File Coverage

blib/lib/TMDB/Movie.pm
Criterion Covered Total %
statement 21 205 10.2
branch 0 88 0.0
condition 0 38 0.0
subroutine 7 46 15.2
pod 0 36 0.0
total 28 413 6.7


line stmt bran cond sub pod time code
1             package TMDB::Movie;
2              
3             #######################
4             # LOAD CORE MODULES
5             #######################
6 1     1   4 use strict;
  1         1  
  1         27  
7 1     1   3 use warnings FATAL => 'all';
  1         1  
  1         38  
8 1     1   3 use Carp qw(croak carp);
  1         1  
  1         46  
9              
10             #######################
11             # LOAD CPAN MODULES
12             #######################
13 1     1   3 use Object::Tiny qw(id session);
  1         1  
  1         4  
14 1     1   140 use Params::Validate qw(validate_with :types);
  1         1  
  1         150  
15 1     1   450 use Locale::Codes::Country qw(all_country_codes);
  1         14089  
  1         76  
16              
17             #######################
18             # LOAD DIST MODULES
19             #######################
20 1     1   7 use TMDB::Session;
  1         1  
  1         6  
21              
22             #######################
23             # VERSION
24             #######################
25             our $VERSION = '1.2.1';
26              
27             #######################
28             # PUBLIC METHODS
29             #######################
30              
31             ## ====================
32             ## Constructor
33             ## ====================
34             sub new {
35 0     0 0   my $class = shift;
36 0           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 0           my $self = $class->SUPER::new(%opts);
50 0           return $self;
51             } ## end sub new
52              
53             ## ====================
54             ## INFO
55             ## ====================
56             sub info {
57 0     0 0   my $self = shift;
58 0           my $params = {};
59 0 0         $params->{language} = $self->session->lang if $self->session->lang;
60 0           my $info = $self->session->talk(
61             {
62             method => 'movie/' . $self->id,
63             params => $params
64             }
65             );
66 0 0         return unless $info;
67 0           $self->{id} = $info->{id}; # Reset TMDB ID
68 0           return $info;
69             } ## end sub info
70              
71             ## ====================
72             ## ALTERNATIVE TITLES
73             ## ====================
74             sub alternative_titles {
75 0     0 0   my $self = shift;
76 0           my $country = shift;
77              
78             # Valid Country codes
79 0 0         if ($country) {
80             my %valid_country_codes
81 0           = map { $_ => 1 } all_country_codes('alpha-2');
  0            
82 0           $country = uc $country;
83 0 0         return unless $valid_country_codes{$country};
84             } ## end if ($country)
85              
86 0           my $args = {
87             method => 'movie/' . $self->id() . '/alternative_titles',
88             params => {},
89             };
90 0 0         $args->{params}->{country} = $country if $country;
91              
92 0           my $response = $self->session->talk($args);
93 0   0       my $titles = $response->{titles} || [];
94              
95 0 0         return @$titles if wantarray;
96 0           return $titles;
97             } ## end sub alternative_titles
98              
99             ## ====================
100             ## CAST
101             ## ====================
102             sub cast {
103 0     0 0   my $self = shift;
104 0           my $response = $self->_cast();
105 0   0       my $cast = $response->{cast} || [];
106 0 0         return @$cast if wantarray;
107 0           return $cast;
108             } ## end sub cast
109              
110             ## ====================
111             ## CREW
112             ## ====================
113             sub crew {
114 0     0 0   my $self = shift;
115 0           my $response = $self->_cast();
116 0   0       my $crew = $response->{crew} || [];
117 0 0         return @$crew if wantarray;
118 0           return $crew;
119             } ## end sub crew
120              
121             ## ====================
122             ## IMAGES
123             ## ====================
124             sub images {
125 0     0 0   my $self = shift;
126 0           my $params = {};
127 0 0         $params->{lang} = $self->session->lang if $self->session->lang;
128 0           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   my $self = shift;
141 0           my $response = $self->session->talk(
142             { method => 'movie/' . $self->id() . '/keywords' } );
143 0   0       my $keywords_dump = $response->{keywords} || [];
144 0           my @keywords;
145 0           foreach (@$keywords_dump) { push @keywords, $_->{name}; }
  0            
146 0 0         return @keywords if wantarray;
147 0           return \@keywords;
148             } ## end sub keywords
149              
150             ## ====================
151             ## RELEASES
152             ## ====================
153             sub releases {
154 0     0 0   my $self = shift;
155 0           my $response = $self->session->talk(
156             { method => 'movie/' . $self->id() . '/releases' } );
157 0   0       my $countries = $response->{countries} || [];
158 0 0         return @$countries if wantarray;
159 0           return $countries;
160             } ## end sub releases
161              
162             ## ====================
163             ## TRAILERS
164             ## ====================
165             sub trailers {
166 0     0 0   my $self = shift;
167 0           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   my $self = shift;
176 0           my $response = $self->session->talk(
177             { method => 'movie/' . $self->id() . '/translations' } );
178 0   0       my $translations = $response->{translations} || [];
179 0 0         return @$translations if wantarray;
180 0           return $translations;
181             } ## end sub translations
182              
183             ## ====================
184             ## SIMILAR MOVIES
185             ## ====================
186             sub similar {
187 0     0 0   my ( $self, $max_pages ) = @_;
188 0 0         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   sub similar_movies { return shift->similar(@_); }
201              
202             ## ====================
203             ## LISTS
204             ## ====================
205             sub lists {
206 0     0 0   my ( $self, $max_pages ) = @_;
207 0 0         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 0     0 0   my ( $self, $max_pages ) = @_;
225 0 0         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   my ( $self, @args ) = @_;
243 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          
270             ),
271             },
272             }
273             );
274              
275 0 0         return unless defined $changes;
276 0 0         return unless exists $changes->{changes};
277 0 0         return @{ $changes->{changes} } if wantarray;
  0            
