tv_grab_uk_tvguide

#!/usr/bin/perl -w
#
# Copyright G. Westcott - February 2013
#
# This code is distributed under the GNU General Public License v2 (GPLv2) .
#
#   For extended help information run
#         tv_grab_uk_tvguide  --info
#

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

use Data::Dumper;

use strict;
use warnings;
use XMLTV 1.0.1;
use XMLTV::ProgressBar;
use XMLTV::Options qw/ParseOptions/;
use XMLTV::Configure::Writer;
use XMLTV::Supplement 0.005065 qw/SetSupplementRoot GetSupplementDir GetSupplementLines/;
use XMLTV::Get_nice 0.005065 qw/get_nice_tree/;

use File::Path;
use POSIX qw(strftime);
use DateTime;
use Date::Parse;
#v1.3: use DateTime::Format::DateParse;
use Encode;
use URI::Escape;
use LWP::UserAgent;
use HTTP::Cookies;
use HTML::TreeBuilder;
use HTTP::Cache::Transparent;
use JSON;


#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(debug warning);
my $warnings = 0;


use XMLTV::Usage <<END;
tv_grab_uk_tvguide: Get UK television listings in XMLTV format
Version: $XMLTV::VERSION
To configure: $0 --configure [--config-file FILE] [--gui OPTION]
To grab listings: $0 [--config-file FILE] [--output FILE] [--quiet] [--offset DAYS] [--days DAYS] [--nodetailspage] [--legacychannels]
To list available channels: $0 --list-channels [--output FILE]
END


# ------------------------------------------------------------------------------------------------------------------------------------- #
# Grabber details
my $VERSION				= "$XMLTV::VERSION";
my $GRABBER_NAME		= 'tv_grab_uk_tvguide';
my $GRABBER_DESC		= 'UK - TV Guide (tvguide.co.uk)';
my $GRABBER_URL			= 'http://wiki.xmltv.org/index.php/XMLTVProject';
my $ROOT_URL			= 'https://api.tvguide.co.uk/';
my $SOURCE_NAME			= 'TV Guide UK';
my $SOURCE_URL			= 'https://www.tvguide.co.uk/';
#
my $generator_info_name	= $GRABBER_NAME;
my $generator_info_url	= $GRABBER_URL;
my $source_info_name	= $SOURCE_NAME;
my $source_info_url		= $SOURCE_URL;
#
my $grabberid = '2023-09-19.1724';

# ------------------------------------------------------------------------------------------------------------------------------------- #
# Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should have

our ($opt, $conf) = ParseOptions({
			grabber_name		=> $GRABBER_NAME,
			capabilities		=> [qw/baseline manualconfig apiconfig cache tkconfig/],		# apiconfig is needed for --list-channels (bug)
			stage_sub			=> \&config_stage,
			listchannels_sub	=> \&fetch_channels,
			version				=> $VERSION,
			description			=> $GRABBER_DESC,
			extra_options		=> [qw/nodetailspage legacychannels method:i makeignorelist:s useignorelist:s usage test:i/],
});
 
usage(1) if $opt->{usage};

#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 gui
XMLTV::Ask::init($opt->{gui});


# ------------------------------------------------------------------------------------------------------------------------------------- #
# 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();


if (defined $opt->{nodetailspage}) {
	print STDERR "Option 'nodetailspage' is deprecated and will have no effect"."\n" unless ($opt->{quiet});
}
if (defined $opt->{method}) {
	print STDERR "Option 'method' is deprecated and will have no effect"."\n" unless ($opt->{quiet});
}
if (defined $opt->{makeignorelist}) {
	print STDERR "Option 'makeignorelist' is deprecated and will have no effect"."\n" unless ($opt->{quiet});
}
if (defined $opt->{useignorelist}) {
	print STDERR "Option 'useignorelist' is deprecated and will have no effect"."\n" unless ($opt->{quiet});
}

# Load the conf file containing mapped channels and categories information
my %mapchannelhash;
my %mapcategoryhash;
loadmapconf();
#print Dumper(\%mapchannelhash, \%mapcategoryhash); exit;



# ------------------------------------------------------------------------------------------------------------------------------------- #
# Progress Bar :)
my $bar = new XMLTV::ProgressBar({
		name => "Fetching listings",
		count => scalar @{$conf->{channel}}
}) unless ($opt->{quiet} || $opt->{debug});



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

# Store channel names during fetch
my $channames = undef;

# Cache for alternative ID lookups
my $channels_cache = {};
my $channels_alt = {};
my $channels_alt_found = {};

