#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
=pod 

=head1 NAME

tv_grab_au (0.6.2) - Grab TV listings for Australia.

=head1 SYNOPSIS

tv_grab_au --help

tv_grab_au --configure [--config-file FILE]

tv_grab_au [--config-file FILE] [--output FILE] [--days N]
           [--offset N] [--dual-names] [--no-icons] [--quiet] [--debug]

tv_grab_au  --list-channels [--loc STATE] [--srv SERVICE]
            [--output FILE] [--dual-names] [--no-icons]

=head1 DESCRIPTION

Output XMLTV listings for various channels available in Australia.

First run B<tv_grab_au --configure> to choose your region and
service provider (ie: free-to-air, pay TV, etc), and which 
channels you want to download.

Then running B<tv_grab_au> with no arguments will output listings 
in XMLTV format to standard output.

B<--configure> Prompt for region, prompt for Free-to-Air or Pay-TV, 
prompt for which channels, and write the configuration file.

B<--config-file FILE> Set the name of the configuration file, the 
default is B<~/.xmltv/tv_grab_au.conf>.  This is the file written by 
B<--configure> and read when grabbing.

B<--list-channels> Grabs a list of channels only and outputs as XMLTV. 
Use B<--loc> to specify region and B<--srv> to specify service.
Use B<--list-channels> with no B<--loc> or B<--srv> to list of options
for B<--loc>, use B<--list-channels> with B<--loc [option]> to see a
list of options for B<--srv>.

B<--output FILE> Write to FILE rather than standard output.

B<--days N> Grab N days, default is 7.

B<--offset N> Start N days in the future.  The default is to start 
from today.

B<--loc REGION> Grab channels for REGION. use B<--list-channels> with no 
options to see list of regions.

B<--srv SERVICE> Grab channels for SERVICE. use B<--list-channels> with 
B<--loc> option to see list of services (Foxtel, Optus, Free-To-Air, etc).

B<--no-icons> Force grabber to NOT write channel icons as URLs.

B<--dual-names> Force grabber to write a second display-name for each
channel found using the channel frequency as the second name.
This helps furious_tv users.

B<--quiet> Suppress the progress messages normally written to standard 
error.

B<--debug> Output debugging info.

B<--share> Specify alternate directory for channel_ids file, usally found
in /usr/share/xmltv/tv_grab_au/.

=head1 SEE ALSO

L<xmltv(5)>. L<http://www.onlinetractorparts.com.au/rohbags/>

=head1 AUTHOR

Written by rohbags (rohbags@onlinetractorparts.com.au).

=head1 BUGS

The data source, L<d1.com.au>, do some strange things with the timezones 
included with their data. For example data for Darwin claims to be in EST
timezone (+1000) but it actually is CST (+0930). Due to this bug the grabber
changes the timezones for start and stop times but does not convert the 
actual time itself. If the start and/or stop times for any shows you notice
seem to be out, please contact the author.

Some long descriptions seem to be cut short. This is the way the grabber
gets it data from its source. I hope D1 can sort this out soon.

The channel_ids file contains the Time Zones for each region, this may be
specified as EST, WST or CST, or +10:00 format (hours from GMT).

Channels are identified by the RFC2838 form recommended by the XMLTV DTD, i think.
(ie: Free-to-Air, Darwin, 7, free.Darwin.7.d1.com.au)

Please email the Author if any bugs are found.

=cut

use strict;
use Getopt::Long;
use Date::Manip;
use IO::File;
use XMLTV;
use XMLTV::Memoize;
use XMLTV::Ask;
use XMLTV::Config_file;
use XMLTV::Get_nice;
use XMLTV::Usage <<END

$0 (0.6.2): grab Australian television listings in XMLTV format
To configure: $0 --configure [--config-file FILE]
To grab listings: $0 [--config-file FILE] [--output FILE] [--days N]
        [--offset N] [--dual-names] [--no-icons] [--quiet] [--debug]
To list channels: $0 --list-channels [--loc STATE] [--srv SERVICE] [--dual-names] [--no-icons]
END
  ;
#To grab icons: $0 --get-icons --icon-dir DIRECTORY [--loc STATE] [--srv SERVICE]

# Use Term::ProgressBar if installed.
use constant Have_bar => eval { require Term::ProgressBar; 1 };

# Use Log::TraceMessages if installed. FIXME
BEGIN {
  eval { require Log::TraceMessages };
  if ($@) {*t = sub {}; *d = sub { '' }; }
  else {*t = \&Log::TraceMessages::t;
	*d = \&Log::TraceMessages::d;
	Log::TraceMessages::check_argv();
  }
}

# Memoize some date parsing routines, if possible.
eval { require Memoize };
unless ($@) {
  foreach (qw(nextdate ParseDate UnixDate dc)) {
    Memoize::memoize($_) or warn "cannot memoize $_";
  }
}

sub xhead( $$ );
sub configure();
sub get_channels( $$ );
sub nextdate( $ );
sub extract_channel_data( $$$ );
sub get_programs( $$$$$$$ );
sub dc( $$ );
sub get_channel_ids( $$ );
sub write_xml_program( $$ );

my %STATES = (
  'SA - Adelaide' => 'Adelaide', 'Queensland - Brisbane' => 'Brisbane',
  'ACT - Canberra' => 'Canberra', 'NT - Darwin' => 'Darwin',
  'Tasmania - Hobart' => 'Hobart', 'Victoria - Melbourne' => 'Melbourne',
  'NSW - Regional' => 'NSWReg', 'NT - Regional' => 'NTReg',
  'WA - Perth' => 'Perth', 'Queensland - Regional' => 'QLDReg',
  'SA - Regional' => 'SAReg', 'NSW - Sydney' => 'Sydney',
  'Tasmania - Regional' => 'TASReg', 'Victoria - Regional' => 'VICReg',
  'WA - Regional' => 'WAReg'
);

