root/grabbers/abc2_website @ 102

#!/usr/bin/perl -w

# abc2_website au_tv guide grabber - runs from "Shepherd" master grabber
#  * written by ltd
#  * uses ABC website for ABC2 data ((http://www.abc.net.au/tv/guide/)
#  * when used in conjunction with Shepherd, shepherd can collect other channels
#    using other grabbers
#  * this does NOT use any config file - all settings are passed in from shepherd

#  changelog:
#    1.50  22sep06      added support for "shepherd" master grabber script
#    1.51  02oct06      --ready option
#    1.52  03oct06      split out abc grabber into its own grabber
#    1.55  09oct06      formalize --cheap option

use strict;

my $progname = "abc2_website";
my $version = "1.55_00oct06";

use LWP::UserAgent;
use Time::HiRes qw(gettimeofday tv_interval);
use XMLTV;
use POSIX qw(strftime mktime);
use Getopt::Long;
use HTML::TreeBuilder;
use Data::Dumper;
use Cwd;

#
# some initial cruft
#

my $script_start_time = [gettimeofday];
my %stats;
my $channels;
my $tv_guide;
my $data_cache;

# lets make sure we look exactly like the yahoo widget engine...
my $ua;
BEGIN {
        $ua = LWP::UserAgent->new(
                'timeout' => 30,
                'keep_alive' => 1,
                'agent' => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-us)'
                );
        $ua->env_proxy;
        # $ua->cookie_jar({});
        $| = 1;
}

#
# parse command line
#

my $opt_days =          7;                              # default
my $opt_offset =        0;                              # default
my $opt_timezone =      "1000";                         # default
my $opt_outputfile =    cwd() . "/abc2_website.xmltv";  # default
my $opt_configfile =    cwd() . "/abc2_website.conf";   # ignored
my $opt_cache_file =    cwd() . "/abc2_website.cache";  # ignored
my $opt_channels_file=  "";
my $opt_no_cache =      0;
my $opt_cheap =         0;
my $opt_fast =          0;
my $opt_warper =        0;
my $opt_obfuscate =     0;
my $opt_no_extra_days = 0;
my $opt_help =          0;
my $opt_version =       0;
my $opt_desc =          0;
my $opt_dont_retry =    0;
my $debug =             1;
my $lang =              "en";
my $region =            94;
my $time_offset =       0;

GetOptions(
        'region=i'      => \$region,
        'days=i'        => \$opt_days,
        'offset=i'      => \$opt_offset,
        'timezone=s'    => \$opt_timezone,
        'channels_file=s' => \$opt_channels_file,
        'output=s'      => \$opt_outputfile,
        'config-file=s' => \$opt_configfile,
        'cache-file=s'  => \$opt_cache_file,
        'no-extra-days' => \$opt_no_extra_days,
        'fast'          => \$opt_fast,
        'no-cache'      => \$opt_no_cache,
        'cheap'         => \$opt_cheap,
        'debug+'        => \$debug,
        'warper'        => \$opt_warper,
        'lang=s'        => \$lang,
        'obfuscate'     => \$opt_obfuscate,
        'no-retry'      => \$opt_dont_retry,
        'help'          => \$opt_help,
        'verbose'       => \$opt_help,
        'version'       => \$opt_version,
        'ready'         => \$opt_version,
        'desc'          => \$opt_desc,
        'v'             => \$opt_help);

&help if ($opt_help);

if ($opt_version || $opt_desc) {
        printf "%s %s\n",$progname,$version;
        printf "%s is a details-aware grabber that collects decent quality data using the ABC website for ABC2 only.",$progname if $opt_desc;
        exit(0);
}

die "no channel file specified, see --help for instructions\n", if ($opt_channels_file eq "");

#
# go go go!
#

# normalize starttime to an hour..
my $starttime = time;
my ($sec,$min,@rest) = localtime($starttime);
$starttime -= ((60 * $min) + $sec);
my $endtime = $starttime + (($opt_no_extra_days ? $opt_days : 14) * 86400);
$starttime += (86400 * $opt_offset);

&log(sprintf "going to %s %s%d%s days%s of data into %s (%s%s%s)",
        ($opt_cheap ? "verify (cache-validate)" : "grab"),
        ($opt_no_extra_days ? "" : "somewhere between "),
        $opt_days,
        ($opt_no_extra_days ? "" : " to 14"),
        ($opt_offset ? " (skipping first %d days)" : ""),
        $opt_outputfile,
        ($opt_fast ? "with haste" : "slowly"),
        ($opt_warper ? ", anonymously" : ""),
        ($opt_no_cache ? ", without caching" : ", with caching"));

# read channels file
if (-r $opt_channels_file) {
        local (@ARGV, $/) = ($opt_channels_file);
        no warnings 'all'; eval <>; die "$@" if $@;
} else {
        die "WARNING: channels file $opt_channels_file could not be read\n";
}