# Get the schedule(s) from TV Guide
fetch_listings();

# print Dumper($programmes);

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

print STDERR "\n".'Writing output file'."\n" unless ($opt->{quiet});


# ------------------------------------------------------------------------------------------------------------------------------------- #
# Filter out programmes outside of requested period (see man page)
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 };

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.
debug "Exiting without warnings.";
exit(0);


# #############################################################################
# # THE MEAT #####################################################################
# ------------------------------------------------------------------------------------------------------------------------------------- #

sub fetch_listings {
	# Fetch listings for all channels
	# https://api.tvguide.co.uk/schedules?start=2023-09-17T07%3A00%3A00.000Z&end=2023-09-17T12%3A00%3A00.000Z&type=grid&platformId=_popular&regionId=_popular

	my $sel_platform_id = $conf->{platform}[0];
	my $sel_region_id = $conf->{region}[0];

	my $baseurl = $ROOT_URL.'schedules';

	my $startday = DateTime->today->set_time_zone('Europe/London')->add (days => ($opt->{offset}));
	my $endday   = $startday->clone()->add (days => ($opt->{days}));

	# Construct the listings url
	my $url = $ROOT_URL.'schedules?start='.uri_escape( $startday->strftime('%Y-%m-%dT00:00:00.000Z') ).'&end='.uri_escape( $endday->strftime('%Y-%m-%dT00:00:00.000Z') ).'&type=grid&platformId='.$sel_platform_id.'&regionId='.$sel_region_id.'';
	debug "Fetching: $url";

	my $data = XMLTV::Get_nice::get_nice_json($url, undef, 1);

	if (scalar @$data > 0) {

		foreach my $channel (@{ $data }) {

			my ($channel_id, $channel_number, $channel_name, $channel_logo);

			$channel_id		= $channel->{id};
			$channel_name	= $channel->{title};
			$channel_logo	= $channel->{logo_url};

			#debug 'found channel name: '.$channel_name;

			# was this channel requested?
			next if !( grep( /^$channel_id$/, @{$conf->{channel}} ) );


			# If we need to map the fetched channel_id to a different value
			my $xmlchannel_id = $channel_id;
			$xmlchannel_id .= '.tvguide.co.uk' unless $opt->{legacychannels};		# make channel RFC2838 compliant
			if (defined(&map_channel_id)) { $xmlchannel_id = map_channel_id($xmlchannel_id); }

			# Add to the channels hash
			$channels->{$channel_id} = { 'id'=> $xmlchannel_id , 'display-name' => [[ encode('utf-8', $channel_name), 'en' ]]  };


			if ($channel->{schedules}) {

				foreach my $show (@{ $channel->{schedules} }) {

					my %prog = ();

					# channel
					$prog{'channel'} = $xmlchannel_id;

					# title (mandatory)
					my $showtitle = $show->{title};
					$prog{'title'} = [[ encode('utf-8', $showtitle), 'en' ]];

					# desc
					my $showdesc = $show->{summary_short};
					if ($showdesc) {
						$showdesc .= '.' if ( (length $showdesc) && $showdesc =~ /[^\.\?!]$/ );	   # append a fullstop
						if (length $showdesc) {
							$prog{'desc'} = [[ encode('utf-8', $showdesc), 'en' ]];
						}
					}

					# type  -- seen in data: "movie", "episode"
					my $showtype = $show->{type};
					if ($showtype eq 'movie') {
						# build for future expansion
						my $category = 'Film';
						my @showcategories = ();
						push @showcategories, $category unless grep(/$category/, @showcategories);
						foreach my $category (@showcategories) {
							push @{$prog{'category'}}, [ encode('utf-8', $category), 'en' ];
						}
					}

					# start time
					my $showstart = DateTime->from_epoch(epoch => str2time($show->{start_at}));
					$prog{'start'} = $showstart->strftime('%Y%m%d%H%M%S %z');

					# stop time
					my $showstop = DateTime->from_epoch(epoch => str2time($show->{end_at}));
					$prog{'stop'} = $showstop->strftime('%Y%m%d%H%M%S %z');

					# programme image
					my $showimg = $show->{image_url};
					if ($showimg) {
						$prog{'image'} = [[ $showimg, { 'system'=>'tvguide', 'type'=>'backdrop' } ]];
					}

					# year
					#    strip this off the title e.g. "A Useful Life (2010)"
					my ($showyear) = $prog{'title'}->[0][0] =~ /.*\((\d\d\d\d)\)$/;
					if ($showyear) {
						$prog{'date'} = $showyear;
						# assume anything with a year is a film - add Films category group
						push @{$prog{'category'}}, [ 'Films', 'en' ];
					}

					# flags
					#    other values seen in input "audio-description", "new", "regional-interest", "interactive-content"
					my $showflags = $show->{meta}->{attributes};
					my %_showflags = map { $_ => 1 } @{$show->{meta}->{attributes}};

					if ($_showflags{subtitles}) {
						push @{$prog{'subtitles'}}, {'type' => 'teletext'};
					}
					if ($_showflags{repeat}) {
						$prog{'previously-shown'} = {};
					}
					if ($_showflags{hd}) {
						$prog{'video'}->{'quality'} = 'HD';
					}
					if ($_showflags{'16x9'}) {
						$prog{'video'}->{'quality'} .= (defined $prog{'video'}->{'quality'} ? ' ' : '') . '16x9';
					}

					# episode number
					my $showseries = $show->{meta}->{season};
					my $showepisode = $show->{meta}->{episode};
					if ($showseries || $showepisode) {
						# cleanup  "episode": "11061&11062"
						if ($showepisode && $showepisode =~ /^(\d*)&/) {
							$showepisode = $1;
						}
						my $showtotepisode = $show->{meta}->{episode_total};
						my $showepnum = make_ns_epnum($showseries, $showepisode, $showtotepisode, '', '');
						if ($showepnum && $showepnum ne '..') {
							$prog{'episode-num'} = [[ $showepnum, 'xmltv_ns' ]];
						}
					}

					# rating
					my $showrating = $show->{meta}->{rating};
					if ($showrating) {
						$prog{'star-rating'} =  [ $showrating . '/10' ];
					}


					#-----------------------------------------------
					# debug Dumper \%prog;
					push(@{$programmes}, \%prog);

				}
			}

			$bar->update if defined $bar;
		}
	}
}


