xmltv-util 0.5.67-0.1 / usr / bin / tv_grab_dtv_la

#!/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_dtv_la - Grab TV listings for Direct TV Latin America

=head1 SYNOPSIS

tv_grab_dtv_la --help

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

tv_grab_dtv_la [--config-file FILE] [--output FILE] [--days N]
		   [--offset N] [--min-delay N] [--max-delay N] [--quiet]

tv_grab_dtv_la --list-channels --loc [ar | cb | cl | co | ec | pe | pr | uy | ve]

tv_grab_dtv_la --capabilities

tv_grab_dtv_la --version

=head1 DESCRIPTION

Output TV listings for Direct TV channels available in Latin America.
Listings for the following countries are currently available:
Argentina, Caribbean ('cb'), Chile, Colombia, Ecuador, 
Peru, Puerto Rico, Trinidad, Uruguay, Venezuela.

The tv listings comes from http://directstage.directvla.com/
The grabber relies on parsing HTML so it might stop working at any time.

First run B<tv_grab_dtv_la --configure> to choose, first of all your country
and then which channels you want to download. Then running B<tv_grab_dtv_la> 
with no arguments will output listings in XML format to standard output.

The grabber doesn't generate stop times, so you may want to run
tv_sort on the output to generate them.

B<--configure> Prompt for which channels,
and write the configuration file.

B<--config-file FILE> Set the name of the configuration file, the
default is B<~/.xmltv/tv_grab_dtv_la.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> Write to FILE rather than standard output.

B<--days N> Grab N days.  The default is 3.

B<--offset N> Start N days in the future.  The default is to start
from today.

B<--min-delay N> You must insert a delay between page requests to avoid
unnecessary load on the website. If you try to grab pages too quickly then
it's likely you will get banned by the website providers (and may get
all other xmltv users banned as well!).
Suggested value: 1 (seconds) 

B<--min-delay N> Maximum delay between web page fetches.
Suggested value: 3 (seconds)

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

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 SEE ALSO

L<xmltv(5)>, L<tv_grab_ar>.

=head1 AUTHOR

Most of the grabber was made by Lic. Christian A. Rodriguez <car@cespi.unlp.edu.ar>, with a
lot of help from others, specially Joaquin Salvarredy <jsalvarredy@cespi.unlp.edu.ar> who 
tested the grabber from it's early versions and Lic. Nicolas Macia <nmacia@cespi.unlp.edu.ar>

=head1 BUGS

This grabber extracts all information from Direct TV Latin America website. Any change in this
web page may cause this grabber to stop working.

=cut

# Author's TODOs & thoughts
#
# Add better channel names
#
(	#(facilitate code-folding)
#
# 2014-04-19
#
#  URLS
#    http://www.directv.com.ar/programacion/guia-de-programacion
#    http://www.directv.com.ar/programacion/guia-de-canales
#
#    http://www.directv.cl/guia/guia.aspx?type=&link=nav/
#    http://www.directv.cl/planes/guia-de-canales
#
#    http://www.directv.com.co/guia/guia.aspx?type=
#    http://www.directv.com.co/paquetes/guia-de-canales
#
#    http://www.directv.com.ec/guia/guia.aspx?type=
#    http://www.directv.com.ec/planes/guia-de-canales
#
#    http://www.directv.com.pe/guia/guia.aspx?type=
#    http://www.directv.com.pe/paquetes/guia-de-canales
#
#    http://www.directv.com.uy/guia/guia.aspx?type=
#    http://www.directv.com.uy/paquetes/guia-de-canales
#
#    http://www.directv.com.ve/guia/guia.aspx?type=
#    http://www.directv.com.ve/planes/guia-de-canales
#
#    note the Sky BR site is very dirfferent layout (& appears broken)
#    http://www.sky.com.br/servicos/Guiadatv/gradecanais.aspx
#    https://www.sky.com.br/servicos/Guiadatv/GravacaoDistancia.aspx
#
#		 the Sky MX site is rubbish
#    http://www.sky.com.mx/sky/gu%C3%ADa-de-programaci%C3%B3n
#
);


######################################################################
## REQUIRED LIBRARIES
######################################################################
use XMLTV;
use XMLTV::Version '$Id: tv_grab_dtv_la,v 1.9 2015/06/23 20:05:25 knowledgejunkie Exp $ ';
use XMLTV::Capabilities qw/baseline manualconfig/;
use XMLTV::Description 'Latin America Direct TV listings';
use XMLTV::Memoize;
use XMLTV::ProgressBar;
use XMLTV::Ask;
use XMLTV::Config_file;
use XMLTV::Mode;
use XMLTV::Date;
use XMLTV::DST;
use XMLTV::Usage <<END
$0: get Latin America Direct-TV listings in XMLTV format
To configure: $0 --configure [--config-file FILE]
To grab listings: $0 [--config-file FILE] [--output FILE] [--days N]
		[--offset N] [--quiet]
To list channels: $0 --list-channels
To show capabilities: $0 --capabilities
To show version: $0 --version
END
;
#use HTML::Form;
use HTML::TreeBuilder;
use Getopt::Long;
use Date::Manip;
use Date::Parse;
use Date::Language;
use LWP::UserAgent;
use HTTP::Cookies;
use Encode qw(from_to is_utf8 _utf8_off encode);
use utf8;
use JSON::PP;
use Data::Dumper;


