#!/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_ee - Grab TV listings for Estonia.

=head1 SYNOPSIS

tv_grab_ee --help

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

tv_grab_ee [--config-file FILE]
           [--days N] [--offset N]
           [--output FILE] [--quiet] [--debug]

tv_grab_ee --list-channels  [--config-file FILE]
           [--output FILE] [--quiet] [--debug]

tv_grab_ee --capabilities

tv_grab_ee --version

=head1 DESCRIPTION

Output TV listings in XMLTV format for many stations available in Estonia.
The data comes from www.kava.ee.

First you must run B<tv_grab_ee --configure> to choose which stations
you want to receive.

Then running B<tv_grab_ee> with no arguments will get a listings in XML
format for the stations you chose for available days including today.

=head1 OPTIONS

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

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

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 XMLTV::ProgressBar.

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

B<--days N> When grabbing, grab N days rather than all available days.

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

B<--quiet> Suppress the progress-bar normally shown on standard error.

B<--debug> Provide more information on progress to stderr to help in
debugging.

B<--list-channels> Write output giving <channel> elements for every
channel available (ignoring the config file), but no programmes.

B<--capabilities> Show which capabilities the grabber supports. For more
information, see L<http://membled.com/twiki/bin/view/Main/XmltvCapabilities>

B<--version> Show the version of the grabber.

B<--help> Print a help message and exit.

=head1 ERROR HANDLING

If the grabber fails to download data for some channel on a specific day, 
it will print an errormessage to STDERR and then continue with the other
channels and days. The grabber will exit with a status code of 1 to indicate 
that the data is incomplete. 

=head1 ENVIRONMENT VARIABLES

The environment variable HOME can be set to change where configuration
files are stored. All configuration is stored in $HOME/.xmltv/. On Windows,
it might be necessary to set HOME to a path without spaces in it.

=head1 SUPPORTED CHANNELS

For information on supported channels, see http://www.kava.ee/

=head1 AUTHOR

Cougar < cougar at random.ee >. This documentation and parts of the code
based on various other tv_grabbers from the XMLTV-project.

=head1 SEE ALSO

L<xmltv(5)>.

=cut

my $default_root_url = 'http://xmltv.kava.ee/files';

use strict;

use XMLTV;
use XMLTV::ProgressBar;
use XMLTV::Options qw/ParseOptions/;
use XMLTV::Configure::Writer;
use XMLTV::Memoize; XMLTV::Memoize::check_argv 'get';

use XML::LibXML;
use Date::Manip;
use Compress::Zlib;
use File::Path;
use File::Basename;
use LWP::Simple qw($ua get);

$ua->agent("xmltv/$XMLTV::VERSION");

sub t;

my $warnings = 0;
my $all_days = 1;

# Hack to override XMLTV defaults for $opt{days} even if --days was not given
if ((scalar(@ARGV) > 0) && (join(':', @ARGV) =~ /--days/)) {
	$all_days = 0;
}

my ($opt, $conf) = ParseOptions({
	grabber_name		=> "tv_grab_ee",
	capabilities		=> [qw/baseline manualconfig tkconfig apiconfig cache/],
	stage_sub		=> \&config_stage,
	listchannels_sub	=> \&list_channels,
	load_old_config_sub	=> \&load_old_config,
	version			=> '$Id$',
	description		=> "Estonia (www.kava.ee)",
});

if (not defined ($conf->{'root-url'})) {
	print STDERR "No root-url defined.\n" .
	             "Please run the grabber with --configure.\n";
	exit(1);
}

my ($encoding, $credits, $ch, $progs) = fetch_channels($conf);

my $bar = undef;
$bar = new XMLTV::ProgressBar({
	name	=> 'downloading listings',
	count	=> scalar(@{$conf->{channel}}),
}) if (not $opt->{quiet}) && (not $opt->{debug});

my @alldata;

foreach my $channel_id (@{$conf->{channel}}) {
	if (exists $ch->{$channel_id}) {
		(my $id = $channel_id) =~ s/^(\d\d).*/$1/;
		t "$channel_id -> $id";
		my $dataurl = $conf->{'root-url'}->[0] . '/' . $id . '_channeldata.xml';
		my $xmlstr = get($dataurl) or warning('Failed to fetch ' . $dataurl);
		if (defined $xmlstr) {
			my $data = XMLTV::parse($xmlstr);
			push @alldata, $data;
		}
	} else {
		warning('Missing channel: ' . $channel_id);
	}
	$bar->update() if defined $bar;
}
$bar->finish() if defined $bar;

my %w_args;

if (((defined $opt->{offset}) && ($opt->{offset} != 0)) || (! $all_days)) {
	$w_args{offset} = (defined $opt->{offset} ? $opt->{offset} : 0);
	$w_args{days} = ($all_days ? 60 : $opt->{days});
	$w_args{cutoff} = '000000';
}

# XML::Writer doesn't use default ouput but STDOUT directly if not specified
if (defined $opt->{output}) {
	my $fd = select();
	$w_args{OUTPUT} = $fd;
}

my $data = XMLTV::cat(@alldata);

$data->[1]{'generator-info-name'} = '$Id: tv_grab_ee,v 1.7 2006/04/12 08:19:16 fgouget Exp $ ';
$data->[1]{'generator-info-url'} = 'mailto:cougar@random.ee';

