root/grabbers/rex @ 63

#!/usr/bin/perl -w
#
# "Rex"

my $version  = '3.2.2';

# An Australian TV Guide Grabber (a.k.a. tv_grab_au)
# by Max Barry
# http://www.maxbarry.com
# 
# Based on the long-serving but currently defunct NMSN Australian TV grabber 
# by Michael 'Immir' Smith
# 
# Use --help for command-line options.
# 
# A current version of this script, plus a README file, might be here:
# http://www.whuffy.com/tv_grab_au/
#
# To install Perl dependencies (like XMLTV.pm), you generally need to
# do this (as root): perl -MCPAN -e 'install <whatever>'
# E.g. perl -MCPAN -e 'install XMLTV::Ask'
# 
# Changelog:
# 0.1.0   : Let there be code
# 0.2.0   : Better caching (fewer HTTP connections)
# 0.3.0   : Aborted attempt to use proxy caches
# 0.4.0   : Reverted to non-proxy version; switched datasources
# 1.0.0   : --configure works; code released
# 1.0.1   : Bugfix : --config-file now works
# 1.1.0   : Feature: --stats option
# 1.1.1   : Bugfix : Download Pay TV show details properly
# 1.1.2   : Bugfix : Replaced non-working --static with --test; 
#                    put sport and free-to-air movies in correct category 
#                    for MythTV
# 1.1.3   : Bugfix : Don't die on a failed download, just report
# 1.2.0   : Feature: --cache-file option
# 1.2.1   : Bugfix : Better explanation for config-file failure
# 1.2.2   : Bugfix : Get more than 1 day's data for Pay TV channels
# 1.2.3   : Bugfix : Translate some category names for MythTV
# 1.2.4   : Bugfix : Better handling of config file locations
# 1.2.5   : Bugfix : Corrected typo in a category name
# 2.0.0   : Datasource change: August 29th, 2006
# 2.1.0   : Feature: Interpret javascript
# 2.1.1   : Bugfix : Try to avoid replacing good data with poisoned data
# 2.1.2   : Bugfix : Minor code tidy
# 2.2.0   : Feature: --help option
# 2.2.1   : Bugfix : Don't overwrite cache if no shows found (e.g. net failure)
# 2.3.0   : Feature: Better detection of changes to pre-fetched guide data
# 2.3.1   : Bugfix : adapted precache to non-fatal datasource change
# 2.4.0   : Feature: --quick option
# 2.4.1   : Bugfix : removed --quick (too hard to accurately parse stop time);
#                    code tidy
# 2.4.2   : Bugfix : progress stats on by default
# 2.5.0   : Feature: altered/added --ignore-cache, --nowrite-cache, and
#                    --rebuild-cache options; exit on unknown option
# 3.0.0   : Shepherd compatibility
# 3.1.0   : Feature: --ready option
# 3.2.0   : Feature: gzip compression, report KB downloaded
# 3.2.1   : Bugfix : handle failed downloads better
# 3.2.2   : Bugfix : no empty sub-titles in cache; no output buffering

use strict;
use Getopt::Long;
use HTTP::Request::Common;
use LWP::UserAgent;
use Date::Manip;
use File::Path;
use File::Basename;
use Data::Dumper;
use HTML::TreeBuilder;
use JavaScript;
use Storable;

use XMLTV;
use XMLTV::Ask;

# ---------------------------------------------------------------------------
# --- Global Variables

my $progname = "Rex";
my $lang = "en";

my $output_dir = ($ENV{HOME} ? $ENV{HOME} . "/." : "/var/local/") . 
                 lc($progname);         # Default location is ~/.rex/

my $cache_file = "$output_dir/cache.dat";

my ($count_dl, $count_detail, $count_bad, $count_cache, $count_changes, $count_kb) = (0) x 6;

my $DATASOURCE             = "http://www.yourtv.com.au";
my $DATASOURCE_SETUP       = "$DATASOURCE/profile/index.cfm?action=saveRegions";
my $DATASOURCE_GUIDE       = "$DATASOURCE/guide/index.cfm";
my $DATASOURCE_GUIDE_TODAY = "$DATASOURCE/guide/index.cfm?action=restofday";
my $DATASOURCE_DETAIL      = "$DATASOURCE/guide/index.cfm";
my $WW                     = "http://webwarper.net/ww/";