my %SERVICES = (
  'Austar Analogue' => 'austar', 'Austar Digital' => 'austard',
  'Foxtel Analogue' => 'foxtel', 'Foxtel Digital' => 'foxteld',
  'Free to Air' => 'free', 'Free to Air Digital' => 'freesd',
  'Free to Air Digital (High Definition)' => 'freehd', 'Optus' => 'optus'
);

# Get options, including undocumented --cache option.
XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux');

# set user-agent manually
$XMLTV::Get_nice::ua->agent("tv_grab_au/0.6.2");

my ($opt_days, $opt_offset, $opt_help, $opt_output,
  $opt_list_channels, $opt_loc, $opt_debug, $opt_share,
  $opt_configure, $opt_config_file, $opt_quiet, $opt_srv,
  $opt_dual_names, $opt_nodelay, $opt_no_icons);
#  $opt_slow, $opt_nodelay, $doonce);
$opt_days  = 7; $opt_offset = 0; $opt_nodelay = 0;
$opt_quiet  = 0; $opt_debug  = 0; 
#$opt_dual_names = 0; $opt_no_icons = 0;
#$doonce = 0;
GetOptions('days=i'        => \$opt_days,
	   'offset=i'      => \$opt_offset,
	   'help'          => \$opt_help,
	   'configure'     => \$opt_configure,
	   'config-file=s' => \$opt_config_file,
	   'output=s'      => \$opt_output,
	   'quiet'         => \$opt_quiet,
	   'list-channels' => \$opt_list_channels,
	   'loc=s'         => \$opt_loc,
	   'srv=s'         => \$opt_srv,
	   'debug'         => \$opt_debug,
           'share=s'       => \$opt_share, # undocumented
           'dual-names'    => \$opt_dual_names,
           'nodelay'       => \$opt_nodelay,
	   'no-icons'      => \$opt_no_icons
	  )
  or usage(0);

die 'number of days must not be negative'
  if (defined $opt_days && $opt_days < 0);

usage(1) if $opt_help;

if ($opt_configure and $opt_list_channels) {
  print STDERR "cannot both configure and list channels, assuming --list-channels only\n";
  $opt_configure = 0;
}
if ($opt_quiet and $opt_debug) {
  print STDERR "cannot both be quiet and debugin' (you fool!), assuming --debug only\n";
  $opt_quiet = 0;
}

# share/ directory for storing region-to-channel mapping files.
# The directory can be overridden with the --share option.
my $SHARE_DIR='/var/tmp/xmltv-0.5.42-4m.mo5-root-builduser/usr/share/xmltv'; # by grab/au/tv_grab_au.PL
$SHARE_DIR = $opt_share if defined $opt_share;
my $OUR_SHARE_DIR = (defined $SHARE_DIR) ? "$SHARE_DIR/tv_grab_au" : '.';
my $channel_ids_file = "$OUR_SHARE_DIR/channel_ids";
#die "file not found: $channel_ids_file" if not -f $channel_ids_file;

if (not -f $channel_ids_file) {print STDERR "file not found: $channel_ids_file\nAborting...\n"; exit(1);}

use vars '%regmap';
use vars '%namemap';
use vars '$BASE_TZ';

# app banner - yyyy-mm-dd format
#if (not $opt_quiet) {print STDERR "\ttv_grab_au - (version 0.6.2 - release 2004-12-27)\n\n";}
if (not $opt_quiet) {print STDERR "\ttv_grab_au - (version 0.6.2 - release 2005-05-31)\n\n";}

# XMLTV config file.
my $config_file  = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_au', $opt_quiet);
#print STDERR "\n" if not $opt_quiet;

if ($opt_debug) {print "DEBUGGIN ON!\n";}
# track # of urls and d/l bytes
my $total_fetches = 0; my $total_bytes = 0;

if ($opt_nodelay){$XMLTV::Get_nice::Delay=0;}
else{$XMLTV::Get_nice::Delay=5;}

if ($opt_configure) {
  configure();
  exit();
}

# not configuring, writing output.
my %w_args;
if (defined $opt_output) {
  my $fh = new IO::File(">$opt_output");
  die "cannot write to $opt_output: $!" if not defined $fh;
  $w_args{OUTPUT} = $fh;
}

$w_args{encoding} = 'ISO-8859-1';
my $writer = new XMLTV::Writer(%w_args);

# list channels only
if ($opt_list_channels) {
  if (not defined $opt_loc) {
    my $msg = "--loc option required with --list-channels:\n";
    foreach (sort keys %STATES) {$msg .= "    --loc $STATES{$_} for $_\n";}
    die $msg;
  }
  if (not defined $opt_srv) {
    my $msg = "--srv option required with --list-channels:\n";
    foreach (sort keys %SERVICES) {$msg .= "    --srv $SERVICES{$_} for $_\n";}
    die $msg;
  }
  if ($opt_debug) {print "sending $opt_loc to get_channel_ids\n";}
  %regmap = get_channel_ids($opt_loc, $opt_srv);
  if ($opt_debug) {print "recieving $regmap{'TZ'} from get_channel_ids\n";}
  $writer->start(xhead($opt_loc, $opt_srv));
#print STDERR "Doing foreach..\n";
  foreach my $chan (get_channels($opt_loc, $opt_srv)) {
     my $ch_wid = $chan->{wid};
     my $ch_xid = $chan->{xid};
     my $ch_icon = $chan->{icon};
     my $ch_name = $chan->{'display-name'}->[0]->[0];
#print STDERR "DB: wid:$ch_wid - xid:$ch_xid - icon:$ch_icon - name:$ch_name\n";
     my $lang = "en";
     my $ch_xmlid = "$ch_wid.d1.com.au";
     if (($opt_no_icons) || (!$ch_icon)){
       if ($opt_dual_names){$writer->write_channel(
         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ], [ $ch_xid ] ] }); }
       else {$writer->write_channel(
         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ] ] }); }
     }
     else {
       if ($opt_dual_names){$writer->write_channel(
         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang],[$ch_xid]],icon=>[{src=>$ch_icon}]}); }
       else {$writer->write_channel(
         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang]],icon=>[{src=>$ch_icon}]}); }
     }
  }
  $writer->end();
  exit();
}

