root/grabbers/ten_website @ 425

#!/usr/bin/perl -w

# network TEN au_tv guide grabber - runs from "Shepherd" master grabber
#  * grabs data from the network TEN website (http://www.ten.com.au)
#    for channel TEN only
#  * this does NOT use any config file - all settings are passed in from shepherd
#  * idea based on OCR::PerfectCR CPAN module

use strict;

my $progname = "ten_website";
my $version = "0.01";

use LWP::UserAgent;
use LWP::ConnCache;
use XMLTV;
use POSIX qw(strftime mktime);
use Getopt::Long;
use HTML::TreeBuilder;
use Data::Dumper;
use Compress::Zlib;
use GD;
use Digest::MD5;

#
# global variables and settings
#

$| = 1;
my $script_start_time = time;
my %stats;
my $channels, my $opt_channels;
my $data_cache;
my $ua;
my $conn_cache;
my $prev_url;
my $d;
my $opt;
my %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } );


#
# parse command line
#

$opt->{days} =          7;                      # default
$opt->{outputfile} =    "output.xmltv";         # default
$opt->{cache_file} =    $progname.".cache";     # default
$opt->{lang} =          "en";
$opt->{region} =        94;

GetOptions(
        'log-http'      => \$opt->{log_http},
        'region=i'      => \$opt->{region},
        'days=i'        => \$opt->{days},
        'offset=i'      => \$opt->{offset},
        'timezone=s'    => \$opt->{timezone},
        'channels_file=s' => \$opt->{channels_file},
        'output=s'      => \$opt->{outputfile},
        'cache-file=s'  => \$opt->{cache_file},
        'fast'          => \$opt->{fast},
        'no-cache'      => \$opt->{no_cache},
        'no-details'    => \$opt->{no_details},
        'debug+'        => \$opt->{debug},
        'warper'        => \$opt->{warper},
        'lang=s'        => \$opt->{lang},
        'no-hdtv-flags' => \$opt->{no_hdtv_flags},
        'obfuscate'     => \$opt->{obfuscate},

        'ocr-learn-mode' => \$opt->{ocr_learn_mode},

        'help'          => \$opt->{help},
        'verbose'       => \$opt->{help},
        'version'       => \$opt->{version},
        'ready'         => \$opt->{version},
        'v'             => \$opt->{help});

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

if ($opt->{version}) {
        printf "%s %s\n",$progname,$version;
        exit(0);
}

die "no channel file specified, see --help for instructions\n", if (!$opt->{channels_file});
$opt->{days} = 7 if ($opt->{days} > 7); # limit to a max of 7 days

# check XMLTV version for HDTV compatability
my @xmltv_version = split(/\./,$XMLTV::VERSION);
if (($xmltv_version[0] <= 0) && ($xmltv_version[1] <= "5") && ($xmltv_version[2] <= "43")) {
        &log("XMLTV version ".$XMLTV::VERSION." too old to support HDTV flags. Disabling HDTV flags.");
        $opt->{no_hdtv_flags} = 1;
        $stats{disabled_hdtv_flag}++;
}

#
# go go go!
#

&log(sprintf "going to grab %d days%s of data into %s (%s%s%s%s)",
        $opt->{days},
        (defined $opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
        $opt->{outputfile},
        (defined $opt->{fast} ? "with haste" : "slowly"),
        (defined $opt->{warper} ? ", anonymously" : ""),
        (defined $opt->{no_details} ? ", without details" : ", with details"),
        (defined $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";
}

die "TEN not listed as a channel in ".$opt->{channels_file}.", nothing to do!\n" if (!defined $channels->{TEN});

&read_cache unless (defined $opt->{no_cache});

&set_ua;
&setup_charset;

&set_region;

&get_summary_pages;
&get_detail_pages unless (defined $opt->{no_details});

&write_xmltv;

&write_cache unless (defined $opt->{no_cache});

&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}")
        --no-cache              don't use a cache to optimize (reduce) number of web queries
        --no-details            don't fetch detailed descriptions (default: do)
        --no-hdtv-flags         don't mark HD programs as being in HDTV (default: do)
        --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
        --anonsocks=(ip:port)   use SOCKS4A server at (ip):(port) (for Tor: recommended)

        --debug                 increase debug level
        --warper                fetch data using WebWarper web anonymizer service
        --obfuscate             pretend to be a proxy servicing multiple clients
        --lang=[s]              set language of xmltv output data (default $opt->{lang})

        --region=N              set region for where to collect data from (default: $opt->{region})
        --channels_file=file    where to get channel data from

        --ocr-learn-mode        put $progname into OCR learning mode to learn the text

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 "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 "ERROR: could not write cache file $opt->{cache_file}: $!\n";
                printf "Please fix this in order to reduce the number of queries for data!\n";
                exit 1;
        } else {
                # cleanup old entries from cache
                for my $k (keys %{($data_cache->{id_cache})}) {
                        if ($data_cache->{id_cache}->{$k}->{last_used} < (time-(86400*14))) {
                                delete $data_cache->{id_cache}->{$k};
                                $stats{expired_from_cache}++;
                        }
                }

                for my $k (keys %{($data_cache->{detail_cache})}) {
                        if ($data_cache->{detail_cache}->{$k}->{last_used} < (time-(86400*14))) {
                                delete $data_cache->{detail_cache}->{$k};
                                $stats{expired_from_cache}++;
                        }
                }

                print F Data::Dumper->Dump([$data_cache], ["data_cache"]);
                close F;
        }
}

