diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Net/HTTP/Spore.pm | 108 | ||||
| -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 | 51 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Meta/Method/Spore.pm | 6 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Role/Debug.pm | 14 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Role/Description.pm | 7 | ||||
| -rw-r--r-- | lib/Net/HTTP/Spore/Role/Request.pm | 1 |
8 files changed, 153 insertions, 37 deletions
diff --git a/lib/Net/HTTP/Spore.pm b/lib/Net/HTTP/Spore.pm index 34f4740..03606a0 100644 --- a/lib/Net/HTTP/Spore.pm +++ b/lib/Net/HTTP/Spore.pm @@ -8,70 +8,124 @@ use IO::All; use JSON; use Carp; use Try::Tiny; +use Scalar::Util; use Net::HTTP::Spore::Core; our $VERSION = 0.01; +# XXX should we let the possibility to override this super class, or add +# another superclasses? + sub new_from_string { my ($class, $string, %args) = @_; - my $spec; + my $spore_class = + Class::MOP::Class->create_anon_class( + superclasses => ['Net::HTTP::Spore::Core'] ); - try { - $spec = JSON::decode_json($string); - }catch{ - Carp::confess("unable to parse JSON spec: ".$_); - }; + my $spore_object = _attach_spec_to_class($string, \%args, $spore_class); + + return $spore_object; +} + +sub new_from_strings { + my $class = shift; - my ( $spore_class, $spore_object ); - # XXX should we let the possibility to override this super class, or add - # another superclasses? + my $opts; + if (ref ($_[-1]) eq 'HASH') { + $opts = pop @_; + } + my @strings = @_; - $spore_class = + my $spore_class = Class::MOP::Class->create_anon_class( superclasses => ['Net::HTTP::Spore::Core'] ); + my $spore_object = undef; + foreach my $string (@strings) { + $spore_object = _attach_spec_to_class($string, $opts, $spore_class, $spore_object); + } + return $spore_object; +} + +sub new_from_spec { + my ( $class, $spec_file, %args ) = @_; + + Carp::confess("specification file is missing") unless $spec_file; + + my $content = _read_spec($spec_file); + + $class->new_from_string( $content, %args ); +} + +sub new_from_specs { + my $class = shift; + + my $opts; + if (ref ($_[-1]) eq 'HASH') { + $opts = pop @_; + } + my @specs = @_; + + my @strings; + foreach my $spec (@specs) { + push @strings,_read_spec($spec); + } + + $class->new_from_strings(@strings, $opts); +} + +sub _attach_spec_to_class { + my ( $string, $opts, $class, $object ) = @_; + + my $spec; + try { + $spec = JSON::decode_json($string); + } + catch { + Carp::confess( "unable to parse JSON spec: " . $_ ); + }; + try { my $base_url; - if ( $spec->{base_url} && !$args{base_url} ) { - $args{base_url} = $spec->{base_url}; + if ( $spec->{base_url} && !$opts->{base_url} ) { + $opts->{base_url} = $spec->{base_url}; } - elsif ( !$args{base_url} ) { + elsif ( !$opts->{base_url} ) { die "base_url is missing!"; } if ( $spec->{formats} ) { - $args{formats} = $spec->{formats}; + $opts->{formats} = $spec->{formats}; } if ( $spec->{authentication} ) { - $args{authentication} = $spec->{authentication}; + $opts->{authentication} = $spec->{authentication}; } - $spore_object = $spore_class->new_object(%args); - $spore_object = _add_methods( $spore_object, $spec->{methods} ); - + if ( !$object ) { + $object = $class->new_object(%$opts); + } + $object = _add_methods( $object, $spec->{methods} ); } catch { Carp::confess( "unable to create new Net::HTTP::Spore object: " . $_ ); }; - return $spore_object; + return $object; } -sub new_from_spec { - my ( $class, $spec_file, %args ) = @_; - - Carp::confess("specification file is missing") unless $spec_file; +sub _read_spec { + my $spec_file = shift; - my ( $content, $spec ); + my $content; if ( $spec_file =~ m!^http(s)?://! ) { my $uri = URI->new($spec_file); - my $req = HTTP::Request->new(GET => $spec_file); + my $req = HTTP::Request->new( GET => $spec_file ); my $ua = LWP::UserAgent->new(); - my $res = $ua->request( $req ); + my $res = $ua->request($req); $content = $res->content; } else { @@ -81,7 +135,7 @@ sub new_from_spec { $content < io($spec_file); } - $class->new_from_string( $content, %args ); + return $content; } sub _add_methods { 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 b546d74..10132ed 100644 --- a/lib/Net/HTTP/Spore/Meta/Method.pm +++ b/lib/Net/HTTP/Spore/Meta/Method.pm @@ -50,12 +50,20 @@ 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 required_payload => ( + is => 'ro', + isa => 'Boolean', + predicate => 'payload_is_required', + lazy => 1, + default => 0, + coerce => 1, +); has authentication => ( is => 'ro', isa => 'Boolean', predicate => 'has_authentication', default => 0, - coerce => 1, + coerce => 1, ); has base_url => ( is => 'ro', @@ -82,17 +90,24 @@ has expected_status => ( handles => { find_expected_status => 'grep', }, ); has optional_params => ( - traits => ['Array'], - is => 'ro', - isa => ArrayRef [Str], - predicate => 'has_optional_params', + traits => ['Array'], + is => 'ro', + isa => ArrayRef [Str], + predicate => 'has_optional_params', auto_deref => 1, ); has required_params => ( - traits => ['Array'], - is => 'ro', - isa => ArrayRef [Str], - predicate => 'has_required_params', + traits => ['Array'], + is => 'ro', + isa => ArrayRef [Str], + predicate => 'has_required_params', + auto_deref => 1, +); +has form_data => ( + traits => ['Hash'], + is => 'ro', + isa => 'HashRef', + predicate => 'has_form_data', auto_deref => 1, ); has documentation => ( @@ -128,6 +143,24 @@ sub wrap { ? delete $method_args{spore_payload} : delete $method_args{payload}; + if ( $payload + && ( $method->method ne 'POST' || $method->method ne 'PUT' ) ) + { + die Net::HTTP::Spore::Response->new( 599, [], + { error => "payload requires a PUT or POST method" }, + ); + } + + if ( $method->payload_is_required && !$payload ) { + die Net::HTTP::Spore::Response->new( + 599, + [], + { + error => "this method require a payload, and no payload is provided", + } + ); + } + if ($method->has_required_params) { foreach my $required ( $method->required_params ) { if ( !grep { $required eq $_ } keys %method_args ) { diff --git a/lib/Net/HTTP/Spore/Meta/Method/Spore.pm b/lib/Net/HTTP/Spore/Meta/Method/Spore.pm index 1cea574..a616149 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/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/Description.pm b/lib/Net/HTTP/Spore/Role/Description.pm index 213955d..2723fef 100644 --- a/lib/Net/HTTP/Spore/Role/Description.pm +++ b/lib/Net/HTTP/Spore/Role/Description.pm @@ -24,4 +24,11 @@ has authentication => ( predicate => 'has_authentication', ); +has expected_status => ( + is => 'rw', + isa => 'Array', + lazy => 1, + default => sub { [] }, +); + 1; diff --git a/lib/Net/HTTP/Spore/Role/Request.pm b/lib/Net/HTTP/Spore/Role/Request.pm index d22a721..a0d61b1 100644 --- a/lib/Net/HTTP/Spore/Role/Request.pm +++ b/lib/Net/HTTP/Spore/Role/Request.pm @@ -66,6 +66,7 @@ sub _request { $result->headers, $result->content, ); + return $response; } |