about summary refs log tree commit diff
path: root/lib/MooseX/Net/API.pm
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2010-06-02 11:34:38 +0200
committerfranck cuny <franck@lumberjaph.net>2010-06-02 11:34:38 +0200
commitadf06fefd3f23850941d706a0765c8ff9a6fa4b4 (patch)
tree695ff4c350a50b7e6a4ce2b596f40596c6db28b3 /lib/MooseX/Net/API.pm
parentrename package (diff)
downloadnet-http-api-adf06fefd3f23850941d706a0765c8ff9a6fa4b4.tar.gz
s/with_caller/with_meta/, move code into roles
Diffstat (limited to '')
-rw-r--r--lib/MooseX/Net/API.pm504
1 files changed, 99 insertions, 405 deletions
diff --git a/lib/MooseX/Net/API.pm b/lib/MooseX/Net/API.pm
index 634416f..b0e02b8 100644
--- a/lib/MooseX/Net/API.pm
+++ b/lib/MooseX/Net/API.pm
@@ -1,355 +1,56 @@
 package MooseX::Net::API;
 
-use URI;
-use Try::Tiny;
-use HTTP::Request;
-
 use Moose;
 use Moose::Exporter;
 
-use MooseX::Net::API::Error;
-
-use MooseX::Net::API::Meta::Class;
-use MooseX::Net::API::Meta::Method;
-
-use MooseX::Net::API::Role::Serialize;
-use MooseX::Net::API::Role::Deserialize;
-
-our $VERSION = '0.10';
-
-my $list_content_type = {
-    'json' => 'application/json',
-    'yaml' => 'text/x-yaml',
-    'xml'  => 'text/xml',
-};
-
-my ( $do_auth, $base_url, $auth_method, $deserialize_method );
+our $VERSION = '0.13';
 
 Moose::Exporter->setup_import_methods(
-    with_caller => [qw/net_api_method net_api_declare/], );
+    with_meta => [qw/net_api_method net_api_declare/],
+    also      => [qw/Moose/]
+);
 