# #############################################################################
# # THE VEG ######################################################################
# ------------------------------------------------------------------------------------------------------------------------------------- #

sub make_ns_epnum {
		# Convert an episode number to its xmltv_ns compatible - i.e. reset the base to zero
		# Input = series number, episode number, total episodes,  part number, total parts,
		#  e.g. "1, 3, 6, 2, 4" >> "0.2/6.1/4",    "3, 4" >> "2.3."
		#
		my ($s, $e, $e_of, $p, $p_of) = @_;
		#	debug Dumper(@_);

		# trap non-numeric values
		undef $s if defined $s && $s !~ /^\d+$/;
		undef $e if defined $e && $e !~ /^\d+$/;
		undef $e_of if defined $e_of && $e_of !~ /^\d+$/;

		# "Part x of x" may contain integers or words (e.g. "Part 1 of 2", or "Part one")
		$p = text_to_num($p) if defined $p;
		$p_of = text_to_num($p_of) if defined $p_of;

		# re-base the series/episode/part numbers
		$s-- if (defined $s && $s > 0);
		$e-- if (defined $e && $e > 0);
		$p-- if (defined $p && $p && $p=~/^\d+$/ && $p > 0);

		# make the xmltv_ns compliant episode-num
		my $episode_ns = '';
		$episode_ns .= $s if defined $s;
		$episode_ns .= '.';
		$episode_ns .= $e if defined $e;
		$episode_ns .= '/'.$e_of if defined $e_of;
		$episode_ns .= '.';
		$episode_ns .= $p if $p;
		$episode_ns .= '/'.$p_of if $p_of;

		#debug "--$episode_ns--";
		return $episode_ns;
}

sub text_to_num {
		# Convert a word number to int e.g. 'one' >> '1'
		#
		my ($text) = @_;
		if ($text !~ /^[+-]?\d+$/) {	# standard test for an int
			my %nums = (one => 1, two => 2, three => 3, four => 4, five => 5, six => 6, seven => 7, eight => 8, nine => 9);
			return $nums{$text} if exists $nums{$text};
		}
		return $text
}

sub map_channel_id {
		# Map the fetched channel_id to a different value (e.g. our PVR needs specific channel ids)
		# mapped channels should be stored in a file called  tv_grab_uk_tvguide.map.conf
		# containing lines of the form:  map==fromchan==tochan  e.g. 'map==109==BBC4'
		#
		my ($channel_id) = @_;
		my $mapchannels = \%mapchannelhash;
		if (%mapchannelhash && exists $mapchannels->{$channel_id}) {
			return $mapchannels->{$channel_id} ;
		}
		return $channel_id;
}

