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

#!/usr/bin/perl -w

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

my $_version 	= '$Id: tv_grab_tr,v 1.5 2015/06/22 19:54:08 knowledgejunkie Exp $';

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

# enable for Dump function if debugging
#use Data::Dumper;

use strict;
use warnings;
use XMLTV::ProgressBar;
use XMLTV::Options qw/ParseOptions/;
use XMLTV::Configure::Writer;
use XMLTV::Get_nice qw(get_nice_tree);
use XMLTV::Date 0.005066;

use File::Path;
use POSIX qw(strftime);
use DateTime;
use Date::Parse;
use Encode;
use URI::Escape;

use HTTP::Cookies;
use LWP::Simple;
use LWP::UserAgent;
my $lwp = &initialise_ua();

use HTTP::Cache::Transparent;


#require HTTP::Cookies;
#my $cookies = HTTP::Cookies->new;
#$XMLTV::Get_nice::ua->cookie_jar($cookies);


# Although we use HTTP::Cache::Transparent, this undocumented --cache
# option for debugging is still useful since it will _always_ use a
# cached copy of a page, without contacting the server at all.
#
use XMLTV::Memoize;
XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux');

use subs qw(t warning);
my $warnings = 0;

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Grabber details
my $VERSION 			= $_version;
my $GRABBER_NAME 		= 'tv_grab_tr';
my $GRABBER_DESC 		= 'Türkiye - Digiturk (www.digiturk.com.tr)';
my $GRABBER_URL 		= 'http://wiki.xmltv.org/index.php/XMLTVProject';
my $ROOT_URL			= 'http://www.digiturk.com.tr/';
my $SOURCE_NAME			= 'Digiturk';
my $SOURCE_URL			= 'http://www.digiturk.com.tr/';
my $RFC_IDENTIFIER 		= 'digiturk.com.tr';
#
my $generator_info_name 	= $GRABBER_NAME;
my $generator_info_url 		= $GRABBER_URL;
my $source_info_name		= $SOURCE_NAME;
my $source_info_url		= $SOURCE_URL;

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should
my ($opt, $conf) = ParseOptions({ 
	grabber_name 			=> $GRABBER_NAME,
	capabilities 			=> [qw/baseline manualconfig apiconfig cache/],
	stage_sub 			=> \&config_stage,
	listchannels_sub 		=> \&fetch_channels,
	version 			=> $VERSION,
	description 			=> $GRABBER_DESC,
});

#print Dumper($conf); exit;

# ------------------------------------------------------------------------------------------------------------------------------------- #
# any overrides?
if (defined( $conf->{'generator-info-name'} )) {
	$generator_info_name = $conf->{'generator-info-name'}->[0];
	}
if (defined( $conf->{'generator-info-url'} )) {
	$generator_info_url = $conf->{'generator-info-url'}->[0];
	}
if (defined( $conf->{'source-info-name'} )) {
	$source_info_name = $conf->{'source-info-name'}->[0];
	}
if (defined( $conf->{'source-info-url'} )) {
	$source_info_url = $conf->{'source-info-url'}->[0];
	}

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Initialise the web page cache
init_cachedir( $conf->{cachedir}->[0] );
HTTP::Cache::Transparent::init( {
				 BasePath => $conf->{cachedir}->[0],
				 NoUpdate => 60*60,			# cache time in seconds
				 MaxAge => 24,				# flush time in hours
				 Verbose => $opt->{debug},
				 } );

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Check we have all our required conf params
config_check();

# Load the conf file containing mapped channels and categories information
my %mapchannelhash;
my %mapcategoryhash;

if (defined( $conf->{'usechannelmapping'} )) {
	loadmapconf();
}

#print Dumper(\%mapchannelhash, \%mapcategoryhash); exit;

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Progress Bar :)
my $bar = new XMLTV::ProgressBar({
				  name => "Fetching listings",				  
				  count => (scalar @{$conf->{channel}}) * ($opt->{days} + 1)	# +1 added for the extra day necessary for <06:00 programmes
				  })
unless ($opt->{quiet} || $opt->{debug});

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Global variables

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

my %hash_channels = ();	#Hash for id and channel title pairs

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Get the schedule(s) from digiturk
fetch_listings();
# print Dumper($programmes);

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Progress Bar
$bar->finish() && undef $bar if defined $bar;


