source: trunk/postprocessors/imdb_augment_data @ 1406

Last change on this file since 1406 was 1406, checked in by max, 7 years ago

Some hacks to imdb_augment_data, to get the most important parts working again

  • Property svn:executable set to *
File size: 41.1 KB
Line 
1#!/usr/bin/env perl
2
3# IMDb XMLTV data augmenter  <ltd@interlink.com.au>
4#
5#  * to be used as a postprocessor for XMLTV data
6#  * uses The Internet Movie Database (www.imdb.com) to augment TV guide data;
7#    contacts www.imdb.com to collect actual movie details
8#  * this should only be used for non-commercial use.
9#    please follow the IMDb terms and conditions.
10#  * can be used in conjunction with 'shepherd' XMLTV reconciler or standalone
11#    (pipe-through)
12#  * no configuration necessary
13#
14#  based roughly on a few existing IMDB XMLTV modules and IMDB CPAN modules
15#  but doesn't actually use them due to the large number of interdependencies
16#  they drag in.
17#     much credit goes to Michael Stepanov for his excellent IMDB::Film module
18#     and the regex's used to match data from IMDb pages
19#
20#  changelog:
21#    0.01 09aug06 ltd   initial version
22#    0.03 19aug06 ltd   actually do imdb lookups & augment data
23#    0.09 09feb07 paulx variety of fixes from paulx@andreassen.com.au
24#                       as per trac ticket #31
25
26use strict;
27use warnings;
28
29my $progname = "imdb_augment_data";
30my $version = "1.02";
31
32use XMLTV;
33use POSIX qw(strftime mktime);
34use Getopt::Long;
35use HTML::TokeParser;
36use Data::Dumper;
37use HTML::TreeBuilder;
38use Shepherd::Common;
39
40#
41# some initial cruft
42#
43
44my $script_start_time = time;
45my %stats;
46my $data_cache;
47my $settings_override = { };
48
49$| = 1;
50
51#
52# parse command line
53#
54
55my $opt = { };
56$opt->{output_file} =           "output.xmltv";
57$opt->{cache_file} =            "imdb_augment_data.storable.cache";
58$opt->{lang} =                  "en";
59$opt->{debug} =                 0;
60$opt->{min_duration} =          65;     # 65 mins
61$opt->{max_duration} =          240;    # 4 hours
62$opt->{skip_categories} =       "Infotainment,Shopping,Business and Finance,Game Show,News,Parliament,Current Affairs,sports,Sport,Weather,Reality,live";
63$opt->{cache_details_for} =     120;    # cache movie details for 4 months
64$opt->{cache_title_for} =       120;    # cache title lookups for 4 months
65$opt->{dont_augment_desc} =     1;      # from 2008/04/15
66
67GetOptions(
68        'region=i'              => \$opt->{region},             # ignored
69        'days=i'                => \$opt->{days},               # ignored
70        'offset=i'              => \$opt->{offset},             # ignored
71        'timezone=s'            => \$opt->{timezone},           # ignored
72        'channels_file=s'       => \$opt->{channels_file},      # ignored
73        'config-file=s'         => \$opt->{configfile},         # ignored
74
75        'min_duration=i'        => \$opt->{min_duration},
76        'max_duration=i'        => \$opt->{max_duration},
77        'skip_categories=s'     => \$opt->{skip_categories},
78        'cache_details_for=i'   => \$opt->{cache_details_for},
79        'cache_title_for=i'     => \$opt->{cache_title_for},
80        'long-info'             => \$opt->{long_info},
81        'dont-augment-desc=i'   => \$opt->{dont_augment_desc},
82
83        'output=s'              => \$opt->{output_file},
84        'cache-file=s'          => \$opt->{cache_file},
85        'fast'                  => \$opt->{fast},
86        'no-cache'              => \$opt->{no_cache},
87        'debug+'                => \$opt->{debug},
88        'lang=s'                => \$opt->{lang},
89        'no-retry'              => \$opt->{dont_retry},
90        'help'                  => \$opt->{help},
91        'test=s'                => \$opt->{test},
92        'simpletest=s'          => \$opt->{simpletest},
93        'set=s'                 => \$opt->{set},
94        'verbose'               => \$opt->{help},
95        'version'               => \$opt->{version},
96        'ready'                 => \$opt->{ready},
97        'desc'                  => \$opt->{desc},
98        'v'                     => \$opt->{version});
99
100printf "%s v%s\n",$progname,$version;
101
102if ($opt->{version} || $opt->{desc} || $opt->{help} || $opt->{ready} ||
103    $opt->{output_file} eq "") {
104        printf "Augments XMLTV data with programme information from ".
105          "The Internet Movie Database (www.imdb.com)\n" if $opt->{desc};
106
107        printf "$progname is ready for operation.\n" if ($opt->{ready});
108
109        printf "No --output file specified.\n" if ($opt->{output_file} eq "");
110
111        if ($opt->{help} || $opt->{output_file} eq "") {
112                print<<EOF
113
114usage: $0 [options] {FILE(s)}
115
116Supported options include:
117  --min_duration={min} ignore programs under {min} duration (default: $opt->{min_duration} min)
118  --max_duration={min} ignore programs over {min} duration (default: $opt->{max_duration} min)
119  --skip_categories={list} don't try to look up programmes in these categories (default: $opt->{skip_categories})
120
121  --dont-augment-desc=1/0 (don't / do)
122                       don't add any IMDb data to programme description,
123                       only update the data fields (default: 1 or don't)
124  --long-info          add lots of IMDb data to description (default: don't)
125
126  --cache_details_for={days}  cache programme details for {days} (def: $opt->{cache_details_for} days)
127  --cache_title_for={days}    cache IMDb URLs for {days} (def: $opt->{cache_title_for} days)
128
129  --lang={lang}        set language to {lang} (default: $opt->{lang})
130  --output={file}      send final XMLTV output to {file} (default: $opt->{output_file})
131  --debug              enable debugging
132  --fast               don't pause between requests to www.imdb.com
133
134  --cache-file={file}  local file to use as our data cache (default: $opt->{cache_file})
135  --no-cache           don't use local cache to reduce network load on www.imdb.com
136  --no-retry           don't retry failed HTTP requests
137
138  --test=(string)      operate in 'test mode', look up prog named (string)
139
140  --set=(setting):(value) save setting override: (value) 1=enable, 0=disable
141        dont-augment-desc:1/0 (don't / do)
142        long-info:1/0 (yes / no)
143
144EOF
145;
146        }
147        exit(0);
148}
149
150&run_test if (defined $opt->{test});
151&simple_search_imdb(split(/,/, $opt->{simpletest})) if ($opt->{simpletest});
152&set_settings if (defined $opt->{set});
153
154# set defaults
155Shepherd::Common::set_default("debug", ((defined $opt->{debug} && $opt->{debug} > 0) ? 2 : 0));
156Shepherd::Common::set_default("stats", \%stats);
157Shepherd::Common::set_default("retry_delay", 10);
158Shepherd::Common::set_default("delay", int(rand(4) + 3)) unless (defined $opt->{fast});
159Shepherd::Common::set_default('fake' => 0);
160
161# go go go!
162
163Shepherd::Common::log(sprintf "started: cache %s, %s%soutput %s",
164        ($opt->{no_cache} ? "disabled" : "enabled"),
165        ($opt->{fast} ? "fast-override, " : ""),
166        ($opt->{debug} ? "debug enabled, " : ""),
167        ($opt->{output_file}));
168
169&read_cache unless ($opt->{no_cache});
170
171my %writer_args = ( encoding => 'ISO-8859-1' );
172my $fh = new IO::File(">".$opt->{output_file}) ||
173  die "can't open $opt->{output_file} for writing: $!";
174$writer_args{OUTPUT} = $fh;
175
176my $writer = new XMLTV::Writer(%writer_args);
177$writer->start( {
178        'source-info-url' => "http://www.imdb.com",
179        'source-info-name' => "$progname $version",
180        'generator-info-name' => "$progname $version"} );
181
182foreach my $file (@ARGV) {
183        Shepherd::Common::log((sprintf "Parsing: %s",
184                ($file eq "-" ? "(from-stdin, hit control-D to finiah)" : $file)));
185        XMLTV::parsefiles_callback(\&encoding_cb, \&credits_cb,
186                \&channel_cb,\&programme_cb, $file);
187}
188
189$writer->end();
190Shepherd::Common::log("Finished parsing, output in $opt->{output_file}");
191
192&write_cache unless ($opt->{no_cache});
193
194Shepherd::Common::print_stats($progname, $version, $script_start_time, %stats);
195
196exit(0);
197
198##############################################################################
199
200sub set_settings
201{
202        &read_cache;
203        my ($setting, $val) = split(/:/,$opt->{set});
204
205        die "--set format is (setting):(value) where value is 0 for disable, 1 for enable.\n"
206          if ((!defined $val) || (($val ne "0") && ($val ne "1")));
207
208        die "unknown '--set' parameter '$setting', see --help for details.\n"
209          if ($setting ne "dont-augment-desc" and $setting ne "long-info");
210
211        printf "%s: override parameter %s: %s\n", $progname, $setting, ($val eq "0" ? "disabled" : "enabled");
212
213        $setting =~ s/-/_/g;
214        $settings_override->{$setting} = $val;
215        &write_cache;
216        exit(0);
217}
218
219##############################################################################
220# populate cache
221
222sub read_cache
223{
224        my $store = Shepherd::Common::read_cache(\$opt->{cache_file});
225       
226        if ($store) {
227                $data_cache = $store->{data_cache};
228                $settings_override = $store->{settings_override};
229
230                foreach my $setting (keys %$settings_override) {
231                        if ($settings_override->{$setting} eq "0") {
232                                printf "using override parameter %s: %s\n", $setting,
233                                                ($settings_override->{$setting} eq "0" ? "disabled" : "enabled");
234                                $opt->{$setting} = 0;
235                        }
236                }
237       
238                #
239                # age our caches on startup
240                #
241                my $max_age;
242               
243                # age our programme_id cache on startup
244                my $prog_id = $data_cache->{movie_id_lookup};
245                $max_age = time - ($opt->{cache_title_for} * 86400);
246                foreach my $key (keys %{$prog_id}) {
247                        if ($data_cache->{movie_id_lookup}->{$key}->{last_fetched} < $max_age) {
248                        delete $data_cache->{movie_id_lookup}->{$key};
249                        $stats{removed_programme_id_from_cache}++
250                        }
251                }
252               
253                # age our programme cache on startup
254                my $prog = $data_cache->{movie_lookup};
255                $max_age = time - ($opt->{cache_details_for} * 86400);
256                foreach my $key (keys %{$prog}) {
257                        if (($data_cache->{movie_lookup}->{$key}->{last_fetched} < $max_age) ||
258                                (($data_cache->{movie_lookup}->{$key}->{last_fetched} > 1208908800) && # 2008/04/23
259                                ($data_cache->{movie_lookup}->{$key}->{last_fetched} < 1209772800))){  # 2008/05/03
260                        delete $data_cache->{movie_lookup}->{$key};
261                        $stats{removed_programme_from_cache}++
262                        }
263                }
264        }
265}
266
267##############################################################################
268# write out updated cache
269
270sub write_cache
271{
272        my $store;
273        $store->{data_cache} = $data_cache;
274        $store->{settings_override} = $settings_override;
275        Shepherd::Common::write_cache($opt->{cache_file}, $store);
276}
277
278##############################################################################
279# use the online IMDb "power search" at http://www.imdb.com/search/title to try to find _1_ match
280
281sub search_imdb_online
282{
283        my ($title, $post_fields, $movie_year) = @_;
284
285        if ($stats{failed_online_imdb_lookup} and $stats{failed_online_imdb_lookup} >= 3) {
286                Shepherd::Common::log("too many failed lookups to online IMDb search for '$title' with $post_fields");
287                return;
288        }
289
290        Shepherd::Common::log("  online IMDb search for '$title' with $post_fields");
291
292        my $html_data = Shepherd::Common::get_url(url => "http://www.imdb.com/search/title?$post_fields",
293            #fake => 1,             # IMDB doesn't like Shepherd at all
294            agent => "shepherd",    # IMDB doesn't like "Shepherd" so we lowercase
295            method => "GET");
296
297        if (!$html_data) {
298                $stats{failed_online_imdb_lookup}++;
299                Shepherd::Common::log("failed to search imdb movie data from http://www.imdb.com/List");
300                return;
301        }
302        $data_cache->{movie_id_lookup}->{$post_fields}->{last_fetched} = time;
303
304        my $tp = HTML::TokeParser->new(\$html_data);
305
306        # see if we can find any <a href="/title/tt[0-9]+/">{name}</a> tags
307        my %urls;
308        my $urls_found = 0;
309        while (my $token = $tp->get_tag("a")) {
310                my $url = $token->[1]{href}; # undefined when 200 results returned
311                if ($url && $url =~ /\/title\/tt[0-9]+\//) {
312                        my $text = $tp->get_trimmed_text();
313                        my $showname = $title;
314                        $showname = "$1, The" if ($showname =~ /^The (.*)/i);   # format to match search results
315                        next unless ($text =~ /^$showname \(((19|20)\d\d)\)$/i); # ignore partial & approximate matches
316                        my $found_year = $1;
317                        if (!$movie_year || !$found_year || (abs($movie_year - $found_year) <= 1) ) {
318                                $urls{$url}++; # store as a hash since imdb sometimes gives dups
319                                $urls_found++ if ($urls{$url} == 1);
320                        }
321                }
322        }
323
324        # only insert into cache if we match exactly _1_ movie
325        if ($urls_found == 1) {
326                my $this_url = (keys %urls)[0];
327                if ($this_url =~ /^http:/) {
328                        $data_cache->{movie_id_lookup}->{$post_fields}->{url} = $this_url;
329                } else {
330                        $data_cache->{movie_id_lookup}->{$post_fields}->{url} = "http://www.imdb.com".$this_url;
331                }
332                $stats{imdb_lookup_added_positive_cache_entry}++;
333        } else {
334                Shepherd::Common::log("    online search failed: wanted 1 match, got $urls_found matches.");
335                # negatively cache our failed lookup
336                $data_cache->{movie_id_lookup}->{$post_fields}->{url} = "-";
337                $data_cache->{movie_id_lookup}->{$post_fields}->{num_choices} =
338                  $urls_found;
339        }
340}
341
342##############################################################################
343# simple search
344#
345# The 'power search' seems to have a couple of annoying flaws, like
346# an inability to find AKA titles. So if our power search fails, we
347# fall back to the simple search. This seems to work very well, finding
348# many shows that the power search misses.
349
350sub simple_search_imdb
351{
352    my ($title, $year) = @_;
353
354    if ($stats{failed_online_imdb_lookup} and $stats{failed_online_imdb_lookup} >= 3) {
355        Shepherd::Common::log("too many failed lookups to online IMDb search for '$title' with $year");
356        return;
357    }
358
359    &Shepherd::Common::log("  trying simple search for '$title' ($year)");
360    my $url = sprintf "http://www.imdb.com/find?q=%s&s=tt", &Shepherd::Common::urlify($title);
361    my @response = &Shepherd::Common::get_url($url);
362    my $html = $response[0];
363
364    unless ($html) 
365    {
366        $stats{failed_online_imdb_lookup}++;
367        &Shepherd::Common::log("simple search failed");
368        return 0;
369    }
370
371    my ($link, $link_fallback);
372
373    # Check if we were sent directly to the show's main page.
374    my $r = $response[6];
375    if ($r and $r->base and $r->base =~ m"/title/tt[0-9]+/")
376    {
377        if (!$year) {
378                $link = $r->base;
379        } else {
380                my $tree = HTML::TreeBuilder->new_from_content($html);
381                my ($found_year) = ($tree->look_down('_tag' => 'title')->as_text() =~ /\(((19|20)\d\d)\)/);
382                if (!$found_year || (abs($year - $found_year) <= 1) ) {
383                        $link = $r->base;
384                }
385        }
386    }
387    else
388    {
389        my $tree = HTML::TreeBuilder->new_from_content($html);
390
391        HTMLPARSE: foreach my $block ($tree->look_down('_tag' => 'p'))
392        {
393            my $tag = $block->look_down('_tag' => 'b');
394            next unless ($tag);
395            if ($tag->as_text eq 'Titles (Exact Matches)' or $tag->as_text eq 'Popular Titles')
396            {
397                foreach my $line (split(/<br>/, $block->as_HTML))
398                {
399                    if ($line =~ /<a href="(\/title\/tt[0-9]+\/?)".*?>(.*?)<\/a> \(((19|20)\d\d)\)(.*)/
400                            and
401                        (!$year or (abs($year - $3) <= 1))
402                            and
403                        (!$4 or $4 !~ /VG/))
404                    {
405                        if (!$year or $year == $3) {
406                                if ($link)
407                                {
408                                        # found multiple hits. That's bad.
409                                        $link = 'bad';
410                                        &Shepherd::Common::log("    found multiple hits, wanted 1.") if ($opt->{debug});
411                                        last HTMLPARSE;
412                                }
413                                # Bingo! Found a link
414                                &Shepherd::Common::log("    found link: $1") if ($opt->{debug});
415                                $link = "http://www.imdb.com" . $1;
416                        } else {
417                                if ($link_fallback)
418                                {
419                                        # found multiple hits. That's bad.
420                                        $link_fallback = 'bad';
421                                        &Shepherd::Common::log("    found multiple fallback hits, wanted 1.") if ($opt->{debug});
422                                }
423                                # Bingo! Found a link
424                                &Shepherd::Common::log("    found fallback link: $1") if ($opt->{debug});
425                                $link_fallback = "http://www.imdb.com" . $1;
426                        }
427                    }
428                }
429            }
430        }
431    }
432    my $cache_name = 'simple-'.&Shepherd::Common::urlify($title).'-'.$year;
433
434    $data_cache->{movie_id_lookup}->{$cache_name}->{last_fetched} = time;
435
436    $link = $link_fallback if !$link && $link_fallback && $link_fallback ne 'bad';
437    if (!$link || $link eq 'bad')
438    {
439        &Shepherd::Common::log("    simple search failed.");
440        # negatively cache our failed lookup
441        $data_cache->{movie_id_lookup}->{$cache_name}->{url} = "-";
442        return 0;
443    }
444    $data_cache->{movie_id_lookup}->{$cache_name}->{url} = $link;
445    $stats{imdb_lookup_added_positive_cache_entry}++;
446    return 1;
447}
448
449##############################################################################
450# simple parser for imdb returned data: covers most data
451
452sub imdb_scalar_parser
453{
454        my ($html_data, $start_tag, $target, $texttype, $targetb, $targetc, $targeta, $v) = @_;
455
456        my $found = 0;
457        my $tp = HTML::TokeParser->new(\$html_data);
458
459        while (my $tag = $tp->get_tag($start_tag)) {
460                if ($tp->get_trimmed_text =~ /^$target/i) {
461                        $found = 1;
462                        last;
463                }
464        }
465        if (!$found) {
466                Shepherd::Common::log(" - no ".$target." found") if ($opt->{debug});
467                return;
468        }
469
470        my $tag = $tp->get_tag($targeta) if (defined $targeta);
471        if ($texttype eq "trimmed") {
472                $$v = $tp->get_trimmed_text($targetb,$targetc);
473        } else {
474                $$v = $tp->get_text($targetb,$targetc);
475                $$v =~ s/^\s*(.*?)\s*$/$1/;
476        }
477
478        Shepherd::Common::log(" - parsed ".$target." ".$$v) if ($opt->{debug});
479}
480
481##############################################################################
482
483sub imdb_list_parser
484{
485        my ($html_data, $target, $target2, $v) = @_;
486
487        my $tp = HTML::TokeParser->new(\$html_data);
488        my @list;
489        my $found = 0;
490
491        while (my $tag = $tp->get_tag('h5')) {
492                if ($tp->get_trimmed_text =~ /^$target/i) {
493                        $found = 1;
494                        last;
495                }
496        }
497        return undef if (!$found);
498
499        while (my $tag = $tp->get_tag()) {
500                push (@list, $tp->get_trimmed_text())
501                  if (($tag->[0] eq 'a') && (defined $tag->[1]{href}) && ($tag->[1]{href} =~ /$target2/i));
502                last if ($tag->[0] eq 'br');
503        }
504
505        my $found_items = 0;
506        foreach my $item (@list) {
507                $$v->[$found_items] = $item;
508                Shepherd::Common::log(" - parsed ".$target." ".$item) if ($opt->{debug});
509                $found_items++;
510        }
511}
512
513##############################################################################
514# perform a detailed movie lookup given a movie url
515# store what we find in our data cache
516
517sub get_imdb_movie_online
518{
519        my ($movie_title, $movie_url) = @_;
520
521        if ($stats{failed_online_imdb_lookup} and $stats{failed_online_imdb_lookup} >= 3) {
522                Shepherd::Common::log("too many failed lookups to downloading online IMDb movie data for '$movie_title'");
523                return;
524        }
525
526        Shepherd::Common::log("  downloading online IMDb movie data for '$movie_title'");
527        my $html_data = Shepherd::Common::get_url($movie_url);
528
529        if (!$html_data) {
530                $stats{failed_online_imdb_lookup}++;
531                Shepherd::Common::log("failed to fetch imdb movie data from $movie_url");
532                return;
533        }
534
535        $stats{imdb_movie_added_cache_entry}++;
536        $data_cache->{movie_lookup}->{$movie_url}->{last_fetched} = time;
537        my $tp;
538
539        #
540        # parse title and year
541        #
542        $tp = HTML::TokeParser->new(\$html_data);
543        my $title_token = $tp->get_tag('title');
544        my $title_text = $tp->get_trimmed_text();
545        if ($title_text =~ /(.*?)\s+\((\d{4})?.*?\)/) {
546                $data_cache->{movie_lookup}->{$movie_url}->{title} = $1;
547                $data_cache->{movie_lookup}->{$movie_url}->{year} = $2;
548        }
549
550        if (!defined $data_cache->{movie_lookup}->{$movie_url}->{title}) {
551                $stats{failed_online_imdb_title_parsing}++;
552                Shepherd::Common::log("failed to parse title within imdb movie data from $movie_url");
553                return;
554        }
555
556        #
557        # parse cover url
558        #
559        my $title = $data_cache->{movie_lookup}->{$movie_url}->{title};
560        $title =~ s/([\{\}\[\]\(\)\^\$\.\|\*\+\?\\])/\\$1/g;
561        $tp = HTML::TokeParser->new(\$html_data);
562        while (my $img_tag = $tp->get_tag('img')) {
563                next if (!$img_tag->[1]{alt});
564                last if ($img_tag->[1]{alt} =~ /^poster not submitted/i);
565                if ($img_tag->[1]{alt} =~ /^$title Poster$/i) {
566                        $data_cache->{movie_lookup}->{$movie_url}->{cover} = $img_tag->[1]{src};
567                        Shepherd::Common::log(" - parsed cover_url ".$img_tag->[1]{src}) if ($opt->{debug});
568                        last;
569                }
570        }
571
572        #
573        # parse directors
574        #
575        $tp = HTML::TokeParser->new(\$html_data);
576        while (my $tag = $tp->get_tag('h5')) {
577                last if ($tp->get_trimmed_text =~ /^(directed|director)/i);
578        }
579        while (my $tag = $tp->get_tag) {
580                my $text = $tp->get_trimmed_text();
581                last if (($text =~ /^(writing|writer)/i) || ($tag->[0] =~ /\/td/i));
582                if ($tag->[0] eq 'a') {
583                        my $id = $tag->[1]{href};
584                        next if (!$id or $id !~ /^\/name\/nm/);
585                        push(@{$data_cache->{movie_lookup}->{$movie_url}->{directors}}, [$text, $id]);
586                        Shepherd::Common::log(" - parsed director ".$text." (".$id.")") if ($opt->{debug});
587                }
588        }
589
590        #
591        # parse writers
592        #
593        $tp = HTML::TokeParser->new(\$html_data);
594        while (my $tag = $tp->get_tag('h5')) {
595                last if ($tp->get_trimmed_text =~ /^(writing|writer)/i);
596        }
597        while (my $tag = $tp->get_tag) {
598                my $text = $tp->get_trimmed_text();
599                last if ($tag->[0] =~ /div/i);
600                if (($tag->[0] eq 'a') && ($text !~ /\bmore\b/i)) {
601                        my $id = $tag->[1]{href};
602                        next if (!$id or $id !~ /^\/name\/nm/);
603                        push(@{$data_cache->{movie_lookup}->{$movie_url}->{writers}}, [$text, $id]);
604                        Shepherd::Common::log(" - parsed writer ".$text." (".$id.")") if ($opt->{debug});
605                }
606        }
607
608        #
609        # parse cast
610        #
611        $tp = HTML::TokeParser->new(\$html_data);
612        while (my $tag = $tp->get_tag('table')) {
613                next unless ((exists $tag->[1]{class}) && ($tag->[1]{class} =~ /cast/i));
614
615                my $person, my $role;
616                while ($tag = $tp->get_tag) {
617                        last if ($tag->[0] =~ /^\/table/i);
618                        if (($tag->[0] =~ /^td/i) && (defined $tag->[1]{class}) && ($tag->[1]{class} =~ /nm/)) {
619                                $tag = $tp->get_tag;
620                                $person = $tp->get_trimmed_text();
621                                next;
622                        }
623                        if (($tag->[0] =~ /^td/i) && (defined $tag->[1]{class}) && ($tag->[1]{class} =~ /char/)) {
624                                $role = $tp->get_trimmed_text();
625
626                                if ((defined $person) && (defined $role)) {
627                                        push(@{$data_cache->{movie_lookup}->{$movie_url}->{cast}}, [$person, $role]);
628                                        Shepherd::Common::log(" - parsed cast (".$role.") ".$person) if ($opt->{debug});
629                                }
630
631                                $person = undef, $role = undef;
632                        }
633                }
634
635                last;
636        }
637
638        #
639        # parse countries, languages, genres using generic list parser
640        #
641        &imdb_list_parser($html_data,"country","countries",
642          \$data_cache->{movie_lookup}->{$movie_url}->{countries});
643        &imdb_list_parser($html_data,"language","language",
644          \$data_cache->{movie_lookup}->{$movie_url}->{languages});
645        &imdb_list_parser($html_data,"genre","genre",
646          \$data_cache->{movie_lookup}->{$movie_url}->{genres});
647
648        #
649        # parse tagline, plot, rating, runtime, aka, trivia, goofs,
650        # awards and summary using generic scalar handler
651        #
652        &imdb_scalar_parser($html_data, "h5", "tagline","trimmed","h5", "a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{tagline});
653        &imdb_scalar_parser($html_data, "h5", "plot","trimmed","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{plot});
654        &imdb_scalar_parser($html_data, "h5", "user rating","trimmed","b","/b","b", \$data_cache->{movie_lookup}->{$movie_url}->{rating});
655        &imdb_scalar_parser($html_data, "h5", "runtime","trimmed","h5","br", undef, \$data_cache->{movie_lookup}->{$movie_url}->{runtime});
656        &imdb_scalar_parser($html_data, "h5", "(aka|also known as)","trimmed","b","/div", undef, \$data_cache->{movie_lookup}->{$movie_url}->{aka});
657        &imdb_scalar_parser($html_data, "h5", "trivia","trimmed","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{trivia});
658        &imdb_scalar_parser($html_data, "h5", "goofs","trimmed","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{goofs});
659        &imdb_scalar_parser($html_data, "h5", "awards","trimmed","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{awards});
660        &imdb_scalar_parser($html_data, "h5", "original air date","trimmed","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{airdate});
661        &imdb_scalar_parser($html_data, "h5", "plot summary","","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{summary});
662
663        # A quick hack to provide star-ratings, because they don't seem to be working.
664        # (Possibly none of this is working.)
665        # Max March 2012.
666        my $tree = HTML::TreeBuilder->new_from_content($html_data);
667        my $tag;
668
669        unless (defined $data_cache->{movie_lookup}->{$movie_url}->{rating})
670        {
671            if ($tag = $tree->look_down( '_tag' => 'div', 'class' => 'star-box-giga-star'))
672            {
673                my $rating = $tag->as_text();
674                $rating =~ s/^ +//;
675                $rating =~ s/ +$//;
676                $data_cache->{movie_lookup}->{$movie_url}->{rating} = "$rating/10";
677            }
678            if ($tag = $tree->look_down( '_tag' => 'a', 'href' => 'criticreviews'))
679            {
680                my $rating = $tag->as_text();
681                if ($rating =~ /(\d+\/\d+)/)
682                {
683                    $data_cache->{movie_lookup}->{$movie_url}->{xtrarating} = $1;
684                }
685            }
686        }
687
688        unless (defined $data_cache->{movie_lookup}->{$movie_url}->{plot})
689        {
690            foreach $tag ($tree->look_down( '_tag' => 'h2' ))
691            {
692                if ($tag->as_text eq 'Storyline')
693                {
694                    my $plot = $tag->right()->as_text();
695                    $plot =~ s/\. Written by.*/./;
696                    $data_cache->{movie_lookup}->{$movie_url}->{plot} = $plot;
697                }
698            }
699        }
700
701        #
702        # certifications
703        #
704        $tp = HTML::TokeParser->new(\$html_data);
705        while (my $tag = $tp->get_tag('h5')) {
706                last if ($tp->get_trimmed_text =~ /^certification/i);
707        }
708        while (my $tag = $tp->get_tag()) {
709                if (($tag->[0] eq "a") && (defined $tag->[1]{href}) && ($tag->[1]{href} =~ /certificates/i)) {
710                        my($country, $range) = split(/\s*:\s*/, $tp->get_trimmed_text, 2);
711                        $data_cache->{movie_lookup}->{$movie_url}->{certifications}->{$country} = $range;
712                        Shepherd::Common::log(" - parsed certification ".$range." (".$country.")") if ($opt->{debug});
713                }
714                last if ($tag->[0] =~ /\/td/i);
715        }
716
717        # don't yet pick the following up: do we need to?
718        #  official_sites
719        #  full plot
720
721
722        # write out the cache every 15 progs or so
723        &write_cache if ((($stats{imdb_movie_added_cache_entry} % 15) == 0) && (!defined $opt->{no_cache}));
724}
725
726##############################################################################
727
728sub encoding_cb( $ )
729{
730        my $e = shift;
731        # printf "got encoding ".Dumper($e);
732}
733       
734##############################################################################
735
736sub credits_cb( $ )
737{
738        my $c = shift;
739        # printf "got credits ".Dumper($c);
740}
741
742##############################################################################
743
744sub channel_cb( $ )
745{
746        my $c = shift;
747        # printf "got channel ".Dumper($c);
748        $writer->write_channel($c);
749}
750
751##############################################################################
752
753sub programme_cb( $ )
754{
755        my $prog=shift;
756        $stats{programmes}++;
757
758        my $movie_title = $prog->{title}->[0]->[0]
759          if (($prog->{title}) && ($prog->{title}->[0]) &&
760              ($prog->{title}->[0]->[0]));
761        my $movie_subtitle = $prog->{'sub-title'}->[0]->[0]
762                if (($prog->{'sub-title'}) && ($prog->{'sub-title'}->[0]) &&
763                        ($prog->{'sub-title'}->[0]->[0]));
764        my $movie_year = $prog->{date} if ($prog->{date});
765
766        if (($movie_title =~ /^close$/i) || ($movie_title =~ /^station close$/i)) {
767                $stats{skipped_due_to_category}++;
768                goto END;
769        }
770
771        if (defined $prog->{category}) {
772                foreach my $prog_category (@{($prog->{category})}) {
773                        foreach my $prog_cat2 (@$prog_category) {
774                                foreach my $skip_category (split(/,/,$opt->{skip_categories})) {
775                                        if (lc($prog_cat2) eq lc($skip_category)) {
776                                                $stats{skipped_due_to_category}++;
777                                                goto END;
778                                        }
779                                }
780                        }
781                }
782        }
783
784        # print "got programme ".Dumper($prog);
785
786        #
787        # only lookup if  min_duration < prog_duration > min_duration
788        #
789        my $t1 = Shepherd::Common::parse_xmltv_date($prog->{start});
790        my $t2 = Shepherd::Common::parse_xmltv_date($prog->{stop});
791        if ((!$t1) || (!$t2)) {
792                $stats{excluded_couldnt_parse_time}++;
793                goto END;
794        }
795        my $prog_duration = (($t2 - $t1) / 60);
796        if ($prog_duration < $opt->{min_duration}) {
797                $stats{excluded_prog_too_short}++;
798                goto END;
799        }
800        if ($prog_duration > $opt->{max_duration}) {
801                $stats{excluded_prog_too_long}++;
802                goto END;
803        }
804
805        $stats{included_for_imdb_lookup}++;
806
807        #
808        # find movie url
809        # (either via a cached previous search or via IMDb "power search")
810        #
811        my @search_fields;
812        push(@search_fields, "title=".Shepherd::Common::urlify($movie_title));
813        push(@search_fields, "&countries=".Shepherd::Common::urlify($prog->{country}->[0][0]))
814          if ((defined $prog->{country}) && (defined $prog->{country}->[0][0]));
815        push(@search_fields, "&year=".Shepherd::Common::urlify($prog->{date}))
816          if ((defined $prog->{date}) && ($prog->{date} > 0));
817        push(@search_fields, "&language=".Shepherd::Common::urlify($prog->{language}->[0] =~ /(^[^,]*)/))
818          if ((defined $prog->{language}) && (defined $prog->{language}->[0]));
819        # &exact=y
820        # cast/crew
821
822        Shepherd::Common::log("programme ".$stats{programmes}.": \"$movie_title\" ($prog_duration minutes)");
823
824        # first search using everything we can...
825        my $orig_post_fields = join("",@search_fields);
826        my $post_fields;
827        my $found = 0;
828        while ((scalar(@search_fields) > 0) && (!$found)) {
829                if ($movie_subtitle) {
830                        $post_fields = "title=".Shepherd::Common::urlify($movie_title." ".$movie_subtitle);
831                        $orig_post_fields = $post_fields;
832                        push(@search_fields, $post_fields);
833                } else {
834                        $post_fields = join("",@search_fields);
835                }
836
837                #
838                # first check if we have a previos cache entry for this
839                #
840                if (defined $data_cache->{movie_id_lookup}->{$post_fields} and
841                                defined $data_cache->{movie_id_lookup}->{$post_fields}->{url}) {
842                        if ($data_cache->{movie_id_lookup}->{$post_fields}->{url} eq "-") {
843                                # negatively cached
844                                $stats{imdb_lookup_used_negative_cache_entry}++;
845                                undef $movie_subtitle;
846                                pop(@search_fields);
847                        } else {
848                                # positive cache
849                                $stats{imdb_lookup_used_cache_entry}++;
850                                $found = 1;
851                        }
852                        Shepherd::Common::log("  used (".($found ? "positive" : "negative")." cache) search: $post_fields");
853                } else {
854                        #
855                        # no cache, go look it up
856                        #
857                        &search_imdb_online($movie_title, $post_fields, $movie_year);
858
859                        # IMDb web site failed/returned unexpected result, just skip rest
860                        goto END
861                          if (!defined $data_cache->{movie_id_lookup}->{$post_fields} or
862                                        !defined $data_cache->{movie_id_lookup}->{$post_fields}->{url});
863
864                        if ($data_cache->{movie_id_lookup}->{$post_fields}->{url} eq "-") {
865                                # lookup failed.
866
867                                # if it returned no hits, perhaps our search was too specific.
868                                # make it less specific if we can
869                                if ($data_cache->{movie_id_lookup}->{$post_fields}->{num_choices} == 0) {
870                                        undef $movie_subtitle;
871                                        pop(@search_fields);
872                                } else {
873                                        # search wasn't specific enough.  (more than 1 hit)
874
875                                        if ($movie_subtitle) {
876                                                # try again if subtitle in search
877                                                undef $movie_subtitle;
878                                                pop(@search_fields);
879                                        } else {
880                                                # skip ahead to simple search
881                                                # fill in less detailed searches or we fetch them next time
882                                                pop(@search_fields);
883                                                while (scalar(@search_fields) > 0) {
884                                                        $post_fields = join("",@search_fields);
885                                                        $data_cache->{movie_id_lookup}->{$post_fields}->{last_fetched} = time;
886                                                        $data_cache->{movie_id_lookup}->{$post_fields}->{url} = '-';
887                                                        $data_cache->{movie_id_lookup}->{$post_fields}->{num_choices} = 1000;
888                                                        pop(@search_fields);
889                                                }
890                                        }
891                                }
892                        } else {
893                                # lookup succeeded
894                                $found = 1;
895                        }
896                }
897        }
898
899        # Try the simple search if we have date info
900        if (!$found) {
901            if ($prog->{date}) {
902                # cached?
903                $post_fields = 'simple-'. &Shepherd::Common::urlify($movie_title) . '-'.$prog->{date};
904                my $simple_search = $data_cache->{movie_id_lookup}->{$post_fields};
905                if ($simple_search and $simple_search->{url}) {
906                    if ($simple_search->{url} eq '-') {
907                        # negatively cached
908                        $stats{imdb_lookup_used_negative_cache_entry}++;
909                    } else {
910                        # positively cached
911                        $stats{imdb_lookup_used_cache_entry}++;
912                        $found = 1;
913                    }
914                    &Shepherd::Common::log(sprintf("  used (%s cache) search: ", ($found ? 'positive' : 'negative')) . $post_fields);
915                } else {
916                    # not cached; look it up
917                    $found = &simple_search_imdb($movie_title, $prog->{date});
918                }
919            } else {
920                &Shepherd::Common::log("  no date info, not trying simple search") if ($opt->{debug});
921            }
922        }
923
924        goto END if (!$found);
925
926        $data_cache->{movie_id_lookup}->{$orig_post_fields}->{url} = $data_cache->{movie_id_lookup}->{$post_fields}->{url}
927                        if ($post_fields ne $orig_post_fields);
928
929        my $movie_url = $data_cache->{movie_id_lookup}->{$post_fields}->{url};
930
931        # no match or negative cache match - bail out
932        goto END if ((!defined $movie_url) || ($movie_url eq "-"));
933
934        #
935        # lookup movie details
936        # (either via previously cached entry or via an online IMDb lookup)
937        #
938
939        if (defined $data_cache->{movie_lookup}->{$movie_url}) {
940                $stats{imdb_movie_used_cache_entry}++;
941                Shepherd::Common::log("  used existing (cached) movie details: $movie_url");
942        } else {
943                &get_imdb_movie_online($movie_title,$movie_url);
944                goto END if (!defined $data_cache->{movie_lookup}->{$movie_url});
945                $stats{imdb_movie_added_cache_entry}++;
946        }
947
948
949        #
950        # augment data
951        #
952
953        $data_cache->{movie_lookup}->{$movie_url}->{last_lookup} = time;
954        $data_cache->{movie_lookup}->{$movie_url}->{num_lookups}++;
955        goto END if (!defined $data_cache->{movie_lookup}->{$movie_url}->{title});
956        my $imdb = $data_cache->{movie_lookup}->{$movie_url};
957        $stats{added_imdb_data}++;
958
959        if ($opt->{dont_augment_desc}) {
960
961                # if not a reasonable description, add anything we've got
962                if (!defined $prog->{desc} || !defined $prog->{desc}->[0] || !defined $prog->{desc}->[0]->[0] ||
963                                 (length ($prog->{desc}->[0]->[0]) <= 20)) {
964                        my $imdb_desc = '';
965
966                        $imdb_desc .= $imdb->{tagline}."\n" if ($imdb->{tagline});
967                        $imdb_desc .= $imdb->{summary}."\n" if ($imdb->{summary});
968                        $imdb_desc .= $imdb->{plot} if ($imdb->{plot});
969
970                        if ($imdb_desc ne '') {
971                                chomp $imdb_desc;
972                                $prog->{desc}->[0]->[0] = "" if (!defined $prog->{desc}->[0]->[0]);
973                                $prog->{desc}->[0]->[0] .= "\n" if ($prog->{desc}->[0]->[0] ne "");
974                                $prog->{desc}->[0]->[0] .= $imdb_desc;
975                        }
976                }
977        } else {
978                my $imdb_desc = '';
979
980                # Unless we request --long-info, only add
981                # Tagline, Awards, and Trivia to the description.
982                # (Other data goes in appropriate fields.)
983
984                if ($opt->{long_info}) {
985                    $imdb_desc .= sprintf " Title: %s",$imdb->{title};
986                    $imdb_desc .= sprintf "  (%s)",$imdb->{year}
987                        if (($imdb->{year}) && ($imdb->{year} > 0));
988                    $imdb_desc .= "\n";
989
990                    $imdb_desc .= sprintf " aka: %s\n",$imdb->{aka}
991                        if (defined $imdb->{aka} && $imdb->{aka} ne "");
992                }
993
994                $imdb_desc .= sprintf " Tagline: %s\n",$imdb->{tagline}
995                    if (defined $imdb->{tagline} && $imdb->{tagline} ne "");
996               
997                if ($opt->{long_info} || !defined $prog->{desc} || !defined $prog->{desc}->[0] ||
998                                !defined $prog->{desc}->[0]->[0] || (length ($prog->{desc}->[0]->[0]) <= 20)) {
999                    $imdb_desc .= sprintf " Summary: %s\n",$imdb->{summary}
1000                        if (defined $imdb->{summary} && $imdb->{summary} ne "");
1001
1002                    $imdb_desc .= sprintf " Plot: %s\n",$imdb->{plot}
1003                        if (defined $imdb->{plot} && $imdb->{plot} ne "");
1004                }
1005
1006                if ($opt->{long_info}) {
1007                    $imdb_desc .= sprintf " Rating: %s\n",$imdb->{rating}
1008                        if (defined $imdb->{rating} && $imdb->{rating} =~ /^\d+/);
1009                }
1010
1011                $imdb_desc .= sprintf " Original Air Date: %s\n",$imdb->{airdate}
1012                    if (defined $imdb->{airdate} && $imdb->{airdate} ne "");
1013
1014                $imdb_desc .= sprintf " Awards: %s\n",$imdb->{awards}
1015                    if (defined $imdb->{awards} && $imdb->{awards} ne "");
1016
1017                $imdb_desc .= sprintf " Trivia: %s\n",$imdb->{trivia}
1018                    if (defined $imdb->{trivia} && $imdb->{trivia} ne "");
1019               
1020                if ($opt->{long_info}) {
1021                    $imdb_desc .= sprintf " Certifications: %s\n", join(', ', 
1022                        map { sprintf "%s (%s)", $imdb->{certifications}->{$_}, $_ } sort keys  %{$imdb->{certifications}})
1023                            if (defined $imdb->{certifications});
1024
1025                    $imdb_desc .= sprintf " Cast: %s\n", join(', ',
1026                        (ref $imdb->{cast} eq "ARRAY" ?
1027                            map { sprintf "%s%s", @$_[0], (@$_[1] ? " as @$_[1]" : '') } @{$imdb->{cast}} :
1028                            map { sprintf "%s%s", $_, ($imdb->{cast}->{$_} ? " as " . $imdb->{cast}->{$_} : '') } keys %{$imdb->{cast}}))
1029                                if (defined $imdb->{cast});
1030
1031                    $imdb_desc .= sprintf " Directors: %s\n",
1032                        join(", ", ref($imdb->{directors}) eq "ARRAY" ?
1033                            map(@$_[0], @{$imdb->{directors}}) : sort keys %{$imdb->{directors}})
1034                                if ($imdb->{directors});
1035                    $imdb_desc .= sprintf " Writers: %s\n",
1036                        join(", ", ref($imdb->{writers}) eq "ARRAY" ?
1037                            map(@$_[0], @{$imdb->{writers}}) : sort keys %{$imdb->{writers}})
1038                                if ($imdb->{writers});
1039
1040                    $imdb_desc .= sprintf " Runtime: %s\n",$imdb->{runtime}
1041                        if (defined $imdb->{runtime} && $imdb->{runtime} ne "");
1042                    $imdb_desc .= sprintf " Countries: %s\n",
1043                        join(", ",@{$imdb->{countries}})
1044                            if (defined $imdb->{countries});
1045                    $imdb_desc .= sprintf " Languages: %s\n",
1046                        join(", ",@{$imdb->{languages}})
1047                            if (defined $imdb->{languages});
1048                    $imdb_desc .= sprintf " Genres: %s\n",
1049                        join(", ",@{$imdb->{genres}})
1050                            if (defined $imdb->{genres});
1051
1052                    $imdb_desc .= sprintf " Goofs: %s\n",$imdb->{goofs}
1053                        if (defined $imdb->{goofs} && $imdb->{goofs} ne "");
1054                    $imdb_desc .= sprintf " Cover: %s\n",$imdb->{cover}
1055                        if (defined $imdb->{cover} && $imdb->{cover} ne "");
1056                }
1057
1058                if ($imdb_desc ne '') {
1059                    chomp $imdb_desc;
1060                    if ($opt->{long_info}) {
1061                        $imdb_desc = "IMDb augmented data:\n$imdb_desc";
1062                    } else {
1063                        $imdb_desc = sprintf "(%s)", substr($imdb_desc, 1);
1064                    }
1065                    $prog->{desc}->[0]->[0] = "" if (!defined $prog->{desc}->[0]->[0]);
1066                    $prog->{desc}->[0]->[0] .= "\n\n" if ($prog->{desc}->[0]->[0] ne "");
1067                    $prog->{desc}->[0]->[0] .= $imdb_desc;
1068                }
1069        }
1070
1071        $prog->{date} = $imdb->{year} if ($imdb->{year} && !$prog->{date});
1072        # $prog->{length} = $imdb->{runtime} if ($imdb->{runtime});
1073
1074        my $found_url = 0, my $found_cover = 0;
1075        if (defined $prog->{url}) {
1076                foreach my $url (@{($prog->{url})}) {
1077                        $found_url++ if (lc($url) eq lc($movie_url));
1078                        $found_cover++ if (($imdb->{cover}) && (lc($url) eq lc($imdb->{cover})));
1079                }
1080        }
1081        push (@{($prog->{url})},$movie_url) if (!$found_url);
1082        push (@{($prog->{url})},$imdb->{cover}) if (($imdb->{cover}) && (!$found_cover));
1083
1084        # quick hack by Max to get working again, March 2012.
1085        if ($imdb->{rating}) {
1086                $prog->{'star-rating'} = [ ] unless (ref $prog->{'star-rating'});
1087                push @{$prog->{'star-rating'}}, [ $imdb->{rating}, "IMDB.com", undef ];
1088                if ($imdb->{xtrarating})
1089                {
1090                    push @{$prog->{'star-rating'}}, [ $imdb->{xtrarating}, "Metacritic", undef ];
1091                }
1092
1093#               my ($rating,$votes) = split(/ /,$imdb->{rating});
1094#               if ($rating =~ /[\d\.\s]+\/[\d\.\s]+/) {
1095#                       # If there's already a star-rating, average the scores
1096#                       if (ref $prog->{'star-rating'} && $prog->{'star-rating'}->[0] =~ /[\d\.\s]+\/[\d\.\s]+/) {
1097#                               $rating = sprintf "%.1f/10", (eval($rating) + eval($prog->{'star-rating'}->[0])) * 5;
1098#                       }
1099#                       $prog->{'star-rating'} = [ $rating ];
1100#               }
1101        }
1102
1103        if ($imdb->{languages}) {
1104                foreach my $lang (@{($imdb->{languages})}) {
1105                        if (defined $prog->{language}) {
1106                                $prog->{language}->[0] .= ", " . $lang
1107                                        if ($prog->{language}->[0] !~ /$lang/i);
1108                        } else {
1109                                $prog->{language}->[0] = $lang;
1110                        }
1111                }
1112        }
1113        # don't fill in XMLTV orig-language - mythtv ignores it
1114
1115        if (defined $imdb->{genres}) {
1116                foreach my $genre (@{($imdb->{genres})}) {
1117                        my $found_genre = 0;
1118                        foreach my $category (@{($prog->{category})}) {
1119                                $found_genre++ if (lc($genre) eq lc($category->[0]));
1120                        }
1121                        push(@{($prog->{category})},[$genre]) if (!$found_genre);
1122                }
1123        }
1124
1125        if (defined $imdb->{countries}) {
1126                foreach my $country (@{($imdb->{countries})}) {
1127                        my $found_country = 0;
1128                        foreach my $c (@{($prog->{country})}) {
1129                                $found_country++ if (lc($country) eq lc($c->[0]));
1130                        }
1131                        push(@{($prog->{country})},[$country]) if (!$found_country);
1132                }
1133        }
1134
1135        if (defined $imdb->{airdate})
1136        {
1137                my ($season) = ($imdb->{airdate} =~ /Season\s+(\d+)/i);
1138                my ($episode) = ($imdb->{airdate} =~ /Episode\s+(\d+)/i);
1139                if ($season || $episode) {
1140                        my $xmltv_ns = ($season ? ($season - 1) : "") ." . ". ($episode ? ($episode - 1) : "") ." . 0";
1141                        $prog->{'episode-num'} = [ [ $xmltv_ns, 'xmltv_ns' ] ];
1142                }
1143        }
1144
1145        if (defined $imdb->{certifications}) {
1146                # put a useful rating first
1147                my $useful_rating;
1148                foreach my $country ('Australia', 'New Zealand', 'USA', 'UK', 'Canada', 'Ireland',
1149                                'Singapore', 'Philippines', 'Taiwan') {
1150                        if ($imdb->{certifications}->{$country} &&
1151                                        $imdb->{certifications}->{$country} ne 'Unrated' &&
1152                                        $imdb->{certifications}->{$country} ne 'Not Rated' &&
1153                                        $imdb->{certifications}->{$country} ne 'Approved') {
1154                                push(@{($prog->{rating})},[$imdb->{certifications}->{$country},$country,undef]);
1155                                $useful_rating = 1;
1156                                last;
1157                        }
1158                }
1159
1160                # only return everything if long_info or no useful rating found
1161                if ($opt->{long_info} || !$useful_rating) {
1162                        foreach my $cert (sort keys %{($imdb->{certifications})}) {
1163                                my $found_cert = 0;
1164                                foreach my $c (@{($prog->{rating})}) {
1165                                        $found_cert++ if (lc($cert) eq lc($c->[1]));
1166                                }
1167                                push(@{($prog->{rating})},[$imdb->{certifications}->{$cert},$cert,undef])
1168                                                if (!$found_cert);
1169                        }
1170                }
1171        }
1172
1173        if (defined $imdb->{cast}) {
1174                foreach my $cast (ref($imdb->{cast}) eq "ARRAY" ?
1175                                map(@$_[0], @{$imdb->{cast}}) : sort keys %{$imdb->{cast}}) {
1176                        my $found_cast = 0;
1177                        if ((defined $prog->{credits}) && (defined $prog->{credits}->{actor})) {
1178                                foreach my $a (@{($prog->{credits}->{actor})}) {
1179                                        $found_cast++ if (lc($cast) eq lc($a));
1180                                }
1181                        }
1182                        push(@{($prog->{credits}->{actor})},$cast) if (!$found_cast);
1183                }
1184        }
1185
1186        if (defined $imdb->{writers}) {
1187                foreach my $cast (ref($imdb->{writers}) eq "ARRAY" ?
1188                                map(@$_[0], @{$imdb->{writers}}) : sort keys %{$imdb->{writers}}) {
1189                        my $found_cast = 0;
1190                        if ((defined $prog->{credits}) && (defined $prog->{credits}->{writer})) {
1191                                foreach my $w (@{($prog->{credits}->{writer})}) {
1192                                        $found_cast++ if (lc($cast) eq lc($w));
1193                                }
1194                        }
1195                        push(@{($prog->{credits}->{writer})},$cast) if (!$found_cast);
1196                }
1197        }
1198
1199        if (defined $imdb->{directors}) {
1200                foreach my $cast (ref($imdb->{directors}) eq "ARRAY" ?
1201                                map(@$_[0], @{$imdb->{directors}}) : sort keys %{$imdb->{directors}}) {
1202                        my $found_cast = 0;
1203                        if ((defined $prog->{credits}) && (defined $prog->{credits}->{director})) {
1204                                foreach my $d (@{($prog->{credits}->{director})}) {
1205                                        $found_cast++ if (lc($cast) eq lc($d));
1206                                }
1207                        }
1208                        push(@{($prog->{credits}->{director})},$cast) if (!$found_cast);
1209                }
1210        }
1211
1212        if (defined $imdb->{cover}) {
1213                $found_cover = 0;
1214                if (defined $prog->{icon}) {
1215                        foreach my $cover (@{($prog->{icon})}) {
1216                                $found_cover++ if (lc($cover->{src}) eq lc($imdb->{cover}));
1217                        }
1218                }
1219                $prog->{icon}->[0]->{src} = $imdb->{cover} if (!$found_cover);
1220        }
1221
1222        Shepherd::Common::cleanup($prog);
1223        #print "prog now ".Dumper($prog);
1224END:
1225        $writer->write_programme($prog);
1226}
1227
1228##############################################################################
1229
1230sub run_test
1231{
1232        $opt->{debug} = 1;
1233        $opt->{fast} = 1;
1234        Shepherd::Common::log("running test for: ".$opt->{test});
1235
1236        my $post_fields = "title=".Shepherd::Common::urlify($opt->{test});
1237        &search_imdb_online($opt->{test},$post_fields);
1238
1239        die "lookup unsuccessful\n"
1240          if ((!defined $data_cache->{movie_id_lookup}->{$post_fields}) ||
1241              ($data_cache->{movie_id_lookup}->{$post_fields}->{url} eq "-"));
1242
1243        my $movie_url = $data_cache->{movie_id_lookup}->{$post_fields}->{url};
1244        &get_imdb_movie_online($opt->{test},$movie_url);
1245        print "Movie details returned: ".Dumper($data_cache->{movie_lookup}->{$movie_url});
1246
1247        exit(0);
1248}
1249
1250##############################################################################
Note: See TracBrowser for help on using the repository browser.