File Coverage

blib/lib/WebService/ReviewBoard.pm
Criterion Covered Total %
statement 61 71 85.9
branch 12 26 46.1
condition 2 9 22.2
subroutine 15 16 93.7
pod 7 7 100.0
total 97 129 75.1


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