source: trunk/grabbers/news

Last change on this file was 1463, checked in by mbarry, 5 years ago

news: Die more quickly due to network errors.

  • Property svn:executable set to *
File size: 25.4 KB
Line 
1#!/usr/bin/env perl
2#
3# "News"
4#
5
6my $version  = '3.2';
7
8use strict;
9use warnings;
10
11use Getopt::Long;
12use Date::Manip;
13use File::Path;
14use File::Basename;
15use Data::Dumper;
16use HTML::TreeBuilder;
17use POSIX;
18use Encode;
19
20use XMLTV;
21use XMLTV::Ask;
22
23use Shepherd::Common;
24
25# ---------------------------------------------------------------------------
26# --- Global Variables
27
28my $progname = "News";
29my $lang = "en";
30
31my $DATASOURCE             = "http://guides.news.com.au";
32my $DATASOURCE_SETUP       = "$DATASOURCE/television/profile/";
33my $DATASOURCE_CHANNEL_LIST= "$DATASOURCE/television/profile/ajax.cfm?";
34my $DATASOURCE_GUIDE       = "$DATASOURCE/television/guide/";
35my $DATASOURCE_GUIDE_TODAY = "$DATASOURCE/television/guide/?action=restofday";
36my $DATASOURCE_DETAIL      = "$DATASOURCE/television/guide/";
37
38my $runtime = time();
39my $laststats = $runtime;
40my $firstfetch;
41my $debug = 0;
42my $opt = { };
43my $channels;
44my $opt_channels;
45my $gaps;
46my %chanid;
47my $cached;
48my $lastpids;
49my $precache;
50my $ua;
51my %shows;
52my $numshows;
53my %stats;
54my $dcount;
55
56# ---------------------------------------------------------------------------
57# --- Setup
58
59print "$progname $version\n";
60
61$| = 1;
62
63Getopt::Long::Configure(qw/pass_through/);
64
65get_command_line_options();
66
67print "Ignoring --config-file option.\n" if ($opt->{'config-file'});
68
69exit 0 if ($opt->{version});
70
71help() if ($opt->{help});
72
73set_defaults();
74read_channels_file();
75unless ($channels)
76{
77    print "ERROR: No channels requested. Please use --channels_file.\n";
78    exit 2;
79}
80
81read_gaps_file();
82
83if ($opt->{test})
84{
85  print "Test mode: won't write XML or cache.\n";
86  $opt->{output} = undef;
87}
88       
89build_channel_map();
90
91if ($opt->{'show-channels'})
92{
93  show_channels();
94  exit 0;
95}
96
97show_config();
98exit 0 if ($opt->{'show-config'});
99
100restore_cache();
101
102if ($opt->{'dump-cache'})
103{
104  dump_cache();
105  exit 0;
106}
107
108initialize_stats();
109
110# ---------------------------------------------------------------------------
111# --- Go!
112
113get_guide_data();
114
115get_details_data();
116
117save_cache() if ($numshows);
118
119write_xml();
120
121print stats(1);
122
123Shepherd::Common::print_stats($progname, $version, $runtime, %stats);
124
125exit 0;
126
127# ---------------------------------------------------------------------------
128# --- Stop!
129
130
131#
132# Subs!
133#
134
135sub get_guide_data
136{
137  print "Grabbing data for days " . ($opt->{offset} + 1) .
138        " - $opt->{days}" . 
139        ($opt->{output} ? " into " . $opt->{output} : '') .
140        ".\n";
141
142  refresh_ua() unless ($ua);
143
144  my ($guidedata, $date);
145
146  for my $day ($opt->{offset} .. $opt->{days} - 1)
147  {
148    $date = Ymd(DateCalc("now", "+ $day days"));
149    print "Day $day.\n" if ($debug);
150
151    if (!$day)
152    {
153      # Special bandwidth-saving URL for day 0
154
155      my $cacheid = $DATASOURCE_GUIDE_TODAY;
156      if ($cached->{$cacheid}) {
157        $guidedata = $cached->{$cacheid}->{data};
158      } else {
159        $guidedata = get_page($DATASOURCE_GUIDE_TODAY);
160        if ($guidedata) {
161          $cached->{$cacheid}->{data} = $guidedata;
162          $cached->{$cacheid}->{stop} = POSIX::strftime("%Y%m%d%H%M%S", localtime($runtime));
163          $cached->{$cacheid}->{title}[0][0] = $cacheid;
164        }
165      }
166      parse_guide($guidedata, $date) if ($guidedata);
167    }
168    else
169    {
170      # Need to grab day in 6-hour chunks.
171      my $rid = $opt->{region};
172      for (1 .. 4)
173      {
174        my $cacheid = "${DATASOURCE_GUIDE}?r=${rid}&d=${date}&p=$_";
175        if ($cached->{$cacheid}) {
176          $guidedata = $cached->{$cacheid}->{data};
177        } else {
178          $guidedata = get_page(url => $DATASOURCE_GUIDE,
179                        postvars =>
180                        [ 'action' => "grid",
181                          'region_id' => $rid,
182                          'date' => $date,
183                          'period' => $_,
184                          'submit' => 'submit'
185                        ]);
186          if ($guidedata) {
187            $cached->{$cacheid}->{data} = $guidedata;
188            $cached->{$cacheid}->{stop} = POSIX::strftime("%Y%m%d%H%M%S", localtime($runtime));
189            $cached->{$cacheid}->{title}[0][0] = $cacheid;
190          }
191        }
192        parse_guide($guidedata, $date, $_) if ($guidedata);
193      }
194    }
195  }
196  $numshows = scalar(keys %$precache);
197  print "Shows found: $numshows.\n";
198}
199
200#
201# This sub fills up %shows with details, either from the cache or
202# from the web.
203#
204sub get_details_data
205{
206  $firstfetch = time();
207  my $show;
208  foreach my $pid (keys %$precache)
209  {
210    if ($cached->{$pid})
211    {
212      print "Cached: " . $cached->{$pid}->{title}[0][0] . ".\n" if ($debug);
213      if (verify_cache($pid))
214      {
215        $shows{$pid} = $cached->{$pid};
216        $stats{cache_hits}++;
217      }
218      else
219      {
220        print "Cache has stale data for \"" . $cached->{$pid}->{title}[0][0] .
221              "\": fetching fresh data.\n" if ($debug);
222        $stats{cache_changes}++;
223      }
224    }
225    unless ($shows{$pid})
226    {
227      $show = download_show($pid);
228      if ($show)
229      {
230        $show->{channel}=$precache->{$pid}->{channel}; # this is a fix for undistinguished channels
231        $shows{$pid} = $show;
232        $cached->{$pid} = $show;
233        $stats{detail_pages}++;
234      }
235      else
236      {
237        print "Failed to parse show $pid.\n";
238      }
239    }
240    if ($opt->{stats} and time() - $laststats >= $opt->{stats})
241    {
242      print stats();
243    }
244  }
245}
246
247sub verify_cache
248{
249  my $pid = shift;
250
251  my @c = ( 
252            [ 
253              'Title', 
254              $cached->{$pid}->{title}[0][0], 
255              $precache->{$pid}->{title} 
256            ],
257            [ 
258              'Start time',
259              $cached->{$pid}->{start},
260              $precache->{$pid}->{start}
261            ],
262            [
263              'Stop time',
264              $cached->{$pid}->{stop},
265              $precache->{$pid}->{stop}
266            ],
267            [
268              'Subtitle',
269              ($cached->{$pid}->{'sub-title'} ? $cached->{$pid}->{'sub-title'}[0][0] : undef),
270              $precache->{$pid}->{'sub-title'}
271            ]
272          ); 
273  foreach my $cmp (@c)
274  {
275    return 0 unless compare_caches($cmp->[0], $cmp->[1], $cmp->[2]);
276  }
277  return 1;
278}
279
280sub compare_caches
281{
282  my ($name, $arg1, $arg2) = @_;
283
284  # Special case for subtitles.
285  return 1 if ($name eq 'Subtitle' and !$arg2);
286  # Special case for no precache stop.
287  return 1 if ($name eq 'Stop time' and !$arg2);
288 
289  $arg1 = '--missing--' unless $arg1;
290  $arg2 = '--missing--' unless $arg2;
291
292  return 1 if $arg1 eq $arg2;
293
294  print "$name mismatch: \"$arg1\" vs \"$arg2\".\n" if ($debug);
295  return 0;
296}
297
298sub download_show
299{
300  my ($pid, $recurse_count) = @_;
301
302  $recurse_count ||= 0;
303  return undef if ($recurse_count > 2);
304 
305  $dcount++;
306#  refresh_ua() if ($dcount % 20 == 0); # don't wait for error page
307
308  my $result;
309
310  print "Downloading # $pid.\n" if ($debug);
311  my $detailsdata = get_page($DATASOURCE_DETAIL .
312                      '?action=event&event_id=' . $pid .
313                      '&refresh=&region_id=' . $opt->{region});
314  $result = parse_details($detailsdata) if ($detailsdata);
315  unless ($detailsdata and $result)
316  {
317    refresh_ua();
318    return download_show($pid, $recurse_count+1);
319  }
320
321  return $result;
322}
323
324sub save_cache
325{
326  return if ($opt->{test} or $opt->{nowrite_cache});
327  print "Saving cache.\n";
328  Shepherd::Common::write_cache($opt->{'cache-file'}, $cached);
329}
330
331sub write_xml
332{
333  return if ($opt->{test});
334 
335  my %writer_args = ( encoding => 'ISO-8859-1' );
336
337  print "Writing XML.\n";
338
339  if ($opt->{output}) 
340  {
341    my $fh = new IO::File(">" . $opt->{output}) 
342             or die "Can't open " . $opt->{output} . ": $!";
343    $writer_args{OUTPUT} = $fh;
344  }
345
346  my $writer = new XMLTV::Writer(%writer_args);
347
348  $writer->start
349    ( { 'source-info-url'    => $DATASOURCE,
350        'source-info-name'   => "Datasource Name",
351        'generator-info-name' => "$progname $version"} );
352
353  for my $channel (sort keys %$channels) 
354  {
355    my $chanid = $chanid{lc $channel};
356    $writer->write_channel( { 'display-name' => [[$channel, $lang]],
357                              'id' => $chanid } );
358  } 
359
360  foreach my $pid (keys %shows)
361  {
362    print "- " . $shows{$pid}->{'title'}[0][0] . "\n" if ($debug);
363    $writer->write_programme($shows{$pid});
364  }
365
366  $writer->end();
367}
368
369sub refresh_ua
370{
371  print "Refreshing UA.\n" if ($debug);
372 
373  if ($ua)
374  {
375     print stats() if ($debug and $opt->{stats});
376     print "Sleeping...\n" if ($debug);
377     sleep_for(2 + int(rand(10)));
378  }
379
380  $ua = Shepherd::Common::setup_ua( cookie_jar => 1 );
381
382  # Get list of 'venue IDs', which are the source's
383  # internal channel ID numbers.
384
385  print "Looking for venue IDs...\n" if ($debug);
386
387  my $html = &get_page(url => $DATASOURCE_CHANNEL_LIST, retries => 4, postvars => [ 'action' => 'channels', 'region_id' => $opt->{'region'}, 'showsub' => '0' ]);
388  unless ($html)
389  {
390      print "Unable to fetch channel list. Exiting.\n";
391      die "Unable to fetch channel list (no network?)";
392  }
393
394  my @venue_ids;
395  my $tree = HTML::TreeBuilder->new_from_content($html);
396  my %clist = %$channels;
397  foreach my $tag ($tree->look_down('_tag' => 'label'))
398  {
399      my $channel_name = &strip_whitespace($tag->as_text);
400      if ($channels->{$channel_name})
401      {
402          # We want this channel
403          $tag->as_HTML =~ /venue_id__(\d+)/;
404          push @venue_ids, $1;
405
406          delete $clist{$channel_name};
407      }
408  }
409
410  unless (@venue_ids)
411  {
412      print "No wanted channels found? Exiting.\n";
413      die "No wanted channels found.";
414  }
415
416  if (keys %clist)
417  {
418      print "\n!!! WARNING! Could not find venue IDs for channels: " . join(', ', keys %clist) . ".\n\n";
419  }
420
421  print "Venue IDs: " . join(',', @venue_ids) . "\n" if ($debug);
422
423  # Set region/service cookie
424  my $postvars = [ 'action' => 'saveProfile', 'fta_region_id' => $opt->{'region'} ];
425  foreach (@venue_ids)
426  {
427      push @$postvars, 'venue_id', $_;
428  }
429
430  unless (&get_page(url => $DATASOURCE_SETUP, retries => 4, postvars => $postvars ))
431  {
432      print "Unable to fetch profile page. No network? Exiting.\n";
433      print stats(1);
434      die "Unable to fetch front page (no network?)";
435  }
436
437  $dcount = 0;
438}
439
440sub restore_cache
441{
442  unless ($opt->{'ignore-cache'} or $opt->{'rebuild-cache'})
443  {
444    $cached = Shepherd::Common::read_cache(\$opt->{'cache-file'});
445  }
446  if ($cached)
447  {
448    print "Retrieved " . keys(%$cached) . " cached items from file.\n";
449    clean_cache();
450  }
451  else
452  {
453    $cached = { };
454    print "Not using cache.\n";
455  }
456}
457
458sub clean_cache
459{
460    my $r = expand_date(localtime(time() - 3*3600)."");
461    my $c = 0;
462    print "Removing cache items that finish earlier than $r.\n" if ($debug);
463    foreach (keys %$cached)
464    {
465        if (Date_Cmp($r, $cached->{$_}->{stop}) == 1)
466        {
467            print "Removing $cached->{$_}->{title}[0][0].\n" if ($debug);
468            delete $cached->{$_};
469            $c++;
470        }
471    }
472    print "Removed $c stale items from cache.\n";
473}
474
475sub dump_cache
476{
477  print "Cache: " . Dumper($cached) . "\n";
478}
479
480sub initialize_stats
481{
482    %stats = ( );
483    foreach (qw( successful_requests failed_requests slept_for bytes detail_pages cache_hits cache_changes failed_parses ))
484    {
485        $stats{$_} = 0;
486    }
487}
488
489sub stats
490{
491  my $finished = shift;
492
493  my $t = time() - $runtime;
494 
495  my $ret = "$progname $version " . 
496            ($finished ? "finished" : "in progress") .
497            ":\n";
498  $ret .= sprintf
499        " %d shows grabbed\n" .
500        " %d downloads, including %d detail pages (%d KB)\n" .
501        " %d cache hits, %d changes from cache\n" .
502        " %d failed downloads, %d failed parses\n",
503        scalar(keys %shows),
504        $stats{successful_requests}, $stats{detail_pages}, ($stats{bytes}/1024),
505        $stats{cache_hits}, $stats{cache_changes},
506        $stats{failed_requests}, $stats{failed_parses};
507  $ret .= sprintf " Time elapsed: %s (spent sleeping: %s)\n",
508                  timestats($t), timestats($stats{slept_for});
509  unless ($finished or !$stats{detail_pages})
510  {
511    $t = ((((time() - $firstfetch) * ($numshows - $stats{cache_hits})) / $stats{detail_pages})) - $t;
512   
513    $ret .= " Estimated time remaining: " . timestats($t) . "\n";
514  }
515  $laststats = time();
516  return $ret;
517}
518
519sub timestats
520{
521  my $t = shift;
522
523  my $ret = '';
524  if ($t >= 3600)
525  {
526    $ret .= sprintf("%d hr ", $t / 3600);
527    $t = $t % 3600;
528  }
529  $ret .= sprintf("%d min %d sec", $t / 60, $t % 60);
530  return $ret;
531}
532
533sub get_page
534{
535  my $ret = Shepherd::Common::get_url(@_);
536  if ($stats{successful_requests} and $stats{failed_requests} > $stats{successful_requests})
537  {
538      printf "Exiting: %d failed network requests vs %d successes.\n",
539             $stats{failed_requests}, $stats{successful_requests};
540      print stats(1);
541      die "Too many network failures.";
542  }
543  $ret =~ s/ / /g if ($ret);
544  return $ret;
545}
546
547sub parse_guide
548{
549  my ($guidedata, $date, $phase) = @_;
550
551  print "Parsing guide page.\n" if ($debug);
552
553  $phase ||= 0;
554
555  $guidedata = Encode::decode_utf8($guidedata);
556
557  my $tree = HTML::TreeBuilder->new_from_content($guidedata);
558  my $curchan = '';
559  my @channels_seen;
560  my ($pid, $block, $line, $link, $title);
561  my $c = 0;
562  foreach my $tag ($tree->look_down('_tag' => 'td', 'class' => 'venue'))
563  {
564    # Some screens repeat channel name
565    next if ($tag->left);
566
567    $c++;
568    my $channame = $tag->as_text();
569    my $curchan = translate_channel_name($tag->as_text(), scalar(grep($_ eq $channame, @channels_seen)));
570    push @channels_seen, $channame;
571    if (!$channels->{$curchan})
572    {
573      print "Ignoring unsubscribed channel $curchan.\n" if ($debug);
574      next;
575    }
576    print "Channel: $curchan.\n" if ($debug);
577    $block = $tag->parent();
578    foreach $line ($block->look_down('_tag' => 'td', 'class' => undef))
579    {
580      my ($pid, $title, $start, $pextra);
581
582      my $linetext = $line->as_text();
583
584      foreach my $href ($line->look_down('_tag' => 'a'))
585      {
586          $title = strip_whitespace($href->as_text());
587          unless (HTML::Entities::decode($href->as_HTML()) =~ /event_popup\('(\d+)/)
588          {
589              &bad_parse("No pid found in guide data block");
590              next;
591          }
592          $pid = $1;
593          if ($linetext =~ /^(.*?)\Q$title\E(.*)/)
594          {
595              $start = strip_whitespace($1);
596              $linetext = $2;
597              if ($phase and $phase == 1 and $start =~ /pm/)
598              {
599                  $start = expand_date($start ." ". Ymd(DateCalc($date, "- 1 day")));
600              }
601              else
602              {
603                  $start = expand_date("$start $date");
604              }
605              if ($start)
606              {
607                  &addme($pid, $title, $start, undef, $curchan);
608                  next;
609              }
610          }
611          &bad_parse("Failed to match start time out of " . $href->as_HTML);
612      }
613    }
614  }
615  bad_parse("No shows found on guide page ($date phase $phase)") unless ($c);
616  $tree->delete();
617}
618
619sub addme
620{
621  my ($pid, $title, $start, $pextra, $curchan) = @_;
622 
623  if ($precache->{$pid})
624  {
625    print "Duplicate: $title ($pid) $start.\n" if ($debug);
626  }
627  else
628  {
629    print "New: $title " . ($pextra ? "($pextra) " : '') . 
630          "($pid) $start\n" if ($debug);
631    if ($pextra and $pextra =~ /\(\d\d\d\d\)/)
632    {
633      print "Ignoring detail.\n" if ($debug);
634      $pextra = undef;
635    }
636    $precache->{$pid} = { 'title' => $title, 
637                          'start' => $start,
638                          'sub-title' => $pextra,
639                          'channel' => $channels->{$curchan}
640                        };
641    my $lastpid = $lastpids->{$curchan};
642    if ($lastpid)
643    {
644        $precache->{$lastpid}->{stop} = $start;
645        if ($start < $precache->{$lastpid}->{start}) 
646        {
647            print "Oddness detected in \"" .
648                  $precache->{$lastpid}->{title} .
649                  "\" (pid $pid), starting at " .
650                  $precache->{$lastpid}->{start} .
651                  ".\n";
652            delete $precache->{$lastpid} if ($gaps);
653        }
654        elsif ($gaps)
655        {
656            if (is_outside_gaps($curchan, $precache->{$lastpid}->{start}, $precache->{$lastpid}->{stop}))
657            {
658                delete $precache->{$lastpid};
659            }
660        }
661    }
662    $lastpids->{$curchan} = $pid;
663  }
664}
665
666# The guide pages for some regions don't provide any way to distinguish
667# between (eg) "Prime (Regional)" and "Prime (Albury)" in the same region,
668# other than the order in which they're listed. (They're both called
669# simply "Prime".) This func tracks which is which.
670sub translate_channel_name
671{
672    my ($chan, $seen_before) = @_;
673
674    my $rchans;
675#     $rchans = {
676#       90 => { 'Prime' => [ 'Prime (Regional Victoria)', 'Prime (Albury)' ] },
677#       };
678
679    $rchans = {
680        95 => { 'TEN' => [ 'TEN (VIC: Mildura/Sunraysia)', 'TEN (Mildura Digital)' ] },
681        };
682
683    my $region = $opt->{region};
684    return $chan unless ($rchans->{$region} and $rchans->{$region}->{$chan});
685    return $rchans->{$region}->{$chan}->[$seen_before];
686}
687
688sub parse_details 
689{
690  my $detailsdata = shift;
691
692  my ($show, $str, @rows, $block, $start, $stop, $date, $time, @extra, @items);
693
694  $detailsdata = Encode::decode_utf8($detailsdata);
695
696  my $tree = HTML::TreeBuilder->new_from_content($detailsdata);
697
698  my $event = $tree->look_down('_tag' => 'div', 'class' => 'event');
699
700  return &bad_parse("Mising title") unless ($event);  # site is probably sending that block page
701
702  $show->{'title'} = [[ strip_whitespace($event->look_down('_tag' => 'h1')->as_text()), $lang ]];
703  $str = $tree->find('h2');
704  if ($str)
705  {
706    $show->{'sub-title'} = [[ strip_whitespace($str->as_text()), $lang ]];
707  }
708
709  $time = $tree->find('h3') or return &bad_parse("Missing section: Time");
710  $date = $tree->find('h4') or return &bad_parse("Missing section: Date");
711  if(HTML::Entities::decode($time->as_HTML()) =~ /(\b[\d\.]+[ap]m)\s+.*?\s+([\d\.]+[ap]m) (.*)</)
712  {
713    ($start, $stop) = ($1, $2);
714    $date = $date->as_text();
715    $show->{'start'} = &expand_date("$start $date");
716    $show->{'stop'} = &expand_date("$stop $date");
717    # This guide always has the stop time 1 minute early!
718    $show->{'stop'} = &expand_date(DateCalc($show->{'stop'}, "+ 1 minute"));
719    $show->{'channel'} = $3;
720  }
721  else
722  {
723    return &bad_parse("Missing times"); 
724  }
725  if (Date_Cmp($show->{'start'}, $show->{'stop'}) == 1)
726  {
727     $show->{'stop'} = &expand_date(DateCalc($show->{'stop'}, "+ 1 day"));
728     print "Adjusted STOP time.\n" if ($debug);
729  }
730
731  $block = $event->look_down('_tag' => 'p');
732  if ($block and $block->as_text())
733  {
734    $show->{'desc'} = [[ &strip_whitespace($block->as_text()), $lang ]];
735  }
736
737  my ($category, %type);
738  foreach my $tag ($event->look_down('_tag' => 'tr'))
739  {
740    $str = $tag->as_text();
741    if ($str =~ /Genre:(.+)/)
742    {
743      $category = &strip_whitespace($1);
744      $str = $tree->find('h5');
745      $type{movie} = 1 if ($str and $str->as_text() =~ /movie/i);
746    }
747    elsif ($str =~ /Rating:(.+)/)
748    {
749      $str = &strip_whitespace($1);
750      if ($str =~ /(.*?)\s*\[(.+)\]/)
751      {
752          $str = $1;
753          my $sr = $2;
754          $sr =~ s/or medical procedures//ig;
755          $sr = &Shepherd::Common::subrating($sr);
756          $str .= " $sr";
757      }
758      $show->{'rating'} = [[ $str, 'ABA', undef]];
759    }
760    elsif ($str =~ /Cast:(.+)/)
761    {
762      $show->{'credits'}{'actor'} = [ split(/, /, &strip_whitespace($1)) ];
763    }
764    elsif ($str =~ /Director:(.+)/)
765    {
766      $show->{'credits'}{'director'} = [ split(/, /, &strip_whitespace($1)) ];
767    }
768    elsif ($str =~ /Writer:(.+)/) # unseen
769    {
770      $show->{'credits'}{'writer'} = [ split(/, /, &strip_whitespace($1)) ];
771    }
772    elsif ($str =~ /Year:\s*(\d+)/)
773    {
774      $show->{'date'} = &strip_whitespace($1);
775    }
776    elsif ($str =~ /Country:(.+)/)
777    {
778      $show->{'country'} = [[ split(/, /, &strip_whitespace($1)) ]];
779    }
780    elsif ($str =~ /Language:(.+)/)
781    {
782      $show->{'language'} = [ &strip_whitespace($1) ];
783    }
784    elsif ($str =~ /Duration:(\d+)/)
785    {
786      $show->{'length'} = $1 * 60;
787    }
788    elsif ($str =~ /^ /)
789    {
790      my $td = $tag->look_down('_tag' => 'td');
791      $str = $td->as_HTML();
792      @extra = split(/<br ?\/?>/, $str);
793      my %video;
794      foreach my $bit (@extra)
795      {
796        $bit =~ s/<.*>//;
797        $bit = &strip_whitespace($bit);
798        next unless ($bit);
799        if ($bit eq 'Repeat')
800        {
801            $show->{'previously-shown'} = { };
802        }
803        elsif ($bit eq 'Widescreen')
804        {
805            $video{'aspect'} = '16:9';
806        }
807        elsif ($bit eq 'High Definition')
808        {
809            $video{'quality'} = 'HDTV';
810        }
811        elsif ($bit eq 'Closed Captions')
812        {
813            $show->{'subtitles'} = [ { 'type' => 'teletext' } ];
814        }
815        elsif ($bit eq 'New Episode')
816        {
817            $show->{'premiere'} = [ $bit ];
818        }
819        elsif ($bit eq 'Premiere')
820        {
821            $show->{'premiere'} = [ $bit ];
822            $type{premiere} = 1;
823        }
824        elsif ($bit eq 'LIVE' || $bit eq 'Live')
825        {
826            $type{live} = 1;
827        }
828        elsif ($bit eq 'Final' || $bit eq 'Finale')
829        {
830            $type{final} = 1;
831        }
832        elsif ($bit eq 'Return') # unseen
833        {
834            $type{return} = 1;
835        }
836        $show->{'video'} = \%video if (%video);
837      }
838    }
839  }
840  $show->{'category'} = [ &Shepherd::Common::generate_category(
841      $show->{'title'}[0][0], $category, %type) ];
842
843  $tree->delete();
844  print Dumper($show) if ($debug);
845  return $show;
846}
847
848sub bad_parse
849{
850  my $msg = shift;
851  print "Parsing error: $msg.\n";
852  $stats{failed_parses}++;
853  if ($stats{failed_parses} >= 5 and $stats{failed_parses} >= $stats{detail_pages})
854  {
855      print "ERROR! Unable to parse shows! Looks like a major problem. " .
856            "Exiting.\n";
857      print stats(1);
858      die "Major parsing error";
859  }
860  return 0;
861}
862
863sub is_outside_gaps
864{
865  my ($ch, $start, $stop) = @_;
866
867  $start = udate_to_epoch($start);
868  $stop = udate_to_epoch($stop);
869
870  foreach my $gap (@{$gaps->{$ch}})
871  {
872      if ($gap =~ /(\d+)-(\d+)/)
873      {
874          return 0 if ($stop > $1 and $start < $2);
875      }
876  }
877  return 1;
878}
879
880sub udate_to_epoch
881{
882    my $udate = shift;
883
884    if ($udate =~ /(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/)
885    {
886        my ($year, $month, $day, $hour, $minute, $second) = ($1, $2, $3, $4, $5, $6);
887        $month--;
888        $year -= 1900;
889        return POSIX::strftime("%s", $second, $minute, $hour, $day, $month, $year);
890    }
891    die "Unable to parse udate $udate!";
892}
893
894sub read_channels_file 
895{
896    read_config_file('channels', 'channels_file');
897}
898
899sub read_gaps_file
900{
901    read_config_file('gaps', 'gaps_file');
902}
903
904sub read_config_file
905{
906    my ($name, $arg) = @_;
907
908    return unless ($opt->{$arg});
909    print "Reading $name file: $opt->{$arg}\n";
910    if (-r $opt->{$arg})
911    {
912        local (@ARGV, $/) = ($opt->{$arg});
913        no warnings 'all';
914        eval <>;
915        die "Can't parse $name file: $@" if ($@);
916    }
917    else
918    {
919        print "Unable to read $name file.\n";
920    }
921}
922
923sub get_command_line_options
924{
925  GetOptions($opt, qw(
926                        help
927                        debug
928                        output=s
929                        days=i
930                        offset=i
931                        region=i
932                        show-config
933                        show-channels
934                        rebuild-cache
935                        ignore-cache
936                        nowrite-cache
937                        dump-cache
938                        cache-file=s
939                        config-file=s
940                        channels_file=s
941                        gaps_file=s
942                        stats=i
943                        test
944                        desc
945                        version
946                        warper
947                    ));
948  $debug = $opt->{debug};   
949
950  if (@ARGV)
951  {
952    print "\nWARNING: Ignoring unknown option(s): @ARGV\n\n";
953  }
954}
955
956sub show_config
957{
958  my $short = shift;
959 
960  print "\nConfiguration\n".
961          "-------------\n";
962  unless ($short)
963  {
964    print "Debug mode : " . is_set($debug) . "\n" .
965          "Test mode  : " . is_set($opt->{test}) . "\n" .
966          "Webwarping : " . is_set($opt->{warper}) . "\n" .
967          "Cache file : " . $opt->{'cache-file'};
968    print ' (not reading)' if ($opt->{'ignore-cache'} or $opt->{'rebuild-cache'});
969    print ' (not updating)' if ($opt->{test} or $opt->{'ignore-cache'} or $opt->{'nowrite-cache'});
970    print "\n" .
971          "Output file: " . ($opt->{output} ? $opt->{output} : "None") . "\n" .
972          "Chann file : $opt->{channels_file}\n" .
973          ($opt->{gaps_file} ? "Gaps file  : " . $opt->{gaps_file} . "\n" : '') .
974          "Statistics : " . ($opt->{stats} ? "every " . $opt->{stats} . " seconds" : "off") . "\n";
975  }
976  print   "Region ID  : $opt->{region}\n" .
977          "Days wanted: $opt->{days} (offset: $opt->{offset})\n";
978  show_channels();
979  print "\n";
980}
981
982sub is_set
983{
984  my $arg = shift;
985  return $arg ? "Yes" : "No";
986}
987
988sub show_channels
989{
990  print "Subscribed channels:\n";
991  print "    $_ -> $channels->{$_}\n" for sort keys %$channels;
992}
993
994sub build_channel_map
995{
996  # --- extract sorted subscribed channel list from config-file hash;
997  # also compute canonicalised lowercased channel to xmltvid hash
998  %chanid = map { lc $_, $channels->{$_} } keys %$channels;
999}
1000
1001sub set_defaults
1002{
1003  my $defaults = {
1004          'days' => 7,
1005          'offset' => 0,
1006          'region' => 94,
1007          'stats' => 90,
1008          'output' => getcwd() . '/output.xmltv',
1009          'cache-file' => getcwd() . '/cache.dat',
1010          'channels_file' => getcwd() . '/channels.conf'
1011  };
1012                                             
1013  foreach (keys %$defaults)
1014  {
1015    unless (defined $opt->{$_})
1016    {
1017      $opt->{$_} = $defaults->{$_};
1018    }
1019  }
1020
1021#  $opt->{'days'} = 7 if ($opt->{'days'} > 7);
1022
1023  Shepherd::Common::set_defaults(
1024        stats => \%stats, 
1025        delay => "1-4",
1026        debug => $debug,
1027        webwarper => $opt->{warper}
1028    );
1029}
1030
1031sub expand_date
1032{
1033  my $t = shift;
1034  $t =~ s/\./:/;
1035  $t="$1:00$2 $3" if ($t =~ m:^(\d+)([ap]m)\s+(.*?)$:o);
1036  my $ret = ParseDate($t);
1037
1038  # strip colons
1039  $ret =~ tr/://d;
1040
1041  return $ret;
1042}
1043
1044sub Ymd { UnixDate($_[0], "%Y-%m-%d") or die "Date problem in Ymd($_[0])" }
1045
1046sub strip_whitespace 
1047{ 
1048  my $str = shift; 
1049  $str =~ s/^\s*(.*?)\s*$/$1/; 
1050  return $str;
1051}
1052
1053sub sleep_for
1054{
1055    my $n = shift;
1056    return unless ($n);
1057    sleep $n;
1058    $stats{slept_for} += $n;
1059}
1060
1061sub help
1062{
1063  print q{
1064Command-line options:
1065    --help                 Print this message
1066
1067    --version              Show current version
1068    --show-channels        Show subscribed channels & exit
1069    --show-config          Show configuration details & exit
1070    --dump-cache           Show cache & exit
1071               
1072    --cache-file <file>    Use the specified cache file
1073    --output <file>        Write XML into the specified file
1074    --channels_file <file> Read channel subscriptions from file
1075    --gaps_file <file>     Read gaps from file
1076
1077    --region <n>           Grab data for region code <n>
1078    --days <n>             Grab <n> days of data (today being day 1)
1079    --offset <n>           Skip the first <n> days
1080
1081    --stats <n>            Print stats every n secs (0=off)
1082    --debug                Print lots of debugging output
1083
1084    --warper               Use webwarper.net anonymizer
1085
1086    --test                 Don't write any output or update cache
1087    --ignore-cache         Neither read nor update cache
1088    --nowrite-cache        Read but don't update cache
1089    --rebuild-cache        Destroy and rebuild cache
1090};
1091  exit 0;
1092}
1093
Note: See TracBrowser for help on using the repository browser.