# Not configuring or listing, must be grabbing.
my ($region, $service, $ch_xid, $ch_wid, $ch_name, $ch_xmlid);
my (%channels, %nochannels, %channels_name, %nochannels_name, %channels_freq);
my $line_num = 0;
foreach (XMLTV::Config_file::read_lines($config_file)){
  ++ $line_num;
  next if not defined;
  my $where = "$config_file:$line_num";
  if (/^region:?\s+(\w+)$/){
    warn "$where: already seen region\n" if defined $region;
    $region = $1;
    if ($opt_debug){print "* D1: region= $region\n";}
  }
  elsif (/^service:?\s+(\w+)$/){
    warn "$where: already seen service\n" if defined $service;
    $service = $1;
    if ($opt_debug){print "* D1b: service= $service\n";}
  }
  elsif (/^\+channel:?\s(\S+)$/){$channels{$1}=$1;}
  elsif (/^-channel:?\s(\S+)$/){$nochannels{$1}=$1;}
  elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"$/){$channels{$1}=$1; $channels_name{$1}=$2;}
  elsif (/^-channel:?\s(\S+)\s\"(.*?)\"$/){$nochannels{$1}=$1; $nochannels_name{$1}=$2;}
  elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"\s(\d+)$/){$channels{$1}=$1;$channels_name{$1}=$2;$channels_freq{$1}=$3;}
  elsif (/^-channel:?\s(\S+)\s\"(.*?)\"\s(\d+)$/){$nochannels{$1}=$1;$nochannels_name{$1}=$2;$channels_freq{$1}=$3;}
  else {warn "$where: bad line\n";}
}
die "No channels specified, run me with --configure\n"
  if not %channels;
  %regmap = get_channel_ids($region, $service);
  if ($opt_debug) {print "recieving $regmap{$region} from get_channel_ids\n";}
  if (defined $regmap{$region}) {
     $BASE_TZ = $regmap{$region}; if ($opt_debug) {print "regmap IS defined\n";}
  }
  else {
     $BASE_TZ = "EST";
     warn "$channel_ids_file: no TZ for $region!, using EST\n";
  }

#exit();

Date_Init('TZ=$BASE_TZ');
# track processing time
my $proc_time = ParseDate('now');

# set now date (with offset)
my $now = dc(ParseDate('now'), "$opt_offset days");

$writer->start(xhead($region, $service));
my @to_get;

# the order in which we fetch the channels do not matter
my %all_xid; my %all_names; my %all_icons;

# get all channels for region from www page
 foreach (get_channels($region, $service)) {
   $all_xid{$_->{wid}} = $_->{xid};
   $all_icons{$_->{wid}} = $_->{icon};
   if ($opt_debug){
     print "get_ch (xid)  DB1: $_->{xid} \n";
     print "get_ch (wid)  DB2: $_->{wid} \n";
     print "get_ch (name) DB3: $_->{'display-name'}->[0]->[0] \n";
     if ($_->{'icon'}){print "get_ch (icon) DB4: $_->{icon} \n";}
       else {print "get_ch (icon) DB4: <NO ICON FOUND>\n";}
   }
   if ($channels_freq{$_->{wid}} != $_->{xid}){
      if ($opt_debug){print "NEW FREQ: $channels_freq{$_->{wid}} was: $_->{xid}\n";}
      $_->{xid} = $channels_freq{$_->{wid}};
      $all_xid{$_->{wid}} = $channels_freq{$_->{wid}};
   }
   else {if ($opt_debug){print "NO NEW FREQs!\n";}}
   if ($channels_name{$_->{wid}}){
      if ($opt_debug){print "tv_grab_au.conf: channel $_->{wid} named $channels_name{$_->{wid}}.\n";}
      $all_names{$_->{wid}} = [ [ $channels_name{$_->{wid}}, "en" ] ];
   }
   elsif ($namemap{$_->{wid}}){
	if ($opt_debug){print "channel $_->{wid} has alt name, using $namemap{$_->{wid}} "};
	if ($opt_debug){print "instead of $_->{'display-name'}->[0]->[0]\n";}
	$all_names{$_->{wid}} = [ [ $namemap{$_->{'wid'}}, "en" ] ];
   }
   else {$all_names{$_->{wid}} = $_->{'display-name'};}
#   if ($opt_debug) {
##     print "GetChannels: X:$_->{xid} W:$_->{wid} N:$all_names{$_->{wid}}->[0]->[0]\n";
#      print "GetChannels: X:$_->{xid} W:$_->{wid} N:$all_names{$_->{wid}}-[]->[] ";
#   }
   
 }

# make sure wanted channels exist
foreach (keys %channels) {
  if (not $all_xid{$_}) {
    if ($opt_debug){print "channel configured but not from www page->: $_\n";}
    if (defined $namemap{$_}) { # force to grab with channel name
	if ($opt_debug){print "this channel: $_ has a alternate name - must be forced\n";}
	$all_xid{$_} = $regmap{$_};
	$all_names{$_} = [ [ $namemap{$_}, "en" ] ];
    }
    else {
	# remove this channel from hash
	delete $channels{$_};
	warn "\nchannel: $_ not found on website (OFF-AIR?)\n";
    }
  }
}

# check for new channels
foreach (keys %all_xid) {
  if ($channels{$_}) {if ($opt_debug) {print "all_xid $_ known and wanted\n";} }
  elsif ($nochannels{$_}) {if ($opt_debug) {print "all_xid $_ known and NOT wanted\n";} }
  else {if ($opt_debug) {print "all_xid $_ unknown (NEW?)\n";}
    warn "\nFound NEW Channel: $_ on website. Consider re-configuring.\n\n";
  }
}

# write channels
foreach my $ch_wid (keys %channels) {
  my $ch_name = $all_names{$ch_wid}->[0]->[0];
  my $ch_xid = $all_xid{$ch_wid};
  my $ch_xmlid = "$ch_wid.d1.com.au";
  my $ch_icon;
  if ($all_icons{$ch_wid}){$ch_icon = $all_icons{$ch_wid};}
#    else {$ch_icon = ""; $opt_no_icons = 1;}
  my $lang="en"; ## FIXME: read from page, sbs has dual langs (en & 'other'(fr/es/jp/de))
#  if ($opt_debug) {print "DB2: X:$ch_xid W:$ch_wid N:$ch_name\n";}
  if ($opt_debug){print "wr_ch(xid): $ch_xid\nwr_ch(wid): $ch_wid\nwr_ch(icon): $ch_icon\nwr_ch(name): $ch_name\n";}
  if (($opt_no_icons) || (!$ch_icon)){
    if ($opt_dual_names){$writer->write_channel(
      { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ], [ $ch_xid ] ] }); }
    else {$writer->write_channel(
         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ] ] }); }
  }
  else {
    if ($opt_dual_names){$writer->write_channel(
      { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang],[$ch_xid]],icon=>[{src=>$ch_icon}]}); }
    else {$writer->write_channel(
         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang]],icon=>[{src=>$ch_icon}]}); }
  }
  my $day=$now;
  for (my $i = 0; $i < $opt_days; $i++) { # for each day
    if ($i > 0) {$day = dc($day, '+ 1 day');}
    push @to_get, [ $day, $ch_xmlid, $ch_xid, $ch_wid, $ch_name, $service ];
  }
}