# ${Log::TraceMessages::On} = 1;
# to switch TRACE in remove the comment from prev. line

# Use Log::TraceMessages if installed.
BEGIN {
	eval { require Log::TraceMessages };
	if ($@) {
	*t = sub {};
	*d = sub { '' };
	}
	else {
	*t = \&Log::TraceMessages::t;
	*d = \&Log::TraceMessages::d;
	Log::TraceMessages::check_argv();
	}
}


######################################################################
## GLOBAL VARIABLES
######################################################################
my $warnings = 0;

my ($opt_days, $opt_offset, $opt_help, $opt_output,
	$opt_configure, $opt_config_file, $opt_gui,
	$opt_quiet, $opt_list_channels, $opt_loc,
	$opt_min_delay, $opt_max_delay, $opt_debug);

# Attributes of the root element in output.
my $HEAD = { 
			'source-info-url'     => 'http://directstage.directvla.com/',
			'source-data-url'     => 'http://directstage.directvla.com/',
			'generator-info-name' => 'tv_grab_dtv_la',
			'generator-info-url'  => 'http://xmltv.org/',
			};

my $channels_icon_url="http://www.lyngsat.com/packages/directvlatin.html";
my $countries_list_url="http://directstage.directvla.com/";

# So we are not affected by winter/summer timezone
$XMLTV::DST::Mode='none';

# timezone to use (for all countries!)
my $TZ="-0300";

# default language
my $LANG="es";
my $OUT_ENCODING="UTF-8";

# Selected country
my %country;

# Full list of channels
my @ch_all;
my $CHANNELS_URL=undef;

# Providers name for creating unique channel id
my $PROVIDER_NAME="dtv.la";

# Progressbar
my $mainbar;

# Private UserAgent
my $cookies = HTTP::Cookies->new;
my $ua = LWP::UserAgent->new;
$ua->cookie_jar($cookies);

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


# undocumented --cache option.
# not sure this will work with ajax post requests ?
XMLTV::Memoize::check_argv('get_tree');

######################################################################
## SUBROUTINES
######################################################################

######################################################################
## Returns a trimmed string
sub trim {
	my $string = shift;
	$string =~ s/^\s+|\s+$//g  if defined $string;
	return $string;
}

######################################################################
## Returns a TreeBuilder instance

# You must insert a delay between page requests to avoid
# unnecessary load on the website. If you try to grab pages too quickly then
# it's likely you will get banned by the website providers (and may get
# all other xmltv users banned as well - it's trivial to ban by user-agent string).
#
my $last_get_time;
#
sub get_tree ($;$$) {
	my $url = shift;
	my $method = shift || 'get';
	my $data = shift;
	my $r;
	
	print STDERR "$method: $url ".($data?"[$data]":'')." \n" if $opt_debug;
	
	# let's not overload the website with too many requests so we'll restrict the request frequency (as per Get_nice)
	
	my $Delay = $opt_max_delay - $opt_min_delay; 	# in seconds
	my $MinDelay = $opt_min_delay; 					# in seconds

	if (defined $last_get_time) {
		# A page has already been retrieved recently.  See if we need
		# to sleep for a while before getting the next page - being
		# nice to the server.
		my $next_get_time = $last_get_time + (rand $Delay) + $MinDelay;
		my $sleep_time = $next_get_time - time();
		sleep $sleep_time if $sleep_time > 0;
	}
	
	if (!defined $method || lc($method) eq 'get') {
		$r = $ua->get($url);
		
	} elsif (lc($method) eq 'post') {
		$r = $ua->post($url, $data);	# $data must be a hash
		
	} elsif (lc($method) eq 'jsonpost') {
		#
		# create the http request
		my $req = HTTP::Request->new( 'POST', $url );
		##$req->header( 'Content-Type' => 'application/json' );
		$req->content_type( 'application/json; charset=utf-8' );
		$req->content( $data );			# data must be json

		# execute the request
		$r = $ua->request($req);

	} else {
		die "unknown fetch method '$method'";
	}
	$last_get_time = time();
	
	#print STDERR Dumper($r);die;
	die "Could not fetch $url". (lc($method) eq 'jsonpost'?"[$data]":'') .", error: " . $r->status_line  if ($r->is_error);
	
	my $t;
	if (lc($method) eq 'jsonpost') {
		# expect a json reply!
		$t = JSON::PP->new()->utf8(1)->decode($r->content) or die "cannot parse content of $url\n";
	
	} else {
		$t = new HTML::TreeBuilder;
		#$t->utf8_mode(1);
		$data=$r->decoded_content('default_charset'=>'utf8');
		#$data=decode('UTF-8',$data) if (is_utf8($data));
		$t->parse($data) or die "Cannot parse content of Tree\n";
		$t->eof;
	}
	return $t;
}

######################################################################
## Bump a YYYYMMDD date by one.
sub nextday {
	my $d = shift;
	my $p = parse_date($d);
	my $n = DateCalc($p, '+ 1 day');
	return UnixDate($n, '%Q');
}

