summaryrefslogtreecommitdiff
path: root/lib/Net
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/HTTP/Spore.pm108
-rw-r--r--lib/Net/HTTP/Spore/Meta.pm1
-rw-r--r--lib/Net/HTTP/Spore/Meta/Class.pm2
-rw-r--r--lib/Net/HTTP/Spore/Meta/Method.pm51
-rw-r--r--lib/Net/HTTP/Spore/Meta/Method/Spore.pm6
-rw-r--r--lib/Net/HTTP/Spore/Role/Debug.pm14
-rw-r--r--lib/Net/HTTP/Spore/Role/Description.pm7
-rw-r--r--lib/Net/HTTP/Spore/Role/Request.pm1
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;
}
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-06 06:06:19 +0000