#!/usr/bin/perl
#
# citysearch TV guide grabber
#

my $version = '2.0.3';

use strict;
use Getopt::Long;
use POSIX;
use Data::Dumper;
use IO::File;
use XMLTV;
use HTML::TreeBuilder;
use Shepherd::Common;

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

my $progname = "citysearch";

my $DATASOURCE = "citysearch.com.au";

my $lang = 'en';
my $debug = 0;
my $channels;
my $opt_channels;
my $opt = { };
my $gaps;
my %stats;
my $shows;
my $cache;
my $runtime = time;
my $zerohr;
my @skipped_channels;

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

print "$progname $version\n";

$| = 1;

&get_command_line_options;

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

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

&set_defaults;

&read_channels_file;

unless ($channels)
{
    print "ERROR: No channels requested. Please use --channels_file.\n";
    exit 2;
}

&read_gaps_file;

&read_cache;

&set_region;

&get_guide_data;

&calculate_stop_times;

&details;

&write_cache;

&write_xml;

&Shepherd::Common::print_stats($progname, $version, $runtime, %stats);

&log("Done.");
exit;


# ---------------------------------------------------------------------------
# --- Subs

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

    # Calculate midnight on day zero in epoch time
    my @today = localtime($runtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
    $zerohr = $runtime - (($today[0]) + ($today[1]*60) + ($today[2]*60*60));

    for my $day ($opt->{offset} .. ($opt->{days} - 1))
    { 
	my $dow = &POSIX::strftime("%A", localtime($runtime + ($day * 86400)));

	&log("Day $day ($dow)");

	my $start_hr = 0;
	if (!$day)
	{
	    $start_hr = int($today[2] / 3) * 3;
	}
	for (my $hr = $start_hr; $hr < 24; $hr += 3)
	{

	    &log("Time window $hr:00 - " . ($hr+3) . ":00");

	    my $url = "$DATASOURCE/tvguide/$day/$hr:00";
	    my $guidedata = &Shepherd::Common::get_url($url);
	    exit 5 unless ($guidedata);

	    # Verify that the guide page really is for the day we want.
	    my $daystr = &POSIX::strftime("%A, %d %B", localtime($runtime + ($day * 86400)));
	    $daystr =~ s/, 0(\d)/, $1/;

	    unless ($guidedata =~ /$daystr/)
	    {
		&log("Exiting: couldn't locate daystring \"$daystr\" in guide page for $dow.");
		exit 8;
	    }

	    &parse_guide($guidedata, $day, $hr);
	}
    }
    &log("Found " . &num_items($shows) . " shows on " . scalar(keys %$shows) . " channels.");
}

