File Coverage

blib/lib/WebService/ReviewBoard.pm
Criterion Covered Total %
statement 56 68 82.3
branch 9 22 40.9
condition 3 9 33.3
subroutine 14 15 93.3
pod 7 7 100.0
total 89 121 73.5


line stmt bran cond sub pod time code
1             package WebService::ReviewBoard;
2              
3 6     6   1416638 use strict;
  6         16  
  6         228  
4 6     6   30 use warnings;
  6         13  
  6         145  
5              
6 6     6   5319 use JSON::Syck;
  6         32576  
  6         584  
7 6     6   8700 use Data::Dumper;
  6         65007  
  6         541  
8 6     6   8262 use Log::Log4perl qw(:easy);
  6         437438  
  6         70  
9 6     6   11635 use HTTP::Request::Common;
  6         185423  
  6         544  
10 6     6   7039 use LWP::UserAgent;
  6         171078  
  6         252  
11 6     6   6045 use version; our $VERSION = qv('0.1.1');
  6         15334  
  6         43  
12              
13             sub new {
14 5     5 1 1096 my $proto = shift;
15 5   66     36 my $url = shift || LOGDIE "usage: " . __PACKAGE__ . "->new( 'http://demo.review-board.org' );";
16              
17 4 50       54 if ( $url !~ m#^https?://# ) {
18 0         0 WARN "url you specified ($url) looks invalid. Must start with http://";
19 0         0 WARN "prefixing with http:// for you";
20 0         0 $url = "http://$url";
21             }
22              
23 4   33     48 my $class = ref $proto || $proto;
24 4         19 my $self = { review_board_url => $url, };
25              
26 4         34 return bless $self, $class;
27             }
28              
29 3     3 1 20 sub get_review_board_url { return shift->{review_board_url}; }
30              
31             sub login {
32 3     3 1 23 my $self = shift;
33 3 50       14 my $username = shift or LOGCROAK "you must pass login a username";
34 3 50       14 my $password = shift or LOGCROAK "you must pass login a password";
35              
36 3         32 my $json = $self->api_post(
37             '/api/json/accounts/login/',
38             [
39             username => $username,
40             password => $password
41             ]
42             );
43              
44 0         0 return 1;
45             }
46              
47             sub api_post {
48 3     3 1 6 my $self = shift;
49 3         23 $self->api_call( shift, 'POST', @_ );
50             }
51              
52             sub api_get {
53 0     0 1 0 my $self = shift;
54 0         0 $self->api_call( shift, 'GET', @_ );
55             }
56              
57             sub api_call {
58 3     3 1 8 my $self = shift;
59 3 50       14 my $path = shift or LOGDIE "No url path to api_post";
60 3 50       13 my $method = shift or LOGDIE "no method (POST or GET)";
61 3         47 my @options = @_;
62              
63 3         83 my $ua = $self->get_ua();
64              
65 3         47 my $url = $self->get_review_board_url() . $path;
66 3         8 my $request;
67 3 50       16 if ( $method eq "POST" ) {
    0          
68 3         25 $request = POST( $url, @options );
69             }
70             elsif ( $method eq "GET" ) {
71 0         0 $request = GET( $url, @options );
72             }
73             else {
74 0         0 LOGDIE "Unknown method $method. Valid methods are GET or POST";
75             }
76              
77 3         44169 DEBUG "Doing request:\n" . $request->as_string();
78 3         511 my $response = $ua->request($request);
79 3         1074720 DEBUG "Got response:\n" . $response->as_string();
80              
81 3         923 my $json;
82 3 50       17 if ( $response->is_success ) {
83 0         0 $json = JSON::Syck::Load( $response->decoded_content() );
84             }
85             else {
86 3         51 LOGDIE "Error fetching $path: " . $response->status_line . "\n";
87             }
88              
89             # check if there was an error
90 0 0 0     0 if ( $json->{err} && $json->{err}->{msg} ) {
91 0         0 LOGDIE "Error from $url: " . $json->{err}->{msg};
92             }
93              
94 0         0 return $json;
95             }
96              
97             # you can overload this method if you want to use a different useragent
98             sub get_ua {
99 3 50   3 1 24 my $self = shift or LOGCROAK "you must call get_ua as a method";
100              
101 3 50       12 if ( !$self->{ua} ) {
102 3         42 $self->{ua} = LWP::UserAgent->new( cookie_jar => {}, );
103             }
104              
105 3         44716 return $self->{ua};
106              
107             }
108              
109             1;
110              
111             __END__
112              
113             =head1 NAME
114              
115             WebService::ReviewBoard - Perl library to talk to a review board installation thru web services.
116              
117             =head1 SYNOPSIS
118              
119             use WebService::ReviewBoard;
120              
121             # pass in the name of the reviewboard url to the constructor
122             my $rb = WebService::ReviewBoard->new( 'http://demo.review-board.org/' );
123             $rb->login( 'username', 'password' );
124              
125             =head1 DESCRIPTION
126              
127             This is an alpha release of C<< WebService::ReviewBoard >>. The interface may change at any time and there
128             are many parts of the API that are not implemented. You've been warned!
129              
130             Patches welcome!
131              
132             =head1 INTERFACE
133              
134             =over
135              
136             =item C<< get_review_board_url >>
137              
138             =item C<< login >>
139              
140             =item C<< get_ua >>
141              
142             Returns an LWP::UserAgent object. You can override this method in a subclass if
143             you need to use a different LWP::UserAgent.
144              
145             =item C<< api_post >>
146              
147             Do the HTTP POST to the reviewboard API.
148              
149             =item C<< api_get >>
150              
151             Same as api_post, but do it with an HTTP GET
152              
153             =item C<< my $json = $rb->api_call( $path, $method, @options ) >>
154              
155             api_post and api_get use this internally
156              
157             =back
158              
159             =head1 DIAGNOSTICS
160              
161             =over
162              
163             =item C<< "Unknown method %s. Valid methods are GET or POST" >>
164              
165             =item C<< "you must pass WebService::ReviewBoard->new a username" >>
166              
167             =item C<< "you must pass WebService::ReviewBoard->new a password" >>
168              
169             =item C<< "No url path to api_post" >>
170              
171             =item C<< "Error fetching %s: %s" >>
172              
173             =item C<< "you must call %s as a method" >>
174              
175             =item C<< "get_review_board_url(): url you passed to new() ($url) looks invalid" >>
176              
177             =back
178              
179             =head1 CONFIGURATION AND ENVIRONMENT
180              
181             None.
182              
183             =head1 DEPENDENCIES
184              
185             version
186             YAML::Syck
187             Data::Dumper
188             Bundle::LWP
189             Log::Log4Perl
190              
191             There are also a bunch of Test::* modules that you need if you want all the tests to pass:
192              
193             Test::More
194             Test::Pod
195             Test::Exception
196             Test::Pod::Coverage
197             Test::Perl::Critic
198              
199             =head1 INCOMPATIBILITIES
200              
201             None reported.
202              
203             =head1 SOURCE CODE REPOSITORY
204              
205             This source lives at http://github.com/jaybuff/perl_WebService_ReviewBoard/
206              
207             =head1 BUGS AND LIMITATIONS
208              
209             No bugs have been reported.
210              
211             Please report any bugs or feature requests to
212             C<bug-webservice-reviewboard@rt.cpan.org>, or through the web interface at
213             L<http://rt.cpan.org>.
214              
215             =head1 AUTHOR
216              
217             Jay Buffington C<< <jaybuffington@gmail.com> >>
218              
219             =head1 LICENCE AND COPYRIGHT
220              
221             Copyright (c) 2008, Jay Buffington C<< <jaybuffington@gmail.com> >>. All rights reserved.
222              
223             This module is free software; you can redistribute it and/or
224             modify it under the same terms as Perl itself. See L<perlartistic>.
225              
226             =head1 DISCLAIMER OF WARRANTY
227              
228             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
229             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
230             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
231             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
232             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
233             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
234             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
235             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
236             NECESSARY SERVICING, REPAIR, OR CORRECTION.
237              
238             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
239             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
240             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
241             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
242             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
243             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
244             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
245             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
246             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
247             SUCH DAMAGES.