&read_cache if ($opt_no_cache == 0);
&get_abc_data($starttime,$endtime,"ABC2",$channels->{ABC2},"http://www.abc.net.au/tv/guide/abc2");
&write_cache if ($opt_no_cache == 0);

&write_data;
&print_stats;
exit(0);

######################################################################################################
# help

sub help
{
        print<<EOF
$progname $version

options are as follows:
        --help                  show these help options
        --days=N                fetch 'n' days of data (default: $opt_days)
        --output=file           send xml output to file (default: "$opt_outputfile")
        --config-file=file      (ignored - historically used by grabbers not not this one)
        --no-cache              don't use a cache to optimize (reduce) number of web queries
        --cheap                 validate contents of cache - fetch summary only, not details
        --cache-file=file       where to store cache (default "$opt_cache_file")
        --fast                  don't run slow - get data as quick as you can - not recommended
        --debug                 increase debug level
        --warper                fetch data using WebWarper web anonymizer service
        --obfuscate             pretend to be a proxy servicing multiple clients
        --no-extra-days         don't fetch extra (14 days) from ABC website
        --no-retry              if webserver is rejecting our request, don't retry (default: do retry)
        --lang=[s]              set language of xmltv output data (default $lang)

        --shepherd              set if being called from the shepherd script
        --region=N              set region for where to collect data from (default: $region)
        --channels_file=file    where to get channel data from (if not set manually)
        --timezone=HHMM         timezone for channel data (default: $opt_timezone)
EOF
;

        exit(0);
}

######################################################################################################
# populate cache

sub read_cache
{
        if (-r $opt_cache_file) {
                local (@ARGV, $/) = ($opt_cache_file);
                no warnings 'all'; eval <>; die "$@" if $@;
        } else {
                printf STDERR "WARNING: no programme cache $opt_cache_file - have to fetch all details\n";

                # try to write to it - if directory doesn't exist this will then cause an error
                &write_cache;
        }
}

######################################################################################################
# write out updated cache

sub write_cache
{
        if (!(open(F,">$opt_cache_file"))) {
                printf STDERR "WARNING: could not write cache file $opt_cache_file: $!\n";
                printf STDERR "Please fix this in order to reduce the number of queries for data!\n";
                sleep 10;
        } else {
                # cleanup old entries from cache
                for my $cache_key (keys %{$data_cache}) {
                        my ($starttime, $endtime, $channel, $progname) = split(/,/,$cache_key);
                        if ($starttime < (time-86400)) {
                                delete $data_cache->{$cache_key};
                                $stats{removed_items_from_cache}++;
                        }
                }
                print F Data::Dumper->Dump([$data_cache], ["data_cache"]);
                close F;
        }
}

######################################################################################################

sub add_cached_data
{
        my ($channel,$starttime,$cache_key) = @_;
        $tv_guide->{$channel}->{data}->{$starttime}->{'sub-title'} =    [[ $data_cache->{$cache_key}->{subtitle}, $lang ]] if $data_cache->{$cache_key}->{subtitle};
        $tv_guide->{$channel}->{data}->{$starttime}->{'desc'} =         [[ $data_cache->{$cache_key}->{desc}, $lang ]] if $data_cache->{$cache_key}->{desc};
        $tv_guide->{$channel}->{data}->{$starttime}->{'category'} =     [[ $data_cache->{$cache_key}->{genre}, $lang ]] if $data_cache->{$cache_key}->{genre};
}

######################################################################################################

