diff options
Diffstat (limited to '')
53 files changed, 2070 insertions, 0 deletions
diff --git a/eg/api.pl b/eg/api.pl new file mode 100644 index 0000000..4e89701 --- /dev/null +++ b/eg/api.pl @@ -0,0 +1,24 @@ +use strict; +use warnings; +use 5.010; + +use Net::HTTP::Spore; + +my $username = shift; +my $token = shift; + +my $api = Net::HTTP::Spore->new_from_spec(shift); + +$api->enable('Net::HTTP::Spore::Middleware::Format::JSON'); + +$api->enable( + 'Net::HTTP::Spore::Middleware::Auth::Basic', + username => $username, + password => $token, +); + +my ( $content, $result ) = + $api->user_information( format => 'json', username => 'franckcuny' ); + +use YAML::Syck; +warn Dump $content; diff --git a/eg/apitest.json b/eg/apitest.json new file mode 100644 index 0000000..8c26bae --- /dev/null +++ b/eg/apitest.json @@ -0,0 +1,13 @@ +{ + "methods" : { + "new_user" : { + "path" : "/user/", + "method" : "POST" + } + }, + "declare" : { + "api_base_url" : "http://localhost:5000", + "api_format_mode" : "content-type", + "api_format" : "json" + } +} diff --git a/eg/apitest.yaml b/eg/apitest.yaml new file mode 100644 index 0000000..9e3bad4 --- /dev/null +++ b/eg/apitest.yaml @@ -0,0 +1,12 @@ +name: apitest +author: + - franck cuny <franck@lumberjaph.net> +version: 0.01 +api_base_url: http://localhost:5000 +methods: + new_user: + method: POST + path: /user/ + list_users: + method: GET + path: /user/list diff --git a/eg/couchdb.pl b/eg/couchdb.pl new file mode 100644 index 0000000..737e76b --- /dev/null +++ b/eg/couchdb.pl @@ -0,0 +1,38 @@ +use strict; +use warnings; +use 5.010; +use YAML::Syck; +use Net::HTTP::Spore; +use Try::Tiny; + +my $api = Net::HTTP::Spore->new_from_spec(shift, api_base_url => 'http://localhost:5984'); + +$api->enable('Format::JSON'); +$api->enable('Runtime'); +$api->enable('UserAgent'); + +#my $documents = $api->get_all_documents(database => 'spore'); +#warn Dump $documents; +#say "status => ".$documents->[0]; +#say "body => ".Dump $documents->[2]; +#say "headers=> ".Dump $documents->[1]; + +my $res; + +#$res = $api->create_document_with_id(database => 'spore', doc_id => 1, payload => {foo => 'bar'}); +#warn Dump $res; + +#$res = $api->delete_document(database =>'spore', doc_id => 1, rev => $res->body->{rev}); +#warn Dump $res; + +$res = $api->create_document_without_id(database => 'spore', payload => {foo => 'baz', bar => 'foobaz'}); +warn Dump $res; + +#try { + #$res = $api->get_document( database => 'spore', doc_id => 1 ); +#} +#catch { + #warn Dump $_->[2]; + #warn Dump $_->[1]; +#}; + diff --git a/eg/github.json b/eg/github.json new file mode 100644 index 0000000..4e3a051 --- /dev/null +++ b/eg/github.json @@ -0,0 +1,36 @@ +{ + "declare" : { + "api_base_url" : "http://github.com/api/v2/", + "api_format_mode" : "content-type", + "api_format" : "json" + }, + "methods" : { + "user_information" : { + "params" : [ + "username", + "format" + ], + "required" : [ + "format", + "username" + ], + "path" : "/:format/user/show/:username", + "method" : "GET", + "expected" : [ + "200" + ] + }, + "user_following" : { + "params" : [ + "user", + "format" + ], + "required" : [ + "user", + "format" + ], + "path" : "/:format/user/show/:user/followers", + "method" : "GET" + } + } +} diff --git a/eg/github.yaml b/eg/github.yaml new file mode 100644 index 0000000..f844a41 --- /dev/null +++ b/eg/github.yaml @@ -0,0 +1,17 @@ +declare: + api_base_url: http://github.com/api/v2/ +methods: + user_information: + method: GET + path: /user/show/:username + params: + - username + required: + - username + user_following: + method: GET + path: /user/show/:user/followers + params: + - user + required: + - user diff --git a/eg/test.pl b/eg/test.pl new file mode 100644 index 0000000..b77d0bb --- /dev/null +++ b/eg/test.pl @@ -0,0 +1,21 @@ +use strict; +use warnings; +use 5.010; + +use Net::HTTP::Spore; + +my $api = Net::HTTP::Spore->new_from_spec(shift, api_base_url => 'http://localhost:5000'); + +$api->enable('Net::HTTP::Spore::Middleware::Format::JSON'); + +$api->enable( + 'Net::HTTP::Spore::Middleware::Auth::Basic', + username => 'admin', + password => 's3cr3t' +); + +my $content = + $api->new_user( input => { user => { francktest => { name => 'franck' } } } ); + +use YAML::Syck; +warn Dump $content; diff --git a/eg/twitter.json b/eg/twitter.json new file mode 100644 index 0000000..f07470e --- /dev/null +++ b/eg/twitter.json @@ -0,0 +1,27 @@ +{ + "declare" : { + "api_base_url" : "http://api.twitter.com/1", + "api_format_mode" : "append", + "api_format" : "json" + }, + "methods" : { + "public_timeline" : { + "params" : [ + "skip_user" + ], + "path" : "/statuses/public_timeline", + "method" : "GET" + }, + "home_timeline" : { + "params" : [ + "since_id", + "max_id", + "count", + "page", + "skip_user" + ], + "path" : "/statuses/home_timeline", + "method" : "GET" + } + } +} diff --git a/eg/twitter.yaml b/eg/twitter.yaml new file mode 100644 index 0000000..92054b7 --- /dev/null +++ b/eg/twitter.yaml @@ -0,0 +1,19 @@ +declare: + api_base_url: http://api.twitter.com/1 + api_format: json + api_format_mode: append +methods: + public_timeline: + method: GET + path: /statuses/public_timeline + params: + - skip_user + home_timeline: + method: GET + path: /statuses/home_timeline + params: + - since_id + - max_id + - count + - page + - skip_user 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; diff --git a/spec/spore.pod b/spec/spore.pod new file mode 100644 index 0000000..3cd44d1 --- /dev/null +++ b/spec/spore.pod @@ -0,0 +1,105 @@ +=head1 NAME + +Spore - Specifications to a POrtable Rest Environment + +=head1 SYNOPSIS + +The ReST +(L<http://en.wikipedia.org/wiki/Representational_State_Transfer|Representational +State Transfer>) paradigm have improved the way we communicate between +services and clients. It's easy to understand an API and to implement +the communications. + +=head1 API DESCRIPTION + +An API should provide a description file. The description should be in JSON +format. + +The description can have the following fields: + +=over 4 + +=item B<name> (optional) + +A simple name to describe the specification (eg: CouchDB) + +=item B<author> (optional) + +A list of authors for this specification + +=item B<api_base_url> (optional) + +If the API have a fixed URL + +=item B<api_format> (optional) + +A list of supported format (eg: JSON, XML) + +=item B<version> (optinal) + +A version of the current description + +=item B<authentication> (optional) + +A boolean to inform if this API require authentication for all the methods + +=item B<methods> (required) + +A list of methods + +=back + +The desciption B<MUST> contains a list of at least one method. + +=over 4 + +=item B<method> (required) + +An HTTP method (GET/POST/PUT/DELETE) + +=item B<path> (required) + +Path for the given method. The path can contains B<placeholder>. A placeholder +B<MUST> begins with a <:>: + + /:database + +=item B<params> (optional) + +A list of parameters. This list will be used to replace value in placeholder, +and if not used in the path, will be added to the query. + +=item B<required> (optional) + +A list of required parameters. Parameters that are required B<MUST NOT> be +repeted in the B<params> field. + +=item B<expected> (optional) + +A list of accepted HTTP status for this method. (eg: 200, 201). + +=item B<description> (optional) + +A simple description for the method. This should not be considered as +documentation. + + Fetch a document from a CouchDB database + +=item B<authentication> (optional) + +A boolean to define if this method requires authentication + +=item B<api_base_url> (optional) + +If this method require a different api_base_url + +=item B<documentation> (optional) + +A complete documentation for the given method + +=back + +=head3 SAMPLE + +=head3 CALLS + diff --git a/t/specs/couchdb.json b/t/specs/couchdb.json new file mode 100644 index 0000000..f7c44b2 --- /dev/null +++ b/t/specs/couchdb.json @@ -0,0 +1,77 @@ +{ + "version" : "0.1", + "methods" : { + "create_document_without_id" : { + "required" : [ + "database" + ], + "path" : "/:database", + "method" : "POST" + }, + "get_all_documents" : { + "params" : [ + "descending", + "startkey", + "endkey", + "limit", + "include_docs" + ], + "required" : [ + "database" + ], + "path" : "/:database/_all_docs", + "method" : "GET" + }, + "create_document_with_id" : { + "required" : [ + "database", + "doc_id" + ], + "path" : "/:database/:doc_id", + "method" : "POST" + }, + "get_document" : { + "params" : [ + "rev", + "revs" + ], + "required" : [ + "database", + "doc_id" + ], + "path" : "/:database/:doc_id", + "method" : "GET" + }, + "get_all_documents_by_seq" : { + "params" : [ + "startkey", + "endkey", + "limit", + "include_docs" + ], + "required" : [ + "database" + ], + "path" : "/:database/_all_docs_by_seq", + "method" : "GET" + }, + "delete_document" : { + "params" : [ + "rev" + ], + "required" : [ + "database", + "doc_id" + ], + "path" : "/:database/:doc_id", + "method" : "DELETE" + } + }, + "api_format" : [ + "json" + ], + "name" : "CouchDB", + "author" : [ + "franck cuny <franck@lumberjaph.net>" + ] +} diff --git a/t/spore-method/base.t b/t/spore-method/base.t new file mode 100644 index 0000000..5010c38 --- /dev/null +++ b/t/spore-method/base.t @@ -0,0 +1,38 @@ +use strict; +use warnings; +use Test::More; +use Test::Exception; +use Net::HTTP::Spore::Meta::Method; + +dies_ok { + Net::HTTP::Spore::Meta::Method->wrap( + name => 'test_method', + package_name => 'test::api', + body => sub { 1 }, + ); +} +"missing some params"; + +like $@, qr/Attribute \(method\) is required/; + +ok my $method = Net::HTTP::Spore::Meta::Method->wrap( + name => 'test_method', + package_name => 'test::api', + body => sub { 1 }, + method => 'GET', + path => '/user/', + ), + 'method created'; + +is $method->method, 'GET', 'method is GET'; + +ok $method = Net::HTTP::Spore::Meta::Method->wrap( + name => 'test_method', + package_name => 'test::api', + method => 'GET', + path => '/user/', + params => [qw/name id street/], + required => [qw/name id/], +); + +done_testing; diff --git a/t/spore-middleware/auth-basic.t b/t/spore-middleware/auth-basic.t new file mode 100644 index 0000000..92776ba --- /dev/null +++ b/t/spore-middleware/auth-basic.t @@ -0,0 +1,32 @@ +use strict; +use warnings; + +use Test::More; +use MIME::Base64; + +use Net::HTTP::Spore; + +ok my $client = + Net::HTTP::Spore->new_from_spec( 't/specs/couchdb.json', + api_base_url => 'http://localhost:5984' ); + +my $username = 'franck'; +my $password = 's3kr3t'; + +$client->enable( 'Auth::Basic', username => $username, password => $password ); +$client->enable( + 'Test::Response', + body => 'result is ok', + headers => [ 'Content-Type' => 'text/html' ] +); + +my $res = $client->get_all_documents( database => 'test_spore' ); +is $res->[0], 200; + +my $req = $res->request; + +is $req->header('Authorization'), + 'Basic ' . encode_base64( $username . ':' . $password, '' ); + +done_testing; + diff --git a/t/spore-middleware/format-json.t b/t/spore-middleware/format-json.t new file mode 100644 index 0000000..3e3b59b --- /dev/null +++ b/t/spore-middleware/format-json.t @@ -0,0 +1,30 @@ +use strict; +use warnings; + +use Test::More; +use JSON; + +use Net::HTTP::Spore; + +ok my $client = + Net::HTTP::Spore->new_from_spec( 't/specs/couchdb.json', + api_base_url => 'http://localhost:5984' ); + +my $content = { keys => [qw/1 2 3/] }; + +$client->enable('Format::JSON'); +$client->enable( + 'Test::Response', + body => JSON::encode_json($content), + headers => [ 'Content-Type' => 'application/json' ] +); + +my $res = $client->get_all_documents( database => 'test_spore' ); +is $res->[0], 200; +is_deeply $res->[2], $content; +is $res->header('Content-Type'), 'application/json'; + +my $req = $res->request; +is $req->header('Accept'), 'application/json'; + +done_testing; diff --git a/t/spore-middleware/format-xml.t b/t/spore-middleware/format-xml.t new file mode 100644 index 0000000..0a01633 --- /dev/null +++ b/t/spore-middleware/format-xml.t @@ -0,0 +1,30 @@ +use strict; +use warnings; + +use Test::More; +use XML::Simple; + +use Net::HTTP::Spore; + +ok my $client = + Net::HTTP::Spore->new_from_spec( 't/specs/couchdb.json', + api_base_url => 'http://localhost:5984' ); + +my $content = { keys => [qw/1 2 3/] }; + +$client->enable('Format::XML'); +$client->enable( + 'Test::Response', + body => XMLout($content), + headers => [ 'Content-Type' => 'text/xml' ] +); + +my $res = $client->get_all_documents( database => 'test_spore' ); +is $res->[0], 200; +is_deeply $res->[2], $content; +is $res->header('Content-Type'), 'text/xml'; + +my $req = $res->request; +is $req->header('Accept'), 'text/xml'; + +done_testing; diff --git a/t/spore-middleware/format-yaml.t b/t/spore-middleware/format-yaml.t new file mode 100644 index 0000000..c104cc5 --- /dev/null +++ b/t/spore-middleware/format-yaml.t @@ -0,0 +1,30 @@ +use strict; +use warnings; + +use Test::More; +use YAML; + +use Net::HTTP::Spore; + +ok my $client = + Net::HTTP::Spore->new_from_spec( 't/specs/couchdb.json', + api_base_url => 'http://localhost:5984' ); + +my $content = { keys => [qw/1 2 3/] }; + +$client->enable('Format::YAML'); +$client->enable( + 'Test::Response', + body => Dump($content), + headers => [ 'Content-Type' => 'text/x-yaml' ] +); + +my $res = $client->get_all_documents( database => 'test_spore' ); +is $res->[0], 200; +is_deeply $res->[2], $content; +is $res->header('Content-Type'), 'text/x-yaml'; + +my $req = $res->request; +is $req->header('Accept'), 'text/x-yaml'; + +done_testing; diff --git a/t/spore-middleware/runtime.t b/t/spore-middleware/runtime.t new file mode 100644 index 0000000..d6c9b55 --- /dev/null +++ b/t/spore-middleware/runtime.t @@ -0,0 +1,19 @@ +use strict; +use warnings; + +use Test::More; +use Net::HTTP::Spore; + +ok my $client = + Net::HTTP::Spore->new_from_spec( 't/specs/couchdb.json', + api_base_url => 'http://localhost:5984' ); + +my $ua_str = 'Test::Spore middleware'; + +$client->enable('Runtime'); +$client->enable('Test::Response'); + +my $res = $client->get_all_documents(database => 'test_spore'); +ok $res->header('X-Spore-Runtime'); + +done_testing; diff --git a/t/spore-middleware/useragent.t b/t/spore-middleware/useragent.t new file mode 100644 index 0000000..14dc9a6 --- /dev/null +++ b/t/spore-middleware/useragent.t @@ -0,0 +1,19 @@ +use strict; +use warnings; + +use Test::More; +use Net::HTTP::Spore; + +ok my $client = + Net::HTTP::Spore->new_from_spec( 't/specs/couchdb.json', + api_base_url => 'http://localhost:5984' ); + +my $ua_str = 'Test::Spore middleware'; + +$client->enable('UserAgent', useragent => $ua_str); +$client->enable('Test::Response'); + +my $res = $client->get_all_documents(database => 'test_spore'); +is $res->request->header('User-Agent'), $ua_str; + +done_testing; diff --git a/t/spore-request/base.t b/t/spore-request/base.t new file mode 100644 index 0000000..7ae91e9 --- /dev/null +++ b/t/spore-request/base.t @@ -0,0 +1,71 @@ +use strict; +use warnings; + +use Net::HTTP::Spore::Request; + +use Test::More; + +my @tests = ( + { + host => 'localhost', + base => 'http://localhost/' + }, + { + script_name => '/foo', + host => 'localhost', + base => 'http://localhost/foo' + }, + { + script_name => '/foo bar', + host => 'localhost', + base => 'http://localhost/foo%20bar' + }, + { + scheme => 'http', + host => 'localhost:91', + base => 'http://localhost:91/' + }, + { + scheme => 'http', + host => 'example.com', + base => 'http://example.com/' + }, + { + scheme => 'https', + host => 'example.com', + base => 'https://example.com/' + }, + { + scheme => 'http', + server_name => 'example.com', + server_port => 80, + base => 'http://example.com/' + }, + { + scheme => 'http', + server_name => 'example.com', + server_port => 8080, + base => 'http://example.com:8080/' + }, + { + host => 'foobar.com', + server_name => 'example.com', + server_port => 8080, + base => 'http://foobar.com/' + }, +); + +plan tests => 1 * @tests; + +for my $block (@tests) { + my $env = { + 'spore.url_scheme' => $block->{scheme} || 'http', + HTTP_HOST => $block->{host} || undef, + SERVER_NAME => $block->{server_name} || undef, + SERVER_PORT => $block->{server_port} || undef, + SCRIPT_NAME => $block->{script_name} || '', + }; + + my $req = Net::HTTP::Spore::Request->new($env); + is $req->base, $block->{base}; +} diff --git a/t/spore-request/exception.t b/t/spore-request/exception.t new file mode 100644 index 0000000..162370a --- /dev/null +++ b/t/spore-request/exception.t @@ -0,0 +1,17 @@ +use strict; +use warnings; + +use Test::More; +use Net::HTTP::Spore; + +ok my $client = + Net::HTTP::Spore->new_from_spec( 't/specs/couchdb.json', + api_base_url => 'http://localhost:5984' ); + +$client->enable( 'Test::Response', callback => sub { die } ); + +my $res = $client->get_all_documents(database => 'test_spore'); +is $res->[0], 599; +like $res->[2]->{error}, qr/Died/; + +done_testing; diff --git a/t/spore-request/finalize.t b/t/spore-request/finalize.t new file mode 100644 index 0000000..230c416 --- /dev/null +++ b/t/spore-request/finalize.t @@ -0,0 +1,27 @@ +use strict; +use Test::More; + +use Net::HTTP::Spore::Request; + +my $env = { + REQUEST_METHOD => 'GET', + SERVER_NAME => 'localhost', + SERVER_PORT => '80', + SCRIPT_NAME => '', + PATH_INFO => '/:database', + REQUEST_URI => '', + QUERY_STRING => '', + SERVER_PROTOCOL => 'HTTP/1.0', + 'spore.params' => [qw/database test_spore key foo rev 123/], +}; + +ok my $request = Net::HTTP::Spore::Request->new($env); + +ok my $http_req = $request->finalize(); +isa_ok($http_req, 'HTTP::Request'); + +is $env->{PATH_INFO}, '/test_spore'; +is $env->{QUERY_STRING}, 'key=foo&rev=123'; +is $http_req->uri->canonical, 'http://localhost/test_spore?key=foo&rev=123'; + +done_testing; diff --git a/t/spore-request/new.t b/t/spore-request/new.t new file mode 100644 index 0000000..6cb9d56 --- /dev/null +++ b/t/spore-request/new.t @@ -0,0 +1,25 @@ +use strict; +use Test::More; +use Net::HTTP::Spore::Request; + +my $req = Net::HTTP::Spore::Request->new( + { + REQUEST_METHOD => 'GET', + SERVER_PROTOCOL => 'HTTP/1.1', + SERVER_PORT => 80, + SERVER_NAME => 'example.com', + SCRIPT_NAME => '/foo', + REMOTE_ADDR => '127.0.0.1', + 'spore.scheme' => 'http', + } +); + +isa_ok( $req, 'Net::HTTP::Spore::Request' ); + +is( $req->method, 'GET', 'method' ); +is( $req->protocol, 'HTTP/1.1', 'protocol' ); +is( $req->uri, 'http://example.com/foo', 'uri' ); +is( $req->port, 80, 'port' ); +is( $req->scheme, 'http', 'url_scheme' ); + +done_testing(); diff --git a/t/spore-request/path_info.t b/t/spore-request/path_info.t new file mode 100644 index 0000000..020a958 --- /dev/null +++ b/t/spore-request/path_info.t @@ -0,0 +1,25 @@ +use strict; +use Test::More; + +use Net::HTTP::Spore::Request; + +my $env = { + REQUEST_METHOD => 'GET', + SERVER_NAME => 'localhost', + SERVER_PORT => '80', + SCRIPT_NAME => '', + PATH_INFO => '/:database/:key', + REQUEST_URI => '', + QUERY_STRING => '', + SERVER_PROTOCOL => 'HTTP/1.0', + 'spore.params' => [qw/database test_spore key foo/], +}; + +ok my $request = Net::HTTP::Spore::Request->new($env); + +is $request->path_info, '/test_spore/foo'; + +$env->{'spore.params'} = [qw/database test_spore key foo another key/]; +is $request->path_info, '/test_spore/foo'; + +done_testing; diff --git a/t/spore-request/query_string.t b/t/spore-request/query_string.t new file mode 100644 index 0000000..2ee7979 --- /dev/null +++ b/t/spore-request/query_string.t @@ -0,0 +1,25 @@ +use strict; +use Test::More; + +use Net::HTTP::Spore::Request; + +my $env = { + REQUEST_METHOD => 'GET', + SERVER_NAME => 'localhost', + SERVER_PORT => '80', + SCRIPT_NAME => '', + PATH_INFO => '/:database', + REQUEST_URI => '', + QUERY_STRING => '', + SERVER_PROTOCOL => 'HTTP/1.0', + 'spore.params' => [qw/database test_spore key foo rev 123/], +}; + +ok my $request = Net::HTTP::Spore::Request->new($env); + +is $request->query_string, 'key=foo&rev=123'; + +$env->{PATH_INFO} = '/:database/:key'; +is $request->query_string, 'rev=123'; + +done_testing; diff --git a/t/spore-request/uri.t b/t/spore-request/uri.t new file mode 100644 index 0000000..d3f8b82 --- /dev/null +++ b/t/spore-request/uri.t @@ -0,0 +1,109 @@ +use strict; +use warnings; +use Test::More; + +use Net::HTTP::Spore::Request; + +my @tests = ( + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => "", + }, + uri => 'http://example.com/', + parameters => {} + }, + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => "", + PATH_INFO => "/foo bar", + }, + uri => 'http://example.com/foo%20bar', + parameters => {} + }, + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => '/test.c', + }, + uri => 'http://example.com/test.c', + parameters => {} + }, + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => '/test.c', + PATH_INFO => '/info', + }, + uri => 'http://example.com/test.c/info', + parameters => {} + }, + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => '/test', + 'spore.params' => [qw/dynamic daikuma/], + }, + uri => 'http://example.com/test?dynamic=daikuma', + parameters => { dynamic => 'daikuma' } + }, + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => '/exec/' + }, + uri => 'http://example.com/exec/', + parameters => {} + }, + { + add_env => { SERVER_NAME => 'example.com' }, + uri => 'http://example.com/', + parameters => {} + }, + { + add_env => {}, + uri => 'http:///', + parameters => {} + }, + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => "", + 'spore.params' => [qw/aco tie/], + }, + uri => 'http://example.com/?aco=tie', + parameters => { aco => 'tie' } + }, + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => "", + 'spore.params' => [qw/0/], + }, + uri => 'http://example.com/?0', + parameters => {} + }, + { + add_env => { + HTTP_HOST => 'example.com', + SCRIPT_NAME => "/foo bar", + PATH_INFO => "/baz quux", + }, + uri => 'http://example.com/foo%20bar/baz%20quux', + parameters => {} + } +); + +plan tests => 1 * @tests; + +for my $block (@tests) { + my $env = { SERVER_PORT => 80 }; + while ( my ( $key, $val ) = each %{ $block->{add_env} || {} } ) { + $env->{$key} = $val; + } + my $req = Net::HTTP::Spore::Request->new($env); + + is $req->uri, $block->{uri}; +# is_deeply $req->query_parameters, $block->{parameters}; +} diff --git a/t/spore-response/body.t b/t/spore-response/body.t new file mode 100644 index 0000000..2a35d6b --- /dev/null +++ b/t/spore-response/body.t @@ -0,0 +1,21 @@ +use strict; +use warnings; +use Test::More; +use Net::HTTP::Spore::Response; +use URI; + +sub r($) { + my $res = Net::HTTP::Spore::Response->new(200); + $res->body(@_); + return $res->finalize->[2]; +} + +is_deeply r "Hello World", "Hello World"; +is_deeply r [ "Hello", "World" ], [ "Hello", "World" ]; + +{ + my $uri = URI->new("foo"); # stringified object + is_deeply r $uri, $uri; +} + +done_testing; diff --git a/t/spore-response/headers.t b/t/spore-response/headers.t new file mode 100644 index 0000000..b9cf319 --- /dev/null +++ b/t/spore-response/headers.t @@ -0,0 +1,20 @@ +use strict; +use warnings; + +use Test::More; +use Net::HTTP::Spore::Response; + +my $status = 200; +my $body = '{"foo":1}'; +my $ct = 'application/json'; +my $cl = length($body); + +my $response = + Net::HTTP::Spore::Response->new( $status, + [ 'Content-Type', $ct, 'Content-Length', length($body) ], $body ); + +is $response->content_type, $ct; +is $response->content_length, $cl; +is $response->status, 200; + +done_testing; diff --git a/t/spore-response/new.t b/t/spore-response/new.t new file mode 100644 index 0000000..fb271ab --- /dev/null +++ b/t/spore-response/new.t @@ -0,0 +1,34 @@ +use strict; +use warnings; +use Test::More; +use Net::HTTP::Spore::Response; + +{ + my $res = Net::HTTP::Spore::Response->new(302); + is $res->status, 302; + is $res->code, 302; +} + +{ + my $res = Net::HTTP::Spore::Response->new(200, [ 'Content-Type' => 'text/plain' ]); + is $res->content_type, 'text/plain'; +} + +{ + my $res = Net::HTTP::Spore::Response->new(200, { 'Content-Type' => 'text/plain' }); + is $res->content_type, 'text/plain'; +} + +{ + my $res = Net::HTTP::Spore::Response->new(200); + $res->content_type('image/png'); + is $res->content_type, 'image/png'; +} + +{ + my $res = Net::HTTP::Spore::Response->new(200); + $res->header('X-Foo' => "bar"); + is $res->header('X-Foo'), "bar"; +} + +done_testing; diff --git a/t/spore-response/response.t b/t/spore-response/response.t new file mode 100644 index 0000000..56be6d2 --- /dev/null +++ b/t/spore-response/response.t @@ -0,0 +1,23 @@ +use strict; +use warnings; +use Test::More; +use Net::HTTP::Spore::Response; + +sub res { + my $res = Net::HTTP::Spore::Response->new; + my %v = @_; + while ( my ( $k, $v ) = each %v ) { + $res->$k($v); + } + $res->finalize; +} + +is_deeply( + res( + status => 200, + body => 'hello', + ), + [ 200, +[], 'hello' ] +); + +done_testing; |