File Coverage

blib/lib/Net/HTTP/API/Meta/Method.pm
Criterion Covered Total %
statement 2 4 50.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 4 6 66.6


line stmt bran cond sub pod time code
1             package Net::HTTP::API::Meta::Method;
2             BEGIN {
3 1     1   25993 $Net::HTTP::API::Meta::Method::VERSION = '0.14';
4             }
5              
6             # ABSTRACT: create api method
7              
8 1     1   1471 use Moose;
  0            
  0            
9             use Net::HTTP::API::Error;
10             use Moose::Util::TypeConstraints;
11              
12             use MooseX::Types::Moose qw/Str Int ArrayRef/;
13              
14             extends 'Moose::Meta::Method';
15              
16             subtype UriPath
17             => as 'Str'
18             => where { $_ =~ m!^/! }
19             => message {"path must start with /"};
20              
21             enum Method => qw(HEAD GET POST PUT DELETE);
22              
23             has path => (is => 'ro', isa => 'UriPath', required => 1);
24             has method => (is => 'ro', isa => 'Method', required => 1);
25             has description => (is => 'ro', isa => 'Str', predicate => 'has_description');
26             has strict => (is => 'ro', isa => 'Bool', default => 1,);
27             has authentication => (
28             is => 'ro',
29             isa => 'Bool',
30             predicate => 'has_authentication',
31             default => 0
32             );
33             has expected => (
34             traits => ['Array'],
35             is => 'ro',
36             isa => ArrayRef [Int],
37             auto_deref => 1,
38             required => 0,
39             predicate => 'has_expected',
40             handles => {find_expected_code => 'grep',},
41             );
42             has params => (
43             traits => ['Array'],
44             is => 'ro',
45             isa => ArrayRef [Str],
46             required => 0,
47             default => sub { [] },
48             auto_deref => 1,
49             handles => {find_request_parameter => 'first',}
50             );
51             has params_in_url => (
52             traits => ['Array'],
53             is => 'ro',
54             isa => ArrayRef [Str],
55             required => 0,
56             default => sub { [] },
57             auto_deref => 0,
58             handles => {find_request_url_parameters => 'first'}
59             );
60             has required => (
61             traits => ['Array'],
62             is => 'ro',
63             isa => ArrayRef [Str],
64             default => sub { [] },
65             auto_deref => 1,
66             required => 0,
67             );
68             has documentation => (
69             is => 'ro',
70             isa => 'Str',
71             lazy => 1,
72             default => sub {
73             my $self = shift;
74             my $doc;
75             $doc .= "name: " . $self->name . "\n";
76             $doc .= "description: " . $self->description . "\n"
77             if $self->has_description;
78             $doc .= "method: " . $self->method . "\n";
79             $doc .= "path: " . $self->path . "\n";
80             $doc .= "arguments: " . join(', ', $self->params) . "\n"
81             if $self->params;
82             $doc .= "required: " . join(', ', $self->required) . "\n"
83             if $self->required;
84             $doc;
85             }
86             );
87              
88             before wrap => sub {
89             my ($class, %args) = @_;
90              
91             if (!$args{params} && $args{required}) {
92             die Net::HTTP::API::Error->new(
93             reason => "You can't require a param that have not been declared");
94             }
95              
96             if ( $args{required} ) {
97             foreach my $required ( @{ $args{required} } ) {
98             die Net::HTTP::API::Error->new( reason =>
99             "$required is required but is not declared in params" )
100             if ( !grep { $_ eq $required } @{ $args{params} }, @{$args{params_in_url}} );
101             }
102             }
103             };
104              
105             sub wrap {
106             my ($class, %args) = @_;
107              
108             if (!defined $args{body}) {
109             my $code = sub {
110             my ($self, %method_args) = @_;
111              
112             my $method = $self->meta->find_net_api_method_by_name($args{name});
113              
114             $method->_validate_before_execute(\%method_args);
115             my $path = $method->_build_path(\%method_args);
116             my $local_url = $method->_build_uri($self, $path);
117              
118             my $result = $self->http_request(
119             $method->method => $local_url,
120             $method->params_in_url, \%method_args
121             );
122              
123             my $code = $result->code;
124              
125             if ($method->has_expected
126             && !$method->find_expected_code(sub {/$code/}))
127             {
128             die Net::HTTP::API::Error->new(
129             reason => "unexpected code",
130             http_error => $result
131             );
132             }
133              
134             my $content = $self->get_content($result);;
135              
136             if ($result->is_success) {
137             if (wantarray) {
138             return ($content, $result);
139             }
140             else {
141             return $content;
142             }
143             }
144              
145             die Net::HTTP::API::Error->new(
146             http_error => $result,
147             reason => $result->message,
148             );
149             };
150             $args{body} = $code;
151             }
152              
153             $class->SUPER::wrap(%args);
154             }
155              
156             sub _validate_before_execute {
157             my ($self, $args) = @_;
158             for my $method (qw/_check_params_before_run _check_required_before_run/) {
159             $self->$method($args);
160             }
161             }
162              
163             sub _check_params_before_run {
164             my ($self, $args) = @_;
165              
166             return if !$self->strict;
167              
168             # check if there is no undeclared param
169             foreach my $arg (keys %$args) {
170             if ( !$self->find_request_parameter(sub {/$arg/})
171             && !$self->find_request_url_parameters(sub {/$arg/}))
172             {
173             die Net::HTTP::API::Error->new(
174             reason => "'$arg' is not declared as a param");
175             }
176             }
177             }
178              
179             sub _check_required_before_run {
180             my ($self, $args) = @_;
181              
182             # check if all our params declared as required are present
183             foreach my $required ($self->required) {
184             if (!grep { $required eq $_ } keys %$args) {
185             die Net::HTTP::API::Error->new(reason =>
186             "'$required' is declared as required, but is not present");
187             }
188             }
189             }
190              
191             sub _build_path {
192             my ($self, $args) = @_;
193             my $path = $self->path;
194              
195             my $max_iter = keys %$args;
196             my $i = 0;
197             while ($path =~ /(?:\$|:)(\w+)/g) {
198             my $match = $1;
199             $i++;
200             if (my $value = delete $args->{$match}) {
201             $path =~ s/(?:\$|:)$match/$value/;
202             }
203             if ($max_iter > $i) {
204             $path =~ s/\/(?:(\$|\:).*)?$//;
205             }
206             }
207             $path =~ s/\/(?:(\$|\:).*)?$//;
208             return $path;
209             }
210              
211             sub _build_uri {
212             my ($method, $self, $path) = @_;
213              
214             my $local_url = $self->api_base_url->clone;
215             my $path_url_base = $local_url->path;
216             $path_url_base =~ s/\/$// if $path_url_base =~ m!/$!;
217             $path_url_base .= $path;
218              
219             if ($self->api_format && $self->api_format_mode eq 'append') {
220             my $format = $self->api_format;
221             $path_url_base .= "." . $format;
222             }
223              
224             $local_url->path($path_url_base);
225             return $local_url;
226             }
227              
228             1;
229              
230              
231             __END__
232             =pod
233              
234             =head1 NAME
235              
236             Net::HTTP::API::Meta::Method - create api method
237              
238             =head1 VERSION
239              
240             version 0.14
241              
242             =head1 SYNOPSIS
243              
244             =head1 DESCRIPTION
245              
246             =head1 AUTHOR
247              
248             franck cuny <franck@lumberjaph.net>
249              
250             =head1 COPYRIGHT AND LICENSE
251              
252             This software is copyright (c) 2010 by linkfluence.
253              
254             This is free software; you can redistribute it and/or modify it under
255             the same terms as the Perl 5 programming language system itself.
256              
257             =cut
258