######################################################################
## Returns the URL for grabbing channels
sub get_channels_url {
	if (not defined $CHANNELS_URL){
		die "No country specified, run me with --configure\n" if not keys %country;

		# as at Apr 2014 it looks like they're still working on the website: all the Caribbean channels
		# point to the same place.
		if ( $country{'id'} eq 'CB' ) {
			$CHANNELS_URL = "http://www.directvcaribbean.com/tt/channel-description";
		}
		else {
			# although some of the sites have this as a subdir (e.g. under 'paquetes' or 'planes') it still
			# seems to work without that
			$CHANNELS_URL = $country{url} . 'guia-de-canales';
		}
		
	}
	
	return $CHANNELS_URL;
}

######################################################################
## Returns the URL for grabbing specified channel programs
sub get_channel_programs_url($) {
	##my $ch_id=shift;
	##my $base_url=get_channels_url();
	##$base_url=~ s/default/detailch/;
	##return "$base_url?c=$ch_id&n=chname";
	
	# e.g. http://www.directv.com.ar/guia/Services/ProgrammingGuideAjax.asmx/GetProgramming
	
	return $country{'url'} . 'guia/Services/ProgrammingGuideAjax.asmx/GetProgramming';
}

######################################################################
## Returns the URL for grabbing programme details
sub get_program_detail_url() {
	
	# e.g. http://www.directv.com.ar/guia/Services/ProgrammingGuideAjax.asmx/GetProgrammingDetail
	
	return $country{'url'} . 'guia/Services/ProgrammingGuideAjax.asmx/GetProgrammingDetail';
}

######################################################################
## Converts the given datetime format to the needed UTC format
sub datetime_for_program( $;$ ){
	my ($date,$strdt)=@_;
	$strdt=~ /^(\w*)\s+(\d{1,2}:\d{1,2})/;
	if ( defined $1 and defined $2) {
		$weekday=$1;
		$time=UnixDate($2,"%H:%M");
		if ( UnixDate($date,"%a") eq $weekday ){
		    return utc_offset("$date $time", $TZ)
		}
	}
	return undef;
}

