#!/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_in_toi - Grab TV listings for India from Times Of India website

=head1 SYNOPSIS

tv_grab_in_toi --help

tv_grab_in_toi --configure [--config-file FILE]

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

tv_grab_in_toi --list-channels [--config-file FILE]
                 [--output FILE] [--quiet]


=head1 DESCRIPTION

Outputs TV listings in XMLTV format for stations available in
India.

Then running B<tv_grab_in_toi> with no arguments will get listings for
all the channels.

=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_in_toi.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 the default.

B<--offset N> Start grabbing at today + N days. Also supports negative offset for past listings.

B<--quiet> Only print error-messages on STDERR.

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

B<--list-channels> Output a list of all channels that data is available
                      for. The list is in xmltv-format.

B<--capabilities> Show which capabilities the grabber supports. For more
information, see L<http://wiki.xmltv.org/index.php/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, it will print an
errormessage to STDERR and then exit with a status code of 1 to indicate
that the data is missing.

=head1 CREDITS

Grabber written by Anand Tamariya, atamariya@gmail.com
This documentation copied from tv_grab_cz,
This code modified from tv_grab_cz, by Mattias Holmlund, mattias -at- holmlund -dot- se.
L<http://wiki.xmltv.org/index.php/HowtoWriteAGrabber>

=head1 BUGS

None known.

=cut

use strict;
use warnings;
use XMLTV;
use XMLTV::Version "$XMLTV::VERSION";
use XMLTV::Configure::Writer;
use XMLTV::Options qw/ParseOptions/;
use XML::LibXML;
use LWP::Simple;
use Date::Calc qw(Add_Delta_Days);
use URI::Escape qw(uri_escape);
use JSON;
use Data::Dumper;

# config vars
my $webroot = "http://timesofindia.indiatimes.com/";
my $loginURL = "http://timesofindia.indiatimes.com/";

my( $opt, $conf ) = ParseOptions( {
     grabber_name => "tv_grab_in_toi",
     capabilities => [qw/baseline manualconfig apiconfig/],
     stage_sub => \&config_stage,
     listchannels_sub => \&list_channels,
     version => "$XMLTV::VERSION",
     description => "India (timesofindia.indiatimes.com)",
} );

# make URL
my @channels = @{$conf->{channel}};

my $data;
$data->[0] = 'UTF-8';
$data->[1] = {
				'source-info-url' => 'http://timesofindia.indiatimes.com/',
				'source-info-name' => 'Times of India',
				'generator-info-name' => 'tv_grab_in_toi',
				'generator-info-url' => 'http://wiki.xmltv.org/index.php/XMLTVProject'
			 };


# channels are retrieved by display name not id
#
while (my @next_n = splice @channels, 0, 10) {
	my $channels_str = join ",", @next_n;
	my $url = buildURL( 'get_schedule', $conf, $opt, $channels_str );

	# fetch data
	my $res = get( $url );
	#print $res;
	transform_program($res);
}

XMLTV::write_data($data);

exit(0);


#=========================================================================================

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

	my $writer = new XMLTV::Configure::Writer( OUTPUT => \$result, encoding => 'utf-8' );

	if( $stage eq 'start' ) {
		$writer->start( { grabber => 'tv_grab_in_toi' } );
		$writer->end( 'select-channels' );

	} else {
		die "Unknown stage $stage";
	}

    return $result;
}

# Return a string containing an xml-document with <channel>-elements
# for all available channels
sub list_channels
{
	# $opt hold command line parameters, if any
	my( $conf, $opt ) = @_;

	my $url = buildURL( 'get_channels', $conf, $opt );

	# fetch list of channels
	my $channels = get( $url );
	my $data = transform_channel( $channels );

	# return XML string
	return $data;
}