#exit();

# The progress bar!
my $bar;
  $bar = new Term::ProgressBar('grabing listings', scalar @to_get)
    if Have_bar && not $opt_quiet;

my (%xmltv_id, %event_id, %rating, %today, %chan);
foreach (@to_get) {
  my ($day, $ch_xmlid, $ch_xid, $ch_wid, $ch_name, $service) = @$_;
  if ($opt_debug) {print "** QDB2: name= $ch_name\t ch_Xid= $ch_xid"};
  if ($opt_debug) {print "\t ch_Wid= $ch_wid\t Xmlid= $ch_xmlid Srv= $service\n"};
  get_programs($writer, $day, $ch_xmlid, $ch_xid, $ch_wid, $ch_name, $service);
  update $bar if Have_bar && not $opt_quiet;
}

$writer->end();
# calc and format last line stats (# of urls, duration, total bytes)
my $proc_time_end = &ParseDate("today");
my $err; my $mins = 0; my $secs = 0;
my $delta=&DateCalc($proc_time,$proc_time_end,\$err);
if ($delta=~/^.*?:(\d+):(\d+)$/s) {$mins = $1; $secs = $2;}
my $totbytes; my @bytes; my $totlen = length($total_bytes);
if ($totlen > 0) {$bytes[2] = substr($total_bytes,-3,3); $totbytes = $bytes[2];}
if ($totlen > 3) {$bytes[1] = substr($total_bytes,-6,3); $totbytes = "$bytes[1],$totbytes";}
if ($totlen > 6) {$bytes[0] = substr($total_bytes,-9,3); $totbytes = "$bytes[0],$totbytes";}
if (not $opt_quiet) {print STDERR "Completed $total_fetches URL grabs ($totbytes Bytes) in $mins minutes & $secs seconds\n";}
exit();

sub xhead( $$ ) {
  my ($region, $service) = @_;
  return { 'source-info-url'     => 'http://www.d1.com.au/',
	   'source-info-name'    => "D1 Australia",
	   'source-data-url'     => "http://www.d1.com.au/d1xmltv.asmx/GetChannels?provider=$service&region=$region",
	   'generator-info-name' => "XMLTV - tv_grab_au v0.6.2",
	   'generator-info-url'  => 'http://www.onlinetractorparts.com.au/rohbags/',
	 };
}