######################################################################
## Returns channel programs for the specified date and channel id
sub get_channel_programs ( $$$$ ) {
	my ($ref_dates, $ref_channels, $ref_ch_all, $ref_programmes) = @_;
	
	# convert @dates & @channels into hashes for faster searching
	my %_dates = map { $_ => 1 } @$ref_dates;
	my %_channels = map { $_ => 1 } @$ref_channels;
	
	my @_ch_all = @$ref_ch_all;
	
	# temporary store for programmes we fetch (used for detecting duplicates and clumps)
	my $programmes = {};
	
	# for parsing non-English language dates
	my $lang;
	if ( $country{'id'} eq 'CB' ) {	# Caribe is currently in English
		$lang = Date::Language->new('English');
	} else {
		$lang = Date::Language->new('Spanish');
	}
	
	# site now uses a jQuery AJAX POST with JSON content in UTF-8
	# e.g. { "day":19, "time":"12","minute":"30", "month":"4", "year":"2014", "onlyFavorites":"N" }
	#
	# data are avialable in a 4-hour windows (all channels combined)
	#
	foreach my $date (@$ref_dates) {
		my ( $_y, $_m, $_d ) = $date =~ /(\d\d\d\d)(\d\d)(\d\d)/;
		for (my $i=0; $i<24; $i+=4) {
			my $_h = substr("0$i", -2, 2);

			my $data = '{ "day":'.$_d.', "time":"'.$_h.'","minute":"00", "month":"'.$_m.'", "year":"'.$_y.'", "onlyFavorites":"N" }';
			##print STDERR $data."\n";
			
	
			my $json = get_tree( get_channel_programs_url(undef), 'jsonpost', $data );
			##print STDERR Dumper($json);die;
		
			# response is a JSON string containing just one k:v pair, 'd' => "..."
			#  (see http://www.directv.com.ar/guia/js/Program-Guide/ProgrammingGuideAjax.js for details)
			
			# we don't need the overhead of TreeBuilder - we'll go 'old school' and use a regexp
			my (@li) = $json->{'d'} =~ m/(<li.*?<\/li>)/g;
			##print Dumper(@li);die;
			
			foreach $li (@li) {
				
				# <li id="PG_ctl02_Prog_ctl00_liItem" class="" style="width:267px" eventId="121190335202" channel="121"><a href="javascript:return false;" class="ChannelArrowLeft"></a><span id="PG_ctl02_Prog_ctl00_HDCh" style="padding-left:10px;"><literal id="PG_ctl02_Prog_ctl00_litHDCh">Las aventuras de Robin Hood</literal></span><a href="/guia/RecordBox.aspx?iframe&eventId=121190335202&page=grid" class="Action loginAvailable"></a></li>
				# <li id="PG_ctl02_Prog_ctl01_liItem" class=" toolTip" style="width:99.5px" title="Enciclopedia digital del cosmos" eventId="121190335203" channel="121"><span id="PG_ctl02_Prog_ctl01_HDCh"><literal id="PG_ctl02_Prog_ctl01_litHDCh">Enciclopedia di...</literal></span><a href="/guia/RecordBox.aspx?iframe&eventId=121190335203&page=grid" class="Action loginAvailable"></a></li>
				
				# <li id="PG_ctl214_Prog_ctl00_liItem" class=" PpvVenezuela toolTip last disabled" style="width:806px" eventid="" channel="1003" original-title="Programación no disponible"><span id="PG_ctl214_Prog_ctl00_HDCh" style="padding-right:10px;" class="HdActive"><literal id="PG_ctl214_Prog_ctl00_litHDCh">Programación no disponible</literal><span id="PG_ctl214_Prog_ctl00_imgIcon" class="3d"></span></span><a href="javascript:return false;" class="ChannelArrowRight"></a><a href="https://www.directv.com.ve/midirectv/PPVBrowse.aspx?language=&amp;section=DOD&amp;film=" class="Action loginAvailable"></a></li>
			
				# Method:
				# The programme schedule is returned as a 4-hour window. Unfortunately the html contains nothing of use
				# other than the title, channel id and eventId. There isn't even a start time! So:
				# 1. Extract all the <li> items
				# 2. Ignore any which aren't for a requested channel
				# 3. Ignore any which have already started (as they will have already been picked up in a previous 4-hour window)
				# 4. Fetch the programme details using the eventId
				# 5. Parse the prog details and add to a hash
				#
				
				# parse the <li> element
				my ( $eventId, $channelId, $hasStarted ) = $li =~ m/eventId="(\d*)"\schannel="(\d*)".*?(?(?=.*ChannelArrowLeft)(ChannelArrowLeft)|())/;
				##if ($hasStarted) {print STDERR "skipping $eventId, $channelId\n";}
				next if $hasStarted;						# if prog has already started
				next if ! $_channels{ $channelId };			# if channel not wanted
				next if !defined $eventId || $eventId eq '';# e.g. Programación no disponible (can't output anything since no start/stop time!)				
				
				# post content: { "eventId":121190335202, "day":20, "time":"4","minute":"0", "month":"4", "year":"2014" }
				my $data = '{ "eventId":'.$eventId.', "day":'.$_d.', "time":"'.$_h.'","minute":"0", "month":"'.$_m.'", "year":"'.$_y.'" }';
		
				my $json = get_tree( get_program_detail_url(), 'jsonpost', $data );
				##print STDERR Dumper($json);die;
				
				my $t = HTML::TreeBuilder->new()->parse( $json->{'d'} ) or die "cannot parse content of programme detail\n";
				$t->eof;
				##$t->dump();die;
		
				my $p;	# programme
				
				my $div;  if ( my $_t = $t->look_down('_tag'=>'h2') ) { $div = $_t->parent(); }
				if (!defined $div) {
					# why is it not? 
					print STDERR 'Warn: No programme description (no <h2> element for "eventId":'.$eventId.', "day":'.$_d.', "time":"'.$_h.")\n";
					next;
				}
				
				my $h;	# html (tree) element
				
				if ( $h = $div->look_down('_tag'=>'h2') ) {
					if ( my $h_ = $div->look_down('_tag'=>'img', 'alt'=>'HD program') ) {
						$p->{'video'}->{'quality'} = 'HDTV';
					}
					$p->{'title'} = trim( $h->as_text() );
					$h->detach;
				}
				# 'title' is mandatory in the DTD. If we don't have one then set to unknown
				$p->{'title'} = ($LANG eq 'pt_BR' ? 'ignorado' : 'incógnito') if (!defined $p->{'title'} || $p->{'title'} eq '');
				

				# 1st <p> is the description
				if ( $h = $div->look_down('_tag'=>'p') ) {
					$p->{'desc'} = trim( $h->as_text() );
					$h->detach;
				}
		
				# 2nd <p> is the start time and duration
				if ( $h = $div->look_down('_tag'=>'p') ) {
					my $h_ = trim( $h->as_text() );
					my ($_junk, $_date, $_dur) = $h_ =~ m/(Comienza|Start):\s*(.*?)\|(.*?)$/s;		# Caribe = "Start:"
					
					# Date::Language doesn't currently do Portuguese
					#  (the Sky BR site isn't handled in this grabber anyway)
					my $dt;
					if ( $country{'id'} eq 'BR' ) {
						die "\n Sorry I don't speak Portuguese \n";
					} else {
						$dt = $lang->str2time($_date, $TZ);
					}
					
					$p->{'start_epoch'} = $lang->str2time($_date, $TZ);
					( $p->{'duration'} ) = $_dur =~ /(\d*)\s(?=minutos|minutes)/;
					$p->{'stop_epoch'} = $p->{'start_epoch'} + ( $p->{'duration'} * 60 )  if $p->{'duration'};
					$p->{'start'} = $lang->time2str( "%Y%m%d%H%M%S %z", $p->{'start_epoch'}, $TZ );
					$p->{'stop'} = $lang->time2str( "%Y%m%d%H%M%S %z", $p->{'stop_epoch'}, $TZ );
					$h->detach;
				}
					
				# <div> class "Rank" = rating & programme url
				if ( $h = $div->look_down('_tag'=>'div', 'class'=>qw/Rank/) ) {
					if ( my $h = $h->look_down('_tag'=>'p') ) {
						my $h_ = trim( $h->as_text() );
						( $p->{'rating'} ) = $h_ =~ m/Rating:\s*(\S*)\s/s;
					}
					
					if ( my $h = $h->look_down('_tag'=>'div') ) {
						if ( my $h_ = $h->look_down('_tag'=>'a') ) {
							my $h__ = trim( $h_->attr('href') );
							$h__ = $country{'url'} . $h__  if ( $h__ !~ /^http/ );
							$p->{'url'} = $h__;
						}
					}
					$h->detach;
				}
				
				
				
				# Reformat the data to Create the data structure for the programme
				my $p_out = {};
				$p_out->{'channel'} 	= $channelId . '.' . $PROVIDER_NAME;
				$p_out->{'title'} 		= [[ encode($OUT_ENCODING, $p->{'title'}), $LANG ]];
				$p_out->{'start'} 		= $p->{'start'};
				$p_out->{'stop'} 		= $p->{'stop'}  if (defined $p->{'stop'} && $p->{'stop'} ne '');
				$p_out->{'desc'} 		= [[ encode($OUT_ENCODING, $p->{'desc'}), $LANG ]]  if (defined $p->{'desc'} && $p->{'desc'} ne '');
				$p_out->{'sub-title'} 	= [[ encode($OUT_ENCODING, $p->{'sub_title'}), $LANG ]]  if (defined $p->{'sub_title'} && $p->{'sub_title'} ne '');
				$p_out->{'rating'} 		= [[ $p->{'rating'} ]]  if (defined $p->{'rating'} && $p->{'rating'} ne '');
				$p_out->{'url'} 	  	= [ encode($OUT_ENCODING, $p->{'url'}) ]  if (defined $p->{'url'} && $p->{'url'} ne '');
				$p_out->{'video'} 		= $p->{'video'}  if (defined $p->{'video'});
				
				# store the programme avoiding duplicates
				# also check for duplicate start times and set clumpidx
				if ( defined $programmes->{ $channelId }->{ $p->{'start_epoch'} } ) {
					# duplicate prog or contemporary?
					my $dup = 0;
					foreach my $_p ( @{ $programmes->{ $channelId }->{ $p->{'start_epoch'} } } ) {
						$dup = 1  if ( $_p->{'title'}[0][0] eq $p_out->{'title'}[0][0] );	# duplicate
					}
					next if $dup;	# ignore duplicates (go to next <li> programme element)
					if (!$dup) { 
						# contemporary programme so set clumpidx
						my $numclumps = scalar @{ $programmes->{ $channelId }->{ $p->{'start_epoch'} } }  + 1;
						# set (or adjust) clumpidx of existing programmes
						my $i = 0;
						foreach my $_p ( @{ $programmes->{ $channelId }->{ $p->{'start_epoch'} } } ) {
							$_p->{'clumpidx'} = "$i/$numclumps";
							$i++;
									}
						# set clumpidx for new programme
						$p_out->{'clumpidx'} = "$i/$numclumps";
					}
				}
				
				# store the programme in our temporary store
				push @{ $programmes->{ $channelId }->{ $p->{'start_epoch'} } }, $p_out;
				
			}
			
			$mainbar->update() if not $opt_quiet;
		}
		
	}
	
	
	# All data has been gathered. We can now write the programme element to the output. 
	#
	foreach ( keys %{$programmes} ) {
		my $_ch_progs = $programmes->{$_};
		foreach ( sort keys %{$_ch_progs} ) {
			my $_dt_progs = $_ch_progs->{$_};
			foreach (@{ $_dt_progs }) {
				push @{$ref_programmes}, $_;
			}
		}
	}
}