my $runtime = time();
my $laststats = $runtime;
my $firstfetch;
my $debug = 0;
my $opt;
my $channels = {};
my %chanid;
my $cached;
my $precache;
my $ua;
my $sid;
my $jsc;
my %shows;
my $numshows;
my $dcount;

# ---------------------------------------------------------------------------
# --- Setup

print "$progname $version\n";

$| = 1;

Getopt::Long::Configure(qw/pass_through/);

get_command_line_options();

exit 0 if ($opt->{ver}) or ($opt->{ready});

help() if ($opt->{help});

read_channels_file() if ($opt->{channels_file});

setup_javascript();

set_defaults();

if ($opt->{test})
{
  print "Test mode: won't write XML or cache.\n";
  $opt->{output} = undef;
}
        
build_channel_map();

if ($opt->{show_channels})
{
  show_channels();
  exit 0;
}

#Date_Init("TZ=$opt->{TZ}"); # explicitly Set Timezone

if ($debug or $opt->{show_config})
{
  show_config();
  exit 0 if ($opt->{show_config});
}

restore_cache();

if ($opt->{dump_cache})
{
  dump_cache();
  exit 0;
}

# ---------------------------------------------------------------------------
# --- Go!

get_guide_data();

get_details_data();

save_cache() if ($numshows);

write_xml();

print stats(1);

exit 0;

# ---------------------------------------------------------------------------
# --- Stop!


#
# Subs!
# 

sub get_guide_data
{
  print "Grabbing data for days " . ($opt->{offset} + 1) .
        " - $opt->{days}" . 
        ($opt->{output} ? " into " . $opt->{output} : '') .
        ".\n";

  refresh_ua() unless ($ua);

  my ($guidedata, $date);

  for my $day ($opt->{offset} .. $opt->{days} - 1)
  {
    $date = Ymd(DateCalc("today", "+ $day days"));
    print "Day $day.\n" if ($debug);

    if (!$day)
    {
      # Special bandwidth-saving URL for day 0

      $guidedata = get_page($DATASOURCE_GUIDE_TODAY);
      parse_guide($guidedata, $date);
    }
    else
    {
      # Need to grab day in 6-hour chunks.
      my $rid = $opt->{region};
      for (1 .. 4)
      {
        $guidedata = post_page($DATASOURCE_GUIDE,
                        [ 'action' => "sessionTimes",
                          'region_id' => $rid,
                          'date' => $date,
                          'period' => $_,
                          'submit' => 'submit'
                        ]);
        parse_guide($guidedata, $date, $_);
      }
    }
  }
  $numshows = scalar(keys %$precache);
  print "Shows found: $numshows.\n";
}

#
# This sub fills up %shows with details, either from the cache or
# from the web.
#
sub get_details_data
{
  $firstfetch = time();
  my $show;
  foreach my $pid (keys %$precache)
  {
    if ($cached->{$pid})
    {
      print "Cached: " . $cached->{$pid}->{title}[0][0] . ".\n" if ($debug);
      if (verify_cache($pid))
      {
        $shows{$pid} = $cached->{$pid};
        $count_cache++;
      }
      else
      {
        print "Cache has stale data for \"" . $cached->{$pid}->{title}[0][0] .
              "\": fetching fresh data.\n" if ($debug);
        $count_changes++;
      }
    }
    unless ($shows{$pid})
    {
      $show = download_show($pid);
      if ($show)
      {
        $shows{$pid} = $show;
        $count_detail++;
      }
      else
      {
        print "Failed to parse show $pid.\n";
      }
      sleep int(2 + rand(5));
    }
    if ($opt->{stats} and time() - $laststats >= $opt->{stats})
    {
      print stats();
    }
  }
}