sub get_abc_data
{
        my ($starttime,$endtime,$channel,$xmlid,$urlbase) = @_;
        my $try_to_add_abc_detail;
        my $unprocessed_programmes = 0;
        my $stop_fetching = 0;
        my @unprocessed_progname, my @unprocessed_starttime, my @unprocessed_url;
        my $daynum = 0;

        for (my $currtime = $starttime; $currtime < $endtime; $currtime += 86400) {
                $daynum++;
                # for abc portal data, treat a faulure as a hint that there is no further data.
                # sometimes they have as much as 30 days of data ahead.  sometimes much less...
                if ($stop_fetching == 0) {
                        my @timeattr = localtime($currtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst

                        my $url = sprintf "%s/%s.htm",$urlbase,(strftime "%Y%m/%Y%m%d",localtime($currtime));
                        my $status = sprintf "%s summary data: day %d of %d", $xmlid, ((($currtime-$starttime)/86400)+1),(($endtime-$starttime)/86400);
                        my $data = &get_url($url,$status,($daynum < 8 ? 5 : 2));
                        my $seen_programmes = 0;

                        if ($data) {    
                                my $tree = HTML::TreeBuilder->new_from_content($data);
                                for ($tree->look_down('_tag' => 'div', 'class' => 'scheduleDiv')) {
                                        foreach my $tree_tr ($_->look_down('_tag' => 'tr')) {
                                                if (my $tree_row = $tree_tr->look_down('_tag' => 'th', 'scope' => 'row')) {
                                                        if ($tree_row->as_text() =~ /^(\d+):(\d+)(.)m/) {
                                                                $timeattr[2] = $1; # hour
                                                                $timeattr[2] += 12 if ($3 eq "p"); # pm
                                                                $timeattr[1] = $2; # min
                                                                my $found_time = mktime(@timeattr);
        
                                                                if ($tree_tr->look_down('_tag' => 'td')) {
                                                                        if ($_ = $tree_tr->look_down('_tag' => 'a')) {
                                                                                my $programme = $_->as_text();
                                                                                my $progurl = $_->attr('href');
                
                                                                                if ($progurl =~ /^\/tv\/guide\//) {
                                                                                        $unprocessed_progname[$unprocessed_programmes] = $programme;
                                                                                        $unprocessed_starttime[$unprocessed_programmes] = $found_time;
                                                                                        $unprocessed_url[$unprocessed_programmes] = "http://www.abc.net.au".$progurl;
                                                                                        $unprocessed_programmes++;
                                                                                        $seen_programmes++;
                                                                                }
                                                                        }
                                                                }
                                                        }
                                                }
                                        }
                                }
                        }
        
                        if ($seen_programmes == 0) {
                                $stop_fetching = 1;
                        } else {
                                $stats{abc_daily_pages}++;
                        }
                }
        }

        # have 'n' days of this channel unprocessed - process it!
        for (my $i = 0; $i < ($unprocessed_programmes-1); $i++) {
                $stats{programmes}++;
                my $starttime = $unprocessed_starttime[$i];
                my $endtime = $unprocessed_starttime[$i+1];
                my $cache_key = sprintf "%d,%d,%s,%s", $starttime, $endtime, $xmlid, $unprocessed_progname[$i];

                $tv_guide->{$channel}->{data}->{$starttime}->{'channel'} =      $xmlid;
                $tv_guide->{$channel}->{data}->{$starttime}->{'start'} =        strftime "%Y%m%d%H%M %z", localtime($starttime);
                $tv_guide->{$channel}->{data}->{$starttime}->{'stop'} =         strftime "%Y%m%d%H%M %z", localtime($endtime);
                $tv_guide->{$channel}->{data}->{$starttime}->{'title'} =        [[ $unprocessed_progname[$i], $lang ]];

                if ($data_cache->{$cache_key}) {
                        $stats{used_cached_data}++;
                        &add_cached_data($channel,$starttime,$cache_key);
                } else {
                        &get_one_abc_event($channel, $cache_key, $unprocessed_url[$i], "$xmlid detail pages ($i of $unprocessed_programmes)") if (!$opt_cheap);
                }
        }
}

######################################################################################################

sub get_one_abc_event
{
        my ($channel, $cache_key, $url, $status) = @_;
        my $seen_programme = 0;
        my ($starttime, $endtime, $xmlid, $progname) = split(/,/,$cache_key);

        do {
                my $data = &get_url($url,$status,3);

                my $tree = HTML::TreeBuilder->new_from_content($data);
                if (my $inner_tree = $tree->look_down('_tag' => 'div', 'class' => 'column2')) {
                        my $event_title = undef, my $event_subtitle = undef, my $event_description = undef, my $event_genre = undef;

                        if (my $prog_h2 = $inner_tree->look_down('_tag' => 'h2')) {
                                my $full_title = $prog_h2->as_HTML();
                                ($event_title,$event_subtitle) = split(/<br>/,$full_title);

                                $event_title =~ s/(<[a-zA-Z0-9]+\>)//g; # remove html tags
                                $event_title =~ s/(^\n|\n$)//g;         # strip trailing/leading blank lines

                                if ($event_subtitle) {
                                    $event_subtitle =~ s/(<[\/a-zA-Z0-9]+\>)//g;        # remove html tags
                                    $event_subtitle =~ s/(^\n|\n$)//g;          # strip trailing/leading blank lines
                                }
                        }
                        
                        my $paranum = 0;
                        foreach my $para ($inner_tree->look_down('_tag' => 'p')) {
                                $paranum++;

                                if (($paranum > 1) && (!($para->as_text() =~ /^Go to website/)) && (!($para->as_text() =~ /^Send to a Friend/))) {
                                        $event_description .= $para->as_text() . "\n";

                                        if (my $try_genre = $para->look_down('_tag' => 'a')) {
                                                $event_genre = $try_genre->as_text();
                                        }
                                }
                        }
                        $stats{portal_detail_pages}++;
                        $seen_programme++;

                        $data_cache->{$cache_key}->{subtitle} = $event_subtitle if $event_subtitle;
                        $data_cache->{$cache_key}->{desc} = $event_description if $event_description;
                        $data_cache->{$cache_key}->{genre} = $event_genre if $event_genre;
                        &add_cached_data($channel,$starttime,$cache_key);
                }
                if ($seen_programme == 0) {
                        printf STDERR "WARNING: failed to parse any programme data from '%s' - blocked/rate-limited/format-changed?\n",$url;
                        $stats{failed_to_parse_portal_detail_page}++;
                }
        } until (($seen_programme> 0) || ($opt_dont_retry>0));
}

######################################################################################################
# logic to fetch a page via http
#  retries up to 3 times to get a page with 5 second pauses inbetween

sub get_url
{
        my ($url,$status,$retrycount) = @_;
        my $response;
        my $attempts = 0;
        my ($raw, $page, $base);

        $retrycount = 5 if ($retrycount == 0);
        $url =~ s#^http://#http://webwarper.net/ww/# if $opt_warper;
        my $request = HTTP::Request->new(GET => $url);
        $request->header('Accept-Encoding' => 'gzip');

        if ($opt_obfuscate) {
                my $randomaddr = sprintf "203.%d.%d.%d",rand(255),rand(255),(rand(254)+1);
                $request->header('Via' => '1.0 proxy:81 (Squid/2.3.STABLE3)');
                $request->header('X-Forwarded-For' => $randomaddr);
        }
        &log(sprintf "fetching %s%s: %s",$status,($opt_obfuscate ? "[obfuscate]" : ""),$url);
        for (1..$retrycount) {
                $response = $ua->request($request);
                last if $response->is_success;

                $stats{http_failed_requests}++;
                $stats{slept_for} += 10;
                $attempts++;
                sleep 10;
        }
        if (!($response->is_success)) {
                &log("aborting after $attempts attempts to fetch url $url") if ($debug && $retrycount > 3);
                return undef;
        }

        $stats{bytes_fetched} += do {use bytes; length($response->content)};
        $stats{http_successful_requests}++;

        if (!$opt_fast) {
                my $sleeptimer = int(rand(5)) + 1;  # sleep anywhere from 1 to 5 seconds
                $stats{slept_for} += $sleeptimer;
                sleep $sleeptimer;
        }

        if ($response->header('Content-Encoding') &&
            $response->header('Content-Encoding') eq 'gzip') {
                $stats{compressed_pages} += do {use bytes; length($response->content)};
                $response->content(Compress::Zlib::memGunzip($response->content));
        }
        return $response->content;
}

######################################################################################################

sub log
{
        my ($entry) = @_;
        printf STDERR "%s [%d] %s\n",$progname,time,$entry;
}

######################################################################################################

sub print_stats
{
        printf STDERR "%s v%s [%d] completed in %0.2f seconds",$progname,$version,time,tv_interval($script_start_time);
        foreach my $key (sort keys %stats) {
                printf STDERR ", %d %s",$stats{$key},$key;
        }
        printf STDERR "\n";
}

######################################################################################################
# descend a structure and clean up various things, including stripping
# leading/trailing spaces in strings, translations of html stuff etc
#   -- taken & modified from Michael 'Immir' Smith's excellent tv_grab_au

my %amp;
BEGIN { %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } ) }