# ------------------------------------------------------------------------------------------------------------------------------------- #
# 
$bar = new XMLTV::ProgressBar({
  name => "Filtering duplicates",
  count => scalar @{$programmes} / 10,
}) unless ($opt->{quiet} || $opt->{debug});

# Remove any duplicate programmes and set clumps where necessary
filter_listings();

# Progress Bar
$bar->finish() && undef $bar if defined $bar;


# ------------------------------------------------------------------------------------------------------------------------------------- #
# Filter out programmes outside of requested period (see man page)
# TODO: Neymis bu daha sonra incele
my %w_args;
if (($opt->{offset} != 0) || ($opt->{days} != -999)) {
  $w_args{offset} = $opt->{offset};
  $w_args{days} = ($opt->{days} == -999) ? 100 : $opt->{days};
  $w_args{cutoff} = '000000';			# e.g. '060000'
}

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Generate the XML
my $encoding = 'UTF-8';
my $credits = { 'generator-info-name' => $generator_info_name,
	       'generator-info-url' => $generator_info_url,
	       'source-info-name' => $source_info_name,
	       'source-info-url' => $source_info_url };

print STDERR "xml file will be written.\n" if $opt->{debug};	
XMLTV::write_data([ $encoding, $credits, $channels, $programmes ], %w_args);
# Finished!

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

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

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