######################################################################
## Returns the list of channels
#
# Note: I've noticed that sometimes there's more channels on the actual programme schedule page
#     than in the channels guide page :-(  So we may need to switch and get the list of channels
#     from the AJAX fetch on the schedules page (although the icons may be smaller?)
#
sub get_channels {
	my $bar = new XMLTV::ProgressBar("Getting list of channels for $country{name}", 1) if not $opt_quiet;

	my %channels;
	my $url=get_channels_url();

	# Get channels that are transmiting now
	my $tree = get_tree($url);
	get_channels_from_tree($tree,\%channels); 
	# We will try to find more channels for later hours
	#get_channels_for_later_hours($tree,\%channels);
	
	# Finish using Tree
	$tree=undef;
	$bar->update() && $bar->finish() if not $opt_quiet;
	return %channels;
}

######################################################################
## Simulate a form filling to retrieve more channels for later hours
sub get_channels_for_later_hours() {
	my ($tree,$channels) = @_;

	# First we get the form elemento to call iteratively for each option from a select
	my $form_elem = $tree->look_down(
		"_tag"=>"form", sub {
		    defined $_[0]->attr('name') and $_[0]->attr('name')=~ /Form1/i
		}
	);
	# The name of the select element is:
	my $search_for_input="ddlTime";
	my %needed_form_elems=('ddlTime','select','ddlDay','select','btnSubmit','input');

	# Form to call iteratively
	$form=HTML::Form->parse($form_elem->as_HTML(),get_channels_url());
	my $input;

	foreach my $ninput (keys %needed_form_elems){
		$input=$form->find_input($ninput);

		# There is a bug in the source HTML. The field we need is outside the form tag
		if (not defined $input) {
		# We try to fix this problem
			my $broken_elem = $tree->look_down(
				"_tag"=>$needed_form_elems{$ninput}, sub {
						defined $_[0]->attr('name') and $_[0]->attr('name')=~ /$ninput/i
				    }
			);
			$form_elem->insert_element($broken_elem);
			$form=HTML::Form->parse($form_elem->as_HTML(),get_channels_url());
			$input=$form->find_input($ninput);
			die "Cannot retrieve field $ninput. Aborting" if (not defined $input);
		}
	}
	# Now for each value of the select, we will call get_channels_from_tree subroutine
	$input=$form->find_input($search_for_input);
	$default_value=$input->value;
	foreach ($input->possible_values) {
		if ($_ != $default_value) {
			$form->value($search_for_input,$_);
			my $r=$ua->request($form->click);
			die "Error doing automatic form filling. Aboring" if ($r->is_error);
			my $t = new HTML::TreeBuilder;
			#$t->utf8_mode(1);
			$data=$r->decoded_content('default_charset'=>'utf8');
			#$data=from_to($data,'UTF-8',$OUT_ENCODING) if (is_utf8($data));
			$t->parse($data) or die "Cannot parse content of Tree\n";
			$t->eof;
			get_channels_from_tree($t,$channels);
		}
	}
}