sub configure() {
    XMLTV::Config_file::check_no_overwrite($config_file);
    open(CONF, ">$config_file") or die "cannot write to $config_file: $!";
    my $default_st = "NT - Darwin";
    my $default_srv = "Free to Air";
#    my $cn = askQuestion('Grab listings for which region?', $default_st, sort keys %STATES);
    my $cn = ask_choice('Grab listings for which region?', $default_st, sort keys %STATES);

    my $c = $STATES{$cn}; die if not defined $c;
#    my $dn = askQuestion('Grab listings for which service?', $default_srv, sort keys %SERVICES);
    my $dn = ask_choice('Grab listings for which service?', $default_srv, sort keys %SERVICES);

    my $d = $SERVICES{$dn}; die if not defined $d;
    print CONF "# tv_grab_au 0.6.2 config file\nregion $c\nservice $d\n";
    print CONF "# \"channel name\" and \"frequency\" can be changed to suit\n";
    print CONF "# [+yes/-no] [channel ID] [channel name] [frequency]\n";
    my $answer; my $answer_all; my %compmap;
    foreach (get_channels($c, $d)) {
        my $ch_wid = $_->{wid};
        my $ch_name = $_->{'display-name'};
	my $ch_icon = $_->{'icon'};
	my $ch_xid = $_->{'xid'};
	my $ch_name_old;
	$compmap{$ch_wid} = $ch_name;
	if ($opt_debug){print "ch_wid: $ch_wid\nname: $ch_name->[0]->[0]\nxid: $ch_xid\n";}
	if ($opt_debug && $ch_icon){print "icon: $ch_icon\n";}
	if (defined $namemap{$ch_wid}){
	   if ($opt_debug){print "HAS a namemap: $namemap{$ch_wid}\n";}
	   $ch_name_old = $ch_name->[0]->[0];
	   $ch_name->[0]->[0] = $namemap{$ch_wid};
	}
	if ($answer_all) {
	    $answer = $answer_all;
	    print($answer eq 'yes' ? 'adding' : 'ignoring', " new channel $ch_name->[0]->[0]\n");
	}
	else {
#	    if (defined $ch_name_old){$answer=askQuestion("add channel: $ch_name->[0]->[0] ($ch_name_old)?", 'yes', 'yes', 'no', 'all', 'none');}
	    if (defined $ch_name_old){$answer=ask_choice("add channel: $ch_name->[0]->[0] ($ch_name_old)?", 'yes', 'yes', 'no', 'all', 'none');}
	    else {$answer=ask_choice("add channel: $ch_name->[0]->[0]?", 'yes', 'yes', 'no', 'all', 'none');}
	    if ( $answer eq 'all' ) {$answer='yes'; $answer_all='yes';}
	    elsif ( $answer eq 'none' ) {$answer='no'; $answer_all='no';}
	}
	if ($answer eq 'yes') {print CONF "+channel $ch_wid \"$ch_name->[0]->[0]\" $ch_xid\n";}
	else {print CONF "-channel $ch_wid \"$ch_name->[0]->[0]\" $ch_xid\n";}
    }
    foreach my $key (keys %regmap){
	if ($opt_debug){print "doing foreach keys regmap! --> $key\n";}
	if (not defined $compmap{$key}){
	if ($opt_debug){print "key matches compmap.\n";}
	 if (not $key eq "TZ"){
	   if ($opt_debug){print "key NO match.\n";}
#	   $answer=askQuestion("add extra channel $namemap{$key}?", 'yes', 'yes', 'no', 'all', 'none');
	   $answer=ask_choice("add extra channel $namemap{$key}?", 'yes', 'yes', 'no', 'all', 'none');
	   if ($opt_debug){print "answer is: $answer\n";}
	   if ($answer eq 'yes') {print CONF "channel $key \"$namemap{$key}\"\n";}
	   else {print CONF "-channel $key \"$namemap{$key}\"\n";}
	 }
	if ($opt_debug){print "done foreach keys regmap!\n";}
	}
    }
    close CONF or warn "cannot close $config_file: $!";
    print "All done, run with no arguments to grab listings.\n";
}

# list the channels for a state.
sub get_channels($$) {
    my ($c, $d) = @_;
    if ($opt_debug) {print "\n--> doing get_channels: c=$c d=$d \n";}
    my $bar = new Term::ProgressBar('grabing channels', 1)
      if Have_bar && not $opt_quiet;
#    my $dt = UnixDate($now, "%Y-%m-%d"); 
#    if ($opt_debug) {print "\n--> got UnixDate: $dt \n";}
    my $url="http://www.d1.com.au/d1xmltv.asmx/GetChannels?provider=$d&region=$c";
    if ($opt_debug) {print "\n--> getting url: $url \n";}
    my $data = get_nice($url);
    die "could not get channel listing $url, aborting\n"
      if not defined $data;
    update $bar if Have_bar && not $opt_quiet;
    if ($opt_debug) {print "get_channels-> URL total_fetches ($total_fetches -> ";}
    $total_fetches++; if ($opt_debug) {print "$total_fetches)\n";}
    my $dbytes = length($data);
    if ($opt_debug) {print "get_channels-> total_bytes (total:$total_bytes + current:$dbytes = ";}
    $total_bytes = $total_bytes + $dbytes; if ($opt_debug) {print "$total_bytes)\n";}
    if ($opt_debug) {print "\n--> got http data: $data \n";}
    return extract_channel_data($data, $c, $d);
}

