root/postprocessors/imdb_augment_data @ 314

Revision 314, 29.2 kB (checked in by lincoln, 6 years ago)

stats passing for yahoo7widget, abc_website, abc2_website, sbsnews_website, ninemsn, yahoo7web, reconciler_mk2 and imdb_augment_data
  • 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
24use strict;
25
26my $progname = "imdb_augment_data";
27my $version = "0.06";
28
29use LWP::UserAgent;
30use Time::HiRes qw(gettimeofday tv_interval);
31use XMLTV;
32use XMLTV::ProgressBar;
33use POSIX qw(strftime mktime);
34use Getopt::Long;
35use HTML::TokeParser;
36use Data::Dumper;
37use Compress::Zlib;
38use DateTime::Format::Strptime;
39use Cwd;
40
41#
42# some initial cruft
43#
44
45my $script_start_time = [gettimeofday];
46my %stats;
47my $data_cache;
48my %interested_categories;
49my %other_categories;
50my $xmltv_strptime = new DateTime::Format::Strptime(pattern => "%Y%m%d%H%M");
51
52my $ua;
53$ua = LWP::UserAgent->new(
54        'timeout' => 30,
55        'keep_alive' => 1,
56        'agent' => "Shepherd / $progname $version"
57        );
58$ua->env_proxy;
59$ua->cookie_jar({});
60$| = 1;
61
62#
63# parse command line
64#
65
66my $opt = { };
67$opt->{output_file} =           cwd() . "/output.xmltv";
68$opt->{cache_file} =            cwd() . "/imdb_augment_data.cache";
69$opt->{lang} =                  "en";
70$opt->{debug} =                 0;
71$opt->{categories} =            "Animated,Animation,Arts and Culture,Classic,".
72                                "Comedy,Crime,Drama,Entertainment,Family,".
73                                "Historical,Movie,Movies,Mystery and Suspense,".
74                                "Premiere,Science,Society and Culture";
75$opt->{min_duration} =          45;     # half an hour
76$opt->{max_duration} =          240;    # 4 hours
77$opt->{cache_details_for} =     21;     # cache movie details for up to 21 days
78$opt->{cache_title_for} =       120;    # cache title lookups for 4 months
79
80GetOptions(
81        'region=i'              => \$opt->{region},             # ignored
82        'days=i'                => \$opt->{days},               # ignored
83        'offset=i'              => \$opt->{offset},             # ignored
84        'timezone=s'            => \$opt->{timezone},           # ignored
85        'channels_file=s'       => \$opt->{channels_file},      # ignored
86        'config-file=s'         => \$opt->{configfile},         # ignored
87
88        'categories=s'          => \$opt->{categories},
89        'min_duration=i'        => \$opt->{min_duration},
90        'max_duration=i'        => \$opt->{max_duration},
91        'cache_details_for=i'   => \$opt->{cache_details_for},
92        'cache_title_for=i'     => \$opt->{cache_title_for},
93        'dont-augment-desc'     => \$opt->{dont_augment_desc},
94
95        'output=s'              => \$opt->{output_file},
96        'cache-file=s'          => \$opt->{cache_file},
97        'fast'                  => \$opt->{fast},
98        'no-cache'              => \$opt->{no_cache},
99        'debug+'                => \$opt->{debug},
100        'lang=s'                => \$opt->{lang},
101        'no-retry'              => \$opt->{dont_retry},
102        'help'                  => \$opt->{help},
103        'verbose'               => \$opt->{help},
104        'version'               => \$opt->{version},
105        'ready'                 => \$opt->{ready},
106        'desc'                  => \$opt->{desc},
107        'v'                     => \$opt->{version});
108
109printf "%s v%s\n",$progname,$version;
110
111if ($opt->{version} || $opt->{desc} || $opt->{help} || $opt->{ready} ||
112    $opt->{output_file} eq "") {
113        printf "Augments XMLTV data with programme information from ".
114          "The Internet Movie Database (www.imdb.com)\n" if $opt->{desc};
115
116        printf "$progname is ready for operation.\n" if ($opt->{ready});
117
118        printf "No --output file specified.\n" if ($opt->{output_file} eq "");
119
120        if ($opt->{help} || $opt->{output_file} eq "") {
121                print<<EOF
122
123usage: $0 [options] {FILE(s)}
124
125Supported options include:
126  --min_duration={min} ignore programs under {min} duration (default: $opt->{min_duration} min)
127  --max_duration={min} ignore programs over {min} duration (default: $opt->{max_duration} min)
128  --categories={a,b..} 'categories' to lookup in IMDb (default: $opt->{categories})
129
130  --dont-augment-desc  don't add IMDb data to programme description,
131                       only update the data fields (default: do)
132
133  --cache_details_for={days}  cache programme details for {days} (def: $opt->{cache_details_for} days)
134  --cache_title_for={days}    cache IMDb URLs for {days} (def: $opt->{cache_title_for} days)
135
136  --lang={lang}        set language to {lang} (default: $opt->{lang})
137  --output={file}      send final XMLTV output to {file} (default: $opt->{output_file})
138  --debug              enable debugging
139  --fast               don't pause between requests to www.imdb.com
140
141  --cache-file={file}  local file to use as our data cache (default: $opt->{cache_file})
142  --no-cache           don't use local cache to reduce network load on www.imdb.com
143  --no-retry           don't retry failed HTTP requests
144
145EOF
146;
147        }
148        exit(0);
149}
150
151@ARGV = ('-') if not @ARGV;
152
153# go go go!
154
155&log(sprintf "started: cacne %s, %s%soutput %s",
156        ($opt->{no_cache} ? "disabled" : "enabled"),
157        ($opt->{fast} ? "fast-override, " : ""),
158        ($opt->{debug} ? "debug enabled, " : ""),
159        ($opt->{output_file}));
160
161&read_cache unless ($opt->{no_cache});
162
163foreach my $c (split(/,/,$opt->{categories})) {
164        $interested_categories{lc($c)}++;
165}
166
167my %writer_args = ( encoding => 'ISO-8859-1' );
168my $fh = new IO::File(">".$opt->{output_file}) ||
169  die "can't open $opt->{output_file} for writing: $!";
170$writer_args{OUTPUT} = $fh;
171
172my $writer = new XMLTV::Writer(%writer_args);
173$writer->start( {
174        'source-info-url' => "http://www.imdb.com",
175        'source-info-name' => "$progname $version",
176        'generator-info-name' => "$progname $version"} );
177
178foreach my $file (@ARGV) {
179        &log((sprintf "Parsing: %s",
180                ($file eq "-" ? "(from-stdin, hit control-D to finiah)" : $file)));
181        XMLTV::parsefiles_callback(\&encoding_cb, \&credits_cb,
182                \&channel_cb,\&programme_cb, $file);
183}
184
185$writer->end();
186&log("Finished parsing, output in $opt->{output_file}");
187
188&write_cache unless ($opt->{no_cache});
189
190&print_stats;
191exit(0);
192
193##############################################################################
194# populate cache
195
196sub read_cache
197{
198        if (-r $opt->{cache_file}) {
199                local (@ARGV, $/) = ($opt->{cache_file});
200                no warnings 'all'; eval <>; die "$@" if $@;
201        } else {
202                printf "WARNING: no cache $opt->{cache_file} - ".
203                  "have to fetch all details.\n";
204                &write_cache; # try to write to it - failure will cause an error & barf
205        }
206
207        #
208        # age our caches on startup
209        #
210        my $max_age;
211
212        # age our programme_id cache on startup
213        my $prog_id = $data_cache->{movie_id_lookup};
214        $max_age = time - ($opt->{cache_title_for} * 86400);
215        foreach my $key (keys %{$prog_id}) {
216                if ($data_cache->{movie_id_lookup}->{$key}->{last_fetched} < $max_age) {
217                        delete $data_cache->{movie_id_lookup}->{$key};
218                        $stats{removed_programme_id_from_cache}++
219                }
220        }
221
222        # age our programme cache on startup
223        my $prog = $data_cache->{movie_lookup};
224        $max_age = time - ($opt->{cache_title_for} * 86400);
225        foreach my $key (keys %{$prog}) {
226                if ($data_cache->{movie_lookup}->{$key}->{last_fetched} < $max_age) {
227                        delete $data_cache->{movie_lookup}->{$key};
228                        $stats{removed_programme_from_cache}++
229                }
230        }
231}
232
233##############################################################################
234# write out updated cache
235
236sub write_cache
237{
238        if (!(open(F,">$opt->{cache_file}"))) {
239                printf "ERROR: could not write cache file %s: %s\n",
240                  $opt->{cache_file}, $!;
241                printf "You need to fix this before you can use %s\n",
242                  $progname;
243                exit(1);
244        } else {
245                print F Data::Dumper->Dump([$data_cache], ["data_cache"]);
246                close F;
247        }
248}
249
250##############################################################################
251# logic to fetch a page via http
252#  retries up to 3 times to get a page with 5 second pauses inbetween
253
254sub get_url
255{
256        my ($url,$urltype,$status,$dontretry,$postvars) = @_;
257        my $response;
258        my $attempts = 0;
259        my ($raw, $page, $base);
260
261        my $request;
262
263        if ($urltype eq "GET") {
264                $request = HTTP::Request->new(GET => $url);
265        } elsif ($urltype eq "POST") {
266                $request = HTTP::Request->new(POST => $url);
267                $request->add_content($postvars);
268        }
269
270        $request->header('Accept-Encoding' => 'gzip');
271
272        &log($status);
273        for (1..3) {
274                $response = $ua->request($request);
275                last if ($response->is_success || $dontretry);
276
277                $stats{http_failed_requests}++;
278                $stats{slept_for} += 10;
279                $attempts++;
280                sleep 10;
281        }
282        if (!($response->is_success)) {
283                if ($dontretry == 0) {
284                        &log("aborting after $attempts attempts to fetch url $url");
285                }
286                return undef;
287        }
288
289        $stats{bytes_fetched} += do {use bytes; length($response->content)};
290        $stats{http_successful_requests}++;
291
292        unless ($opt->{fast}) {
293                my $sleeptimer = int(rand(12)) + 3;  # sleep 4 to 15 seconds
294                $stats{slept_for} += $sleeptimer;
295                sleep $sleeptimer;
296        }
297
298        if ($response->header('Content-Encoding') &&
299            $response->header('Content-Encoding') eq 'gzip') {
300                $stats{compressed_pages} += do {use bytes; length($response->content)};
301                $response->content(Compress::Zlib::memGunzip($response->content));
302        }
303        return $response->content;
304}
305
306##############################################################################
307
308sub log
309{
310        my ($entry) = @_;
311        printf "%s [%d] %s\n",$progname, time,$entry;
312}
313
314##############################################################################
315
316sub print_stats
317{
318        printf "STATS: %s v%s completed in %0.2f seconds",
319          $progname, $version, tv_interval($script_start_time);
320        foreach my $key (sort keys %stats) {
321                printf ", %d %s",$stats{$key},$key;
322        }
323        printf "\n";
324
325        if ($opt->{debug}) {
326                printf "Non-matching categories (and programme count):";
327                my $seen_num = 0;
328                foreach my $c (sort 
329                  { $other_categories{$b} <=> $other_categories{$a} } 
330                  keys %other_categories) {
331                        printf "%s %5d %-19s ",
332                          (($seen_num % 3 == 0) ? "\n" : ""),
333                          $other_categories{$c}, $c;
334                        $seen_num++;
335                }
336                printf "\n\n";
337        }
338}
339
340##############################################################################
341# descend a structure and clean up various things, including stripping
342# leading/trailing spaces in strings, translations of html stuff etc
343#   -- taken & modified from Michael 'Immir' Smith's excellent tv_grab_au
344
345my %amp;
346BEGIN { %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } ) }
347
348sub cleanup {
349        my $x = shift;
350        if    (ref $x eq "REF")   { cleanup($_) }
351        elsif (ref $x eq "HASH")  { cleanup(\$_) for values %$x }
352        elsif (ref $x eq "ARRAY") { cleanup(\$_) for @$x }
353        elsif (defined $$x) {
354                $$x =~ s/&(#(\d+)|(.*?));/ $2 ? chr($2) : $amp{$3}||' ' /eg;
355                # $$x =~ s/[^\x20-\x7f]/ /g;
356                $$x =~ s/(^\s+|\s+$)//g;
357        }
358}
359
360##############################################################################
361# turn a string into something that can be used on a URL line
362
363sub urlify
364{
365        my $str = shift;
366        $str =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
367        return $str;
368}
369
370##############################################################################
371# use the online IMDb "power search" at http://www.imdb/List to try to find _1_ match
372
373sub search_imdb_online
374{
375        my ($title, $post_fields) = @_;
376        $stats{imdb_lookup_added_cache_entry}++;
377        $data_cache->{movie_id_lookup}->{$post_fields}->{last_fetched} = time;
378
379        my $html_data = get_url("http://www.imdb.com/List","POST",
380          "  online IMDb search for '$title' with $post_fields",0,$post_fields);
381        if (!$html_data) {
382                $stats{failed_online_imdb_lookup}++;
383                &log("failed to search imdb movie data from http://www.imdb.com/List");
384                return;
385        }
386        my $tp = HTML::TokeParser->new(\$html_data);
387
388        my $urls_found = 0;
389        my @urls;
390
391        # see if we can find any <a href="/title/tt[0-9]+/">{name}</a> tags
392        while (my $token = $tp->get_tag("a")) {
393                my $url = $token->[1]{href};
394                if ($url =~ /\/title\/tt[0-9]+\//) {
395                        $urls_found++;
396                        push(@urls,$url);
397                }
398        }
399
400        # only insert into cache if we match exactly _1_ movie
401        if ($urls_found == 1) {
402                if ($urls[0] =~ /^http:/) {
403                        $data_cache->{movie_id_lookup}->{$post_fields}->{url} = 
404                          $urls[0];
405                } else {
406                        $data_cache->{movie_id_lookup}->{$post_fields}->{url} = 
407                          "http://www.imdb.com".$urls[0];
408                }
409                $stats{imdb_lookup_added_positive_cache_entry}++;
410        } else {
411                &log("    online search failed: wanted 1 match, got $urls_found matches.");
412                # negatively cache our failed lookup
413                $data_cache->{movie_id_lookup}->{$post_fields}->{url} = "-";
414                $data_cache->{movie_id_lookup}->{$post_fields}->{num_choices} =
415                  $urls_found;
416
417                my $num = 0;
418                foreach my $url (@urls) {
419                        $data_cache->{movie_id_lookup}->{$post_fields}->{choices}->[$num] = $url;
420                        $num++;
421                }
422        }
423}
424
425##############################################################################
426# simple parser for imdb returned data: covers most data
427
428sub imdb_scalar_parser
429{
430        my ($html_data, $target, $texttype, $targetb, $targetc, $targeta) = @_;
431
432        my $found = 0;
433        my $tp = HTML::TokeParser->new(\$html_data);
434
435        while (my $tag = $tp->get_tag('b')) {
436                if ($tp->get_text =~ /^$target/i) {
437                        $found = 1;
438                        last;
439                }
440        }
441        return undef if (!$found);
442
443        my $tag = $tp->get_tag($targeta) if (defined $targeta);
444
445        return ($tp->get_trimmed_text($targetb,$targetc)) if ($texttype eq "trimmed");
446        return ($tp->get_text($targetb,$targetc));
447}
448
449##############################################################################
450
451sub imdb_list_parser
452{
453        my ($html_data, $target, $target2, $v) = @_;
454
455        my $tp = HTML::TokeParser->new(\$html_data);
456        my @list;
457        my $found = 0;
458
459        while (my $tag = $tp->get_tag('b')) {
460                if ($tp->get_text =~ /^$target/i) {
461                        $found = 1;
462                        last;
463                }
464        }
465        return undef if (!$found);
466
467        while (my $tag = $tp->get_tag()) {
468                push (@list, $tp->get_text())
469                  if (($tag->[0] eq 'a') && ($tag->[1]{href} =~ /$target2/i));
470                last if ($tag->[0] eq 'br');
471        }
472
473        my $found_items = 0;
474        foreach my $item (@list) {
475                $$v->[$found_items] = $item;
476                $found_items++;
477        }
478}
479
480##############################################################################
481# perform a detailed movie lookup given a movie url
482# store what we find in our data cache
483
484sub get_imdb_movie_online
485{
486        my ($movie_title, $movie_url) = @_;
487        my $html_data = get_url($movie_url,"GET",
488          "  downloading online IMDb movie data for '$movie_title'",0);
489
490        if (!$html_data) {
491                $stats{failed_online_imdb_lookup}++;
492                &log("failed to fetch imdb movie data from $movie_url");
493                return;
494        }
495
496        $stats{imdb_movie_added_cache_entry}++;
497        $data_cache->{movie_lookup}->{$movie_url}->{last_fetched} = time;
498        my $tp;
499
500        #
501        # parse title and year
502        #
503        $tp = HTML::TokeParser->new(\$html_data);
504        my $title_token = $tp->get_tag('title');
505        my $title_text = $tp->get_text();
506        if ($title_text =~ /(.*?)\s+\((\d{4}).*?\)/) {
507                $data_cache->{movie_lookup}->{$movie_url}->{title} = $1;
508                $data_cache->{movie_lookup}->{$movie_url}->{year} = $2;
509        }
510
511        if (!defined $data_cache->{movie_lookup}->{$movie_url}->{title}) {
512                $stats{failed_online_imdb_title_parsing}++;
513                &log("failed to parse title within imdb movie data from $movie_url");
514                return;
515        }
516
517        #
518        # parse cover url
519        #
520        my $title = $data_cache->{movie_lookup}->{$movie_url}->{title};
521        $tp = HTML::TokeParser->new(\$html_data);
522        while (my $img_tag = $tp->get_tag('img')) {
523                next if (!$img_tag->[1]{alt});
524                last if ($img_tag->[1]{alt} =~ /^poster not submitted/i);
525                if ($img_tag->[1]{alt} =~ /^$title$/i) {
526                        $data_cache->{movie_lookup}->{$movie_url}->{cover} = $img_tag->[1]{src};
527                        last;
528                }
529        }
530
531        #
532        # parse directors
533        #
534        $tp = HTML::TokeParser->new(\$html_data);
535        while (my $tag = $tp->get_tag('b')) {
536                last if ($tp->get_text =~ /^directed/i);
537        }
538        while (my $tag = $tp->get_tag) {
539                my $text = $tp->get_text();
540                last if (($text =~ /writing/i) || ($tag->[0] =~ /\/td/i));
541                if ($tag->[0] eq 'a') {
542                        my $id = $tag->[1]{href};
543                        next if ($id !~ /^\/name\/nm/);
544                        $data_cache->{movie_lookup}->{$movie_url}->{directors}->{$text} = $id;
545                }
546        }
547
548        #
549        # parse writers
550        #
551        $tp = HTML::TokeParser->new(\$html_data);
552        while (my $tag = $tp->get_tag('b')) {
553                last if ($tp->get_text =~ /^writing/i);
554        }
555        while (my $tag = $tp->get_tag) {
556                my $text = $tp->get_text();
557                last if ($tag->[0] =~ /\/table/i);
558                if (($tag->[0] eq 'a') && ($text !~ /more/i)) {
559                        my $id = $tag->[1]{href};
560                        next if ($id !~ /^\/name\/nm/);
561                        $data_cache->{movie_lookup}->{$movie_url}->{writers}->{$text} = $id;
562                }
563        }
564
565        #
566        # parse cast
567        #
568        $tp = HTML::TokeParser->new(\$html_data);
569        while (my $tag = $tp->get_tag('b')) {
570                next unless ((exists $tag->[1]{class}) && ($tag->[1]{class} eq 'blackcatheader'));
571                last if ($tp->get_text =~ /^(cast overview|credited cast|(?:series )?complete credited cast)/i);
572        }
573        while (my $tag = $tp->get_tag('a')) {
574                last if ($tag->[1]{href} =~ /fullcredits/i);
575                if (($tag->[1]{href}) && ($tag->[1]{href} =~ /(?<!tinyhead)\/name\/nm(\d+?)\//)) {
576                        my $person = $tp->get_text;
577                        # ignore id:  my $id = $1;
578                        my $text = $tp->get_trimmed_text('a', '/tr');
579                        my $role = "";
580                        $role = $1 if ($text =~ /.*?\s+(.*)$/);
581                        $data_cache->{movie_lookup}->{$movie_url}->{cast}->{$person} = $role;
582                }
583        }
584
585        #
586        # parse countries, languages, genres using generic list parser
587        #
588        &imdb_list_parser($html_data,"country","countries",
589          \$data_cache->{movie_lookup}->{$movie_url}->{countries});
590        &imdb_list_parser($html_data,"language","language",
591          \$data_cache->{movie_lookup}->{$movie_url}->{languages});
592        &imdb_list_parser($html_data,"genre","genre",
593          \$data_cache->{movie_lookup}->{$movie_url}->{genres});
594
595        #
596        # parse tagline, plot, rating, runtime, aka, trivia, goofs,
597        # awards and summary using generic scalar handler
598        #
599        $data_cache->{movie_lookup}->{$movie_url}->{tagline} =
600          &imdb_scalar_parser($html_data,"tagline","trimmed","b","a");
601        $data_cache->{movie_lookup}->{$movie_url}->{plot} =
602          &imdb_scalar_parser($html_data,"plot","trimmed","b","a");
603        $data_cache->{movie_lookup}->{$movie_url}->{rating} =
604          &imdb_scalar_parser($html_data,"user rating","trimmed","b","a","b");
605        $data_cache->{movie_lookup}->{$movie_url}->{runtime} =
606          &imdb_scalar_parser($html_data,"runtime","trimmed","b","br");
607        $data_cache->{movie_lookup}->{$movie_url}->{aka} =
608          &imdb_scalar_parser($html_data,"(aka|also known as)","trimmed","b","b");
609        $data_cache->{movie_lookup}->{$movie_url}->{trivia} =
610          &imdb_scalar_parser($html_data,"trivia","trimmed","b","a");
611        $data_cache->{movie_lookup}->{$movie_url}->{goofs} =
612          &imdb_scalar_parser($html_data,"goofs","trimmed","b","a");
613        $data_cache->{movie_lookup}->{$movie_url}->{awards} =
614          &imdb_scalar_parser($html_data,"awards","trimmed","b","a");
615        $data_cache->{movie_lookup}->{$movie_url}->{summary} =
616          &imdb_scalar_parser($html_data,"plot summary","","b","a");
617
618        #
619        # certifications
620        #
621        $tp = HTML::TokeParser->new(\$html_data);
622        while (my $tag = $tp->get_tag('b')) {
623                last if ($tp->get_text =~ /^certification/i);
624        }
625        while (my $tag = $tp->get_tag()) {
626                if (($tag->[0] eq "a") && ($tag->[1]{href} =~ /certificates/i)) {
627                        my($country, $range) = split(/:/, $tp->get_text);
628                        $data_cache->{movie_lookup}->{$movie_url}->{certifications}->{$country} = $range;
629                }
630                last if ($tag->[0] =~ /\/td/i);
631        }
632
633        # don't yet pick the following up: do we need to?
634        #  official_sites
635        #  full plot
636}
637
638##############################################################################
639
640sub encoding_cb( $ )
641{
642        my $e = shift;
643        # printf "got encoding ".Dumper($e);
644}
645       
646##############################################################################
647
648sub credits_cb( $ )
649{
650        my $c = shift;
651        # printf "got credits ".Dumper($c);
652}
653
654##############################################################################
655
656sub channel_cb( $ )
657{
658        my $c = shift;
659        # printf "got channel ".Dumper($c);
660        $writer->write_channel($c);
661}
662
663##############################################################################
664
665sub programme_cb( $ )
666{
667        my $prog=shift;
668
669        my $movie_title = $prog->{title}->[0]->[0]
670          if (($prog->{title}) && ($prog->{title}->[0]) &&
671              ($prog->{title}->[0]->[0]));
672        my $movie_categories = $prog->{category}->[0]
673           if ($prog->{category} && $prog->{category}->[0]);
674        my $movie_year = $prog->{date} if ($prog->{date});
675
676        # print "got programme ".Dumper($prog);
677
678        #
679        # only lookup if it is within one of our categories we care about
680        #
681        my $interested = "";
682        foreach my $c (@$movie_categories) {
683                if ($c && $c ne "") {
684                        if ($interested_categories{lc($c)}) {
685                                $interested .= "$c ";
686                        } else {
687                                $other_categories{$c}++;
688                        }
689                }
690        }
691
692        if ($interested eq "") {
693                $stats{excluded_didnt_match_categories}++;
694                goto END;
695        }
696
697        #
698        # only lookup if  min_duration < prog_duration > min_duration
699        #
700        my $t1 = $xmltv_strptime->parse_datetime($prog->{start});
701        my $t2 = $xmltv_strptime->parse_datetime($prog->{stop});
702        if ((!$t1) || (!$t2)) {
703                $stats{excluded_couldnt_parse_time}++;
704                goto END;
705        }
706        my $prog_duration = (($t2->epoch - $t1->epoch) / 60);
707        if ($prog_duration < $opt->{min_duration}) {
708                $stats{excluded_prog_too_short}++;
709                goto END;
710        }
711        if ($prog_duration > $opt->{max_duration}) {
712                $stats{excluded_prog_too_long}++;
713                goto END;
714        }
715
716        $stats{included_for_imdb_lookup}++;
717
718        #
719        # find movie url
720        # (either via a cached previous search or via IMDb "power search")
721        #
722
723        my $post_fields = "words=".urlify($movie_title);
724        $post_fields .= "&countries=".urlify($prog->{country}->[0][0])
725          if ((defined $prog->{country}) && (defined $prog->{country}->[0][0]));
726        $post_fields .= "&year=".urlify($prog->{date})
727          if ((defined $prog->{date}) && ($prog->{date} > 0));
728        $post_fields .= "&language=".urlify($prog->{language}->[0])
729          if ((defined $prog->{language}) && (defined $prog->{language}->[0]));
730        # $post_fields .= "&exact=y";
731        # featuring=<cast/crew>
732        my $orig_post_fields = $post_fields;
733
734        if (defined $data_cache->{movie_id_lookup}->{$post_fields}) {
735                $stats{imdb_lookup_used_cache_entry}++;
736                &log("used (cache) lookup \"$movie_title\" duration $prog_duration, matching categories: $interested");
737        } else {
738                &log("looking up \"$movie_title\" duration $prog_duration, matching categories: $interested");
739                &search_imdb_online($movie_title,$post_fields);
740
741                goto END
742                  if (!defined $data_cache->{movie_id_lookup}->{$post_fields}->{url});
743
744                if (($data_cache->{movie_id_lookup}->{$post_fields}->{url} eq "-") &&
745                    ($data_cache->{movie_id_lookup}->{$post_fields}->{num_choices} == 0)) {
746                        # lookup failed with no choices.  did we try it
747                        # with a year or language?  if so, try again without those
748                        if (($post_fields =~ /^(.*)&year=/) || 
749                            ($post_fields =~ /^(.*)&language=/)) {
750                                my $orig_post_fields = $post_fields;
751                                $post_fields = $1;
752                                &search_imdb_online($movie_title,$post_fields);
753
754                                if (defined $data_cache->{movie_id_lookup}->{$post_fields}) {
755                                        # fixup our original entry to use this one
756                                        $data_cache->{movie_id_lookup}->{$orig_post_fields}->{url} = $data_cache->{movie_id_lookup}->{$post_fields}->{url};
757                                        $stats{imdb_lookup_without_year_language_success}++ 
758                                          if ($data_cache->{movie_id_lookup}->{$orig_post_fields}->{url} ne "-");
759                                }
760                        }
761                }
762                goto END
763                  if (!defined $data_cache->{movie_id_lookup}->{$post_fields});
764        }
765
766        $data_cache->{movie_id_lookup}->{$post_fields}->{last_lookup} = time;
767        $data_cache->{movie_id_lookup}->{$post_fields}->{num_lookups}++;
768        my $movie_url = $data_cache->{movie_id_lookup}->{$post_fields}->{url};
769
770        # no match or negative cache match - bail out
771        goto END if ((!defined $movie_url) || ($movie_url eq "-"));
772
773        #
774        # lookup movie details
775        # (either via previously cached entry or via an online IMDb lookup)
776        #
777
778        if (defined $data_cache->{movie_lookup}->{$movie_url}) {
779                $stats{imdb_movie_used_cache_entry}++;
780        } else {
781                $stats{imdb_movie_added_cache_entry}++;
782                &get_imdb_movie_online($movie_title,$movie_url);
783                goto END if (!defined $data_cache->{movie_lookup}->{$movie_url});
784        }
785
786
787        #
788        # augment data
789        #
790
791        $data_cache->{movie_lookup}->{$movie_url}->{last_lookup} = time;
792        $data_cache->{movie_lookup}->{$movie_url}->{num_lookups}++;
793        my $imdb = $data_cache->{movie_lookup}->{$movie_url};
794        $stats{added_imdb_data}++;
795
796        unless ($opt->{dont_augment_desc}) {
797                my $imdb_desc = "IMDb augmented data:\n";
798                $imdb_desc .= sprintf " Title: %s",$imdb->{title};
799                $imdb_desc .= sprintf "  (%s)",$imdb->{year}
800                  if (($imdb->{year}) && ($imdb->{year} > 0));
801
802                $imdb_desc .= sprintf "\n Rating: %s",$imdb->{rating}
803                  if (defined $imdb->{rating} && $imdb->{rating} ne "");
804                $imdb_desc .= sprintf "\n aka: %s",$imdb->{aka}
805                  if (defined $imdb->{aka} && $imdb->{aka} ne "");
806                $imdb_desc .= sprintf "\n Tagline: %s",$imdb->{tagline}
807                  if (defined $imdb->{tagline} && $imdb->{tagline} ne "");
808                $imdb_desc .= sprintf "\n Summary: %s",$imdb->{summary}
809                  if (defined $imdb->{summary} && $imdb->{summary} ne "");
810                $imdb_desc .= sprintf "\n Plot: %s",$imdb->{plot}
811                  if (defined $imdb->{plot} && $imdb->{plot} ne "");
812
813                my $num = 0;
814                foreach my $c (sort keys %{($imdb->{certifications})}) {
815                        $imdb_desc .= sprintf "%s%s (%s)",
816                          ($num > 0 ? ", " : "\nCertifications: "),
817                          $imdb->{certifications}->{$c}, $c;
818                        $num++;
819                }
820
821                $num = 0;
822                foreach my $c (sort keys %{($imdb->{cast})}) {
823                        $imdb_desc .= sprintf "%s%s%s",
824                          ($num > 0 ? ", " : "\n Cast: "), 
825                          $c, 
826                          ($imdb->{cast}->{$c} ? " as $imdb->{cast}->{$c}" : "");
827                        $num++;
828                }
829
830                $imdb_desc .= sprintf "\n Directors: %s",
831                  join(", ",keys %{($imdb->{directors})})
832                  if ($imdb->{directors});
833                $imdb_desc .= sprintf "\n Writers: %s",
834                  join(", ",keys %{($imdb->{writers})})
835                  if ($imdb->{writers});
836
837                $imdb_desc .= sprintf "\n Awards: %s",$imdb->{awards}
838                  if (defined $imdb->{awards} && $imdb->{awards} ne "");
839                $imdb_desc .= sprintf "\n Runtime: %s",$imdb->{runtime}
840                  if (defined $imdb->{runtime} && $imdb->{runtime} ne "");
841                $imdb_desc .= sprintf "\n Countries: %s",
842                  join(", ",@{$imdb->{countries}})
843                  if (defined $imdb->{countries});
844                $imdb_desc .= sprintf "\n Languages: %s",
845                  join(", ",@{$imdb->{languages}})
846                  if (defined $imdb->{languages});;
847                $imdb_desc .= sprintf "\n Genres: %s",
848                  join(", ",@{$imdb->{genres}})
849                  if (defined $imdb->{genres});;
850
851                $imdb_desc .= sprintf "\n Trivia: %s",$imdb->{trivia}
852                  if (defined $imdb->{trivia} && $imdb->{trivia} ne "");
853                $imdb_desc .= sprintf "\n Goofs: %s",$imdb->{goofs}
854                  if (defined $imdb->{goofs} && $imdb->{goofs} ne "");
855                $imdb_desc .= sprintf "\n Cover: %s",$imdb->{cover}
856                  if (defined $imdb->{cover} && $imdb->{cover} ne "");
857
858                $prog->{desc}->[0]->[0] = "" if (!defined $prog->{desc}->[0]->[0]);
859                $prog->{desc}->[0]->[0] .= "\n\n" if ($prog->{desc}->[0]->[0] ne "");
860                $prog->{desc}->[0]->[0] .= $imdb_desc;
861        }
862
863        $prog->{date} = $imdb->{year} if ($imdb->{year});
864        # $prog->{length} = $imdb->{runtime} if ($imdb->{runtime});
865
866        my $found_url = 0, my $found_cover = 0;
867        if (defined $prog->{url}) {
868                foreach my $url (@{($prog->{url})}) {
869                        $found_url++ if (lc($url) eq lc($movie_url));
870                        $found_cover++ if (($imdb->{cover}) && (lc($url) eq lc($imdb->{cover})));
871                }
872        }
873        push (@{($prog->{url})},$movie_url) if (!$found_url);
874        push (@{($prog->{url})},$imdb->{cover}) if (($imdb->{cover}) && (!$found_cover));
875
876        if ($imdb->{rating}) {
877                my ($rating,$votes) = split(/ /,$imdb->{rating});
878                push (@{($prog->{'star-rating'})},$rating);
879        }
880
881        if ($imdb->{languages}) {
882                foreach my $lang (@{($imdb->{languages})}) {
883                        my $found_lang = 0;
884                        if (defined $prog->{language}) {
885                                foreach my $prog_lang (@{($prog->{language})}) {
886                                        $found_lang++ if (lc($prog_lang) eq lc($lang));
887                                }
888                        }
889                        push (@{($prog->{language})},$lang) if (!$found_lang);
890                }
891        }
892        # don't fill in XMLTV orig-language - mythtv ignores it
893
894        if (($imdb->{plot}) && ((!defined $prog->{desc}->[0]->[0]) ||
895            ($prog->{desc}->[0]->[0] eq ""))) {
896                $prog->{desc}->[0]->[0] = "";
897                $prog->{desc}->[0]->[0] .= $imdb->{tagline}."\n" if ($imdb->{tagline});
898                $prog->{desc}->[0]->[0] .= $imdb->{plot};
899        }
900
901        foreach my $genre (@{($imdb->{genres})}) {
902                my $found_genre = 0;
903                foreach my $category (@{($prog->{category})}) {
904                        $found_genre++ if (lc($genre) eq lc($category->[0]));
905                }
906                push(@{($prog->{category})},[$genre]) if (!$found_genre);
907        }
908
909        foreach my $country (@{($imdb->{countries})}) {
910                my $found_country = 0;
911                foreach my $c (@{($prog->{country})}) {
912                        $found_country++ if (lc($country) eq lc($c->[0]));
913                }
914                push(@{($prog->{country})},[$country]) if (!$found_country);
915        }
916
917        foreach my $cert (keys %{($imdb->{certifications})}) {
918                my $found_cert = 0;
919                foreach my $c (@{($prog->{rating})}) {
920                        $found_cert++ if (lc($cert) eq lc($c->[0]));
921                }
922                push(@{($prog->{rating})},[$cert,$imdb->{certifications}->{$cert},undef]) if (!$found_cert);
923        }
924
925        foreach my $cast (keys %{($imdb->{cast})}) {
926                my $found_cast = 0;
927                if ((defined $prog->{credits}) && (defined $prog->{credits}->{actor})) {
928                        foreach my $a (@{($prog->{credits}->{actor})}) {
929                                $found_cast++ if (lc($cast) eq lc($a));
930                        }
931                }
932                push(@{($prog->{credits}->{actor})},$cast) if (!$found_cast);
933        }
934
935        foreach my $cast (keys %{($imdb->{writers})}) {
936                my $found_cast = 0;
937                if ((defined $prog->{credits}) && (defined $prog->{credits}->{writer})) {
938                        foreach my $w (@{($prog->{credits}->{writer})}) {
939                                $found_cast++ if (lc($cast) eq lc($w));
940                        }
941                }
942                push(@{($prog->{credits}->{writer})},$cast) if (!$found_cast);
943        }
944
945        foreach my $cast (keys %{($imdb->{directors})}) {
946                my $found_cast = 0;
947                if ((defined $prog->{credits}) && (defined $prog->{credits}->{director})) {
948                        foreach my $d (@{($prog->{credits}->{director})}) {
949                                $found_cast++ if (lc($cast) eq lc($d));
950                        }
951                }
952                push(@{($prog->{credits}->{director})},$cast) if (!$found_cast);
953        }
954
955        if (defined $imdb->{cover}) {
956                $found_cover = 0;
957                if (defined $prog->{icon}) {
958                        foreach my $cover (@{($prog->{icon})}) {
959                                $found_cover++ if (lc($cover->{src}) eq lc($imdb->{cover}));
960                        }
961                }
962                $prog->{icon}->[0]->{src} = $imdb->{cover} if (!$found_cover);
963        }
964
965        &cleanup($prog);
966        #print "prog now ".Dumper($prog);
967END:
968        $writer->write_programme($prog);
969}
970
971##############################################################################
Note: See TracBrowser for help on using the browser.