##############################################################################
# logic to fetch a page via http
#  retries up to $retrycount times to get a page with 10 second pauses inbetween

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

        $reqtype = "GET" if (!defined $reqtype);

        $retrycount = 5 if ($retrycount == 0);
        $url =~ s#^http://#http://webwarper.net/ww/# if (defined $opt->{warper});

        if ($reqtype eq "GET") {
                $request = HTTP::Request->new(GET => $url);
        } elsif ($reqtype eq "HEAD") {
                $request = HTTP::Request->new(HEAD => $url);
        } elsif ($reqtype eq "POST") {
                $request = HTTP::Request->new(POST => $url);
                $request->header('Content-type' => 'application/x-www-form-urlencoded');
                $request->add_content($postvars);
        }

        if (defined $referer) {
                $request->header('Referer' => $referer);
        } else {
                $request->header('Referer' => $prev_url) if (defined $prev_url);
        }
        $prev_url = $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);
        }

        my $status;
        for (1..$retrycount) {
                $response = $ua->request($request);

                if ((defined $opt->{log_http}) && (open(F,">>http_log.txt"))) {
                        printf F "\n----------------------------------------------------\n";
                        printf F "request: %s %s %s\n",$reqtype,$url,(defined $postvars ? $postvars : "");
                        printf F "referer: %s\n", ($request->header('Referer') ? $request->header('Referer') : "(none)");
                        printf F "response: %s\n",$response->status_line;
                        print F $response->content;
                        close F;
                }

                if ($response->is_success) {
                        if ($response->content =~ /we are unable to process your request/) {
                                $status = "fail: 999: Service unavailable"; # CPAN's LWP lied to us
                        } else {
                                $status = "good";
                                last;
                        }
                } else {
                        $status = "fail: ".$response->status_line;
                }

                $stats{http_failed_requests}++;
                $attempts++;

                my $sleep_for = 60;

                &log("attempt $attempts of $retrycount failed to fetch $url, sleeping for $sleep_for secs: $status");

                $stats{slept_for} += $sleep_for;
                sleep $sleep_for;
        }
        if ($status !~ /^good/) {
                &log("aborting after $attempts attempts to fetch url $url");
                return undef;
        }

        $prev_url = $response->base;
        $prev_url =~ s#^http://webwarper.net/ww/#http://# if (defined $opt->{warper});

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

        if ($reqtype eq "HEAD") {
                return $response->header("Content-Length");
        }

        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 "%s [%d] %s\n",$progname,time,$entry;
}

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

