File Coverage

blib/lib/Net/HTTP/Spore/Meta/Method.pm
Criterion Covered Total %
statement 51 52 98.0
branch 24 28 85.7
condition 5 6 83.3
subroutine 8 8 100.0
pod 1 1 100.0
total 89 95 93.6


line stmt bran cond sub pod time code
1             package Net::HTTP::Spore::Meta::Method;
2             $Net::HTTP::Spore::Meta::Method::VERSION = '0.07';
3             # ABSTRACT: create api method
4              
5 22     22   78351 use JSON;
  22         11344  
  22         184  
6 22     22   2853 use Moose;
  22         361117  
  22         130  
7              
8 22     22   139707 use MooseX::Types::Moose qw/Str Int ArrayRef HashRef/;
  22         1136577  
  22         212  
9 22     22   117998 use MooseX::Types::URI qw/Uri/;
  22         2680419  
  22         161  
10              
11             extends 'Moose::Meta::Method';
12 22     22   46473 use Net::HTTP::Spore::Response;
  22         66  
  22         745  
13 22     22   6990 use Net::HTTP::Spore::Meta::Types qw(UriPath HTTPMethod Boolean);
  22         85  
  22         135  
14              
15             has path => ( is => 'ro', isa => UriPath, required => 1 );
16             has method => ( is => 'ro', isa => HTTPMethod, required => 1 );
17             has description => ( is => 'ro', isa => Str, predicate => 'has_description' );
18              
19             has required_payload => (
20             is => 'ro',
21             isa => Boolean,
22             predicate => 'payload_is_required',
23             lazy => 1,
24             default => 0,
25             coerce => 1,
26             );
27             has authentication => (
28             is => 'ro',
29             isa => Boolean,
30             predicate => 'has_authentication',
31             default => 0,
32             lazy => 1,
33             coerce => 1,
34             );
35             has base_url => (
36             is => 'ro',
37             isa => Uri,
38             coerce => 1,
39             predicate => 'has_base_url',
40             );
41             has formats => (
42             is => 'ro',
43             isa => ArrayRef[Str],
44             predicate => 'has_formats',
45             );
46             has headers => (
47             is => 'ro',
48             isa => HashRef[Str],
49             predicate => 'has_headers',
50             );
51             has expected_status => (
52             traits => ['Array'],
53             is => 'ro',
54             isa => ArrayRef[Int],
55             auto_deref => 1,
56             predicate => 'has_expected_status',
57             handles => { find_expected_status => 'grep', },
58             );
59             has optional_params => (
60             traits => ['Array'],
61             is => 'ro',
62             isa => ArrayRef[Str],
63             predicate => 'has_optional_params',
64             auto_deref => 1,
65             );
66             has required_params => (
67             traits => ['Array'],
68             is => 'ro',
69             isa => ArrayRef[Str],
70             predicate => 'has_required_params',
71             auto_deref => 1,
72             );
73             has form_data => (
74             traits => ['Hash'],
75             is => 'ro',
76             isa => HashRef,
77             predicate => 'has_form_data',
78             auto_deref => 1,
79             );
80             has documentation => (
81             is => 'ro',
82             isa => Str,
83             lazy => 1,
84             default => sub {
85             my $self = shift;
86             my $doc;
87             $doc .= "name: " . $self->name . "\n";
88             $doc .= "description: " . $self->description . "\n"
89             if $self->has_description;
90             $doc .= "method: " . $self->method . "\n";
91             $doc .= "path: " . $self->path . "\n";
92             $doc .= "optional params: " . join(', ', $self->optional_params) . "\n"
93             if $self->has_optional_params;
94             $doc .= "required params: " . join(', ', $self->required_params) . "\n"
95             if $self->has_required_params;
96             $doc;
97             }
98             );
99              
100             sub wrap {
101 125     125 1 50279 my ( $class, %args ) = @_;
102              
103 125         270 my $name = $args{name};
104             my $code = sub {
105 25     25   393 my ( $self, %method_args ) = @_;
106              
107 25         106 my $method = $self->meta->find_spore_method_by_name( $name );
108              
109             my $payload =
110             ( defined $method_args{spore_payload} )
111             ? delete $method_args{spore_payload}
112 25 50       349 : delete $method_args{payload};
113              
114 25 100 100     174 if ( $payload
115             && ( $method->method !~ /^(?:POST|PUT|PATCH)$/i ) )
116             {
117 1         6 die Net::HTTP::Spore::Response->new( 599, [],
118             { error => "payload requires a PUT, PATCH or POST method" },
119             );
120             }
121              
122 24 100 66     986 if ( $method->payload_is_required && !$payload ) {
123 2         14 die Net::HTTP::Spore::Response->new(
124             599,
125             [],
126             {
127             error => "this method require a payload, and no payload is provided",
128             }
129             );
130             }
131              
132 22 100       821 if ($method->has_required_params) {
133 2         71 foreach my $required ( $method->required_params ) {
134 2 50       9 if ( !grep { $required eq $_ } keys %method_args ) {
  2         14  
135 0         0 die Net::HTTP::Spore::Response->new(
136             599,
137             [],
138             {
139             error =>
140             "$required is marked as required but is missing",
141             }
142             );
143             }
144             }
145             }
146              
147 22         53 my $params;
148 22         81 foreach (keys %method_args) {
149 4         13 push @$params, $_, $method_args{$_};
150             }
151              
152 22 100       762 my $authentication =
153             $method->has_authentication ? $method->authentication : $self->authentication;
154              
155 22 50       747 my $formats = $method->has_formats ? $method->formats : $self->formats;
156              
157 22 50       756 my $base_url =
158             $method->has_base_url
159             ? $method->base_url
160             : $self->base_url;
161              
162 22 100       632 my $env = {
163             REQUEST_METHOD => $method->method,
164             SERVER_NAME => $base_url->host,
165             SERVER_PORT => $base_url->port,
166             SCRIPT_NAME => (
167             $base_url->path eq '/'
168             ? ''
169             : $base_url->path
170             ),
171             PATH_INFO => $method->path,
172             REQUEST_URI => '',
173             QUERY_STRING => '',
174             HTTP_USER_AGENT => $self->api_useragent->agent,
175             'spore.expected_status' => [ $method->expected_status ],
176             'spore.authentication' => $authentication,
177             'spore.params' => $params,
178             'spore.payload' => $payload,
179             'spore.errors' => *STDERR,
180             'spore.url_scheme' => $base_url->scheme,
181             'spore.userinfo' => $base_url->userinfo,
182             'spore.formats' => $formats,
183             };
184              
185 22 100       2655 $env->{'spore.form_data'} = $method->form_data
186             if $method->has_form_data;
187              
188 22 100       700 $env->{'spore.headers'} = $method->headers if $method->has_headers;
189              
190 22         380 my $response = $self->http_request($env);
191 22         364 my $code = $response->status;
192              
193             my $ok = ($method->has_expected_status)
194 3         11 ? $method->find_expected_status( sub { $_ eq $code } )
195 22 100       904 : $response->is_success; # only 2xx is success
196 22 100       112 die $response if not $ok;
197              
198 18         110 $response;
199 125         923 };
200 125         273 $args{body} = $code;
201              
202 125 100       315 if ($args{'form-data'}){
203 20         63 $args{'form_data'} = delete $args{'form-data'};
204             }
205              
206 125         653 $class->SUPER::wrap(%args);
207             }
208              
209             1;
210              
211             __END__
212              
213             =pod
214              
215             =encoding UTF-8
216              
217             =head1 NAME
218              
219             Net::HTTP::Spore::Meta::Method - create api method
220              
221             =head1 VERSION
222              
223             version 0.07
224              
225             =head1 SYNOPSIS
226              
227             my $spore_method = Net::HTTP::Spore::Meta::Method->wrap(
228             'user_timeline',
229             method => 'GET',
230             path => '/user/:name'
231             );
232              
233             =head1 DESCRIPTION
234              
235             =head1 METHODS
236              
237             =over 4
238              
239             =item B<path>
240              
241             =item B<method>
242              
243             =item B<description>
244              
245             =item B<authentication>
246              
247             =item B<base_url>
248              
249             =item B<formats>
250              
251             =item B<expected_status>
252              
253             =item B<params>
254              
255             =item B<documentation>
256              
257             =back
258              
259             =head1 AUTHORS
260              
261             =over 4
262              
263             =item *
264              
265             Franck Cuny <franck.cuny@gmail.com>
266              
267             =item *
268              
269             Ash Berlin <ash@cpan.org>
270              
271             =item *
272              
273             Ahmad Fatoum <athreef@cpan.org>
274              
275             =back
276              
277             =head1 COPYRIGHT AND LICENSE
278              
279             This software is copyright (c) 2012 by Linkfluence.
280              
281             This is free software; you can redistribute it and/or modify it under
282             the same terms as the Perl 5 programming language system itself.
283              
284             =cut