sub verify_cache
{
  my $pid = shift;

  my @c = ( 
            [ 
              'Title', 
              $cached->{$pid}->{title}[0][0], 
              $precache->{$pid}->{title} 
            ],
            [ 
              'Start time',
              $cached->{$pid}->{start},
              $precache->{$pid}->{start}
            ],
            [
              'Subtitle',
              ($cached->{$pid}->{'sub-title'} ? $cached->{$pid}->{'sub-title'}[0][0] : undef),
              $precache->{$pid}->{'sub-title'}
            ]
          ); 
  foreach my $cmp (@c)
  {
    return 0 unless compare_caches($cmp->[0], $cmp->[1], $cmp->[2]);
  }
  return 1;
}

sub compare_caches
{
  my ($name, $arg1, $arg2) = @_;

  # Special case for subtitles.
  return 1 if ($name eq 'Subtitle' and !$arg2);
  
  $arg1 = '--missing--' unless $arg1;
  $arg2 = '--missing--' unless $arg2;

  return 1 if $arg1 eq $arg2;

  print "$name mismatch: \"$arg1\" vs \"$arg2\".\n" if ($debug);
  return 0;
}

sub download_show
{
  my ($pid, $recurse_count) = @_;

  $recurse_count ||= 0;
  return undef if ($recurse_count > 2);
 
  $dcount++;
  refresh_ua() if ($dcount % 20 == 0); # don't wait for error page

  my $result;

  print "Downloading # $pid.\n" if ($debug);
  my $detailsdata = get_page($DATASOURCE_DETAIL .
                      '?action=session_info&event_id=' . $pid .
                      '&sid=' . $sid . '&loc=grid');
  $result = parse_details($detailsdata) if ($detailsdata);
  unless ($detailsdata and $result)
  {
    print "Download failed.\n" if ($debug);
    sleep(5);
    $count_bad++;
    refresh_ua();
    return download_show($pid, $recurse_count+1);
  }

  return $result;
}

sub save_cache
{
  return if ($opt->{test} or $opt->{nowrite_cache});
  print "Saving cache.\n";
  Storable::store(\%shows, $cache_file);
}

sub write_xml
{
  return if ($opt->{test});
  
  my %writer_args = ( encoding => 'ISO-8859-1' );

  print "Writing XML.\n";

  if ($opt->{output}) 
  {
    my $fh = new IO::File(">" . $opt->{output})  
             or die "can't open " . $opt->{output} . ": $!";
    $writer_args{OUTPUT} = $fh;
  }

  my $writer = new XMLTV::Writer(%writer_args);

  $writer->start
    ( { 'source-info-url'    => $DATASOURCE,
        'source-info-name'   => "Datasource Name",
        'generator-info-name' => "XMLTV - $progname v$version"} );

  for my $channel (sort keys %$channels) 
  {
    my $chanid = $chanid{lc $channel};
    $writer->write_channel( { 'display-name' => [[$channel, $lang]],
                              'id' => $chanid } );
  } 

  foreach my $pid (keys %shows)
  {
    print "- " . $shows{$pid}->{'title'}[0][0] . "\n" if ($debug);
    $writer->write_programme($shows{$pid});
  }

  $writer->end();
}

sub refresh_ua
{
  print "Refreshing UA.\n" if ($debug);
  
  if ($ua)
  {
     print "Sleeping...\n" if ($debug);
     sleep 5 + int(rand(20));
  }

  my $agent = 
    ( 
    'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)',
    'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.4) Gecko/20060508 Firefox/1.5.0.4',
    'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.7.6) Gecko/20050512 Firefox',
    'Opera/9.00 (Windows NT 5.1; U; en)',
    'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/412 (KHTML, like Gecko) Safari/412'
    )[int(rand(5))];
               
  $ua = LWP::UserAgent->new
    ('timeout' => 30,
     'keep_alive' => 1,
     'agent' => $agent);
  $ua->env_proxy;
  $ua->cookie_jar({});

  # Set initial cookie
  get_page($DATASOURCE, 1);

  # Set region/service cookie
  post_page($DATASOURCE_SETUP,
        [ 'fta_region_id' => $opt->{'region'} ],
        1 );
  $ua->cookie_jar()->scan(\&refresh_sid);

  $dcount = 0;
}

