File Coverage

blib/lib/Net/Twitter/API.pm
Criterion Covered Total %
statement 77 77 100.0
branch 27 32 84.3
condition 5 9 55.5
subroutine 128 129 99.2
pod 4 5 80.0
total 241 252 95.6


line stmt bran cond sub pod time code
1             package Net::Twitter::API;
2             $Net::Twitter::API::VERSION = '4.01043';
3 32     63   190 use Moose ();
  32         54  
  32         738  
4 32     32   130 use Carp::Clan qw/^(?:Net::Twitter|Moose|Class::MOP)/;
  32         54  
  32         157  
5 32     32   4830 use Moose::Exporter;
  32         54  
  32         160  
6 32     32   914 use URI::Escape;
  32         65  
  32         1549  
7 32     32   15817 use DateTime::Format::Strptime;
  32         1384742  
  32         123  
8              
9 32     32   2276 use namespace::autoclean;
  32         61  
  32         129  
10              
11             Moose::Exporter->setup_import_methods(
12                 with_caller => [ qw/base_url authenticate datetime_parser twitter_api_method/ ],
13             );
14              
15             my $_base_url;
16 91     91 1 433 sub base_url { $_base_url = $_[1] }
17              
18             # kludge: This is very transient!
19             my $do_auth;
20 91     91 1 333 sub authenticate { $do_auth = $_[1] }
21              
22             # provide a default: we'll use the format of the REST API
23             my $datetime_parser = DateTime::Format::Strptime->new(pattern => '%a %b %d %T %z %Y');
24 74     74 1 1253 sub datetime_parser { $datetime_parser = $_[1] }
25              
26             sub twitter_api_method {
27 3663     3663 1 12291     my $caller = shift;
28 3663         5141     my $name = shift;
29 3663         21642     my %options = (
30                     authenticate => $do_auth,
31                     datetime_parser => $datetime_parser,
32                     base_url_method => $_base_url,
33                     path_suffix => '.json',
34                     @_,
35                 );
36              
37       0         my $deprecation_coderef = ref $options{deprecated} eq ref sub {}
38 1     1   5                             ? sub { $options{deprecated}->($name) }
39 3663 100   667   21961                             : sub {};
40              
41 3663         15353     my $class = Moose::Meta::Class->initialize($caller);
42              
43 3663         53839     my ($arg_names, $path) = @options{qw/required path/};
44 3663 100 100     8542     $arg_names = $options{params} if @$arg_names == 0 && @{$options{params}} == 1;
  2038         5767  
45              
46                 my $code = sub {
47 668     668   390198         my $self = shift;
        668      
        668      
        699      
        699      
        492      
        668      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        382      
        668      
        699      
        699      
        699      
        699      
        699      
        937      
        699      
        699      
        699      
        492      
        668      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        699      
        492      
        461      
        719      
        750      
        988      
        750      
        988      
        988      
        750      
        750      
        750      
        988      
        988      
        781      
        957      
        750      
        988      
        750      
        750      
        699      
        699      
        699      
        699      
        699      
        937      
        699      
        699      
        699      
        632      
        668      
        699      
        699      
        937      
        937      
        699      
        699      
        699      
        492      
        668      
        699      
        492      
        668      
        937      
        699      
        730      
        668      
        699      
        699      
        937      
        699      
        699      
        699      
        699      
        699      
        937      
        699      
        382      
        668      
        937      
        1175      
        699      
        699      
        238      
        238      
48              
49             # give the deprecation coderef early access in case it intends to die
50 668         1632         $deprecation_coderef->();
51              
52             # copy callers args since we may add ->{source}
53 668 100       2015         my $args = ref $_[-1] eq 'HASH' ? { %{pop @_} } : {};
  220         651  
54              
55             # flatten array arguments
56 668         1228         for ( qw/id user_id screen_name/ ) {
57 2004 100       3598             $args->{$_} = join ',' => @{ $args->{$_} } if ref $args->{$_} eq 'ARRAY';
  9         32  
58                     }
59              
60 668         2016         $self->_remap_legacy_synthetic_args($args);
61              
62 668 100       1696         croak sprintf "$name expected %d args", scalar @$arg_names if @_ > @$arg_names;
63              
64             # promote positional args to named args
65 667         1409         for ( my $i = 0; @_; ++$i ) {
66 239         390             my $param = $arg_names->[$i];
67                         croak "duplicate param $param: both positional and named"
68 239 50       377                 if exists $args->{$param};
69              
70 239         637             $args->{$param} = shift;
71                     }
72              
73 667 100 33     1818         $args->{source} ||= $self->source if $options{add_source};
74              
75 667 100       1484         my $authenticate = exists $args->{-authenticate} ? $args->{-authenticate} : $options{authenticate};
76              
77             # promote boolean parameters
78 667         798         for my $boolean_arg ( @{ $options{booleans} } ) {
  667         1419  
79 622 100       1192             if ( exists $args->{$boolean_arg} ) {
80 8 50       41                 next if $args->{$boolean_arg} =~ /^true|false$/;
81 8 100       25                 $args->{$boolean_arg} = $args->{$boolean_arg} ? 'true' : 'false';
82                         }
83                     }
84              
85             # Workaround Twitter bug: any value passed for skip_user is treated as true.
86             # The only way to get 'false' is to not pass the skip_user at all.
87 667 50 33     1348         delete $args->{skip_user} if exists $args->{skip_user} && $args->{skip_user} eq 'false';
88              
89             # replace placeholder arguments
90 667         1000         my $local_path = $path;
91 667 100       1705         $local_path =~ s,/:id$,, unless exists $args->{id}; # remove optional trailing id
92 667 50       1467         $local_path =~ s/:(\w+)/delete $args->{$1} or croak "required arg '$1' missing"/eg;
  179         755  
93              
94 667         880         my $uri = URI->new($self->${ \$options{base_url_method} } . "/$local_path$options{path_suffix}");
  667         20947  
95              
96                     return $self->_json_request(
97                         $options{method},
98                         $uri,
99                         $args,
100                         $authenticate,
101                         $options{datetime_parser},
102                         $options{content_type}
103 667         167095         );
104 3663         14528     };
105              
106 3663         16300     $class->add_method(
107                     $name,
108                     Net::Twitter::Meta::Method->new(
109                         name => $name,
110                         package_name => $caller,
111                         body => $code,
112                         %options,
113                     ),
114                 );
115              
116 3663 100       9117973     $class->add_method($_, $code) for @{$options{aliases} || []};
  3663         21248  
117             }
118              
119             package Net::Twitter::Meta::Method;
120             $Net::Twitter::Meta::Method::VERSION = '4.01043';
121 32     32   23134 use Moose;
  32         67  
  32         190  