sub parse_guide
{
    my ($guidedata, $day, $window) = @_;

    &log("Parsing guide page (Day $day hr $window).") if ($debug);
    my $tree = HTML::TreeBuilder->new;
    $tree->no_space_compacting(1);
    $tree->parse($guidedata);
    $tree->eof;

    foreach my $table ($tree->look_down(_tag => 'table', id => 'tvGuideTable'))
    {
	&log("Found table.") if ($debug);
	foreach my $tr ($table->look_down(_tag => 'tr'))
	{
	    my $ctag = $tr->look_down(_tag => 'td', class => 'channel');
	    next unless ($ctag);

	    my $channame = $ctag->as_text();
	    if ($ctag->as_HTML =~ /<span .*?>.*?<\/span>.*?<span .*?>(.*?)<\/span>/s)
	    {
		$channame = $1;
	    }
	    $channame =~ s/^ //g;
	    $channame =~ s/ $//g;
	    $channame =~ s/\n//g;
	    $channame = 'Prime Canberra/Sth Coast' if ($channame eq 'Prime' and $opt->{region} == 126);

	    my $chanid = $channels->{$channame};
	    unless ($chanid)
	    {
		unless (grep $_ eq $channame, @skipped_channels)
		{
		    &log("Skipping unsubscribed channel \"$channame\".");
		    push @skipped_channels, $channame;
		}
		next;
	    }

	    &log("Channel $channame") if ($debug);
	    
	    # When we hit a "Continue Before" block, it means we're missing
	    # a show's start time. Skip next show in this case.
	    my $continue_before = 0;

	    foreach my $td ($tr->look_down(_tag => 'td'))
	    {
		my $td_class = $td->attr('class');
		next unless ($td_class and $td_class =~ /(\d\d)(\d\d)/);
		my $block_start = ($1 * 3600) + ($2 * 60); 

		$continue_before = 1 if ($td_class =~ /continueBefore/);

		foreach my $showblock ($td->look_down(_tag => 'div', class => 'programWrapper'))
		{

		    if ($continue_before)
		    {
			$continue_before = 0;
			next;
		    }

		    my $show;

		    $show->{channel} = $chanid;

		    my $start = $block_start;
		    if ($showblock->as_HTML =~ /<span class="oddStartTime">(\d+)\.(\d+)<\/span> ([ap]m)/)
		    {
			$start = ($1 * 3600) + ($2 * 60);
			$start += (12 * 3600) if ($3 eq 'pm');
			$start -= (12 * 3600) if ($3 eq 'am' and $1 == 12);
		    }
		    $show->{start} = $zerohr + (86400 * $day) + $start;

		    my $atag = $showblock->look_down(_tag => 'a');
		    unless ($atag)
		    {
			# Caused by "No information available" entries
			&log("Empty show block: day $day hr $window chan $channame") if ($debug);
			next;
		    }
		    $show->{title} = $atag->as_text();

		    die "Missing pid: day $day hr $window chan $channame title $show->{title}" unless ($atag->attr('href') =~ m"/tv/viewTvProgram/tvReviews-(.*)");
		    $show->{pid} = $1;

		    #if ($showblock->as_HTML =~ /<span class="accessLink">(\w+)<\/span>/)
		    #{
		    #	push @{$show->{category}}, $1;
		    #}

		    if ($showblock->as_HTML =~ /Rpt/)
		    {
			$show->{'previously-shown'} = { };
		    }
		    &log("- $show->{title}") if ($debug);
		    $shows->{$chanid}->{$show->{start}} = $show;
		}
	    }
	}
    }
    $tree->delete;
}

sub details
{
    # iterate through our list, compare to cache, lookup if necessary
    my $count = 0;
    my $num_shows = &num_items($shows);
    foreach my $ch (keys %$shows)
    {
	foreach my $s (sort keys %{$shows->{$ch}})
	{
	    my $show = $shows->{$ch}->{$s};
	    if ($show->{start} > $zerohr + (86400 * $opt->{days}))
	    {
		&log("Late  : " . $show->{title}) if ($debug);
		delete $shows->{$ch}->{$s};
	    }
	    elsif ($show->{stop} and $show->{stop} < $zerohr + (86400 * $opt->{offset}))
	    {
		&log("Early : " . $show->{title}) if ($debug);
		delete $shows->{$ch}->{$s};
	    }
	    elsif ($gaps and &is_outside_gaps($show->{channel}, $show->{start}, $show->{stop}))
	    {
		&log("Nongap: " . $show->{title}) if ($debug);
		delete $shows->{$ch}->{$s};
	    }
	    elsif (
		$cache 
		    and 
		$cache->{$ch} 
		    and 
		$cache->{$ch}->{$s}
		    and
		$cache->{$ch}->{$s}->{details}
		    and
		$cache->{$ch}->{$s}->{stop} eq $show->{stop}
		    and
		$cache->{$ch}->{$s}->{title} eq $show->{title})
	    {
		&log("Cached: ". $show->{title}) if ($debug);
		$shows->{$ch}->{$s} = $cache->{$ch}->{$s};
		$stats{cache_hits}++;
		$stats{shows}++;
	    }
	    else
	    {
		&log("New   : " . $show->{title}) if ($debug);
		my $html = &fetch_details($show->{pid});
		if ($html)
		{
		    &parse_details($html, $show);
		    $show->{details} = 1;
		    $cache->{$ch}->{$s} = $show;
		    $stats{shows}++;
		}
		else
		{
		    &log("Couldn't fetch " . $show->{title} .
			 " (pid " . $show->{pid} . ")!");
		}
	    }
	    $count++;
	    if ($count % 25 == 0)
	    {
		&log(sprintf " ...processed %d of %d shows [%s elapsed, %d new, %d cached, %d unwanted]",
		    $count, $num_shows, 
		    &Shepherd::Common::pretty_duration(time - $runtime),
		    $stats{shows} - $stats{cache_hits},
		    $stats{cache_hits},
		    $count - $stats{shows});
	    }
	}
    }
}