sub print_stats
{
        printf "STATS: %s v%s completed in %d seconds",$progname, $version, time-$script_start_time;
        foreach my $key (sort keys %stats) {
                printf ", %d %s",$stats{$key},$key;
        }
        printf "\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

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_xmltv
{
        my $writer;

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

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

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

        $writer->write_channel( {
                'display-name' => [[ "TEN", $opt->{lang} ]], 'id' => $channels->{TEN} } );

        foreach my $prog (@{($d->{progs})}) {
                # convert epoch starttime into XMLTV starttime
                next if (!defined $prog->{starttime});
                $prog->{start} = strftime "%Y%m%d%H%M", localtime($prog->{starttime});
                delete $prog->{starttime};

                # convert epoch stoptime into XMLTV stoptime
                next if (!defined $prog->{stoptime});
                $prog->{stop} = strftime "%Y%m%d%H%M", localtime($prog->{stoptime});
                delete $prog->{stoptime};

                delete $prog->{details};
                delete $prog->{id};

                &cleanup($prog);
                printf "DEBUG: programme xmltv: ".Dumper($prog) if (defined $opt->{debug});
                $writer->write_programme($prog);
        }

        $writer->end();
}

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

sub set_ua
{
        my @agent_list = (
                'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)',
                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)',
                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; FunWebProducts)',
                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)',
                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)',
                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; Q312466)',
                'Mozilla/4.0 (compatible; MSIE 6.0; Windows XP)',
                'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85.8.5 (KHTML, like Gecko) Safari/85.8.1',
                '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',
                'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.8) Gecko/20061025 Firefox/1.5.0.8',
                'Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1) Gecko/20061010 Firefox/2.0',
                'Mozilla/5.0 (compatible; Yahoo! Slurp; http://help.yahoo.com/help/us/ysearch/slurp)',
                'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/412 (KHTML, like Gecko) Safari/412',
                'Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en-us) AppleWebKit/418.9 (KHTML, like Gecko) Safari/419.3',
                'Mozilla/5.0 (Macintosh; U; Intel Mac OS X; fr) AppleWebKit/418.9 (KHTML, like Gecko) Safari/419.3',
                'Opera/9.00 (Windows NT 5.1; U; en)');

        $ua = undef;
        $conn_cache = LWP::ConnCache->new;
        $ua = LWP::UserAgent->new('conn_cache' => $conn_cache, 'timeout' => 30, 'agent' => $agent_list[(int(rand($#agent_list+1)))] );
        $ua->env_proxy;
        $ua->cookie_jar({ });


        $prev_url = undef; # reset referer
}

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

sub urlify
{
        my $str = shift;
        $str =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
        $str =~ s/%20/+/g;
        $str =~ s/%2D/-/g;
        return $str;
}

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

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

        return $translation{$genre} if defined $translation{$genre};
        return $genre;
}

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

sub set_region
{
        &log("setting region");

        my $url = sprintf "http://www.ten.com.au/citySelect.aspx?change=true";
        my $data = &get_url($url,5);
        if (!$data) {
                &log("CRITICAL ERROR: Could not set region because of error fetching '$url'");
                exit(1);
        }

        my $tree = HTML::TreeBuilder->new_from_content($data);
        if (!$tree) {
                &log("CRITICAL ERROR: url '$url' doesn't seem to contain any valid HTML: has the format changed?");
                exit(1);
        }

        $opt->{viewstate} = $_->attr('value') if ($_ = $tree->look_down('_tag' => 'input', 'type' => 'hidden', 'name' => '__VIEWSTATE'));
        if (!defined $opt->{viewstate}) {
                &log(" has the format changed? could not find 'viewstate'...");
                $stats{viewstate_not_found}++;
                $opt->{viewstate} = "";
        }

        my $reg = 1;                                                    # sydney
        $reg = 2 if ($opt->{region} =~ /^9/);                           # melbourne
        $reg = 3 if ($opt->{region} =~ /(75|78|79|114|74|108)/);        # brisbane
        $reg = 4 if ($opt->{region} =~ /(101|102)/);                    # perth
        $reg = 5 if ($opt->{region} =~ /(81|82|83|85|86|107)/);         # adelaide

        my $postvars = "__VIEWSTATE=".urlify($opt->{viewstate})."&new_site_id=".$reg."&_ctl1.x=0&_ctl1.y=0";
        $data = &get_url($url, 5, undef, "POST", $postvars);

        $stats{programmes} = 0 if (!defined $stats{programmes});
}

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

sub get_summary_pages
{
        my $starttime = time;
        my $day_num = 0;
        my $skip_days = 0;

        $skip_days = $opt->{offset} if (defined $opt->{offset});
        while ($day_num < $opt->{days}) {
                my $currtime = $starttime + (60*60*24 * $day_num);
                $day_num++;

                # skip if --offset applies against this day
                if ($skip_days > 0) {
                        $skip_days--;
                        next;
                }

                my @timeattr = localtime($currtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
                $timeattr[0] = 0; # zero sec
                $timeattr[1] = 0; # zero min
                $timeattr[2] = 0; # midnight
                my $day_start = mktime(@timeattr);

                &log("fetching day $day_num summary page");
                &parse_summary_page($day_start, $day_num);
        }
}

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

sub parse_summary_page
{
        my ($day_start, $day_num) = @_;
        my %seen_prog;

        my $url = "http://www.ten.com.au/programGuide.aspx?section=programGuide";
        my $postvars = "__VIEWSTATE=".urlify($opt->{viewstate}).
                "&newDate=".urlify(POSIX::strftime("%Y-%m-%d %H:%M:%S",localtime($day_start))).".000".
                "&newTime=&newGenre=&newKeyword=&filterButton.x=0&filterButton.y=0&sq=";
        $postvars .= "&storeDate=".urlify($opt->{storedate}) if (defined $opt->{storedate});

        &log("parse_summary_page debug: day_start $day_start day_num $day_num POST $postvars") if (defined $opt->{debug} && $opt->{debug} > 2);

        my $data = &get_url($url, 5, undef, "POST", $postvars);
        if (!$data) {
                &log("url '$url' (POST $postvars) doesn't seem to contain any valid response.");
                $stats{bad_response}++;
                return;
        }

        my $tree = HTML::TreeBuilder->new_from_content($data);
        if (!$tree) {
                &log("url '$url' (POST $postvars) doesn't seem to contain any valid HTML: has the format changed?");
                $stats{bad_html}++;
                return;
        }

        if (my $viewstate_field = $tree->look_down('_tag' => 'input', 'type' => 'hidden', 'name' => '__VIEWSTATE')) {
                my $new_viewstate = $viewstate_field->attr('value');
                $opt->{viewstate} = $new_viewstate if (defined $new_viewstate);
        }

        if (my $storedate_field = $tree->look_down('_tag' => 'input', 'type' => 'hidden', 'name' => 'storeDate')) {
                my $page_date = $storedate_field->attr('value');
                $opt->{storedate} = $page_date if (defined $page_date);
        }

        my $progs_in_day = 0;

        my @tree_rows = $tree->look_down('_tag' => 'tr');
        foreach my $tree_pg (@tree_rows) {
                my $yellow_row_count = 0;
                my $prog_bg;
                my $prog_fg;
                my $prog_details;
                my $prog_rating;
                my $prog_cc;
                my $prog_hd;

                foreach my $prog_td ($tree_pg->look_down('_tag' => 'td')) {
                        my $prog_td_class = $prog_td->attr('class');
                        if ((defined $prog_td_class) && ($prog_td_class eq "pgimgcell") && (!defined $prog_bg)) {
                                if (my $style_tag = $prog_td->attr('style')) {
                                        if ($style_tag =~ /^background:url\((.*)\) /) {
                                                $prog_bg = $1;
                                                &log("got prog_bg '$prog_bg'") if (defined $opt->{debug} && $opt->{debug} > 1);
                                        }
                                }

                                if ((!defined $prog_fg) && (my $img_tag = $prog_td->look_down('_tag' => 'img', 'class' => 'pgimg'))) {
                                        $prog_fg = $img_tag->attr('src');
                                        &log("got prog_fg '$prog_fg'") if (defined $opt->{debug} && $opt->{debug} > 1);
                                }

                                if ((!defined $prog_details) && (my $link_tag = $prog_td->look_down('_tag' => 'a', 'href' => '#'))) {
                                        my $link_url = $link_tag->attr('onClick');
                                        if ($link_url =~ /^window\.open\('(.+?)'/) {
                                                $prog_details = $1;
                                                &log("got prog_details '$prog_details'") if (defined $opt->{debug} && $opt->{debug} > 1);
                                        }
                                }
                        } elsif ((defined $prog_td_class) && ($prog_td_class eq "yellow")) {
                                $yellow_row_count++;
                                if ($yellow_row_count == 1) {           # HD flag
                                        if ($prog_td->as_text() =~ /HD/) {
                                                $prog_hd = 1;
                                                &log("prog is in HD") if (defined $opt->{debug} && $opt->{debug} > 1);
                                        } else {
                                                $prog_hd = 0;
                                        }
                                } elsif ($yellow_row_count == 2) {      # CC flag
                                        if ($prog_td->as_text() =~ /Y/) {
                                                $prog_cc = 1;
                                                &log("prog has closed captions") if (defined $opt->{debug} && $opt->{debug} > 1);
                                        } else {
                                                $prog_cc = 0;
                                        }
                                } elsif ($yellow_row_count == 3) {      # rating
                                        $prog_rating = $prog_td->as_text();
                                        &log("prog has rating '$prog_rating'") if (defined $opt->{debug} && $opt->{debug} > 1);
                                }
                        }
                }

                &log("finished evaluating row") if (defined $opt->{debug} && $opt->{debug} > 1);

                if ((defined $prog_fg) && (defined $prog_bg) && (defined $prog_details)) {
                        next if (defined $seen_prog{$prog_details});
                        $seen_prog{$prog_details}++;

                        $progs_in_day++;
                        &parse_one_summary_prog($day_start, $day_num, $progs_in_day, $prog_fg, $prog_bg, $prog_details, $prog_rating, $prog_hd, $prog_cc);
                }
        }

        &log("WARNING: Only $progs_in_day programmes seen on day $day_num in '$url' (POST $postvars). ".
          "Data may be bad.") if ($progs_in_day < 10);

        unless (defined $opt->{fast}) {
                my $sleep_for = 20 + int(rand(5));
                &log(" .. found $progs_in_day programmes on day $day_num, sleeping for $sleep_for seconds.");
                sleep $sleep_for;
                $stats{slept_for} += $sleep_for;
        }
}

##############################################################################
# given a summary-line of a programme, turn it into a prog entry

sub parse_one_summary_prog
{
        my ($day_start, $day_num, $progs_in_day, $prog_fg, $prog_bg, $prog_details, $prog_rating, $prog_hd, $prog_cc) = @_;
        my $prog;

        my $id;
        $id = $1 if ($prog_bg =~ /id=(\d+)$/);

        my $s;

        if (!defined $data_cache->{id_cache}->{$id}) {
                $s = &ocr_image($id, "http://www.ten.com.au".$prog_fg, "http://www.ten.com.au".$prog_bg, 3, ($day_num == 1 ? 6 : 14), 0);
                $data_cache->{id_cache}->{$id}->{ocr_text} = $s;
        } else {
                $s = $data_cache->{id_cache}->{$id}->{ocr_text};
                $stats{used_cached_items}++;
        }
        $data_cache->{id_cache}->{$id}->{last_used} = time;

        if ($s =~ /\s*(\d+):(\d+)\s*(A|P)M\s+(.*)$/) {
                my $prog_hr = $1;
                $prog_hr = 0 if ($prog_hr == 12);

                $prog->{starttime} = (($prog_hr * 60) + $2) * 60; # seconds
                $prog->{starttime} += (60*60*12) if (lc($3) eq "p");

                $prog->{title} = [[ $4, $opt->{lang} ]];
        } elsif ($s =~ /\s*(\d+)\.(\d+)\.(\d+)\s+(\d+):(\d+)\s*(A|P)M\s+(.*)$/) {
                my $prog_hr = $4;
                $prog_hr = 0 if ($prog_hr == 12);

                $prog->{starttime} = (($prog_hr * 60) + $5) * 60; # seconds
                $prog->{starttime} += (60*60*12) if (lc($6) eq "p");

                $prog->{title} = [[ $7, $opt->{lang} ]];
        }

        if (!defined $prog->{title}) {
                &log("could not parse progname from OCR string '$s'. Format changed?");
                $stats{unparsable_name}++;
                return;
        }
        if (!defined $prog->{starttime}) {
                &log("could not parse start time from OCR string '$s'. Format changed?");
                $stats{unparsable_time}++;
                return;
        }

        if ($prog->{starttime} < (12*60*60)) {
                $prog->{starttime} += (24*60*60) if (defined $d->{seen_pm}->[$day_num]);
        } else {
                $d->{seen_pm}->[$day_num] = 1 if (!defined $d->{seen_pm}->[$day_num]);
        }
        $prog->{starttime} += $day_start;

        $prog->{id} = $id;
        $prog->{details} = $prog_details;
        $prog->{channel} = $channels->{TEN};

        if ((defined $prog_rating) && ($prog_rating ne "")) {
                my @ratings;
                push(@ratings, [$prog_rating, 'ABA', undef]);
                $prog->{rating} = [ @ratings ];
        }

        $prog->{subtitles} = [ { 'type' => 'teletext' } ] if ($prog_cc);
        if ($prog_hd) {
                $prog->{video}->{aspect} = "16:9";      # widescreen
                $prog->{video}->{quality} = "HDTV" unless (defined $opt->{no_hdtv_flags});
        }

        push(@{($d->{progs})},$prog);

        if ($stats{programmes} > 0) {
                # set previous stoptime based on this starttime
                $d->{progs}->[($stats{programmes}-1)]->{stoptime} = $prog->{starttime};
        }
        $stats{programmes}++;

        &log("parse_one_summary_prog: d".$day_num."p".$progs_in_day." ".$prog_details.": start:".$prog->{starttime}." name:".$prog->{title}->[0]->[0]) if (defined $opt->{debug});

}

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

sub get_detail_pages
{
        my $prog_count;
        $stats{used_detailed_cache} = 0;
        &log("fetching up to ".$stats{programmes}." detail pages...");

        foreach my $prog (@{($d->{progs})}) {
                my $was_in_cache = 0;

                $prog_count++;
                my $details = $prog->{details};

                if (($prog_count % 10) == 1) {
                        &log(" .. at programme ".$prog_count." of ".$stats{programmes}." (".$stats{used_detailed_cache}." from cache)");
                }

                if (!defined $data_cache->{detail_cache}->{$details}) {
                        my $url = "http://www.ten.com.au/".$details;
                        my $data = &get_url($url,5);
                        my $tree = HTML::TreeBuilder->new_from_content($data) if (defined $data);
                        if ((!$data) || (!$tree)) {
                                &log("url '$url' doesn't seem to contain any valid details. Has the format changed?");
                                $stats{bad_detail_response}++;
                                return;
                        }

                        # parse description from first 'class=info' table cell
                        my $prog_desc = $tree->look_down('_tag' => 'td', 'class' => 'info', 'style' => 'text-align:justify;');
                        if (defined $prog_desc) {
                                $data_cache->{detail_cache}->{$details}->{desc} = [[ $prog_desc->as_text(), $opt->{lang} ]];
                                &log("got desc '".$prog_desc->as_text()."'") if (defined $opt->{debug} && $opt->{debug} > 1);
                        }

                        my $genre_group = &get_url("http://www.ten.com.au/pgutil/epfront.ashx?cd=2&id=".$prog->{id},3,undef,"HEAD");
                        if ((defined $genre_group) && ($genre_group ne "")) {
                                if (defined $d->{gset}->{$genre_group}) {
                                        $data_cache->{detail_cache}->{$details}->{category} = [[ translate_category($d->{gset}->{$genre_group}), $opt->{lang} ]];
                                } else {
                                        $data_cache->{detail_cache}->{$details}->{category} = [[ $genre_group, $opt->{lang} ]];
                                        &log("unknown genre group '$genre_group' for prog '".$prog->{title}->[0]->[0]."'");
                                        $stats{unknown_genre}++;
                                }
                        }

                        if ($data =~ /EPISODE:/) {
                                my $s = &ocr_image($prog->{id}, "http://www.ten.com.au/pgutil/epfront.ashx?cd=1&id=".$prog->{id}, "http://www.ten.com.au/pgutil/epback.ashx?cd=1&id=".$prog->{id}, 3, 0, 1);
                                if ((defined $s) && ($s ne "")) {
                                        $data_cache->{detail_cache}->{$details}->{'sub-title'} = [[ $s, $opt->{lang} ]];
                                }
                        }

                        $stats{used_detailed_cache}++;
                        $was_in_cache = 1;
                }

                $data_cache->{detail_cache}->{$details}->{last_used} = time;

                $prog->{desc} = $data_cache->{detail_cache}->{$details}->{desc}
                    if (defined $data_cache->{detail_cache}->{$details}->{desc});

                $prog->{category} = $data_cache->{detail_cache}->{$details}->{category}
                    if (defined $data_cache->{detail_cache}->{$details}->{category});

                $prog->{'sub-title'} = $data_cache->{detail_cache}->{$details}->{'sub-title'}
                    if (defined $data_cache->{detail_cache}->{$details}->{'sub-title'});

                unless ((defined $opt->{fast}) || ($was_in_cache)) {
                        my $sleep_for = 3 + int(rand(2));
                        sleep $sleep_for;
                        $stats{slept_for} += $sleep_for;
                }
        }
}

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

sub parse_characters
{
        my ($imgname,$i,$space_threshold) = @_;

        my ($width, $height) = $i->getBounds;
        my $bg = $i->getPixel(0,0);

        # flatten image colours
        my @bgcolour;
        foreach my $index (0..$i->colorsTotal) {
                my @r = $i->rgb($index);
                my $total = $r[0]+$r[1]+$r[2];

                if ($total > (240*3)) {
                        $bgcolour[$index] = 1;
                } else {
                        $bgcolour[$index] = 0;
                }
        }

        my $char_x1 = 0;
        my $char_x2 = 0;
        my $last_char_x = 0;
        my $done = 0;
        my $charnum = 0;
        my $s = "";

        while (!$done) {
                $char_x2++;
                $done = 1 if ($char_x2 >= ($width-1));

                my $blank_line = 1;     # until proven otherwise
                my $char_y = 0;
                while (($char_y < ($height-1)) && ($blank_line)) {
                        my $index = $i->getPixel($char_x2,$char_y);
                        $blank_line = 0 if ($bgcolour[($i->getPixel($char_x2,$char_y))] == 0);
                        $char_y++;
                }

                if (($blank_line) || ($char_x2 == ($width-1))) {
                        if (($char_x2 - $char_x1) == 1) {
                                $char_x1 = $char_x2 + 1;
                                $char_x2++;
                                next;
                        }

                        if (($char_x1 - $last_char_x) >= 3) {
                                if (($charnum > $space_threshold) || (($char_x1 - $last_char_x) >= 4)) {
                                        $s .= " ";
                                        $charnum++;
                                }
                        }
                        $last_char_x = $char_x2;

                        my $str = pack('N',($char_x2-$char_x1));
                        foreach my $x ($char_x1..$char_x2) {
                                foreach my $y (0..($height-1)) {
                                        $str .= pack('N', $bgcolour[($i->getPixel($x, $y))]);
                                }
                        }
                        my $md5 = Digest::MD5::md5_hex($str);
                        $charnum++;

                        if ((!defined $d->{charset}->{$md5}) || ($d->{charset}->{$md5} eq "?")) {
                                if (defined $opt->{ocr_learn_mode}) {
                                        $d->{charset}->{$md5} = "[".$md5."]";
                                        $s .= "[".$md5."]";
                                } else {
                                        $s .= "?";
                                }
                        } else {
                                $s .= $d->{charset}->{$md5};
                        }

                        $char_x1 = $char_x2+1;
                        $char_x2++;
                }
        }

        return $s;
}

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

sub setup_charset
{
        my %charset = qw{
                87b7de3dbbeda572e883253803f73a78 e caa8c600dd0aecf49f445753963e97b5 : 46854a6efed48426f1018828cca41ac2 o
                f64db65ec25ba73bdced42fcf01be00a r d0ec43eddec59827259b46c460386ae0 l d4fb05e2702c4199a73794b5def96ec2 G
                ca1cbc6861523c4608f19365cac6dde0 0 a49667c09e9d4be0b595578d51eeb60d M 1a9de7fb6f1c93f3ffaa15816549e43a 6
                fbec6375cab7ff5b9d4b4783c7aab13b s b1465cc2781264fff5a55a9e9b3d8064 A b61b8c026407890a23276d41125d7e98 h
                8e2a682942360201f924e694dc70fa43 T c1e402fec1d35694b1898b1f1dbb16bb w bed2eaba5e16b7246bb1f5b94d44b61c h
                c0107f886a27e42ce8fd2eca63a5ebcc D 8300a291d7dae2e876126878c98af6d1 S 7edd9f81d7da6577d57da07f93f95b87 E
                ec5d1b2140213fdbbf3c837400b2d3c5 e 14e3c224bd590504ffa95a1987ac3fbc n 55ced8bf6a2a2482f578bc988b60b5ed a
                51bc70bfed877b2bf7300a5023a88634 o 5ae0c7cc64eb457ed198ee008fcd52f9 d 8769704a7c47684c74d841673664f942 V
                763602fa61fe36273a3492f3fbae0ff8 t 0efb2ccf6c4e8b3084e56da89ad6629b 7 70dddd8427594526c8fd308b6151d673 i
                75419c36d52e0f29143d4ecf3c5fd2fd W 592559bccc3f515e5d2a93622320a1a2 m 4e4073891b344c07deceee07cd6ba348 g
                9e2f28787475e105da5221e20eb7a137 r f7e8dade3df2070be62dd206ef0cc8f1 5 62982338ad7a6b499056bac67f840d83 N
                97fd0fdcedad187e8bf877adc5d580c5 2 35f9e067a546f3ae0057065223fe4c33 3 97f15e1d2ad1cb232147d0b6f01c8022 O
                4c52033ce6a724d184d9c8d23a960d6e P 9fbd3153eb8e55a0a1f453ee33e6bafd i e7a5cbb21f17f35f2f141e63f37a45fb c
                f7e8dade3df2070be62dd206ef0cc8f1 5 646db1d6726727e809ed1eb7ea11f545 8 c5ed676c18b62bc6885e34bf527e66af Y
                99bea8c75f15219ca16a7229b3938665 u a9ea989899145834e84daf0abc5964f0 ! 8113592ffa186852672d458f5bd86135 k
                fec8880342772dd7e83ca9ffeed0e216 l 185a57d42d98c6cbd85135d9e8295501 D 606bf5428471cfd5de3434374c281334 y
                50692dc12cde0fae151d9a0c2563c81d J f3045893d14fbb5f20e215a38617aee4 0 cf78a362c08ef3b9284ade8113e670d7 R
                0de173cf09ded97fff935aa24f7f8bfe z cf63706b1f8eaa1c9120e1f9794918c3 T f9f2e0d23af08cb6fbeacb686992f633 v
                c1777c45a7d53a5d557c5da145bea080 ' 88f4902f74cf89846318c96003466835 p 2b821839a93b75e470d04a5e2c1971b3 J
                120cfb2dcf74d7900dc22d44bea9db09 H 298b488eb21a879c4cf9007c05283a15 s 08021ebe5ef72c0ed41b438fd794e71e tt
                b24415f6bccb3a9ad482156a524dbf1e y 6c27fb8ed1d2d451785d957138ca0902 u 5a6e6307a1b18b409618616556a327e5 E
                8d4430c7857a01d4805b4666c54fe114 b cf9c23550ff1fde3b19b593966fdd391 S 97986e54d74ef7047eebc1169134564f B
                561fda757040c25038687752394d39a8 M 8015f8d4c3d6574c9ec73b412ece2013 L 7fdc4d50db244ad00f11d7c362f10b8f 9
                73f0455d71b4156ab2bbebb7fac004ca 4 401ccf9844fe6399f13597cb458abedb a 28de7104f0f94e161104c407071a5e91 m
                cc282e429660787afc4a292a6e35cb2a F 449bb458f502dbb10cf71673d1bd7ac4 5 eb6c72d1cb3b32bfcf646e2c5dafc4d2 N
                aa364cab095bc5f46f855c9772619f5e 1 6aadacaa0e0b622fe755be8615f67f87 2 0f87f473885da54c2a7c886ae92f0ddd R
                17d10978ffc796cc024c68afa3fb463c I 70b21817f2611845e464f8b551c73b71 1 f5a215139fdc4921b4fad687e0899fdc H
                8b9e1cc11d23773ca68afaea3064902a A 6adf28b9140e9b236394bd6956638630 9 0d2eeea7b20edb640d5556ea8528ba67 K
                3503cdc59df22be3b6242db35cfe3482 f b5856240a388696d55ea99fad53166ce W 4b8e08032dde00ced51e8435820be5e1 n
                38b1c7da79cbbac219c590129f40cca1 k 1697c04376dac187f028f240cb0ccc9a C 2e03a06a91a1993a5c6e15b43784e5c3 3
                840e43645d65217fd0d57914321db2bf : 5e871ec322ade9e74d44285c3ddad972 L e3bcb0065109e004bc6b18b1403fb810 rt
                9f32b9cd5083733eead4380bb6551ac5 B 148cafcb02f1a203866f583dbdb253af & 519cc9d317d1a6db113c0da6e5560e71 d
                40ec9716cfe72fe54201dae866e70ec5 V ace17452c10518e97caba9493898c910 U d244b3a33602a55c1ee8cf9c570dced9 -
                25ee9123a9fdb7c164b29dfaa50d10b7 6 a87bc5bc8b3e5df44df2e2405561dd83 . f6e64e873007d53c7bf7873d639f4678 .
                de8b17aa3cf358a1e8b9496dd99e20f1 7 21e73997781a1af8c506eded30c6143f 4 4518bf9cb085588761164be21442aa5d F
                c38b4e845130be00f1a27a023241a500 ! f5a9cba4badf510bbde66e1012647c8c O c67d0abf9dd1bf2352613c243de4649b P
                453b59cf0cb2813958d5518fc668639c Z 3dad6dcdedabfbb99ef2067f38d6bd67 B b2da7f7ca8c9be23ca445a7df954a4f2 8
                8a3bf2c9eb10c811e50c91759e6e57cc G f9e0333c0725c22b198bc0c3a7aa4a51 x 61ea6df7256f910d1cb031979d7d1eda C
                588b076556aa1b58810fe1f97fa77371 Y 8a3bf2c9eb10c811e50c91759e6e57cc G 61ea6df7256f910d1cb031979d7d1eda C

                5892305501d6d7b3c944edcdfac487b0 W cb28d04e3bbe3bfd0bf0086b5b50b50e a d9f38cfa215b61b0baf8d3232ab71e5a c
                bcfbf5865682d0d691b0ba7ad34b4e5f k 0ff718ec0df83d26df8ef58f27af3e1d y df27299772b1c1fa25bc74e3e0b28519 M
                e74795b60c312f1fa48d956433cffd67 d e1bcd7c44b8fd705281926db43eae7f2 n c677cf0e0d2124629e224628a01a96fe e
                df74545eacbaf90dc1206ef81be97bbb s 118dfa4e0e53dbde0a74554c16f4b6e8 A 6ac1a637edb8d167b9b0263b72d30d50 B
                ab0135e45bdc858357c40d35e2a6d662 l 202c9276948bf52699ef2521988c2ed0 z f65810bb9e22c25d31a442b3ff1ec3e8 i
                f079edc2a2167e5c3b5a0250130ad3cc g 6ac1a637edb8d167b9b0263b72d30d50 B 238d4f228563b5efcd46fdb0ee0fa367 ttl
                df74545eacbaf90dc1206ef81be97bbb s acf02f7463a907c98ccfdaf1364e506a ( 761086404df3dd6a879c15722e6b5c72 P
                f932ec8ddd3f2edd739a715090614687 1 ff8c0771c4dc7c6a1867ada5d47c1446 ) 26e1d6a4efa3a6e7d107a7003924ad9f rt
                27e56f6930a29f7ccb1f2ed98c2c99be G 168527e83abcaee41f74514b627b651a ra 9ab22051e33a6755e407cc69ea9d02b4 a
                9ab22051e33a6755e407cc69ea9d02b4 p 0e6e0a842f847b0997de866dcb69fd7d th 98dee45f3aa315b8d6d1c2a83208e158 u
                90b5c188102f105c0cab2556d27b0788 rd 154690fb8d4578148e1513ab0f921076 P 34065c67fbb12cce0561001cd462d573 a
                1d58b69f2b50b50daacfb7645a0fdd18 rt 13f9bf707f893bc39e10ce0475e151a7 I 3af52f596fd1c33743a59d7fa816aaa3 ts
                2e1e8bd83e52ee09bb58297aeb1da158 Th 1e128beba3aff04a49fba2b291603579 Re aa296120499cf1ee8868ec6759895f9b m
                f74eae3e6c5426b5da01fb1ad236e1a2 Tw faa3822c5ea6489c829cafc96ba86271 o a507f381a52898da1b4c63a3252559ef N
                0e07a84d610ae1d5f823c02573825438 h 49b35e005120197a73685301f17ddd92 b f66ffe4a80deebe8ffca678d33e33f7b rs
                2e1e8bd83e52ee09bb58297aeb1da158 Th 28a61bb021be4f7b4d43c3a995207169 re 33f3092e1d836e03bbbe45cf77f46183 S
                517c4ccbb8292617db5d758e868023a0 M ac8de377a8f7d07007d10ad37eeaa88b r e42460162dfa7d0d9ad67efe32f9505c .
                7f84b8c690c3b0412a0514e117a04c69 S fd84447f45a91a443e1863fa7a2c830e p 1e92bddfb0b4813630d147a38863543d ri
                84db1131cd6f3ed6f630e58b879f781f tz 0fd741130b71b082f1eeebda6e2e2811 G a26fbebcec2437f07bad0ad6f6dc2313 o
                29f53067840a08d6ca5c34834ad14e77 e 673324edd255d182fad9267db821f230 s d3f8a87a788b91db4886c6a4c0e5a82d To
                11a9bc26a268f7cd5787ccae1a3a7fd6 to a68667571be8a5b2aaf5fd4f4f429d41 D 8d4c375b6b8db04ccee5077e5ba33863 Re
                ed445642499ca8148938c51518771540 e a1d72e973b08017846fcd70a732b3143 i 70a7a183ec29e18634005ddde569f65d a
                29dc936fcdb2723b69c638a022135ff2 tch 3961534a0448ed072632dce5dba32d2a e e27d84de85414214f105583f45d406d7 d
                0dc0ef29925f3ddffb70ce1107ca1b4d ri b46e207278c9048939ff4eb56d1aa847 t 53f78e0dc0417e0f6a455299e15dca0c V
                ef32aff5c88702eb5ed51c3a6836a583 7 732b43290b91d76547d1e4dd5e85ab8f - ade03db1bcb287d34d4ca9c9bd82c227 r
                2f49cdc45bf918107fd3001a57d334cc U 96ab55702d9094de2f158ec3a5f1dd00 n a1a6c673257c30fe6b02ed3a5de7acec to
                222c34badb06b16ff61a3bfdbd2087c5 l b6e528d8cb510fceabfcb1d280e539d9 W bd4a858bb84721b3c83498f9e4e33b20 a
                222c34badb06b16ff61a3bfdbd2087c5 l a49e3b56b645aa6dc1de7a81898c92ba th b2c89ec08fe126b2e147bc3fceb5b72e S
                05dd472da0bb30cf7eb463c5eea42aca u ce6488a8ce8ae8a8e81bdc631880780d c 000312319671d8f7f93eb9461828c238 s
                49ba6d6bfe0d856eb6808ab901bf0ec3 F 207d6b243ade809ae1cad6507711d528 ro 37138974a7027ed973547cce5fba5db7 m
                c458ef3d193bfddaecd9970d9a57f844 P bd4a858bb84721b3c83498f9e4e33b20 a af722d233b9e8ae897b72d15fd8b5bc4 ti
                7f76b9fb361c686de8ec1c828c71da4b v 4dcdd7bc37f7b3dae2943ddb8618bbc1 9 8fc445dd8da1ee8f8542ca18a4816109 V
                5eee84d45d3263e5db81dfcc62d101fa 2 
                };
        $d->{charset} = \%charset;


        my %gset = qw{491 News 508 Children 531 Entertainment 496 Drama 533 Infotainment 507 Religion};
        $d->{gset} = \%gset;
}

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

sub ocr_image
{
        my ($id, $fg_url, $bg_url, $tries, $space_width, $multiline) = @_;
        $multiline = 0 if (!defined $multiline);

        my $fg_gif_image = &get_url($fg_url, $tries);
        my $bg_png_image = &get_url($bg_url, $tries);

        my $fg_image = GD::Image->newFromGifData($fg_gif_image);
        my $bg_image = GD::Image->newFromPngData($bg_png_image);

        $bg_image->copyMerge($fg_image, 0, 0, 0, 0, $fg_image->width, $fg_image->height, 100);

        if (!$multiline) {
                # remove underline
                my $white = $bg_image->colorExact(255,255,255);
                $bg_image->filledRectangle(0, 14, $fg_image->width, $fg_image->height, $white);

                return parse_characters($id, $bg_image, $space_width);
        }

        return parse_multiline_characters($id, $bg_image);
}

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

sub parse_multiline_characters
{
        my ($imgname,$i) = @_;

        my ($width, $height) = $i->getBounds;
        my $bg = $i->getPixel(0,0);
        &log("image bounds: x=$width, y=$height") if ((defined $opt->{debug}) && ($opt->{debug} > 3));

        # flatten image colours
        my @bgcolour;
        foreach my $index (0..$i->colorsTotal) {
                my @r = $i->rgb($index);
                my $total = $r[0]+$r[1]+$r[2];

                if ($total > (240*3)) {
                        $bgcolour[$index] = 1;
                } else {
                        $bgcolour[$index] = 0;
                }
        }

        my $last_char_x;
        my $charnum = 0;
        my $s = "";

        my $done = 0;
        my $char_y1 = 0;
        my $char_y2 = 0;

        while (!$done) {
                # 1. find first non-blank horizontal
                $char_y1 = $char_y2;
                my $blank_y_line = 1;   # until proven otherwise
                while (($blank_y_line) && ($char_y1 < ($height-1))) {
                        my $char_x = 0;
                        while ($char_x < ($width-1)) {
                                my $index = $i->getPixel($char_x, $char_y1);
                                $blank_y_line = 0 if ($bgcolour[($i->getPixel($char_x,$char_y1))] == 0);
                                $char_x++;
                        }
                        if ($blank_y_line) {
                                &log("[1] whole-of-line y $char_y1 was blank!") if ((defined $opt->{debug}) && ($opt->{debug} > 3));
                                $char_y1++;
                        }
                }
                if ($blank_y_line) {
                        &log("[1] reached end of image without finding anymore non-blank y lines. end of image!") if ((defined $opt->{debug}) && ($opt->{debug} > 3));
                        $done = 1;
                        next;
                }
                &log("[1] non-blank horizontal line found: y1=$char_y1") if ((defined $opt->{debug}) && ($opt->{debug} > 3));

                # 2. find first blank horizontal
                $char_y2 = $char_y1;
                my $nonblank_y_line = 0;
                while (($nonblank_y_line == 0) && ($char_y2 < ($height-1))) {
                        my $char_x = 0;
                        $nonblank_y_line = 1;
                        while ($char_x < ($width-1)) {
                                my $index = $i->getPixel($char_x, $char_y2);
                                $nonblank_y_line = 0 if ($bgcolour[($i->getPixel($char_x,$char_y2))] == 0);
                                $char_x++;
                        }
                        if ($nonblank_y_line == 0) {
                                &log("[2] whole-of-line y $char_y2 was nonblank!") if ((defined $opt->{debug}) && ($opt->{debug} > 3));
                                $char_y2++;
                        }
                }
                &log("[2] blank horizontal line found: y2=$char_y2") if ((defined $opt->{debug}) && ($opt->{debug} > 3));

                my $done_line = 0;
                my $char_x1 = 0;
                my $char_x2 = 0;
                while (!$done_line) {
                        # 3. find first non-blank vertical between char_y1 and char_y2
                        $char_x1 = $char_x2;
                        my $blank_x_line = 1;   # until proven otherwise
                        while (($blank_x_line) && ($char_x1 < ($width-1))) {
                                my $char_y = $char_y1;
                                while ($char_y < $char_y2) {
                                        my $index = $i->getPixel($char_x1,$char_y);
                                        $blank_x_line = 0 if ($bgcolour[($i->getPixel($char_x1,$char_y))] == 0);
                                        $char_y++;
                                }
                                if ($blank_x_line) {
                                        &log("[3] whole-of-line x $char_x1 was blank!") if ((defined $opt->{debug}) && ($opt->{debug} > 3));
                                        $char_x1++;
                                }
                        }
                        if ($blank_x_line) {
                                &log("[3] end of this line (x1 is $char_x1), looking for next line...") if ((defined $opt->{debug}) && ($opt->{debug} > 3));
                                $done_line = 1;
                                $s .= " " if ($s ne "");
                                next;
                        }
                        &log("[3] non-blank vertical line found: x1=$char_x1") if ((defined $opt->{debug}) && ($opt->{debug} > 3));

                        # 4. find first blank vertical between char_y1 and char_y2
                        $char_x2 = $char_x1;
                        my $nonblank_x_line = 0;
                        while (($nonblank_x_line == 0) && ($char_x2 < ($width-1))) {
                                my $char_y = $char_y1;
                                $nonblank_x_line = 1;
                                while ($char_y < $char_y2) {
                                        my $index = $i->getPixel($char_x2,$char_y);
                                        $nonblank_x_line = 0 if ($bgcolour[($i->getPixel($char_x2,$char_y))] == 0);
                                        $char_y++;
                                }
                                if ($nonblank_x_line == 0) {
                                        &log("[4] whole-of-line x $char_x2 wasn't blank!") if ((defined $opt->{debug}) && ($opt->{debug} > 3));
                                        $char_x2++;
                                }
                        }
                        &log("blank vertical line found: x2=$char_x2") if ((defined $opt->{debug}) && ($opt->{debug} > 3));

                        &log("looking at character between: x1,y1 $char_x1,$char_y1 and x2,y2 $char_x2,$char_y2 ........") if ((defined $opt->{debug}) && ($opt->{debug} > 3));
                        # 5. insert spaces
                        if ((defined $last_char_x) && (($char_x1 - $last_char_x) >= 3)) {
                                $s .= " ";
                                $charnum++;
                        }
                        $last_char_x = $char_x2;

                        # 6. md5 char
                        my $str = pack('NN',($char_x2-$char_x1),($char_y2-$char_y1));
                        foreach my $x ($char_x1..($char_x2-1)) {
                                foreach my $y ($char_y1..($char_y2-1)) {
                                        $str .= pack('N', $bgcolour[($i->getPixel($x, $y))]);
                                }
                        }
                        my $md5 = Digest::MD5::md5_hex($str);
                        $charnum++;

                        # 7. insert char
                        if ((!defined $d->{charset}->{$md5}) || ($d->{charset}->{$md5} eq "?")) {
                                if (defined $opt->{ocr_learn_mode}) {
                                        $d->{charset}->{$md5} = "[".$md5."]";
                                        $s .= "[".$md5."]";
                                } else {
                                        $s .= "?";
                                }
                        } else {
                                $s .= $d->{charset}->{$md5};
                        }
                }
        }

        &log("multiline ocr got '$s'") if (defined $opt->{debug} && $opt->{debug} > 1);
        return $s;
}