File Coverage

blib/lib/TMDB/Movie.pm
Criterion Covered Total %
statement 153 205 74.6
branch 33 88 37.5
condition 15 38 39.4
subroutine 40 46 86.9
pod 0 36 0.0
total 241 413 58.3


line stmt bran cond sub pod time code
1             package TMDB::Movie;
2              
3             #######################
4             # LOAD CORE MODULES
5             #######################
6 3     3   22 use strict;
  3         7  
  3         163  
7 3     3   18 use warnings FATAL => 'all';
  3         8  
  3         260  
8 3     3   22 use Carp qw(croak carp);
  3         7  
  3         232  
9              
10             #######################
11             # LOAD CPAN MODULES
12             #######################
13 3     3   19 use Object::Tiny qw(id session);
  3         6  
  3         23  
14 3     3   893 use Params::Validate qw(validate_with :types);
  3         6  
  3         696  
15 3     3   1832 use Locale::Codes::Country qw(all_country_codes);
  3         108928  
  3         393  
16              
17             #######################
18             # LOAD DIST MODULES
19             #######################
20 3     3   26 use TMDB::Session;
  3         6  
  3         24  
21              
22             #######################
23             # VERSION
24             #######################
25             our $VERSION = '1.3.0';
26              
27             #######################
28             # PUBLIC METHODS
29             #######################
30              
31             ## ====================
32             ## Constructor
33             ## ====================
34             sub new {
35 1     1 0 18 my $class = shift;
36 1         46 my %opts = validate_with(
37             params => \@_,
38             spec => {
39             session => {
40             type => OBJECT,
41             isa => 'TMDB::Session',
42             },
43             id => {
44             type => SCALAR,
45             },
46             },
47             );
48              
49 1         20 my $self = $class->SUPER::new(%opts);
50 1         11 return $self;
51             } ## end sub new
52              
53             ## ====================
54             ## INFO
55             ## ====================
56             sub info {
57 13     13 0 99 my $self = shift;
58 13         35 my $params = {};
59 13 50       498 $params->{language} = $self->session->lang if $self->session->lang;
60 13         1323 my $info = $self->session->talk(
61             {
62             method => 'movie/' . $self->id,
63             params => $params
64             }
65             );
66 13 50       691 return unless $info;
67 13         38 $self->{id} = $info->{id}; # Reset TMDB ID
68 13         46 return $info;
69             } ## end sub info
70              
71             ## ====================
72             ## ALTERNATIVE TITLES
73             ## ====================
74             sub alternative_titles {
75 0     0 0 0 my $self = shift;
76 0         0 my $country = shift;
77              
78             # Valid Country codes
79 0 0       0 if ($country) {
80             my %valid_country_codes
81 0         0 = map { $_ => 1 } all_country_codes('alpha-2');
  0         0  
82 0         0 $country = uc $country;
83 0 0       0 return unless $valid_country_codes{$country};
84             } ## end if ($country)
85              
86 0         0 my $args = {
87             method => 'movie/' . $self->id() . '/alternative_titles',
88             params => {},
89             };
90 0 0       0 $args->{params}->{country} = $country if $country;
91              
92 0         0 my $response = $self->session->talk($args);
93 0   0     0 my $titles = $response->{titles} || [];
94              
95 0 0       0 return @$titles if wantarray;
96 0         0 return $titles;
97             } ## end sub alternative_titles
98              
99             ## ====================
100             ## CAST
101             ## ====================
102             sub cast {
103 2     2 0 543 my $self = shift;
104 2         8 my $response = $self->_cast();
105 2   50     146 my $cast = $response->{cast} || [];
106 2 100       13 return @$cast if wantarray;
107 1         6 return $cast;
108             } ## end sub cast
109              
110             ## ====================
111             ## CREW
112             ## ====================
113             sub crew {
114 6     6 0 507 my $self = shift;
115 6         15 my $response = $self->_cast();
116 6   50     312 my $crew = $response->{crew} || [];
117 6 100       34 return @$crew if wantarray;
118 1         5 return $crew;
119             } ## end sub crew
120              
121             ## ====================
122             ## IMAGES
123             ## ====================
124             sub images {
125 3     3 0 509 my $self = shift;
126 3         6 my $params = {};
127 3 50       95 $params->{lang} = $self->session->lang if $self->session->lang;
128 3         204 return $self->session->talk(
129             {
130             method => 'movie/' . $self->id() . '/images',
131             params => $params
132             }
133             );
134             } ## end sub images
135              
136             ## ====================
137             ## KEYWORDS
138             ## ====================
139             sub keywords {
140 0     0 0 0 my $self = shift;
141 0         0 my $response = $self->session->talk(
142             { method => 'movie/' . $self->id() . '/keywords' } );
143 0   0     0 my $keywords_dump = $response->{keywords} || [];
144 0         0 my @keywords;
145 0         0 foreach (@$keywords_dump) { push @keywords, $_->{name}; }
  0         0  
146 0 0       0 return @keywords if wantarray;
147 0         0 return \@keywords;
148             } ## end sub keywords
149              
150             ## ====================
151             ## RELEASES
152             ## ====================
153             sub releases {
154 0     0 0 0 my $self = shift;
155 0         0 my $response = $self->session->talk(
156             { method => 'movie/' . $self->id() . '/releases' } );
157 0   0     0 my $countries = $response->{countries} || [];
158 0 0       0 return @$countries if wantarray;
159 0         0 return $countries;
160             } ## end sub releases
161              
162             ## ====================
163             ## TRAILERS
164             ## ====================
165             sub trailers {
166 2     2 0 520 my $self = shift;
167 2         58 return $self->session->talk(
168             { method => 'movie/' . $self->id() . '/trailers' } );
169             } ## end sub trailers
170              
171             ## ====================
172             ## TRANSLATIONS
173             ## ====================
174             sub translations {
175 0     0 0 0 my $self = shift;
176 0         0 my $response = $self->session->talk(
177             { method => 'movie/' . $self->id() . '/translations' } );
178 0   0     0 my $translations = $response->{translations} || [];
179 0 0       0 return @$translations if wantarray;
180 0         0 return $translations;
181             } ## end sub translations
182              
183             ## ====================
184             ## SIMILAR MOVIES
185             ## ====================
186             sub similar {
187 1     1 0 509 my ( $self, $max_pages ) = @_;
188 1 50       111 return $self->session->paginate_results(
189             {
190             method => 'movie/' . $self->id() . '/similar_movies',
191             max_pages => $max_pages,
192             params => {
193             language => $self->session->lang
194             ? $self->session->lang
195             : undef,
196             },
197             }
198             );
199             } ## end sub similar
200 0     0 0 0 sub similar_movies { return shift->similar(@_); }
201              
202             ## ====================
203             ## LISTS
204             ## ====================
205             sub lists {
206 1     1 0 503 my ( $self, $max_pages ) = @_;
207 1 50       40 return $self->session->paginate_results(
208             {
209             method => 'movie/' . $self->id() . '/lists',
210             max_pages => $max_pages,
211             params => {
212             language => $self->session->lang
213             ? $self->session->lang
214             : undef,
215             },
216             }
217             );
218             } ## end sub lists
219              
220             ## ====================
221             ## REVIEWS
222             ## ====================
223             sub reviews {
224 1     1 0 503 my ( $self, $max_pages ) = @_;
225 1 50       39 return $self->session->paginate_results(
226             {
227             method => 'movie/' . $self->id() . '/reviews',
228             max_pages => $max_pages,
229             params => {
230             language => $self->session->lang
231             ? $self->session->lang
232             : undef,
233             },
234             }
235             );
236             } ## end sub reviews
237              
238             ## ====================
239             ## CHANGES
240             ## ====================
241             sub changes {
242 0     0 0 0 my ( $self, @args ) = @_;
243 0         0 my %options = validate_with(
244             params => [@args],
245             spec => {
246             start_date => {
247             type => SCALAR,
248             optional => 1,
249             regex => qr/^\d{4}\-\d{2}\-\d{2}$/
250             },
251             end_date => {
252             type => SCALAR,
253             optional => 1,
254             regex => qr/^\d{4}\-\d{2}\-\d{2}$/
255             },
256             },
257             );
258              
259             my $changes = $self->session->talk(
260             {
261             method => 'movie/' . $self->id() . '/changes',
262             params => {
263             (
264             $options{start_date}
265             ? ( start_date => $options{start_date} )
266             : ()
267             ), (
268             $options{end_date} ? ( end_date => $options{end_date} )
269 0 0       0 : ()
    0          
270             ),
271             },
272             }
273             );
274              
275 0 0       0 return unless defined $changes;
276 0 0       0 return unless exists $changes->{changes};
277 0 0       0 return @{ $changes->{changes} } if wantarray;
  0         0  
278 0         0 return $changes->{changes};
279             } ## end sub changes
280              
281             ## ====================
282             ## VERSION
283             ## ====================
284             sub version {
285 1     1 0 522 my ($self) = @_;
286 1 50       38 my $response = $self->session->talk(
287             {
288             method => 'movie/' . $self->id(),
289             want_headers => 1,
290             }
291             ) or return;
292 1   50     11 my $version = $response->{etag} || q();
293 1         4 $version =~ s{"}{}gx;
294 1         4 return $version;
295             } ## end sub version
296              
297             ## ====================
298             ## INFO HELPERS
299             ## ====================
300              
301             # Title
302             sub title {
303 1     1 0 478 my ($self) = @_;
304 1         5 my $info = $self->info();
305 1 50       5 return unless $info;
306 1   50     9 return $info->{title} || q();
307             } ## end sub title
308              
309             # Release Year
310             sub year {
311 1     1 0 501 my ($self) = @_;
312 1         6 my $info = $self->info();
313 1 50       5 return unless $info;
314 1   50     8 my $full_date = $info->{release_date} || q();
315 1 50       8 return unless $full_date;
316 0         0 my ($year) = split( /\-/, $full_date );
317 0         0 return $year;
318             } ## end sub year
319              
320             # Tagline
321             sub tagline {
322 1     1 0 495 my ($self) = @_;
323 1         6 my $info = $self->info();
324 1 50       5 return unless $info;
325 1   50     9 return $info->{tagline} || q();
326             } ## end sub tagline
327              
328             # Overview
329             sub overview {
330 2     2 0 474 my ($self) = @_;
331 2         8 my $info = $self->info();
332 2 50       7 return unless $info;
333 2   50     15 return $info->{overview} || q();
334             } ## end sub overview
335              
336             # IMDB ID
337             sub imdb_id {
338 1     1 0 473 my ($self) = @_;
339 1         5 my $info = $self->info();
340 1 50       6 return unless $info;
341 1   50     9 return $info->{imdb_id} || q();
342             } ## end sub imdb_id
343              
344             # Description
345 1     1 0 489 sub description { return shift->overview(); }
346              
347             # Collection
348             sub collection {
349 1     1 0 482 my ($self) = @_;
350 1         5 my $info = $self->info();
351 1 50       5 return unless $info;
352 1   50     10 return $info->{belongs_to_collection}->{id} || q();
353             } ## end sub collection
354              
355             # Genres
356             sub genres {
357 1     1 0 493 my $self = shift;
358 1         6 my $info = $self->info();
359 1 50       5 return unless $info;
360 1         3 my @genres;
361 1 50       7 if ( exists $info->{genres} ) {
362 0         0 foreach ( @{ $info->{genres} } ) { push @genres, $_->{name}; }
  0         0  
  0         0  
363             }
364              
365 1 50       9 return @genres if wantarray;
366 1         6 return \@genres;
367             } ## end sub genres
368              
369             # Homepage
370             sub homepage {
371 1     1 0 519 my ($self) = @_;
372 1         6 my $info = $self->info();
373 1 50       6 return unless $info;
374 1   50     9 return $info->{homepage} || q();
375             } ## end sub homepage
376              
377             # Studios
378             sub studios {
379 1     1 0 518 my $self = shift;
380 1         5 my $info = $self->info();
381 1 50       22 return unless $info;
382 1         3 my @studios;
383 1 50       6 if ( exists $info->{production_companies} ) {
384 0         0 foreach ( @{ $info->{production_companies} } ) {
  0         0  
385 0         0 push @studios, $_->{name};
386             }
387             } ## end if ( exists $info->{production_companies...})
388              
389 1 50       4 return @studios if wantarray;
390 1         7 return \@studios;
391             } ## end sub studios
392              
393             ## ====================
394             ## CAST/CREW HELPERS
395             ## ====================
396              
397             # Actor names
398             sub actors {
399 1     1 0 467 my $self = shift;
400 1         7 my @cast = $self->cast();
401 1         3 my @names;
402 1         4 foreach (@cast) { push @names, $_->{name}; }
  0         0  
403 1 50       5 return @names if wantarray;
404 1         4 return \@names;
405             } ## end sub actors
406              
407             # Crew member names
408 1     1 0 468 sub director { return shift->_crew_names('Director'); }
409 1     1 0 498 sub producer { return shift->_crew_names('Producer'); }
410 1     1 0 465 sub executive_producer { return shift->_crew_names('Executive Producer'); }
411 1     1 0 472 sub writer { return shift->_crew_names('Screenplay|Writer|Author|Novel'); }
412              
413             ## ====================
414             ## IMAGE HELPERS
415             ## ====================
416              
417             # Poster
418             sub poster {
419 1     1 0 497 my $self = shift;
420 1         5 my $info = $self->info();
421 1 50       5 return unless $info;
422 1   50     10 return $info->{poster_path} || q();
423             } ## end sub poster
424              
425             # Posters
426             sub posters {
427 1     1 0 512 my $self = shift;
428 1         6 my $response = $self->images();
429 1 50       32 return unless $response;
430 1   50     6 my $posters = $response->{posters} || [];
431 1         4 return $self->_image_urls($posters);
432             } ## end sub posters
433              
434             # Backdrop
435             sub backdrop {
436 1     1 0 523 my $self = shift;
437 1         5 my $info = $self->info();
438 1 50       4 return unless $info;
439 1   50     9 return $info->{backdrop_path} || q();
440             } ## end sub backdrop
441              
442             # Backdrops
443             sub backdrops {
444 1     1 0 285 my $self = shift;
445 1         4 my $response = $self->images();
446 1 50       32 return unless $response;
447 1   50     6 my $backdrops = $response->{backdrops} || [];
448 1         3 return $self->_image_urls($backdrops);
449             } ## end sub backdrops
450              
451             ## ====================
452             ## TRAILER HELPERS
453             ## ====================
454             sub trailers_youtube {
455 1     1 0 287 my $self = shift;
456 1         4 my $trailers = $self->trailers();
457 1         27 my @urls;
458 1   50     8 my $yt_tmp = $trailers->{youtube} || [];
459 1         3 foreach (@$yt_tmp) {
460 0         0 push @urls, 'http://youtu.be/' . $_->{source};
461             }
462 1 50       3 return @urls if wantarray;
463 1         4 return \@urls;
464             } ## end sub trailers_youtube
465              
466             #######################
467             # PRIVATE METHODS
468             #######################
469              
470             ## ====================
471             ## CAST
472             ## ====================
473             sub _cast {
474 9     9   278 my $self = shift;
475 9         335 return $self->session->talk(
476             {
477             method => 'movie/' . $self->id() . '/casts',
478             }
479             );
480             } ## end sub _cast
481              
482             ## ====================
483             ## CREW NAMES
484             ## ====================
485             sub _crew_names {
486 5     5   313 my $self = shift;
487 5         9 my $job = shift;
488              
489 5         9 my @names;
490 5         36 my @crew = $self->crew();
491 5         14 foreach (@crew) {
492 0 0       0 push @names, $_->{name} if ( $_->{job} =~ m{$job}xi );
493             }
494              
495 5 50       14 return @names if wantarray;
496 5         18 return \@names;
497             } ## end sub _crew_names
498              
499             ## ====================
500             ## IMAGE URLS
501             ## ====================
502             sub _image_urls {
503 2     2   3 my $self = shift;
504 2         3 my $images = shift;
505 2         3 my @urls;
506 2         5 foreach (@$images) {
507 0         0 push @urls, $_->{file_path};
508             }
509 2 50       4 return @urls if wantarray;
510 2         8 return \@urls;
511             } ## end sub _image_urls
512              
513             #######################
514             1;