File Coverage

blib/lib/WWW/SourceForge.pm
Criterion Covered Total %
statement 39 81 48.1
branch 6 24 25.0
condition 4 17 23.5
subroutine 8 9 88.8
pod 2 3 66.6
total 59 134 44.0


line stmt bran cond sub pod time code
1             package WWW::SourceForge;
2 3     3   13478 use strict;
  3         6  
  3         88  
3 3     3   1424 use LWP::Simple qw(get);
  3         152711  
  3         18  
4 3     3   1592 use JSON::Parse;
  3         1744  
  3         115  
5 3     3   1256 use XML::Feed;
  3         438036  
  3         78  
6 3     3   1341 use File::HomeDir;
  3         11571  
  3         831  
7              
8             our $VERSION = '0.73'; # This is the overall version for the entire
9             # package, so should probably be updated even when the other modules are
10             # touched.
11              
12             =head2 new
13              
14             Usage : my $sfapi = new WWW::SourceForge;
15             Returns : WWW::SourceForge object
16              
17             Optionally pass an 'api' argument to select one of the other APIs.
18              
19             my $download_api = WWW::SourceForge->new( api => 'download' );
20              
21             See https://sourceforge.net/p/forge/documentation/Download%20Stats%20API/
22              
23             =cut
24              
25             sub new {
26 18     18 1 54 my ( $class, %parameters ) = @_;
27              
28 18   50     118 my $api = $parameters{api} || 'data';
29 18         35 my $api_url;
30              
31             # TODO: This stuff made sense when I wrote it, but until there's a
32             # single unified API, this is just confusing. Need to nuke this bit
33 18 50       71 if ( $api eq 'download' ) {
34 0         0 $api_url = 'http://sourceforge.net/projects';
35             } else {
36 18         48 $api_url = 'http://sourceforge.net/rest';
37             }
38              
39 18   33     142 my $self = bless(
40             {
41             api_url => $api_url,
42             api => $api,
43             },
44             ref($class) || $class
45             );
46              
47 18         79 return $self;
48             }
49              
50             =head2 call
51              
52             Usage : my $json = $sfapi->call(
53             method => whatever,
54             arg1 => 'value',
55             arg2 => 'another value',
56             format => 'rss',
57             );
58             Returns : Hashref, containing a bunch of data. Format defaults to
59             'json', but in some cases, you'll want to force rss because that's
60             how the return is available. Will try to make this smarter
61             eventually.
62              
63             Calls a particular method in the SourceForge API. Other args are passed
64             as args to that call.
65              
66             =cut
67              
68             sub call {
69 17     17 1 37 my $self = shift;
70 17         46 my %args = @_;
71              
72 17         26 my $r = {};
73 17         24 my $url;
74             my $format;
75              
76 17 50 33     111 if ( defined( $args{method} ) && ( $args{ method } eq 'proj_activity' ) ) {
    50          
77 0         0 my $project = $args{ project };
78 0         0 $url =
79             'http://sourceforge.net/export/rss2_keepsake.php?group_id=' .
80             $project->id();
81 0         0 $format = 'rss';
82             }
83              
84             # Download API, documented at
85             # https://sourceforge.net/p/forge/documentation/Download%20Stats%20API/
86             elsif ( $self->{api} eq 'download' ) {
87              
88             # TODO: Default start date, end date (last 7 days, perhaps?)
89              
90             # TODO: API allows specification of subdirs of the files
91             # hierarchy, and we don't allow that yet here.
92              
93             $url =
94             $self->{api_url} . '/'
95             . $args{project}
96             . '/files/stats/json?start_date=' . $args{start_date}
97 0         0 . '&end_date=' . $args{end_date};
98              
99 0         0 $format = 'json';
100              
101             # Data API, documented at
102             # https://sourceforge.net/p/forge/documentation/API/
103             } else {
104              
105             # HACK
106             # If a full URI is provided, use that
107 17 50       39 if ( $args{uri} ) {
108 17   50     95 $format = $args{format} || 'json';
109 17         43 $url = $self->{api_url} . $args{uri};
110             } else {
111              
112 0   0     0 my $method = $args{method} || return $r;
113 0         0 delete( $args{method} );
114              
115 0   0     0 $format = $args{format} || 'json';
116 0         0 delete( $args{format} );
117              
118 0         0 $url = $self->{api_url} . '/' . $method;
119             # $url .= '/' . join('/',@args);
120 0         0 foreach my $a ( keys %args ) {
121 0         0 $url .= '/' . $a . '/' . $args{$a};
122             }
123              
124             # Format defaults to 'json'
125 0         0 $url .= '/' . $format;
126             }
127             }
128              
129 17 50       48 if ( $format eq 'rss' ) {
130              
131 0         0 $r = { entries => [] };
132              
133 0         0 my $feed;
134 0         0 eval { $feed = XML::Feed->parse( URI->new($url) ) };
  0         0  
135 0 0       0 if ($@) {
136 0         0 warn $@;
137 0         0 return $r;
138             }
139             {
140 3     3   16 no warnings 'all';
  3         3  
  3         791  
  0         0  
141 0 0 0     0 if ( $feed && $feed->entries ) {
142 0         0 for my $entry ( $feed->entries ) {
143 0         0 push @{ $r->{entries} }, $entry;
  0         0  
144             }
145             } else {
146 0         0 return { entries => [] };
147             }
148             }
149             } else {
150              
151 17         65 my $json = get($url);
152              
153 17         5566144 eval { $r = JSON::Parse::json_to_perl($json); };
  17         125  
154 17 50       688 if ( $@ ) {
155 0         0 warn $@;
156 0         0 return { entries => [] };
157             }
158             }
159              
160 17         136 return $r;
161             }
162              
163             # Loads a config from ~/.sourceforge
164             sub get_config {
165 0     0 0   my $conf = File::HomeDir->my_home() . "/.sourceforge";
166 0           my %config = ();
167              
168 0 0         if ( -e $conf ) {
169 0 0         open my $C, "<$conf" or die "Couldn't open $conf";
170 0           my @conf = <$C>;
171 0           close $C;
172              
173 0           foreach my $line (@conf) {
174 0           chomp $line;
175 0 0         next if $line =~ m/^#/;
176              
177 0           my ( $var, $val ) = split /\s+/, $line;
178 0 0         next unless $val;
179 0           $config{$var} = $val;
180             }
181             }
182 0           return %config;
183             }
184              
185             =head1 NAME
186              
187             WWW::SourceForge - Interface to SourceForge's APIs - http://sourceforge.net/p/forge/documentation/API/ and https://sourceforge.net/p/forge/documentation/Download%20Stats%20API/
188              
189             =head1 SYNOPSIS
190              
191             Usually you'll use this via WWW::SourceForge::Project and
192             WWW::SourceForge::User rather than using this directly.
193              
194             =head1 DESCRIPTION
195              
196             Implements a Perl interface to the SourceForge API, documented here:
197             http://sourceforge.net/p/forge/documentation/API/ and here:
198             https://sourceforge.net/p/forge/documentation/Download%20Stats%20API/
199              
200             =head1 USAGE
201              
202             use WWW::SourceForge;
203             my $sfapi = new WWW::SourceForge;
204              
205             See WWW::SourceForge::User and WWW::SourceForge::Project for details.
206              
207             =head1 BUGS
208              
209             None
210              
211             =head1 SUPPORT
212              
213             http://sourceforge.net/p/sfprojecttools/tickets/
214              
215             =head1 AUTHOR
216              
217             Rich Bowen
218             CPAN ID: RBOW
219             SourceForge
220             rbowen@sourceforge.net
221             http://sf.net
222              
223             =head1 COPYRIGHT
224              
225             This program is free software; you can redistribute
226             it and/or modify it under the same terms as Perl itself.
227              
228             The full text of the license can be found in the
229             LICENSE file included with this module.
230              
231              
232             =head1 SEE ALSO
233              
234             perl(1).
235              
236             =cut
237              
238             #################### main pod documentation end ###################
239              
240              
241             1;
242