File Coverage

blib/lib/TMDB/Person.pm
Criterion Covered Total %
statement 18 71 25.3
branch 0 18 0.0
condition 0 16 0.0
subroutine 6 21 28.5
pod 0 14 0.0
total 24 140 17.1


line stmt bran cond sub pod time code
1             package TMDB::Person;
2              
3             #######################
4             # LOAD CORE MODULES
5             #######################
6 1     1   5 use strict;
  1         2  
  1         31  
7 1     1   5 use warnings FATAL => 'all';
  1         1  
  1         35  
8 1     1   6 use Carp qw(croak carp);
  1         1  
  1         51  
9              
10             #######################
11             # LOAD CPAN MODULES
12             #######################
13 1     1   5 use Object::Tiny qw(id session);
  1         2  
  1         5  
14 1     1   177 use Params::Validate qw(validate_with :types);
  1         2  
  1         154  
15              
16             #######################
17             # LOAD DIST MODULES
18             #######################
19 1     1   5 use TMDB::Session;
  1         3  
  1         5  
20              
21             #######################
22             # VERSION
23             #######################
24             our $VERSION = '1.2.0';
25              
26             #######################
27             # PUBLIC METHODS
28             #######################
29              
30             ## ====================
31             ## Constructor
32             ## ====================
33             sub new {
34 0     0 0   my $class = shift;
35 0           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 0           my $self = $class->SUPER::new(%opts);
49 0           return $self;
50             } ## end sub new
51              
52             ## ====================
53             ## INFO
54             ## ====================
55             sub info {
56 0     0 0   my $self = shift;
57 0           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 0     0 0   my $self = shift;
69 0           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   my $self = shift;
81 0           my $response = $self->session->talk(
82             {
83             method => 'person/' . $self->id() . '/images',
84             }
85             );
86 0   0       return $response->{profiles} || [];
87             } ## end sub images
88              
89             ## ====================
90             ## VERSION
91             ## ====================
92             sub version {
93 0     0 0   my ($self) = @_;
94 0 0         my $response = $self->session->talk(
95             {
96             method => 'person/' . $self->id(),
97             want_headers => 1,
98             }
99             ) or return;
100 0   0       my $version = $response->{etag} || q();
101 0           $version =~ s{"}{}gx;
102 0           return $version;
103             } ## end sub version
104              
105             ## ====================
106             ## INFO HELPERS
107             ## ====================
108              
109             # Name
110             sub name {
111 0     0 0   my ($self) = @_;
112 0           my $info = $self->info();
113 0 0         return unless $info;
114 0   0       return $info->{name} || q();
115             } ## end sub name
116              
117             # Alternative names
118             sub aka {
119 0     0 0   my ($self) = @_;
120 0           my $info = $self->info();
121 0 0         return unless $info;
122 0   0       my @aka = $info->{also_known_as} || [];
123 0 0         return @aka if wantarray;
124 0           return \@aka;
125             } ## end sub aka
126              
127             # Bio
128             sub bio {
129 0     0 0   my ($self) = @_;
130 0           my $info = $self->info();
131 0 0         return unless $info;
132 0   0       return $info->{biography} || q();
133             } ## end sub bio
134              
135             # Image
136             sub image {
137 0     0 0   my ($self) = @_;
138 0           my $info = $self->info();
139 0 0         return unless $info;
140 0   0       return $info->{profile_path} || q();
141             } ## end sub image
142              
143             ## ====================
144             ## CREDIT HELPERS
145             ## ====================
146              
147             # Acted in
148             sub starred_in {
149 0     0 0   my $self = shift;
150 0   0       my $movies = $self->credits()->{cast} || [];
151 0           my @names;
152 0           foreach (@$movies) { push @names, $_->{title}; }
  0            
153 0 0         return @names if wantarray;
154 0           return \@names;
155             } ## end sub starred_in
156              
157             # Crew member
158 0     0 0   sub directed { return shift->_crew_names('Director'); }
159 0     0 0   sub produced { return shift->_crew_names('Producer'); }
160 0     0 0   sub executive_produced { return shift->_crew_names('Executive Producer'); }
161 0     0 0   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 0     0     my $self = shift;
172 0           my $job = shift;
173              
174 0           my @names;
175 0   0       my $crew = $self->credits()->{crew} || [];
176 0           foreach (@$crew) {
177 0 0         push @names, $_->{title} if ( $_->{job} =~ m{$job}xi );
178             }
179              
180 0 0         return @names if wantarray;
181 0           return \@names;
182             } ## end sub _crew_names
183              
184             #######################
185             1;