#!/usr/bin/perl -w

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

=pod

=head1 NAME

tv_grab_uk_bleb - Grab TV listings for the United Kingdom, from bleb.org

=head1 SYNOPSIS

tv_grab_uk_bleb --help

tv_grab_uk_bleb [--config-file FILE] --configure [--gui OPTION]

tv_grab_uk_bleb [--config-file FILE] [--output FILE] [--quiet]
                [--days N] [--offset N]

=head1 DESCRIPTION

Output TV and radio listings in XMLTV format for many stations
available in Britain.  The data comes from the bleb.org web site.

=head1 USAGE

First you must run B<tv_grab_uk_bleb --configure> to choose which
stations you want to receive.  Then running B<tv_grab_uk_bleb> with no
arguments will get about a week<39>s listings for the stations
you chose.

B<--configure> Prompt for which stations to download and write the
configuration file.

B<--gui OPTION> Use this option to enable a graphical interface to be used.
OPTION may be 'Tk', or left blank for the best available choice.
Additional allowed values of OPTION are 'Term' for normal terminal output
(default) and 'TermNoProgressBar' to disable the use of Term::ProgressBar.

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

B<--output FILE> When grabbing, write output to FILE rather than
standard output.

B<--days N> When grabbing, grab N days rather than as many as
possible.

B<--offset N> Start grabbing at today + N.  N may be negative.

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

=head1 SEE ALSO

L<xmltv(5)>, L<http://www.bleb.org/>

=head1 AUTHOR

Andy Balaam, axis3x3@users.sourceforge.net

Based on tv_grab_nl_wolf by Ed Avis

=cut

use strict;

use Archive::Zip;
use IO::Scalar;

# We work by inheriting from XMLTV::Grab_XML and overriding certain
# methods.
#
use XMLTV::Grab_XML;

package Grab_XML_uk_bleb;
use base 'XMLTV::Grab_XML';

use Date::Manip;
use XMLTV::DST;

use XMLTV::Ask;
use XMLTV::Config_file;
use XMLTV::Date qw(parse_date);
use XMLTV::Get_nice;
use XMLTV::TZ   qw(tz_to_num);

# Memoize one routine if possible.
eval { require Memoize };
unless ($@) {
    for ('tz_to_num') {
        Memoize::memoize($_) or warn "cannot memoize $_";
    }
}

# Check for faulty versions of Archive::Zip
my $az_version = $Archive::Zip::VERSION;
if($az_version =~ /^1\.1[123]$/) {
    say( <<END
##########################################################################
# Warning - Archive::Zip versions 1.11 to 1.13 contain a bug which       #
# causes tv_grab_uk_bleb to fail.  Please downgrade to Archive::Zip 1.10 #
# or upgrade to a later version if available.                            #
##########################################################################
END
)
}

sub country( $ ) {
    my $pkg = shift;
    return 'UK';
}

my $SHARE_DIR='/usr/share/xmltv'; # by grab/uk_bleb/tv_grab_uk_bleb.PL
my $OUR_SHARE_DIR;

my $URL_HOST     = 'http://www.bleb.org';
my $URL_DIR      = '/tv/data/listings';
my $url_base     = "$URL_HOST$URL_DIR";
my $url_channels = "$URL_HOST$URL_DIR";

my $today = DateCalc(parse_date('today midnight'));
my $now = parse_date('now');
Date_Init('TZ=+0000');

# Returns a hash mapping YYYMMDD to URL.
sub urls_by_date( $$$ ) {
    my $pkg = shift;
    my $opt_config_file = shift;
    my $opt_quiet = shift;
    my $config_file = XMLTV::Config_file::filename($opt_config_file,
        'tv_grab_uk_bleb', $opt_quiet);

    my %ans; # This is a hash to return that is urls indexed by date

    my @channels; # This holds the names of channels

    # Do the channels from the config file
    foreach my $line (XMLTV::Config_file::read_lines($config_file, 0)) {
        next if not $line;

        # Remove whitespace and trailing comments
        if ($line =~ /\s*(.*?)#.*\s*/) {
            $line = $1;
        }
        push @channels, $line;
    }
    my $channels_string = join(',', @channels);

    # Do the dates
    for (my $off = -1; $off < 7; ++$off) {
        my $date = DateCalc($now, $off.' days');

        if ($date =~ /^(\d{8})/) {
            $date = $1;
        }
	else {
            warn("Strange.  No date found at beginning of 'now' string.");
        }

        $ans{$date} = $url_base.'?format=XMLTV&file=zip&channels='
            .$channels_string.'&days='.$off;
    }
    return %ans;
}

