diff options
author | franck cuny <franck@lumberjaph.net> | 2010-07-16 16:10:41 +0200 |
---|---|---|
committer | franck cuny <franck@lumberjaph.net> | 2010-07-16 16:10:41 +0200 |
commit | e97449eaa8bd3a408763057f9ca2253d93e2a3d0 (patch) | |
tree | 4fd0dc6ed899efe361e314adfc913b9aa6b0a1a4 /lib/Net/HTTP/API/Role | |
parent | check if auth_method is declared (diff) | |
download | net-http-api-e97449eaa8bd3a408763057f9ca2253d93e2a3d0.tar.gz |
rename from mx::net::api to net::http::api
Diffstat (limited to 'lib/Net/HTTP/API/Role')
-rw-r--r-- | lib/Net/HTTP/API/Role/Authentication.pm | 67 | ||||
-rw-r--r-- | lib/Net/HTTP/API/Role/Format.pm | 65 | ||||
-rw-r--r-- | lib/Net/HTTP/API/Role/Request.pm | 79 | ||||
-rw-r--r-- | lib/Net/HTTP/API/Role/Serialization.pm | 104 | ||||
-rw-r--r-- | lib/Net/HTTP/API/Role/UserAgent.pm | 36 |
5 files changed, 351 insertions, 0 deletions
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<api_password> + +=item B<api_username> + +=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<content_type> + +=back + +=head2 ATTRIBUTES + +=over 4 + +=item B<api_format> + +=item B<api_format_mode> + +=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<http_request> + +=back + +=head2 ATTRIBUTES + +=over 4 + +=item B<api_base_url> + +=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<serializers> + +=back + +=head2 METHODS + +=over 4 + +=item B<get_content> + +=item B<serialize> + +=item B<deserialize> + +=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<api_useragent> + +=back |