sub fetch_details
{
    my $pid = shift;

    my $url = "$DATASOURCE/tv/viewTvProgram/tvReviews-$pid";
    my $html = &Shepherd::Common::get_url($url);
    return $html;
}

sub parse_details
{
    my ($html, $show) = @_;

    &log("Parsing \"$show->{title}\"") if ($debug);
    my $tree = HTML::TreeBuilder->new_from_content($html);

    my $div = $tree->look_down(_tag => 'div', id => 'contentHeader');
    die "Can't read page!\n$html" unless ($div);

    my $desc = $div->look_down(_tag => 'p');
    if ($desc)
    {
	$desc = &strip_whitespace($desc->as_text);
	$show->{desc} = $desc if ($desc);
    }

    $div = $tree->look_down(_tag => 'div', class => 'contentDetails');
    my (%video, $category, %type);
    foreach my $tr ($div->look_down(_tag => 'tr'))
    {
	if ($tr->as_text =~ /(.*?):(.*)/)
	{
	    if ($1 eq 'Type')
	    {
		$category = &strip_whitespace($2);
	    }
	    elsif ($1 eq 'Country')
	    {
		$show->{country} = $2;
	    }
	    elsif ($1 eq 'Language')
	    {
		$show->{language} = $2;
	    }
	    elsif ($1 eq 'Cast')
	    {
		foreach (split /, /, $2)
		{
		    push @{$show->{credits}{actor}}, &strip_whitespace($_);
		}
	    }
	    elsif ($1 eq 'Director')
	    {
		foreach (split /, /, $2)
		{
		    push @{$show->{credits}{director}}, &strip_whitespace($_);
		}
	    }
	    elsif ($1 eq 'Writer') # unseen
	    {
		foreach (split /, /, $2)
		{
		    push @{$show->{credits}{writer}}, &strip_whitespace($_);
		}
	    }
	    elsif ($1 eq 'Duration')
	    {
		if ($2 =~ /(\d+) min/)
		{
		    $show->{length} = $1 * 60;
		    if (!$show->{stop}) {
			$show->{stop} = $show->{start} + ($1 * 60);
			&log("Filled in stop time! $1 minutes.") if ($debug);
		    }
		}
	    }
	    elsif ($1 eq 'Format')
	    {
		foreach my $info (split /, /, $2)
		{
		    $info = &strip_whitespace($info);
		    if ($info eq 'Closed Captions')
		    {
			push @{$show->{'subtitles'}}, 'teletext';
		    }
		    elsif ($info eq 'Subtitles')
		    {
			push @{$show->{'subtitles'}}, 'onscreen';
		    }
		    elsif ($info eq 'Widescreen')
		    {
			$video{aspect} = '16:9';
		    }
		    elsif ($info eq 'High Definition')
		    {
			$video{'quality'} = 'HDTV';
		    }
		    elsif ($info eq 'Premiere')
		    {
			$show->{'premiere'} = [ $info ];
			$type{premiere} = 1;
		    }
		    elsif ($info eq 'Live')
		    {
			$type{live} = 1;
		    }
		    elsif ($info eq 'Final' || $info eq 'Finale') # unseen
		    {
			$type{final} = 1;
		    }
		    elsif ($info eq 'Return') # unseen
		    {
			$type{return} = 1;
		    }
		    elsif ($info eq 'Repeat')
		    {
			$show->{'previously-shown'} = { };
		    }
		    elsif ($info eq 'Movie')
		    {
			$type{movie} = 1;
		    }
		    else
		    {
			&log("Unknown info field: \"$info\"");
		    }
		}
	    }
	    elsif ($1 eq 'Rating')
	    {
		$show->{rating} = $2;
	    }
	    elsif ($1 eq 'Year')
	    {
		$show->{date} = $2;
	    }
	    elsif ($1 eq 'Channel' or $1 eq 'Time')
	    {
		# ignore: handled elsewhere
	    }
	    else
	    {
		&log("Ignoring $1: $2") if ($debug);
	    }
	}
	else
	{
	    &log("Unknown field: " .$tr->as_text);
	}
    }
    $show->{video} = { %video } if (%video);
    $show->{category} = [ &Shepherd::Common::generate_category(
        $show->{title}, $category, %type) ];

    $tree->delete;

    print "Parsed: " . Dumper($show) if ($debug);
}