# Unzip the data and return it
sub xml_from_data( $$ ) {
    my $pkg = shift;
    my $zipped_data = shift;

    my $fake_filehandle = IO::Scalar->new(\$zipped_data);

    my $zip = Archive::Zip->new();
    $zip->readFromFileHandle($fake_filehandle);

    my $data_file = $zip->memberNamed('data.xml');
    my $xml = $data_file->contents();

    $xml = correct_emptydescs($xml);
    $xml = correct_timezones($xml);
    $xml = add_channel_icons($xml);

    return Grab_XML_uk_bleb->remove_early_stop_times($xml);
}

sub add_channel_icons( $ ) {
    my $xml = shift;
    
    my %channel_urls;
    if (defined $SHARE_DIR) {
        $OUR_SHARE_DIR = "$SHARE_DIR/tv_grab_uk_bleb";
    }
    else {
        $OUR_SHARE_DIR = '.';
    }
    (my $CHANNEL_ICONS_FILE = "$OUR_SHARE_DIR/icon_urls") =~ tr!/!/!s;
    foreach (XMLTV::Config_file::read_lines($CHANNEL_ICONS_FILE, 1)) {
            
        next unless defined;
        my @fields = split;
        my ($channel_id, $channel_url) = @fields;
            
        $channel_urls{$channel_id} = $channel_url;
            
    }
    
    # Do the regex to put in icons
    $xml =~ s{(<channel id=\")(.*?)(\">.*?)(</display-name>)}
             {$1.$2.$3.$4.'<icon src="'.$channel_urls{$2}.'" />'}esg;
        
    return $xml; 
}

# Removes description tags which are empty.
sub correct_emptydescs( $ ) {
    my @lines = split /\n/, shift;
    foreach my $line (@lines) {
        if ($line =~ /<desc lang="en"><\/desc>/) {

            # Just remove the line
            $line =~ s/.*//;

        }
    }
    return join("\n", @lines);
}

# Adds timezones which are guessed at by DST
sub correct_timezones( $ ) {
    my @lines = split /\n/, shift;
    foreach my $line (@lines) {
        if ($line =~ /<programme/) {

            # Check for times without timezones
            $line =~ s/(start|stop)="(\d+)"/qq'$1="'.utc_offset($2, "+0000").qq'"'/eg;

        }
    }
    return join("\n", @lines);
}

sub configure( $$$ ) {
    my $pkg = shift;
    my $opt_config_file = shift;
    my $opt_quiet = shift;

    my $config_file = XMLTV::Config_file::filename($opt_config_file,
        'tv_grab_uk_bleb', $opt_quiet);

    XMLTV::Config_file::check_no_overwrite($config_file);

    open(CONF, ">$config_file") or die "cannot write to $config_file: $!";

    my $bar = new XMLTV::ProgressBar('getting available channels', 1)
        if not $opt_quiet;

    my $page = get_nice($url_channels);
    $bar->update() if not $opt_quiet;
    $bar->finish() if not $opt_quiet;

    if ($page =~ /Available channels are: <tt>(.*?)<\/tt>/) {
        my @channels = split(', ', $1);
        my @questions;

        foreach my $chan (@channels) {
            push @questions, "Add channel $chan? ";
        }
        my @answers = ask_many_boolean(1, @questions);

        for (my $i=0; $i < $#channels; $i++) {
            if ($answers[$i]) {
                print CONF $channels[$i]."\n";
            }
        }
        say("Configuration complete.");
    }
    else {
        say("Unable to download channels list from $url_channels.");
        die;
    }
}

# Set the share directory using the undocumented --share option
sub set_share_dir( $$ ) {
    my $pkg = shift;
    $SHARE_DIR = shift;
}

Grab_XML_uk_bleb->go();