sub map_category {
		# Map the fetched category to a different value (e.g. our PVR needs specific genres)
		# mapped categories should be stored in a file called  tv_grab_uk_guardian.map.conf
		# containing lines of the form:  cat==fromcategory==tocategory  e.g. 'cat==General Movie==Film'
		#
		my ($category) = @_;
		my $mapcategories = \%mapcategoryhash;
		if (%mapcategoryhash && exists $mapcategories->{$category}) {
			return $mapcategories->{$category} ;
		}
		return $category;
}

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 $supplementdir = $ENV{XMLTV_SUPPLEMENT} || GetSupplementDir();
		# get default file from supplement.xmltv.org if local file not exist 
		if (-f File::Spec->catfile( $supplementdir, $GRABBER_NAME, $GRABBER_NAME . '.map.conf' ) ) {
			SetSupplementRoot($supplementdir);
		}
		my $lines = GetSupplementLines($GRABBER_NAME, $GRABBER_NAME . '.map.conf');
		foreach my $line (@$lines) {
			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";
			}
		}
		# debug Dumper ($mapchannels, $mapcategories);
}

sub fetch_channels {
    # ParseOptions() handles --configure and --list-channels internally without returning,
	#  so we do not have global $opt available during --configure
	#  unless we copy vars to main package. (Note package variable must be declared with 'our')
	#
	($main::conf, $main::opt) = @_;

	my $sel_platform_id = $conf->{platform}[0];
	my $sel_region_id = $conf->{region}[0];

	my $channels = {};

	# Get the list of available channels
	#-------------------------------------------------------------------------------------------

	if (defined $opt->{method}) {
		# deprecated
	}

	if ((scalar keys %$channels == 0) && (1)) {

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

		# Fetch channels via a dummy call to listings
		#
		my $theday = DateTime->today->set_time_zone('Europe/London')->strftime('%Y-%m-%d');
		my $url = $ROOT_URL."schedules?start=".$theday."T06%3A00%3A00.000Z&end=".$theday."T12%3A00%3A00.000Z&type=grid&platformId=".$sel_platform_id."&regionId=".$sel_region_id."";
		debug "Fetching: $url";

		my @channels;

		my $data = XMLTV::Get_nice::get_nice_json($url);

		if (scalar @$data > 0) {

			foreach (@{ $data }) {

				my ($channel_id, $channel_number, $channel_name, $channel_logo);

				$channel_id		= $_->{id};
				$channel_name	= $_->{title};
				$channel_logo	= $_->{logo_url};

				$channels->{$channel_id} = {
					id => $channel_id . (!$opt->{'list-channels'}?"   # ".encode('utf-8', $channel_name):(!$opt->{legacychannels}?'.tvguide.co.uk':'')),
					'display-name' => [[ encode('utf-8', $channel_name), 'en' ]],
					url => [ $channel_logo ]
				};

			}

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

		}

		warning "No channels found in TVGuide" if (scalar keys %$channels == 0);

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

	}


	#-------------------------------------------------------------------------------------------

	if (defined $opt->{makeignorelist}) {
		# deprecated
	}

	if (defined $opt->{useignorelist}) {
		# deprecated
	}

	#debug Dumper $channels;


	#-------------------------------------------------------------------------------------------
	# Format & write out the config file

	# Notifying the user :)
	#$bar = new XMLTV::ProgressBar({
	#	name => "Reformatting",
	#	count => 1
	#}) unless ($opt->{quiet} || $opt->{debug});

	if (scalar keys %$channels == 0) {
		warning "No channels found in TVGuide \n";
		exit 1;
	}

	# Let XMLTV::Writer format the results as a valid xmltv file
	my $result;
	my $writer = new XMLTV::Writer(OUTPUT => \$result, encoding => 'utf-8');
	$writer->start({'generator-info-name' => $generator_info_name});
	#
	# this writes the channels sorted by 'id' but the TVG id has no relation to the actual channel number,
	#  and makes it harder to select the channels to fetch
	###  $writer->write_channels($channels);
	# so let's write them by name
	foreach (sort { $channels->{$a}->{'display-name'}[0][0] cmp $channels->{$b}->{'display-name'}[0][0] } keys %$channels) {
		$writer->write_channel($channels->{$_});
	}
	#
	$writer->end();

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

	return $result;
}

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

	# Fetch available platforms
	my $url = $ROOT_URL."platforms";
	#debug "Fetching: $url";

	my (%platforms, @platforms);

	my $data = XMLTV::Get_nice::get_nice_json($url);

	if (scalar @$data > 0) {

		foreach (@{ $data }) {
			my ($platform_title, $platform_id);	
			$platform_id	= $_->{id};
			$platform_title	= $_->{title};

			push(@platforms, $platform_title) if $platform_title;
			$platforms{$platform_title} = $platform_id if $platform_title;
		}
	}

	return \%platforms, \@platforms; 
}

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

	# Fetch available regions (needed for url construction)
	my $url = $ROOT_URL."regions";
	#debug "Fetching: $url";

	my (%regions, @regions);

	my $data = XMLTV::Get_nice::get_nice_json($url);

	if (scalar @$data > 0) {

		foreach (@{ $data }) {
			my ($region_title, $region_id, $platform_id);
			$region_id		= $_->{id};
			$region_title	= $_->{title};
			$platform_id	= $_->{platform_id};

			if ($platform_id eq $conf->{platform}[0]) {
				push(@regions, $region_title) if $region_title;
				$regions{$region_title} = $region_id if $region_title;
			}
		}
	}

	return \%regions, \@regions; 
}

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 } );


	if($stage eq 'start') {

		$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-platforms' );
	}
	elsif($stage eq 'select-platforms') {

		my ($platforms, $platformsarr) = fetch_platforms($conf);

		$writer->start_selectone({
			id => 'platform',
			description => [ [ '', 'en' ] ],
			title => [ [ 'Select TVGuide platform', 'en' ] ],
		});

		foreach my $platform (@{$platformsarr}) {
			$writer->write_option({
				value => $platforms->{$platform},
				text  => [ [ $platform, 'en' ] ],
			});
		}
		$writer->end_selectone();

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

	}
	elsif($stage eq 'select-regions') {

		my ($regions, $regionsarr) = fetch_regions($conf);

		$writer->start_selectone({
			id => 'region',
			description => [ [ '', 'en' ] ],
			title => [ [ 'Select TVGuide region', 'en' ] ],
		});

		foreach my $region (@{$regionsarr}) {
			$writer->write_option({
				value => $regions->{$region},
				text  => [ [ $region, 'en' ] ],
			});
		}
		$writer->end_selectone();

		$writer->end('select-channels');
	}
	else {
		die "Unknown stage $stage";
	}

	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;
	}
}