sub calculate_stop_times
{
    foreach my $ch (keys %$shows)
    {
	my $last_start_time;
	foreach my $s (reverse sort keys %{$shows->{$ch}})
	{
	    $shows->{$ch}->{$s}->{stop} = $last_start_time if ($last_start_time);
	    $last_start_time = $shows->{$ch}->{$s}->{start};
	}
    }
}

sub write_xml
{
    my %writer_args = ( encoding => 'ISO-8859-1' );

    &log("Writing " . &num_items($shows) . " shows to XML.");

    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'   => "Citysearch",
	    'generator-info-name' => "$progname $version"} );

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

    foreach my $ch (sort keys %$shows)
    {
	foreach my $s (sort keys %{$shows->{$ch}})
	{
	    # Don't return shows with no stop time
	    next unless ($shows->{$ch}->{$s}->{stop});

	    # Format for XMLTV-compliance
	    my %p = %{$shows->{$ch}->{$s}};
	    foreach my $field ('title', 'sub-title', 'desc', 'country')
	    {
		$p{$field} = [[ $p{$field}, $lang ]] if ($p{$field});
	    }
	    $p{language} = [ $p{language}, $lang ] if ($p{language});
	    $p{start} = &POSIX::strftime("%Y%m%d%H%M", localtime($p{start}));
	    $p{stop} = &POSIX::strftime("%Y%m%d%H%M", localtime($p{stop}));
	    $p{rating} = [[ $p{rating}, 'ABA', undef ]] if ($p{rating});
	    if ($p{category} && ref($p{category}) eq "ARRAY"
		    && $p{category}[0] && ref($p{category}[0]) ne "ARRAY") # obsolete 14/10/2007
	    {
		foreach (@{$p{category}})
		{
		    $_ = [ &Shepherd::Common::translate_category($_), $lang ];
		}
	    }
	    if ($p{subtitles})
	    {
		my @s;
		foreach (@{$p{subtitles}})
		{
		    push @s, { type => $_ };
		}
		$p{subtitles} = [ @s ];
	    }
	    delete $p{pid};
	    delete $p{details};

	    &log("-> " . $shows->{$ch}->{$s}->{title}) if ($debug);
#	    print Dumper(\%p);
	    $shows->{$ch}->{$s}->{start} = &POSIX::strftime("%Y%m%d%H%M", localtime($s));
	    $writer->write_programme(\%p);
	}
    }

    $writer->end();
}

# ---------------------------------------------------------------------
# Helper subs

sub num_items
{
    my $hash = shift;
    my $count = 0;
    foreach my $ch (keys %$hash)
    {
	$count += scalar keys %{$hash->{$ch}};
    }
    return $count;
}

sub is_outside_gaps
{
    my ($ch, $start, $stop) = @_;

    foreach my $gap (@{$gaps->{$ch}})
    {
	if ($gap =~ /(\d+)-(\d+)/)
	{
	    return 0 if ($stop > $1 and $start < $2);
	}
    }
    return 1;
}

sub strip_whitespace 
{
    $_[0] =~ /^\s*(.*?)\s*$/ ? $1 : $_[0];
}

# ---------------------------------------------------------------------
# Setup subs


