diff options
Diffstat (limited to 'lib/Net')
| -rw-r--r-- | lib/Net/HTTP/Spore/Meta.pm | 1 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Meta/Class.pm | 2 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Meta/Method.pm | 34 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Meta/Method/Spore.pm | 6 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm | 7 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Middleware/FileUpload.pm | 12 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Middleware/ParanoidAgent.pm | 13 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Middleware/Redirection.pm | 44 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Request.pm | 270 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Response.pm | 2 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Role/Debug.pm | 14 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Role/Request.pm | 33 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Role/UserAgent.pm | 1 |
13 files changed, 375 insertions, 64 deletions
diff --git a/lib/Net/HTTP/Spore/Meta.pm b/lib/Net/HTTP/Spore/Meta.pm index ec773b6..14b4266 100644 --- a/lib/Net/HTTP/Spore/Meta.pm +++ b/lib/Net/HTTP/Spore/Meta.pm @@ -36,6 +36,7 @@ sub init_meta { for => $for, roles => [ qw/ + Net::HTTP::Spore::Role::Debug Net::HTTP::Spore::Role::Description Net::HTTP::Spore::Role::UserAgent Net::HTTP::Spore::Role::Request diff --git a/lib/Net/HTTP/Spore/Meta/Class.pm b/lib/Net/HTTP/Spore/Meta/Class.pm index 4ddd5c6..7571305 100644 --- a/lib/Net/HTTP/Spore/Meta/Class.pm +++ b/lib/Net/HTTP/Spore/Meta/Class.pm @@ -4,7 +4,7 @@ package Net::HTTP::Spore::Meta::Class; use Moose::Role; -with qw/Net::HTTP::Spore::Meta::Method::Spore/; +with qw/Net::HTTP::Spore::Meta::Method::Spore Net::HTTP::Spore::Role::Debug/; 1; diff --git a/lib/Net/HTTP/Spore/Meta/Method.pm b/lib/Net/HTTP/Spore/Meta/Method.pm index 4353b55..db990ff 100644 --- a/lib/Net/HTTP/Spore/Meta/Method.pm +++ b/lib/Net/HTTP/Spore/Meta/Method.pm @@ -76,6 +76,11 @@ has formats => ( isa => ArrayRef [Str], predicate => 'has_formats', ); +has headers => ( + is => 'ro', + isa => HashRef [Str], + predicate => 'has_headers', +); has expected_status => ( traits => ['Array'], is => 'ro', @@ -195,19 +200,24 @@ sub wrap { ? '' : $base_url->path ), - PATH_INFO => $method->path, - REQUEST_URI => '', - QUERY_STRING => '', - HTTP_USER_AGENT => $self->api_useragent->agent, - 'spore.expected_status' => [ $method->expected_status ], - 'spore.authentication' => $authentication, - 'spore.params' => $params, - 'spore.payload' => $payload, - 'spore.errors' => *STDERR, - 'spore.url_scheme' => $base_url->scheme, + PATH_INFO => $method->path, + REQUEST_URI => '', + QUERY_STRING => '', + HTTP_USER_AGENT => $self->api_useragent->agent, + 'spore.expected_status' => [ $method->expected_status ], + 'spore.authentication' => $authentication, + 'spore.params' => $params, + 'spore.payload' => $payload, + 'spore.errors' => *STDERR, + 'spore.url_scheme' => $base_url->scheme, 'spore.formats' => $formats, }; + $env->{'spore.form_data'} = $method->form_data + if $method->has_form_data; + + $env->{'spore.headers'} = $method->headers if $method->has_headers; + my $response = $self->http_request($env); my $code = $response->status; @@ -218,6 +228,10 @@ sub wrap { }; $args{body} = $code; + if ($args{'form-data'}){ + $args{'form_data'} = delete $args{'form-data'}; + } + $class->SUPER::wrap(%args); } diff --git a/lib/Net/HTTP/Spore/Meta/Method/Spore.pm b/lib/Net/HTTP/Spore/Meta/Method/Spore.pm index 1cea574..b61e2de 100644 --- a/lib/Net/HTTP/Spore/Meta/Method/Spore.pm +++ b/lib/Net/HTTP/Spore/Meta/Method/Spore.pm @@ -54,6 +54,12 @@ sub add_spore_method { my $code = delete $options{code}; +# $meta->_trace_msg( '-> attach ' +# . $name . ' (' +# . $options{method} . ' => ' +# . $options{path} +# . ')' ); + $meta->add_method( $name, Net::HTTP::Spore::Meta::Method->wrap( diff --git a/lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm b/lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm index 3fb5bf0..524205d 100644 --- a/lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm +++ b/lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm @@ -44,6 +44,9 @@ sub call { =head1 SYNOPSIS my $client = Net::HTTP::Spore->new_from_spec('twitter.json'); + + $client->enable('Format::JSON'); + $client->enable( 'Auth::OAuth', consumer_key => 'xxx', @@ -52,6 +55,10 @@ sub call { token_secret => '456' ); + print $client->friends_timeline( + format => 'json' + )->body->[0]->{text}; + =head1 DESCRIPTION Net::HTTP::Spore::Middleware::Auth::OAuth is a middleware to handle OAuth mechanism. This middleware should be loaded as the last middleware, because it requires all parameters to be setted to calculate the signature. diff --git a/lib/Net/HTTP/Spore/Middleware/FileUpload.pm b/lib/Net/HTTP/Spore/Middleware/FileUpload.pm new file mode 100644 index 0000000..6677e54 --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/FileUpload.pm @@ -0,0 +1,12 @@ +package Net::HTTP::Spore::Middleware::FileUpload; + +use Moose; +extends 'Net::HTTP::Spore::Middleware'; + +use LWP::MediaTypes qw/read_media_types/; + +sub call { + my ($self, $request) = @_; +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/ParanoidAgent.pm b/lib/Net/HTTP/Spore/Middleware/ParanoidAgent.pm new file mode 100644 index 0000000..c1cce0c --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/ParanoidAgent.pm @@ -0,0 +1,13 @@ +package Net::HTTP::Spore::Middleware::ParanoidAgent; + +use Moose; +extends 'Net::HTTP::Spore::Middleware'; + +has black_list => (); +has white_list => (); + +sub call { + my ($self, $request) = @_; +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Redirection.pm b/lib/Net/HTTP/Spore/Middleware/Redirection.pm new file mode 100644 index 0000000..07046d8 --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Redirection.pm @@ -0,0 +1,44 @@ +package Net::HTTP::Spore::Middleware::Redirection; + +use Moose; + +extends 'Net::HTTP::Spore::Middleware'; + +with 'Net::HTTP::Spore::Role::Request', 'Net::HTTP::Spore::Role::UserAgent'; + +has max_redirect => ( is => 'rw', isa => 'Int', lazy => 1, default => 5 ); + +sub call { + my ( $self, $req ) = @_; + + my $nredirect = 0; + + return $self->response_cb( + sub { + my $res = shift; + while ( $nredirect < $self->max_redirect ) { + my $location = $res->header('location'); + my $status = $res->status; + if ( + $location + and ( $status == 301 + or $status == 302 + or $status == 303 + or $status == 307 ) + ) + { + my $uri = URI->new($location); + $req->env->{HTTP_HOST} = $uri->host; + $req->env->{PATH_INFO} = $uri->path; + $res = $self->_request($req); + $nredirect++; + }else{ + last; + } + } + return $res; + } + ); +} + +1; diff --git a/lib/Net/HTTP/Spore/Request.pm b/lib/Net/HTTP/Spore/Request.pm index 267ec0b..8604f35 100644 --- a/lib/Net/HTTP/Spore/Request.pm +++ b/lib/Net/HTTP/Spore/Request.pm @@ -2,44 +2,179 @@ package Net::HTTP::Spore::Request; # ABSTRACT: Net::HTTP::Spore::Request - Portable HTTP request object from SPORE env hash -use strict; -use warnings; - +use Moose; use Carp (); use URI; use HTTP::Headers; use HTTP::Request; use URI::Escape; -use Hash::MultiValue; - +use MIME::Base64; use Net::HTTP::Spore::Response; -sub new { - my ( $class, $env ) = @_; +has env => ( + is => 'rw', + isa => 'HashRef', + required => 1, + traits => ['Hash'], + handles => { + set_to_env => 'set', + get_from_env => 'get', + } +); + +has path => ( + is => 'rw', + isa => 'Str', + lazy => 1, + default => sub { $_[0]->path_info } +); + +has headers => ( + is => 'rw', + isa => 'HTTP::Headers', + lazy => 1, + handles => { + header => 'header', + }, + default => sub { + my $self = shift; + my $env = $self->env; + my $h = HTTP::Headers->new( + map { + ( my $field = $_ ) =~ s/^HTTPS?_//; + ( $field => $env->{$_} ); + } grep { /^(?:HTTP|CONTENT)/i } keys %$env + ); + return $h; + }, +); + +sub BUILDARGS { + my $class = shift; + + if (@_ == 1 && !exists $_[0]->{env}) { + return {env => $_[0]}; + } + return @_; +} + +sub method { + my ( $self, $value ) = @_; + if ($value) { + $self->set_to_env( 'REQUEST_METHOD', $value ); + } + else { + return $self->get_from_env('REQUEST_METHOD'); + } +} + +sub port { + my ( $self, $value ) = @_; + if ($value) { + $self->set_to_env( 'SERVER_PORT', $value ); + } + else { + return $self->get_from_env('SERVER_PORT'); + } +} + +sub script_name { + my ( $self, $value ) = @_; + if ($value) { + $self->set_to_env( 'SCRIPT_NAME', $value ); + } + else { + return $self->get_from_env('SCRIPT_NAME'); + } +} + +sub request_uri { + my ($self, $value) = @_; + if ($value) { + $self->set_to_env( 'REQUEST_URI', $value ); + } + else { + return $self->get_from_env('REQUEST_URI'); + } +} + +sub scheme { + my ($self, $value) = @_; + if ($value) { + $self->set_to_env( 'spore.scheme', $value ); + } + else { + return $self->get_from_env('spore.scheme'); + } +} + +sub logger { + my ($self, $value) = @_; + if ($value) { + $self->set_to_env( 'sporex.logger', $value ); + } + else { + return $self->get_from_env('sporex.logger'); + } +} + +sub body { + my ($self, $value) = @_; + if ($value) { + $self->set_to_env( 'spore.payload', $value ); + } + else { + return $self->get_from_env('spore.payload'); + } +} + +sub input { (shift)->body(@_) } +sub content { (shift)->body(@_) } +sub secure { $_[0]->scheme eq 'https' } + +# stolen from HTTP::Request::Common +sub _boundary { + my ( $self, $size ) = @_; + + return "xYzZy" unless $size; - Carp::croak('$env is required') unless defined $env && ref($env) eq 'HASH'; - bless { env => $env }, $class; + my $b = + MIME::Base64::encode( join( "", map chr( rand(256) ), 1 .. $size * 3 ), + "" ); + $b =~ s/[\W]/X/g; + return $b; } -sub env { $_[0]->{env} } -sub method { $_[0]->{env}->{REQUEST_METHOD} } -sub port { $_[0]->{env}->{SERVER_PORT} } -sub script_name { $_[0]->{env}->{SCRIPT_NAME} } -sub path { $_[0]->path_info } -sub request_uri { $_[0]->{env}->{REQUEST_URI} } -sub scheme { $_[0]->{env}->{'spore.scheme'} } -sub logger { $_[0]->{env}->{'sporex.logger'} } -sub secure { $_[0]->scheme eq 'https' } -sub content { $_[0]->{env}->{'spore.payload'} } -sub body { $_[0]->{env}->{'spore.payload'} } -sub input { $_[0]->{env}->{'spore.payload'} } +sub _form_data { + my ( $self, $data ) = @_; + + my $form_data; + foreach my $k ( keys %$data ) { + push @$form_data, + 'Content-Disposition: form-data; name="' + . $k + . '"'."\r\n\r\n" + . $data->{$k}; + } + + my $b = $self->_boundary(10); + my $t = []; + foreach (@$form_data) { + push @$t, '--', $b, "\r\n", $_, "\r\n"; + } + push @$t, '--', $b, , '--', "\r\n"; + my $content = join("", @$t); + return ($content, $b); +} +# TODO sub path_info { my $self = shift; my ($path) = $self->_path; $path; } +# TODO sub _path { my $self = shift; @@ -65,28 +200,14 @@ sub _path { return ( $path, $query_string ); } +# TODO sub query_string { my $self = shift; my ( undef, $query_string ) = $self->_path; $query_string; } -sub headers { - my $self = shift; - if ( !defined $self->{headers} ) { - my $env = $self->env; - $self->{headers} = HTTP::Headers->new( - map { - ( my $field = $_ ) =~ s/^HTTPS?_//; - ( $field => $env->{$_} ); - } grep { /^(?:HTTP|CONTENT)/i } keys %$env - ); - } - $self->{headers}; -} - -sub header {shift->headers->header(@_)} - +# TODO sub uri { my $self = shift; @@ -113,16 +234,18 @@ sub uri { return URI->new( $base . $path )->canonical; } -# retourner les query parameters ? vu qu'on a pas encore peuple l'url, on gere comment ? +# TODO retourner les query parameters ? vu qu'on a pas encore peuple l'url, on gere comment ? sub query_parameters { my $self = shift; } +# TODO sub base { my $self = shift; URI->new( $self->_uri_base )->canonical; } +# TODO sub _uri_base { my $self = shift; my $env = $self->env; @@ -147,18 +270,75 @@ sub new_response { sub finalize { my $self = shift; - my ($path_info, $query_string) = $self->_path; + my $path_info = $self->env->{PATH_INFO}; + + my $form_data = $self->env->{'spore.form_data'}; + my $headers = $self->env->{'spore.headers'}; + my $params = $self->env->{'spore.params'} || []; + + my $query = []; + my $form = {}; + + for ( my $i = 0 ; $i < scalar @$params ; $i++ ) { + my $k = $params->[$i]; + my $v = $params->[++$i]; + my $modified = 0; + + if ($path_info =~ s/\:$k/$v/) { + $modified++; + } + + foreach my $f_k (keys %$form_data) { + my $f_v = $form_data->{$f_k}; + if ($f_v =~ s/^\:$k/$v/) { + $form->{$f_k} = $f_v; + $modified++; + } + } + + foreach my $h_k (keys %$headers) { + my $h_v = $headers->{$h_k}; + if ($h_v =~ s/^\:$k/$v/) { + $self->header($h_k => $h_v); + $modified++; + } + } - $self->env->{PATH_INFO} = $path_info; - $self->env->{QUERY_STRING} = $query_string || ''; + if ($modified == 0) { + push @$query, $k.'='.$v; + } + } + + my $query_string; + if (scalar @$query) { + $query_string = join('&', @$query); + } + + $self->env->{PATH_INFO} = $path_info; + $self->env->{QUERY_STRING} = $query_string; my $uri = $self->uri($path_info, $query_string || ''); + + my $request = HTTP::Request->new( + $self->method => $uri, $self->headers + ); + + if ( keys %$form_data ) { + $self->env->{'spore.form_data'} = $form; + my ( $content, $b ) = $self->_form_data($form); + $request->content($content); + $request->header('Content-Length' => length($content)); + $request->header( + 'Content-Type' => 'multipart/form-data; boundary=' . $b ); + } - my $request = - HTTP::Request->new( $self->method => $uri, $self->headers ); + if ( my $payload = $self->content ) { + $request->content($payload); + $request->header( + 'Content-Type' => 'application/x-www-form-urlencoded' ); + } - $request->content($self->content) if ($self->content); - $request; + return $request; } 1; diff --git a/lib/Net/HTTP/Spore/Response.pm b/lib/Net/HTTP/Spore/Response.pm index 03ab2e7..b667332 100644 --- a/lib/Net/HTTP/Spore/Response.pm +++ b/lib/Net/HTTP/Spore/Response.pm @@ -5,7 +5,7 @@ package Net::HTTP::Spore::Response; use strict; use warnings; -use overload '@{}' => \&finalize; +use overload '@{}' => \&finalize, fallback => 1; use HTTP::Headers; diff --git a/lib/Net/HTTP/Spore/Role/Debug.pm b/lib/Net/HTTP/Spore/Role/Debug.pm new file mode 100644 index 0000000..772373a --- /dev/null +++ b/lib/Net/HTTP/Spore/Role/Debug.pm @@ -0,0 +1,14 @@ +package Net::HTTP::Spore::Role::Debug; + +use Moose::Role; + +has trace => ( + is => 'rw', + isa => 'Bool', + lazy => 1, + default => sub { $ENV{SPORE_TRACE} ? 1 : 0; } +); + +sub _trace_msg { print STDOUT $_[1]."\n" if $_[0]->trace; } + +1; diff --git a/lib/Net/HTTP/Spore/Role/Request.pm b/lib/Net/HTTP/Spore/Role/Request.pm index ddd52e6..a0d61b1 100644 --- a/lib/Net/HTTP/Spore/Role/Request.pm +++ b/lib/Net/HTTP/Spore/Role/Request.pm @@ -33,22 +33,41 @@ sub http_request { } } - if (defined $response) { - map { $_->($response) } reverse @middlewares; - return $response; + return + $self->_execute_middlewares_on_response( $response, @middlewares ) + if defined $response; + + $response = $self->_request($request); + + return $self->_execute_middlewares_on_response( $response, @middlewares ); +} + +sub _execute_middlewares_on_response { + my ($self, $response, @middlewares) = @_; + + foreach my $mw ( reverse @middlewares ) { + my $res = $mw->($response); + $response = $res + if ( defined $res + && Scalar::Util::blessed($res) + && $res->isa('Net::HTTP::Spore::Response') ); } + $response; +} + +sub _request { + my ($self, $request) = @_; + my $result = $self->request($request->finalize); - $response = $request->new_response( + my $response = $request->new_response( $result->code, $result->headers, $result->content, ); - map { $_->($response) } reverse @middlewares; - - $response; + return $response; } 1; diff --git a/lib/Net/HTTP/Spore/Role/UserAgent.pm b/lib/Net/HTTP/Spore/Role/UserAgent.pm index 6bfaa5a..9b99ab8 100644 --- a/lib/Net/HTTP/Spore/Role/UserAgent.pm +++ b/lib/Net/HTTP/Spore/Role/UserAgent.pm @@ -15,6 +15,7 @@ has api_useragent => ( my $ua = LWP::UserAgent->new(); $ua->agent( "Net::HTTP::Spore v" . $Net::HTTP::Spore::VERSION . " (Perl)" ); $ua->env_proxy; + $ua->max_redirect(0); return $ua; } ); |