######################################################################
## Return the list of channels for a tree representation of an HTML page
sub get_channels_from_tree( ) {
	my ($tree,$channels) = @_;
	
	# see if there's a 'pMain' so we can ignore the CMS content (which contains the on-demand channels)
	my $chan_div = $tree->look_down('_tag' => 'div', 'id' => 'pMain');
	$tree = $chan_div  if $chan_div;
	
	my @chan_groups = $tree->look_down('_tag' => 'div', 'class' => 'guia-canales')->look_down('_tag' => 'div', 'class' => 'combo-canal-content');
	
	foreach (@chan_groups) {
		my @chan_elems = $_->look_down('_tag' => 'li');
		foreach (@chan_elems) {
			# <li>
			#   <a itemprop="makesOffer" href="http://www.directv.com.pe/guia/ChannelDetail.aspx?id=197"><img src="http://www.ondirectv.com/Thumbnail.ashx?image=LOGOS/canales/v2/197.png&amp;width=64&amp;height=32" alt="TVPeru " width="64" height="32" title="TVPeru  - Canal 197"><br>
			# 	  <span>197</span>
			#	 </a>
			# </li>
			
			if ( my $chan = $_->look_down('_tag' => 'a') ) {
				my ($chan_id, $chan_name, $chan_url, %chan_icon) = ('', '', '', ());
				$chan_id = trim( $chan->look_down('_tag' => 'span')->as_text() );
				$chan_url = $chan->attr('href');
				if ( my $chan_img = $chan->look_down('_tag' => 'img') ) {
					$chan_name = trim( $chan_img->attr('alt') );
					$chan_icon{'src'} = $chan_img->attr('src');
					$chan_icon{'width'} = $chan_img->attr('width')  if defined $chan_img->attr('width');
					$chan_icon{'height'} = $chan_img->attr('height')  if defined $chan_img->attr('height');
				}

				$chan_name="$chan_name ($chan_id)";
				if (not exists  ${$channels} { $chan_id }) {
					${$channels} {$chan_id}=$chan_name;
					 push @ch_all, {
									'display-name' => [[ encode("UTF-8",$chan_name), $LANG ],[$chan_id]],
									'channel-num' => $chan_id  ,
									'id' => "$chan_id.$PROVIDER_NAME",
									'icon' => [ \%chan_icon ],
									 };
				}
			}
		}
	}
	
}

######################################################################
## Get a list of possible countries
sub get_countries( ) {
	my $country_codes = { 'Argentina' => 'AR', 'Caribe' => 'CB', 'Chile' => 'CL', 'Colombia' => 'CO', 'Ecuador' => 'EC', 'Peru' => 'PE', 'Puerto Rico' => 'PR', 'Trinidad' => 'TT', 'Uruguay' => 'UY', 'Venezuela' => 'VE' };

	my $tree = get_tree($countries_list_url);
	my @options=$tree->look_down('_tag' => 'div', 'id' => 'country-selector-btm')->look_down('_tag' => 'li');
	my %countries;
	foreach (@options){
		if ( my $tag = $_->look_down('_tag' => 'a') ) {
			my %country;
			$country{'name'} = $tag->as_text();
			$country{'url'} = $tag->attr('href');
			$country{'id'} = $country_codes->{$country{'name'}};
			
			# we won't do the Sky sites - they are very different to DirecTV
			if ( $country{'name'} =~ /(SKY Brasil|SKY Mexico)/ ) {
				#print "Skipping country - $country{'name'} \n" unless $opt_quiet;
				next;
			}
			
			if ( !defined $country_codes->{$country{'name'}} ) {
				print "Unknown country - $country{'name'} \n" unless $opt_quiet;
				next;
			}
			
			$countries{$tag->as_text()} = \%country;
		}
	}
	return %countries;
}

######################################################################
## Return the user-selected country
sub select_country( ) {
	%countries = get_countries();
	my @names = sort keys %countries;
	my $choice = ask_choice("Select your country:", $names[0], @names);
	return ( id=>$countries{$choice}{'id'}, name=>$choice, url=>$countries{$choice}{'url'} );
}