sub read_cache
{
    $cache = Shepherd::Common::read_cache(\$opt->{'cache-file'});
    if ($cache)
    {
	&log("Retrieved " . &num_items($cache) . " cached items from file.");
	&clean_cache;
    }
    else
    {
	$cache = { };
	&log("Not using cache.");
    }
    if ($opt->{'dump-cache'})
    {
	&log("Dumping cache.");
	print Dumper($cache);
	exit 0;
    }
}

sub clean_cache
{
    my $cutoff = $runtime - 86400;   
    &log("Removing cached shows that finish earlier than " . localtime($cutoff) . ".") if ($debug);
    my $count = 0;

    foreach my $ch (keys %$cache)
    {
	foreach my $s (keys %{$cache->{$ch}})
	{
	    if ($cache->{$ch}->{$s}->{stop} < $cutoff)
	    {
		&log("Removing $cache->{$ch}->{$s}->{title}.") if ($debug);
		delete $cache->{$ch}->{$s};
		$count++;
	    }
	}
    }
    &log("Removed $count stale items from cache.") if ($count);
}

sub write_cache
{
    my $n = &num_items($cache);
    return unless ($n);
    &log("Writing $n shows to cache.");
    Shepherd::Common::write_cache($opt->{'cache-file'}, $cache);
}

sub set_region
{
    my %regions = ( 81 => 'adelaide', 75 => 'brisbane', 126 => 'canberra',
		    74 => 'darwin', 88 => 'hobart', 94 => 'melbourne', 
		    101 => 'perth', 73 => 'sydney' );
    unless ($regions{$opt->{region}})
    {
	&log("ERROR: unsupported region \"$opt->{region}\".");
	exit 3;
    }
    $opt->{rname} = $regions{$opt->{region}};
    $DATASOURCE = "http://$opt->{rname}.$DATASOURCE";
    &log("Datasource: $DATASOURCE") if ($debug);
}


sub get_command_line_options
{
    &Getopt::Long::Configure('pass_through');
    &GetOptions($opt, qw(
			    help
			    debug
			    output=s
			    days=i
			    offset=i
			    region=i
			    dump-cache
			    cache-file=s
			    channels_file=s
			    gaps_file=s
			    version
			    warper
			));
    $debug = $opt->{debug};

    if (@ARGV)
    {
	&log("\nUnknown option(s): @ARGV\n");
    }
}

sub set_defaults
{
    my $defaults = {
	'days' => 7,
	'offset' => 0,
	'region' => 94,
	'output' => &getcwd . '/output.xmltv',
	'cache-file' => &getcwd . '/' . $progname . '.cache',
	'channels_file' => &getcwd . '/channels.conf'
    };

    foreach (keys %$defaults)
    {
	unless (defined $opt->{$_})
	{
	    $opt->{$_} = $defaults->{$_};
	}
    }

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

    &Shepherd::Common::set_defaults(
	stats => \%stats,
	delay => "1-5",
	debug => $debug,
	webwarper => $opt->{warper}
	);

    # Initialize stats
    %stats = ( );
    foreach (qw( cache_hits shows ))
    {
	$stats{$_} = 0;
    }
}

sub read_channels_file 
{
    &read_config_file('channels', 'channels_file');
}

sub read_gaps_file
{
    &read_config_file('gaps', 'gaps_file');
    if ($gaps)
    {
	foreach (keys %$gaps)
	{
	    $gaps->{$channels->{$_}} = $gaps->{$_};
	    delete $gaps->{$_};
	}
    }
}

sub read_config_file
{
    my ($name, $arg) = @_;

    return unless ($opt->{$arg});
    &log("Reading $name file: $opt->{$arg}");
    if (-r $opt->{$arg})
    {
	local (@ARGV, $/) = ($opt->{$arg});
	no warnings 'all';
	eval <>;
	die "Can't parse $name file: $@" if ($@);
    }
    else
    {
	&log("Unable to read $name file.");
    }
}

sub log
{
    &Shepherd::Common::log(@_);
}

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

  --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

  --debug                Print lots of debugging output
};
    exit 0;
}