# not used --
sub fetch_url ($;$$) {
	# fetch a url with up to 5 retries
	my ($url, $method, $varhash) = @_;
	$XMLTV::Get_nice::FailOnError = 0;
	my $content;
	my $maxretry = 5;
	my $retry = 0;
	if (defined $method && lc($method) eq 'post') {

		my $ua = initialise_ua();

		while ( (not defined($content)) || (length($content) == 0) ) {
			my $r = $ua->post($url, $varhash);
			$content = $r->content;
			if ( $r->is_error || (length($content) == 0) ) {
				print STDERR "HTTP error: ".$r->status_line."\n";
				$retry++;
				return undef if $retry > $maxretry;
				print STDERR "Retrying URL: $url (attempt $retry of $maxretry) \n";
			}
		}

	} else {

		while ( (not defined($content = XMLTV::Get_nice::get_nice($url))) || (length($content) == 0) ) {
			my $r = $XMLTV::Get_nice::Response;
			print STDERR "HTTP error: ".$r->status_line."\n";
			$retry++;
			return undef if $retry > $maxretry;
			print STDERR "Retrying URL: $url (attempt $retry of $maxretry) \n";
		}

	}

	$content = decode('UTF-8', $content);
	my $t = HTML::TreeBuilder->new();
	$t->parse($content) or die "cannot parse content of $url\n";
	$t->eof;
	return $t;
}

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 get_default_cachedir {
	return get_default_dir() . "/.xmltv/cache";
}

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

sub debug ( $$ ) {
	my( $message, $nonewline ) = @_;
	print STDERR $message if $opt->{debug};
	print STDERR "\n" if $opt->{debug} && (!defined $nonewline || $nonewline != 1);
}

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

sub initialise_ua {
	my $cookies = HTTP::Cookies->new;
	#my $ua = LWP::UserAgent->new(keep_alive => 1);
	my $ua = LWP::UserAgent->new;
	# Allow redirects
	$ua->requests_redirectable(['GET', 'HEAD','POST']);
	# Cookies
	$ua->cookie_jar($cookies);
	# Define user agent type
	$ua->agent('Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US)');
	# Define timouts
	$ua->timeout(240);
	# Use proxy if set in http_proxy etc.
	$ua->env_proxy;

	return $ua;
}

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