######################################################################
## Return the channel icons from LyngSat
sub get_channel_icons() {
	my $bar = new XMLTV::ProgressBar("Trying to fetch channel icons for $country{name}", $#ch_all + 1) if not $opt_quiet;
	my $tree=get_tree($channels_icon_url);
	my $table=$tree->look_down( 
		'_tag'=>'table',sub {
			defined $_[0]->attr('width') and $_[0]->attr('width')== '600'
		}
	);
	foreach my $ch (@ch_all){
		my $ch_num=$ch->{'channel-num'};
		my $tr=$table->look_down(
			'_tag'=>'tr',sub {
				@td=$_[0]->content_list();
				defined $td[0] and $td[0]->as_text() =~ /\s*$ch_num\s*/
		    }
		);
		if (defined $tr){
			my $img=$tr->look_down(
				'_tag'=>'img');
			$ch->{icon}=[ { src=>$img->attr('src')} ] if defined $img and defined $img->attr('src');
		}
		$bar->update() if not $opt_quiet;
	}
	$bar->finish() if not $opt_quiet;
}

######################################################################
## Return the channel icons from the DirecTV site
sub get_channel_icons_dtv() {
	my $bar = new XMLTV::ProgressBar("Fetching channel icons for $country{name}", $#ch_all + 1) if not $opt_quiet;
	my $tree=get_tree( get_channels_url() );
	my $table=$tree->look_down('_tag' => 'div', 'class' => 'guia-canales');
	
	foreach my $ch (@ch_all){
		my $ch_num=$ch->{'channel-num'};
		my $chan_img;
		if ( my $chan_a = $table->look_down('_tag'=>'a', 'href'=>qr/ChannelDetail.aspx\?id=$ch_num/) ){
			$chan_img = $chan_a->look_down('_tag'=>'img');
		}
		if (defined $chan_img) {
			my %chan_icon;
			$chan_icon{'src'} = $chan_img->attr('src');
			$chan_icon{'width'} = $chan_img->attr('width')  if defined $chan_img->attr('width');
			$chan_icon{'height'} = $chan_img->attr('height')  if defined $chan_img->attr('height');
			$ch->{icon}=[ \%chan_icon ];
		}
		$bar->update() if not $opt_quiet;
	}
	$bar->finish() if not $opt_quiet;
}

######################################################################
## MAIN PROGRAM
######################################################################

######################################################################
## get options
# Get options.

$opt_days       = 3; # default
$opt_offset     = 0; # default
$opt_quiet      = 0; # default
$opt_min_delay  = 1;
$opt_max_delay  = 3;
$opt_debug      = 0;

GetOptions(
	'days=i'		=> \$opt_days,
	'offset=i'      => \$opt_offset,
	'help'		  => \$opt_help,
	'configure'     => \$opt_configure,
	'config-file=s' => \$opt_config_file,
	'gui:s'		 => \$opt_gui,
	'output=s'      => \$opt_output,
	'quiet'		 => \$opt_quiet,
	'list-channels' => \$opt_list_channels,
	'debug'		 => \$opt_debug,
	'loc=s'		 => \$opt_loc,
	'min-delay=f'   => \$opt_min_delay,
	'max-delay=f'   => \$opt_max_delay,
) or usage(0);

$opt_min_delay = (0.5, $opt_min_delay)[0.5 < $opt_min_delay];
$opt_max_delay = (0.5, $opt_max_delay)[0.5 < $opt_max_delay];

die 'number of days must not be negative' if (defined $opt_days && $opt_days < 0);
usage(1) if $opt_help;

XMLTV::Ask::init($opt_gui);
my $mode = XMLTV::Mode::mode(
	'grab', # default
	$opt_configure => 'configure',
	$opt_list_channels => 'list-channels',
);

# File that stores which channels to download.
my $config_file = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_dtv_la', $opt_quiet);
my @config_lines; # used only in grab mode
if ($mode eq 'configure') {
	XMLTV::Config_file::check_no_overwrite($config_file);
}elsif ($mode eq 'grab') {
	@config_lines = XMLTV::Config_file::read_lines($config_file);
}elsif ($mode eq 'list-channels') {
	# Config file not used.
}else { 
	die 
}

## Whatever we are doing, we need the channels data.
##my %channels = get_channels(); # sets @ch_all
my %channels;
my @channels;

######################################################################
## write configuration
#    
if ($mode eq 'configure') {
	open(CONF, ">$config_file") or die "cannot write to $config_file: $!";
	%country= select_country();
	print CONF "country $country{id} $country{name} $country{url} \n";
	%channels = get_channels(); # sets @ch_all
	
	# Ask about each channel.
	my @chs = sort keys %channels;
	my @names = map { $channels{$_} } @chs;
	my @qs = map { "add channel $_?" } @names;
	my @want = ask_many_boolean(1, @qs);
	foreach (@chs) {
		my $w = shift @want;
		warn("cannot read input, stopping channel questions"), last
		if not defined $w;
		# No need to print to user - XMLTV::Ask is verbose enough.

		# Print a config line, but comment it out if channel not wanted.
		print CONF '#' if not $w;
		my $name = shift @names;
		print CONF "channel $_ $name\n";
		# TODO don't store display-name in config file.
		}
	close CONF or warn "cannot close $config_file: $!";
	say("Finished configuration.");
	exit();
}

# Not configuration, we must be writing something, either full
# listings or just channels.

die if $mode ne 'grab' and $mode ne 'list-channels';

# Options to be used for XMLTV::Writer.
my %w_args;
if (defined $opt_output) {
	my $fh = new IO::File(">$opt_output");
	die "cannot write to $opt_output: $!" if not defined $fh;
	$w_args{OUTPUT} = $fh;
}
$w_args{encoding} = $OUT_ENCODING;
my $writer = new XMLTV::Writer(%w_args);
$writer->start($HEAD);

if ($mode eq 'list-channels') {
	# must have a country before we can list channels!
	die "please select a country ('--loc xx')"  if (!defined $opt_loc || $opt_loc eq '');
	
	%countries = get_countries();
	while ( ($key, $value) = each %countries ) {
		undef $key;
		if ( $value->{'id'} eq uc($opt_loc) ) {
			%country = ( id => $value->{'id'}, name => $value->{'name'}, url => $value->{'url'} );
			last;
		}
	}
		
	%channels = get_channels(); # sets @ch_all based on %country
	
	foreach (@ch_all) {
		delete $_->{'channel-num'};  # not an DTD item!
		$writer->write_channel($_) ;
	}
	$writer->end();
	exit();
}


######################################################################
## We are producing full listings.
die if $mode ne 'grab';

## Read configuration
# @channels = id list of channels to grab
# %channels = id => name of channels to grab
# @ch_all = id + ch-num + display-name of channels to grab
#
my $line_num = 1;
foreach (@config_lines) {
	++ $line_num;
	next if not defined;
	if (/^country:?\s+(\S+)\s+(\S+)\s+([^\#]+)/) {
		%country=( id => $1, name=>$2, url=>$3 );      
	}else{
		if (/^channel:?\s+(\S+)\s+([^\#]+)/) {
			my $ch_did = $1;
			my $ch_name = $2;
			$ch_name =~ s/\s*$//;
			push @channels, $ch_did;
			#CAR
			push @ch_all, {
							'display-name' => [[ $ch_name, $LANG ],[$ch_did]],
							'channel-num' => $ch_did  ,
							'id'=> "$ch_did.$PROVIDER_NAME" };
			$channels{$ch_did} = $ch_name;
		} else {
			warn "$config_file:$line_num: bad line\n";
		}
	}
}   

######################################################################
## begin main program
## Assume the listings source uses CET (see BUGS above).
my $now = DateCalc(parse_date('now'), "$opt_offset days");

die "No channels specified, run me with --configure\n" if not keys %channels;
die "No country specified, run me with --configure\n" if not keys %country;
my @to_get;

## we change language if country is Brazil
$LANG="pt_BR" if $country{name} =~ /brazil/i;

# Dates requested for programs listing
# @dates = list of dates to grab (yyyymmdd)
#
my $day=UnixDate($now,'%Q');
my @dates;
for (my $i=0;$i<$opt_days;$i++) {
	push @dates, $day;
	#for each day
	$day=nextday($day); 
	die if not defined $day;
}

# Try to get channel icons
# adds %icon to @ch_all
#
##get_channel_icons();    # LyngSat
get_channel_icons_dtv();	# DirecTV

# Write the <channel> elements
# data from %channels
# @to_get = array of @dates (yyyymmdd), chan-id (e.g. 122), chan-name (e.g. 122.dtv.la)
#
foreach my $ch_did (@channels) {
	my $index=0;
	my $ch_name=$channels{$ch_did};
	my $ch_xid="$ch_did.$PROVIDER_NAME";
	while (${$ch_all[$index]}{'id'} ne $ch_xid) {
		$index=$index+1;
	}
	my $ch_num=${ch_all[$index]}{'channel-num'};
	my $to_add={
		id => $ch_xid,
		'display-name' => [
		    [ encode($OUT_ENCODING, $ch_name), $LANG ],
		    [ $ch_num ] ]
	};
	$to_add->{icon}=${ch_all[$index]}{icon} if (exists ${ch_all[$index]}{icon} );
	$writer->write_channel($to_add);
	# build array of station-days to grab
	push @to_get, [ \@dates, $ch_xid, $ch_num ];
}

# This progress bar is for both downloading and parsing.  Maybe
# they could be separate.
##my $mainbar = new XMLTV::ProgressBar("getting listings for $country{name}", $#to_get + 1) if not $opt_quiet;
$mainbar = new XMLTV::ProgressBar("Getting listings for $country{name}", (@dates * 6) ) if not $opt_quiet;

# Grab requested data
# [ <v1.4 and write the output xml ]
# [v1.4 - now done all together rather than one station-day at a time]
##foreach (@to_get) {
##	foreach (get_channel_programs($_->[0], $_->[1], $_->[2])) {
##		$writer->write_programme($_);
##	}
##	$mainbar->update() if not $opt_quiet;
##}

# Data store before being written as XML
my @programmes = ();

# Fetch the data
# (note the params are all globals so the params aren't strictly necessary
#   but let's try for some better programming practice ;-)
get_channel_programs(\@dates, \@channels, \@ch_all, \@programmes);
	
# Write the <programme> elements
foreach (@programmes) {
	$writer->write_programme($_);
}
	
# end the progress bar
$mainbar->finish() if not $opt_quiet;

# close xml file
$writer->end();

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

# All data fetched ok.
#debug "Exiting without warnings.";
exit(0);