-sub init_meta {
-    my ( $me, %options ) = @_;
-
-    my $for = $options{for_class};
-    Moose::Util::MetaRole::apply_metaroles(
-        for_class       => $for,
-        metaclass_roles => ['MooseX::Net::API::Meta::Class'],
-    );
+sub net_api_method {
+    my $meta = shift;
+    my $name = shift;
+    $meta->add_net_api_method($name, @_);
 }
 
 sub net_api_declare {
-    my $caller  = shift;
-    my $name    = shift;
-    my %options = @_;
-
-    my $class = Moose::Meta::Class->initialize($caller);
-
-    $class->add_attribute(
-        'api_base_url',
-        is      => 'rw',
-        isa     => 'Str',
-        lazy    => 1,
-        default => delete $options{base_url} || ''
-    );
-
-    if ( !$options{format} ) {
-        die MooseX::Net::API::Error->new(
-            reason => "format is missing in your api declaration" );
-    }
-    elsif ( !$list_content_type->{ $options{format} } ) {
-        die MooseX::Net::API::Error->new(
-            reason => "format is not recognised. It must be "
-                . join( " or ", keys %$list_content_type ) );
-    }
-    else {
-        $class->add_attribute(
-            'api_format',
-            is      => 'ro',
-            isa     => 'Str',
-            lazy    => 1,
-            default => delete $options{format}
-        );
-    }
-
-    if ( !$options{format_mode} ) {
-        die MooseX::Net::API::Error->new(
-            reason => "format_mode is not set" );
-    }
-    elsif ( $options{format_mode} !~ /^(?:append|content\-type)$/ ) {
-        die MooseX::Net::API::Error->new(
-            reason => "format_mode must be append or content-type" );
-    }
-    else {
-        $class->add_attribute(
-            'api_format_mode',
-            is      => 'ro',
-            isa     => 'Str',
-            lazy    => 1,
-            default => delete $options{format_mode}
-        );
-    }
-
-    if ( !$options{useragent} ) {
-        _add_useragent($class);
-    }
-    else {
-        my $method = $options{useragent};
-        if ( ref $method ne 'CODE' ) {
-            die MooseX::Net::API::Error->new(
-                reason => "useragent must be a CODE ref" );
-        }
-        else {
-            _add_useragent( $class, delete $options{useragent} );
-        }
-    }
-
-    if ( $options{authentication} ) {
-        $do_auth = delete $options{authentication};
-    }
-
-    if ( $options{username} ) {
-        $class->add_attribute(
-            'api_username',
-            is      => 'ro',
-            isa     => 'Str',
-            lazy    => 1,
-            default => delete $options{username}
-        );
-        if ( $options{password} ) {
-            $class->add_attribute(
-                'api_password',
-                is      => 'ro',
-                isa     => 'Str',
-                lazy    => 1,
-                default => delete $options{password}
-            );
-        }
-    }
-    if ( $options{authentication_method} ) {
-        $auth_method = delete $options{authentication_method};
-    }
-
-    if ( $options{deserialisation} ) {
-        $deserialize_method = delete $options{deserialize_order};
-    }
-    else {
-        MooseX::Net::API::Role::Deserialize->meta->apply( $caller->meta );
-    }
-
-    if ( $options{serialisation} ) {
-        $deserialize_method = delete $options{serialize_order};
-    }
-    else {
-        MooseX::Net::API::Role::Serialize->meta->apply( $caller->meta );
-    }
+    my $meta = shift;
+    my $name = shift;
+    $meta->add_net_api_declare($name, @_);
 }
 
-sub net_api_method {
-    my $caller  = shift;
-    my $name    = shift;
-    my %options = ( authentication => $do_auth, @_ );
-
-    if ( !$options{params} && $options{required} ) {
-        die MooseX::Net::API::Error->new( reason =>
-                "you can't require a param that have not been declared" );
-    }
-
-    if ( $options{required} ) {
-        foreach my $required ( @{ $options{required} } ) {
-            die MooseX::Net::API::Error->new( reason =>
-                    "$required is required but is not declared in params" )
-                if ( !grep { $_ eq $required } @{ $options{params} } );
-        }
-    }
+sub init_meta {
+    my ($class, %options) = @_;
 
-    my $class = Moose::Meta::Class->initialize($caller);
-
-    my $code;
-    if ( !$options{code} ) {
-        $code = sub {
-            my $self = shift;
-            my %args = @_;
-
-            my $meta = $self->meta;
-
-            if ( $auth_method && !$meta->find_method_by_name($auth_method) ) {
-                die MooseX::Net::API::Error->new( reason =>
-                        "you provided $auth_method as an authentication method, but it's not available in your object"
-                );
-            }
-
-            if ( $deserialize_method
-                && !$meta->find_method_by_name($deserialize_method) )
-            {
-                die MooseX::Net::API::Error->new( reason =>
-                        "you provided $deserialize_method for deserialisation, but the method is not available in your object"
-                );
-            }
-
-            # check if there is no undeclared param
-            foreach my $arg ( keys %args ) {
-                if ( !grep { $arg eq $_ } @{ $options{params} } ) {
-                    die MooseX::Net::API::Error->new(
-                        reason => "$arg is not declared as a param" );
-                }
-            }
-
-            # check if all our params declared as required are present
-            foreach my $required ( @{ $options{required} } ) {
-                if ( !grep { $required eq $_ } keys %args ) {
-                    die MooseX::Net::API::Error->new( reason =>
-                            "$required is declared as required, but is not present"
-                    );
-                }
-            }
-
-            my $path = $options{path};
-
-            # replace all args in the url
-            while ( $path =~ /\$(\w+)/ ) {
-                my $match = $1;
-                if ( my $value = delete $args{$match} ) {
-                    $path =~ s/\$$match/$value/;
-                }
-            }
-
-            $path .= '/' if ( $self->api_base_url !~ m!/^! );
-            my $url = $self->api_base_url . $path;
-
-            my $format = $self->api_format();
-            $url .= "." . $format if ( $self->api_format_mode() eq 'append' );
-            my $uri = URI->new($url);
-
-            my $res = _request( $self, $format, \%options, $uri, \%args );
-            if ( $options{expected} ) {
-                if ( !grep { $_ eq $res->code } @{ $options{expected} } ) {
-                    die MooseX::Net::API::Error->new(
-                        reason     => "unexpected code",
-                        http_error => $res
-                    );
-                }
-            }
-
-            my $content_type = $res->headers->{"content-type"};
-            $content_type =~ s/(;.+)$//;
-
-            my @deserialize_order
-                = ( $content_type, $format, keys %$list_content_type );
-
-            my $content;
-            if ($deserialize_method) {
-                $content = $self->$deserialize_method( $res->content,
-                    @deserialize_order );
-            }
-            else {
-                $content = $self->_do_deserialization( $res->content,
-                    @deserialize_order );
-            }
-
-            if ( $res->is_success ) {
-                if (wantarray) {
-                    return ( $content, $res );
-                }
-                else {
-                    return $content;
-                }
-            }
-
-            die MooseX::Net::API::Error->new(
-                http_error => $res,
-                reason     => $content
-            );
-        };
-    }
-    else {
-        $code = $options{code};
-    }
+    my $for = $options{for_class};
+    Moose->init_meta(%options);
 
-    $class->add_method(
-        $name,
-        MooseX::Net::API::Meta::Method->new(
-            name         => $name,
-            package_name => $caller,
-            body         => $code,
-            %options,
-        ),
+    my $meta = Moose::Util::MetaRole::apply_metaroles(
+        for_class       => $for,
+        metaclass_roles => ['MooseX::Net::API::Meta::Class'],
     );
-    $class->_add_api_method($name);
-}
 
-sub _add_useragent {
-    my $class = shift;
-    my $code  = shift;
-
-    if ( !$code ) {
-        try { require LWP::UserAgent; }
-        catch {
-            die MooseX::Net::API::Error->new( reason =>
-                    "no useragent defined and LWP::UserAgent is not available"
-            );
-        };
-
-        $code = sub {
-            my $ua = LWP::UserAgent->new();
-            $ua->agent("MooseX::Net::API/$VERSION (Perl)");
-            $ua->env_proxy;
-            return $ua;
-        };
-    }
-    $class->add_attribute(
-        'api_useragent',
-        is      => 'rw',
-        isa     => 'Any',
-        lazy    => 1,
-        default => $code,
+    Moose::Util::MetaRole::apply_base_class_roles(
+        for   => $for,
+        roles => [
+            qw/
+              MooseX::Net::API::Role::UserAgent
+              MooseX::Net::API::Role::Format
+              MooseX::Net::API::Role::Authentication
+              MooseX::Net::API::Role::Serialization
+              MooseX::Net::API::Role::Request
+              /
+        ],
     );
-}
-
-sub _request {
-    my ( $self, $format, $options, $uri, $args ) = @_;
-
-    my $req;
-    my $method = $options->{method};
 
-    if ( $method =~ /^(?:GET|DELETE)$/ || $options->{params_in_url} ) {
-        $uri->query_form(%$args);
-        $req = HTTP::Request->new( $method => $uri );
-    }
-    elsif ( $method =~ /^(?:POST|PUT)$/ ) {
-        $req = HTTP::Request->new( $method => $uri );
-        my $content = $self->_do_serialization( $args, $format );
-        $req->content($content);
-    }
-    else {
-        die MooseX::Net::API::Error->new(
-            reason => "$method is not defined" );
-    }
-
-    $req->header( 'Content-Type' => $list_content_type->{$format} )
-        if $self->api_format_mode eq 'content-type';
-
-    if ( $do_auth || $options->{authentication} ) {
-        if ($auth_method) {
-            $req = $self->$auth_method($req);
-        }
-        else {
-            $req = _do_authentication( $self, $req );
-        }
-    }
-
-    return $self->api_useragent->request($req);
-}
-
-sub _do_authentication {
-    my ( $caller, $req ) = @_;
-    $req->headers->authorization_basic( $caller->api_username,
-        $caller->api_password )
-        if ( $caller->api_username && $caller->api_password );
-    return $req;
+    $meta;
 }
 
 1;
+
 __END__
 
 =head1 NAME
@@ -358,58 +59,57 @@ MooseX::Net::API - Easily create client for net API
 
 =head1 SYNOPSIS
 
-  package My::Net::API;
-  use Moose;
-  use MooseX::Net::API;
-
-  # we declare an API, the base_url is http://exemple.com/api
-  # the format is json and it will be happened to the query
-  # You can set base_url later, calling $obj->api_base_url('http://..')
-  net_api_declare my_api => (
-    base_url   => 'http://exemple.com/api',
-    format     => 'json',
-    format_api => 'append',
-  );
+    package My::Net::API;
+    use MooseX::Net::API;
 
-  # calling $obj->foo will call http://exemple.com/api/foo?user=$user&group=$group
-  net_api_method foo => (
-    description => 'this get foo',
-    method      => 'GET',
-    path        => '/foo/',
-    params      => [qw/user group/],
-    required    => [qw/user/],
-  );
+    # we declare an API, the base_url is http://exemple.com/api
+    # the format is json and it will be append to the query
+    # You can set api_base_url later, calling $obj->api_base_url('http://..')
+    net_api_declare my_api => (
+        api_base_url    => 'http://exemple.com/api',
+        api_format      => 'json',
+        api_format_mode => 'append',
+    );
 
-  # you can create your own useragent
-  net_api_declare my_api => (
-    ...
-    useragent => sub {
-      my $ua = LWP::UserAgent->new;
-      $ua->agent('MyUberAgent/0.23');
-      return $ua
-    },
-    ...
-  );
+    # declaring a users method
+    # calling $obj->users will call http://exemple.com/api/users?country=france
+    net_api_method users => (
+        description => 'this get a list of users',
+        method      => 'GET',
+        path        => '/users/',
+        params      => [qw/country/],
+    );
 
-  # if the API require authentification, the module will handle basic
-  # authentication for you
-  net_api_declare my_api => (
-    ...
-    authentication => 1,
-    ...
-  );
+    # you can create your own useragent (it must be a LWP::UserAgent object)
+    net_api_declare my_api => (
+        ...
+        useragent => sub {
+            my $ua = LWP::UserAgent->new;
+            $ua->agent('MyUberAgent/0.23');
+            return $ua
+        },
+        ...
+    );
 
-  # if the authentication is more complex, you can delegate to your own method
+    # if the API require authentification, the module will handle basic
+    # authentication for you
+    net_api_declare my_api => (
+        ...
+        authentication => 1,
+        ...
+    );
+
+    # if the authentication is more complex, you can delegate to your own method
 
-  1;
+    1;
 
-  my $obj = My::Net::API->new();
-  $obj->api_base_url('http://...');
-  $obj->foo(user => $user);
+    my $obj = My::Net::API->new();
+    $obj->api_base_url('http://...');
+    $obj->foo(user => $user);
 
 =head1 DESCRIPTION
 
-MooseX::Net::API is module to help to easily create a client for a web API.
+MooseX::Net::API is a module to help to easily create a client for a web API.
 This module is heavily inspired by what L<Net::Twitter> does.
 
 B<THIS MODULE IS IN ITS BETA QUALITY. THE API MAY CHANGE IN THE FUTURE>
@@ -420,37 +120,33 @@ B<THIS MODULE IS IN ITS BETA QUALITY. THE API MAY CHANGE IN THE FUTURE>
 
 =item B<net_api_declare>
 
-  net_api_declare backtype => (
-    base_url    => 'http://api....',
-    format      => 'json',
-    format_mode => 'append',
-  );
+    net_api_declare backtype => (
+        base_url    => 'http://api....',
+        format      => 'json',
+        format_mode => 'append',
+    );
 
 =over 2
 
-=item B<base_url> (required)
+=item B<api_base_url>
 
-The base url for all the API's calls. This will add an B<api_base_url>
-attribut to your class.
+The base url for all the API's calls. This will add an B<api_base_url> attribut to your class. Can be set at the object creation or before calling an API method. If no api_base_url is defined, the method will die.
 
-=item B<format> (required, must be either xml, json or yaml)
+=item B<api_format> (required, must be either xml, json or yaml)
 
-The format for the API's calls. This will add an B<api_format> attribut to
-your class.
+The format for the API's calls. This will add an B<api_format> attribut to your class.
 
-=item B<format_mode> (required, must be 'append' or 'content-type')
+=item B<api_format_mode> (required, must be 'append' or 'content-type')
 
-How the format is handled. B<append> will add B<.json> to the query,
-B<content-type> will add the content-type information to the header of the
-request.
+How the format is handled. B<append> will add B<.json> to the query, B<content-type> will add the content-type information to the header of the request.
 
 =item B<useragent> (optional, by default it's a LWP::UserAgent object)
 
-  useragent => sub {
-    my $ua = LWP::UserAgent->new;
-    $ua->agent( "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.1) Gecko/20061204 Firefox/2.0.0.1");
-     return $ua;
-  },
+    useragent => sub {
+        my $ua = LWP::UserAgent->new;
+        $ua->agent( "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.1) Gecko/20061204 Firefox/2.0.0.1");
+        return $ua;
+    }
 
 =item B<authentication> (optional)
 
@@ -458,8 +154,7 @@ This is a boolean to tell if we must authenticate to use this API.
 
 =item B<authentication_method> (optional)
 
-The default authentication method only set an authorization header using the
-Basic Authentication Scheme. You can write your own authentication method:
+The default authentication method only set an authorization header using the Basic Authentication Scheme. You can write your own authentication method:
 
   net_api_declare foo => (
     ...
@@ -493,20 +188,20 @@ path of the query.
 
 If you defined your path and params like this
 
-  net_api_method user_comments => (
-    ...
-    path => '/user/$user/list/$date/',
-    params => [qw/user date foo bar/],
-    ...
-  );
+    net_api_method user_comments => (
+      ...
+      path => '/user/$user/list/$date/',
+      params => [qw/user date foo bar/],
+      ...
+    );
 
 and you call
 
-  $obj->user_comments(user => 'franck', date => 'today', foo => 1, bar => 2);
+    $obj->user_comments(user => 'franck', date => 'today', foo => 1, bar => 2);
 
 the url generetad will look like
 
-  /user/franck/list/today/?foo=1&bar=2
+    /user/franck/list/today/?foo=1&bar=2
 
 =item B<params> [arrayref]
 
@@ -522,8 +217,7 @@ should we do an authenticated call
 
 =item B<params_in_url> (optional)
 
-When you do a post, the content may have to be sent as arguments in the url,
-and not as content in the header.
+When you do a post, the content may have to be sent as arguments in the url, and not as content in the header.
 
 =back