sub refresh_sid
{
  my ($version, $key, $val) = @_;

  $sid = $val if ($key eq 'CFID');
}

sub setup_javascript 
{
  print "Initializing JavaScript interpreter.\n" if ($debug);
  $jsc = new JavaScript::Runtime->create_context();
  $jsc->set_error_handler( sub { } );
  $jsc->eval(qq{
    var doc = '';
    function Location() { this.href  = '$DATASOURCE'; }
    function Document() { this.write = function(x) { doc += x; } }
    function Window()   { this.___ww = 0 }
    location = new Location;
    document = new Document;
    window   = new Window;
  });
}

sub restore_cache
{
  unless ($opt->{ignore_cache} or $opt->{rebuild_cache})
  {
    if (-r $cache_file)
    {
      $cached = Storable::retrieve($cache_file);
    }
    else
    {
      print "Unable to read cache file: $cache_file.\n";
    }
  }
  if ($cached)
  {
    print "Retrieved " . keys(%$cached) . " cached items from file.\n";
  }
  else
  {
    $cached = { };
    print "Not using cache.\n";
  }
}

sub dump_cache
{
  print "Cache: " . Dumper($cached) . "\n";
}

sub stats
{
  my $finished = shift;

  my $t = time() - $runtime;
  
  my $ret = "$progname $version " . 
            ($finished ? "finished" : "in progress") .
            ":\n";
  $ret .= sprintf(
        " %d shows grabbed\n" .
        " %d downloads, including %d detail pages (%d KB)\n" .
        " %d cache hits, %d changes from cache, %d failed downloads\n",
        scalar(keys %shows),
        $count_dl, $count_detail, $count_kb, 
        $count_cache, $count_changes, $count_bad);
  $ret .= " Time elapsed: " . timestats($t) . "\n";
  unless ($finished or !$count_detail)
  {
    $t = ((((time() - $firstfetch) * ($numshows - $count_cache)) / $count_detail)) - $t;
    
    $ret .= " Estimated time remaining: " . timestats($t) . "\n";
  }
  $laststats = time();
  return $ret;
}

sub timestats
{
  my $t = shift;

  my $ret = '';
  if ($t >= 3600)
  {
    $ret .= sprintf("%d hr ", $t / 3600);
    $t = $t % 3600;
  }
  $ret .= sprintf("%d min %d sec", $t / 60, $t % 60);
  return $ret;
}


sub get_page
{
  my ($url, $ignore_failure) = @_;
  my $request = GET $url;
  return fetch_page($request, $ignore_failure);
}

sub post_page
{
  my ($url, $headers, $ignore_failure) = @_;
  my $request = POST $url, $headers;
  return fetch_page($request, $ignore_failure);
}

sub fetch_page
{
  my ($request, $ignore_failure) = @_;
  
  $request->uri() =~ s/^http:\/\//$WW/ if $opt->{warper};

  $request->header('Accept-Encoding' => 'gzip');

  print "Fetching: " . $request->as_string() . "\n" if ($debug);
  my $response;
  for my $c (1..2) {
    print "Attempt #$c.\n" if ($debug);
    $response = $ua->request($request);
    last if ($response->is_success() or $ignore_failure);
    sleep 5;
  }
  unless ($response->is_success() or $ignore_failure)
  {
    print "ERROR! Failed to retrieve page: " . $request->uri() . ".\n";
  }
  if ($debug and (my $r = $response)->previous) 
  {
    print "GET_CONTENT_BASE redirection backtrace:\n";
    while ($r) { print "    ", $r->base, "\n"; $r = $r->previous }
  }
  $count_dl++;
  my $page = $response->content();
  $count_kb += (do {use bytes; length($page)}) / 1024;

  if ($response->header('Content-Encoding')
      and
      $response->header('Content-Encoding') eq 'gzip') 
  {
      $page = Compress::Zlib::memGunzip($response->content());
  }

  $page =~ s/&nbsp;/ /g;
  return $page;
}

