File Coverage

blib/lib/TMDB/Person.pm
Criterion Covered Total %
statement 66 71 92.9
branch 8 18 44.4
condition 7 16 43.7
subroutine 20 21 95.2
pod 0 14 0.0
total 101 140 72.1


line stmt bran cond sub pod time code
1             package TMDB::Person;
2              
3             #######################
4             # LOAD CORE MODULES
5             #######################
6 3     3   16 use strict;
  3         7  
  3         107  
7 3     3   13 use warnings FATAL => 'all';
  3         5  
  3         150  
8 3     3   13 use Carp qw(croak carp);
  3         4  
  3         188  
9              
10             #######################
11             # LOAD CPAN MODULES
12             #######################
13 3     3   15 use Object::Tiny qw(id session);
  3         24  
  3         17  
14 3     3   633 use Params::Validate qw(validate_with :types);
  3         6  
  3         416  
15              
16             #######################
17             # LOAD DIST MODULES
18             #######################
19 3     3   16 use TMDB::Session;
  3         5  
  3         20  
20              
21             #######################
22             # VERSION
23             #######################
24             our $VERSION = '1.3.0';
25              
26             #######################
27             # PUBLIC METHODS
28             #######################
29              
30             ## ====================
31             ## Constructor
32             ## ====================
33             sub new {
34 1     1 0 10 my $class = shift;
35 1         26 my %opts = validate_with(
36             params => \@_,
37             spec => {
38             session => {
39             type => OBJECT,
40             isa => 'TMDB::Session',
41             },
42             id => {
43             type => SCALAR,
44             },
45             },
46             );
47              
48 1         34 my $self = $class->SUPER::new(%opts);
49 1         9 return $self;
50             } ## end sub new
51              
52             ## ====================
53             ## INFO
54             ## ====================
55             sub info {
56 5     5 0 21 my $self = shift;
57 5         102 return $self->session->talk(
58             {
59             method => 'person/' . $self->id(),
60             }
61             );
62             } ## end sub info
63              
64             ## ====================
65             ## CREDITS
66             ## ====================
67             sub credits {
68 7     7 0 270 my $self = shift;
69 7         141 return $self->session->talk(
70             {
71             method => 'person/' . $self->id() . '/credits',
72             }
73             );
74             } ## end sub credits
75              
76             ## ====================
77             ## IMAGES
78             ## ====================
79             sub images {
80 0     0 0 0 my $self = shift;
81 0         0 my $response = $self->session->talk(
82             {
83             method => 'person/' . $self->id() . '/images',
84             }
85             );
86 0   0     0 return $response->{profiles} || [];
87             } ## end sub images
88              
89             ## ====================
90             ## VERSION
91             ## ====================
92             sub version {
93 1     1 0 302 my ($self) = @_;
94 1 50       36 my $response = $self->session->talk(
95             {
96             method => 'person/' . $self->id(),
97             want_headers => 1,
98             }
99             ) or return;
100 1   50     7 my $version = $response->{etag} || q();
101 1         2 $version =~ s{"}{}gx;
102 1         3 return $version;
103             } ## end sub version
104              
105             ## ====================
106             ## INFO HELPERS
107             ## ====================
108              
109             # Name
110             sub name {
111 1     1 0 285 my ($self) = @_;
112 1         3 my $info = $self->info();
113 1 50       30 return unless $info;
114 1   50     6 return $info->{name} || q();
115             } ## end sub name
116              
117             # Alternative names
118             sub aka {
119 1     1 0 287 my ($self) = @_;
120 1         3 my $info = $self->info();
121 1 50       36 return unless $info;
122 1   50     7 my @aka = $info->{also_known_as} || [];
123 1 50       3 return @aka if wantarray;
124 1         5 return \@aka;
125             } ## end sub aka
126              
127             # Bio
128             sub bio {
129 1     1 0 291 my ($self) = @_;
130 1         4 my $info = $self->info();
131 1 50       28 return unless $info;
132 1   50     5 return $info->{biography} || q();
133             } ## end sub bio
134              
135             # Image
136             sub image {
137 1     1 0 273 my ($self) = @_;
138 1         3 my $info = $self->info();
139 1 50       32 return unless $info;
140 1   50     6 return $info->{profile_path} || q();
141             } ## end sub image
142              
143             ## ====================
144             ## CREDIT HELPERS
145             ## ====================
146              
147             # Acted in
148             sub starred_in {
149 1     1 0 295 my $self = shift;
150 1   50     3 my $movies = $self->credits()->{cast} || [];
151 1         37 my @names;
152 1         2 foreach (@$movies) { push @names, $_->{title}; }
  0         0  
153 1 50       4 return @names if wantarray;
154 1         2 return \@names;
155             } ## end sub starred_in
156              
157             # Crew member
158 1     1 0 264 sub directed { return shift->_crew_names('Director'); }
159 1     1 0 267 sub produced { return shift->_crew_names('Producer'); }
160 1     1 0 264 sub executive_produced { return shift->_crew_names('Executive Producer'); }
161 1     1 0 277 sub wrote { return shift->_crew_names('Author|Novel|Screenplay|Writer'); }
162              
163             #######################
164             # PRIVATE METHODS
165             #######################
166              
167             ## ====================
168             ## CREW NAMES
169             ## ====================
170             sub _crew_names {
171 5     5   262 my $self = shift;
172 5         6 my $job = shift;
173              
174 5         6 my @names;
175 5   50     7 my $crew = $self->credits()->{crew} || [];
176 5         188 foreach (@$crew) {
177 0 0       0 push @names, $_->{title} if ( $_->{job} =~ m{$job}xi );
178             }
179              
180 5 50       9 return @names if wantarray;
181 5         25 return \@names;
182             } ## end sub _crew_names
183              
184             #######################
185             1;