XMLTV::write_data($data, %w_args);

# Signal that something went wrong if there were warnings.
exit(1) if $warnings;

# All data fetched ok.
t 'Exiting without warnings.';
exit(0);

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

sub t
{
	my ($message) = @_;
	print STDERR $message . "\n" if $opt->{debug};
}

sub warning
{
	my ($message) = @_;
	print STDERR $message . "\n";
	$warnings++;
}

sub fetch_channels
{
	my ($conf) = @_;

	t 'Fetching channels';
	my $compressed = get($conf->{'root-url'}->[0] . '/channels.xml.gz')
		or die 'Failed to fetch ' . $conf->{'root-url'}->[0] . '/channels.xml.gz';
	my $xmlstr = Compress::Zlib::memGunzip(\$compressed);
	my $data = XMLTV::parse($xmlstr);
	return @$data;
}

sub list_channels
{
	my ($conf, $opt) = @_;

	my ($encoding, $credits, $ch, $progs) = fetch_channels($conf);

	my $result;

	my %w_args;
	$w_args{encoding} = $encoding;
	$w_args{OUTPUT} = \$result;

	my $writer = new XMLTV::Writer(%w_args);
	$writer->start($credits);
	foreach (sort keys %$ch) {
		$writer->write_channel($ch->{$_});
	}
	$writer->end();	
	return $result;
}

sub config_stage
{
	my ($stage, $conf) = @_;

	if ($stage eq 'start') {
		return config_stage_start($stage, $conf);
	} else {
		die "Unknown stage $stage";
	}
}

sub config_stage_start
{
	my ($stage, $conf) = @_;

	die "Unknown stage $stage" if $stage ne "start";

	my $result;
	my $writer = new XMLTV::Configure::Writer(OUTPUT   => \$result,
	                                          encoding => 'utf-8');
	$writer->start({grabber => 'tv_grab_ee'});
	$writer->write_string({
		id		=> 'root-url', 
		title		=> [ 
				     [ 'Root URL for grabbing data',	'en' ],
				     [ 'Kavade kataloogi URL',		'et' ]
				   ],
		description	=> [ 
				     [ 'This URL describes root directory ' .
				       'where channels file and all ' .
				       'channel data can be found.',	'en' ],
				     [ 'Selles kataloogis peavad asuma ' .
				       'kanaleid kirjeldav fail ning ' .
				       'kõikide kanalite telekavad.',	'et' ]
				   ],
		default		=> $default_root_url,
	});

	$writer->end('select-channels');

	return $result;
}

sub load_old_config
{
	my ($config_file) = @_;

	my %chanmap = (
		'10'	=>	'11',	# ETV
		'12'	=>	'13',	# TV 3
		'13'	=>	'12',	# Kanal 2
		'14'	=>	'131',	# STV
		'15'	=>	'15',	# YLE 1
		'16'	=>	'16',	# YLE 2
		'17'	=>	'17',	# MTV 3
		'20'	=>	'18',	# Nelonen
		'22'	=>	'54',	# PRO 7
		'23'	=>	'105',	# NTV+ Vene
		'24'	=>	'53',	# RTL2
		'25'	=>	'50',	# RTL
		'27'	=>	'28',	# PBK
		'29'	=>	'14',	# TV1000 Eesti
		'32'	=>	'46',	# Viasat Explorer
		'35'	=>	'27',	# TV3+
		'36'	=>	'41',	# Discovery Channel
		'37'	=>	'125',	# NTV Discovery
		'38'	=>	'44',	# Discovery Travel&Living
		'39'	=>	'42',	# Discovery Civilisation
		'40'	=>	'43',	# Discovery Science
		'41'	=>	'22',	# National Geographic
		'42'	=>	'45',	# Viasat History
		'43'	=>	'59',	# Arte
		'44'	=>	'60',	# Eurosport
		'45'	=>	'70',	# MTV
		'46'	=>	'72',	# VH1
		'47'	=>	'73',	# Viva
		'48'	=>	'74',	# Mezzo
		'49'	=>	'128',	# NTV Sport
		'50'	=>	'123',	# NTV Jalgpall
	);

	t 'Loading old config format';
	my @lines = XMLTV::Config_file::read_lines($config_file);

	my $conf = {};
	$conf->{'root-url'}->[0] = $default_root_url;
	$conf->{'channel'} = [];
	$conf->{'no_channel'} = [];

	foreach my $line (@lines) {
		next unless defined $line;
		if ($line !~ /^(#?)channel (\d+)\.tv\.delfi\.ee /) {
			t 'Illegal config line "' . $line . '"';
			next;
		}
		my $status = $1;
		my $oldchan = $2;
		if (! defined $chanmap{$oldchan}) {
			t 'Unknown channel ' . $2 . ' from "' . $line . '"';
			next;
		}
		if ($status eq '') {
			push @{$conf->{'channel'}}, "$oldchan.xmltv.kava.ee";
			t 'Converting ' . $line . ' -> ' . "channel=$oldchan.xmltv.kava.ee";
		} else {
			push @{$conf->{'no_channel'}}, "$oldchan.xmltv.kava.ee";
			t 'Converting ' . $line . ' -> ' . "channel!$oldchan.xmltv.kava.ee";
		}
	}
	return $conf;
}