278 0           return $changes->{changes};
279             } ## end sub changes
280              
281             ## ====================
282             ## VERSION
283             ## ====================
284             sub version {
285 0     0 0   my ($self) = @_;
286 0 0         my $response = $self->session->talk(
287             {
288             method => 'movie/' . $self->id(),
289             want_headers => 1,
290             }
291             ) or return;
292 0   0       my $version = $response->{etag} || q();
293 0           $version =~ s{"}{}gx;
294 0           return $version;
295             } ## end sub version
296              
297             ## ====================
298             ## INFO HELPERS
299             ## ====================
300              
301             # Title
302             sub title {
303 0     0 0   my ($self) = @_;
304 0           my $info = $self->info();
305 0 0         return unless $info;
306 0   0       return $info->{title} || q();
307             } ## end sub title
308              
309             # Release Year
310             sub year {
311 0     0 0   my ($self) = @_;
312 0           my $info = $self->info();
313 0 0         return unless $info;
314 0   0       my $full_date = $info->{release_date} || q();
315 0 0         return unless $full_date;
316 0           my ($year) = split( /\-/, $full_date );
317 0           return $year;
318             } ## end sub year
319              
320             # Tagline
321             sub tagline {
322 0     0 0   my ($self) = @_;
323 0           my $info = $self->info();
324 0 0         return unless $info;
325 0   0       return $info->{tagline} || q();
326             } ## end sub tagline
327              
328             # Overview
329             sub overview {
330 0     0 0   my ($self) = @_;
331 0           my $info = $self->info();
332 0 0         return unless $info;
333 0   0       return $info->{overview} || q();
334             } ## end sub overview
335              
336             # IMDB ID
337             sub imdb_id {
338 0     0 0   my ($self) = @_;
339 0           my $info = $self->info();
340 0 0         return unless $info;
341 0   0       return $info->{imdb_id} || q();
342             } ## end sub imdb_id
343              
344             # Description
345 0     0 0   sub description { return shift->overview(); }
346              
347             # Collection
348             sub collection {
349 0     0 0   my ($self) = @_;
350 0           my $info = $self->info();
351 0 0         return unless $info;
352 0   0       return $info->{belongs_to_collection}->{id} || q();
353             } ## end sub collection
354              
355             # Genres
356             sub genres {
357 0     0 0   my $self = shift;
358 0           my $info = $self->info();
359 0 0         return unless $info;
360 0           my @genres;
361 0 0         if ( exists $info->{genres} ) {
362 0           foreach ( @{ $info->{genres} } ) { push @genres, $_->{name}; }
  0            
  0            
363             }
364              
365 0 0         return @genres if wantarray;
366 0           return \@genres;
367             } ## end sub genres
368              
369             # Homepage
370             sub homepage {
371 0     0 0   my ($self) = @_;
372 0           my $info = $self->info();
373 0 0         return unless $info;
374 0   0       return $info->{homepage} || q();
375             } ## end sub homepage
376              
377             # Studios
378             sub studios {
379 0     0 0   my $self = shift;
380 0           my $info = $self->info();
381 0 0         return unless $info;
382 0           my @studios;
383 0 0         if ( exists $info->{production_companies} ) {
384 0           foreach ( @{ $info->{production_companies} } ) {
  0            
385 0           push @studios, $_->{name};
386             }
387             } ## end if ( exists $info->{production_companies...})
388              
389 0 0         return @studios if wantarray;
390 0           return \@studios;
391             } ## end sub studios
392              
393             ## ====================
394             ## CAST/CREW HELPERS
395             ## ====================
396              
397             # Actor names
398             sub actors {
399 0     0 0   my $self = shift;
400 0           my @cast = $self->cast();
401 0           my @names;
402 0           foreach (@cast) { push @names, $_->{name}; }
  0            
403 0 0         return @names if wantarray;
404 0           return \@names;
405             } ## end sub actors
406              
407             # Crew member names
408 0     0 0   sub director { return shift->_crew_names('Director'); }
409 0     0 0   sub producer { return shift->_crew_names('Producer'); }
410 0     0 0   sub executive_producer { return shift->_crew_names('Executive Producer'); }
411 0     0 0   sub writer { return shift->_crew_names('Screenplay|Writer|Author|Novel'); }
412              
413             ## ====================
414             ## IMAGE HELPERS
415             ## ====================
416              
417             # Poster
418             sub poster {
419 0     0 0   my $self = shift;
420 0           my $info = $self->info();
421 0 0         return unless $info;
422 0   0       return $info->{poster_path} || q();
423             } ## end sub poster
424              
425             # Posters
426             sub posters {
427 0     0 0   my $self = shift;
428 0           my $response = $self->images();
429 0 0         return unless $response;
430 0   0       my $posters = $response->{posters} || [];
431 0           return $self->_image_urls($posters);
432             } ## end sub posters
433              
434             # Backdrop
435             sub backdrop {
436 0     0 0   my $self = shift;
437 0           my $info = $self->info();
438 0 0         return unless $info;
439 0   0       return $info->{backdrop_path} || q();
440             } ## end sub backdrop
441              
442             # Backdrops
443             sub backdrops {
444 0     0 0   my $self = shift;
445 0           my $response = $self->images();
446 0 0         return unless $response;
447 0   0       my $backdrops = $response->{backdrops} || [];
448 0           return $self->_image_urls($backdrops);
449             } ## end sub backdrops
450              
451             ## ====================
452             ## TRAILER HELPERS
453             ## ====================
454             sub trailers_youtube {
455 0     0 0   my $self = shift;
456 0           my $trailers = $self->trailers();
457 0           my @urls;
458 0   0       my $yt_tmp = $trailers->{youtube} || [];
459 0           foreach (@$yt_tmp) {
460 0           push @urls, 'http://youtu.be/' . $_->{source};
461             }
462 0 0         return @urls if wantarray;
463 0           return \@urls;
464             } ## end sub trailers_youtube
465              
466             #######################
467             # PRIVATE METHODS
468             #######################
469              
470             ## ====================
471             ## CAST
472             ## ====================
473             sub _cast {
474 0     0     my $self = shift;
475 0           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 0     0     my $self = shift;
487 0           my $job = shift;
488              
489 0           my @names;
490 0           my @crew = $self->crew();
491 0           foreach (@crew) {
492 0 0         push @names, $_->{name} if ( $_->{job} =~ m{$job}xi );
493             }
494              
495 0 0         return @names if wantarray;
496 0           return \@names;
497             } ## end sub _crew_names
498              
499             ## ====================
500             ## IMAGE URLS
501             ## ====================
502             sub _image_urls {
503 0     0     my $self = shift;
504 0           my $images = shift;
505 0           my @urls;
506 0           foreach (@$images) {
507 0           push @urls, $_->{file_path};
508             }
509 0 0         return @urls if wantarray;
510 0           return \@urls;
511             } ## end sub _image_urls
512              
513             #######################
514             1;