diff options
author | franck cuny <franck@lumberjaph.net> | 2010-09-13 13:31:56 +0200 |
---|---|---|
committer | franck cuny <franck@lumberjaph.net> | 2010-09-13 13:31:56 +0200 |
commit | 3e3dc478fc9b4eb90681df89156dfcc8f7f81481 (patch) | |
tree | b9788b0d48f524bc4c0aeeb48c744a8f7b097910 /lib/Net/HTTP | |
download | net-http-spore-3e3dc478fc9b4eb90681df89156dfcc8f7f81481.tar.gz |
initial import
Diffstat (limited to 'lib/Net/HTTP')
24 files changed, 1086 insertions, 0 deletions
diff --git a/lib/Net/HTTP/Spore.pm b/lib/Net/HTTP/Spore.pm new file mode 100644 index 0000000..88ce418 --- /dev/null +++ b/lib/Net/HTTP/Spore.pm @@ -0,0 +1,68 @@ +package Net::HTTP::Spore; + +use Moose; + +use IO::All; +use JSON; +use Carp; +use Try::Tiny; + +use Net::HTTP::Spore::Core; + +our $VERSION = 0.01; + +sub new_from_spec { + my ($class, $spec_file, %args) = @_; + + if (! -f $spec_file) { + Carp::confess ("$spec_file does not exists"); + } + + my ($content, $spec); + + $content < io($spec_file); + + try { + $spec = JSON::decode_json($content); + } + catch { + Carp::confess( "unable to parse JSON spec: " . $_ ); + }; + + my $spore_class = + Class::MOP::Class->create_anon_class( + superclasses => ['Net::HTTP::Spore::Core']); + + my $spore_object; + try { + + my $api_base_url; + if ( $spec->{api_base_url} && !$args{api_base_url} ) { + $args{api_base_url} = $spec->{api_base_url}; + } + elsif ( !$args{api_base_url} ) { + die "api_base_url is missing!"; + } + + $spore_object = $spore_class->new_object(%args); + $spore_object = _add_methods($spore_object, $spec->{methods}); + + }catch{ + Carp::confess("unable to create new Net::HTTP::Spore object: ".$_); + }; + + return $spore_object; +} + +sub _add_methods { + my ($class, $methods_spec) = @_; + + foreach my $method_name (keys %$methods_spec) { + $class->meta->add_spore_method($method_name, + %{$methods_spec->{$method_name}}); + } + $class; +} + + +1; diff --git a/lib/Net/HTTP/Spore/Core.pm b/lib/Net/HTTP/Spore/Core.pm new file mode 100644 index 0000000..2251af8 --- /dev/null +++ b/lib/Net/HTTP/Spore/Core.pm @@ -0,0 +1,5 @@ +package Net::HTTP::Spore::Core; + +use Net::HTTP::Spore::Meta; + +1; diff --git a/lib/Net/HTTP/Spore/Meta.pm b/lib/Net/HTTP/Spore/Meta.pm new file mode 100644 index 0000000..8b4942a --- /dev/null +++ b/lib/Net/HTTP/Spore/Meta.pm @@ -0,0 +1,47 @@ +package Net::HTTP::Spore::Meta; + +use Moose; +use Moose::Exporter; +use Moose::Util::MetaRole; + +our $VERSION = '0.14'; + +Moose::Exporter->setup_import_methods( + with_meta => [qw/spore_method/], + also => [qw/Moose/] +); + +sub spore_method { + my $meta = shift; + my $name = shift; + $meta->add_spore_method($name, @_); +} + +sub init_meta { + my ($class, %options) = @_; + + my $for = $options{for_class}; + Moose->init_meta(%options); + + my $meta = Moose::Util::MetaRole::apply_metaroles( + for => $for, + class_metaroles => { + class => ['Net::HTTP::Spore::Meta::Class'], + }, + ); + + Moose::Util::MetaRole::apply_base_class_roles( + for => $for, + roles => [ + qw/ + Net::HTTP::Spore::Role::UserAgent + Net::HTTP::Spore::Role::Request + Net::HTTP::Spore::Role::Middleware + / + ], + ); + + $meta; +}; + +1; diff --git a/lib/Net/HTTP/Spore/Meta/Class.pm b/lib/Net/HTTP/Spore/Meta/Class.pm new file mode 100644 index 0000000..4ddd5c6 --- /dev/null +++ b/lib/Net/HTTP/Spore/Meta/Class.pm @@ -0,0 +1,13 @@ +package Net::HTTP::Spore::Meta::Class; + +# ABSTRACT: metaclass for all API client + +use Moose::Role; + +with qw/Net::HTTP::Spore::Meta::Method::Spore/; + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION diff --git a/lib/Net/HTTP/Spore/Meta/Method.pm b/lib/Net/HTTP/Spore/Meta/Method.pm new file mode 100644 index 0000000..0087147 --- /dev/null +++ b/lib/Net/HTTP/Spore/Meta/Method.pm @@ -0,0 +1,159 @@ +package Net::HTTP::Spore::Meta::Method; + +# ABSTRACT: create api method + +use Moose; +use Moose::Util::TypeConstraints; + +use MooseX::Types::Moose qw/Str Int ArrayRef/; +use MooseX::Types::URI qw/Uri/; + +extends 'Moose::Meta::Method'; +use Net::HTTP::Spore::Response; + +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 ); +has method => ( is => 'ro', isa => 'Method', required => 1 ); +has description => ( is => 'ro', isa => 'Str', predicate => 'has_description' ); + +has authentication => ( + is => 'ro', + isa => 'Bool', + predicate => 'has_authentication', + default => 0 +); +has api_base_url => ( + is => 'ro', + isa => Uri, + coerce => 1, + predicate => 'has_api_base_url', +); +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 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; + } +); + +sub wrap { + my ( $class, %args ) = @_; + + my $code = sub { + my ( $self, %method_args ) = @_; + + my $method = $self->meta->find_spore_method_by_name( $args{name} ); + + my $payload = + ( defined $method_args{spore_payload} ) + ? delete $method_args{spore_payload} + : delete $method_args{payload}; + + foreach my $required ( $method->required ) { + if ( !grep { $required eq $_ } keys %method_args ) { + die Net::HTTP::Spore::Response->new( + 599, + [], + { + error => + "$required is marked as required but is missing", + } + ); + } + } + + my $params; + foreach (keys %method_args) { + push @$params, $_, $method_args{$_}; + } + + my $api_base_url = + $method->has_api_base_url + ? $method->api_base_url + : $self->api_base_url; + + my $env = { + REQUEST_METHOD => $method->method, + SERVER_NAME => $api_base_url->host, + SERVER_PORT => $api_base_url->port, + SCRIPT_NAME => ( + $api_base_url->path eq '/' + ? '' + : $api_base_url->path + ), + PATH_INFO => $method->path, + REQUEST_URI => '', + QUERY_STRING => '', + SERVER_PROTOCOL => $api_base_url->scheme, + HTTP_USER_AGENT => $self->api_useragent->agent, + 'spore.expected' => [ $method->expected ], + 'spore.authentication' => $method->authentication, + 'spore.params' => $params, + 'spore.payload' => $payload, + 'spore.errors' => *STDERR, + 'spore.url_scheme' => $api_base_url->scheme, + }; + + my $response = $self->http_request($env); + my $code = $response->status; + + die $response if ( $method->has_expected + && !$method->find_expected_code( sub { /$code/ } ) ); + + $response; + }; + $args{body} = $code; + + $class->SUPER::wrap(%args); +} + +1; + +=head1 SYNOPSIS + +=head1 DESCRIPTION + diff --git a/lib/Net/HTTP/Spore/Meta/Method/Spore.pm b/lib/Net/HTTP/Spore/Meta/Method/Spore.pm new file mode 100644 index 0000000..4c6fe71 --- /dev/null +++ b/lib/Net/HTTP/Spore/Meta/Method/Spore.pm @@ -0,0 +1,113 @@ +package Net::HTTP::Spore::Meta::Method::Spore; + +# ABSTRACT: declare API method + +use Moose::Role; +use Net::HTTP::API::Error; +use Net::HTTP::Spore::Meta::Method; +use MooseX::Types::Moose qw/Str ArrayRef/; + +has local_spore_methods => ( + traits => ['Array'], + is => 'rw', + isa => ArrayRef [Str], + required => 1, + default => sub { [] }, + auto_deref => 1, + handles => { + _find_spore_method_by_name => 'first', + _add_spore_method => 'push', + get_all_spore_methods => 'elements', + }, +); + +sub find_spore_method_by_name { + my ($meta, $name) = @_; + my $method_name = $meta->_find_spore_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_spore_method { + my ($meta, $name) = @_; + my @methods = grep { !/$name/ } $meta->get_all_spore_methods; + $meta->local_spore_methods(\@methods); + $meta->remove_method($name); +} + +before add_spore_method => sub { + my ($meta, $name) = @_; + if ($meta->_find_spore_method_by_name(sub {/^$name$/})) { + die Net::HTTP::API::Error->new( + reason => "method '$name' is already declared in " . $meta->name); + } +}; + +sub add_spore_method { + my ($meta, $name, %options) = @_; + + my $code = delete $options{code}; + + $meta->add_method( + $name, + Net::HTTP::Spore::Meta::Method->wrap( + name => $name, + package_name => $meta->name, + body => $code, + %options + ), + ); + $meta->_add_spore_method($name); +} + +after add_spore_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_spore_method_by_name('users'); + + $api_client->meta->remove_spore_method($method); + + $api_client->meta->add_spore_method('users', sub {...}, + description => 'this method does...',); + +=head1 DESCRIPTION + +=method get_all_spore_methods + +Return a list of net api methods + +=method find_spore_method_by_name + +Return a net api method + +=method remove_spore_method + +Remove a net api method + +=method add_spore_method + +Add a net api method diff --git a/lib/Net/HTTP/Spore/Middleware.pm b/lib/Net/HTTP/Spore/Middleware.pm new file mode 100644 index 0000000..0b8584c --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware.pm @@ -0,0 +1,31 @@ +package Net::HTTP::Spore::Middleware; + +use strict; +use warnings; + +sub new { + my $class = shift; + bless {@_}, $class; +} + +sub response_cb { + my ($self, $cb) = @_; + + my $body_filter = sub { + my $filter = $cb->(@_); + }; + return $body_filter; +} + +sub wrap { + my ($self, @args) = @_; + + if (!ref $self) { + $self = $self->new(@args); + } + return sub { + $self->call(@_); + }; +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Auth/Basic.pm b/lib/Net/HTTP/Spore/Middleware/Auth/Basic.pm new file mode 100644 index 0000000..18c1e16 --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Auth/Basic.pm @@ -0,0 +1,24 @@ +package Net::HTTP::Spore::Middleware::Auth::Basic; + +use Moose; +use MIME::Base64; + +extends 'Net::HTTP::Spore::Middleware'; + +has username => (isa => 'Str', is => 'rw', predicate => 'has_username'); +has password => (isa => 'Str', is => 'rw', predicate => 'has_password'); + +sub call { + my ( $self, $req ) = @_; + + if ( $self->has_username && $self->has_password ) { + $req->header( + 'Authorization' => 'Basic ' + . MIME::Base64::encode( + $self->username . ':' . $self->password, '' + ) + ); + } +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm b/lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm new file mode 100644 index 0000000..e30a45b --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Auth/OAuth.pm @@ -0,0 +1,37 @@ +package Net::HTTP::Spore::Middleware::Auth::OAuth; + +use Moose; +extends 'Net::HTTP::Spore::Middleware'; + +use Net::OAuth; +use MIME::Base64; + +has [qw/consumer_key consumer_secret token token_secret/] => ( + is => 'ro', + isa => 'Str', + required => 1, +); + +sub call { + my ( $self, $req ) = @_; + + my $request = Net::OAuth->request('protected resource')->new( + version => '1.0', + consumer_key => $self->consumer_key, + consumer_secret => $self->consumer_secret, + token => $self->token, + token_secret => $self->token_secret, + request_method => $req->method, + signature_method => 'HMAC-SHA1', + timestamp => time, + nonce => MIME::Base64::encode( time . $$ . rand ), + request_url => $req->uri, + # extra_params => \%post_args, + ); + + $request->sign; + my $auth = $request->to_authorization_header; + $req->header( 'Authorization' => $auth ); +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Format.pm b/lib/Net/HTTP/Spore/Middleware/Format.pm new file mode 100644 index 0000000..7acd376 --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Format.pm @@ -0,0 +1,37 @@ +package Net::HTTP::Spore::Middleware::Format; + +use Moose; +extends 'Net::HTTP::Spore::Middleware'; + +sub encode { die "must be implemented" } +sub decode { die "must be implemented" } +sub accept_type { die "must be implemented" } +sub content_type { die "must be implemented" } + +sub call { + my ( $self, $req ) = @_; + + return + if ( exists $req->env->{'sporex.format'} + && $req->env->{'sporex.format'} == 1 ); + + $req->header( $self->accept_type ); + + if ( $req->env->{'spore.payload'} ) { + $req->env->{'spore.payload'} = + $self->encode( $req->env->{'spore.payload'} ); + $req->header( $self->content_type ); + } + + $req->env->{'sporex.format'} = 1; + + return $self->response_cb( + sub { + my $res = shift; + my $content = $self->decode( $res->body ); + $res->body($content); + } + ); +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Format/Auto.pm b/lib/Net/HTTP/Spore/Middleware/Format/Auto.pm new file mode 100644 index 0000000..fd66b8c --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Format/Auto.pm @@ -0,0 +1,17 @@ +package Net::HTTP::Spore::Middleware::Format::Auto; + +use Moose; +extends 'Net::HTTP::Spore::Middleware::Format'; + +sub call { + my ( $self, $req ) = @_; + + $req->env->{'sporex.format'} = 1; + + return $self->response_cb( sub { + my $res = shift; + return $res; + }); +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Format/JSON.pm b/lib/Net/HTTP/Spore/Middleware/Format/JSON.pm new file mode 100644 index 0000000..61326cd --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Format/JSON.pm @@ -0,0 +1,19 @@ +package Net::HTTP::Spore::Middleware::Format::JSON; + +use JSON; +use Moose; +extends 'Net::HTTP::Spore::Middleware::Format'; + +has _json_parser => ( + is => 'rw', + isa => 'JSON', + lazy => 1, + default => sub { JSON->new->allow_nonref }, +); + +sub encode { $_[0]->_json_parser->encode( $_[1] ); } +sub decode { $_[0]->_json_parser->decode( $_[1] ); } +sub accept_type { ( 'Accept' => 'application/json' ) } +sub content_type { ( 'Content-Type' => 'application/json' ) } + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Format/XML.pm b/lib/Net/HTTP/Spore/Middleware/Format/XML.pm new file mode 100644 index 0000000..c4ae038 --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Format/XML.pm @@ -0,0 +1,13 @@ +package Net::HTTP::Spore::Middleware::Format::XML; + +use Moose; +extends 'Net::HTTP::Spore::Middleware::Format'; + +use XML::Simple; + +sub accept_type { ( 'Accept' => 'text/xml' ); } +sub content_type { ( 'Content-Type' => 'text/xml' ) } +sub encode { XMLout( $_[1] ) } +sub decode { XMLin( $_[1] ) } + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Format/YAML.pm b/lib/Net/HTTP/Spore/Middleware/Format/YAML.pm new file mode 100644 index 0000000..bd844ce --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Format/YAML.pm @@ -0,0 +1,12 @@ +package Net::HTTP::Spore::Middleware::Format::YAML; + +use YAML; +use Moose; +extends 'Net::HTTP::Spore::Middleware::Format'; + +sub encode { YAML::Decode( $_[1] ); } +sub decode { YAML::Load( $_[1] ); } +sub accept_type { ( 'Accept' => 'text/x-yaml' ) } +sub content_type { ( 'Content-Type' => 'text/x-yaml' ) } + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/LogDispatch.pm b/lib/Net/HTTP/Spore/Middleware/LogDispatch.pm new file mode 100644 index 0000000..2724fcf --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/LogDispatch.pm @@ -0,0 +1,7 @@ +package Net::HTTP::Spore::Middleware::LogDispatch; + +use Moose; +extends 'Net::HTTP::Spore::Middleware'; + + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Runtime.pm b/lib/Net/HTTP/Spore/Middleware/Runtime.pm new file mode 100644 index 0000000..1614c31 --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Runtime.pm @@ -0,0 +1,22 @@ +package Net::HTTP::Spore::Middleware::Runtime; + +use Moose; +extends 'Net::HTTP::Spore::Middleware'; +use Time::HiRes; + +sub call { + my ( $self, $req) = @_; + + my $start_time = [Time::HiRes::gettimeofday]; + + $self->response_cb( + sub { + my $res = shift; + my $req_time = sprintf '%.6f', + Time::HiRes::tv_interval($start_time); + $res->header('X-Spore-Runtime' => $req_time); + } + ); +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Test.pm b/lib/Net/HTTP/Spore/Middleware/Test.pm new file mode 100644 index 0000000..6cf2c9e --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Test.pm @@ -0,0 +1,12 @@ +package Net::HTTP::Spore::Middleware::Test; + +use strict; +use warnings; + +use parent qw/Net::HTTP::Spore::Middleware/; + +sub call { +# use YAML::Syck; warn Dump \@_; +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/Test/Response.pm b/lib/Net/HTTP/Spore/Middleware/Test/Response.pm new file mode 100644 index 0000000..ca216c5 --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/Test/Response.pm @@ -0,0 +1,28 @@ +package Net::HTTP::Spore::Middleware::Test::Response; + +use Moose; +extends 'Net::HTTP::Spore::Middleware'; + +has status => ( isa => 'Int', is => 'ro', lazy => 1, default => 200 ); +has headers => ( isa => 'ArrayRef', is => 'ro', default => sub { [] } ); +has callback => ( + isa => 'CodeRef', + is => 'ro', + lazy => 1, + default => sub { + sub { + my ( $self, $req ) = @_; + $req->new_response( $self->status, $self->headers, $self->body, ); + } + } +); + +has body => + ( isa => 'HashRef', is => 'ro', lazy => 1, default => sub { { foo => 1 } } ); + +sub call { + my ( $self, $req ) = @_; + $self->callback->($self, $req); +} + +1; diff --git a/lib/Net/HTTP/Spore/Middleware/UserAgent.pm b/lib/Net/HTTP/Spore/Middleware/UserAgent.pm new file mode 100644 index 0000000..0517c26 --- /dev/null +++ b/lib/Net/HTTP/Spore/Middleware/UserAgent.pm @@ -0,0 +1,15 @@ +package Net::HTTP::Spore::Middleware::UserAgent; + +use Moose; +extends qw/Net::HTTP::Spore::Middleware/; + +has useragent => (is => 'ro', isa => 'Str', required => 1); + +sub call { + my ($self, $req) = @_; + + $req->header('User-Agent' => $self->useragent); +} + + +1; diff --git a/lib/Net/HTTP/Spore/Request.pm b/lib/Net/HTTP/Spore/Request.pm new file mode 100644 index 0000000..655f128 --- /dev/null +++ b/lib/Net/HTTP/Spore/Request.pm @@ -0,0 +1,156 @@ +package Net::HTTP::Spore::Request; + +use strict; +use warnings; + +use URI; +use HTTP::Headers; +use HTTP::Request; +use URI::Escape; +use Hash::MultiValue; + +use Net::HTTP::Spore::Response; + +sub new { + my ( $class, $env ) = @_; + bless { env => $env }, $class; +} + +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]->{env}->{PATH_INFO} || '/' } +sub request_uri { $_[0]->{env}->{REQUEST_URI} } +sub protocol { $_[0]->{env}->{SERVER_PROTOCOL} } +sub content { $_[0]->{env}->{'spore.payload'} } +sub scheme { $_[0]->{env}->{'spore.scheme'} } + +sub path_info { + my $self = shift; + my ($path) = $self->_path; + $path; +} + +sub _path { + my $self = shift; + + my $query_string; + my $path = $self->env->{PATH_INFO}; + my @params = @{ $self->env->{'spore.params'} || [] }; + + + my $j = 0; + for (my $i = 0; $i < scalar @params; $i++) { + my $key = $params[$i]; + my $value = $params[++$i]; + if (!$value) { + $query_string .= $key; + last; + } + unless ( $path && $path =~ s/\:$key/$value/ ) { + $query_string .= $key . '=' . $value; + $query_string .= '&' if $query_string && scalar @params; + } + } + + $query_string =~ s/&$// if $query_string; + return ( $path, $query_string ); +} + +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(@_)} + +sub uri { + my $self = shift; + + my $path_info = shift; + my $query_string = shift; + + if ( !$path_info || !$query_string ) { + my @path_info = $self->_path; + $path_info = $path_info[0] if !$path_info; + $query_string = $path_info[1] if !$query_string; + } + + my $base = $self->_uri_base; + + my $path_escape_class = '^A-Za-z0-9\-\._~/'; + + my $path = URI::Escape::uri_escape($path_info || '', $path_escape_class); + + if (defined $query_string) { + $path .= '?' . $query_string; + } + + $base =~ s!/$!! if $path =~ m!^/!; + return URI->new( $base . $path )->canonical; +} + +sub query_parameters { + my $self = shift; +} + +sub base { + my $self = shift; + URI->new( $self->_uri_base )->canonical; +} + +sub _uri_base { + my $self = shift; + my $env = $self->env; + + my $uri = + ( $env->{'spore.url_scheme'} || "http" ) . "://" + . ( + $env->{HTTP_HOST} + || (( $env->{SERVER_NAME} || "" ) . ":" + . ( $env->{SERVER_PORT} || 80 ) ) + ) . ( $env->{SCRIPT_NAME} || '/' ); + return $uri; +} + +sub new_response { + my $self = shift; + my $res = Net::HTTP::Spore::Response->new(@_); + $res->request($self); + $res; +} + +sub finalize { + my $self = shift; + + my ($path_info, $query_string) = $self->_path; + + $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 ); + + $request->content($self->content) if ($self->content); + $request; +} + +1; diff --git a/lib/Net/HTTP/Spore/Response.pm b/lib/Net/HTTP/Spore/Response.pm new file mode 100644 index 0000000..d695dfa --- /dev/null +++ b/lib/Net/HTTP/Spore/Response.pm @@ -0,0 +1,103 @@ +package Net::HTTP::Spore::Response; + +use strict; +use warnings; + +use overload '@{}' => \&finalize; + +use HTTP::Headers; + +sub new { + my ( $class, $rc, $headers, $body ) = @_; + + my $self = bless {}, $class; + $self->status($rc) if defined $rc; + if (defined $body) { + $self->body($body); + $self->raw_body($body); + } + $self->headers($headers || []); + $self; +} + +sub code { shift->status(@_) } +sub content { shift->body(@_) } + +sub content_type { shift->headers->content_type(@_) } +sub content_length { shift->headers->content_length(@_) } + +sub status { + my $self = shift; + if (@_) { + $self->{status} = shift; + } + else { + return $self->{status}; + } +} + +sub body { + my $self = shift; + if (@_) { + $self->{body} = shift; + } + else { + return $self->{body}; + } +} + +sub raw_body { + my $self = shift; + if (@_) { + $self->{raw_body} = shift; + }else{ + return $self->{raw_body}; + } +} + +sub headers { + my $self = shift; + if (@_) { + my $headers = shift; + if ( ref $headers eq 'ARRAY' ) { + $headers = HTTP::Headers->new(@$headers); + } + elsif ( ref $headers eq 'HASH' ) { + $headers = HTTP::Headers->new(%$headers); + } + $self->{headers} = $headers; + } + else { + return $self->{headers} ||= HTTP::Headers->new(); + } +} + +sub request { + my $self = shift; + if (@_) { + $self->{request} = shift; + }else{ + return $self->{request}; + } +} + +sub header { + my $self = shift; + $self->headers->header(@_); +} + +sub finalize { + my $self = shift; + return [ + $self->status, + +[ + map { + my $k = $_; + map { ( $k => $_ ) } $self->headers->header($_); + } $self->headers->header_field_names + ], + $self->body, + ]; +} + +1; diff --git a/lib/Net/HTTP/Spore/Role/Middleware.pm b/lib/Net/HTTP/Spore/Role/Middleware.pm new file mode 100644 index 0000000..dd2c1c5 --- /dev/null +++ b/lib/Net/HTTP/Spore/Role/Middleware.pm @@ -0,0 +1,44 @@ +package Net::HTTP::Spore::Role::Middleware; + +use Moose::Role; + +has middlewares => ( + is => 'rw', + isa => 'ArrayRef', + traits => ['Array'], + lazy => 1, + default => sub { [] }, + auto_deref => 1, + handles => { _add_middleware => 'push', _filter_middlewares => 'grep'}, +); + +sub _load_middleware { + my ( $self, $mw, @args ) = @_; + + Class::MOP::load_class($mw); + + my $code = $mw->wrap( @args ); + $self->_add_middleware($code); +} + +sub enable { + my ($self, $mw, @args) = @_; + + if ($mw !~ /(?:^\+|Net\:\:HTTP\:\:Spore\:\:Middleware)/) { + $mw = "Net::HTTP::Spore::Middleware::".$mw; + } + $self->_load_middleware($mw, @args); + $self; +} + +sub enable_if { + my ($self, $cond, $mw, @args) = @_; + $self; +} + +sub reset_middlewares { + my $self = shift; + $self->middlewares([]); +} + +1; diff --git a/lib/Net/HTTP/Spore/Role/Request.pm b/lib/Net/HTTP/Spore/Role/Request.pm new file mode 100644 index 0000000..840917a --- /dev/null +++ b/lib/Net/HTTP/Spore/Role/Request.pm @@ -0,0 +1,82 @@ +package Net::HTTP::Spore::Role::Request; + +# ABSTRACT: make HTTP request + +use Try::Tiny; +use Moose::Role; +use MooseX::Types::URI qw/Uri/; + +use Net::HTTP::Spore::Request; + +has api_base_url => ( + is => 'rw', + isa => Uri, + coerce => 1, + required => 1, +); + +sub http_request { + my ( $self, $env ) = @_; + + my ($request, $response); + $request = Net::HTTP::Spore::Request->new($env); + + my @middlewares; + foreach my $mw ( $self->middlewares ) { + my $res; + try { + $res = $mw->($request); + } + catch { + $res = $request->new_response( 599, [], { error => $_, } ); + }; + + if ( ref $res && ref $res eq 'CODE' ) { + push @middlewares, $res; + } + elsif ( ref $res && ref $res eq 'Net::HTTP::Spore::Response' ) { + return $res if ($res->status == 599); + $response = $res; + last; + } + } + + if (defined $response) { + map { $_->($response) } reverse @middlewares; + return $response; + } + + my $result = $self->request($request->finalize); + + $response = $request->new_response( + $result->code, + $result->headers, + $result->content, + ); + + map { $_->($response) } reverse @middlewares; + + $response; +} + +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/Spore/Role/UserAgent.pm b/lib/Net/HTTP/Spore/Role/UserAgent.pm new file mode 100644 index 0000000..6bfaa5a --- /dev/null +++ b/lib/Net/HTTP/Spore/Role/UserAgent.pm @@ -0,0 +1,22 @@ +package Net::HTTP::Spore::Role::UserAgent; + +# ABSTRACT: create UserAgent + +use Moose::Role; +use LWP::UserAgent; + +has api_useragent => ( + is => 'rw', + isa => 'LWP::UserAgent', + lazy => 1, + handles => [qw/request/], + default => sub { + my $self = shift; + my $ua = LWP::UserAgent->new(); + $ua->agent( "Net::HTTP::Spore v" . $Net::HTTP::Spore::VERSION . " (Perl)" ); + $ua->env_proxy; + return $ua; + } +); + +1; |