root/postprocessors/imdb_augment_data @ 843

Revision 843, 34.8 kB (checked in by paul, 6 years ago)

imdb_augment_data: keep order of directors, cast and writers
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
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;
27
28my $progname = "imdb_augment_data";
29my $version = "0.24";
30
31use XMLTV;
32use POSIX qw(strftime mktime);
33use Getopt::Long;
34use HTML::TokeParser;
35use Data::Dumper;
36use Storable;
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
66GetOptions(
67        'region=i'              => \$opt->{region},             # ignored
68        'days=i'                => \$opt->{days},               # ignored
69        'offset=i'              => \$opt->{offset},             # ignored
70        'timezone=s'            => \$opt->{timezone},           # ignored
71        'channels_file=s'       => \$opt->{channels_file},      # ignored
72        'config-file=s'         => \$opt->{configfile},         # ignored
73
74        'min_duration=i'        => \$opt->{min_duration},
75        'max_duration=i'        => \$opt->{max_duration},
76        'skip_categories=s'     => \$opt->{skip_categories},
77        'cache_details_for=i'   => \$opt->{cache_details_for},
78        'cache_title_for=i'     => \$opt->{cache_title_for},
79        'dont-augment-desc'     => \$opt->{dont_augment_desc},
80
81        'output=s'              => \$opt->{output_file},
82        'cache-file=s'          => \$opt->{cache_file},
83        'fast'                  => \$opt->{fast},
84        'no-cache'              => \$opt->{no_cache},
85        'debug+'                => \$opt->{debug},
86        'lang=s'                => \$opt->{lang},
87        'no-retry'              => \$opt->{dont_retry},
88        'help'                  => \$opt->{help},
89        'test=s'                => \$opt->{test},
90        'simpletest=s'          => \$opt->{simpletest},
91        'set=s'                 => \$opt->{set},
92        'verbose'               => \$opt->{help},
93        'version'               => \$opt->{version},
94        'ready'                 => \$opt->{ready},
95        'desc'                  => \$opt->{desc},
96        'v'                     => \$opt->{version});
97
98printf "%s v%s\n",$progname,$version;
99
100if ($opt->{version} || $opt->{desc} || $opt->{help} || $opt->{ready} ||
101    $opt->{output_file} eq "") {
102        printf "Augments XMLTV data with programme information from ".
103          "The Internet Movie Database (www.imdb.com)\n" if $opt->{desc};
104
105        printf "$progname is ready for operation.\n" if ($opt->{ready});
106
107        printf "No --output file specified.\n" if ($opt->{output_file} eq "");
108
109        if ($opt->{help} || $opt->{output_file} eq "") {
110                print<<EOF
111
112usage: $0 [options] {FILE(s)}
113
114Supported options include:
115  --min_duration={min} ignore programs under {min} duration (default: $opt->{min_duration} min)
116  --max_duration={min} ignore programs over {min} duration (default: $opt->{max_duration} min)
117  --skip_categories={list} don't try to look up programmes in these categories (default: $opt->{skip_categories})
118
119  --dont-augment-desc  don't add IMDb data to programme description,
120                       only update the data fields (default: do)
121
122  --cache_details_for={days}  cache programme details for {days} (def: $opt->{cache_details_for} days)
123  --cache_title_for={days}    cache IMDb URLs for {days} (def: $opt->{cache_title_for} days)
124
125  --lang={lang}        set language to {lang} (default: $opt->{lang})
126  --output={file}      send final XMLTV output to {file} (default: $opt->{output_file})
127  --debug              enable debugging
128  --fast               don't pause between requests to www.imdb.com
129
130  --cache-file={file}  local file to use as our data cache (default: $opt->{cache_file})
131  --no-cache           don't use local cache to reduce network load on www.imdb.com
132  --no-retry           don't retry failed HTTP requests
133
134  --test=(string)      operate in 'test mode', look up prog named (string)
135
136  --set=(setting):(value) save setting override: (value) 1=enable, 0=disable
137        dont_augment_desc:1/0 (don't / do)
138
139EOF
140;
141        }
142        exit(0);
143}
144
145&run_test if (defined $opt->{test});
146&simple_search_imdb(split(/,/, $opt->{simpletest})) if ($opt->{simpletest});
147&set_settings if (defined $opt->{set});
148
149# set defaults
150Shepherd::Common::set_default("debug", ((defined $opt->{debug} && $opt->{debug} > 0) ? 2 : 0));
151Shepherd::Common::set_default("stats", \%stats);
152Shepherd::Common::set_default("retry_delay", 10);
153Shepherd::Common::set_default("delay", int(rand(4) + 3)) unless (defined $opt->{fast});
154Shepherd::Common::set_default('fake' => 0);
155
156# go go go!
157
158Shepherd::Common::log(sprintf "started: cache %s, %s%soutput %s",
159        ($opt->{no_cache} ? "disabled" : "enabled"),
160        ($opt->{fast} ? "fast-override, " : ""),
161        ($opt->{debug} ? "debug enabled, " : ""),
162        ($opt->{output_file}));
163
164&read_cache unless ($opt->{no_cache});
165
166my %writer_args = ( encoding => 'ISO-8859-1' );
167my $fh = new IO::File(">".$opt->{output_file}) ||
168  die "can't open $opt->{output_file} for writing: $!";
169$writer_args{OUTPUT} = $fh;
170
171my $writer = new XMLTV::Writer(%writer_args);
172$writer->start( {
173        'source-info-url' => "http://www.imdb.com",
174        'source-info-name' => "$progname $version",
175        'generator-info-name' => "$progname $version"} );
176
177foreach my $file (@ARGV) {
178        Shepherd::Common::log((sprintf "Parsing: %s",
179                ($file eq "-" ? "(from-stdin, hit control-D to finiah)" : $file)));
180        XMLTV::parsefiles_callback(\&encoding_cb, \&credits_cb,
181                \&channel_cb,\&programme_cb, $file);
182}
183
184$writer->end();
185Shepherd::Common::log("Finished parsing, output in $opt->{output_file}");
186
187&write_cache unless ($opt->{no_cache});
188
189Shepherd::Common::print_stats($progname, $version, $script_start_time, %stats);
190
191exit(0);
192
193##############################################################################
194
195sub set_settings
196{
197        &read_cache;
198        my ($setting, $val) = split(/:/,$opt->{set});
199
200        die "--set format is (setting):(value) where value is 0 for disable, 1 for enable.\n"
201          if ((!defined $val) || (($val ne "0") && ($val ne "1")));
202
203        die "unknown '--set' parameter '$setting', see --help for details.\n"
204          if ($setting ne "dont_augment_desc");
205
206        $settings_override->{$setting} = $val;
207        printf "%s: override parameter %s: %s\n", $progname, $setting, ($val eq "0" ? "disabled" : "enabled");
208
209        &write_cache;
210        exit(0);
211}
212
213##############################################################################
214# populate cache
215
216sub read_cache
217{
218        #
219        # new-style Storable cache
220        #
221        if (-r $opt->{cache_file}) {
222                my $store = Storable::retrieve($opt->{cache_file});
223                $data_cache = $store->{data_cache};
224                $settings_override = $store->{settings_override};
225
226                foreach my $setting (keys %$settings_override) {
227                        $opt->{$setting} = 1 if ($settings_override->{$setting} != 0);
228                }
229        } else {
230                printf "WARNING: no cache $opt->{cache_file} - ".
231                  "have to fetch all details.\n";
232                &write_cache; # try to write to it - failure will cause an error & barf
233        }
234
235        #
236        # age our caches on startup
237        #
238        my $max_age;
239
240        # age our programme_id cache on startup
241        my $prog_id = $data_cache->{movie_id_lookup};
242        $max_age = time - ($opt->{cache_title_for} * 86400);
243        foreach my $key (keys %{$prog_id}) {
244                if ($data_cache->{movie_id_lookup}->{$key}->{last_fetched} < $max_age) {
245                        delete $data_cache->{movie_id_lookup}->{$key};
246                        $stats{removed_programme_id_from_cache}++
247                }
248        }
249
250        # age our programme cache on startup
251        my $prog = $data_cache->{movie_lookup};
252        $max_age = time - ($opt->{cache_details_for} * 86400);
253        foreach my $key (keys %{$prog}) {
254                if ($data_cache->{movie_lookup}->{$key}->{last_fetched} < $max_age) {
255                        delete $data_cache->{movie_lookup}->{$key};
256                        $stats{removed_programme_from_cache}++
257                }
258        }
259}
260
261##############################################################################
262# write out updated cache
263
264sub write_cache
265{
266        my $store;
267        $store->{data_cache} = $data_cache;
268        $store->{settings_override} = $settings_override;
269        Storable::store($store, $opt->{cache_file});
270}
271
272##############################################################################
273# use the online IMDb "power search" at http://www.imdb/List to try to find _1_ match
274
275sub search_imdb_online
276{
277        my ($title, $post_fields) = @_;
278
279        if ($stats{failed_online_imdb_lookup} and $stats{failed_online_imdb_lookup} >= 3) {
280                Shepherd::Common::log("too many failed lookups to online IMDb search for '$title' with $post_fields");
281                return;
282        }
283
284        Shepherd::Common::log("  online IMDb search for '$title' with $post_fields");
285        my $html_data = Shepherd::Common::get_url(url => "http://www.imdb.com/List",
286                        method => "POST", postvars => $post_fields);
287
288        if (!$html_data) {
289                $stats{failed_online_imdb_lookup}++;
290                Shepherd::Common::log("failed to search imdb movie data from http://www.imdb.com/List");
291                return;
292        }
293        $data_cache->{movie_id_lookup}->{$post_fields}->{last_fetched} = time;
294
295        my $tp = HTML::TokeParser->new(\$html_data);
296
297        # see if we can find any <a href="/title/tt[0-9]+/">{name}</a> tags
298        my %urls;
299        my $urls_found = 0;
300        while (my $token = $tp->get_tag("a")) {
301                my $url = $token->[1]{href}; # undefined when 200 results returned
302                if ($url && $url =~ /\/title\/tt[0-9]+\//) {
303                        $urls{$url}++; # store as a hash since imdb sometimes gives dups
304                        $urls_found++ if ($urls{$url} == 1);
305                }
306        }
307
308        # only insert into cache if we match exactly _1_ movie
309        if ($urls_found == 1) {
310                my $this_url = (keys %urls)[0];
311                if ($this_url =~ /^http:/) {
312                        $data_cache->{movie_id_lookup}->{$post_fields}->{url} = $this_url;
313                } else {
314                        $data_cache->{movie_id_lookup}->{$post_fields}->{url} = "http://www.imdb.com".$this_url;
315                }
316                $stats{imdb_lookup_added_positive_cache_entry}++;
317        } else {
318                Shepherd::Common::log("    online search failed: wanted 1 match, got $urls_found matches.");
319                # negatively cache our failed lookup
320                $data_cache->{movie_id_lookup}->{$post_fields}->{url} = "-";
321                $data_cache->{movie_id_lookup}->{$post_fields}->{num_choices} =
322                  $urls_found;
323        }
324}
325
326##############################################################################
327# simple search
328#
329# The 'power search' seems to have a couple of annoying flaws, like
330# an inability to find AKA titles. So if our power search fails, we
331# fall back to the simple search. This seems to work very well, finding
332# many shows that the power search misses.
333
334sub simple_search_imdb
335{
336    my ($title, $year) = @_;
337
338    &Shepherd::Common::log("  trying simple search for '$title' ($year)");
339    my $url = sprintf "http://us.imdb.com/find?q=%s;s=tt", &Shepherd::Common::urlify($title);
340    my $html = &Shepherd::Common::get_url($url);
341
342    unless ($html) 
343    {
344        $stats{failed_online_imdb_lookup}++;
345        &Shepherd::Common::log("simple search failed");
346        return 0;
347    }
348
349    my $link;
350    my $tree = HTML::TreeBuilder->new_from_content($html);
351    HTMLPARSE: foreach my $block ($tree->look_down('_tag' => 'p'))
352    {
353        my $tag = $block->look_down('_tag' => 'b');
354        next unless ($tag);
355        if ($tag->as_text eq 'Titles (Exact Matches)' or $tag->as_text eq 'Popular Titles')
356        {
357            foreach my $line (split(/<br>/, $block->as_HTML))
358            {
359                if ($line =~ /^<a href="(\/title\/tt[0-9]+\/?)">(.*?)<\/a> \((\d{4})\)(.*)/
360                        and
361                    (!$year or $year == $3)
362                        and
363                    (!$4 or $4 !~ /VG/))
364                {
365                    if ($link)
366                    {
367                        # found multiple hits. That's bad.
368                        $link = undef;
369                        &Shepherd::Common::log("    found multiple hits, wanted 0.") if ($opt->{debug});
370                        last HTMLPARSE;
371                    }
372                    # Bingo! Found a link
373                    &Shepherd::Common::log("    found link: $1") if ($opt->{debug});
374                    $link = "http://www.imdb.com" . $1;
375                }
376            }
377        }
378    }
379    my $cache_name = 'simple-'.&Shepherd::Common::urlify($title).'-'.$year;
380
381    $data_cache->{movie_id_lookup}->{$cache_name}->{last_fetched} = time;
382
383    unless ($link)
384    {
385        &Shepherd::Common::log("    simple search failed.");
386        # negatively cache our failed lookup
387        $data_cache->{movie_id_lookup}->{$cache_name}->{url} = "-";
388        return 0;
389    }
390    $data_cache->{movie_id_lookup}->{$cache_name}->{url} = $link;
391    $stats{imdb_lookup_added_positive_cache_entry}++;
392    return 1;
393}
394
395##############################################################################
396# simple parser for imdb returned data: covers most data
397
398sub imdb_scalar_parser
399{
400        my ($html_data, $start_tag, $target, $texttype, $targetb, $targetc, $targeta, $v) = @_;
401
402        my $found = 0;
403        my $tp = HTML::TokeParser->new(\$html_data);
404
405        while (my $tag = $tp->get_tag($start_tag)) {
406                if ($tp->get_text =~ /^$target/i) {
407                        $found = 1;
408                        last;
409                }
410        }
411        if (!$found) {
412                Shepherd::Common::log(" - no ".$target." found") if ($opt->{debug});
413                return;
414        }
415
416        my $tag = $tp->get_tag($targeta) if (defined $targeta);
417        if ($texttype eq "trimmed") {
418                $$v = $tp->get_trimmed_text($targetb,$targetc);
419        } else {
420                $$v = $tp->get_text($targetb,$targetc);
421                $$v =~ s/^\s*(.*?)\s*$/$1/;
422        }
423
424        Shepherd::Common::log(" - parsed ".$target." ".$$v) if ($opt->{debug});
425}
426
427##############################################################################
428
429sub imdb_list_parser
430{
431        my ($html_data, $target, $target2, $v) = @_;
432
433        my $tp = HTML::TokeParser->new(\$html_data);
434        my @list;
435        my $found = 0;
436
437        while (my $tag = $tp->get_tag('h5')) {
438                if ($tp->get_text =~ /^$target/i) {
439                        $found = 1;
440                        last;
441                }
442        }
443        return undef if (!$found);
444
445        while (my $tag = $tp->get_tag()) {
446                push (@list, $tp->get_text())
447                  if (($tag->[0] eq 'a') && (defined $tag->[1]{href}) && ($tag->[1]{href} =~ /$target2/i));
448                last if ($tag->[0] eq 'br');
449        }
450
451        my $found_items = 0;
452        foreach my $item (@list) {
453                $$v->[$found_items] = $item;
454                Shepherd::Common::log(" - parsed ".$target." ".$item) if ($opt->{debug});
455                $found_items++;
456        }
457}
458
459##############################################################################
460# perform a detailed movie lookup given a movie url
461# store what we find in our data cache
462
463sub get_imdb_movie_online
464{
465        my ($movie_title, $movie_url) = @_;
466
467        if ($stats{failed_online_imdb_lookup} and $stats{failed_online_imdb_lookup} >= 3) {
468                Shepherd::Common::log("too many failed lookups to downloading online IMDb movie data for '$movie_title'");
469                return;
470        }
471
472        Shepherd::Common::log("  downloading online IMDb movie data for '$movie_title'");
473        my $html_data = Shepherd::Common::get_url($movie_url);
474
475        if (!$html_data) {
476                $stats{failed_online_imdb_lookup}++;
477                Shepherd::Common::log("failed to fetch imdb movie data from $movie_url");
478                return;
479        }
480
481        $stats{imdb_movie_added_cache_entry}++;
482        $data_cache->{movie_lookup}->{$movie_url}->{last_fetched} = time;
483        my $tp;
484
485        #
486        # parse title and year
487        #
488        $tp = HTML::TokeParser->new(\$html_data);
489        my $title_token = $tp->get_tag('title');
490        my $title_text = $tp->get_text();
491        if ($title_text =~ /(.*?)\s+\((\d{4})?.*?\)/) {
492                $data_cache->{movie_lookup}->{$movie_url}->{title} = $1;
493                $data_cache->{movie_lookup}->{$movie_url}->{year} = $2;
494        }
495
496        if (!defined $data_cache->{movie_lookup}->{$movie_url}->{title}) {
497                $stats{failed_online_imdb_title_parsing}++;
498                Shepherd::Common::log("failed to parse title within imdb movie data from $movie_url");
499                return;
500        }
501
502        #
503        # parse cover url
504        #
505        my $title = $data_cache->{movie_lookup}->{$movie_url}->{title};
506        $title =~ s/([\{\}\[\]\(\)\^\$\.\|\*\+\?\\])/\\$1/g;
507        $tp = HTML::TokeParser->new(\$html_data);
508        while (my $img_tag = $tp->get_tag('img')) {
509                next if (!$img_tag->[1]{alt});
510                last if ($img_tag->[1]{alt} =~ /^poster not submitted/i);
511                if ($img_tag->[1]{alt} =~ /^$title$/i) {
512                        $data_cache->{movie_lookup}->{$movie_url}->{cover} = $img_tag->[1]{src};
513                        Shepherd::Common::log(" - parsed cover_url ".$img_tag->[1]{src}) if ($opt->{debug});
514                        last;
515                }
516        }
517
518        #
519        # parse directors
520        #
521        $tp = HTML::TokeParser->new(\$html_data);
522        while (my $tag = $tp->get_tag('h5')) {
523                last if ($tp->get_text =~ /^(directed|director)/i);
524        }
525        while (my $tag = $tp->get_tag) {
526                my $text = $tp->get_text();
527                last if (($text =~ /^(writing|writer)/i) || ($tag->[0] =~ /\/td/i));
528                if ($tag->[0] eq 'a') {
529                        my $id = $tag->[1]{href};
530                        next if ($id !~ /^\/name\/nm/);
531                        push(@{$data_cache->{movie_lookup}->{$movie_url}->{directors}}, [$text, $id]);
532                        Shepherd::Common::log(" - parsed director ".$text." (".$id.")") if ($opt->{debug});
533                }
534        }
535
536        #
537        # parse writers
538        #
539        $tp = HTML::TokeParser->new(\$html_data);
540        while (my $tag = $tp->get_tag('h5')) {
541                last if ($tp->get_text =~ /^(writing|writer)/i);
542        }
543        while (my $tag = $tp->get_tag) {
544                my $text = $tp->get_text();
545                last if ($tag->[0] =~ /div/i);
546                if (($tag->[0] eq 'a') && ($text !~ /\bmore\b/i)) {
547                        my $id = $tag->[1]{href};
548                        next if ($id !~ /^\/name\/nm/);
549                        push(@{$data_cache->{movie_lookup}->{$movie_url}->{writers}}, [$text, $id]);
550                        Shepherd::Common::log(" - parsed writer ".$text." (".$id.")") if ($opt->{debug});
551                }
552        }
553
554        #
555        # parse cast
556        #
557        $tp = HTML::TokeParser->new(\$html_data);
558        while (my $tag = $tp->get_tag('table')) {
559                next unless ((exists $tag->[1]{class}) && ($tag->[1]{class} =~ /cast/i));
560
561                my $person, my $role;
562                while ($tag = $tp->get_tag) {
563                        last if ($tag->[0] =~ /^\/table/i);
564                        if (($tag->[0] =~ /^td/i) && (defined $tag->[1]{class}) && ($tag->[1]{class} =~ /nm/)) {
565                                $tag = $tp->get_tag;
566                                $person = $tp->get_text();
567                                next;
568                        }
569                        if (($tag->[0] =~ /^td/i) && (defined $tag->[1]{class}) && ($tag->[1]{class} =~ /char/)) {
570                                $role = $tp->get_text();
571
572                                if ((defined $person) && (defined $role)) {
573                                        push(@{$data_cache->{movie_lookup}->{$movie_url}->{cast}}, [$person, $role]);
574                                        Shepherd::Common::log(" - parsed cast (".$role.") ".$person) if ($opt->{debug});
575                                }
576
577                                $person = undef, $role = undef;
578                        }
579                }
580
581                last;
582        }
583
584        #
585        # parse countries, languages, genres using generic list parser
586        #
587        &imdb_list_parser($html_data,"country","countries",
588          \$data_cache->{movie_lookup}->{$movie_url}->{countries});
589        &imdb_list_parser($html_data,"language","language",
590          \$data_cache->{movie_lookup}->{$movie_url}->{languages});
591        &imdb_list_parser($html_data,"genre","genre",
592          \$data_cache->{movie_lookup}->{$movie_url}->{genres});
593
594        #
595        # parse tagline, plot, rating, runtime, aka, trivia, goofs,
596        # awards and summary using generic scalar handler
597        #
598        &imdb_scalar_parser($html_data, "h5", "tagline","trimmed","h5", "/div", undef, \$data_cache->{movie_lookup}->{$movie_url}->{tagline});
599        &imdb_scalar_parser($html_data, "h5", "plot","trimmed","h5","a", undef, undef, \$data_cache->{movie_lookup}->{$movie_url}->{plot});
600        &imdb_scalar_parser($html_data, "b", "user rating","trimmed","b","/b","b", \$data_cache->{movie_lookup}->{$movie_url}->{rating});
601        &imdb_scalar_parser($html_data, "h5", "runtime","trimmed","h5","br", undef, \$data_cache->{movie_lookup}->{$movie_url}->{runtime});
602        &imdb_scalar_parser($html_data, "h5", "(aka|also known as)","trimmed","b","/div", undef, \$data_cache->{movie_lookup}->{$movie_url}->{aka});
603        &imdb_scalar_parser($html_data, "h5", "trivia","trimmed","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{trivia});
604        &imdb_scalar_parser($html_data, "h5", "goofs","trimmed","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{goofs});
605        &imdb_scalar_parser($html_data, "h5", "awards","trimmed","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{awards});
606        &imdb_scalar_parser($html_data, "h5", "plot summary","","h5","a", undef, \$data_cache->{movie_lookup}->{$movie_url}->{summary});
607
608        if (defined $data_cache->{movie_lookup}->{$movie_url}->{rating}) {
609                # don't use a rating unless its numeric
610                if ($data_cache->{movie_lookup}->{$movie_url}->{rating} !~ /^\d+/) {
611                        delete $data_cache->{movie_lookup}->{$movie_url}->{rating};
612                }
613        }
614
615        #
616        # certifications
617        #
618        $tp = HTML::TokeParser->new(\$html_data);
619        while (my $tag = $tp->get_tag('h5')) {
620                last if ($tp->get_text =~ /^certification/i);
621        }
622        while (my $tag = $tp->get_tag()) {
623                if (($tag->[0] eq "a") && (defined $tag->[1]{href}) && ($tag->[1]{href} =~ /certificates/i)) {
624                        my($country, $range) = split(/:/, $tp->get_text);
625                        $data_cache->{movie_lookup}->{$movie_url}->{certifications}->{$country} = $range;
626                        Shepherd::Common::log(" - parsed certification ".$range." (".$country.")") if ($opt->{debug});
627                }
628                last if ($tag->[0] =~ /\/td/i);
629        }
630
631        # don't yet pick the following up: do we need to?
632        #  official_sites
633        #  full plot
634
635
636        # write out the cache every 15 progs or so
637        &write_cache if ((($stats{imdb_movie_added_cache_entry} % 15) == 0) && (!defined $opt->{no_cache}));
638}
639
640##############################################################################
641
642sub encoding_cb( $ )
643{
644        my $e = shift;
645        # printf "got encoding ".Dumper($e);
646}
647       
648##############################################################################
649
650sub credits_cb( $ )
651{
652        my $c = shift;
653        # printf "got credits ".Dumper($c);
654}
655
656##############################################################################
657
658sub channel_cb( $ )
659{
660        my $c = shift;
661        # printf "got channel ".Dumper($c);
662        $writer->write_channel($c);
663}
664
665##############################################################################
666
667sub programme_cb( $ )
668{
669        my $prog=shift;
670        $stats{programmes}++;
671
672        my $movie_title = $prog->{title}->[0]->[0]
673          if (($prog->{title}) && ($prog->{title}->[0]) &&
674              ($prog->{title}->[0]->[0]));
675        my $movie_subtitle = $prog->{'sub-title'}->[0]->[0]
676                if (($prog->{'sub-title'}) && ($prog->{'sub-title'}->[0]) &&
677                        ($prog->{'sub-title'}->[0]->[0]));
678        my $movie_year = $prog->{date} if ($prog->{date});
679
680        if (($movie_title =~ /^close$/i) || ($movie_title =~ /^station close$/i)) {
681                $stats{skipped_due_to_category}++;
682                goto END;
683        }
684
685        if (defined $prog->{category}) {
686                foreach my $prog_category (@{($prog->{category})}) {
687                        foreach my $prog_cat2 (@$prog_category) {
688                                foreach my $skip_category (split(/,/,$opt->{skip_categories})) {
689                                        if (lc($prog_cat2) eq lc($skip_category)) {
690                                                $stats{skipped_due_to_category}++;
691                                                goto END;
692                                        }
693                                }
694                        }
695                }
696        }
697
698        # print "got programme ".Dumper($prog);
699
700        #
701        # only lookup if  min_duration < prog_duration > min_duration
702        #
703        my $t1 = Shepherd::Common::parse_xmltv_date($prog->{start});
704        my $t2 = Shepherd::Common::parse_xmltv_date($prog->{stop});
705        if ((!$t1) || (!$t2)) {
706                $stats{excluded_couldnt_parse_time}++;
707                goto END;
708        }
709        my $prog_duration = (($t2 - $t1) / 60);
710        if ($prog_duration < $opt->{min_duration}) {
711                $stats{excluded_prog_too_short}++;
712                goto END;
713        }
714        if ($prog_duration > $opt->{max_duration}) {
715                $stats{excluded_prog_too_long}++;
716                goto END;
717        }
718
719        $stats{included_for_imdb_lookup}++;
720
721        #
722        # find movie url
723        # (either via a cached previous search or via IMDb "power search")
724        #
725        my @search_fields;
726        push(@search_fields, "words=".Shepherd::Common::urlify($movie_title));
727        push(@search_fields, "&countries=".Shepherd::Common::urlify($prog->{country}->[0][0]))
728          if ((defined $prog->{country}) && (defined $prog->{country}->[0][0]));
729        push(@search_fields, "&year=".Shepherd::Common::urlify($prog->{date}))
730          if ((defined $prog->{date}) && ($prog->{date} > 0));
731        push(@search_fields, "&language=".Shepherd::Common::urlify($prog->{language}->[0] =~ /(^[^,]*)/))
732          if ((defined $prog->{language}) && (defined $prog->{language}->[0]));
733        # &exact=y
734        # cast/crew
735
736        Shepherd::Common::log("programme ".$stats{programmes}.": \"$movie_title\" ($prog_duration minutes)");
737
738        # first search using everything we can...
739        my $orig_post_fields = join("",@search_fields);
740        my $post_fields;
741        my $found = 0;
742        while (($#search_fields >= 0) && (!$found)) {
743                if ($movie_subtitle) {
744                        $post_fields = "words=".Shepherd::Common::urlify($movie_title." ".$movie_subtitle);
745                        $orig_post_fields = $post_fields;
746                        push(@search_fields, $post_fields);
747                        undef $movie_subtitle;
748                } else {
749                        $post_fields = join("",@search_fields);
750                }
751
752                #
753                # first check if we have a previos cache entry for this
754                #
755                if (defined $data_cache->{movie_id_lookup}->{$post_fields} and
756                                defined $data_cache->{movie_id_lookup}->{$post_fields}->{url}) {
757                        if ($data_cache->{movie_id_lookup}->{$post_fields}->{url} eq "-") {
758                                # negatively cached
759                                $stats{imdb_lookup_used_negative_cache_entry}++;
760                                pop(@search_fields);
761                        } else {
762                                # positive cache
763                                $stats{imdb_lookup_used_cache_entry}++;
764                                $found = 1;
765                        }
766                        Shepherd::Common::log("  used (".($found ? "positive" : "negative")." cache) search: $post_fields");
767                } else {
768                        #
769                        # no cache, go look it up
770                        #
771                        &search_imdb_online($movie_title,$post_fields);
772
773                        # IMDb web site failed/returned unexpected result, just skip rest
774                        goto END
775                          if (!defined $data_cache->{movie_id_lookup}->{$post_fields} or
776                                        !defined $data_cache->{movie_id_lookup}->{$post_fields}->{url});
777
778                        if ($data_cache->{movie_id_lookup}->{$post_fields}->{url} eq "-") {
779                                # lookup failed.
780
781                                # if it returned no hits, perhaps our search was too specific.
782                                # make it less specific if we can
783                                if ($data_cache->{movie_id_lookup}->{$post_fields}->{num_choices} == 0) {
784                                        pop(@search_fields);
785                                } else {
786                                        # search wasn't specific enough.  (more than 1 hit)
787                                        # skip ahead to simple search
788                                        last;
789                                }
790                        } elsif ($data_cache->{movie_id_lookup}->{$post_fields}->{url} ne "-") {
791                                # lookup succeeded
792                                $found = 1;
793                                $data_cache->{movie_id_lookup}->{$orig_post_fields}->{url} = $data_cache->{movie_id_lookup}->{$post_fields}->{url}
794                                  if ($post_fields ne $orig_post_fields);
795                        }
796                }
797        }
798
799        # Try the simple search if we have date info
800        if (!$found and $prog->{date}) {
801            # cached?
802            $post_fields = 'simple-'. &Shepherd::Common::urlify($movie_title) . '-'.$prog->{date};
803            my $simple_search = $data_cache->{movie_id_lookup}->{$post_fields};
804            if ($simple_search and $simple_search->{url}) {
805                if ($simple_search->{url} eq '-') {
806                    # negatively cached
807                    $stats{imdb_lookup_used_negative_cache_entry}++;
808                } else {
809                    # positively cached
810                    $stats{imdb_lookup_used_cache_entry}++;
811                    $found = 1;
812                }
813                &Shepherd::Common::log(sprintf("  used (%s cache) search: ", ($found ? 'positive' : 'negative')) . $post_fields);
814            } else {
815                # not cached; look it up
816                $found = &simple_search_imdb($movie_title, $prog->{date});
817            }
818        } else {
819            &Shepherd::Common::log("  no date info, not trying simple search") if ($opt->{debug});
820        }
821
822        goto END if (!$found);
823
824        my $movie_url = $data_cache->{movie_id_lookup}->{$post_fields}->{url};
825
826        # no match or negative cache match - bail out
827        goto END if ((!defined $movie_url) || ($movie_url eq "-"));
828
829        #
830        # lookup movie details
831        # (either via previously cached entry or via an online IMDb lookup)
832        #
833
834        if (defined $data_cache->{movie_lookup}->{$movie_url}) {
835                $stats{imdb_movie_used_cache_entry}++;
836                Shepherd::Common::log("  used existing (cached) movie details: $movie_url");
837        } else {
838                &get_imdb_movie_online($movie_title,$movie_url);
839                goto END if (!defined $data_cache->{movie_lookup}->{$movie_url});
840                $stats{imdb_movie_added_cache_entry}++;
841        }
842
843
844        #
845        # augment data
846        #
847
848        $data_cache->{movie_lookup}->{$movie_url}->{last_lookup} = time;
849        $data_cache->{movie_lookup}->{$movie_url}->{num_lookups}++;
850        goto END if (!defined $data_cache->{movie_lookup}->{$movie_url}->{title});
851        my $imdb = $data_cache->{movie_lookup}->{$movie_url};
852        $stats{added_imdb_data}++;
853
854        unless ($opt->{dont_augment_desc}) {
855                my $imdb_desc = "IMDb augmented data:\n";
856                $imdb_desc .= sprintf " Title: %s",$imdb->{title};
857                $imdb_desc .= sprintf "  (%s)",$imdb->{year}
858                  if (($imdb->{year}) && ($imdb->{year} > 0));
859
860                $imdb_desc .= sprintf "\n Rating: %s",$imdb->{rating}
861                  if (defined $imdb->{rating} && $imdb->{rating} =~ /^\d+/);
862                $imdb_desc .= sprintf "\n aka: %s",$imdb->{aka}
863                  if (defined $imdb->{aka} && $imdb->{aka} ne "");
864                $imdb_desc .= sprintf "\n Tagline: %s",$imdb->{tagline}
865                  if (defined $imdb->{tagline} && $imdb->{tagline} ne "");
866                $imdb_desc .= sprintf "\n Summary: %s",$imdb->{summary}
867                  if (defined $imdb->{summary} && $imdb->{summary} ne "");
868                $imdb_desc .= sprintf "\n Plot: %s",$imdb->{plot}
869                  if (defined $imdb->{plot} && $imdb->{plot} ne "");
870
871                my $num = 0;
872                if (defined $imdb->{certifications}) {
873                        foreach my $c (sort keys %{($imdb->{certifications})}) {
874                                $imdb_desc .= sprintf "%s%s (%s)",
875                                  ($num > 0 ? ", " : "\n Certifications: "),
876                                  $imdb->{certifications}->{$c}, $c;
877                                $num++;
878                        } 
879                }
880
881                if (defined $imdb->{cast}) {
882                        $num = 0;
883                        if (ref($imdb->{cast}) eq "ARRAY") {
884                                foreach my $c (@{$imdb->{cast}}) {
885                                        $imdb_desc .= sprintf "%s%s%s",
886                                        ($num > 0 ? ", " : "\n Cast: "),
887                                        @$c[0],
888                                        (@$c[1] ? " as @$c[1]" : "");
889                                        $num++;
890                                }
891                        } else { # HASH
892                                foreach my $c (sort keys %{($imdb->{cast})}) {
893                                        $imdb_desc .= sprintf "%s%s%s",
894                                        ($num > 0 ? ", " : "\n Cast: "),
895                                        $c,
896                                        ($imdb->{cast}->{$c} ? " as $imdb->{cast}->{$c}" : "");
897                                        $num++;
898                                }
899                        }
900                }
901
902                $imdb_desc .= sprintf "\n Directors: %s",
903                  join(", ", ref($imdb->{directors}) eq "ARRAY" ?
904                  map(@$_[0], @{$imdb->{directors}}) : sort keys %{$imdb->{directors}})
905                  if ($imdb->{directors});
906                $imdb_desc .= sprintf "\n Writers: %s",
907                  join(", ", ref($imdb->{writers}) eq "ARRAY" ?
908                  map(@$_[0], @{$imdb->{writers}}) : sort keys %{$imdb->{writers}})
909                  if ($imdb->{writers});
910
911                $imdb_desc .= sprintf "\n Awards: %s",$imdb->{awards}
912                  if (defined $imdb->{awards} && $imdb->{awards} ne "");
913                $imdb_desc .= sprintf "\n Runtime: %s",$imdb->{runtime}
914                  if (defined $imdb->{runtime} && $imdb->{runtime} ne "");
915                $imdb_desc .= sprintf "\n Countries: %s",
916                  join(", ",@{$imdb->{countries}})
917                  if (defined $imdb->{countries});
918                $imdb_desc .= sprintf "\n Languages: %s",
919                  join(", ",@{$imdb->{languages}})
920                  if (defined $imdb->{languages});;
921                $imdb_desc .= sprintf "\n Genres: %s",
922                  join(", ",@{$imdb->{genres}})
923                  if (defined $imdb->{genres});;
924
925                $imdb_desc .= sprintf "\n Trivia: %s",$imdb->{trivia}
926                  if (defined $imdb->{trivia} && $imdb->{trivia} ne "");
927                $imdb_desc .= sprintf "\n Goofs: %s",$imdb->{goofs}
928                  if (defined $imdb->{goofs} && $imdb->{goofs} ne "");
929                $imdb_desc .= sprintf "\n Cover: %s",$imdb->{cover}
930                  if (defined $imdb->{cover} && $imdb->{cover} ne "");
931
932                $prog->{desc}->[0]->[0] = "" if (!defined $prog->{desc}->[0]->[0]);
933                $prog->{desc}->[0]->[0] .= "\n\n" if ($prog->{desc}->[0]->[0] ne "");
934                $prog->{desc}->[0]->[0] .= $imdb_desc;
935        }
936
937        $prog->{date} = $imdb->{year} if ($imdb->{year});
938        # $prog->{length} = $imdb->{runtime} if ($imdb->{runtime});
939
940        my $found_url = 0, my $found_cover = 0;
941        if (defined $prog->{url}) {
942                foreach my $url (@{($prog->{url})}) {
943                        $found_url++ if (lc($url) eq lc($movie_url));
944                        $found_cover++ if (($imdb->{cover}) && (lc($url) eq lc($imdb->{cover})));
945                }
946        }
947        push (@{($prog->{url})},$movie_url) if (!$found_url);
948        push (@{($prog->{url})},$imdb->{cover}) if (($imdb->{cover}) && (!$found_cover));
949
950        if ($imdb->{rating}) {
951                my ($rating,$votes) = split(/ /,$imdb->{rating});
952                push (@{($prog->{'star-rating'})},$rating);
953        }
954
955        if ($imdb->{languages}) {
956                foreach my $lang (@{($imdb->{languages})}) {
957                        if (defined $prog->{language}) {
958                                $prog->{language}->[0] .= ", " . $lang
959                                        if ($prog->{language}->[0] !~ /$lang/i);
960                        } else {
961                                $prog->{language}->[0] = $lang;
962                        }
963                }
964        }
965        # don't fill in XMLTV orig-language - mythtv ignores it
966
967        if (($imdb->{plot}) && ((!defined $prog->{desc}->[0]->[0]) ||
968            ($prog->{desc}->[0]->[0] eq ""))) {
969                $prog->{desc}->[0]->[0] = "";
970                $prog->{desc}->[0]->[0] .= $imdb->{tagline}."\n" if ($imdb->{tagline});
971                $prog->{desc}->[0]->[0] .= $imdb->{plot};
972        }
973
974        if (defined $imdb->{genres}) {
975                foreach my $genre (@{($imdb->{genres})}) {
976                        my $found_genre = 0;
977                        foreach my $category (@{($prog->{category})}) {
978                                $found_genre++ if (lc($genre) eq lc($category->[0]));
979                        }
980                        push(@{($prog->{category})},[$genre]) if (!$found_genre);
981                }
982        }
983
984        if (defined $imdb->{countries}) {
985                foreach my $country (@{($imdb->{countries})}) {
986                        my $found_country = 0;
987                        foreach my $c (@{($prog->{country})}) {
988                                $found_country++ if (lc($country) eq lc($c->[0]));
989                        }
990                        push(@{($prog->{country})},[$country]) if (!$found_country);
991                }
992        }
993
994        if (defined $imdb->{certifications}) {
995                push(@{($prog->{rating})},[$imdb->{certifications}->{Australia},'Australia',undef]) 
996                        if ($imdb->{certifications}->{Australia});
997                foreach my $cert (sort keys %{($imdb->{certifications})}) {
998                        my $found_cert = 0;
999                        foreach my $c (@{($prog->{rating})}) {
1000                                $found_cert++ if (lc($cert) eq lc($c->[1]));
1001                        }
1002                        push(@{($prog->{rating})},[$imdb->{certifications}->{$cert},$cert,undef])
1003                          if (!$found_cert);
1004                }
1005        }
1006
1007        if (defined $imdb->{cast}) {
1008                foreach my $cast (ref($imdb->{cast}) eq "ARRAY" ?
1009                                map(@$_[0], @{$imdb->{cast}}) : sort keys %{$imdb->{cast}}) {
1010                        my $found_cast = 0;
1011                        if ((defined $prog->{credits}) && (defined $prog->{credits}->{actor})) {
1012                                foreach my $a (@{($prog->{credits}->{actor})}) {
1013                                        $found_cast++ if (lc($cast) eq lc($a));
1014                                }
1015                        }
1016                        push(@{($prog->{credits}->{actor})},$cast) if (!$found_cast);
1017                }
1018        }
1019
1020        if (defined $imdb->{writers}) {
1021                foreach my $cast (ref($imdb->{writers}) eq "ARRAY" ?
1022                                map(@$_[0], @{$imdb->{writers}}) : sort keys %{$imdb->{writers}}) {
1023                        my $found_cast = 0;
1024                        if ((defined $prog->{credits}) && (defined $prog->{credits}->{writer})) {
1025                                foreach my $w (@{($prog->{credits}->{writer})}) {
1026                                        $found_cast++ if (lc($cast) eq lc($w));
1027                                }
1028                        }
1029                        push(@{($prog->{credits}->{writer})},$cast) if (!$found_cast);
1030                }
1031        }
1032
1033        if (defined $imdb->{directors}) {
1034                foreach my $cast (ref($imdb->{directors}) eq "ARRAY" ?
1035                                map(@$_[0], @{$imdb->{directors}}) : sort keys %{$imdb->{directors}}) {
1036                        my $found_cast = 0;
1037                        if ((defined $prog->{credits}) && (defined $prog->{credits}->{director})) {
1038                                foreach my $d (@{($prog->{credits}->{director})}) {
1039                                        $found_cast++ if (lc($cast) eq lc($d));
1040                                }
1041                        }
1042                        push(@{($prog->{credits}->{director})},$cast) if (!$found_cast);
1043                }
1044        }
1045
1046        if (defined $imdb->{cover}) {
1047                $found_cover = 0;
1048                if (defined $prog->{icon}) {
1049                        foreach my $cover (@{($prog->{icon})}) {
1050                                $found_cover++ if (lc($cover->{src}) eq lc($imdb->{cover}));
1051                        }
1052                }
1053                $prog->{icon}->[0]->{src} = $imdb->{cover} if (!$found_cover);
1054        }
1055
1056        Shepherd::Common::cleanup($prog);
1057        #print "prog now ".Dumper($prog);
1058END:
1059        $writer->write_programme($prog);
1060}
1061
1062##############################################################################
1063
1064sub run_test
1065{
1066        $opt->{debug} = 1;
1067        $opt->{fast} = 1;
1068        Shepherd::Common::log("running test for: ".$opt->{test});
1069
1070        my $post_fields = "words=".Shepherd::Common::urlify($opt->{test});
1071        &search_imdb_online($opt->{test},$post_fields);
1072
1073        die "lookup unsuccessful\n"
1074          if ((!defined $data_cache->{movie_id_lookup}->{$post_fields}) ||
1075              ($data_cache->{movie_id_lookup}->{$post_fields}->{url} eq "-"));
1076
1077        my $movie_url = $data_cache->{movie_id_lookup}->{$post_fields}->{url};
1078        &get_imdb_movie_online($opt->{test},$movie_url);
1079        print "Movie details returned: ".Dumper($data_cache->{movie_lookup}->{$movie_url});
1080
1081        exit(0);
1082}
1083
1084##############################################################################
Note: See TracBrowser for help on using the browser.