sub parse_guide
{
  my ($guidedata, $date, $phase) = @_;

  print "Parsing guide page.\n" if ($debug);

  $guidedata = readjs(Encode::decode_utf8($guidedata));

  my $tree = HTML::TreeBuilder->new_from_content($guidedata);
  my $curchan = '';
  my ($pid, $block, $line, $link, $title);
  foreach my $tag ($tree->look_down('_tag' => 'td', 'class' => 'venue'))
  {
    next if ($curchan eq $tag->as_text()); # Ignore repeated Station name
    $curchan = $tag->as_text();
    $curchan =~ s/\(.*\)//;
    if (!$channels->{$curchan})
    {
      print "Ignoring unsubscribed channel $curchan.\n" if ($debug);
      next;
    }
    print "Channel: $curchan.\n" if ($debug);
    $block = $tag->parent();
    foreach $line ($block->look_down('_tag' => 'td', 'class' => undef))
    {
      my ($pid, $title, $start, $pextra);
      foreach my $bit ($line->look_down('_tag' => 'div'))
      {
        #print "Looking at: " . $bit->as_text() . "\n" if ($debug);
        if ($bit->attr('class') eq 'ptime')
        {
          if ($start)
          {
            addme($pid, $title, $start, $pextra);
            $pextra = undef;
            $title = undef;
            $pid = undef;
          }
          $start = $bit->as_text();
          if ($phase and $phase == 1 and $start =~ /pm/)
          {
            $start = expand_date($start ." ". Ymd(DateCalc($date, "- 1 day")));
          }
          else
          {
            $start = expand_date("$start $date");
          }
        }
        elsif ($bit->attr('class') eq 'pname')
        {
          $title = strip_whitespace($bit->as_text());
          if ($bit->as_HTML() =~ /session_info\(\&#39;(\d+)/) 
          {
            $pid = $1; 
          }
        }
        elsif ($bit->attr('class') eq 'pextra')
        {
          $pextra = strip_whitespace($bit->as_text());
        }
      }
      if ($pid)
      {
        addme($pid, $title, $start, $pextra);
      }
      else
      {
        print "Parsing error: No pid found in block.\n";
      }
    }
  }
}

sub addme
{
  my ($pid, $title, $start, $pextra) = @_;
  
  if ($precache->{$pid})
  {
    print "Duplicate: $title ($pid).\n" if ($debug);
  }
  else
  {
    print "New: $title " . ($pextra ? "($pextra) " : '') . 
          "($pid) $start\n" if ($debug);
    if ($pextra and $pextra =~ /\(\d\d\d\d\)/)
    {
      print "Ignoring detail.\n" if ($debug);
      $pextra = undef;
    }
    $precache->{$pid} = { 'title' => $title, 
                          'start' => $start,
                          'sub-title' => $pextra
                        };
  }
}

sub parse_details 
{
  my $detailsdata = shift;

  my ($show, $str, @rows, $block, $start, $stop, $date, @extra, @items);

  $detailsdata = readjs(Encode::decode_utf8($detailsdata));

  my $tree = HTML::TreeBuilder->new_from_content($detailsdata);

  $block = $tree->find('h1');
  return undef unless ($block);  # site is probably sending that block page

  $show->{'title'} = [[ strip_whitespace($block->as_text()), $lang ]];
  $str = $tree->find('h2');
  if ($str)
  {
    $show->{'sub-title'} = [[ strip_whitespace($str->as_text()), $lang ]];
  }

  $block = $tree->find('h3') or return undef;
  @rows = $block->look_down('_tag' => 'div');
  $date = $rows[1]->as_text();
  if($rows[0]->as_HTML() =~ /([\d\.]+[ap]m)\s+&ndash;\s+([\d\.]+[ap]m)/)
  {
    ($start, $stop) = ($1, $2);
    $show->{'start'} = expand_date("$start $date");
    $show->{'stop'} = expand_date("$stop $date");
  }
  else
  {
    return undef;  # Failed to parse
  }
  if (Date_Cmp($show->{'start'}, $show->{'stop'}) == 1)
  {
     $show->{'stop'} = expand_date(DateCalc($show->{'stop'}, "+ 1 day"));
     print "Adjusted STOP time.\n" if ($debug);
  }
  $show->{'channel'} = $chanid{lc($rows[0]->find('span')->as_text())};

  $block = $tree->find('_tag' => 'hr', 'noshade') or return undef;
  $block = $block->right();
  if ($block->as_text())
  {
    $show->{'desc'} = [[ strip_whitespace($block->as_text()), $lang ]];
    $block = $block->right()->right();
  }
  else
  {
    $block = $block->right();
  }
  foreach my $tag ($block->look_down('_tag' => 'tr'))
  {
    $str = $tag->as_text();
    if ($str =~ /Genre:(.+)/)
    {
      $str = strip_whitespace($1);
      if ($str eq 'N/A')
      {
        @extra = ( $str );
      }
      else
      {
        @extra = split(/\//, $str);
      }
      $str = $tree->find('h5');
      if ($str and $str->as_text() =~ /movie/i)
      {
        unshift (@extra, 'movie');
      }

      foreach (@extra)
      {
        $_ = [ translate_category($_), $lang ];
      }
      $show->{'category'} = [ @extra ];
    }
    elsif ($str =~ /Rating:(.+)/)
    {
      $str = strip_whitespace($1);
      if ($str =~ /(.*?)\s*\[(.+)\]/)
      {
        @extra = split(/, /, $2);
        foreach (@extra)
        {
          $_ = [ $_, 'advisory', undef ];
        }
        $show->{'rating'} = [[ $1, 'CTVA', undef],  @extra ];
      }
      else
      {
        $show->{'rating'} = [[ $1, "CTVA", undef]];
      }
    }
    elsif ($str =~ /Cast: (.+)/)
    {
      $show->{'credits'}{'actor'} = [ split(/, /, strip_whitespace($1)) ];
    }
    elsif ($str =~ /Year:(\d+)/)
    {
#      $show->{'date'} = strip_whitespace($1);
    }
    elsif ($str =~ /Other:(.+)/)
    {
      next unless (strip_whitespace($1));
      $str = $tag->as_HTML();
      @extra = split(/<br>/, $tag->as_HTML());
      my @to_add;
      foreach my $bit (@extra)
      {
        $bit =~ s/<.*>//;
        $bit = strip_whitespace($bit);
        next unless ($bit);
        push (@to_add, $bit);
      }
      foreach (@to_add)
      {
        if ($show->{'desc'})
        {
          $show->{'desc'}[0][0] .= " $_.";
        }
        else
        {
          $show->{'desc'} = [[ "$_.", $lang ]];
        }
      }
    }
  }

  print Dumper($show) if ($debug);
  return $show;
}

sub translate_category
{
  my %translation = (   'Sport' => 'sports',
                        'Soap Opera' => 'Soap',
                        'Science and Technology' => 'Science/Nature',
                        'Real Life' => 'Reality',
                        'Cartoon' => 'Animation',
                        'Family' => 'Children',
                        'Murder' => 'Crime' );
                        
  return $translation{$_} if $translation{$_};
  return $_;
}

sub readjs {
  my $data = shift;
  $data =~ s{<script type="?text/javascript"?[^>]*>(.*?)</script>}{
    my $x = $1;
    $jsc->eval(qq{ doc = '' });
    $jsc->eval($x);
    $jsc->eval(qq{ doc }) || '';
  }isge;
  $data;
}
 
sub read_channels_file 
{   
    print "Reading channels file: $opt->{channels_file}\n";
    if (-r $opt->{channels_file})
    {
        local (@ARGV, $/) = ($opt->{channels_file});
        no warnings 'all';
        eval <>;
        die "$@" if ($@);
    }
    else
    {
        print "Unable to read channels file.\n";
    }
}

sub get_command_line_options
{
  GetOptions( 'config-file=s'   => \$opt->{configfile},
              'help'            => \$opt->{help},
              'debug'           => \$debug,
              'days=i'          => \$opt->{days},
              'offset=i'        => \$opt->{offset},
              'show-channels'   => \$opt->{show_channels},
              'output=s'        => \$opt->{output},
              'rebuild-cache'   => \$opt->{rebuild_cache},
              'ignore-cache'    => \$opt->{ignore_cache},
              'nowrite-cache'   => \$opt->{nowrite_cache},
              'dump-cache'      => \$opt->{dump_cache},
              'test'            => \$opt->{test},
              'show-config'     => \$opt->{show_config},
              'warper'          => \$opt->{warper},
              'cache-file=s'    => \$cache_file,
              'stats=i'         => \$opt->{stats},
              'region=i'        => \$opt->{region},
              'channels_file=s' => \$opt->{channels_file},
              'version'         => \$opt->{ver},
              'desc'            => \$opt->{desc},
              'ready'           => \$opt->{ready}
             );

  if (@ARGV)
  {
    print "\nERROR: Unknown option(s): @ARGV\n";
    help();
  }
}

sub show_config
{
  my $short = shift;
  
  print "\nConfiguration\n".
          "-------------\n";
  unless ($short)
  {
    print "Debug mode : " . is_set($debug) . "\n" .
          "Test mode  : " . is_set($opt->{test}) . "\n" .
          "Webwarping : " . is_set($opt->{warper}) . "\n" .
          "Cache file : $cache_file";
    print ' (not reading)' if ($opt->{ignore_cache} or $opt->{rebuild_cache});
    print ' (not updating)' if ($opt->{test} or $opt->{ignore_cache} or $opt->{nowrite_cache});
    print "\n" .
          "Output file: " . ($opt->{output} ? $opt->{output} : "None") . "\n" .
          "Chann file : $opt->{channels_file}\n" .
          "Statistics : " . ($opt->{stats} ? "every " . $opt->{stats} . " seconds" : "off") . "\n";
  }
  print   "Region ID  : $opt->{region}\n" .
          "Days wanted: $opt->{days} (offset: $opt->{offset})\n";
  show_channels();
  print "\n";
}

sub is_set
{
  my $arg = shift;
  return $arg ? "Yes" : "No";
}

sub show_channels
{
  print "Subscribed channels:\n";
  print "    $_ -> $channels->{$_}\n" for sort keys %$channels;
}

sub build_channel_map
{
  # --- extract sorted subscribed channel list from config-file hash;
  # also compute canonicalised lowercased channel to xmltvid hash
  %chanid = map { lc $_, $channels->{$_} } keys %$channels;
}

sub set_defaults
{
  my $defaults = {
          'days' => 7,
          'offset' => 0,
          'region' => 94,
          'stats' => 300,
          'output' => "$output_dir/guide.xml",
          'channels_file' => "$output_dir/channels.conf"
  };
                                              
  foreach (keys %$defaults)
  {
    unless (defined $opt->{$_})
    {
      $opt->{$_} = $defaults->{$_};
    }
  }

  $opt->{'days'} = 7 if ($opt->{'days'} > 7);
}

sub expand_date
{
  my $t = shift;

  $t =~ s/\./:/;
  my $ret = ParseDate($t);

  # --- append timezone and strip colons
#  ($ret .= " $opt->{TZ}") =~ tr/://d;
  $ret =~ tr/://d;

  return $ret;
}

sub Ymd { UnixDate($_[0], "%Y-%m-%d") or die "problem in Ymd($_[0])" }

sub strip_whitespace 
{ 
  my $str = shift; 
  $str =~ s/^\s*(.*?)\s*$/$1/; 
  return $str;
}

sub help
{
  print q{
Command-line options:
    --help                 Print this message

    --version              Show current version
    --show-channels        Show subscribed channels & exit
    --show-config          Show configuration details & exit
    --dump-cache           Show cache & exit
                
    --cache-file <file>    Use the specified cache file
    --output <file>        Write XML into the specified file
    --channels_file <file> Read channel subscriptions from file

    --region <n>           Grab data for region code <n>
    --days <n>             Grab <n> days of data (today being day 1)
    --offset <n>           Skip the first <n> days

    --stats <n>            Print stats every n secs (0=off)
    --debug                Print lots of debugging output

    --warper               Use webwarper.net anonymizer

    --test                 Don't write any output or update cache
    --ignore-cache         Neither read nor update cache
    --nowrite-cache        Read but don't update cache
    --rebuild-cache        Destroy and rebuild cache
};
  exit 0;
}