__END__

=pod

=head1 NAME

B<tv_grab_uk_tvguide> - Grab TV listings for UK from the TVGuide website.

=head1 SYNOPSIS

tv_grab_uk_tvguide --usage

tv_grab_uk_tvguide --version

tv_grab_uk_tvguide --configure [--config-file FILE] [--gui OPTION]
                   [--debug]

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

tv_grab_uk_tvguide --list-channels [--output FILE] [--debug]

=head1 DESCRIPTION

Output TV listings in XMLTV format for many channels available in UK.
The data come from tvguide.co.uk

First you must run B<tv_grab_uk_tvguide --configure> to choose which channels
you want to receive.

Then running B<tv_grab_uk_tvguide> with no arguments will get programme listings 
in XML format for the channels you chose, for available days including today.

=head1 OPTIONS

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

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

B<--gui OPTION> Use this option to enable a graphical interface to be used.
OPTION may be 'Tk'. 
Additional allowed values of OPTION are 'Term' for normal terminal output (default)
 and 'TermNoProgressBar' to disable the use of Term::ProgressBar.
(May not work on Windows OS.)

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

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

B<--legacychannels> Channel ids were made compliant with the XMLTV specification 
in December 2020. Use --legacychannels to output channel ids in the previous format
 (i.e. number only).

B<--output FILE> Write to FILE rather than standard output.

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

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

B<--list-channels> Output a list (in xmltv format) of all channels that can be fetched.

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

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

=head1 INSTALLATION

The file F<tv_grab_uk_tvguide.map.conf> has two purposes.  Firstly you can map the channel ids used by the site into something more meaningful to your PVR. E.g.

      map==74==BBC 1

will change "74" to "BBC 1" in the output XML.

Note: the lines are of the form "map=={channel id}=={my name}".

The second purpose is to likewise translate genre names.  So if your PVR doesn"t have a category for "Science Fiction" but uses "Sci-fi" instead, then you can specify

      cat==Science Fiction==Sci-fi

and the output XML will have "Sci-fi".


IMPORTANT: the downloaded "tv_grab_uk_tvguide.map.conf" contains example lines to illustrate the format - you should edit this file to suit your own purposes!

=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://tvguide.co.uk/

=head1 XMLTV VALIDATION

B<tv_validate_grabber> may report an error similar to:

      "Line 5 Invalid channel-id BBC 1"

This is a because ValidateFile.pm insists the channel-id adheres to RFC2838 despite the xmltv.dtd only saying "preferably" not "SHOULD".
(Having channel ids of the form "bbc1.bbc.co.uk" will be rejected by many PVRs since they require the data to match their own list.)

It may also report:

      "tv_sort failed on the concatenated data. Probably due to overlapping data between days."

Both these errors can be ignored.

=head1 BE KIND

Your grabbing might benefit from a more targeted strategy, rather than blithely getting all days for all channels. 

Since the published schedule rarely changes, a strategy of grabbing the next 3 days plus the 1 newest day would give you any new programmes as well as any last minute changes. Simply fetch "--offset 0 --days 3" and concatenate it with a separate fetch of "--offset 7 --days 1".

For example:

=over 6

( tv_grab_uk_tvguide --days 3 --offset 0 --output temp.xml ) && ( tv_grab_uk_tvguide --days 1 --offset 7 | tv_cat --output myprogrammes.xml temp.xml - ) && ( rm -f temp.xml )

=back

This avoids overloading the TVGuide website, and significantly reduces your runtime with minimal impact on your viewing schedule.

TVGuide provide this data for free, so let's not abuse their generosity.

=head1 DISCLAIMER

The TVGuide website's license for these data does not allow non-personal use.

Certainly, any commercial use of listings data obtained by using this grabber will breach copyright law, but if you are just using the data for your own personal use then you are probably fine.

By using this grabber you aver you are using the listings data for your own personal use only and you absolve the author(s) from any liability under copyright law or otherwise.

=head1 AUTHOR

Geoff Westcott. This documentation and parts of the code
based on various other tv_grabbers from the XMLTV-project.

=head1 SEE ALSO

L<xmltv(5)>.

=cut


To Do
=====

1.  Improve the progress bar update frequency
2.  Add actor 'character' attribute  DONE 30/6/16
3.  Currently only does Actor, Director, Producer, Writer - does anyone actually use any of the others present in the DTD?