File Coverage

blib/lib/Net/Songkick.pm
Criterion Covered Total %
statement 120 178 67.4
branch 19 68 27.9
condition n/a
subroutine 32 35 91.4
pod 8 8 100.0
total 179 289 61.9


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Net::Songkick - Perl wrapper for the Songkick API
4              
5             =head1 SYNOPSIS
6              
7             use Net::Songkick;
8              
9             my $api_key = 'your_api_key';
10             my $sk = Net::Songkick->new({ api_key => $api_key });
11              
12             # Returns XML by default
13             my $events = $sk->get_events;
14              
15             # Or returns JSON
16             my $events = $sk->get_events({ format => 'json' });
17              
18             =head1 DESCRIPTION
19              
20             This module presents a Perl wrapper around the Songkick API.
21              
22             Songkick (L<https://www.songkick.com/>) is a web site that tracks gigs
23             around the world. Users can add information about gigs (both in the past
24             and the future) and can track their attendance at those gigs.
25              
26             For more details of the Songkick API see L<https://www.songkick.com/developer>.
27              
28             =head1 METHODS
29              
30             =head2 Net::Songkick->new({ api_key => $api_key })
31              
32             Creates a new object which can be used to request data from the Songkick
33             API. Requires one parameter which is the user's API key.
34              
35             To request an API key from Songkick, see
36             L<https://www.songkick.com/api_key_requests/new>.
37              
38             Returns a Net::Songkick object if successful.
39              
40             =cut
41              
42             package Net::Songkick;
43              
44 5     5   1044518 use strict;
  5         46  
  5         151  
45 5     5   31 use warnings;
  5         11  
  5         195  
46              
47             our $VERSION = '1.0.8';
48              
49 5     5   2975 use Moose;
  5         2365051  
  5         33  
50              
51 5     5   42171 use LWP::UserAgent;
  5         207264  
  5         186  
52 5     5   39 use URI;
  5         10  
  5         122  
53 5     5   3624 use JSON;
  5         50744  
  5         30  
54              
55 5     5   2784 use Net::Songkick::Event;
  5         23  
  5         12029  
56              
57             has api_key => (
58             is => 'ro',
59             isa => 'Str',
60             required => 1,
61             );
62              
63             has ua => (
64             is => 'ro',
65             isa => 'LWP::UserAgent',
66             lazy_build => 1,
67             );
68              
69             sub _build_ua {
70 1     1   2 my $self = shift;
71              
72 1         14 return LWP::UserAgent->new;
73             }
74              
75             has json_decoder => (
76             is => 'ro',
77             isa => 'JSON',
78             lazy_build => 1,
79             );
80              
81             sub _build_json_decoder {
82 1     1   41 return JSON->new;
83             }
84              
85             has ['api_format', 'return_format' ] => (
86             is => 'ro',
87             isa => 'Str',
88             lazy_build => 1,
89             );
90              
91             sub _build_api_format {
92 1     1   29 my $format = $_[0]->return_format;
93 1 50       4 $format = 'json' if $format eq 'perl';
94 1         25 return $format;
95             }
96              
97             sub _build_return_format {
98 1     1   25 return 'perl';
99             }
100              
101             has ['api_url', 'events_url', 'user_events_url', 'user_gigs_url',
102             'artists_url', 'artists_mb_url', 'venue_events_url', 'metro_url'] => (
103             is => 'ro',
104             isa => 'URI',
105             lazy_build => 1,
106             );
107              
108             sub _build_api_url {
109 2     2   19 return URI->new('https://api.songkick.com/api/3.0');
110             }
111              
112             sub _build_events_url {
113 2     2   62 return URI->new(shift->api_url . '/events');
114             }
115              
116             sub _build_user_events_url {
117 2     2   61 return URI->new(shift->api_url . '/users/USERNAME/events');
118             }
119              
120             sub _build_user_gigs_url {
121 2     2   57 return URI->new(shift->api_url . '/users/USERNAME/gigography');
122             }
123              
124             sub _build_artists_url {
125 1     1   29 return URI->new(shift->api_url . '/artists/ARTIST_ID/calendar');
126             }
127              
128             sub _build_artists_mb_url {
129 1     1   28 return URI->new(shift->api_url . '/artists/mbid:MB_ID/calendar');
130             }
131              
132             sub _build_venue_events_url {
133 1     1   29 return URI->new(shift->api_url . '/venues/VENUE_ID/calendar');
134             }
135              
136             sub _build_metro_url {
137 1     1   27 return URI->new(shift->api_url . '/metro/METRO_ID/calendar');
138             }
139              
140             has ['events_params', 'user_events_params', 'user_gigs_params',
141             'artist_events_params', 'venue_events_params',
142             'metro_events_params'] => (
143             is => 'ro',
144             isa => 'HashRef',
145             lazy_build => 1,
146             );
147              
148             sub _build_events_params {
149 2     2   12 my @params = qw(type artists artist_name artist_id venue_id
150             min_date max_date location);
151              
152 2         6 return { map { $_ => 1 } @params };
  16         91  
153             }
154              
155             sub _build_user_events_params {
156 1     1   2 my @params = ( keys %{shift->events_params}, 'attendance' );
  1         27  
157              
158 1         4 return { map { $_ => 1 } @params };
  9         43  
159             }
160              
161             sub _build_user_gigs_params {
162 1     1   5 my @params = qw[ page per_page ];
163              
164 1         3 return { map { $_ => 1 } @params };
  2         33  
165             }
166              
167             sub _build_artist_events_params {
168 1     1   5 my @params = qw[ min_date max_date page per_page order ];
169              
170 1         4 return { map { $_ => 1} @params };
  5         37  
171             }
172              
173             sub _build_venue_events_params {
174 1     1   4 my @params = qw[ page per_page ];
175              
176 1         4 return { map { $_ => 1 } @params };
  2         32  
177             }
178              
179             sub _build_metro_events_params {
180 1     1   5 my @params = qw[ page per_page ];
181              
182 1         3 return { map { $_ => 1 } @params };
  2         32  
183             }
184              
185             sub _request {
186 3     3   7 my $self = shift;
187 3         7 my ($url, $args) = @_;
188              
189 3         84 $args->{apikey} = $self->api_key;
190 3 50       20 $url->query_form($args) if $args;
191              
192 3         348 my $resp = $self->ua->get($url);
193              
194 3 50       6802 return $resp->content if $resp->is_success;
195              
196 0         0 die $resp->content;
197             }
198              
199             =head2 $sk->return_perl
200              
201             Returns a Boolean value indicating whether or not this Net::Songkick
202             object should return Perl data structures for requests.
203              
204             =cut
205              
206             sub return_perl {
207 3     3 1 103 return $_[0]->return_format eq 'perl';
208             }
209              
210             =head2 $sk->parse_events_from_json($json_text)
211              
212             Takes the JSON returns by a request for a list of events, parses the JSON
213             and returns a list of Net::Songkick::JSON objects.
214              
215             =cut
216              
217             sub parse_events_from_json {
218 3     3 1 6 my $self = shift;
219 3         7 my ($json) = @_;
220              
221 3         6 my @events;
222 3         81 my $data = $self->json_decoder->decode($json);
223              
224             # Dump the two top levels of the JSON
225 3 50       18 $data = $data->{resultsPage} if exists $data->{resultsPage};
226 3 50       10 $data = $data->{results} if exists $data->{results};
227              
228 3 100       13 if (exists $data->{event}) {
    50          
229             # Ensure we have an array of events
230 1 50       6 $data->{event} = [ $data->{event}] if ref $data->{event} ne 'ARRAY';
231              
232 1         2 @events = map { Net::Songkick::Event->new($_) } @{$data->{event}};
  1         43  
  1         4  
233             } elsif (exists $data->{calendarEntry}) {
234             $data->{calendarEntry} = [ $data->{calendarEntry} ]
235 2 50       6 if ref $data->{calendarEntry} ne 'ARRAY';
236              
237             @events = map {
238             Net::Songkick::Event->new($_->{event})
239 2         4 } @{ $data->{calendarEntry} };
  2         65  
  2         7  
240             } else {
241 0 0       0 die "No events found in JSON\n" unless exists $data->{event};
242             }
243              
244 3         27 return @events;
245             }
246              
247             =head2 $sk->get_events({ ... options ... });
248              
249             Gets a list of upcoming events from Songkick. Various parameters to control
250             the events returned are supported for the full list see
251             L<http://www.songkick.com/developer/event-search>.
252              
253             In addition, this method takes an extra parameter, B<format>, which control
254             the format of the data returned. This can be either I<xml>, I<json> or
255             I<perl>. If it is either I<xml> or I<json> then the method will return the
256             raw XML or JSON from the Songkick API. If it is I<perl> then this method
257             will return a list of L<Net::Songkick::Event> objects. If this parameter is
258             omitted, then I<perl> is assumed.
259              
260             =cut
261              
262             sub get_events {
263 1     1 1 8 my $self = shift;
264 1         4 my ($params) = @_;
265              
266 1         35 my $url = URI->new($self->events_url . '.' . $self->api_format);
267              
268 1         69 my %req_args;
269              
270 1         5 foreach (keys %$params) {
271 1 50       32 if ($self->events_params->{$_}) {
272 1         4 $req_args{$_} = $params->{$_};
273             }
274             }
275              
276 1         5 my $resp = $self->_request($url, \%req_args);
277              
278 1 50       27 return $resp unless $self->return_perl;
279              
280 1         5 my @events = $self->parse_events_from_json($resp);
281              
282 1 50       17 return wantarray ? @events : \@events;
283             }
284              
285             =head2 $sk->get_upcoming_events({ ... options ... });
286              
287             Gets a list of upcoming events for a particular user from Songkick. This
288             method accepts all of the same search parameters as C<get_events>. It also
289             supports the optional B<format> parameter.
290              
291             This method has another, mandatory, parameter called B<user>. This is the
292             username of the user that you want information about.
293              
294             =cut
295              
296             sub get_upcoming_events {
297 1     1 1 4 my $self = shift;
298              
299 1         3 my ($params) = @_;
300              
301 1         2 my $user;
302 1 50       4 if (exists $params->{user}) {
303 1         2 $user = delete $params->{user};
304             } else {
305 0         0 die "user not passed to get_past_events\n";
306             }
307              
308 1         71 my $url = $self->user_events_url . '.' . $self->api_format;
309 1         6 $url =~ s/USERNAME/$user/;
310 1         3 $url = URI->new($url);
311              
312 1         64 my %req_args;
313              
314 1         5 foreach (keys %$params) {
315 0 0       0 if ($self->user_events_params->{$_}) {
316 0         0 $req_args{$_} = $params->{$_};
317             }
318             }
319              
320 1         4 my $resp = $self->_request($url, \%req_args);
321              
322 1 50       22 return $resp unless $self->return_perl;
323              
324 1         4 my @events = $self->parse_events_from_json($resp);
325              
326 1 50       10 return wantarray ? @events : \@events;
327             }
328              
329             =head2 $sk->get_past_events({ ... options ... });
330              
331             Gets a list of upcoming events for a particular user from Songkick.
332              
333             This method has an optional parameter, B<page> to control which page of
334             the data you want to return. It also supports the B<format> parameter.
335              
336             This method has another, mandatory, parameter called B<user>. This is the
337             username of the user that you want information about.
338              
339             =cut
340              
341             sub get_past_events {
342 1     1 1 3 my $self = shift;
343              
344 1         3 my ($params) = @_;
345              
346 1         2 my $user;
347 1 50       4 if (exists $params->{user}) {
348 1         3 $user = delete $params->{user};
349             } else {
350 0         0 die "user not passed to get_past_events\n";
351             }
352              
353 1         37 my $url = $self->user_gigs_url . '.' . $self->api_format;
354 1         6 $url =~ s/USERNAME/$user/;
355 1         4 $url = URI->new($url);
356              
357 1         63 my %req_args;
358              
359 1         5 foreach (keys %$params) {
360 0 0       0 if ($self->user_gigs_params->{$_}) {
361 0         0 $req_args{$_} = $params->{$_};
362             }
363             }
364              
365 1         5 my $resp = $self->_request($url, \%req_args);
366              
367 1 50       22 return $resp unless $self->return_perl;
368              
369 1         5 my @events = $self->parse_events_from_json($resp);
370              
371 1 50       37 return wantarray ? @events : \@events;
372             }
373              
374             =head2 $sk->get_venue_events({ ... options ...});
375              
376             =cut
377              
378             sub get_venue_events {
379 0     0 1   my $self = shift;
380              
381 0           my ($params) = @_;
382              
383 0           my $url;
384              
385 0 0         if (exists $params->{venue_id}) {
386 0           $url = $self->venue_events_url . '.' . $self->api_format;
387 0           $url =~ s/VENUE_ID/$params->{venue_id}/;
388             } else {
389 0           die "No venue id passed to get_venue_events\n";
390             }
391              
392 0           $url = URI->new($url);
393              
394 0           my %req_args;
395              
396 0           foreach (keys %$params) {
397 0 0         if ($self->venue_events_params->{$_}) {
398 0           $req_args{$_} = $params->{$_};
399             }
400             }
401              
402 0           my $resp = $self->_request($url, \%req_args);
403              
404 0 0         return $resp unless $self->return_perl;
405              
406 0           my @events = $self->parse_events_from_json($resp);
407              
408 0 0         return wantarray ? @events : \@events;
409             }
410              
411             =head2 $sk->get_artist_events({ ... options ... });
412              
413             =cut
414              
415             sub get_artist_events {
416 0     0 1   my $self = shift;
417              
418 0           my ($params) = @_;
419              
420 0           my $url;
421              
422 0 0         if (exists $params->{artist_id}) {
    0          
423 0           $url = $self->artists_url . '.' . $self->api_format;
424 0           $url =~ s/ARTIST_ID/$params->{artist_id}/;
425             } elsif (exists $params->{mb_id}) {
426 0           $url = $self->artists_mb_url . '.' . $self->api_format;
427 0           $url =~ s/MB_ID/$params->{mb_id}/;
428             } else {
429 0           die "No artist id or MusicBrainz id passed to get_artist_events\n";
430             }
431              
432 0           $url = URI->new($url);
433              
434 0           my %req_args;
435              
436 0           foreach (keys %$params) {
437 0 0         if ($self->artist_events_params->{$_}) {
438 0           $req_args{$_} = $params->{$_};
439             }
440             }
441              
442 0           my $resp = $self->_request($url, \%req_args);
443              
444 0 0         return $resp unless $self->return_perl;
445              
446 0           my @events = $self->parse_events_from_json($resp);
447              
448 0 0         return wantarray ? @events : \@events;
449             }
450              
451             =head2 $sk->get_metro_events({ ... options ... });
452              
453             =cut
454              
455             sub get_metro_events {
456 0     0 1   my $self = shift;
457              
458 0           my ($params) = @_;
459              
460 0           my $url;
461              
462 0 0         if (exists $params->{metro_id}) {
463 0           $url = $self->metro_url . '.' . $self->api_format . '?api_key=' . $self->api_key;
464 0           $url =~ s/METRO_ID/$params->{metro_id}/;
465             } else {
466 0           die "No metro area id passed to get_metro_events\n";
467             }
468              
469 0           $url = URI->new($url);
470              
471 0           my %req_args;
472              
473 0           foreach (keys %$params) {
474 0 0         if ($self->metro_events_params->{$_}) {
475 0           $req_args{$_} = $params->{$_};
476             }
477             }
478              
479 0           my $resp = $self->_request($url, \%req_args);
480              
481 0 0         return $resp unless $self->return_perl;
482              
483 0           my @events = $self->parse_events_from_json($resp);
484              
485 0 0         return wantarray ? @events : \@events;
486             }
487              
488 5     5   70 no Moose;
  5         10  
  5         44  
489             __PACKAGE__->meta->make_immutable;
490              
491             =head1 AUTHOR
492              
493             Dave Cross <dave@perlhacks.com>
494              
495             =head1 SEE ALSO
496              
497             perl(1), L<http://www.songkick.com/>, L<http://developer.songkick.com/>
498              
499             =head1 COPYRIGHT AND LICENSE
500              
501             Copyright (C) 2010, Magnum Solutions Ltd. All Rights Reserved.
502              
503             This script is free software; you can redistribute it and/or modify it
504             under the same terms as Perl itself.
505              
506             =cut
507              
508             1;