# Grabs per channel listings - GetChannels
sub extract_channel_data( $$$ ) {
   my ($data, $c, $d) = @_; my @r;
   $data =~ /<NewDataSet(.*?)<\/NewDataSet>/s
     or die "\nERROR: can't find DataSet for $c - $d\n";
   $_ = $1;
#   while (/<Channels.*?<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>.*?<\/Channels>/sg) {
    foreach my $tmpdat ($1 =~ /<Channels(.*?)<\/Channels>/sg){
    if ($opt_debug){print "Doing FOREACH loop: $tmpdat\n";}
    $_ = $tmpdat;
#    while (/<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>/sg) {
#    $_=~/<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>/sg;
     if ($opt_debug){print "Doing WHILE loop...\n";}
     my ($ch_wid, $ch_xid, $ch_name, $ch_icon);
#      if (defined $1){$ch_wid=$1;}
#       else {print STDERR "ERROR! - no xmltv id found!\n";}
#      if (defined $2){$ch_xid=$2;}
#       else {print STDERR "ERROR! - no frequency found!\n";}
#      if (defined $3){$ch_name=$3;}
#       else {print STDERR "ERROR! - no channel name found!\n";}
#      if (defined $4){$ch_icon=$4;}
#       else {print STDERR "ERROR! - no channel icon found!\n";}
     if ($_=~/<ChannelID>(.*?)<\/ChannelID/sg){$ch_wid=$1;}
      else {print STDERR "ERROR! - no xmltv id found!\nData: $_\nDying!";die}
     if ($_=~/<FreqID>(.*?)<\/FreqID>/sg){$ch_xid=$1;}
      elsif ($_=~/<Channel>(.*?)<\/Channel>/sg){$ch_xid=$1;}
      else {print STDERR "ERROR! - no frequency found for $ch_wid!\n";}
     if ($_=~/<Name>(.*?)<\/Name>/sg){$ch_name=$1;}
      else {print STDERR "ERROR! - no channel name found for $ch_wid!\n";}
     if ($_=~/<Icon>(.*?)<\/Icon>/sg){$ch_icon=$1;}
      else {print STDERR "ERROR! - no channel icon found for $ch_wid!\n";}
     my $lang="en";
     my $ch = { 'display-name' => [ [ $ch_name, $lang ] ], 'xid' => $ch_xid , 'wid' => $ch_wid, 'icon' => $ch_icon };
     push @r, $ch;
     if ($opt_debug){print "Found Channel:\tName= $ch_name\tWeb-ID= $ch_wid\tXml-ID= $ch_xid\t";}
     if ($opt_debug && $ch_icon){print "Icon=$ch_icon\n";}
       else {if ($opt_debug){print "\n";}}
#    } # end while
   } # end foreach
   return @r;
}

# grab 1 days list of programmes for channel N.
sub get_programs( $$$$$$$ ) {
    my ($w, $date, $ch_xmltv_id, $ch_xid, $ch_www_id, $ch_name, $service) = @_;
    if ($opt_debug){print "doing get_programs...\n"}
    my $today = UnixDate($date, "%Y-%m-%d"); $today=~s/ //;
    my $url="http://www.d1.com.au/d1xmltv.asmx/GetPrograms?channelid=$ch_www_id&date=$today";
    if ($opt_debug) {print "getting URL: $url\n";}
    my $data=get_nice($url);
    if (not defined $data) {
	warn "could not fetch $url, skipping this channel\n";
	return;
    }
    if ($opt_debug) {print "get_programs-> URL total_fetches ($total_fetches -> ";}
    $total_fetches++;
    if ($opt_debug) {print "$total_fetches)\n";}
    my $dbytes = length($data);
    if ($opt_debug) {print "get_programs-> total_bytes (total:$total_bytes + current:$dbytes = ";}
    $total_bytes = $total_bytes + $dbytes;
    if ($opt_debug) {print "$total_bytes)\n";}
    local $SIG{__WARN__} = sub {if ($opt_debug) {print "local SIG _WARN_ here\n";}
	warn "$url: $_[0]";
    };
    if ($opt_debug){print "looking for NewDataSet.....\n";}
    if ($data =~ /<NewDataSet\s*(.*?)\s*<\/NewDataSet>/s){
#      or die "\nERROR: can't find DataSet for $ch_name - $today\nData is:\n$data\n";
#      or warn "\nERROR: can't find DataSet for $ch_name - $today\nData is:\n$data\n";
    $data = $1;
    if ($opt_debug){print "Must have found NewDataSet!\n";}
    foreach my $tmpdat ($data=~/<Programs\s*(.*?)\s*<\/Programs>/sg) {
	if ($opt_debug){print "Found SOMETHING between <programs>!\n";}
	if ($opt_debug){print "SOMETHING is:\n$tmpdat\nEND-SOMETHING\n";}
	foreach my $tmpdat2 ($tmpdat){
	  my $mainhash;
	  ${$mainhash}{'xmltv_id'} = $ch_www_id . ".d1.com.au";
	  if ( $tmpdat2=~/<Start>\s*(.*?)\s*<\/Start>/sg ) {
	    if ($opt_debug){print "found start - $1 -|\n";}
	    ${$mainhash}{'starttime'}=$1;
	  }
	  if ( $tmpdat2=~/<Stop>\s*(.*?)\s*<\/Stop>/sg ) {
	    if ($opt_debug){print "found stop - $1 -|\n";}
	    ${$mainhash}{'stoptime'}=$1;
	  }
	  if ( $tmpdat2=~/<Title>\s*(.*?)\s*<\/Title>/sg ) {
	    if ($opt_debug){print "found title - $1 -|\n";}
	    ${$mainhash}{'title'}=$1;
	  }
	  if ( $tmpdat2=~/<Subtitle>\s*(.*?)\s*<\/Subtitle>/sg ) {
	    if ($opt_debug){print "found subtitle - $1 -|\n";}
	    ${$mainhash}{'subtitle'}=$1;
	  }
	  if ( $tmpdat2=~/<Description>\s*(.*?)\s*<\/Description>/sg ) {
	    if ($opt_debug){print "found description - $1 -|\n";}
	    ${$mainhash}{'desc'}=$1;
	  }
	  if ( $tmpdat2=~/<Category>\s*(.*?)\s*<\/Category>/sg ) {
	    if ($opt_debug){print "found category - $1 -|\n";}
	    ${$mainhash}{'genre'}=$1;
	  }
	  if ( $tmpdat2=~/<Rating>(.*?)<\/Rating>/sg ) {
	    my $rate = $1;
	    if ( $rate=~/(.*?)\t$/ ) { $rate=$1; if ($opt_debug){print "-->rating has tab\n";}}
	    if ( $rate=~/(.*?)\s*$/ ) { $rate=$1; if ($opt_debug){print "-->rating has space(s)\n";}}
	    if ($opt_debug) {print "found rating - $rate -|- $1 -|\n";}
	    ${$mainhash}{'rating'}=$rate;
	  }
		${$mainhash}{'xid'}=$ch_xid;
		write_xml_program($w, $mainhash);
	}
    }
   }
   else {
     print STDERR "\nERROR: can't find DataSet for $ch_name - $today\n";
     if ($opt_debug){"Data is:\n$data\n";}
     }
 } #-> end get_programs

