From e97449eaa8bd3a408763057f9ca2253d93e2a3d0 Mon Sep 17 00:00:00 2001 From: franck cuny Date: Fri, 16 Jul 2010 16:10:41 +0200 Subject: rename from mx::net::api to net::http::api --- lib/MooseX/Net/API.pm | 286 --------------------------- lib/MooseX/Net/API/Error.pm | 43 ---- lib/MooseX/Net/API/Meta/Class.pm | 16 -- lib/MooseX/Net/API/Meta/Method.pm | 229 --------------------- lib/MooseX/Net/API/Meta/Method/APIDeclare.pm | 57 ------ lib/MooseX/Net/API/Meta/Method/APIMethod.pm | 115 ----------- lib/MooseX/Net/API/Parser.pm | 15 -- lib/MooseX/Net/API/Parser/JSON.pm | 23 --- lib/MooseX/Net/API/Parser/XML.pm | 30 --- lib/MooseX/Net/API/Parser/YAML.pm | 23 --- lib/MooseX/Net/API/Role/Authentication.pm | 67 ------- lib/MooseX/Net/API/Role/Format.pm | 65 ------ lib/MooseX/Net/API/Role/Request.pm | 79 -------- lib/MooseX/Net/API/Role/Serialization.pm | 104 ---------- lib/MooseX/Net/API/Role/UserAgent.pm | 36 ---- lib/Net/HTTP/API.pm | 286 +++++++++++++++++++++++++++ lib/Net/HTTP/API/Error.pm | 43 ++++ lib/Net/HTTP/API/Meta/Class.pm | 16 ++ lib/Net/HTTP/API/Meta/Method.pm | 230 +++++++++++++++++++++ lib/Net/HTTP/API/Meta/Method/APIDeclare.pm | 57 ++++++ lib/Net/HTTP/API/Meta/Method/APIMethod.pm | 115 +++++++++++ lib/Net/HTTP/API/Parser.pm | 15 ++ lib/Net/HTTP/API/Parser/JSON.pm | 23 +++ lib/Net/HTTP/API/Parser/XML.pm | 30 +++ lib/Net/HTTP/API/Parser/YAML.pm | 23 +++ lib/Net/HTTP/API/Role/Authentication.pm | 67 +++++++ lib/Net/HTTP/API/Role/Format.pm | 65 ++++++ lib/Net/HTTP/API/Role/Request.pm | 79 ++++++++ lib/Net/HTTP/API/Role/Serialization.pm | 104 ++++++++++ lib/Net/HTTP/API/Role/UserAgent.pm | 36 ++++ 30 files changed, 1189 insertions(+), 1188 deletions(-) delete mode 100644 lib/MooseX/Net/API.pm delete mode 100644 lib/MooseX/Net/API/Error.pm delete mode 100644 lib/MooseX/Net/API/Meta/Class.pm delete mode 100644 lib/MooseX/Net/API/Meta/Method.pm delete mode 100644 lib/MooseX/Net/API/Meta/Method/APIDeclare.pm delete mode 100644 lib/MooseX/Net/API/Meta/Method/APIMethod.pm delete mode 100644 lib/MooseX/Net/API/Parser.pm delete mode 100644 lib/MooseX/Net/API/Parser/JSON.pm delete mode 100644 lib/MooseX/Net/API/Parser/XML.pm delete mode 100644 lib/MooseX/Net/API/Parser/YAML.pm delete mode 100644 lib/MooseX/Net/API/Role/Authentication.pm delete mode 100644 lib/MooseX/Net/API/Role/Format.pm delete mode 100644 lib/MooseX/Net/API/Role/Request.pm delete mode 100644 lib/MooseX/Net/API/Role/Serialization.pm delete mode 100644 lib/MooseX/Net/API/Role/UserAgent.pm create mode 100644 lib/Net/HTTP/API.pm create mode 100644 lib/Net/HTTP/API/Error.pm create mode 100644 lib/Net/HTTP/API/Meta/Class.pm create mode 100644 lib/Net/HTTP/API/Meta/Method.pm create mode 100644 lib/Net/HTTP/API/Meta/Method/APIDeclare.pm create mode 100644 lib/Net/HTTP/API/Meta/Method/APIMethod.pm create mode 100644 lib/Net/HTTP/API/Parser.pm create mode 100644 lib/Net/HTTP/API/Parser/JSON.pm create mode 100644 lib/Net/HTTP/API/Parser/XML.pm create mode 100644 lib/Net/HTTP/API/Parser/YAML.pm create mode 100644 lib/Net/HTTP/API/Role/Authentication.pm create mode 100644 lib/Net/HTTP/API/Role/Format.pm create mode 100644 lib/Net/HTTP/API/Role/Request.pm create mode 100644 lib/Net/HTTP/API/Role/Serialization.pm create mode 100644 lib/Net/HTTP/API/Role/UserAgent.pm (limited to 'lib') diff --git a/lib/MooseX/Net/API.pm b/lib/MooseX/Net/API.pm deleted file mode 100644 index d801eb9..0000000 --- a/lib/MooseX/Net/API.pm +++ /dev/null @@ -1,286 +0,0 @@ -package MooseX::Net::API; - -# ABSTRACT: Easily create client for net API - -use Moose; -use Moose::Exporter; - -our $VERSION = '0.11'; - -Moose::Exporter->setup_import_methods( - with_meta => [qw/net_api_method net_api_declare/], - also => [qw/Moose/] -); - -sub net_api_method { - my $meta = shift; - my $name = shift; - $meta->add_net_api_method($name, @_); -} - -sub net_api_declare { - my $meta = shift; - my $name = shift; - $meta->add_net_api_declare($name, @_); -} - -sub init_meta { - my ($class, %options) = @_; - - my $for = $options{for_class}; - 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; -} - -1; - -=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', - ); - - # 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/], - ); - - # 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 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; - - my $obj = My::Net::API->new(); - $obj->api_base_url('http://...'); - $obj->foo(user => $user); - -=head1 DESCRIPTION - -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 does. - -B - -The following roles are added to your class: - -=over 4 - -=item B - -=item B - -=item B - -=item B - -=item B - -=back - -The following attributes are added to your class: - -=over 4 - -=item B - -=item B - -=item B - -=item B - -=item B - -=item B - -=back - -The following methods are added to your class: - -=over 4 - -=item B - -=item B - -=item B - -=item B - -=item B - -=back - -=head2 METHODS - -=over 4 - -=item B - - net_api_declare backtype => ( - base_url => 'http://api....', - format => 'json', - format_mode => 'append', - ); - -=over 2 - -=item B - -The base url for all the API's calls. This will set the B attribut in your class. Can be set at the object creation or before calling an API method. - -=item B - -The format for the API's calls. This will set the B attribut to your class. Value can be: - -=over 2 - -=item B - -=item B - -=item B - -=back - -=item B - -How the format is handled. B will add B<.$format> to the query, B will set the content-type information to the header of the request. Should be one the following value: - -=over 2 - -=item B - -=item B - -=back - -=item B - -A L 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 - -This is a boolean to tell if we must authenticate to use this API. - -=item B - -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 => ( - ... - authentication_method => 'my_auth_method', - ... - ); - - sub my_auth_method { - my ($self, $req) = @_; #$req is an HTTP::Request object - ... - } - -=back - -=item B - -=over 2 - -=item B - -A string to describe the method (this is a documentation) - -=item B - -HTTP method (GET, POST, PUT, DELETE) - -=item B - -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/], - ... - ); - -and you call - - $obj->user_comments(user => 'franck', date => 'today', foo => 1, bar => 2); - -the url generated will look like - - /user/franck/list/today/?foo=1&bar=2 - -=item B - -Arrayref of params. - -=item B - -Arrayref of required params. - -=item B - -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 - -=back diff --git a/lib/MooseX/Net/API/Error.pm b/lib/MooseX/Net/API/Error.pm deleted file mode 100644 index 0bb760a..0000000 --- a/lib/MooseX/Net/API/Error.pm +++ /dev/null @@ -1,43 +0,0 @@ -package MooseX::Net::API::Error; - -# ABSTRACT: Throw error - -use Moose; -use JSON; -use Moose::Util::TypeConstraints; -use overload '""' => \&error; - -subtype error => as 'Str'; -coerce error => from 'HashRef' => via { JSON::encode_json $_}; - -has http_error => ( - is => 'ro', - isa => 'HTTP::Response', - handles => { http_message => 'message', http_code => 'code' } -); -has reason => ( - is => 'ro', - isa => 'error', - predicate => 'has_reason', - coerce => 1 -); - -sub error { - my $self = shift; - return - ( $self->has_reason && $self->reason ) - || ( $self->http_message . ": " . $self->http_code ) - || 'unknown'; -} - -1; - -=head1 SYNOPSIS - - MooseX::Net::API::Error->new(reason => "'useragent' is required"); - -or - - MooseX::Net::API::Error->new() - -=head1 DESCRIPTION diff --git a/lib/MooseX/Net/API/Meta/Class.pm b/lib/MooseX/Net/API/Meta/Class.pm deleted file mode 100644 index ad1b709..0000000 --- a/lib/MooseX/Net/API/Meta/Class.pm +++ /dev/null @@ -1,16 +0,0 @@ -package MooseX::Net::API::Meta::Class; - -# ABSTRACT: metaclass for all API client - -use Moose::Role; - -with qw/ - MooseX::Net::API::Meta::Method::APIMethod - MooseX::Net::API::Meta::Method::APIDeclare - /; - -1; - -=head1 SYNOPSIS - -=head1 DESCRIPTION diff --git a/lib/MooseX/Net/API/Meta/Method.pm b/lib/MooseX/Net/API/Meta/Method.pm deleted file mode 100644 index 8879e04..0000000 --- a/lib/MooseX/Net/API/Meta/Method.pm +++ /dev/null @@ -1,229 +0,0 @@ -package MooseX::Net::API::Meta::Method; - -# ABSTRACT: create api method - -use Moose; -use MooseX::Net::API::Error; -use Moose::Util::TypeConstraints; - -use MooseX::Types::Moose qw/Str Int ArrayRef/; - -extends 'Moose::Meta::Method'; - -subtype UriPath - => as 'Str' - => where { $_ =~ m!^/! } - => message {"path must start with /"}; - -enum Method => qw(HEAD GET POST PUT DELETE); - -has path => (is => 'ro', isa => 'UriPath', required => 1, coerce => 1); -has method => (is => 'ro', isa => 'Method', required => 1); -has description => (is => 'ro', isa => 'Str', predicate => 'has_description'); -has strict => (is => 'ro', isa => 'Bool', default => 1,); -has authentication => ( - is => 'ro', - isa => 'Bool', - predicate => 'has_authentication', - 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_request_parameter => 'first',} -); -has params_in_url => ( - traits => ['Array'], - is => 'ro', - isa => ArrayRef [Str], - required => 0, - default => sub { [] }, - auto_deref => 0, - handles => {find_request_url_parameters => 'first'} -); -has required => ( - traits => ['Array'], - is => 'ro', - isa => ArrayRef [Str], - default => sub { [] }, - auto_deref => 1, - required => 0, -); -has documentation => ( - is => 'ro', - isa => 'Str', - lazy => 1, - default => sub { - my $self = shift; - my $doc; - $doc .= "name: " . $self->name . "\n"; - $doc .= "description: " . $self->description . "\n" - if $self->has_description; - $doc .= "method: " . $self->method . "\n"; - $doc .= "path: " . $self->path . "\n"; - $doc .= "arguments: " . join(', ', $self->params) . "\n" - if $self->params; - $doc .= "required: " . join(', ', $self->required) . "\n" - if $self->required; - $doc; - } -); - -before wrap => sub { - 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"); - } - - 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} }, @{$args{params_in_url}} ); - } - } -}; - -sub wrap { - my ($class, %args) = @_; - - if (!defined $args{body}) { - my $code = sub { - my ($self, %method_args) = @_; - - my $method = $self->meta->find_net_api_method_by_name($args{name}); - - $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_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) = @_; - - return if !$self->strict; - - # check if there is no undeclared param - foreach my $arg (keys %$args) { - if ( !$self->find_request_parameter(sub {/$arg/}) - && !$self->find_request_url_parameters(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/(?:\/((?:\$|\:).*))?$//; - } - } - $path =~ s/(?:\/((?:\$|\:).*))?$//; - 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; - -=head1 SYNOPSIS - -=head1 DESCRIPTION diff --git a/lib/MooseX/Net/API/Meta/Method/APIDeclare.pm b/lib/MooseX/Net/API/Meta/Method/APIDeclare.pm deleted file mode 100644 index 0de38df..0000000 --- a/lib/MooseX/Net/API/Meta/Method/APIDeclare.pm +++ /dev/null @@ -1,57 +0,0 @@ -package MooseX::Net::API::Meta::Method::APIDeclare; - -# ABSTRACT: declare API - -use Moose::Role; -use MooseX::Net::API::Error; - -my @accepted_options = qw/ - api_base_url - api_format - api_format_mode - api_username - api_password - authentication - authentication_method - /; - -has api_options => ( - is => 'ro', - traits => ['Hash'], - isa => 'HashRef[Str|CodeRef]', - default => sub { {} }, - lazy => 1, - handles => { - set_api_option => 'set', - get_api_option => 'get', - }, -); - -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_api_option(useragent => delete $options{useragent}); - } - - # XXX for backward compatibility - for my $attr (qw/base_url format format_mode username password/) { - my $attr_name = "api_" . $attr; - if (exists $options{$attr} && !exists $options{$attr_name}) { - $options{$attr_name} = delete $options{$attr}; - } - } - - for my $attr (@accepted_options) { - $meta->set_api_option($attr => $options{$attr}) if defined $options{$attr}; - } -} - -1; - -=head1 SYNOPSIS - -=head1 DESCRIPTION diff --git a/lib/MooseX/Net/API/Meta/Method/APIMethod.pm b/lib/MooseX/Net/API/Meta/Method/APIMethod.pm deleted file mode 100644 index 0ddcacd..0000000 --- a/lib/MooseX/Net/API/Meta/Method/APIMethod.pm +++ /dev/null @@ -1,115 +0,0 @@ -package MooseX::Net::API::Meta::Method::APIMethod; - -# ABSTRACT: declare API method - -use Moose::Role; -use MooseX::Net::API::Error; -use MooseX::Net::API::Meta::Method; -use MooseX::Types::Moose qw/Str ArrayRef/; - -has local_net_api_methods => ( - traits => ['Array'], - is => 'rw', - isa => ArrayRef [Str], - required => 1, - default => sub { [] }, - auto_deref => 1, - handles => { - _find_net_api_method_by_name => 'first', - _add_net_api_method => 'push', - get_all_net_api_methods => 'elements', - }, -); - -sub find_net_api_method_by_name { - my ($meta, $name) = @_; - my $method_name = $meta->_find_net_api_method_by_name(sub {/^$name$/}); - return unless $method_name; - my $method = $meta->find_method_by_name($method_name); - if ($method->isa('Class::MOP::Method::Wrapped')) { - return $method->get_original_method; - } - else { - return $method; - } -} - -sub remove_net_api_method { - my ($meta, $name) = @_; - my @methods = grep { !/$name/ } $meta->get_all_net_api_methods; - $meta->local_net_api_methods(\@methods); - $meta->remove_method($name); -} - -before add_net_api_method => sub { - my ($meta, $name) = @_; - if ($meta->_find_net_api_method_by_name(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) = @_; - - # XXX 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_net_api_method($name); -} - -after add_net_api_method => sub { - my ($meta, $name) = @_; - $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; - -=head1 SYNOPSIS - - my $api_client = MyAPI->new; - - my @methods = $api_client->meta->get_all_api_methods(); - - my $method = $api_client->meta->find_net_api_method_by_name('users'); - - $api_client->meta->remove_net_api_method($method); - - $api_client->meta->add_net_api_method('users', sub {...}, - description => 'this method does...',); - -=head1 DESCRIPTION - -=method get_all_net_api_methods - -Return a list of net api methods - -=method find_net_api_method_by_name - -Return a net api method - -=method remove_net_api_method - -Remove a net api method - -=method add_net_api_method - -Add a net api method diff --git a/lib/MooseX/Net/API/Parser.pm b/lib/MooseX/Net/API/Parser.pm deleted file mode 100644 index c56a026..0000000 --- a/lib/MooseX/Net/API/Parser.pm +++ /dev/null @@ -1,15 +0,0 @@ -package MooseX::Net::API::Parser; - -# ABSTRACT: base class for all MooseX::Net::API::Parser - -use Moose; - -sub encode {die "must be implemented"} -sub decode {die "must be implemented"} - -1; - -=head1 SYNOPSIS - -=head1 DESCRIPTION - diff --git a/lib/MooseX/Net/API/Parser/JSON.pm b/lib/MooseX/Net/API/Parser/JSON.pm deleted file mode 100644 index 58cc95a..0000000 --- a/lib/MooseX/Net/API/Parser/JSON.pm +++ /dev/null @@ -1,23 +0,0 @@ -package MooseX::Net::API::Parser::JSON; - -# ABSTRACT: Parse 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; - -=head1 SYNOPSIS - -=head1 DESCRIPTION diff --git a/lib/MooseX/Net/API/Parser/XML.pm b/lib/MooseX/Net/API/Parser/XML.pm deleted file mode 100644 index 305d4b4..0000000 --- a/lib/MooseX/Net/API/Parser/XML.pm +++ /dev/null @@ -1,30 +0,0 @@ -package MooseX::Net::API::Parser::XML; - -# ABSTRACT: Parse XML result - -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; - -=head1 SYNOPSIS - -=head1 DESCRIPTION diff --git a/lib/MooseX/Net/API/Parser/YAML.pm b/lib/MooseX/Net/API/Parser/YAML.pm deleted file mode 100644 index 82e6da2..0000000 --- a/lib/MooseX/Net/API/Parser/YAML.pm +++ /dev/null @@ -1,23 +0,0 @@ -package MooseX::Net::API::Parser::YAML; - -# ABSTRACT: Parse 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; - -=head1 SYNOPSIS - -=head1 DESCRIPTION diff --git a/lib/MooseX/Net/API/Role/Authentication.pm b/lib/MooseX/Net/API/Role/Authentication.pm deleted file mode 100644 index 06b7e69..0000000 --- a/lib/MooseX/Net/API/Role/Authentication.pm +++ /dev/null @@ -1,67 +0,0 @@ -package MooseX::Net::API::Role::Authentication; - -# ABSTRACT: Add authentication informations to request header - -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_api_option($_); - $self->$_($value) if $value && !$self->$predicate; - } - - if ( $self->meta->get_api_option('authentication') - || $self->meta->get_api_option('authentication_method')) - { - my $auth_method = $self->meta->get_api_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; - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head2 ATTRIBUTES - -=over 4 - -=item B - -=item B - -=back -64: hit eof while in pod documentation (no =cut seen) - this can cause trouble with some pod utilities diff --git a/lib/MooseX/Net/API/Role/Format.pm b/lib/MooseX/Net/API/Role/Format.pm deleted file mode 100644 index 5c37a47..0000000 --- a/lib/MooseX/Net/API/Role/Format.pm +++ /dev/null @@ -1,65 +0,0 @@ -package MooseX::Net::API::Role::Format; - -# ABSTRACT: Set appropriate format to request header - -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_api_option('api_format'); - } -); - -has api_format_mode => ( - is => 'rw', - isa => 'FormatMode', - lazy => 1, - default => sub { - my $self = shift; - my $mode = $self->meta->get_api_option('api_format_mode') || 'append'; - $mode; - } -); - -1; - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head2 METHODS - -=over 4 - -=item B - -=back - -=head2 ATTRIBUTES - -=over 4 - -=item B - -=item B - -=back diff --git a/lib/MooseX/Net/API/Role/Request.pm b/lib/MooseX/Net/API/Role/Request.pm deleted file mode 100644 index 13221d3..0000000 --- a/lib/MooseX/Net/API/Role/Request.pm +++ /dev/null @@ -1,79 +0,0 @@ -package MooseX::Net::API::Role::Request; - -# ABSTRACT: make HTTP 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_api_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)$/) { - $uri->query_form(%$args); - $request = HTTP::Request->new($method => $uri); - } - elsif ($method =~ /^(?:POST|PUT)$/) { - my $params = {}; - foreach my $key (@$params_in_url) { - $params->{$key} = $args->{$key} if exists $args->{$key}; - } - $uri->query_form(%$params) if $params; - - $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; - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head2 METHODS - -=over 4 - -=item B - -=back - -=head2 ATTRIBUTES - -=over 4 - -=item B - -=back diff --git a/lib/MooseX/Net/API/Role/Serialization.pm b/lib/MooseX/Net/API/Role/Serialization.pm deleted file mode 100644 index 92c0248..0000000 --- a/lib/MooseX/Net/API/Role/Serialization.pm +++ /dev/null @@ -1,104 +0,0 @@ -package MooseX::Net::API::Role::Serialization; - -# ABSTRACT: do (de)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) = @_; - - return undef unless $result->content; - - 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 { $result = $s->decode($content) }; - return $result if $result; - } -} - -sub serialize { - my ($self, $content) = @_; - my $s = $self->_get_serializer($self->api_format) - || $self->_load_serializer(); - 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; - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head2 ATTRIBUTES - -=over 4 - -=item B - -=back - -=head2 METHODS - -=over 4 - -=item B - -=item B - -=item B - -=back -99: hit eof while in pod documentation (no =cut seen) - this can cause trouble with some pod utilities diff --git a/lib/MooseX/Net/API/Role/UserAgent.pm b/lib/MooseX/Net/API/Role/UserAgent.pm deleted file mode 100644 index 3cb9714..0000000 --- a/lib/MooseX/Net/API/Role/UserAgent.pm +++ /dev/null @@ -1,36 +0,0 @@ -package MooseX::Net::API::Role::UserAgent; - -# ABSTRACT: create 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_api_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; - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head2 ATTRIBUTES - -=over 4 - -=item B - -=back diff --git a/lib/Net/HTTP/API.pm b/lib/Net/HTTP/API.pm new file mode 100644 index 0000000..92908bb --- /dev/null +++ b/lib/Net/HTTP/API.pm @@ -0,0 +1,286 @@ +package Net::HTTP::API; + +# ABSTRACT: Easily create client for net API + +use Moose; +use Moose::Exporter; + +our $VERSION = '0.11'; + +Moose::Exporter->setup_import_methods( + with_meta => [qw/net_api_method net_api_declare/], + also => [qw/Moose/] +); + +sub net_api_method { + my $meta = shift; + my $name = shift; + $meta->add_net_api_method($name, @_); +} + +sub net_api_declare { + my $meta = shift; + my $name = shift; + $meta->add_net_api_declare($name, @_); +} + +sub init_meta { + my ($class, %options) = @_; + + my $for = $options{for_class}; + Moose->init_meta(%options); + + my $meta = Moose::Util::MetaRole::apply_metaroles( + for_class => $for, + metaclass_roles => ['Net::HTTP::API::Meta::Class'], + ); + + Moose::Util::MetaRole::apply_base_class_roles( + for => $for, + roles => [ + qw/ + Net::HTTP::API::Role::UserAgent + Net::HTTP::API::Role::Format + Net::HTTP::API::Role::Authentication + Net::HTTP::API::Role::Serialization + Net::HTTP::API::Role::Request + / + ], + ); + + $meta; +} + +1; + +=head1 SYNOPSIS + + package My::Net::API; + use Net::HTTP::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', + ); + + # 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/], + ); + + # 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 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; + + my $obj = My::Net::API->new(); + $obj->api_base_url('http://...'); + $obj->foo(user => $user); + +=head1 DESCRIPTION + +Net::HTTP::API is a module to help to easily create a client for a web API. + +This module is heavily inspired by what L does. + +B + +The following roles are added to your class: + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +The following attributes are added to your class: + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +The following methods are added to your class: + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head2 METHODS + +=over 4 + +=item B + + net_api_declare backtype => ( + base_url => 'http://api....', + format => 'json', + format_mode => 'append', + ); + +=over 2 + +=item B + +The base url for all the API's calls. This will set the B attribut in your class. Can be set at the object creation or before calling an API method. + +=item B + +The format for the API's calls. This will set the B attribut to your class. Value can be: + +=over 2 + +=item B + +=item B + +=item B + +=back + +=item B + +How the format is handled. B will add B<.$format> to the query, B will set the content-type information to the header of the request. Should be one the following value: + +=over 2 + +=item B + +=item B + +=back + +=item B + +A L 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 + +This is a boolean to tell if we must authenticate to use this API. + +=item B + +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 => ( + ... + authentication_method => 'my_auth_method', + ... + ); + + sub my_auth_method { + my ($self, $req) = @_; #$req is an HTTP::Request object + ... + } + +=back + +=item B + +=over 2 + +=item B + +A string to describe the method (this is a documentation) + +=item B + +HTTP method (GET, POST, PUT, DELETE) + +=item B + +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/], + ... + ); + +and you call + + $obj->user_comments(user => 'franck', date => 'today', foo => 1, bar => 2); + +the url generated will look like + + /user/franck/list/today/?foo=1&bar=2 + +=item B + +Arrayref of params. + +=item B + +Arrayref of required params. + +=item B + +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 + +=back diff --git a/lib/Net/HTTP/API/Error.pm b/lib/Net/HTTP/API/Error.pm new file mode 100644 index 0000000..43157b5 --- /dev/null +++ b/lib/Net/HTTP/API/Error.pm @@ -0,0 +1,43 @@ +package Net::HTTP::API::Error; + +# ABSTRACT: Throw error + +use Moose; +use JSON; +use Moose::Util::TypeConstraints; +use overload '""' => \&error; + +subtype error => as 'Str'; +coerce error => from 'HashRef' => via { JSON::encode_json $_}; + +has http_error => ( + is => 'ro', + isa => 'HTTP::Response', + handles => { http_message => 'message', http_code => 'code' } +); +has reason => ( + is => 'ro', + isa => 'error', + predicate => 'has_reason', + coerce => 1 +); + +sub error { + my $self = shift; + return + ( $self->has_reason && $self->reason ) + || ( $self->http_message . ": " . $self->http_code ) + || 'unknown'; +} + +1; + +=head1 SYNOPSIS + + Net::HTTP::API::Error->new(reason => "'useragent' is required"); + +or + + Net::HTTP::API::Error->new() + +=head1 DESCRIPTION diff --git a/lib/Net/HTTP/API/Meta/Class.pm b/lib/Net/HTTP/API/Meta/Class.pm new file mode 100644 index 0000000..8bc8c7b --- /dev/null +++ b/lib/Net/HTTP/API/Meta/Class.pm @@ -0,0 +1,16 @@ +package Net::HTTP::API::Meta::Class; + +# ABSTRACT: metaclass for all API client + +use Moose::Role; + +with qw/ + Net::HTTP::API::Meta::Method::APIMethod + Net::HTTP::API::Meta::Method::APIDeclare + /; + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION diff --git a/lib/Net/HTTP/API/Meta/Method.pm b/lib/Net/HTTP/API/Meta/Method.pm new file mode 100644 index 0000000..adda12c --- /dev/null +++ b/lib/Net/HTTP/API/Meta/Method.pm @@ -0,0 +1,230 @@ +package Net::HTTP::API::Meta::Method; + +# ABSTRACT: create api method + +use Moose; +use Net::HTTP::API::Error; +use Moose::Util::TypeConstraints; + +use MooseX::Types::Moose qw/Str Int ArrayRef/; + +extends 'Moose::Meta::Method'; + +subtype UriPath + => as 'Str' + => where { $_ =~ m!^/! } + => message {"path must start with /"}; + +enum Method => qw(HEAD GET POST PUT DELETE); + +has path => (is => 'ro', isa => 'UriPath', required => 1, coerce => 1); +has method => (is => 'ro', isa => 'Method', required => 1); +has description => (is => 'ro', isa => 'Str', predicate => 'has_description'); +has strict => (is => 'ro', isa => 'Bool', default => 1,); +has authentication => ( + is => 'ro', + isa => 'Bool', + predicate => 'has_authentication', + 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_request_parameter => 'first',} +); +has params_in_url => ( + traits => ['Array'], + is => 'ro', + isa => ArrayRef [Str], + required => 0, + default => sub { [] }, + auto_deref => 0, + handles => {find_request_url_parameters => 'first'} +); +has required => ( + traits => ['Array'], + is => 'ro', + isa => ArrayRef [Str], + default => sub { [] }, + auto_deref => 1, + required => 0, +); +has documentation => ( + is => 'ro', + isa => 'Str', + lazy => 1, + default => sub { + my $self = shift; + my $doc; + $doc .= "name: " . $self->name . "\n"; + $doc .= "description: " . $self->description . "\n" + if $self->has_description; + $doc .= "method: " . $self->method . "\n"; + $doc .= "path: " . $self->path . "\n"; + $doc .= "arguments: " . join(', ', $self->params) . "\n" + if $self->params; + $doc .= "required: " . join(', ', $self->required) . "\n" + if $self->required; + $doc; + } +); + +before wrap => sub { + my ($class, %args) = @_; + + if (!$args{params} && $args{required}) { + die Net::HTTP::API::Error->new( + reason => "You can't require a param that have not been declared"); + } + + if ( $args{required} ) { + foreach my $required ( @{ $args{required} } ) { + die Net::HTTP::API::Error->new( reason => + "$required is required but is not declared in params" ) + if ( !grep { $_ eq $required } @{ $args{params} }, @{$args{params_in_url}} ); + } + } +}; + +sub wrap { + my ($class, %args) = @_; + + if (!defined $args{body}) { + my $code = sub { + my ($self, %method_args) = @_; + + my $method = $self->meta->find_net_api_method_by_name($args{name}); + + $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 Net::HTTP::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 Net::HTTP::API::Error->new( + http_error => $result, + reason => $result->message, + ); + }; + $args{body} = $code; + } + + $class->SUPER::wrap(%args); +} + +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) = @_; + + return if !$self->strict; + + # check if there is no undeclared param + foreach my $arg (keys %$args) { + if ( !$self->find_request_parameter(sub {/$arg/}) + && !$self->find_request_url_parameters(sub {/$arg/})) + { + die Net::HTTP::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 Net::HTTP::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/\/(?:(\$|\:).*)?$//; + } + } + $path =~ s/\/(?:(\$|\:).*)?$//; + 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; + +=head1 SYNOPSIS + +=head1 DESCRIPTION + diff --git a/lib/Net/HTTP/API/Meta/Method/APIDeclare.pm b/lib/Net/HTTP/API/Meta/Method/APIDeclare.pm new file mode 100644 index 0000000..8718eaa --- /dev/null +++ b/lib/Net/HTTP/API/Meta/Method/APIDeclare.pm @@ -0,0 +1,57 @@ +package Net::HTTP::API::Meta::Method::APIDeclare; + +# ABSTRACT: declare API + +use Moose::Role; +use Net::HTTP::API::Error; + +my @accepted_options = qw/ + api_base_url + api_format + api_format_mode + api_username + api_password + authentication + authentication_method + /; + +has api_options => ( + is => 'ro', + traits => ['Hash'], + isa => 'HashRef[Str|CodeRef]', + default => sub { {} }, + lazy => 1, + handles => { + set_api_option => 'set', + get_api_option => 'get', + }, +); + +sub add_net_api_declare { + my ($meta, $name, %options) = @_; + + if ($options{useragent}) { + die Net::HTTP::API::Error->new( + reason => "'useragent' must be a CODE ref") + unless ref $options{useragent} eq 'CODE'; + $meta->set_api_option(useragent => delete $options{useragent}); + } + + # XXX for backward compatibility + for my $attr (qw/base_url format format_mode username password/) { + my $attr_name = "api_" . $attr; + if (exists $options{$attr} && !exists $options{$attr_name}) { + $options{$attr_name} = delete $options{$attr}; + } + } + + for my $attr (@accepted_options) { + $meta->set_api_option($attr => $options{$attr}) if defined $options{$attr}; + } +} + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION diff --git a/lib/Net/HTTP/API/Meta/Method/APIMethod.pm b/lib/Net/HTTP/API/Meta/Method/APIMethod.pm new file mode 100644 index 0000000..8303770 --- /dev/null +++ b/lib/Net/HTTP/API/Meta/Method/APIMethod.pm @@ -0,0 +1,115 @@ +package Net::HTTP::API::Meta::Method::APIMethod; + +# ABSTRACT: declare API method + +use Moose::Role; +use Net::HTTP::API::Error; +use Net::HTTP::API::Meta::Method; +use MooseX::Types::Moose qw/Str ArrayRef/; + +has local_net_api_methods => ( + traits => ['Array'], + is => 'rw', + isa => ArrayRef [Str], + required => 1, + default => sub { [] }, + auto_deref => 1, + handles => { + _find_net_api_method_by_name => 'first', + _add_net_api_method => 'push', + get_all_net_api_methods => 'elements', + }, +); + +sub find_net_api_method_by_name { + my ($meta, $name) = @_; + my $method_name = $meta->_find_net_api_method_by_name(sub {/^$name$/}); + return unless $method_name; + my $method = $meta->find_method_by_name($method_name); + if ($method->isa('Class::MOP::Method::Wrapped')) { + return $method->get_original_method; + } + else { + return $method; + } +} + +sub remove_net_api_method { + my ($meta, $name) = @_; + my @methods = grep { !/$name/ } $meta->get_all_net_api_methods; + $meta->local_net_api_methods(\@methods); + $meta->remove_method($name); +} + +before add_net_api_method => sub { + my ($meta, $name) = @_; + if ($meta->_find_net_api_method_by_name(sub {/^$name$/})) { + die Net::HTTP::API::Error->new( + reason => "method '$name' is already declared in " . $meta->name); + } +}; + +sub add_net_api_method { + my ($meta, $name, %options) = @_; + + # XXX accept blessed method ? + + my $code = delete $options{code}; + + $meta->add_method( + $name, + Net::HTTP::API::Meta::Method->wrap( + name => $name, + package_name => $meta->name, + body => $code, + %options + ), + ); + $meta->_add_net_api_method($name); +} + +after add_net_api_method => sub { + my ($meta, $name) = @_; + $meta->add_before_method_modifier( + $name, + sub { + my $self = shift; + die Net::HTTP::API::Error->new( + reason => "'api_base_url' have not been defined") + unless $self->api_base_url; + } + ); +}; + +1; + +=head1 SYNOPSIS + + my $api_client = MyAPI->new; + + my @methods = $api_client->meta->get_all_api_methods(); + + my $method = $api_client->meta->find_net_api_method_by_name('users'); + + $api_client->meta->remove_net_api_method($method); + + $api_client->meta->add_net_api_method('users', sub {...}, + description => 'this method does...',); + +=head1 DESCRIPTION + +=method get_all_net_api_methods + +Return a list of net api methods + +=method find_net_api_method_by_name + +Return a net api method + +=method remove_net_api_method + +Remove a net api method + +=method add_net_api_method + +Add a net api method diff --git a/lib/Net/HTTP/API/Parser.pm b/lib/Net/HTTP/API/Parser.pm new file mode 100644 index 0000000..b77095b --- /dev/null +++ b/lib/Net/HTTP/API/Parser.pm @@ -0,0 +1,15 @@ +package Net::HTTP::API::Parser; + +# ABSTRACT: base class for all Net::HTTP::API::Parser + +use Moose; + +sub encode {die "must be implemented"} +sub decode {die "must be implemented"} + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION + diff --git a/lib/Net/HTTP/API/Parser/JSON.pm b/lib/Net/HTTP/API/Parser/JSON.pm new file mode 100644 index 0000000..be8b30e --- /dev/null +++ b/lib/Net/HTTP/API/Parser/JSON.pm @@ -0,0 +1,23 @@ +package Net::HTTP::API::Parser::JSON; + +# ABSTRACT: Parse JSON + +use JSON; +use Moose; +extends 'Net::HTTP::API::Parser'; + +sub encode { + my ($self, $content) = @_; + return JSON::encode_json($content); +} + +sub decode { + my ($self, $content) = @_; + return JSON::decode_json($content); +} + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION diff --git a/lib/Net/HTTP/API/Parser/XML.pm b/lib/Net/HTTP/API/Parser/XML.pm new file mode 100644 index 0000000..aaedfcd --- /dev/null +++ b/lib/Net/HTTP/API/Parser/XML.pm @@ -0,0 +1,30 @@ +package Net::HTTP::API::Parser::XML; + +# ABSTRACT: Parse XML result + +use XML::Simple; +use Moose; +extends 'Net::HTTP::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; + +=head1 SYNOPSIS + +=head1 DESCRIPTION diff --git a/lib/Net/HTTP/API/Parser/YAML.pm b/lib/Net/HTTP/API/Parser/YAML.pm new file mode 100644 index 0000000..f18593a --- /dev/null +++ b/lib/Net/HTTP/API/Parser/YAML.pm @@ -0,0 +1,23 @@ +package Net::HTTP::API::Parser::YAML; + +# ABSTRACT: Parse YAML + +use YAML::Syck; +use Moose; +extends 'Net::HTTP::API::Parser'; + +sub encode { + my ($self, $content) = @_; + return Dump($content); +} + +sub decode { + my ($self, $content) = @_; + return Load($content); +} + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION diff --git a/lib/Net/HTTP/API/Role/Authentication.pm b/lib/Net/HTTP/API/Role/Authentication.pm new file mode 100644 index 0000000..27728c3 --- /dev/null +++ b/lib/Net/HTTP/API/Role/Authentication.pm @@ -0,0 +1,67 @@ +package Net::HTTP::API::Role::Authentication; + +# ABSTRACT: Add authentication informations to request header + +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_api_option($_); + $self->$_($value) if $value && !$self->$predicate; + } + + if ( $self->meta->get_api_option('authentication') + || $self->meta->get_api_option('authentication_method')) + { + my $auth_method = $self->meta->get_api_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; + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 ATTRIBUTES + +=over 4 + +=item B + +=item B + +=back +64: hit eof while in pod documentation (no =cut seen) + this can cause trouble with some pod utilities diff --git a/lib/Net/HTTP/API/Role/Format.pm b/lib/Net/HTTP/API/Role/Format.pm new file mode 100644 index 0000000..1d8c10f --- /dev/null +++ b/lib/Net/HTTP/API/Role/Format.pm @@ -0,0 +1,65 @@ +package Net::HTTP::API::Role::Format; + +# ABSTRACT: Set appropriate format to request header + +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_api_option('api_format'); + } +); + +has api_format_mode => ( + is => 'rw', + isa => 'FormatMode', + lazy => 1, + default => sub { + my $self = shift; + my $mode = $self->meta->get_api_option('api_format_mode') || 'append'; + $mode; + } +); + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 METHODS + +=over 4 + +=item B + +=back + +=head2 ATTRIBUTES + +=over 4 + +=item B + +=item B + +=back diff --git a/lib/Net/HTTP/API/Role/Request.pm b/lib/Net/HTTP/API/Role/Request.pm new file mode 100644 index 0000000..c972b77 --- /dev/null +++ b/lib/Net/HTTP/API/Role/Request.pm @@ -0,0 +1,79 @@ +package Net::HTTP::API::Role::Request; + +# ABSTRACT: make HTTP request + +use Moose::Role; +use HTTP::Request; +use Net::HTTP::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_api_option('api_base_url'); + if (!$api_base_url) { + die Net::HTTP::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)$/) { + $uri->query_form(%$args); + $request = HTTP::Request->new($method => $uri); + } + elsif ($method =~ /^(?:POST|PUT)$/) { + my $params = {}; + foreach my $key (@$params_in_url) { + $params->{$key} = $args->{$key} if exists $args->{$key}; + } + $uri->query_form(%$params) if $params; + + $request = HTTP::Request->new($method => $uri); + my $content = $self->serialize($args); + $request->content($content); + } + else { + die Net::HTTP::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; + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 METHODS + +=over 4 + +=item B + +=back + +=head2 ATTRIBUTES + +=over 4 + +=item B + +=back diff --git a/lib/Net/HTTP/API/Role/Serialization.pm b/lib/Net/HTTP/API/Role/Serialization.pm new file mode 100644 index 0000000..37d2603 --- /dev/null +++ b/lib/Net/HTTP/API/Role/Serialization.pm @@ -0,0 +1,104 @@ +package Net::HTTP::API::Role::Serialization; + +# ABSTRACT: do (de)serialization + +use 5.010; + +use Try::Tiny; +use Moose::Role; +use Net::HTTP::API::Error; + +has serializers => ( + traits => ['Hash'], + is => 'rw', + isa => 'HashRef[Net::HTTP::API::Parser]', + default => sub { {} }, + auto_deref => 1, + handles => { + _add_serializer => 'set', + _get_serializer => 'get', + }, +); + +sub get_content { + my ($self, $result) = @_; + + return undef unless $result->content; + + 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 Net::HTTP::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 { $result = $s->decode($content) }; + return $result if $result; + } +} + +sub serialize { + my ($self, $content) = @_; + my $s = $self->_get_serializer($self->api_format) + || $self->_load_serializer(); + my $result = try { $s->encode($content) }; + return $result if $result; +} + +sub _load_serializer { + my $self = shift; + my $format = shift || $self->api_format; + my $parser = "Net::HTTP::API::Parser::" . uc($format); + if (Class::MOP::load_class($parser)) { + my $o = $parser->new; + $self->_add_serializer($format => $o); + return $o; + } +} + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 ATTRIBUTES + +=over 4 + +=item B + +=back + +=head2 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=back +99: hit eof while in pod documentation (no =cut seen) + this can cause trouble with some pod utilities diff --git a/lib/Net/HTTP/API/Role/UserAgent.pm b/lib/Net/HTTP/API/Role/UserAgent.pm new file mode 100644 index 0000000..84f618d --- /dev/null +++ b/lib/Net/HTTP/API/Role/UserAgent.pm @@ -0,0 +1,36 @@ +package Net::HTTP::API::Role::UserAgent; + +# ABSTRACT: create 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_api_option('useragent'); + return $ua->() if $ua; + $ua = LWP::UserAgent->new(); + $ua->agent( + "Net::HTTP::API " . $Net::HTTP::API::VERSION . " (Perl)"); + $ua->env_proxy; + return $ua; + } +); + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 ATTRIBUTES + +=over 4 + +=item B + +=back -- cgit v1.2.3