# Transform comma separated string to XMLTV channel list in string form
sub transform_channel
{
	my ( $str ) = @_;

	# we don't get JSON but a simple comma-separated list of channel names!
	my @array = split( ",", $str);

	my $result;
	my $writer = new XMLTV::Writer(OUTPUT => \$result);
	$writer->start({'generator-info-name' => 'tv_grab_in_toi'});

	# Note this breaks RFC2838 but there's no easy way to get the list of channel ids
	#
	foreach my $name (@array) {
		my %channel = (
						'id' => "$name",
						'display-name' => [ [ "$name", "en" ] ]
					  );
		$writer->write_channel( \%channel );
	}
	$writer->end();
	#printf $result;

	return $result;
}

# Transform schedule JSON to XMLTV in $data
sub transform_program
{
	my ( $str ) = @_;
	my $ptr = decode_json $str;
	$ptr = $ptr->{"ScheduleGrid"}->{"channel"};

	my $tz = "+0530";	# IST
	my $lang = "en";
	my ($encoding, $credits, $ch, $progs) = @$data;
	foreach my $c (@$ptr) {
		my $channeldisplayname = $c->{"channeldisplayname"};
		$channeldisplayname =~ s/\s/-/g;		# spaces not allowed by RFC2838 (note this still breaks validation as it's not a valid dns-identifier)
		if (! exists($ch->{$c->{"channelid"}})) {
			$ch->{$c->{"channelid"}} = {
										#  we should use channelid but that's not how they're listed in the config file,
										#  and we should be consistent!
										#			id => $c->{"channelid"},
										'id' => $channeldisplayname,
										'icon' => [ { src => $c->{"channellogourl"}} ],
										'display-name' => [ [ $c->{"display-name"}, $lang ] ]
										};
		}
		my $program = $c->{"programme"};
		foreach my $p (@$program) {

			my %prog = (
						#channel =>  $c->{"channelid"},
						channel =>  $channeldisplayname,
						start => "$p->{'start'} $tz",
						stop => "$p->{'stop'} $tz",
						category => [ [$p->{"subgenre"}, $lang] ],
						icon => [ { src => $p->{"programmeurl"}} ],
						date => $p->{"date"},
						title => [ [ $p->{"title"}, $lang ] ]
						);
			push @$progs, \%prog;
		}
	}

	$data->[2] = $ch;
	$data->[3] = $progs;
	#print Dumper $ch;
}

# build API URL for a given action
sub buildURL
{
	my( $action, $conf, $opt, $channels ) = @_;
	my $url;

	if ($action eq "get_channels") {
		$url  = $webroot . "tvschannellist.cms?genrename=all";
		return $url;

	} elsif ($action eq "get_schedule") {
		$channels =~ s/\ /%20/g ;
		$url  = $webroot . "tvschedulejson.cms?channellist=" . $channels;

	} else {
		die "Invalid action\n";
	}

	if ( !exists($opt->{quiet}) || $opt->{quiet} == 0 ) {
		if ( $opt->{days} > 1 ) {
			die "EPG only allows fetch of one day at a time\n";
		}
	}

	my ($sec,$min,$hour,$day,$month,$year,$wday,$yday,$isdst) = localtime();
	my $datestring;
	$year += 1900;
	$month++;

	if( $opt->{offset} > 0 ) {
		# append offset
		($year, $month, $day) = Add_Delta_Days($year, $month, $day,  $opt->{offset});
	}
	$datestring = sprintf "%04d%02d%02d0000", ($year, $month, $day);
	$url .= "&fromdatetime=" .  $datestring;

	if( $opt->{days} > 0 ) {
		$opt->{days} = 1;   # can only fetch one day at a time
		# append days
		($year, $month, $day) = Add_Delta_Days($year, $month, $day,  $opt->{days});
		$datestring = sprintf "%04d%02d%02d0000", ($year, $month, $day);
		$url .= "&todatetime=" .  $datestring;
	}

	#print STDERR $url;
	# 		e.g. http://timesofindia.indiatimes.com/tvschedulejson.cms?channellist=Zee%20TV&fromdatetime=201802240000&todatetime=201802250000

	return $url;

}

1;