# get channel-to-region ids from file, also gets local timezone
sub get_channel_ids( $$ ) {
  if ($opt_debug) {print "doing get_channel_ids!\n";}
  my ($region, $service) = @_;
  if ($opt_debug) {print "Region is: $region\n";}
  if ($opt_debug) {print "Service is: $service\n";}
  my $line_num = 0;
  foreach (XMLTV::Config_file::read_lines($channel_ids_file, 1)) {
    ++ $line_num;
    next if not defined;
    my $ch = $_;
    if (not defined $ch) {warn "$channel_ids_file:$line_num: unknown channel id $_\n";}
    else {
       if ($ch=~m/^$region:(.*?)$/sg){
 	if ($opt_debug) {print "region matches! $region->$1<-\n";}
         $regmap{$region} = $1;
       }
      else {
	if ($opt_debug) {print "no match! - $ch.\n";} 
      }
    }
  }
  if (defined $regmap{$region}) {if ($opt_debug) {print "regmap IS defined-> ($region = $regmap{$region})\n";}
  } else {$regmap{$region}="EST"; warn "$channel_ids_file: no TZ for $region!, using EST\n";}
  # to do - can fix daylight savings prob from here
  if ($regmap{$region} eq "EST") {$regmap{$region}="+1000"}
  if ($regmap{$region} eq "CST") {$regmap{$region}="+0930"}
  if ($regmap{$region} eq "WST") {$regmap{$region}="+0800"}
  if ($opt_debug) {print "done get_channel_ids!\n";}
  return %regmap;
}

# Bump a YYYYMMDD date by one. (20030607)
sub nextdate( $ ) {
  if ($opt_debug) {print "start nextdate\n";}
  my $d = shift; $d =~ /^\d{8}$/ or die;
  my $p = ParseDate($d);
  my $n = dc($p, '+ 1 day');
  if ($opt_debug) {print "end nextdate\n";}
  return UnixDate($n, '%Q');
}

# Wrapper for DateCalc().
sub dc( $$ ) {
  if ($opt_debug) {print "start dc\n";}
  my $err;
  my $r = DateCalc(@_, \$err);
  die "DateCalc() failed with $err" if $err;
  die 'DateCalc() returned undef' if not defined $r;
  if ($opt_debug) {print "end dc\n";}
  return $r;
}