sub fetch_listings {
	# Fetch listings per channel
	foreach my $channel_id (@{$conf->{channel}}) {
		# Now grab listings for each channel on each day, according to the options in $opt
		#
		# tvguide runs from 07:00 so we need to get the previous day as well just for any programmes after midnight
		for (my $i=($opt->{offset} -1); $i < ($opt->{offset} + $opt->{days}); $i++) {
			my $channelname_rfc;
			# if have, remove non-id part to use for generating url by using site's id
			my ($site_channel_id) = $channel_id =~ /(.*?)\./;			
			
			# Construct the listings url			
			# TODO : today returns incorrect date at midnight maybe because of system time is localtime on windows, check on linux!
			my $theday = DateTime->today->add (days => $i)->set_time_zone('Europe/Istanbul');
			# Officially:
			#http://www.digiturk.com.tr/_Services/TVguide/jProxy.aspx?cid=377&sd=14_2_2014_0_0
			my $url = $ROOT_URL . "_Services/TVguide/jProxy.aspx?cid=" . $site_channel_id . '&sd=' . uri_escape( $theday->strftime('%d_%m_%Y_0_0') );			
			#print STDERR $url ."\n";
			
			# $channel_id from configuration is RFC2838-compliant
			# If we need to map the fetched channel_id to a different value			
			my $xmlchannel_id = $channel_id;
			if (defined(&map_channel_id)) {
				$xmlchannel_id = map_channel_id($channel_id);
				# Make channel id RFC2838-compliant
				#$xmlchannel_id = rfc_channel_id($xmlchannel_id);
			}			
			eval {
				# Fetch the page
				#my $page_programmes = XMLTV::Get_nice::get_nice($url);
				my $page_programmes = $lwp->get($url);
				$page_programmes = $page_programmes->content;
				#print $page_channels;
			
				# Scrub the page
				if ($page_programmes) {
					# {"CID":168,"CName":"Dizimax Entertainment","CNo":3,
					my ($channelname) = $page_programmes =~ /\"CName":"(.*?)\"/;
					# Make channel name RFC2838-compliant
					#$channelname_rfc = rfc_channel_id($channelname);
					print STDERR $xmlchannel_id . " - " . $channelname . "\n" if $opt->{debug};
					
					# get raw data of programme list
					my @raw_shows = split('},{',$page_programmes);
					undef $page_programmes;
					while(my $raw_show=shift(@raw_shows)) {
					#foreach my $raw_show (@raw_shows) {
						#print $raw_show;
						
						my %prog = ();
						my $showtime;
						
						# Fetch the details page of programme
						# ,"BID":174087354,"PDuration":
						my ($show_bid) = $raw_show =~ /\"BID":(.*?)\,/;
						if (!$show_bid) {
							# Could not find programme id for details page, skipping to next.                                                        
                                                        print STDERR "\nCould not find bid in programme listing, skipping to next!\n" unless $opt->{quiet};
							next;
						}
						
						my ($url) = $ROOT_URL . "_Services/TVguide/jProxy.aspx?bid=" . $show_bid;
						eval {					
							#my $page_detail = XMLTV::Get_nice::get_nice($url);                                                        
                                                        my $page_detail = $lwp->get($url);
                                                        $page_detail = $page_detail->content;
							#print $page_detail;
							if ($page_detail) {
								#We have details								
								#Get start and stop time as epoch timestamp
								# ,"PStartTime":"\/Date(1392266520000+0200)\/","PEndTime":"\/Date(1392267660000+0200)\/","PGenre":
								my (@raw_showtimes) = $page_detail =~ /\Date\((.*?)\+/g;
								#print $raw_showtimes[0]. "\n";
								#epoch timestamp is in milisecond so divide by 1000 and set timezone
								my $dt_show_start = DateTime->from_epoch( epoch => ($raw_showtimes[0]/1000) )->set_time_zone('Europe/Istanbul');
								my $dt_show_stop = DateTime->from_epoch( epoch => ($raw_showtimes[1]/1000) )->set_time_zone('Europe/Istanbul');
								#print $dt_start;
								#print $dt_start->hour . ":" . $dt_start->min;
								$prog{'start'} = $dt_show_start->strftime("%Y%m%d%H%M%S %z");
								$prog{'stop'} = $dt_show_stop->strftime("%Y%m%d%H%M%S %z");
								
								# channel id
								#$prog{'channel'} = $xmlchannel_id;
								$prog{'channel'} = encode( 'utf-8', $xmlchannel_id);
							
								# title (mandatory)
								# {"PName":"AZ SONRA...","POName":
								my ($showtitle) = $page_detail =~ /\"PName":"(.*?)\"/;
								$prog{'title'} = [[ encode( 'utf-8', decode( 'utf-8', $showtitle)), 'tr' ]];
								# print STDERR $dt_show_start . " <-> " . $dt_show_stop. "\t" . $showtitle . "\n" unless $opt->{quiet};
								
								# category
								#,"PGenreStr":"Dram","SDesc":
								# TODO: Birden cok kategori olursa herbir kategoriyi ekleyecek kodu sonra yazmayi unutma
								my ($showcategory) = $page_detail =~ /\"PGenreStr":"(.*?)\"/;
								if (!$showcategory) {
									$showcategory = ".";
								}
							
								push @{$prog{'category'}}, [ $showcategory, 'tr' ];
							
								# desc
								#,"SDesc":"(THE COLD TURKEY, 4.SEZON, 2006) RYAN, SÜKRAN GÜNÜNDE ... SORUNLAR YASAR.","LDesc":
								#,"LDesc":"ON YILI GERIDE BIRAKTIGI HALDE EN ... HIKAYESI..","ScrRatio":
								my ($showSdesc) = $page_detail =~ /\"SDesc":"(.*?)\","LDesc/;
								my ($showLdesc) = $page_detail =~ /\"LDesc":"(.*?)\","ScrRatio/;
								my $showdesc;
								if ($showSdesc) {
									$showdesc = $showSdesc . "\n";
								}
								if ($showLdesc) {
									$showdesc .= $showLdesc;
								}
								#print $showdesc;
								if ($showdesc) {
									$prog{'desc'} = [[ encode( 'utf-8', decode( 'utf-8', $showdesc)), 'tr' ]];
								}
								
								# print Dumper \%prog;
								push(@{$programmes}, \%prog);
							}
							else {
                                                                print STDERR "No detail page for programme skipping to next!\n" unless $opt->{quiet};
								die; # exit eval block with 'undefined'
							} #end if $page_detail
						} #end eval
						or do {
							# could not fetch programme details skip to next programme
							print STDERR "Could not fetch programme (" . $show_bid . ") details, skipping to next!\n" unless $opt->{quiet};
							next;
						}
					} #end loop $raw_show
					undef @raw_shows;
					# Add to the channels hash
					#$channels->{$channel_id} = { 'id'=> $xmlchannel_id , 'display-name' => [[$channelname, 'tr']] };
					$channels->{$channel_id} = { 'id'=> encode( 'utf-8', $xmlchannel_id), 'display-name' => [[$channelname, 'tr']] };
				} #end if ($page_programmes)
				else {
					# no schedule found
					warning 'No schedule found';
				}
			} #end eval
			or do {
				# could not fetch programme listing for channel, skipping to next channel
                                print STDERR "Could not fetch programme listing for channel, skipping to next!\n" unless $opt->{quiet};
				next;
			};
			
			# update progress bar
			$bar->update if defined $bar;
			
		} #end for loop for days		
	} #end foreach $channel_id
}
	
# ------------------------------------------------------------------------------------------------------------------------------------- #

sub filter_listings {
		# Given a hash ready to be fed into XMLTV writer, perform some last minute work on the programmes:
		#   1) Remove any duplicate programmes
		#   2) Create clumps where necessary (i.e. where programmes overlap)
		#
			
		# Walk the array (note: this assumes, (i) the programmes are stored in channel+starttime order, (ii) they have stop times )
		my ($clumpidx, $clumptot, @curr_clumps) = (0, 2, ());
		for (my $i=0; $i<scalar @{$programmes}; $i++) {
			my ($this, $next) = ($i, $i+1);			
			
			FILTER:
			
			# any more progs after this one?
			last  if ($next >= scalar @{$programmes} );
						
			# get programme's times as epoch seconds
			#my $this_start = time_xmltv_to_epoch( @$programmes[$this]->{'start'} );
			my $this_stop  = time_xmltv_to_epoch( @$programmes[$this]->{'stop'} );
			my $next_start = time_xmltv_to_epoch( @$programmes[$next]->{'start'} );
			#my $next_stop  = time_xmltv_to_epoch( @$programmes[$next]->{'stop'} );
			
			
			# (Task #1)
			# Is prog a duplicate with next
			#   (duplicate = same channel + same start & stop times + same title
			if ( @$programmes[$next]->{'channel'}     eq @$programmes[$this]->{'channel'}
			 &&  @$programmes[$next]->{'start'}       eq @$programmes[$this]->{'start'}
			 &&  @$programmes[$next]->{'stop'}        eq @$programmes[$this]->{'stop'}
			 &&  @$programmes[$next]->{'title'}[0][0] eq @$programmes[$this]->{'title'}[0][0] ) {
					# delete the duplicate
					splice(@{$programmes}, $next, 1);
					goto FILTER;
			}
			
			
			# (Task #2) 
			# Check times of next prog on this channel; is there an overlap?
			if ( @$programmes[$next]->{'channel'} eq @$programmes[$this]->{'channel'}
			 &&  $next_start < $this_stop ) {
			 
			  if ( !scalar @curr_clumps ) {
					@$programmes[$this]->{'clumpidx'} = $clumpidx++ .'/'. $clumptot;
					@$programmes[$next]->{'clumpidx'} = $clumpidx .'/'. $clumptot;
					push @curr_clumps, $this;		# remember the current array index
					
				} else {   # current prog is already part of a clump :(   
					# adjust rest of current clump
					$clumptot++;
					$clumpidx = 0;
					foreach (@curr_clumps) {
						@$programmes[$_]->{'clumpidx'} = $clumpidx++ .'/'. $clumptot;
					}
					@$programmes[$this]->{'clumpidx'} = $clumpidx++ .'/'. $clumptot;
					@$programmes[$next]->{'clumpidx'} = $clumpidx .'/'. $clumptot;
					push @curr_clumps, $this;		# remember the current array index
				}
						
				
			} else {
				# reset vars ready for next pass
			  ($clumpidx, $clumptot, @curr_clumps) = (0, 2, ());
			}
			
			$bar->update if defined $bar && $i%10==0;
		}
}
	
# ------------------------------------------------------------------------------------------------------------------------------------- #
sub loadmapconf {
	# Load the conf file containing mapped channels and categories information
	# 
	# This file contains 2 record types:
	# lines starting with "map" are used to 'translate' the incoming channel id to those required by your PVR
	#e.g. 	map==dave==DAVE     will output "DAVE" in your XML file instead of "dave"
	# lines starting with "cat" are used to translate categories (genres) in the incoming data to those required by your PVR
	# e.g.  cat==Science Fiction==Sci-fi will output "Sci-Fi" in your XML file instead of "Science Fiction"
	# 
	my $mapchannels = \%mapchannelhash;
	my $mapcategories = \%mapcategoryhash;
	#		
	my $fn = get_supplement_dir() . '/'. $GRABBER_NAME . '.map.conf';
	my $fhok = open my $fh, '<', $fn or warning("Cannot open conf file $fn");
	if ($fhok) {
		while (my $line = <$fh>) {
			chomp $line;
			chop($line) if ($line =~ m/\r$/);
			next if $line =~ /^#/ || $line eq '';
			my ($type, $mapfrom, $mapto, $trash) = $line =~ /^(.*)==(.*)==(.*?)([\s\t]*#.*)?$/;
			SWITCH: {
				lc($type) eq 'map' && do { $mapchannels->{$mapfrom} = $mapto; last SWITCH; };
				lc($type) eq 'cat' && do { $mapcategories->{$mapfrom} = $mapto; last SWITCH; };
				warning("Unknown type in map file: \n $line");
				}
			}
		close $fh;
		}
	#print Dumper ($mapchannels, $mapcategories);
}

# ------------------------------------------------------------------------------------------------------------------------------------- #
sub rfc_channel_id {
	# Make a channel_id compliant with RFC2838 (or else tv_validate will fail)
	#
	return $_[0].'.'.$RFC_IDENTIFIER;
}

# ------------------------------------------------------------------------------------------------------------------------------------- #
sub fetch_channels {
	my ($opt, $conf) = @_;  
	# Fetch channels via a dummy call to digiturk
	# http://www.digiturk.com.tr/
	my $channel_list_url = $ROOT_URL.'_Services/TVguide/jProxy.aspx?chs=2&che=500';

	my $result;
	my $hash_channels = {};

	my $bar = new XMLTV::ProgressBar({
					  name => "Fetching channels",
					  count => 1
					  })
	unless ($opt->{quiet} || $opt->{debug});

	# Get the page containing the list of channels 
	my $page_channels = XMLTV::Get_nice::get_nice($channel_list_url);
	#print $page_channels;
	$bar->update() && $bar->finish && undef $bar if defined $bar;	
	
	# {"CID":377,"CName":"Dizimax Sci-fi","CNo":2
	my @raw_channel_pairs = $page_channels =~ /\{"CID"(.*?)\,"CNo/g;
						       
	$bar = new XMLTV::ProgressBar({
				       name => "Parsing result",
				       count => scalar @raw_channel_pairs
				       })
	unless ($opt->{quiet} || $opt->{debug});
	
	# Browse through the downloaded list of channels and map them to a hash XMLTV::Writer would understand
	foreach my $raw_channel_pair (@raw_channel_pairs) {
		#print $raw_channel_pair;
		my($channel_id,$str_tmp1,$channel_name) = ($raw_channel_pair =~ /\:(.*?)\,"(.*?)\":"(.*?)\"(.*)/);
		#print $channel_id . " - " . $channel_title . "\n";
		
		# Make channel id RFC2838-compliant
		(my $_channel_name = $channel_name) =~ s/\s/-/g;		# replace space chars (not allowed)
		my $rfcchannel_id = rfc_channel_id($channel_id.".".$_channel_name);
	
		$hash_channels->{"$channel_id"} = {
				      id => $rfcchannel_id,
				      'display-name' => [[ encode( 'utf-8', decode( 'utf-8', $channel_name)), 'tr' ]],
				      url => [ $ROOT_URL."_Services/TVguide/jProxy.aspx?sd=&cid=".$channel_id ]
				      };		
		$bar->update() if defined $bar;
		}
	$bar->finish() && undef $bar if defined $bar;
			
	# Notifying the user :)
	$bar = new XMLTV::ProgressBar({
				       name => "Reformatting",
				       count => 1
				       })
	unless ($opt->{quiet} || $opt->{debug});

	# Let XMLTV::Writer format the results as a valid xmltv file
	my $writer = new XMLTV::Writer(OUTPUT => \$result, encoding => 'utf-8');
	$writer->start({'generator-info-name' => $generator_info_name});
	$writer->write_channels($hash_channels);
	$writer->end();

	$bar->update() && $bar->finish() if defined $bar;

	return $result;
	}

# ------------------------------------------------------------------------------------------------------------------------------------- #
sub config_stage
{
	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 => $GRABBER_NAME } );
	$writer->write_string( {
				id => 'cachedir',
				title => [ [ 'Directory to store the cache in', 'en' ] ],
				description => [[ $GRABBER_NAME.' uses a cache with files that it has already '.'downloaded. Please specify where the cache shall be stored. ',
						 'en' ]],
				default => get_default_cachedir(),
				});
	$writer->end( 'select-channels' );
	return $result;
	}

# ------------------------------------------------------------------------------------------------------------------------------------- #
sub config_check {
	if (not defined( $conf->{cachedir} )) {
		print STDERR "No cachedir defined in configfile " .
		$opt->{'config-file'} . "\n" .
		"Please run the grabber with --configure.\n";
		exit 1;
		}
	if (not defined( $conf->{'channel'} )) {
		print STDERR "No channels selected in configfile " .
		$opt->{'config-file'} . "\n" .
		"Please run the grabber with --configure.\n";
		exit 1;
		}
	}

# ------------------------------------------------------------------------------------------------------------------------------------- #
sub get_supplement_dir {
	return $ENV{XMLTV_SUPPLEMENT} . "/" . $GRABBER_NAME  if defined( $ENV{XMLTV_SUPPLEMENT} );
	return get_default_dir() . "/.xmltv/supplement/" . $GRABBER_NAME;
	}

# ------------------------------------------------------------------------------------------------------------------------------------- #
sub get_default_cachedir {
	return get_default_dir() . "/.xmltv/cache";
	}

# ------------------------------------------------------------------------------------------------------------------------------------- #
sub get_default_dir {
	my $winhome = $ENV{HOMEDRIVE} . $ENV{HOMEPATH} 
	if defined( $ENV{HOMEDRIVE} )
	and defined( $ENV{HOMEPATH} );
	my $home = $ENV{HOME} || $winhome || ".";
	return $home;
	}



# ------------------------------------------------------------------------------------------------------------------------------------- #
sub init_cachedir {
	my( $path ) = @_;
	if( not -d $path ) {
		mkpath( $path ) or die "Failed to create cache-directory $path: $@";
		}
	}

# ------------------------------------------------------------------------------------------------------------------------------------- #
sub utf8 {
		# Catch the error:
		#    "Parsing of undecoded UTF-8 will give garbage when decoding entities at /usr/lib/perl5/site_perl/5.8.8/XMLTV/Get_nice.pm line 57."
		# (e.g. https://eli.thegreenplace.net/2007/07/20/parsing-of-undecoded-utf-8-will-give-garbage-when-decoding-entities/ )
		#
		my ($html) = @_;
		return decode('UTF-8', $html); 
}

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

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

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Initialise LWP
sub initialise_ua {
		my $cookies = HTTP::Cookies->new;
		#my $ua = LWP::UserAgent->new(keep_alive => 1);
		my $ua = LWP::UserAgent->new;
		# Cookies
		$ua->cookie_jar($cookies);
		# Define user agent type
		#$ua->agent('Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.0; Trident/5.0');
		# Define timouts
		$ua->timeout(240);
		# Use proxy if set in http_proxy etc.
		$ua->env_proxy;
		#
		return $ua;
}

=pod

=head1 NAME

tv_grab_tr - Grab TV listings for Turkey.

=head1 SYNOPSIS

tv_grab_tr --help

tv_grab_tr --configure [--config-file FILE]

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

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

tv_grab_tr --version

tv_grab_tr --capabilities

tv_grab_tr --description


=head1 DESCRIPTION

Output TV listings in XMLTV format for many stations
available in Turkey. Data is downloaded from Digiturk.

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

Then running B<tv_grab_tr> with no arguments will get listings for
your chosen stations including today.

=head1 OPTIONS

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

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

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

B<--config-file FILE> Set the name of the configuration file, the
default is B<~/.xmltv/tv_grab_tr.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.

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

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

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

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<--description> Show a brief description of the grabber.

=head1 ERROR HANDLING

If the grabber fails to download listings data for a channel, it will print an
error message to STDERR and continue with the next configured channel.

=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 CREDITS

Grabber written by Dig Lam, dig -dot- lam -at- gmail -dot- com
This documentation copied from tv_grab_uk by Ed Avis,
ed -at- membled -dot- com.

=head1 BUGS

None known.

=cut