122 32     32   180393 use Carp::Clan qw/^(?:Net::Twitter|Moose|Class::MOP)/;
  32         56  
  32         216  
123             extends 'Moose::Meta::Method';
124              
125 32     32   5642 use namespace::autoclean;
  32         61  
  32         119  
126              
127             has description => ( isa => 'Str', is => 'ro', required => 1 );
128             has aliases => ( isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] } );
129             has path => ( isa => 'Str', is => 'ro', required => 1 );
130             has method => ( isa => 'Str', is => 'ro', default => 'GET' );
131             has add_source => ( isa => 'Bool', is => 'ro', default => 0 );
132             has params => ( isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] } );
133             has required => ( isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] } );
134             has returns => ( isa => 'Str', is => 'ro', predicate => 'has_returns' );
135             has deprecated => ( isa => 'Bool|CodeRef', is => 'ro', default => 0 );
136             has booleans => ( isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] } );
137             has authenticate => ( isa => 'Bool', is => 'ro', required => 1 );
138             has datetime_parser => ( is => 'ro', required => 1 );
139             has base_url_method => ( isa => 'Str', is => 'ro', required => 1 );
140             has path_suffix => ( isa => 'Str', is => 'ro', required => 1 );
141             has content_type => ( isa => 'Str', is => 'ro', default => '' );
142              
143             # TODO: can MooseX::StrictConstructor be made to work here?
144             my %valid_attribute_names = map { $_->init_arg => 1 }
145                                         __PACKAGE__->meta->get_all_attributes;
146              
147             sub new {
148 3663     3694 0 5039     my $class = shift;
149 3663         14501     my %args = @_;
150              
151 3663         11268     my @invalid_attributes = grep { !$valid_attribute_names{$_} } keys %args;
  50336         68460  
152 3663 50       8355     croak "unexpected argument(s): @invalid_attributes" if @invalid_attributes;
153              
154 3663         10418     $class->SUPER::wrap(@_);
155             }
156              
157             1;
158              
159             __END__
160            
161             =head1 NAME
162            
163             Net::Twitter::API - Moose sugar for defining Twitter API methods
164            
165             =head1 VERSION
166            
167             version 4.01043
168            
169             =head1 SYNOPSIS
170            
171             package My::Twitter::API;
172             use Moose::Role;
173             use Net::Twitter::API;
174            
175             use namespace::autoclean;
176            
177             has apiurl => ( isa => 'Str', is => 'rw', default => 'http://twitter.com' );
178            
179             base_url 'apiurl';
180            
181             twitter_api_method friends_timeline => (
182             description => <<'',
183             Returns the 20 most recent statuses posted by the authenticating user
184             and that user's friends. This is the equivalent of /home on the Web.
185            
186             aliases => [qw/following_timeline/],
187             path => 'statuses/friends_timeline',
188             method => 'GET',
189             params => [qw/since_id max_id count page/],
190             required => [],
191             returns => 'ArrayRef[Status]',
192             );
193            
194             1;
195            
196             =head1 DESCRIPTION
197            
198             This module provides some Moose sugar for defining Twitter API methods. It is part
199             of the Net-Twitter distribution on CPAN and is used by C<Net::Twitter::API::RESTv1_1>,
200             C<Net::Twitter::API::Search>, and perhaps others.
201            
202             It's intent is to make maintaining C<Net::Twitter> as easy as possible.
203            
204             =head1 METHODS
205            
206             =over 4
207            
208             =item base_url
209            
210             Specifies, by name, the attribute which contains the base URL for the defined API.
211            
212             =item twitter_api_method
213            
214             Defines a Twitter API method. Valid arguments are:
215            
216             =over 4
217            
218             =item authenticate
219            
220             Specifies whether, by default, API methods calls should authenticate.
221            
222             =item datetime_parser
223            
224             Specifies the Date::Time::Format derived parser to use for parsing and
225             formatting date strings for the API being defined.
226            
227             =item description
228            
229             A string describing the method, suitable for documentation.
230            
231             =item aliases
232            
233             An ARRAY ref of strings containing alternate names for the method.
234            
235             =item path
236            
237             A string containing the path part of the API URL
238            
239             =item path_suffix
240            
241             A string containing an additional suffix to append to the path (for
242             legacy reasons). If you want to suffix appended, pass the empty
243             string. Defaults to ".json".
244            
245             =item method
246            
247             A string containing the HTTP method for the call. Defaults to "GET".
248            
249             =item add_source
250            
251             A boolean, indicating whether or not the C<source> parameter should be added
252             to the API call. (The source value is assigned by Twitter for registered
253             applications.) Defaults to 0.
254            
255             =item params
256            
257             An ARRAY ref of strings naming all of the valid parameters. Defaults to an
258             empty ARRAY ref.
259            
260             =item required
261            
262             An ARRAY ref of strings naming all of the required parameters. Defaults to an
263             empty ARRAY ref.
264            
265             =item returns
266            
267             A string describing the return type of the API method call.
268            
269             =item deprecated
270            
271             A boolean indicating whether or not this API is deprecated. If set to 1, code
272             for the method will be created. This option is optional, and is used by the
273             C<Net-Twitter> distribution when generating documentation. It defaults to 0.
274            
275             =back
276            
277             =back
278            
279             =head1 AUTHOR
280            
281             Marc Mims <marc@questright.com>
282            
283             =head1 LICENSE
284            
285             Copyright (c) 2016 Marc Mims
286            
287             The Twitter API itself, and the description text used in this module is:
288            
289             Copyright (c) 2009 Twitter
290            
291             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
292            
293             =head1 DISCLAIMER OF WARRANTY
294            
295             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
296             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
297             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
298             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
299             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
300             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
301             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
302             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
303             NECESSARY SERVICING, REPAIR, OR CORRECTION.
304            
305             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
306             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
307             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE
308             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
309             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
310             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
311             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
312             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
313             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
314             SUCH DAMAGES.
315