sub write_xml_program( $$ ) {
  my ($w, $mainhash) = @_;
  my ($starttime, $stoptime);
  if ($opt_debug) {print "---> doing write_xml_program\n";}
  # convert times to standard format
#  $starttime=UnixDate(${$mainhash}{'starttime'}, "%H%M");
#  $starttime="${$mainhash}{'today'}$starttime"."00"." $BASE_TZ";
  if ($opt_debug){print "DB: regmap(region) is: $regmap{$region}\n";}
  # fixme - source times are EST!
  $starttime = ${$mainhash}{'starttime'};
  $stoptime = ${$mainhash}{'stoptime'};
  
  # convert times from EST to local times (broken due to source!)
#  Date_Init('TZ=+0930');
#  $starttime = UnixDate($starttime, "%Y%m%d%H%M%S %z");
#  $stoptime = UnixDate($stoptime, "%Y%m%d%H%M%S %z");

  # ugly hack - change TZ to local TZ NOT convert actual times!
  if ($opt_debug){print "***> SEARCHING for TZ in starttime.... ($starttime)\n";}
  if ($starttime=~/^(.*?)\s(.*?)$/) {
    my $time = $1; my $timetz = $2;
    if ($opt_debug){print "**> FOUND TZ in starttime: $timetz - ($starttime)\n";}
    $starttime = $time . " " . $regmap{$region};
    if ($opt_debug){print "**> NEW starttime is: $starttime\n";}
  }
  if ($opt_debug){print "***> SEARCHING for TZ in stoptime.... ($stoptime)\n";}
  if ($stoptime=~/^(.*?)\s(.*?)$/) {
    my $time = $1; my $timetz = $2;
    if ($opt_debug){print "**> FOUND TZ in stoptime: $timetz - ($stoptime)\n";}
    $stoptime = $time . " " . $regmap{$region};
    if ($opt_debug){print "**> NEW stoptime is: $stoptime\n";}
  }
  if ($opt_debug){print "***> DONE looking and swapping TZ's!\n";}

  if ($opt_debug) {print "---> mainhash=$mainhash\n";}
  if ($opt_debug) {print "---> hash(xmltv_id)=${$mainhash}{'xmltv_id'}\n";}
  if ($opt_debug) {print "---> hash(xid)=${$mainhash}{'xid'}\n";}
  if ($opt_debug) {print "---> hash(starttime)=$starttime (${$mainhash}{'starttime'})\n";}
  if ($opt_debug && ${$mainhash}{'stoptime'}) {print "---> hash(stoptime)=$stoptime (${$mainhash}{'stoptime'})\n";}
#  if ($opt_debug) {print "---> hash(today)=${$mainhash}{'today'}\n";}
  if ($opt_debug) {print "---> hash(title)=${$mainhash}{'title'}\n";}
  if ($opt_debug && ${$mainhash}{'subtitle'}) {print "---> hash(subtitle)=${$mainhash}{'subtitle'}\n";}
  if ($opt_debug && ${$mainhash}{'rating'}) {print "---> hash(rating)=${$mainhash}{'rating'}\n";}
  # start writing xmltv programme element
  if (${$mainhash}{'stoptime'} && ${$mainhash}{'starttime'}) {
     $w->startTag('programme', start=> $starttime, stop => $stoptime, channel=> ${$mainhash}{'xmltv_id'});
  } elsif (${$mainhash}{'starttime'} && not ${$mainhash}{'stoptime'}) {
     $w->startTag('programme', start=> $starttime, channel=> ${$mainhash}{'xmltv_id'});
  } else {
     warn "\n\n **  im outa here! **\nno start-stop time combo! :O\n"; die;
  }
  $w->dataElement('title', ${$mainhash}{'title'}, 'lang'=>"en"); # fixme: get lang
  if (${$mainhash}{'subtitle'}) {$w->dataElement('sub-title',${$mainhash}{'subtitle'},'lang'=>"en");}
  if (${$mainhash}{'desc'}) {$w->dataElement('desc', ${$mainhash}{'desc'}, 'lang' => "en");}
#  if (%{$dcpdesc}) {
#    $w->startTag('credits');
#    if (${$dcpdesc}{'director'}) {$w->dataElement('director', ${$dcpdesc}{'director'});}
#    if (${$dcpdesc}{'writer'}) {$w->dataElement('writer', ${$dcpdesc}{'writer'});}
#    if (${$dcpdesc}{'adapter'}) {$w->dataElement('adapter', ${$dcpdesc}{'adapter'});}
#    if (${$dcpdesc}{'producer'}) {$w->dataElement('producer', ${$dcpdesc}{'producer'});}
#    if (${$dcpdesc}{'presenter'}) {$w->dataElement('presenter', ${$dcpdesc}{'presenter'});}
#    if (${$dcpdesc}{'host'}) {$w->dataElement('presenter', $$dcpdesc{'host'});} # fixme?
#    if (${$dcpdesc}{'commentator'}) {$w->dataElement('commentator', ${$dcpdesc}{'commentator'});}
#    if (${$dcpdesc}{'guest'}) {$w->dataElement('guest', ${$dcpdesc}{'guest'});}
#    if (@{$pcast}) { foreach $_ (@{$pcast}){$w->dataElement('actor', $_);} }
#    $w->endTag('credits');
#  }
  if (${$mainhash}{'date'}) {$w->dataElement('category', ${$mainhash}{'date'}, 'lang' => "en");}
  if (${$mainhash}{'genre'}) {$w->dataElement('category', ${$mainhash}{'genre'}, 'lang' => "en");}
  if (${$mainhash}{'live'}) {$w->dataElement('category', "Live", 'lang' => "en");}
  if (${$mainhash}{'lang'}) {$w->dataElement('language', ${$mainhash}{'lang'}, 'lang' => "en");}
  if (${$mainhash}{'olang'}) {$w->dataElement('orig-language', ${$mainhash}{'olang'}, 'lang' => "en");}
#  if (${$mainhash}{'length'}) {$w->dataElement('length', ${$mainhash}{'length'}, 'units' => "minutes");}
  if (${$mainhash}{'length'}) {
    my $l = ${$mainhash}{'length'}; my $units = 'minutes';
    if ($l % 60 == 0) {$units = 'hours'; $l /= 60;}
    $w->dataElement('length', $l, 'units' => $units);
  }
  # icon goes here
  if (${$mainhash}{'url'}) {$w->dataElement('url',${$mainhash}{'url'});}
  if (${$mainhash}{'country'}) {$w->dataElement('country', ${$mainhash}{'country'}, 'lang' => "en");}
  if (${$mainhash}{'epnum'}) {$w->dataElement('episode-num',${$mainhash}{'epnum'});}
  if (${$mainhash}{'video-col'} or ${$mainhash}{'video-asp'}) { # present(yes/no), color(yes/no), aspect(4:3/16:9)
    $w->startTag('video');
    if (${$mainhash}{'video-col'}) {$w->dataElement('color', "no");}
    if (${$mainhash}{'video-asp'}) {$w->dataElement('aspect', ${$mainhash}{'video-asp'});}
    $w->endTag('video');
  }
  if (${$mainhash}{'audio'}) { # present(yes/no),stereo(mono/stereo/surround)
    $w->startTag('audio');
    $w->dataElement('present', "yes");
    $w->dataElement('stereo', "surround");
    $w->endTag('audio');
  }
  if (${$mainhash}{'repeat'}) {$w->emptyTag('previously-shown',"");}
  if (${$mainhash}{'premiere'}) {$w->emptyTag('premiere',"");}
  if (${$mainhash}{'last'}) {$w->emptyTag('last-chance',"");}
  if (${$mainhash}{'new'}) {$w->emptyTag('new',"");}
  if (${$mainhash}{'captions'}) {$w->emptyTag('subtitles', 'type' => "teletext");}
  if (${$mainhash}{'rating'}) {
    $w->startTag('rating', 'system' => "CTVA");
    $w->dataElement('value', ${$mainhash}{'rating'});
    $w->endTag('rating');
  }
  if (${$mainhash}{'stars'}) {
    $w->startTag('star-rating');
    $w->dataElement('value', ${$mainhash}{'stars'});
    $w->endTag('star-rating');
  }
  $w->endTag('programme');
  if ($opt_debug) {print "---> done write_xml_program <-|\n";}
}

# the end :)
