line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
IMDB::Film - OO Perl interface to the movies database IMDB. |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use IMDB::Film; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# Retrieve a movie information by its IMDB code |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
my $imdbObj = new IMDB::Film(crit => 227445); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
or |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# |
17
|
|
|
|
|
|
|
# Retrieve a movie information by its title |
18
|
|
|
|
|
|
|
# |
19
|
|
|
|
|
|
|
my $imdbObj = new IMDB::Film(crit => 'Troy'); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
or |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
# Parse already stored HTML page from IMDB |
25
|
|
|
|
|
|
|
# |
26
|
|
|
|
|
|
|
my $imdbObj = new IMDB::Film(crit => 'troy.html'); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
if($imdbObj->status) { |
29
|
|
|
|
|
|
|
print "Title: ".$imdbObj->title()."\n"; |
30
|
|
|
|
|
|
|
print "Year: ".$imdbObj->year()."\n"; |
31
|
|
|
|
|
|
|
print "Plot Symmary: ".$imdbObj->plot()."\n"; |
32
|
|
|
|
|
|
|
} else { |
33
|
|
|
|
|
|
|
print "Something wrong: ".$imdbObj->error; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 DESCRIPTION |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head2 Overview |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
IMDB::Film is an object-oriented interface to the IMDB. |
41
|
|
|
|
|
|
|
You can use that module to retrieve information about film: |
42
|
|
|
|
|
|
|
title, year, plot etc. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=cut |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
package IMDB::Film; |
47
|
|
|
|
|
|
|
|
48
|
1
|
|
|
1
|
|
1001
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
49
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
50
|
|
|
|
|
|
|
|
51
|
1
|
|
|
1
|
|
16
|
use base qw(IMDB::BaseClass); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
719
|
|
52
|
|
|
|
|
|
|
|
53
|
1
|
|
|
1
|
|
8
|
use Carp; |
|
1
|
|
|
|
|
22
|
|
|
1
|
|
|
|
|
89
|
|
54
|
1
|
|
|
1
|
|
7
|
use Data::Dumper; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
94
|
|
55
|
|
|
|
|
|
|
|
56
|
1
|
|
|
|
|
7
|
use fields qw( _title |
57
|
|
|
|
|
|
|
_kind |
58
|
|
|
|
|
|
|
_year |
59
|
|
|
|
|
|
|
_episodes |
60
|
|
|
|
|
|
|
_episodeof |
61
|
|
|
|
|
|
|
_summary |
62
|
|
|
|
|
|
|
_cast |
63
|
|
|
|
|
|
|
_directors |
64
|
|
|
|
|
|
|
_writers |
65
|
|
|
|
|
|
|
_cover |
66
|
|
|
|
|
|
|
_language |
67
|
|
|
|
|
|
|
_country |
68
|
|
|
|
|
|
|
_top_info |
69
|
|
|
|
|
|
|
_rating |
70
|
|
|
|
|
|
|
_genres |
71
|
|
|
|
|
|
|
_tagline |
72
|
|
|
|
|
|
|
_plot |
73
|
|
|
|
|
|
|
_also_known_as |
74
|
|
|
|
|
|
|
_certifications |
75
|
|
|
|
|
|
|
_duration |
76
|
|
|
|
|
|
|
_full_plot |
77
|
|
|
|
|
|
|
_trivia |
78
|
|
|
|
|
|
|
_goofs |
79
|
|
|
|
|
|
|
_awards |
80
|
|
|
|
|
|
|
_official_sites |
81
|
|
|
|
|
|
|
_release_dates |
82
|
|
|
|
|
|
|
_aspect_ratio |
83
|
|
|
|
|
|
|
_mpaa_info |
84
|
|
|
|
|
|
|
_company |
85
|
|
|
|
|
|
|
_connections |
86
|
|
|
|
|
|
|
_full_companies |
87
|
|
|
|
|
|
|
_recommendation_movies |
88
|
|
|
|
|
|
|
_plot_keywords |
89
|
|
|
|
|
|
|
_big_cover_url |
90
|
|
|
|
|
|
|
_big_cover_page |
91
|
|
|
|
|
|
|
_storyline |
92
|
|
|
|
|
|
|
full_plot_url |
93
|
1
|
|
|
1
|
|
6
|
); |
|
1
|
|
|
|
|
1
|
|
94
|
|
|
|
|
|
|
|
95
|
1
|
|
|
1
|
|
285
|
use vars qw( $VERSION %FIELDS %FILM_CERT %FILM_KIND $PLOT_URL ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
108
|
|
96
|
|
|
|
|
|
|
|
97
|
1
|
|
|
1
|
|
7
|
use constant CLASS_NAME => 'IMDB::Film'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
65
|
|
98
|
1
|
|
|
1
|
|
6
|
use constant FORCED => 1; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
54
|
|
99
|
1
|
|
|
1
|
|
6
|
use constant USE_CACHE => 1; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
49
|
|
100
|
1
|
|
|
1
|
|
6
|
use constant DEBUG_MOD => 1; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
48
|
|
101
|
1
|
|
|
1
|
|
5
|
use constant EMPTY_OBJECT => 0; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
47
|
|
102
|
1
|
|
|
1
|
|
5
|
use constant MAIN_TAG => 'h4'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
98
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
BEGIN { |
105
|
1
|
|
|
1
|
|
3
|
$VERSION = '0.53'; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Convert age gradation to the digits |
108
|
|
|
|
|
|
|
# TODO: Store this info into constant file |
109
|
1
|
|
|
|
|
12
|
%FILM_CERT = ( G => 'All', |
110
|
|
|
|
|
|
|
R => 16, |
111
|
|
|
|
|
|
|
'NC-17' => 16, |
112
|
|
|
|
|
|
|
PG => 13, |
113
|
|
|
|
|
|
|
'PG-13' => 13 |
114
|
|
|
|
|
|
|
); |
115
|
|
|
|
|
|
|
|
116
|
1
|
|
|
|
|
9406
|
%FILM_KIND = ( '' => 'movie', |
117
|
|
|
|
|
|
|
TV => 'tv movie', |
118
|
|
|
|
|
|
|
V => 'video movie', |
119
|
|
|
|
|
|
|
mini => 'tv mini series', |
120
|
|
|
|
|
|
|
VG => 'video game', |
121
|
|
|
|
|
|
|
S => 'tv series', |
122
|
|
|
|
|
|
|
E => 'episode' |
123
|
|
|
|
|
|
|
); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
{ |
127
|
|
|
|
|
|
|
my %_defaults = ( |
128
|
|
|
|
|
|
|
cache => 0, |
129
|
|
|
|
|
|
|
debug => 0, |
130
|
|
|
|
|
|
|
error => [], |
131
|
|
|
|
|
|
|
cache_exp => '1 h', |
132
|
|
|
|
|
|
|
cache_root => '/tmp', |
133
|
|
|
|
|
|
|
matched => [], |
134
|
|
|
|
|
|
|
host => 'www.imdb.com', |
135
|
|
|
|
|
|
|
query => 'title/tt', |
136
|
|
|
|
|
|
|
search => 'find?s=tt&exact=true&q=', |
137
|
|
|
|
|
|
|
status => 0, |
138
|
|
|
|
|
|
|
timeout => 10, |
139
|
|
|
|
|
|
|
user_agent => 'Mozilla/5.0', |
140
|
|
|
|
|
|
|
decode_html => 1, |
141
|
|
|
|
|
|
|
full_plot_url => 'http://www.imdb.com/rg/title-tease/plotsummary/title/tt', |
142
|
|
|
|
|
|
|
_also_known_as => [], |
143
|
|
|
|
|
|
|
_official_sites => [], |
144
|
|
|
|
|
|
|
_release_dates => [], |
145
|
|
|
|
|
|
|
_duration => [], |
146
|
|
|
|
|
|
|
_top_info => [], |
147
|
|
|
|
|
|
|
_cast => [], |
148
|
|
|
|
|
|
|
); |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
0
|
|
|
sub _get_default_attrs { keys %_defaults } |
151
|
|
|
|
|
|
|
sub _get_default_value { |
152
|
0
|
|
|
0
|
|
|
my($self, $attr) = @_; |
153
|
0
|
|
|
|
|
|
$_defaults{$attr}; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 Constructor |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=over 4 |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=item new() |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
Object's constructor. You should pass as parameter movie title or IMDB code. |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
my $imdb = new IMDB::Film(crit => ); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
or |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
my $imdb = new IMDB::Film(crit => ); |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
or |
172
|
|
|
|
|
|
|
my $imdb = new IMDB::Film(crit => ); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
For more infomation about base methods refer to IMDB::BaseClass. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=item _init() |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
Initialize object. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=cut |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub _init { |
183
|
0
|
|
|
0
|
|
|
my CLASS_NAME $self = shift; |
184
|
0
|
|
|
|
|
|
my %args = @_; |
185
|
|
|
|
|
|
|
|
186
|
0
|
0
|
0
|
|
|
|
croak "Film IMDB ID or Title should be defined!" if !$args{crit} && !$args{file}; |
187
|
|
|
|
|
|
|
|
188
|
0
|
|
|
|
|
|
$self->SUPER::_init(%args); |
189
|
|
|
|
|
|
|
|
190
|
0
|
|
|
|
|
|
$self->title(FORCED, \%args); |
191
|
|
|
|
|
|
|
|
192
|
0
|
0
|
|
|
|
|
unless($self->title) { |
193
|
0
|
|
|
|
|
|
$self->status(EMPTY_OBJECT); |
194
|
0
|
|
|
|
|
|
$self->error('Not Found'); |
195
|
0
|
|
|
|
|
|
return; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
0
|
0
|
|
|
|
|
for my $prop (grep { /^_/ && |
|
0
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
!/^(_title|_code|_full_plot|_official_sites|_release_dates|_connections|_full_companies|_plot_keywords|_big_cover_url|_big_cover_page)$/ } sort keys %FIELDS) { |
200
|
0
|
|
|
|
|
|
($prop) = $prop =~ /^_(.*)/; |
201
|
0
|
|
|
|
|
|
$self->$prop(FORCED); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=back |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head2 Options |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=over 4 |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=item year |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Define a movie's year. It's useful to use it to get the proper movie by its title: |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
my $imdbObj = new IMDB::Film(crit => 'Jack', year => 2003); |
216
|
|
|
|
|
|
|
print "Got #" . $imdbObj->code . " " . $imdbObj->title . "\n"; #0379836 |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=item proxy |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
defines proxy server name and port: |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
proxy => 'http://proxy.myhost.com:80' |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
By default object tries to get proxy from environment |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item debug |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
switches on debug mode to display useful debug messages. Can be 0 or 1 (0 by default) |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=item cache |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
indicates use cache or not to store retrieved page content. Can be 0 or 1 (0 by default) |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=item cache_root |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
specifies a directory to store cache data. By default it use /tmp/FileCache for *NIX OS |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item cache_exp |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
specifies an expiration time for cache. By default, it's 1 hour |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=item clear_cache |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
indicates clear cached data before get request to IMDB.com or not |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=item timeout |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
specifies a timeout for HTTP connection in seconds (10 sec by default) |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=item user_agent |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
specifies an user agent for request ('Mozilla/5.0' by default) |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=item full_plot_url |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
specifies a full plot url for specified movie |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=item host |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
specifies a host name for IMDB site. By default it's www.imdb.com |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=item query |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
specifies a query string to get specified movie by its ID. By defualt it's 'title/tt' |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=item search |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
specifies query string to make a search movie by its title. By default it's 'find?tt=on;mx=20;q=' |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Example: |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
my $imdb = new IMDB::Film( crit => 'Troy', |
274
|
|
|
|
|
|
|
user_agent => 'Opera/8.x', |
275
|
|
|
|
|
|
|
timeout => 2, |
276
|
|
|
|
|
|
|
debug => 1, |
277
|
|
|
|
|
|
|
cache => 1, |
278
|
|
|
|
|
|
|
cache_root => '/tmp/imdb_cache', |
279
|
|
|
|
|
|
|
cache_exp => '1 d', |
280
|
|
|
|
|
|
|
); |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
It'll create an object with critery 'Troy', user agent 'Opera', timeout 2 seconds, debug mode on, |
283
|
|
|
|
|
|
|
using cache with directory '/tmp/imdb_cache' and expiration time in 1 day. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=cut |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub full_plot_url { |
288
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
289
|
0
|
0
|
|
|
|
|
if(@_) { $self->{full_plot_url} = shift } |
|
0
|
|
|
|
|
|
|
290
|
0
|
|
|
|
|
|
return $self->{full_plot_url} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub fields { |
294
|
0
|
|
|
0
|
0
|
|
my CLASS_NAME $self = shift; |
295
|
0
|
|
|
|
|
|
return \%FIELDS; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=back |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 Object Private Methods |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=over 4 |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=item _search_film() |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Implemets functionality to search film by name. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=cut |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub _search_film { |
311
|
0
|
|
|
0
|
|
|
my CLASS_NAME $self = shift; |
312
|
0
|
|
0
|
|
|
|
my $args = shift || {}; |
313
|
|
|
|
|
|
|
|
314
|
0
|
|
|
|
|
|
return $self->SUPER::_search_results('^\/title\/tt(\d+)', '/td', $args->{year}); |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=back |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head2 Object Public Methods |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=over 4 |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=item status() |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
Indicates a status of IMDB object: |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
0 - empty object; |
328
|
|
|
|
|
|
|
1 - loaded from file; |
329
|
|
|
|
|
|
|
2 - loaded from internet request; |
330
|
|
|
|
|
|
|
3 - loaded from cache. |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=item status_descr() |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
Return a description for IMDB object status. Can be 'Empty', 'Filed', 'Fresh' and 'Cached': |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
if($film->status) { |
338
|
|
|
|
|
|
|
print "This is a " . $film->status_descr . " object!"; |
339
|
|
|
|
|
|
|
} else { |
340
|
|
|
|
|
|
|
die "Cannot retrieve IMDB object!"; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=item title() |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
Retrieve film title from film page. If was got search page instead |
346
|
|
|
|
|
|
|
of film page this method calls method _search_film to get list |
347
|
|
|
|
|
|
|
matched films and continue to process first one: |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
my $title = $film->title(); |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=cut |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub title { |
354
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
355
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
356
|
0
|
|
0
|
|
|
|
my $args = shift || {}; |
357
|
|
|
|
|
|
|
|
358
|
0
|
0
|
|
|
|
|
if($forced) { |
359
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
360
|
|
|
|
|
|
|
|
361
|
0
|
|
|
|
|
|
$parser->get_tag('title'); |
362
|
0
|
|
|
|
|
|
my $title = $parser->get_text(); |
363
|
0
|
0
|
|
|
|
|
if($title =~ /Find \- IMDb/i) { |
364
|
0
|
|
|
|
|
|
$self->_show_message("Go to search page ...", 'DEBUG'); |
365
|
0
|
|
|
|
|
|
$title = $self->_search_film($args); |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
0
|
0
|
|
|
|
|
if($title) { |
369
|
0
|
0
|
|
|
|
|
$self->retrieve_code($parser, 'http://www.imdb.com/title/tt(\d+)') unless $self->code; |
370
|
0
|
|
|
|
|
|
$title =~ s/\*/\\*/g; |
371
|
0
|
|
|
|
|
|
$title = $self->_decode_special_symbols($title); |
372
|
|
|
|
|
|
|
|
373
|
0
|
|
|
|
|
|
$self->_show_message("title: $title", 'DEBUG'); |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# TODO: implement parsing of TV series like ALF (TV Series 1986–1990) |
376
|
0
|
|
|
|
|
|
$title =~ s/^imdb\s+\-\s+//i; |
377
|
0
|
|
|
|
|
|
($self->{_title}, $self->{_year}, $self->{_kind}) = $title =~ m!(.*?)\s+\((\d{4})(?:/[IVX]+)\)(?:\s\((\w*)\))?!; |
378
|
0
|
0
|
|
|
|
|
unless($self->{_title}) { |
379
|
0
|
|
|
|
|
|
($self->{_title}, $self->{_kind}, $self->{_year}) = $title =~ m!(.*?)\s+\((.*?)?\s?([0-9\-]*\s?)\)!; |
380
|
|
|
|
|
|
|
} |
381
|
0
|
0
|
|
|
|
|
$self->{_kind} = 'Movie' unless $self->{_kind}; # Default kind should be movie |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# "The Series" An Episode (2005) |
384
|
|
|
|
|
|
|
# "The Series" (2005) |
385
|
0
|
0
|
|
|
|
|
if( $self->{_title} =~ /\"[^\"]+\"(\s+.+\s+)?/ ) { |
386
|
0
|
0
|
|
|
|
|
$self->{_kind} = $1 ? 'E' : 'S'; |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
0
|
|
|
|
|
|
return $self->{_title}; |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=item kind() |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Get kind of movie: |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
my $kind = $film->kind(); |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
Possible values are: 'movie', 'tv series', 'tv mini series', 'video game', 'video movie', 'tv movie', 'episode'. |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=cut |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
sub kind { |
405
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
406
|
0
|
0
|
|
|
|
|
return exists $FILM_KIND{$self->{_kind}} ? $FILM_KIND{$self->{_kind}} : lc($self->{_kind}); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=item year() |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Get film year: |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
my $year = $film->year(); |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=cut |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sub year { |
418
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
419
|
0
|
|
|
|
|
|
return $self->{_year}; |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=item connections() |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
Retrieve connections for the movie as an arrays of hashes with folloeing structure |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
{ |
427
|
|
|
|
|
|
|
follows => [ { id => , title => , year => , ..., } ], |
428
|
|
|
|
|
|
|
followed_by => [ { id => , title => , year => , ..., } ], |
429
|
|
|
|
|
|
|
references => [ { id => , title => , year => , ..., } ], |
430
|
|
|
|
|
|
|
referenced_in => [ { id => , title => , year => , ..., } ], |
431
|
|
|
|
|
|
|
featured_in => [ { id => , title => , year => , ..., } ], |
432
|
|
|
|
|
|
|
spoofed_by => [ { id => , title => , year => , ..., } ], |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
my %connections = %{ $film->connections() }; |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=cut |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub connections { |
440
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
441
|
|
|
|
|
|
|
|
442
|
0
|
0
|
|
|
|
|
unless($self->{_connections}) { |
443
|
0
|
|
|
|
|
|
my $page; |
444
|
0
|
0
|
|
|
|
|
$page = $self->_cacheObj->get($self->code . '_connections') if $self->_cache; |
445
|
|
|
|
|
|
|
|
446
|
0
|
0
|
|
|
|
|
unless($page) { |
447
|
0
|
|
|
|
|
|
my $url = "http://". $self->{host} . "/" . $self->{query} . $self->code . "/trivia?tab=mc"; |
448
|
0
|
|
|
|
|
|
$self->_show_message("URL for movie connections is $url ...", 'DEBUG'); |
449
|
|
|
|
|
|
|
|
450
|
0
|
|
|
|
|
|
$page = $self->_get_page_from_internet($url); |
451
|
0
|
0
|
|
|
|
|
$self->_cacheObj->set($self->code.'_connections', $page, $self->_cache_exp) if $self->_cache; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED, \$page); |
455
|
|
|
|
|
|
|
|
456
|
0
|
|
|
|
|
|
my $group = undef; |
457
|
0
|
|
|
|
|
|
my %result; |
458
|
0
|
|
|
|
|
|
my @lookFor = ('h4'); |
459
|
0
|
|
|
|
|
|
while (my $tag = $parser->get_tag(@lookFor)) { |
460
|
0
|
0
|
|
|
|
|
if ($tag->[0] eq 'h4') { |
|
|
0
|
|
|
|
|
|
461
|
0
|
|
|
|
|
|
$group = HTML::Entities::encode_entities($parser->get_text); |
462
|
0
|
|
|
|
|
|
$group = lc($group); |
463
|
0
|
|
|
|
|
|
$group =~ s/\s+/_/g; |
464
|
0
|
|
|
|
|
|
$group =~ s/( |\?|\:)//; |
465
|
0
|
|
|
|
|
|
$group =~ s/&/and/; |
466
|
0
|
|
|
|
|
|
$result{$group} = []; |
467
|
0
|
|
|
|
|
|
@lookFor = ('h4', 'a', 'hr', 'hr/'); |
468
|
|
|
|
|
|
|
} elsif ($tag->[0] eq 'a') { |
469
|
0
|
|
|
|
|
|
my $id; |
470
|
0
|
0
|
|
|
|
|
($id)= $tag->[1]->{href} =~ /(\d+)/ if $tag->[1]->{href}; |
471
|
0
|
|
|
|
|
|
my $name = $parser->get_trimmed_text; |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# Handle series episodes (usually in 'referenced' sections) |
474
|
0
|
|
|
|
|
|
my($series,$t,$s,$e) = ($name =~ /^(.*?): *(.*?) *\(?#(\d+)\.(\d+)\)?$/); |
475
|
0
|
0
|
|
|
|
|
$name = $series if defined $series; |
476
|
|
|
|
|
|
|
|
477
|
0
|
|
|
|
|
|
$tag = $parser->get_tag('/a'); |
478
|
0
|
|
|
|
|
|
my $next = $parser->get_trimmed_text(); |
479
|
0
|
|
|
|
|
|
my %film = ('id' => $id, 'title' => $name); |
480
|
0
|
0
|
|
|
|
|
if(defined $t) { |
481
|
0
|
|
|
|
|
|
$film{'series_title'} = $t; |
482
|
0
|
|
|
|
|
|
$film{'season'} = $s; |
483
|
0
|
|
|
|
|
|
$film{'episode'} = $e; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
0
|
0
|
|
|
|
|
$film{'year'} = $1 if $next =~ /\((\d{4})\)/; |
487
|
0
|
0
|
|
|
|
|
next if ($next =~ /\(VG\)/); |
488
|
0
|
|
|
|
|
|
push @{$result{$group}}, \%film; |
|
0
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
} else { |
490
|
|
|
|
|
|
|
# Stop when we hit the divider |
491
|
0
|
|
|
|
|
|
last; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
0
|
|
|
|
|
|
$self->{_connections} = \%result; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
0
|
|
|
|
|
|
return $self->{_connections}; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=item full_companies() |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
Retrieve companies for the movie as an array where each item has following stucture: |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
{ |
507
|
|
|
|
|
|
|
production => [ { name => , url => , extra => } ], |
508
|
|
|
|
|
|
|
distributors => [ { name => , url => , extra => } ], |
509
|
|
|
|
|
|
|
special_effects => [ { name => , url => , extra => } ], |
510
|
|
|
|
|
|
|
other => [ { name => , url => , extra => } ], |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
my %full_companies = %{ $film->full_companies() }; |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=cut |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub full_companies { |
518
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
519
|
|
|
|
|
|
|
|
520
|
0
|
0
|
|
|
|
|
unless($self->{_full_companies}) { |
521
|
0
|
|
|
|
|
|
my $page; |
522
|
0
|
0
|
|
|
|
|
$page = $self->_cacheObj->get($self->code . '_full_companies') if $self->_cache; |
523
|
|
|
|
|
|
|
|
524
|
0
|
0
|
|
|
|
|
unless($page) { |
525
|
0
|
|
|
|
|
|
my $url = "http://". $self->{host} . "/" . $self->{query} . $self->code . "/companycredits"; |
526
|
0
|
|
|
|
|
|
$self->_show_message("URL for company credits is $url ...", 'DEBUG'); |
527
|
|
|
|
|
|
|
|
528
|
0
|
|
|
|
|
|
$page = $self->_get_page_from_internet($url); |
529
|
0
|
0
|
|
|
|
|
$self->_cacheObj->set($self->code.'_full_companies', $page, $self->_cache_exp) if $self->_cache; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED, \$page); |
533
|
0
|
|
|
|
|
|
my $group = undef; |
534
|
0
|
|
|
|
|
|
my %result; |
535
|
0
|
|
|
|
|
|
my @lookFor = ('h2'); |
536
|
0
|
|
|
|
|
|
while (my $tag = $parser->get_tag(@lookFor)) { |
537
|
0
|
0
|
|
|
|
|
if ($tag->[0] eq 'h2') { |
|
|
0
|
|
|
|
|
|
538
|
0
|
|
|
|
|
|
$group = $parser->get_text; |
539
|
0
|
|
|
|
|
|
$group =~ s/ compan(y|ies)//i; |
540
|
0
|
|
|
|
|
|
$group =~ tr/A-Z/a-z/; |
541
|
0
|
|
|
|
|
|
$group =~ s/\s+/_/g; |
542
|
0
|
|
|
|
|
|
$result{$group} = []; |
543
|
0
|
|
|
|
|
|
@lookFor = ('h2', 'a', 'hr', 'hr/'); |
544
|
|
|
|
|
|
|
} elsif($tag->[0] eq 'a') { |
545
|
|
|
|
|
|
|
|
546
|
0
|
|
|
|
|
|
my($url) = $tag->[1]->{href}; |
547
|
0
|
|
|
|
|
|
my $name = $parser->get_trimmed_text; |
548
|
|
|
|
|
|
|
|
549
|
0
|
|
|
|
|
|
$tag = $parser->get_tag('/a'); |
550
|
0
|
|
|
|
|
|
my $next = $parser->get_trimmed_text(); |
551
|
0
|
|
|
|
|
|
$next =~ s/^[\t \xA0]+//; # nbsp comes out as \xA0 |
552
|
0
|
|
|
|
|
|
my %company = ( 'url' => $url, |
553
|
|
|
|
|
|
|
'name' => $name, |
554
|
|
|
|
|
|
|
'extra' => $next ); |
555
|
0
|
|
|
|
|
|
push @{$result{$group}}, \%company; |
|
0
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
} else { |
557
|
|
|
|
|
|
|
# Stop when we hit the divider |
558
|
0
|
|
|
|
|
|
last; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
|
562
|
0
|
|
|
|
|
|
$self->{_full_companies} = \%result; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
0
|
|
|
|
|
|
return $self->{_full_companies}; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=item company() |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
Returns a list of companies given for a specified movie: |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
my $company = $film->company(); |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
or |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
my @companies = $film->company(); |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=cut |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
sub company { |
581
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
582
|
|
|
|
|
|
|
|
583
|
0
|
0
|
|
|
|
|
unless($self->{_company}) { |
584
|
0
|
|
|
|
|
|
my @companies = split /\s?\,\s?/, $self->_get_simple_prop('Production Co'); |
585
|
0
|
|
|
|
|
|
$self->{_company} = \@companies; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
|
588
|
0
|
0
|
|
|
|
|
return wantarray ? $self->{_company} : $self->{_company}[0]; |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
=item episodes() |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
Retrieve episodes info list each element of which is hash reference for tv series - |
594
|
|
|
|
|
|
|
{ id => , title => , season => , episode => , date => , plot => }: |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
my @episodes = @{ $film->episodes() }; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=cut |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
sub episodes { |
601
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
602
|
|
|
|
|
|
|
|
603
|
0
|
0
|
0
|
|
|
|
return [] if !$self->kind or $self->kind !~ /tv serie/i; |
604
|
|
|
|
|
|
|
|
605
|
0
|
0
|
|
|
|
|
unless($self->{_episodes}) { |
606
|
0
|
|
|
|
|
|
my $page; |
607
|
0
|
0
|
|
|
|
|
$page = $self->_cacheObj->get($self->code . '_episodes') if $self->_cache; |
608
|
|
|
|
|
|
|
|
609
|
0
|
0
|
|
|
|
|
unless($page) { |
610
|
0
|
|
|
|
|
|
my $url = "http://". $self->{host} . "/" . $self->{query} . $self->code . "/epcast"; |
611
|
0
|
|
|
|
|
|
$self->_show_message("URL for episodes is $url ...", 'DEBUG'); |
612
|
|
|
|
|
|
|
|
613
|
0
|
|
|
|
|
|
$page = $self->_get_page_from_internet($url); |
614
|
0
|
0
|
|
|
|
|
$self->_cacheObj->set($self->code.'_episodes', $page, $self->_cache_exp) if $self->_cache; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED, \$page); |
618
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('h4')) { |
619
|
0
|
|
|
|
|
|
my $id; |
620
|
0
|
|
|
|
|
|
my($season, $episode); |
621
|
0
|
0
|
|
|
|
|
next unless(($season, $episode) = $parser->get_text =~ /Season\s+(.*?),\s+Episode\s+([^:]+)/); |
622
|
0
|
|
|
|
|
|
my $imdb_tag = $parser->get_tag('a'); |
623
|
0
|
0
|
|
|
|
|
($id) = $imdb_tag->[1]->{href} =~ /(\d+)/ if $imdb_tag->[1]->{href}; |
624
|
0
|
|
|
|
|
|
my $title = $parser->get_trimmed_text; |
625
|
0
|
|
|
|
|
|
$parser->get_tag('b'); |
626
|
0
|
|
|
|
|
|
my($date) = $parser->get_trimmed_text; |
627
|
0
|
|
|
|
|
|
$parser->get_tag('br'); |
628
|
0
|
|
|
|
|
|
my $plot = $parser->get_trimmed_text; |
629
|
|
|
|
|
|
|
|
630
|
0
|
|
|
|
|
|
push @{ $self->{_episodes} }, { |
|
0
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
season => $season, |
632
|
|
|
|
|
|
|
episode => $episode, |
633
|
|
|
|
|
|
|
id => $id, |
634
|
|
|
|
|
|
|
title => $title, |
635
|
|
|
|
|
|
|
date => $date, |
636
|
|
|
|
|
|
|
plot => $plot |
637
|
|
|
|
|
|
|
}; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
|
641
|
0
|
|
|
|
|
|
return $self->{_episodes}; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=item episodeof() |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
Retrieve parent tv series list each element of which is hash reference for episode - |
647
|
|
|
|
|
|
|
{ id => , title => , year => }: |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
my @tvseries = @{ $film->episodeof() }; |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=cut |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
sub episodeof { |
654
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
655
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
656
|
|
|
|
|
|
|
|
657
|
0
|
0
|
0
|
|
|
|
return if !$self->kind or $self->kind ne "episode"; |
658
|
|
|
|
|
|
|
|
659
|
0
|
0
|
|
|
|
|
if($forced) { |
660
|
0
|
|
|
|
|
|
my($episodeof, $title, $year, $episode, $season, $id); |
661
|
0
|
|
|
|
|
|
my($parser) = $self->_parser(FORCED); |
662
|
|
|
|
|
|
|
|
663
|
0
|
|
|
|
|
|
while($parser->get_tag(MAIN_TAG)) { |
664
|
0
|
0
|
|
|
|
|
last if $parser->get_text =~ /^TV Series/i; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
|
667
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('a')) { |
668
|
0
|
0
|
|
|
|
|
($title, $year) = ($1, $2) if $parser->get_text =~ m!(.*?)\s+\(([\d\?]{4}).*?\)!; |
669
|
0
|
0
|
|
|
|
|
last unless $tag->[1]{href} =~ /title/i; |
670
|
0
|
|
|
|
|
|
($id) = $tag->[1]{href} =~ /(\d+)/; |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
#start again |
674
|
0
|
|
|
|
|
|
$parser = $self->_parser(FORCED); |
675
|
0
|
|
|
|
|
|
while($parser->get_tag(MAIN_TAG)) { |
676
|
0
|
0
|
|
|
|
|
last if $parser->get_text =~ /^Original Air Date/i; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
0
|
|
|
|
|
|
$parser->get_token; |
680
|
0
|
|
|
|
|
|
($season, $episode) = $parser->get_text =~ /\(Season\s+(\d+),\s+Episode\s+(\d+)/; |
681
|
|
|
|
|
|
|
|
682
|
0
|
|
|
|
|
|
push @{ $self->{_episodeof} }, {title => $title, year => $year, id => $id, season => $season, episode => $episode}; |
|
0
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
|
685
|
0
|
|
|
|
|
|
return $self->{_episodeof}; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=item cover() |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
Retrieve url of film cover: |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
my $cover = $film->cover(); |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=cut |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
sub cover { |
697
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
698
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
699
|
|
|
|
|
|
|
|
700
|
0
|
0
|
|
|
|
|
if($forced) { |
701
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
702
|
0
|
|
|
|
|
|
my $cover; |
703
|
|
|
|
|
|
|
|
704
|
0
|
|
|
|
|
|
my $title = quotemeta($self->title); |
705
|
0
|
|
|
|
|
|
while(my $img_tag = $parser->get_tag('img')) { |
706
|
0
|
|
0
|
|
|
|
$img_tag->[1]{alt} ||= ''; |
707
|
|
|
|
|
|
|
|
708
|
0
|
0
|
|
|
|
|
last if $img_tag->[1]{alt} =~ /^poster not submitted/i; |
709
|
|
|
|
|
|
|
|
710
|
0
|
0
|
|
|
|
|
if($img_tag->[1]{alt} =~ /Poster$/) { |
711
|
0
|
|
|
|
|
|
$cover = $img_tag->[1]{src}; |
712
|
0
|
|
|
|
|
|
last; |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
} |
715
|
0
|
|
|
|
|
|
$self->{_cover} = $cover; |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
0
|
|
|
|
|
|
return $self->{_cover}; |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
sub top_info { |
722
|
0
|
|
|
0
|
0
|
|
my CLASS_NAME $self = shift; |
723
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
724
|
0
|
0
|
0
|
|
|
|
if($forced or !$self->{'_top_info'}) { |
725
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
726
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('div')) { |
727
|
0
|
0
|
0
|
|
|
|
last if $tag->[1]->{class} && $tag->[1]->{class} eq 'article highlighted'; |
728
|
|
|
|
|
|
|
} |
729
|
0
|
|
|
|
|
|
my $text = $parser->get_trimmed_text('span'); |
730
|
0
|
|
|
|
|
|
my @top_items = split /\s?\|\s?/, $text; |
731
|
0
|
|
|
|
|
|
$self->{_top_info} = \@top_items; |
732
|
|
|
|
|
|
|
} |
733
|
0
|
|
|
|
|
|
return $self->{_top_info}; |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
=item recommendation_movies() |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Return a list of recommended movies for specified one as a hash where each key is a movie ID in IMDB and |
739
|
|
|
|
|
|
|
value - movie's title: |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
$recommendation_movies = $film->recommendation_movies(); |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
For example, the list of recommended movies for Troy will be similar to that: |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
__DATA__ |
746
|
|
|
|
|
|
|
$VAR1 = { |
747
|
|
|
|
|
|
|
'0416449' => '300', |
748
|
|
|
|
|
|
|
'0167260' => 'The Lord of the Rings: The Return of the King', |
749
|
|
|
|
|
|
|
'0442933' => 'Beowulf', |
750
|
|
|
|
|
|
|
'0320661' => 'Kingdom of Heaven', |
751
|
|
|
|
|
|
|
'0172495' => 'Gladiator' |
752
|
|
|
|
|
|
|
}; |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=cut |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
sub recommendation_movies { |
757
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
758
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
759
|
|
|
|
|
|
|
|
760
|
0
|
0
|
|
|
|
|
if($forced) { |
761
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
762
|
|
|
|
|
|
|
|
763
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('h2')) { |
764
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
765
|
0
|
0
|
|
|
|
|
last if $text =~ /recommendations/i; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
0
|
|
|
|
|
|
my %result = (); |
769
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag()) { |
770
|
0
|
0
|
|
|
|
|
last if $tag->[0] eq '/table'; |
771
|
|
|
|
|
|
|
|
772
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
773
|
0
|
0
|
0
|
|
|
|
if($tag->[0] eq 'a' && $text && $tag->[1]{href} =~ /tt(\d+)/) { |
|
|
|
0
|
|
|
|
|
774
|
0
|
|
|
|
|
|
$result{$1} = $text; |
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
0
|
|
|
|
|
|
$self->{_recommendation_movies} = \%result; |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
|
781
|
0
|
|
|
|
|
|
return $self->{_recommendation_movies}; |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
=item directors() |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
Retrieve film directors list each element of which is hash reference - |
787
|
|
|
|
|
|
|
{ id => , name => }: |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
my @directors = @{ $film->directors() }; |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=cut |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
sub directors { |
794
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
795
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
796
|
|
|
|
|
|
|
|
797
|
0
|
0
|
|
|
|
|
if($forced) { |
798
|
0
|
|
|
|
|
|
my ($parser) = $self->_parser(FORCED); |
799
|
0
|
|
|
|
|
|
my (@directors, $tag); |
800
|
|
|
|
|
|
|
|
801
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag(MAIN_TAG)) { |
802
|
0
|
|
|
|
|
|
my $text = $parser->get_text; |
803
|
0
|
0
|
|
|
|
|
last if $text =~ /direct(?:ed|or)/i; |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
|
806
|
0
|
|
|
|
|
|
while ($tag = $parser->get_tag() ) { |
807
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
808
|
|
|
|
|
|
|
|
809
|
0
|
0
|
0
|
|
|
|
last if $text =~ /^writ(?:ing|ers)/i or $tag->[0] eq '/div'; |
810
|
|
|
|
|
|
|
|
811
|
0
|
0
|
0
|
|
|
|
if($tag->[0] eq 'a' && $tag->[1]{href} && $text !~ /(img|more)/i) { |
|
|
|
0
|
|
|
|
|
812
|
0
|
|
|
|
|
|
my($id) = $tag->[1]{href} =~ /(\d+)/; |
813
|
0
|
|
|
|
|
|
push @directors, {id => $id, name => $text}; |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
0
|
|
|
|
|
|
$self->{_directors} = \@directors; |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
|
820
|
0
|
|
|
|
|
|
return $self->{_directors}; |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=item writers() |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
Retrieve film writers list each element of which is hash reference - |
826
|
|
|
|
|
|
|
{ id => , name => }: |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
my @writers = @{ $film->writers() }; |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
Note: this method returns Writing credits from movie main page. It maybe not |
831
|
|
|
|
|
|
|
contain a full list! |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=cut |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
sub writers { |
836
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
837
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
838
|
|
|
|
|
|
|
|
839
|
0
|
0
|
|
|
|
|
if($forced) { |
840
|
0
|
|
|
|
|
|
my ($parser) = $self->_parser(FORCED); |
841
|
0
|
|
|
|
|
|
my (@writers, $tag); |
842
|
|
|
|
|
|
|
|
843
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag(MAIN_TAG)) { |
844
|
0
|
0
|
|
|
|
|
last if $parser->get_text =~ /writ(?:ing|ers|er)/i; |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
|
847
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag()) { |
848
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
849
|
0
|
0
|
|
|
|
|
last if $tag->[0] eq '/div'; |
850
|
|
|
|
|
|
|
|
851
|
0
|
0
|
0
|
|
|
|
if($tag->[0] eq 'a' && $tag->[1]{href} && $text !~ /more/i && $text !~ /img/i) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
852
|
0
|
0
|
|
|
|
|
if(my($id) = $tag->[1]{href} =~ /nm(\d+)/) { |
853
|
0
|
|
|
|
|
|
push @writers, {id => $id, name => $text}; |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
|
858
|
0
|
|
|
|
|
|
$self->{_writers} = \@writers; |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
|
861
|
0
|
|
|
|
|
|
return $self->{_writers}; |
862
|
|
|
|
|
|
|
} |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=item genres() |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
Retrieve film genres list: |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
my @genres = @{ $film->genres() }; |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=cut |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
sub genres { |
873
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
874
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
875
|
|
|
|
|
|
|
|
876
|
0
|
0
|
|
|
|
|
if($forced) { |
877
|
0
|
|
|
|
|
|
my ($parser) = $self->_parser(FORCED); |
878
|
0
|
|
|
|
|
|
my (@genres); |
879
|
|
|
|
|
|
|
|
880
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag(MAIN_TAG)) { |
881
|
0
|
0
|
|
|
|
|
last if $parser->get_text =~ /^genre/i; |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('a')) { |
885
|
0
|
|
|
|
|
|
my $genre = $parser->get_text; |
886
|
0
|
0
|
|
|
|
|
last unless $tag->[1]{href} =~ m!/genre/!i; |
887
|
0
|
0
|
|
|
|
|
last if $genre =~ /more/i; |
888
|
0
|
|
|
|
|
|
push @genres, $genre; |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
|
891
|
0
|
|
|
|
|
|
$self->{_genres} = \@genres; |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
|
894
|
0
|
|
|
|
|
|
return $self->{_genres}; |
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=item tagline() |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
Retrieve film tagline: |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
my $tagline = $film->tagline(); |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
=cut |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
sub tagline { |
906
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
907
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
908
|
|
|
|
|
|
|
|
909
|
0
|
0
|
|
|
|
|
if($forced) { |
910
|
0
|
|
|
|
|
|
my ($parser) = $self->_parser(FORCED); |
911
|
|
|
|
|
|
|
|
912
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag(MAIN_TAG)) { |
913
|
0
|
0
|
|
|
|
|
last if($parser->get_text =~ /tagline/i); |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
|
916
|
0
|
|
|
|
|
|
$self->{_tagline} = $parser->get_trimmed_text(MAIN_TAG, 'a'); |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
|
919
|
0
|
|
|
|
|
|
return $self->{_tagline}; |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=item plot() |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
Returns a movie plot: |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
my $plot = $film->plot; |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=cut |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
sub plot { |
931
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
932
|
|
|
|
|
|
|
|
933
|
0
|
|
|
|
|
|
return $self->{_plot}; |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
=item storyline() |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
Retrieve film plot summary: |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
my $storyline = $film->storyline(); |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=cut |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
sub storyline { |
945
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
946
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
947
|
|
|
|
|
|
|
|
948
|
0
|
0
|
|
|
|
|
if($forced) { |
949
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
950
|
|
|
|
|
|
|
|
951
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('h2')) { |
952
|
0
|
0
|
|
|
|
|
last if $parser->get_text =~ /^storyline$/i; |
953
|
|
|
|
|
|
|
} |
954
|
|
|
|
|
|
|
|
955
|
0
|
|
|
|
|
|
my $plot = $parser->get_trimmed_text(MAIN_TAG, 'em'); |
956
|
0
|
|
|
|
|
|
$self->{_storyline} = $self->_decode_special_symbols($plot); |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
|
959
|
0
|
|
|
|
|
|
return $self->{_storyline}; |
960
|
|
|
|
|
|
|
} |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=item rating() |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
In scalar context returns film user rating, in array context returns |
965
|
|
|
|
|
|
|
film rating, number of votes and info about place in TOP 250 or some other TOP and avards: |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
my $rating = $film->rating(); |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
or |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
my($rating, $vnum, $avards) = $film->rating(); |
972
|
|
|
|
|
|
|
print "RATING: $rating ($vnum votes)"; |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
Note, that $avards is array reference where the first elemen is a TOP info if so, and the next element is other avards - Oscar, nominations and etc |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=cut |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
sub rating { |
979
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
980
|
0
|
|
0
|
|
|
|
my ($forced) = shift || 0; |
981
|
|
|
|
|
|
|
|
982
|
0
|
0
|
|
|
|
|
if($forced) { |
983
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
984
|
|
|
|
|
|
|
|
985
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('div')) { |
986
|
0
|
0
|
0
|
|
|
|
last if $tag->[1]{class} && $tag->[1]{class} eq 'star-box-details'; |
987
|
|
|
|
|
|
|
} |
988
|
|
|
|
|
|
|
|
989
|
0
|
|
|
|
|
|
my $text = $parser->get_trimmed_text('/a'); |
990
|
|
|
|
|
|
|
|
991
|
0
|
|
|
|
|
|
my($rating, $val) = $text =~ m!(\d+\.?\d*)/10.*?(\d+,?\d*)!; |
992
|
0
|
0
|
|
|
|
|
$val =~ s/\,// if $val; |
993
|
|
|
|
|
|
|
|
994
|
0
|
|
|
|
|
|
$self->{_rating} = [$rating, $val, $self->top_info]; |
995
|
|
|
|
|
|
|
|
996
|
0
|
0
|
|
|
|
|
unless($self->{_plot}) { |
997
|
0
|
|
|
|
|
|
my $tag = $parser->get_tag('p'); |
998
|
0
|
|
|
|
|
|
my $text = $parser->get_trimmed_text('/p'); |
999
|
0
|
|
|
|
|
|
$self->{_plot} = $text; |
1000
|
|
|
|
|
|
|
} |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
|
1003
|
0
|
0
|
|
|
|
|
return wantarray ? @{ $self->{_rating} } : $self->{_rating}[0]; |
|
0
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=item cast() |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
Retrieve film cast list each element of which is hash reference - |
1009
|
|
|
|
|
|
|
{ id => , name => , role => }: |
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
my @cast = @{ $film->cast() }; |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
Note: this method retrieves a cast list first billed only! |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=cut |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
sub cast { |
1020
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1021
|
0
|
|
0
|
|
|
|
my ($forced) = shift || 0; |
1022
|
|
|
|
|
|
|
|
1023
|
0
|
0
|
|
|
|
|
if($forced) { |
1024
|
0
|
|
|
|
|
|
my (@cast, $tag, $person, $id, $role); |
1025
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
1026
|
|
|
|
|
|
|
|
1027
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag('table')) { |
1028
|
0
|
0
|
0
|
|
|
|
last if $tag->[1]->{class} && $tag->[1]->{class} =~ /^cast_list$/i; |
1029
|
|
|
|
|
|
|
} |
1030
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag()) { |
1031
|
0
|
0
|
0
|
|
|
|
last if $tag->[0] eq 'a' && $tag->[1]{href} && $tag->[1]{href} =~ /fullcredits/i; |
|
|
|
0
|
|
|
|
|
1032
|
0
|
0
|
0
|
|
|
|
if($tag->[0] eq 'td' && $tag->[1]{class} && $tag->[1]{class} eq 'name') { |
|
|
|
0
|
|
|
|
|
1033
|
0
|
|
|
|
|
|
$tag = $parser->get_tag('a'); |
1034
|
0
|
0
|
0
|
|
|
|
if($tag->[1]{href} && $tag->[1]{href} =~ m#name/nm(\d+?)/#) { |
1035
|
0
|
|
|
|
|
|
$person = $parser->get_text; |
1036
|
0
|
|
|
|
|
|
$id = $1; |
1037
|
0
|
|
|
|
|
|
my $text = $parser->get_trimmed_text('/tr'); |
1038
|
0
|
|
|
|
|
|
($role) = $text =~ /.*?\s+(.*)$/; |
1039
|
0
|
|
|
|
|
|
push @cast, {id => $id, name => $person, role => $role}; |
1040
|
|
|
|
|
|
|
} |
1041
|
|
|
|
|
|
|
} |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
|
1044
|
0
|
|
|
|
|
|
$self->{_cast} = \@cast; |
1045
|
|
|
|
|
|
|
} |
1046
|
|
|
|
|
|
|
|
1047
|
0
|
|
|
|
|
|
return $self->{_cast}; |
1048
|
|
|
|
|
|
|
} |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=item duration() |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
In the scalar context it retrieves a film duration in minutes (the first record): |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
my $duration = $film->duration(); |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
In array context it retrieves all movie's durations: |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
my @durations = $film->duration(); |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
=cut |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
sub duration { |
1063
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1064
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
1065
|
|
|
|
|
|
|
|
1066
|
0
|
0
|
|
|
|
|
if($forced) { |
1067
|
|
|
|
|
|
|
|
1068
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
1069
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag(MAIN_TAG)) { |
1070
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
1071
|
0
|
0
|
|
|
|
|
last if $text =~ /runtime:/i; |
1072
|
|
|
|
|
|
|
} |
1073
|
0
|
|
|
|
|
|
my $duration_str = $self->_decode_special_symbols($parser->get_trimmed_text(MAIN_TAG, '/div')); |
1074
|
0
|
|
|
|
|
|
my @runtime = split /\s+(\/|\|)\s+/, $duration_str; |
1075
|
|
|
|
|
|
|
|
1076
|
0
|
|
|
|
|
|
$self->{_duration} = \@runtime; |
1077
|
|
|
|
|
|
|
} |
1078
|
|
|
|
|
|
|
|
1079
|
0
|
0
|
|
|
|
|
return wantarray ? @{ $self->{_duration} } : $self->{_duration}->[0]; |
|
0
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
=item country() |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
Retrieve film produced countries list: |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
my $countries = $film->country(); |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=cut |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
sub country { |
1091
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1092
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
1093
|
|
|
|
|
|
|
|
1094
|
0
|
0
|
|
|
|
|
if($forced) { |
1095
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
1096
|
0
|
|
|
|
|
|
while (my $tag = $parser->get_tag(MAIN_TAG)) { |
1097
|
0
|
0
|
|
|
|
|
last if $parser->get_text =~ /country/i; |
1098
|
|
|
|
|
|
|
} |
1099
|
|
|
|
|
|
|
|
1100
|
0
|
|
|
|
|
|
my (@countries); |
1101
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag()) { |
1102
|
|
|
|
|
|
|
|
1103
|
0
|
0
|
0
|
|
|
|
if( $tag->[0] eq 'a' && $tag->[1]{href} && $tag->[1]{href} =~ m!/country/[a-z]{2}!i ) { |
|
|
|
0
|
|
|
|
|
1104
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
1105
|
0
|
|
|
|
|
|
$text =~ s/\n//g; |
1106
|
0
|
|
|
|
|
|
push @countries, $text; |
1107
|
|
|
|
|
|
|
} |
1108
|
|
|
|
|
|
|
|
1109
|
0
|
0
|
|
|
|
|
last if $tag->[0] eq 'br'; |
1110
|
|
|
|
|
|
|
} |
1111
|
|
|
|
|
|
|
|
1112
|
0
|
|
|
|
|
|
$self->{_country} = \@countries; |
1113
|
|
|
|
|
|
|
} |
1114
|
|
|
|
|
|
|
|
1115
|
0
|
|
|
|
|
|
return $self->{_country} |
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
=item language() |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
Retrieve film languages list: |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
my $languages = $film->language(); |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
=cut |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
sub language { |
1127
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1128
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
1129
|
|
|
|
|
|
|
|
1130
|
0
|
0
|
|
|
|
|
if($forced) { |
1131
|
0
|
|
|
|
|
|
my (@languages, $tag); |
1132
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
1133
|
0
|
|
|
|
|
|
while ($tag = $parser->get_tag(MAIN_TAG)) { |
1134
|
0
|
0
|
|
|
|
|
last if $parser->get_text =~ /language/i; |
1135
|
|
|
|
|
|
|
} |
1136
|
|
|
|
|
|
|
|
1137
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag()) { |
1138
|
0
|
0
|
0
|
|
|
|
if( $tag->[0] eq 'a' && $tag->[1]{href} && $tag->[1]{href} =~ m!/language/[a-z]{2}!i ) { |
|
|
|
0
|
|
|
|
|
1139
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
1140
|
0
|
|
|
|
|
|
$text =~ s/\n//g; |
1141
|
0
|
|
|
|
|
|
push @languages, $text; |
1142
|
|
|
|
|
|
|
} |
1143
|
|
|
|
|
|
|
|
1144
|
0
|
0
|
|
|
|
|
last if $tag->[0] eq '/div'; |
1145
|
|
|
|
|
|
|
} |
1146
|
|
|
|
|
|
|
|
1147
|
0
|
|
|
|
|
|
$self->{_language} = \@languages; |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
|
1150
|
0
|
|
|
|
|
|
return $self->{_language}; |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
} |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
=item also_known_as() |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
Retrieve AKA information as array, each element of which is string: |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
my $aka = $film->also_known_as(); |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
print map { "$_\n" } @$aka; |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
=cut |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
sub also_known_as { |
1165
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self= shift; |
1166
|
0
|
0
|
|
|
|
|
unless($self->{_also_known_as}) { |
1167
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
1168
|
|
|
|
|
|
|
|
1169
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag(MAIN_TAG)) { |
1170
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
1171
|
0
|
|
|
|
|
|
$self->_show_message("AKA: $text", 'DEBUG'); |
1172
|
0
|
0
|
|
|
|
|
last if $text =~ /^(aka|also known as)/i; |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
|
1175
|
0
|
|
|
|
|
|
my $aka = $parser->get_trimmed_text('span'); |
1176
|
|
|
|
|
|
|
|
1177
|
0
|
|
|
|
|
|
$self->_show_message("AKA: $aka", 'DEBUG'); |
1178
|
0
|
|
|
|
|
|
my @aka = ($aka); |
1179
|
0
|
|
|
|
|
|
$self->{_also_known_as} = \@aka; |
1180
|
|
|
|
|
|
|
} |
1181
|
|
|
|
|
|
|
|
1182
|
0
|
|
|
|
|
|
return $self->{_also_known_as}; |
1183
|
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=item trivia() |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
Retrieve a movie trivia: |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
my $trivia = $film->trivia(); |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
=cut |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
sub trivia { |
1194
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1195
|
|
|
|
|
|
|
|
1196
|
0
|
0
|
|
|
|
|
$self->{_trivia} = $self->_get_simple_prop('trivia') unless $self->{_trivia}; |
1197
|
0
|
|
|
|
|
|
return $self->{_trivia}; |
1198
|
|
|
|
|
|
|
} |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
=item goofs() |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
Retrieve a movie goofs: |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
my $goofs = $film->goofs(); |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
=cut |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
sub goofs { |
1209
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1210
|
|
|
|
|
|
|
|
1211
|
0
|
0
|
|
|
|
|
$self->{_goofs} = $self->_get_simple_prop('goofs') unless($self->{_goofs}); |
1212
|
0
|
|
|
|
|
|
return $self->{_goofs}; |
1213
|
|
|
|
|
|
|
} |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
=item awards() |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
Retrieve a general information about movie awards like 1 win & 1 nomination: |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
my $awards = $film->awards(); |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
=cut |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
sub awards { |
1224
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1225
|
|
|
|
|
|
|
|
1226
|
0
|
|
|
|
|
|
return $self->{_top_info}; |
1227
|
|
|
|
|
|
|
} |
1228
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
=item mpaa_info() |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
Return a MPAA for the specified move: |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
my mpaa = $film->mpaa_info(); |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
=cut |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
sub mpaa_info { |
1238
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1239
|
0
|
0
|
|
|
|
|
unless($self->{_mpaa_info}) { |
1240
|
|
|
|
|
|
|
|
1241
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
1242
|
|
|
|
|
|
|
|
1243
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag(MAIN_TAG)) { |
1244
|
0
|
|
|
|
|
|
my $text = $parser->get_trimmed_text(MAIN_TAG, '/a'); |
1245
|
0
|
0
|
|
|
|
|
last if $text =~ /^Motion Picture Rating/i; |
1246
|
|
|
|
|
|
|
} |
1247
|
|
|
|
|
|
|
|
1248
|
0
|
|
|
|
|
|
my $mpaa = $parser->get_trimmed_text('/span'); |
1249
|
0
|
|
|
|
|
|
$mpaa =~ s/^\)\s//; |
1250
|
0
|
|
|
|
|
|
$self->{_mpaa_info} = $mpaa; |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
|
1253
|
0
|
|
|
|
|
|
return $self->{_mpaa_info}; |
1254
|
|
|
|
|
|
|
} |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
=item aspect_ratio() |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
Returns an aspect ratio of specified movie: |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
my $aspect_ratio = $film->aspect_ratio(); |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
=cut |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
sub aspect_ratio { |
1265
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1266
|
|
|
|
|
|
|
|
1267
|
0
|
0
|
|
|
|
|
$self->{_aspect_ratio} = $self->_get_simple_prop('aspect ratio') unless $self->{_aspect_ratio}; |
1268
|
|
|
|
|
|
|
|
1269
|
0
|
|
|
|
|
|
return $self->{_aspect_ratio}; |
1270
|
|
|
|
|
|
|
} |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
=item summary() |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
Retrieve film user summary: |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
my $descr = $film->summary(); |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
=cut |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
sub summary { |
1281
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1282
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
1283
|
|
|
|
|
|
|
|
1284
|
0
|
0
|
|
|
|
|
if($forced) { |
1285
|
0
|
|
|
|
|
|
my($tag, $text); |
1286
|
0
|
|
|
|
|
|
my($parser) = $self->_parser(FORCED); |
1287
|
|
|
|
|
|
|
|
1288
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag('b')) { |
1289
|
0
|
|
|
|
|
|
$text = $parser->get_text(); |
1290
|
0
|
0
|
|
|
|
|
last if $text =~ /^summary/i; |
1291
|
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
|
|
1293
|
0
|
|
|
|
|
|
$text = $parser->get_text('b', 'a'); |
1294
|
0
|
|
|
|
|
|
$self->{_summary} = $text; |
1295
|
|
|
|
|
|
|
} |
1296
|
|
|
|
|
|
|
|
1297
|
0
|
|
|
|
|
|
return $self->{_summary}; |
1298
|
|
|
|
|
|
|
} |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
=item certifications() |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
Retrieve list of film certifications each element of which is hash reference - |
1303
|
|
|
|
|
|
|
{ country => certificate }: |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
my @cert = $film->certifications(); |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
=cut |
1308
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
sub certifications { |
1310
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1311
|
0
|
|
0
|
|
|
|
my $forced = shift || 0; |
1312
|
0
|
|
|
|
|
|
my (%cert_list, $tag); |
1313
|
|
|
|
|
|
|
|
1314
|
0
|
0
|
|
|
|
|
if($forced) { |
1315
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
1316
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag(MAIN_TAG)) { |
1317
|
0
|
0
|
|
|
|
|
last if $parser->get_text =~ /certification/i; |
1318
|
|
|
|
|
|
|
} |
1319
|
|
|
|
|
|
|
|
1320
|
0
|
|
|
|
|
|
while($tag = $parser->get_tag()) { |
1321
|
|
|
|
|
|
|
|
1322
|
0
|
0
|
0
|
|
|
|
if($tag->[0] eq 'a' && $tag->[1]{href} && $tag->[1]{href} =~ /certificates/i) { |
|
|
|
0
|
|
|
|
|
1323
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
1324
|
0
|
|
|
|
|
|
$text =~ s/\n//g; |
1325
|
0
|
|
|
|
|
|
my($country, $range) = split /\:/, $text; |
1326
|
0
|
|
|
|
|
|
$cert_list{$country} = $range; |
1327
|
|
|
|
|
|
|
} |
1328
|
|
|
|
|
|
|
|
1329
|
0
|
0
|
|
|
|
|
last if $tag->[0] eq '/td'; |
1330
|
|
|
|
|
|
|
} |
1331
|
|
|
|
|
|
|
|
1332
|
0
|
|
|
|
|
|
$self->{_certifications} = \%cert_list; |
1333
|
|
|
|
|
|
|
} |
1334
|
|
|
|
|
|
|
|
1335
|
0
|
|
|
|
|
|
return $self->{_certifications}; |
1336
|
|
|
|
|
|
|
} |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
=item full_plot |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
Return full movie plot. |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
my $full_plot = $film->full_plot(); |
1343
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
=cut |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
sub full_plot { |
1347
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1348
|
|
|
|
|
|
|
|
1349
|
0
|
|
|
|
|
|
$self->_show_message("Getting full plot ".$self->code."; url=".$self->full_plot_url." ...", 'DEBUG'); |
1350
|
|
|
|
|
|
|
# |
1351
|
|
|
|
|
|
|
# TODO: move all methods which needed additional connection to the IMDB.com |
1352
|
|
|
|
|
|
|
# to the separate module. |
1353
|
|
|
|
|
|
|
# |
1354
|
0
|
0
|
|
|
|
|
unless($self->{_full_plot}) { |
1355
|
0
|
|
|
|
|
|
my $page; |
1356
|
0
|
0
|
|
|
|
|
$page = $self->_cacheObj->get($self->code.'_plot') if $self->_cache; |
1357
|
0
|
0
|
|
|
|
|
unless($page) { |
1358
|
0
|
|
|
|
|
|
my $url = $self->full_plot_url . $self->code() . '/plotsummary'; |
1359
|
|
|
|
|
|
|
|
1360
|
0
|
|
|
|
|
|
$self->_show_message("URL is $url ...", 'DEBUG'); |
1361
|
|
|
|
|
|
|
|
1362
|
0
|
|
|
|
|
|
$page = $self->_get_page_from_internet($url); |
1363
|
0
|
0
|
|
|
|
|
unless($page) { |
1364
|
0
|
|
|
|
|
|
return; |
1365
|
|
|
|
|
|
|
} |
1366
|
|
|
|
|
|
|
|
1367
|
0
|
0
|
|
|
|
|
$self->_cacheObj->set($self->code.'_plot', $page, $self->_cache_exp) if $self->_cache; |
1368
|
|
|
|
|
|
|
} |
1369
|
|
|
|
|
|
|
|
1370
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED, \$page); |
1371
|
|
|
|
|
|
|
|
1372
|
0
|
|
|
|
|
|
my($text); |
1373
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('p')) { |
1374
|
0
|
0
|
0
|
|
|
|
if(defined $tag->[1]{class} && $tag->[1]{class} =~ /plotpar/i) { |
1375
|
0
|
|
|
|
|
|
$text = $parser->get_trimmed_text(); |
1376
|
0
|
|
|
|
|
|
last; |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
|
1380
|
0
|
|
|
|
|
|
$self->{_full_plot} = $text; |
1381
|
|
|
|
|
|
|
} |
1382
|
|
|
|
|
|
|
|
1383
|
0
|
|
|
|
|
|
return $self->{_full_plot}; |
1384
|
|
|
|
|
|
|
} |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
sub big_cover { |
1387
|
0
|
|
|
0
|
0
|
|
my CLASS_NAME $self = shift; |
1388
|
|
|
|
|
|
|
|
1389
|
0
|
0
|
|
|
|
|
unless($self->{'_big_cover_url'}) { |
1390
|
0
|
0
|
|
|
|
|
unless($self->{'_big_cover_page'}) { |
1391
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED); |
1392
|
0
|
|
|
|
|
|
my $regexp = '^/media/.+/tt' . $self->code . '$'; |
1393
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('a')) { |
1394
|
0
|
|
|
|
|
|
$self->_show_message("$regexp --> " . $tag->[1]->{href}, 'DEBUG'); |
1395
|
0
|
0
|
|
|
|
|
if($tag->[1]->{'href'} =~ m!$regexp!) { |
1396
|
0
|
|
|
|
|
|
$self->{'_big_cover_page'} = $tag->[1]->{'href'}; |
1397
|
0
|
|
|
|
|
|
last; |
1398
|
|
|
|
|
|
|
} |
1399
|
|
|
|
|
|
|
} |
1400
|
|
|
|
|
|
|
} |
1401
|
0
|
0
|
|
|
|
|
if($self->{'_big_cover_page'}) { |
1402
|
0
|
|
|
|
|
|
my $page = $self->_get_page_from_internet('http://' . $self->{'host'} . $self->{'_big_cover_page'}); |
1403
|
0
|
0
|
|
|
|
|
return unless $page; |
1404
|
|
|
|
|
|
|
|
1405
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED, \$page); |
1406
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('img')) { |
1407
|
0
|
0
|
0
|
|
|
|
if($tag->[1]->{'id'} && $tag->[1]->{'id'} eq 'primary-img') { |
1408
|
0
|
|
|
|
|
|
$self->{'_big_cover_url'} = $tag->[1]->{'src'}; |
1409
|
0
|
|
|
|
|
|
last; |
1410
|
|
|
|
|
|
|
} |
1411
|
|
|
|
|
|
|
} |
1412
|
|
|
|
|
|
|
} |
1413
|
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
|
|
1415
|
0
|
|
|
|
|
|
return $self->{_big_cover_url}; |
1416
|
|
|
|
|
|
|
} |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
=item official_sites() |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
Returns a list of official sites of specified movie as array reference which contains hashes |
1421
|
|
|
|
|
|
|
with site information - URL => Site Title: |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
my $sites = $film->official_sites(); |
1424
|
|
|
|
|
|
|
for(@$sites) { |
1425
|
|
|
|
|
|
|
print "Site name - $_->{title}; url - $_->{url}\n"; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=cut |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
sub official_sites { |
1431
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1432
|
|
|
|
|
|
|
|
1433
|
0
|
0
|
|
|
|
|
unless($self->{_official_sites}) { |
1434
|
0
|
|
|
|
|
|
my $page; |
1435
|
0
|
0
|
|
|
|
|
$page = $self->_cacheObj->get($self->code . '_sites') if $self->_cache; |
1436
|
|
|
|
|
|
|
|
1437
|
0
|
0
|
|
|
|
|
unless($page) { |
1438
|
0
|
|
|
|
|
|
my $url = "http://". $self->{host} . "/" . $self->{query} . $self->code . "/officialsites"; |
1439
|
0
|
|
|
|
|
|
$self->_show_message("URL for sites is $url ...", 'DEBUG'); |
1440
|
|
|
|
|
|
|
|
1441
|
0
|
|
|
|
|
|
$page = $self->_get_page_from_internet($url); |
1442
|
|
|
|
|
|
|
|
1443
|
0
|
0
|
|
|
|
|
$self->_cacheObj->set($self->code.'_sites', $page, $self->_cache_exp) if $self->_cache; |
1444
|
|
|
|
|
|
|
} |
1445
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
|
1447
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED, \$page); |
1448
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag()) { |
1449
|
0
|
0
|
|
|
|
|
last if $tag->[0] eq 'ol'; |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
|
1452
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag()) { |
1453
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
1454
|
0
|
0
|
0
|
|
|
|
if($tag->[0] eq 'a' && $tag->[1]->{href} !~ /sections/i) { |
1455
|
0
|
|
|
|
|
|
push @{ $self->{_official_sites} }, { $tag->[1]->{href} => $text }; |
|
0
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
} |
1457
|
|
|
|
|
|
|
|
1458
|
0
|
0
|
0
|
|
|
|
last if $tag->[0] eq '/ol' or $tag->[0] eq 'hr'; |
1459
|
|
|
|
|
|
|
} |
1460
|
|
|
|
|
|
|
} |
1461
|
|
|
|
|
|
|
|
1462
|
0
|
|
|
|
|
|
return $self->{_official_sites}; |
1463
|
|
|
|
|
|
|
} |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
=item release_dates() |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
Returns a list of release dates of specified movie as array reference: |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
my $sites = $film->release_dates(); |
1470
|
|
|
|
|
|
|
for(@$sites) { |
1471
|
|
|
|
|
|
|
print "Country - $_->{country}; release date - $_->{date}; info - $_->{info}\n"; |
1472
|
|
|
|
|
|
|
} |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
Option info contains additional information about release - DVD premiere, re-release, restored version etc |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
=cut |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
sub release_dates { |
1479
|
0
|
|
|
0
|
1
|
|
my CLASS_NAME $self = shift; |
1480
|
|
|
|
|
|
|
|
1481
|
0
|
0
|
|
|
|
|
unless($self->{_release_dates}) { |
1482
|
0
|
|
|
|
|
|
my $page; |
1483
|
0
|
0
|
|
|
|
|
$page = $self->_cacheObj->get($self->code . '_dates') if $self->_cache; |
1484
|
|
|
|
|
|
|
|
1485
|
0
|
0
|
|
|
|
|
unless($page) { |
1486
|
0
|
|
|
|
|
|
my $url = "http://". $self->{host} . "/" . $self->{query} . $self->code . "/releaseinfo"; |
1487
|
0
|
|
|
|
|
|
$self->_show_message("URL for sites is $url ...", 'DEBUG'); |
1488
|
|
|
|
|
|
|
|
1489
|
0
|
|
|
|
|
|
$page = $self->_get_page_from_internet($url); |
1490
|
0
|
0
|
|
|
|
|
$self->_cacheObj->set($self->code.'_dates', $page, $self->_cache_exp) if $self->_cache; |
1491
|
|
|
|
|
|
|
} |
1492
|
|
|
|
|
|
|
|
1493
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED, \$page); |
1494
|
|
|
|
|
|
|
# Searching header of release dates table |
1495
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('th')) { |
1496
|
0
|
0
|
0
|
|
|
|
last if $tag->[1]->{class} && $tag->[1]->{class} eq 'xxxx'; |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
# |
1500
|
|
|
|
|
|
|
# The table has three columns. So we parse then one by one and grab their text |
1501
|
|
|
|
|
|
|
# |
1502
|
0
|
|
|
|
|
|
my $count = 0; |
1503
|
0
|
|
|
|
|
|
my @dates = (); |
1504
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag()) { |
1505
|
0
|
0
|
|
|
|
|
last if $tag->[0] eq '/table'; |
1506
|
0
|
0
|
|
|
|
|
next unless $tag->[0] eq 'td'; |
1507
|
|
|
|
|
|
|
|
1508
|
0
|
|
|
|
|
|
$dates[$count] = $parser->get_trimmed_text('/td'); |
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
# When rish 3rd column we should store dates into object property |
1511
|
0
|
0
|
|
|
|
|
if(++$count > 2) { |
1512
|
0
|
|
|
|
|
|
$dates[2] =~ s/\)\s\(/, /g; |
1513
|
0
|
|
|
|
|
|
$dates[2] =~ s/(\(|\))//g; |
1514
|
0
|
|
|
|
|
|
push @{ $self->{_release_dates} }, {country => $dates[0], date => $dates[1], info => $dates[2]}; |
|
0
|
|
|
|
|
|
|
1515
|
0
|
|
|
|
|
|
$count = 0; |
1516
|
|
|
|
|
|
|
} |
1517
|
|
|
|
|
|
|
} |
1518
|
|
|
|
|
|
|
} |
1519
|
|
|
|
|
|
|
|
1520
|
0
|
|
|
|
|
|
return $self->{_release_dates}; |
1521
|
|
|
|
|
|
|
} |
1522
|
|
|
|
|
|
|
=item |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
Retrieve a list of plot keywords as an array reference: |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
my $plot_keywords = $film->plot_keywords(); |
1527
|
|
|
|
|
|
|
for my $keyword (@$plot_keywords) { |
1528
|
|
|
|
|
|
|
print "keyword: $keyword\n"; |
1529
|
|
|
|
|
|
|
} |
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
=cut |
1532
|
|
|
|
|
|
|
|
1533
|
|
|
|
|
|
|
sub plot_keywords { |
1534
|
0
|
|
|
0
|
0
|
|
my CLASS_NAME $self = shift; |
1535
|
|
|
|
|
|
|
|
1536
|
0
|
0
|
|
|
|
|
unless($self->{_plot_keywords}) { |
1537
|
0
|
|
|
|
|
|
my $page; |
1538
|
0
|
0
|
|
|
|
|
$page = $self->_cacheObj->get($self->code . '_keywords') if $self->_cache; |
1539
|
|
|
|
|
|
|
|
1540
|
0
|
0
|
|
|
|
|
unless($page) { |
1541
|
0
|
|
|
|
|
|
my $url = "http://". $self->{host} . "/" . $self->{query} . $self->code . "/keywords"; |
1542
|
0
|
|
|
|
|
|
$self->_show_message("URL for sites is $url ...", 'DEBUG'); |
1543
|
|
|
|
|
|
|
|
1544
|
0
|
|
|
|
|
|
$page = $self->_get_page_from_internet($url); |
1545
|
0
|
0
|
|
|
|
|
$self->_cacheObj->set($self->code.'_keywords', $page, $self->_cache_exp) if $self->_cache; |
1546
|
|
|
|
|
|
|
} |
1547
|
|
|
|
|
|
|
|
1548
|
0
|
|
|
|
|
|
my $parser = $self->_parser(FORCED, \$page); |
1549
|
|
|
|
|
|
|
|
1550
|
0
|
|
|
|
|
|
my @keywords = (); |
1551
|
0
|
|
|
|
|
|
while(my $tag = $parser->get_tag('a')) { |
1552
|
0
|
|
|
|
|
|
my $text = $parser->get_text(); |
1553
|
0
|
|
|
|
|
|
$text = $self->_decode_special_symbols($text); |
1554
|
|
|
|
|
|
|
#$self->_show_message("*** $tag->[1]->{href} --> $text ***", 'DEBUG'); |
1555
|
0
|
0
|
0
|
|
|
|
push @keywords, $text if $tag->[1]->{href} && $tag->[1]->{href} =~ m#/keyword/#; |
1556
|
|
|
|
|
|
|
} |
1557
|
|
|
|
|
|
|
|
1558
|
0
|
|
|
|
|
|
$self->{_plot_keywords} = \@keywords; |
1559
|
|
|
|
|
|
|
} |
1560
|
|
|
|
|
|
|
|
1561
|
0
|
|
|
|
|
|
return $self->{_plot_keywords}; |
1562
|
|
|
|
|
|
|
} |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
=back |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
=cut |
1567
|
|
|
|
|
|
|
|
1568
|
|
|
|
|
|
|
sub DESTROY { |
1569
|
0
|
|
|
0
|
|
|
my CLASS_NAME $self = shift; |
1570
|
|
|
|
|
|
|
} |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
1; |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
__END__ |