sub cleanup {
        my $x = shift;
        if    (ref $x eq "REF")   { cleanup($_) }
        elsif (ref $x eq "HASH")  { cleanup(\$_) for values %$x }
        elsif (ref $x eq "ARRAY") { cleanup(\$_) for @$x }
        elsif (defined $$x) {
                $$x =~ s/&(#(\d+)|(.*?));/ $2 ? chr($2) : $amp{$3}||' ' /eg;
                # $$x =~ s/[^\x20-\x7f]/ /g;
                $$x =~ s/(^\s+|\s+$)//g;
        }
}

######################################################################################################

sub write_data
{
        my %writer_args = ( encoding => 'ISO-8859-1' );
        if ($opt_outputfile) {
                my $fh = new IO::File(">$opt_outputfile")  or die "can't open $opt_outputfile: $!";
                $writer_args{OUTPUT} = $fh;
        }

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

        $writer->start
          ( { 'source-info-url'    => "about:blank",
              'source-info-name'   => "$progname $version",
              'generator-info-name' => "$progname $version"} );

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

        for my $channel (sort keys %{$channels}) {
                for my $event_id (sort {$a <=> $b} keys %{($tv_guide->{$channel}->{data})}) {
                        my $show = $tv_guide->{$channel}->{data}->{$event_id};
                        &cleanup($show);
                        $writer->write_programme($show);
                }
        }

        $writer->end();
}

######################################################################################################