diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/MooseX/Net/API.pm | 592 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Error.pm | 36 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Meta/Class.pm | 51 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Meta/Method.pm | 220 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Meta/Method/APIDeclare.pm | 85 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Meta/Method/APIMethod.pm | 86 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Parser.pm | 35 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Parser/JSON.pm | 43 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Parser/XML.pm | 50 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Parser/YAML.pm | 43 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Role/Authentication.pm | 83 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Role/Deserialize.pm | 49 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Role/Format.pm | 85 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Role/Request.pm | 94 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Role/Serialization.pm | 118 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Role/Serialize.pm | 34 | ||||
| -rw-r--r-- | lib/MooseX/Net/API/Role/UserAgent.pm | 56 |
17 files changed, 1227 insertions, 533 deletions
diff --git a/lib/MooseX/Net/API.pm b/lib/MooseX/Net/API.pm index 872d83d..2dcfc13 100644 --- a/lib/MooseX/Net/API.pm +++ b/lib/MooseX/Net/API.pm @@ -1,424 +1,169 @@ 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'; +our $VERSION = '0.11'; -my $list_content_type = { - 'json' => 'application/json', - 'yaml' => 'text/x-yaml', - 'xml' => 'text/xml', -}; +Moose::Exporter->setup_import_methods( + with_meta => [qw/net_api_method net_api_declare/], + also => [qw/Moose/] +); -my ( $do_auth, $base_url, $auth_method, $deserialize_method ); +sub net_api_method { + my $meta = shift; + my $name = shift; + $meta->add_net_api_method($name, @_); +} -Moose::Exporter->setup_import_methods( - with_caller => [qw/net_api_method net_api_declare/], ); +sub net_api_declare { + my $meta = shift; + my $name = shift; + $meta->add_net_api_declare($name, @_); +} sub init_meta { - my ( $me, %options ) = @_; + my ($class, %options) = @_; my $for = $options{for_class}; - Moose::Util::MetaRole::apply_metaroles( + Moose->init_meta(%options); + + my $meta = Moose::Util::MetaRole::apply_metaroles( for_class => $for, metaclass_roles => ['MooseX::Net::API::Meta::Class'], ); + + 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 + / + ], + ); + + $meta; } -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} || '' +1; + +__END__ + +=head1 NAME + +MooseX::Net::API - Easily create client for net API + +=head1 SYNOPSIS + + package My::Net::API; + use MooseX::Net::API; + + # 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', ); - 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} - ); - } + # declaring a users method + # calling $obj->users will call http://exemple.com/api/users/france + net_api_method users => ( + description => 'this get a list of users', + method => 'GET', + path => '/users/:country', + params => [qw/country/], + ); - 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} - ); - } + # 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 ( !$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 the API require authentification, the module will handle basic + # authentication for you + net_api_declare my_api => ( + ... + authentication => 1, + ... + ); - if ( $options{authentication} ) { - $do_auth = delete $options{authentication}; - } + # if the authentication is more complex, you can delegate to your own method - 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}; - } + 1; - if ( $options{deserialisation} ) { - $deserialize_method = delete $options{deserialize_order}; - } - else { - MooseX::Net::API::Role::Deserialize->meta->apply( $caller->meta ); - } + my $obj = My::Net::API->new(); + $obj->api_base_url('http://...'); + $obj->foo(user => $user); - if ( $options{serialisation} ) { - $deserialize_method = delete $options{serialize_order}; - } - else { - MooseX::Net::API::Role::Serialize->meta->apply( $caller->meta ); - } -} +=head1 DESCRIPTION -sub net_api_method { - my $caller = shift; - my $name = shift; - my %options = ( authentication => $do_auth, @_ ); +MooseX::Net::API is a module to help to easily create a client for a web API. - if ( !$options{params} && $options{required} ) { - die MooseX::Net::API::Error->new( reason => - "you can't require a param that have not been declared" ); - } +This module is heavily inspired by what L<Net::Twitter> does. - 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} } ); - } - } +B<THIS MODULE IS IN ITS BETA QUALITY. THE API MAY CHANGE IN THE FUTURE> - 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 - my $max_iter = keys %args; - my $i = 0; - while ($path =~ /\$(\w+)/g) { - my $match = $1; - if (my $value = delete $args{$match}) { - $path =~ s/\$$match/$value/; - } - if (++$i > $max_iter) { - $path =~ s/\$(\w+)//; - last; - } - } - - $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}; - } +The following roles are added to your class: - $class->add_method( - $name, - MooseX::Net::API::Meta::Method->new( - name => $name, - package_name => $caller, - body => $code, - %options, - ), - ); - $class->_add_api_method($name); -} +=over 4 -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, - ); -} +=item B<MooseX::Net::API::Role::UserAgent> -sub _request { - my ( $self, $format, $options, $uri, $args ) = @_; +=item B<MooseX::Net::API::Role::Format> - my $req; - my $method = $options->{method}; +=item B<MooseX::Net::API::Role::Authentication> - 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" ); - } +=item B<MooseX::Net::API::Role::Serialization> - $req->header( 'Content-Type' => $list_content_type->{$format} ) - if $self->api_format_mode eq 'content-type'; +=item B<MooseX::Net::API::Role::Request> - if ( $do_auth || $options->{authentication} ) { - if ($auth_method) { - $req = $self->$auth_method($req); - } - else { - $req = _do_authentication( $self, $req ); - } - } +=back - return $self->api_useragent->request($req); -} +The following attributes are added to your class: -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; -} +=over 4 -1; -__END__ +=item B<api_base_url> -=head1 NAME +=item B<api_format> -MooseX::Net::API - Easily create client for net API +=item B<api_username> -=head1 SYNOPSIS +=item B<api_passord> - 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', - ); +=item B<authentication> - # 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/], - ); +=item B<authentication_method> - # 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 - }, - ... - ); +=back - # if the API require authentification, the module will handle basic - # authentication for you - net_api_declare my_api => ( - ... - authentication => 1, - ... - ); +The following methods are added to your class: - # if the authentication is more complex, you can delegate to your own method +=over 4 - 1; +=item B<http_request> - my $obj = My::Net::API->new(); - $obj->api_base_url('http://...'); - $obj->foo(user => $user); +=item B<get_content> -=head1 DESCRIPTION +=item B<serialize> -MooseX::Net::API is module to help to easily create a client for a web API. -This module is heavily inspired by what L<Net::Twitter> does. +=item B<deserialize> -B<THIS MODULE IS IN ITS BETA QUALITY. THE API MAY CHANGE IN THE FUTURE> +=item B<content_type> + +=back =head2 METHODS @@ -426,46 +171,61 @@ 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<api_base_url> + +The base url for all the API's calls. This will set the B<api_base_url> attribut in your class. Can be set at the object creation or before calling an API method. + +=item B<api_format> + +The format for the API's calls. This will set the B<api_format> attribut to your class. Value can be: =over 2 -=item B<base_url> (required) +=item B<json> + +=item B<yaml> + +=item B<xml> -The base url for all the API's calls. This will add an B<api_base_url> -attribut to your class. +=back + +=item B<api_format_mode> -=item B<format> (required, must be either xml, json or yaml) +How the format is handled. B<append> will add B<.$format> to the query, B<content-type> will set the content-type information to the header of the request. Should be one the following value: -The format for the API's calls. This will add an B<api_format> attribut to -your class. +=over 2 -=item B<format_mode> (required, must be 'append' or 'content-type') +=item B<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. +=item B<append> -=item B<useragent> (optional, by default it's a LWP::UserAgent object) +=back - 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<api_useragent> + +A L<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; + } -=item B<authentication> (optional) +=item B<authentication> This is a boolean to tell if we must authenticate to use this API. -=item B<authentication_method> (optional) +=item B<authentication_method> -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 => ( ... @@ -476,7 +236,6 @@ Basic Authentication Scheme. You can write your own authentication method: sub my_auth_method { my ($self, $req) = @_; #$req is an HTTP::Request object ... - return $req; } =back @@ -485,51 +244,46 @@ Basic Authentication Scheme. You can write your own authentication method: =over 2 -=item B<description> [string] +=item B<description> -description of the method (this is a documentation) +A string to describe the method (this is a documentation) -=item B<method> [string] +=item B<method> HTTP method (GET, POST, PUT, DELETE) -=item B<path> [string] +=item B<path> 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); - -the url generetad will look like - - /user/franck/list/today/?foo=1&bar=2 + $obj->user_comments(user => 'franck', date => 'today', foo => 1, bar => 2); -=item B<params> [arrayref] +the url generated will look like -list of params. + /user/franck/list/today/?foo=1&bar=2 -=item B<required> [arrayref] +=item B<params> -list of required params. +Arrayref of params. -=item B<authentication> (optional) +=item B<required> -should we do an authenticated call +Arrayref of required params. -=item B<params_in_url> (optional) +=item B<params_in_url> -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 diff --git a/lib/MooseX/Net/API/Error.pm b/lib/MooseX/Net/API/Error.pm index 0542613..8825877 100644 --- a/lib/MooseX/Net/API/Error.pm +++ b/lib/MooseX/Net/API/Error.pm @@ -1,12 +1,12 @@ package MooseX::Net::API::Error; use Moose; -use JSON::XS; +use JSON; use Moose::Util::TypeConstraints; use overload '""' => \&error; subtype error => as 'Str'; -coerce error => from 'HashRef' => via { encode_json $_}; +coerce error => from 'HashRef' => via { JSON::encode_json $_}; has http_error => ( is => 'ro', @@ -29,5 +29,35 @@ sub error { } 1; - __END__ + +=head1 NAME + +MooseX::Net::API::Error + +=head1 SYNOPSIS + + MooseX::Net::API::Error->new(reason => "'useragent' is required"); + +or + + MooseX::Net::API::Error->new() + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Meta/Class.pm b/lib/MooseX/Net/API/Meta/Class.pm index e4bed0c..9fdd793 100644 --- a/lib/MooseX/Net/API/Meta/Class.pm +++ b/lib/MooseX/Net/API/Meta/Class.pm @@ -1,25 +1,36 @@ package MooseX::Net::API::Meta::Class; use Moose::Role; -use Moose::Meta::Class; -use MooseX::Types::Moose qw(Str ArrayRef ClassName Object); - -has local_api_methods => ( - traits => ['Array'], - is => 'ro', - isa => ArrayRef [Str], - required => 1, - default => sub { [] }, - auto_deref => 1, - handles => { '_add_api_method' => 'push' }, -); - -sub _build_meta_class { - my $self = shift; - return Moose::Meta::Class->create_anon_class( - superclasses => [ $self->method_metaclass ], - cache => 1, - ); -} + +with qw/ + MooseX::Net::API::Meta::Method::APIMethod + MooseX::Net::API::Meta::Method::APIDeclare + /; 1; +__END__ + +=head1 NAME + +MooseX::Net::API::Meta::Class + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Meta/Method.pm b/lib/MooseX/Net/API/Meta/Method.pm index e9ceca7..7c388b9 100644 --- a/lib/MooseX/Net/API/Meta/Method.pm +++ b/lib/MooseX/Net/API/Meta/Method.pm @@ -1,19 +1,223 @@ package MooseX::Net::API::Meta::Method; use Moose; +use MooseX::Net::API::Error; +use Moose::Util::TypeConstraints; + +use MooseX::Types::Moose qw/Str Int ArrayRef/; + extends 'Moose::Meta::Method'; -has description => ( is => 'ro', isa => 'Str' ); -has path => ( is => 'ro', isa => 'Str', required => 1 ); -has method => ( is => 'ro', isa => 'Str', required => 1 ); -has params => ( is => 'ro', isa => 'ArrayRef', required => 0 ); -has required => ( is => 'ro', isa => 'ArrayRef', required => 0 ); -has expected => ( is => 'ro', isa => 'ArrayRef', required => 0 ); +subtype UriPath => as 'Str' => where { $_ =~ m!^/! } => + message {"path must start with /"}; + +enum Method => qw(GET POST PUT DELETE); + +has description => (is => 'ro', isa => 'Str'); +has method => (is => 'ro', isa => 'Method', required => 1); +has path => (is => 'ro', isa => 'UriPath', required => 1, coerce => 1); +has params_in_url => (is => 'ro', isa => 'Bool', default => 0); +has authentication => (is => 'ro', isa => 'Bool', default => 0); +has expected => ( + traits => ['Array'], + is => 'ro', + isa => ArrayRef [Int], + auto_deref => 1, + required => 0, + predicate => 'has_expected', + handles => {find_expected_code => 'grep',}, +); +has params => ( + traits => ['Array'], + is => 'ro', + isa => ArrayRef [Str], + required => 0, + default => sub { [] }, + auto_deref => 1, + handles => {find_param => 'first',} +); +has required => ( + traits => ['Array'], + is => 'ro', + isa => ArrayRef [Str], + default => sub { [] }, + auto_deref => 1, + required => 0, +); -sub new { +before wrap => sub { my $class = shift; my %args = @_; - $class->SUPER::wrap(@_); + + $class->_validate_params_before_install(\%args); + $class->_validate_required_before_install(\%args); +}; + +sub wrap { + my $class = shift; + my %args = @_; + + if (!defined $args{body}) { + my $code = sub { + my ($self, %method_args) = @_; + + my $method = + $self->meta->find_method_by_name($args{name}) + ->get_original_method; + + $method->_validate_before_execute(\%method_args); + + my $path = $method->_build_path(\%method_args); + my $local_url = $method->_build_uri($self, $path); + + my $result = $self->http_request( + $method->method => $local_url, + $method->params_in_url, \%method_args + ); + + my $code = $result->code; + + if ($method->has_expected + && !$method->find_expected_code(sub {/$code/})) + { + die MooseX::Net::API::Error->new( + reason => "unexpected code", + http_error => $result + ); + } + + my $content = $self->get_content($result);; + + if ($result->is_success) { + if (wantarray) { + return ($content, $result); + } + else { + return $content; + } + } + + die MooseX::Net::API::Error->new( + http_error => $result, + reason => $result->message, + ); + }; + $args{body} = $code; + } + + $class->SUPER::wrap(%args); +} + +sub _validate_params_before_install { + my ( $class, $args ) = @_; + if ( !$args->{params} && $args->{required} ) { + die MooseX::Net::API::Error->new( reason => + "You can't require a param that have not been declared" ); + } +} + +sub _validate_required_before_install { + my ( $class, $args ) = @_; + if ( $args->{required} ) { + foreach my $required ( @{ $args->{required} } ) { + die MooseX::Net::API::Error->new( reason => + "$required is required but is not declared in params" ) + if ( !grep { $_ eq $required } @{ $args->{params} } ); + } + } +} + +sub _validate_before_execute { + my ($self, $args) = @_; + for my $method (qw/_check_params_before_run _check_required_before_run/) { + $self->$method($args); + } +} + +sub _check_params_before_run { + my ($self, $args) = @_; + + # check if there is no undeclared param + foreach my $arg (keys %$args) { + if (!$self->find_param(sub {/$arg/})) { + die MooseX::Net::API::Error->new( + reason => "'$arg' is not declared as a param"); + } + } +} + +sub _check_required_before_run { + my ($self, $args) = @_; + + # check if all our params declared as required are present + foreach my $required ($self->required) { + if (!grep { $required eq $_ } keys %$args) { + die MooseX::Net::API::Error->new(reason => + "'$required' is declared as required, but is not present"); + } + } +} + +sub _build_path { + my ($self, $args) = @_; + my $path = $self->path; + + my $max_iter = keys %$args; + my $i = 0; + while ($path =~ /(?:\$|:)(\w+)/g) { + my $match = $1; + $i++; + if (my $value = delete $args->{$match}) { + $path =~ s/(?:\$|:)$match/$value/; + } + if ($max_iter > $i) { + $path =~ s/(?:\$|:)(\w+)//; + } + } + return $path; +} + +sub _build_uri { + my ($method, $self, $path) = @_; + + my $local_url = $self->api_base_url->clone; + my $path_url_base = $local_url->path; + $path_url_base =~ s/\/$// if $path_url_base =~ m!/$!; + $path_url_base .= $path; + + if ($self->api_format && $self->api_format_mode eq 'append') { + my $format = $self->api_format; + $path_url_base .= "." . $format; + } + + $local_url->path($path_url_base); + return $local_url; } 1; +__END__ + +=head1 NAME + +MooseX::Net::API::Meta::Class::Method + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Meta/Method/APIDeclare.pm b/lib/MooseX/Net/API/Meta/Method/APIDeclare.pm new file mode 100644 index 0000000..14fb83d --- /dev/null +++ b/lib/MooseX/Net/API/Meta/Method/APIDeclare.pm @@ -0,0 +1,85 @@ +package MooseX::Net::API::Meta::Method::APIDeclare; + +use Moose::Role; +use MooseX::Net::API::Error; + +has options => ( + is => 'ro', + traits => ['Hash'], + isa => 'HashRef[Str|CodeRef]', + default => sub { {} }, + lazy => 1, + handles => { + set_option => 'set', + get_option => 'get', + }, +); +has accepted_options => ( + is => 'ro', + traits => ['Array'], + isa => 'ArrayRef[Str]', + default => sub { + [ qw/api_base_url + api_format + api_username + api_password + authentication + authentication_method/ + ]; + }, + lazy => 1, + auto_deref => 1, +); + +sub add_net_api_declare { + my ($meta, $name, %options) = @_; + + if ($options{useragent}) { + die MooseX::Net::API::Error->new( + reason => "'useragent' must be a CODE ref") + unless ref $options{useragent} eq 'CODE'; + $meta->set_option(useragent => delete $options{useragent}); + } + + # XXX for backward compatibility + for my $attr (qw/base_url format username password/) { + my $attr_name = "api_" . $attr; + if (exists $options{$attr} && !exists $options{$attr_name}) { + $options{$attr_name} = delete $options{$attr}; + } + } + + for my $attr ($meta->accepted_options) { + $meta->set_option($attr => $options{$attr}) if defined $options{$attr}; + } + + # XXX before_request after_request +} + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Meta::Class::Method::APIDeclare + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Meta/Method/APIMethod.pm b/lib/MooseX/Net/API/Meta/Method/APIMethod.pm new file mode 100644 index 0000000..d55fe82 --- /dev/null +++ b/lib/MooseX/Net/API/Meta/Method/APIMethod.pm @@ -0,0 +1,86 @@ +package MooseX::Net::API::Meta::Method::APIMethod; + +use Moose::Role; +use MooseX::Net::API::Error; +use MooseX::Net::API::Meta::Method; +use MooseX::Types::Moose qw/Str ArrayRef/; + +has local_api_methods => ( + traits => ['Array'], + is => 'ro', + isa => ArrayRef [Str], + required => 1, + default => sub { [] }, + auto_deref => 1, + handles => { + _get_api_method => 'grep', + _add_api_method => 'push', + _all_api_methods => 'elements', + }, +); + +before add_net_api_method => sub { + my ($meta, $name) = @_; + if (my @method = $meta->_get_api_method(sub {/^$name$/})) { + die MooseX::Net::API::Error->new( + reason => "method '$name' is already declared in " . $meta->name); + } +}; + +sub add_net_api_method { + my ($meta, $name, %options) = @_; + + # accept blessed method + my $code = delete $options{code}; + $meta->add_method( + $name, + MooseX::Net::API::Meta::Method->wrap( + name => $name, + package_name => $meta->name, + body => $code, + %options + ), + ); + $meta->_add_api_method($name); +} + +after add_net_api_method => sub { + my ($meta, $name, %options) = @_; + $meta->add_before_method_modifier( + $name, + sub { + my $self = shift; + die MooseX::Net::API::Error->new( + reason => "'api_base_url' have not been defined") + unless $self->api_base_url; + } + ); +}; + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Meta::Class::Method::APIMethod + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Parser.pm b/lib/MooseX/Net/API/Parser.pm new file mode 100644 index 0000000..8bf74b0 --- /dev/null +++ b/lib/MooseX/Net/API/Parser.pm @@ -0,0 +1,35 @@ +package MooseX::Net::API::Parser; + +use Moose; + +sub encode {die "must be implemented"} +sub decode {die "must be implemented"} + +1; + +__END__ + +=head1 NAME + +MooseX::Net::API::Parser + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Parser/JSON.pm b/lib/MooseX/Net/API/Parser/JSON.pm new file mode 100644 index 0000000..bf4c08b --- /dev/null +++ b/lib/MooseX/Net/API/Parser/JSON.pm @@ -0,0 +1,43 @@ +package MooseX::Net::API::Parser::JSON; + +use JSON; +use Moose; +extends 'MooseX::Net::API::Parser'; + +sub encode { + my ($self, $content) = @_; + return JSON::encode_json($content); +} + +sub decode { + my ($self, $content) = @_; + return JSON::decode_json($content); +} + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Parser::JSON + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Parser/XML.pm b/lib/MooseX/Net/API/Parser/XML.pm new file mode 100644 index 0000000..7198175 --- /dev/null +++ b/lib/MooseX/Net/API/Parser/XML.pm @@ -0,0 +1,50 @@ +package MooseX::Net::API::Parser::XML; + +use XML::Simple; +use Moose; +extends 'MooseX::Net::API::Parser'; + +has _xml_parser => ( + is => 'rw', + isa => 'XML::Simple', + lazy => 1, + default => sub { XML::SImple->new(ForceArray => 0) } +); + +sub encode { + my ($self, $content) = @_; + return $self->_xml_parser->XMLin($content); +} + +sub decode { + my ($self, $content) = @_; + return $self->_xml_parser->XMLout($content); +} + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Parser::XML + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Parser/YAML.pm b/lib/MooseX/Net/API/Parser/YAML.pm new file mode 100644 index 0000000..5258796 --- /dev/null +++ b/lib/MooseX/Net/API/Parser/YAML.pm @@ -0,0 +1,43 @@ +package MooseX::Net::API::Parser::YAML; + +use YAML::Syck; +use Moose; +extends 'MooseX::Net::API::Parser'; + +sub encode { + my ($self, $content) = @_; + return Dump($content); +} + +sub decode { + my ($self, $content) = @_; + return Load($content); +} + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Parser::YAML + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Role/Authentication.pm b/lib/MooseX/Net/API/Role/Authentication.pm new file mode 100644 index 0000000..0b6de69 --- /dev/null +++ b/lib/MooseX/Net/API/Role/Authentication.pm @@ -0,0 +1,83 @@ +package MooseX::Net::API::Role::Authentication; + +use Moose::Role; + +has api_username => ( + is => 'rw', + isa => 'Str', + predicate => 'has_api_username', +); + +has api_password => ( + is => 'rw', + isa => 'Str', + predicate => 'has_api_password', +); + +# ugly :( +after BUILDALL => sub { + my $self = shift; + + for (qw/api_username api_password/) { + my $predicate = 'has_' . $_; + my $value = $self->meta->get_option($_); + $self->$_($value) if $value && !$self->$predicate; + } + + if (my $has_auth = $self->meta->get_option('authentication')) { + my $auth_method = $self->meta->get_option('authentication_method'); + if ($auth_method) { + $self->api_useragent->add_handler( + request_prepare => sub { $self->$auth_method(@_) }); + } + else { + if ($self->has_api_username && $self->has_api_password) { + $self->api_useragent->add_handler( + request_prepare => sub { + my $req = shift; + $req->headers->authorization_basic($self->api_username, + $self->api_password); + } + ); + } + } + } +}; + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Role::Authentication + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 ATTRIBUTES + +=over 4 + +=item B<api_password> + +=item B<api_username> + +=back + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Role/Deserialize.pm b/lib/MooseX/Net/API/Role/Deserialize.pm deleted file mode 100644 index cf69087..0000000 --- a/lib/MooseX/Net/API/Role/Deserialize.pm +++ /dev/null @@ -1,49 +0,0 @@ -package MooseX::Net::API::Role::Deserialize; - -use Moose::Role; -use JSON::XS; -use YAML::Syck; -use XML::Simple; -use Try::Tiny; - -my $reverse_content_type = { - 'application/json' => 'json', - 'application/x-yaml' => 'yaml', - 'text/xml' => 'xml', - 'application/xml' => 'xml', -}; - -sub _from_json { - return decode_json( $_[1] ); -} - -sub _from_yaml { - return Load $_[1]; -} - -sub _from_xml { - my $xml = XML::Simple->new( ForceArray => 0 ); - $xml->XMLin( $_[1] ); -} - -sub _do_deserialization { - my ( $caller, $raw_content, @content_types ) = @_; - - my $content; - foreach my $deserializer (@content_types) { - my $method; - if ( $reverse_content_type->{$deserializer} ) { - $method = '_from_' . $reverse_content_type->{$deserializer}; - } - else { - $method = '_from_' . $deserializer; - } - next if ( !$caller->meta->find_method_by_name($method) ); - try { - $content = $caller->$method($raw_content); - }; - return $content if $content; - } -} - -1; diff --git a/lib/MooseX/Net/API/Role/Format.pm b/lib/MooseX/Net/API/Role/Format.pm new file mode 100644 index 0000000..e766161 --- /dev/null +++ b/lib/MooseX/Net/API/Role/Format.pm @@ -0,0 +1,85 @@ +package MooseX::Net::API::Role::Format; + +use Moose::Role; +use Moose::Util::TypeConstraints; + +sub content_type { + { json => {value => 'application/json', module => 'JSON',}, + yaml => {value => 'text/x-yaml', module => 'YAML'}, + xml => {value => 'text/xml', module => 'XML::Simple'}, + }; +} + +subtype Format => as 'Str' => where { + my $format = shift; + grep {/^$format$/} keys %{content_type()}; +}; + +enum 'FormatMode' => qw(content-type append); + +has api_format => ( + is => 'rw', + isa => 'Format', + lazy => 1, + default => sub { + my $self = shift; + $self->meta->get_option('api_format'); + } +); + +has api_format_mode => ( + is => 'rw', + isa => 'FormatMode', + lazy => 1, + default => sub { + my $self = shift; + my $mode = $self->meta->get_option('api_format_mode'); + $mode || 'append'; + } +); + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Role::Format + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 METHODS + +=over 4 + +=item B<content_type> + +=back + +=head2 ATTRIBUTES + +=over 4 + +=item B<api_format> + +=item B<api_format_mode> + +=back + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Role/Request.pm b/lib/MooseX/Net/API/Role/Request.pm new file mode 100644 index 0000000..214411c --- /dev/null +++ b/lib/MooseX/Net/API/Role/Request.pm @@ -0,0 +1,94 @@ +package MooseX::Net::API::Role::Request; + +use Moose::Role; +use HTTP::Request; +use MooseX::Net::API::Error; +use MooseX::Types::URI qw(Uri); + +has api_base_url => ( + is => 'rw', + isa => Uri, + coerce => 1, + lazy => 1, + default => sub { + my $self = shift; + my $api_base_url = $self->meta->get_option('api_base_url'); + if (!$api_base_url) { + die MooseX::Net::API::Error->new( + reason => "'api_base_url' have not been defined"); + } + $api_base_url; + } +); + +sub http_request { + my ($self, $method, $uri, $params_in_url, $args) = @_; + + my $request; + + if ( $method =~ /^(?:GET|DELETE)$/ || $params_in_url ) { + $uri->query_form(%$args); + $request = HTTP::Request->new( $method => $uri ); + } + elsif ( $method =~ /^(?:POST|PUT)$/ ) { + $request = HTTP::Request->new( $method => $uri ); + my $content = $self->serialize($args); + $request->content($content); + } + else { + die MooseX::Net::API::Error->new( + reason => "$method is not defined" ); + } + + $request->header( + 'Content-Type' => $self->content_type->{$self->api_format}->{value}) + if $self->api_format_mode eq 'content-type'; + + # XXX lwp hook! + my $result = $self->api_useragent->request($request); + return $result; +} + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Role::Request + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 METHODS + +=over 4 + +=item B<http_request> + +=back + +=head2 ATTRIBUTES + +=over 4 + +=item B<api_base_url> + +=back + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Role/Serialization.pm b/lib/MooseX/Net/API/Role/Serialization.pm new file mode 100644 index 0000000..d4feb56 --- /dev/null +++ b/lib/MooseX/Net/API/Role/Serialization.pm @@ -0,0 +1,118 @@ +package MooseX::Net::API::Role::Serialization; + +use 5.010; + +use Try::Tiny; +use Moose::Role; +use MooseX::Net::API::Error; + +has serializers => ( + traits => ['Hash'], + is => 'rw', + isa => 'HashRef[MooseX::Net::API::Parser]', + default => sub { {} }, + auto_deref => 1, + handles => { + _add_serializer => 'set', + _get_serializer => 'get', + }, +); + +sub get_content { + my ($self, $result) = @_; + + my $content_type = $self->api_format // $result->header('Content-Type'); + $content_type =~ s/(;.+)$//; + + my $content; + if ($result->is_success && $result->code != 204) { + my @deserialize_order = ($content_type, $self->api_format); + $content = $self->deserialize($result->content, \@deserialize_order); + + if (!$content) { + die MooseX::Net::API::Error->new( + reason => "can't deserialize content", + http_error => $result, + ); + } + } + $content; +} + +sub deserialize { + my ($self, $content, $list_of_formats) = @_; + + foreach my $format (@$list_of_formats) { + my $s = $self->_get_serializer($format) + || $self->_load_serializer($format); + next unless $s; + my $result = try { $s->decode($content) }; + return $result if $result; + } +} + +sub serialize { + my ($self, $content) = @_; + my $s = $self->_get_serializer($self->api_format); + my $result = try { $s->encode($content) }; + return $result if $result; +} + +sub _load_serializer { + my $self = shift; + my $format = shift || $self->api_format; + my $parser = "MooseX::Net::API::Parser::" . uc($format); + if (Class::MOP::load_class($parser)) { + my $o = $parser->new; + $self->_add_serializer($format => $o); + return $o; + } +} + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Role::Serialization + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 ATTRIBUTES + +=over 4 + +=item B<serializers> + +=back + +=head2 METHODS + +=over 4 + +=item B<get_content> + +=item B<serialize> + +=item B<deserialize> + +=back + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Net/API/Role/Serialize.pm b/lib/MooseX/Net/API/Role/Serialize.pm deleted file mode 100644 index f527928..0000000 --- a/lib/MooseX/Net/API/Role/Serialize.pm +++ /dev/null @@ -1,34 +0,0 @@ -package MooseX::Net::API::Role::Serialize; - -use Moose::Role; -use JSON::XS; -use YAML::Syck; -use XML::Simple; -use Try::Tiny; - -sub _to_json { - return encode_json( $_[1] ); -} - -sub _to_yaml { - return Dump $_[1]; -} - -sub _to_xml { - my $xml = XML::Simple->new( ForceArray => 0 ); - $xml->XMLin("$_[0]"); -} - -sub _do_serialization { - my ( $caller, $content, $format ) = @_; - - my $format_content; - my $method = '_to_' . $format; - return if ( !$caller->meta->find_method_by_name($method) ); - try { - $format_content = $caller->$method($content); - }; - return $format_content if $format_content; -} - -1; diff --git a/lib/MooseX/Net/API/Role/UserAgent.pm b/lib/MooseX/Net/API/Role/UserAgent.pm new file mode 100644 index 0000000..c3a1d5b --- /dev/null +++ b/lib/MooseX/Net/API/Role/UserAgent.pm @@ -0,0 +1,56 @@ +package MooseX::Net::API::Role::UserAgent; + +use Moose::Role; +use LWP::UserAgent; + +has api_useragent => ( + is => 'rw', + isa => 'LWP::UserAgent', + lazy => 1, + default => sub { + my $self = shift; + my $ua = $self->meta->get_option('useragent'); + return $ua->() if $ua; + $ua = LWP::UserAgent->new(); + $ua->agent( + "MooseX::Net::API " . $MooseX::Net::API::VERSION . " (Perl)"); + $ua->env_proxy; + return $ua; + } +); + +1; +__END__ + +=head1 NAME + +MooseX::Net::API::Role::UseAgent + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 ATTRIBUTES + +=over 4 + +=item B<api_useragent> + +=back + +=head1 AUTHOR + +franck cuny E<lt>franck@lumberjaph.netE<gt> + +=head1 SEE ALSO + +=head1 LICENSE + +Copyright 2009, 2010 by Linkfluence + +http://linkfluence.net + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut |