#!/usr/bin/perl
#
# get_iplayer
#
# Lists and downloads BBC iPlayer audio and video streams
#
# Author: Phil Lewis
# Email: iplayer (at sign) linuxcentre.net
# Web: http://linuxcentre.net/iplayer
# License: GPLv3 (see LICENSE.txt)
#
my $version = 1.01;
#
# Help:
#	./get_iplayer --help
#
# Changelog:
# 	http://linuxcentre.net/get_iplayer/CHANGELOG.txt
#
# Example Usage and Documentation:
# 	http://linuxcentre.net/getiplayer/documentation
#
# Todo:
# * Use non-shell tee?
# * Fix non-uk detection - iphone auth?
# * Index/Download live radio streams w/schedule feeds to assist timing
# * Podcasts for 'local' stations are missing (only a handful). They use a number of different station ids which will involve reading html to determine rss feed. 
# * Remove all rtsp/mplayer/lame/tee dross when realaudio streams become obselete (not quite yet)
#
# Known Issues:
# * In ActivePerl/windows downloaded iPhone video files do not get renamed (remain with .partial.mov)
# * vlc does not quit after downloading an rtsp N95 video stream (ctrl-c is required) - need a --play-and-quit option if such a thing exists
#

use Env qw[@PATH];
use Fcntl;
use File::Copy;
use File::Path;
use File::stat;
use Getopt::Long;
use HTML::Entities;
use HTTP::Cookies;
use HTTP::Headers;
use IO::Seekable;
use IO::Socket;
use LWP::ConnCache;
#use LWP::Debug qw(+);
use LWP::UserAgent;
use POSIX qw(mkfifo);
use strict;
#use warnings;
use Time::Local;
use URI;

$|=1;
my %opt = ();
my %opt_cmdline = (); # a hash of which options came from the cmdline rather than the options files
my %opt_file = (); # a hash of which options came from the options files rather than the cmdline

# Print to STDERR if not quiet unless verbose or debug
sub logger(@) {
	# Make sure quiet can be overridden by verbose and debug options
	print STDERR $_[0] if (! $opt{quiet}) || $opt{verbose} || $opt{debug};
}

sub usage {
	logger <<EOF;
get_iplayer v$version, Usage ( Also see http://linuxcentre.net/iplayer ):
Search Programmes:  get_iplayer [<search options>] [<regex|index|pid|pidurl> ...]
Download files:     get_iplayer --get [<search options>] <regex|index|pid|pidurl> ...
                    get_iplayer --pid <pid|pidurl> [<options>]
Stream Downloads:   get_iplayer --stdout [<options>] <regex|index|pid|pidurl> | mplayer -cache 2048 -
Update get_iplayer: get_iplayer --update

Search Options:
 <regex|index|pid|url>         Search programme names based on given pattern
 -l, --long                    Additionally search in long programme descriptions / episode names
 --channel <regex>             Narrow search to matched channel(s)
 --category <regex>            Narrow search to matched categories
 --versions <regex>            Narrow search to matched programme version(s)
 --exclude-channel <regex>     Narrow search to exclude matched channel(s)
 --exclude-category <regex>    Narrow search to exclude matched catogories
 --type <radio|tv|podcast|all> Only search in these types of programmes (tv is default)
 --since <hours>               Limit search to programmes added to the cache in the last N hours
 
Display Options:
 -l, --long                    Display long programme descriptions / episode names and other data
 --terse                       Only show terse programme info (does not affect searching)
 --tree                        Display Programme listings in a tree view
 -i, --info                    Show full programme metadata (only if number of matches < 50)
 --list <categories|channel>   Show a list of available categories/channels for the selected type and exit
 --hide                        Hide previously downloaded programmes

Download Options:
 -g, --get                     Download matching programmes
 -x, --stdout                  Additionally stream to STDOUT (so you can pipe output to a player)
 -p, --proxy <url>             Web proxy URL spec
 --partial-proxy               Works around for some broken web proxies (try this extra option if your proxy fails)
 --pid <pid|url>               Download an arbitrary pid that does not appear in the index
 --force-download              Ignore download history (unsets --hide option also)
 --realaudio                   Use the RealAudio radio stream and not the MP3 stream
 --mp3audio                    Use the MP3 radio stream for radio and dont fallback to the RealAudio stream
 --wav                         In radio realaudio mode output as wav and don't transcode to mp3
 --raw                         In radio/realaudio or iPhone/video mode don't transcode or change the downloaded stream in any way
 --n95                         In TV mode download/stream low quality Nokia N95 H.264 stream (alpha)
 --bandwidth                   In radio realaudio mode specify the link bandwidth in bps for rtsp streaming (default 512000)
 --subtitles                   In TV mode, download subtitles into srt/SubRip format if available
 --suboffset <offset>          Offset the subtitle timestamps by the specified number of milliseconds
 --version-list <versions>     Override the version of programme to download (e.g. '--version-list signed,default')
 -t, --test                    Test only - no download (will show programme type)
 
PVR Options:
 --pvr                         Runs the PVR download using all saved PVR searches (intended to be run every hour from cron etc)
 --pvradd <search name>        Add the current search terms to the named PVR search
 --pvrdel <search name>        Remove the named search from the PVR searches
 --pvr-enable <search name>    Enable a previously disabled named PVR search
 --pvr-disable <search name>   Disable (not delete) a named PVR search
 --pvrlist                     Show the PVR search list

Output Options:
 -o, --output <dir>            Default Download output directory for all downloads
 --outputradio <dir>           Download output directory for radio
 --outputtv <dir>              Download output directory for tv
 --outputpodcast <dir>         Download output directory for podcasts
 --file-prefix <format>        The filename prefix (excluding dir and extension) using formatting fields. e.g. '<name>-<episode>-<pid>'
 -s, --subdir                  Downloaded files into Programme name subdirectory
 -n, --nowrite                 No writing of file to disk (use with -x to prevent a copy being stored on disk)
 -w, --whitespace              Keep whitespace (and escape chars) in filenames
 -q, --quiet                   No logging output
 -c, --command <command>       Run user command after successful download using args such as <pid>, <name> etc

Config Options:
 -f, --flush, --refresh        Refresh cache
 -e, --expiry <secs>           Cache expiry in seconds (default 4hrs)
 --symlink <file>              Create symlink to <file> once we have the header of the download
 --fxd <file>                  Create Freevo FXD XML in specified file
 --mythtv <file>               Create Mythtv streams XML in specified file
 --xml-channels                Create freevo/Mythtv menu of channels -> programme names -> episodes
 --xml-names                   Create freevo/Mythtv menu of programme names -> episodes
 --xml-alpha                   Create freevo/Mythtv menu sorted alphabetically by programme name
 --html <file>                 Create basic HTML index of programmes in specified file
 --mplayer <path>              Location of mplayer binary
 --lame <path>                 Location of lame binary
 --id3v2 <path>                Location of id3v2 binary
 --vlc <path>                  Location of vlc binary
 --streaminfo                  Returns all of the media stream urls of the programme(s)
 -v, --verbose                 Verbose
 -u, --update                  Update get_iplayer if a newer one exists
 -h, --help                    Help
 --save                        Save specified options as default in .get_iplayer/config
EOF
	exit 1;
}

# Get cmdline params
my $save;
# This is where all profile data/caches/cookies etc goes
my $profile_dir;
# This is where system-wide default options are specified
my $optfile_system;
# Options on unix-like systems
if ( defined $ENV{HOME} ) {
	$profile_dir = $ENV{HOME}.'/.get_iplayer';
	$optfile_system = '/etc/get_iplayer/options';

# Otherwise look for windows style file locations
} elsif ( defined $ENV{USERPROFILE} ) {
	$profile_dir = $ENV{USERPROFILE}.'/.get_iplayer';
	$optfile_system = $ENV{ALLUSERSPROFILE}.'/get_iplayer/options';
}
# Make profile dir if it doesnt exist
mkpath $profile_dir if ! -d $profile_dir;
# Personal options go here
my $optfile = "${profile_dir}/options";
# PVR Lockfile location
my $lockfile;
# Parse options if we're not saving options (system-wide options are overridden by personal options)
if ( ! grep /\-\-save/, @ARGV ) {
	$opt{debug} = 1 if grep /\-\-debug/, @ARGV;
	read_options_file($optfile_system);
	read_options_file($optfile);
}

# Allow bundling of single char options
Getopt::Long::Configure ("bundling");
# cmdline opts take precedence
GetOptions(
	"bandwidth=n"			=> \$opt_cmdline{bandwidth},
	"category=s"			=> \$opt_cmdline{category},
	"channel=s"			=> \$opt_cmdline{channel},
	"c|command=s"			=> \$opt_cmdline{command},
	"debug"				=> \$opt_cmdline{debug},
	"exclude-category=s"		=> \$opt_cmdline{excludecategory},
	"exclude-channel=s"		=> \$opt_cmdline{excludechannel},
	"expiry|e=n"			=> \$opt_cmdline{expiry},
	"file-prefix|fileprefix=s"	=> \$opt_cmdline{fileprefix},
	"flush|refresh|f"		=> \$opt_cmdline{flush},
	"force-download"		=> \$opt_cmdline{forcedownload},
	"fxd=s"				=> \$opt_cmdline{fxd},
	"get|g"				=> \$opt_cmdline{get},
	"help|h"			=> \$opt_cmdline{help},
	"hide"				=> \$opt_cmdline{hide},
	"html=s"			=> \$opt_cmdline{html},
	"id3v2=s"			=> \$opt_cmdline{id3v2},
	"i|info"			=> \$opt_cmdline{info},
	"lame=s"			=> \$opt_cmdline{lame},
	"list=s"			=> \$opt_cmdline{list},
	"long|l"			=> \$opt_cmdline{long},
	"mp3audio"			=> \$opt_cmdline{mp3audio},
	"mplayer=s"			=> \$opt_cmdline{mplayer},
	"mythtv=s"			=> \$opt_cmdline{mythtv},
	"n95"				=> \$opt_cmdline{n95},
	"no-write|nowrite|n"		=> \$opt_cmdline{nowrite},
	"output|o=s"			=> \$opt_cmdline{output},
	"outputpodcast=s"		=> \$opt_cmdline{outputpodcast},
	"outputradio=s"			=> \$opt_cmdline{outputradio},
	"outputtv=s"			=> \$opt_cmdline{outputtv},
	"partial-proxy"			=> \$opt_cmdline{partialproxy},
	"pid=s"				=> \$opt_cmdline{pid},
	"proxy|p=s"			=> \$opt_cmdline{proxy},
	"pvr"				=> \$opt_cmdline{pvr},
	"pvradd|pvr-add=s"		=> \$opt_cmdline{pvradd},
	"pvrdel|pvr-del=s"		=> \$opt_cmdline{pvrdel},
	"pvrdisable|pvr-disable=s"	=> \$opt_cmdline{pvrdisable},
	"pvrenable|pvr-enable=s"	=> \$opt_cmdline{pvrenable},
	"pvrlist|pvr-list"		=> \$opt_cmdline{pvrlist},
	"q|quiet"			=> \$opt_cmdline{quiet},
	"raw"				=> \$opt_cmdline{raw},
	"realaudio"			=> \$opt_cmdline{realaudio},
	"save"				=> \$save,
	"since=n"			=> \$opt_cmdline{since},
	"stdout|stream|x"		=> \$opt_cmdline{stdout},
	"streaminfo"			=> \$opt_cmdline{streaminfo},
	"subdirs|subdir|s"		=> \$opt_cmdline{subdir},
	"suboffset=n"			=> \$opt_cmdline{suboffset},
	"subtitles"			=> \$opt_cmdline{subtitles},
	"symlink|freevo=s"		=> \$opt_cmdline{symlink},
	"test|t"			=> \$opt_cmdline{test},
	"terse"				=> \$opt_cmdline{terse},
	"tree"				=> \$opt_cmdline{tree},
	"type=s"			=> \$opt_cmdline{type},
	"update|u"			=> \$opt_cmdline{update},
	"versionlist|version-list=s"	=> \$opt_cmdline{versionlist},
	"versions=s"			=> \$opt_cmdline{versions},
	"verbose|v"			=> \$opt_cmdline{verbose},
	"vlc=s"				=> \$opt_cmdline{vlc},
	"wav"				=> \$opt_cmdline{wav},
	"whitespace|ws|w"		=> \$opt_cmdline{whitespace},
	"xml-channels|fxd-channels"	=> \$opt_cmdline{xmlchannels},
	"xml-names|fxd-names"		=> \$opt_cmdline{xmlnames},
	"xml-alpha|fxd-alpha"		=> \$opt_cmdline{xmlalpha},
) || die usage();
usage() if $opt_cmdline{help};

# Merge cmdline options into %opt
for ( keys %opt_cmdline ) {
	$opt{$_} = $opt_cmdline{$_} if defined $opt_cmdline{$_};
}
# Save opts if specified
save_options_file( $optfile ) if $save;


# Global vars

# Programme data structure
# $prog{$pid} = {
#	'index'		=> <index number>,
#	'name'		=> <programme short name>,
#	'episode'	=> <Episode info>,
#	'desc'		=> <Long Description>,
#	'available'	=> <Date/Time made available or remaining>,
#	'duration'	=> <duration in HH:MM:SS>
#	'versions'	=> <comma separated list of versions, e.g default, signed>
#	'thumbnail'	=> <programme thumbnail url>
#	'channel	=> <channel>
#	'categories'	=> <Comma separtaed list of categories>
# 	'type'		=> <Type: tv, radio or podcast>
#	'timeadded'	=> <timestamp when programme was added to cache>
#	'longname'	=> <Long name (only parsed in stage 1 download)>,
#	'version'	=> <selected version e.g default, signed, etc - only set before d/load>
#	'filename'	=> <Path and Filename of saved file - set only while downloading>
#	'dir'		=> <Filename Directory of saved file - set only while downloading>
#	'fileprefix'	=> <Filename Prefix of saved file - set only while downloading>
#	'ext'		=> <Filename Extension of saved file - set only while downloading>
#};
my %prog;
my %pids_history;
my %index_pid; # Hash to obtain pid given an index
my $now;
my $childpid;

# Static URLs
my $channel_feed_url		= 'http://feeds.bbc.co.uk/iplayer'; # /$channel/list/limit/400
my $prog_feed_url		= 'http://feeds.bbc.co.uk/iplayer/episode/'; # $pid
my $prog_iplayer_metadata	= 'http://www.bbc.co.uk/iplayer/playlist/'; # $pid
my $media_stream_data_prefix	= 'http://www.bbc.co.uk/mediaselector/4/mtis/stream/'; # $verpid
my $iphone_download_prefix	= 'http://www.bbc.co.uk/mediaselector/3/auth/iplayer_streaming_http_mp4';
my $prog_page_prefix		= 'http://www.bbc.co.uk/programmes';
my $thumbnail_prefix		= 'http://www.bbc.co.uk/iplayer/images/episode';
my $metadata_xml_prefix		= 'http://www.bbc.co.uk/iplayer/metafiles/episode'; # /${pid}.xml
my $metadata_mobile_prefix	= 'http://www.bbc.co.uk/iplayer/widget/episodedetail/episode'; # /${pid}/template/mobile/service_type/tv/
my $podcast_index_feed_url	= 'http://downloads.bbc.co.uk/podcasts/ppg.xml';
my $version_url			= 'http://linuxcentre.net/get_iplayer/VERSION-get_iplayer';
my $update_url			= 'http://linuxcentre.net/get_iplayer/get_iplayer';

# Static hash definitions
my %channels;
$channels{tv} = {
	'bbc_one'				=> 'tv|BBC One',
	'bbc_two'				=> 'tv|BBC Two',
	'bbc_three'				=> 'tv|BBC Three',
	'bbc_four'				=> 'tv|BBC Four',
	'cbbc'					=> 'tv|CBBC',
	'cbeebies'				=> 'tv|CBeebies',
	'bbc_news24'				=> 'tv|BBC News 24',
	'bbc_parliament'			=> 'tv|BBC Parliament',
	'bbc_one_northern_ireland'		=> 'tv|BBC One Northern Ireland',
	'bbc_one_scotland'			=> 'tv|BBC One Scotland',
	'bbc_one_wales'				=> 'tv|BBC One Wales',
	'bbc_webonly'				=> 'tv|BBC Web Only',
	'bbc_hd'				=> 'tv|BBC HD',
	'bbc_alba'				=> 'tv|BBC Alba',
	'categories/news/tv'			=> 'tv|BBC News',
	'categories/sport/tv'			=> 'tv|BBC Sport',
#	'categories/tv'				=> 'tv|All',
	'categories/signed'			=> 'tv|Signed',
};

$channels{radio} = {
	'bbc_1xtra'				=> 'radio|BBC 1Xtra',
	'bbc_radio_one'				=> 'radio|BBC Radio 1',
	'bbc_radio_two'				=> 'radio|BBC Radio 2',
	'bbc_radio_three'			=> 'radio|BBC Radio 3',
	'bbc_radio_four'			=> 'radio|BBC Radio 4',
	'bbc_radio_five_live'			=> 'radio|BBC Radio 5 live',
	'bbc_radio_five_live_sports_extra'	=> 'radio|BBC 5 live Sports Extra',
	'bbc_6music'				=> 'radio|BBC 6 Music',
	'bbc_7'					=> 'radio|BBC 7',
	'bbc_asian_network'			=> 'radio|BBC Asian Network',
	'bbc_radio_foyle'			=> 'radio|BBC Radio Foyle',
	'bbc_radio_scotland'			=> 'radio|BBC Radio Scotland',
	'bbc_radio_nan_gaidheal'		=> 'radio|BBC Radio Nan Gaidheal',
	'bbc_radio_ulster'			=> 'radio|BBC Radio Ulster',
	'bbc_radio_wales'			=> 'radio|BBC Radio Wales',
	'bbc_radio_cymru'			=> 'radio|BBC Radio Cymru',
	'bbc_world_service'			=> 'radio|BBC World Service',
#	'categories/radio'			=> 'radio|All',
};

# User Agents
my %user_agent = (
  	coremedia	=> 'Apple iPhone v1.1.1 CoreMedia v1.0.0.3A110a',
  	safari		=> 'Mozilla/5.0 (iPhone; U; CPU like Mac OS X; en) AppleWebKit/420.1 (KHTML, like Gecko) Version/3.0 Mobile/3A110a Safari/419.3',
  	update		=> "get_iplayer updater (v${version} - $^O)",
  	desktop		=> 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-GB; rv:1.9) Gecko/2008052906 Firefox/3.0',
  	get_iplayer	=> "get_iplayer/$version $^O",
);

# Setup signal handlers
$SIG{INT} = $SIG{PIPE} =\&cleanup;

# Other Non-option dependant vars
my %cachefile = (
	'tv'		=> "${profile_dir}/tv.cache",
	'radio'		=> "${profile_dir}/radio.cache",
	'podcast'	=> "${profile_dir}/podcast.cache",
);
my $get_iplayer_stream	= 'get_iplayer_freevo_wrapper';	# Location of wrapper script for streaming with mplayer/xine on freevo
my $historyfile		= "${profile_dir}/download_history";
my $pvr_dir		= "${profile_dir}/pvr/";
my $cookiejar		= "${profile_dir}/cookies";
my $namedpipe 		= "${profile_dir}/namedpipe.$$";
my $lwp_request_timeout	= 20;
my $info_limit		= 40;
my $iphone_block_size	= 0x2000000; # 32MB


# Option dependant var definitions
my %download_dir;
my $cache_secs;
my $mplayer;
my $mplayer_opts;
my $lame;
my $lame_opts;
my $vlc;
my $vlc_opts;
my $id3v2;
my $tee;
my $bandwidth;
my @version_search_list;
my $proxy_url;
my @search_args = @ARGV;
# Assume search term is '.*' if nothing is specified - i.e. lists all programmes
push @search_args, '.*' if ! $search_args[0];


# PVR functions
my %pvrsearches; # $pvrsearches{searchname}{<option>} = <value>;
if ( $opt{pvradd} ) {
	pvr_add( $opt{pvradd}, @search_args );
	exit 0;

} elsif ( $opt{pvrdel} ) {
	pvr_del( $opt{pvrdel} );
	exit 0;

} elsif ( $opt{pvrdisable} ) {
	pvr_disable( $opt{pvrdisable} );
	exit 0;

} elsif ( $opt{pvrenable} ) {
	pvr_enable( $opt{pvrenable} );
	exit 0;

} elsif ( $opt{pvrlist} ) {
	pvr_display_list();
	exit 0;

# Load all PVR searches and run one-by-one
} elsif ( $opt{pvr} ) {
	# PVR Lockfile detection (with 12 hrs stale lockfile check)
	$lockfile = "${profile_dir}/pvr_lock";
	lockfile(43200) if ! $opt{test};
	# Don't attempt to download pids in download history
	%pids_history = load_download_history();
	# Load all PVR searches
	pvr_load_list();
	# Display default options
	display_default_options();
	# For each PVR search
	for my $name ( sort {$a <=> $b} keys %pvrsearches ) {
		# Ignore if this search is disabled
		if ( $pvrsearches{$name}{disable} ) {
			logger "\nSkipping disabled PVR Search '$name'\n" if $opt{verbose};
			next;
		}
		logger "\nRunning PVR Search '$name'\n";
		# Clear then Load options for specified pvr search name
		pvr_load_options($name);
		# Switch on --hide option
		$opt{hide} = 1;
		# Dont allow --flush with --pvr
		$opt{flush} = '';
		# Do the downloads (force --get option)
		$opt{get} = 1 if ! $opt{test};
		process_matches( @search_args );
	}

# Else just process command line args
} else {
	%pids_history = load_download_history() if $opt{hide};
	process_matches( @search_args );
}
exit 0;



# Use the specified options to process the matches in specified array
sub process_matches {
	my @search_args = @_;
	# Show options
	display_current_options() if $opt{verbose};
	# Clear prog hash
	%prog = ();
	logger "INFO: Search args: '".(join "','", @search_args)."'\n" if $opt{verbose};

	# Option dependant vars
	%download_dir	= (
		'tv'		=> $opt{outputtv} || $opt{output} || $ENV{IPLAYER_OUTDIR} || '.',
		'radio'		=> $opt{outputradio} || $opt{output} || $ENV{IPLAYER_OUTDIR} || '.',
		'podcast'	=> $opt{outputpodcast} || $opt{output} || $ENV{IPLAYER_OUTDIR} || '.',
	);
	# Default to type=tv
	$opt{type} 		= 'tv' if ! $opt{type};
	# Expand 'all' to various prog types
	$opt{type} 		= 'tv,radio,podcast' if $opt{type} =~ /(all|any)/i;
	# Ensure lowercase
	$opt{type} = lc( $opt{type} );
	$cache_secs 		= $opt{expiry} || 14400;
	$mplayer		= $opt{mplayer} || 'mplayer';
	$mplayer_opts		= '-nolirc';
	$mplayer_opts		.= ' -really-quiet' if $opt{quiet};
	$lame			= $opt{lame} || 'lame';
	$lame_opts		= '-f ';
	$lame_opts		.= '--quiet ' if $opt{quiet};
	$vlc			= $opt{vlc} || 'cvlc';
	$vlc_opts		= '-vv';
	$id3v2			= $opt{id3v2} || 'id3v2';
	$tee			= 'tee';
	$bandwidth		= $opt{bandwidth} || 512000; # Download bandwidth bps used for rtsp streams
	# Order with which to search for programme versions (can be overridden by --versionlist option)
	@version_search_list 	= qw/ default original signed audiodescribed opensubtitled shortened lengthened other /;
	@version_search_list 	= split /,/, $opt{versionlist} if $opt{versionlist};
	# Set quiet, test and get options if we're asked for streaminfo
	if ( $opt{streaminfo} ) {
		$opt{test} 	= 1;
		$opt{get} 	= 1;
		$opt{quiet} 	= 1;
	}

	# Sanity check some conflicting options
	if ($opt{nowrite} && (!$opt{stdout})) {
		logger "ERROR: Cannot download to nowhere\n";
		exit 1;
	}

	# Web proxy
	$proxy_url = $opt{proxy} || $ENV{HTTP_PROXY} || $ENV{http_proxy} || '';
	logger "INFO: Using Proxy $proxy_url\n" if $proxy_url;

	# Update this script if required
	if ($opt{update}) {
		update_script();
	}

	# Check for valid dload dirs or create them
	for ( keys %download_dir ) {
		if ( ! -d $download_dir{$_} ) {
			logger "INFO: Created directory $download_dir{$_}\n";
			mkpath($download_dir{$_});
		}
	}

	# Get stream links from BBC iplayer site or from cache (also populates all hashes) specified in --type option
	get_links( $_ ) for split /,/, $opt{type};

	# List elements (i.e. 'channel' 'categories') if required and exit
	if ( $opt{list} ) {
		list_unique_element_counts( $opt{list} );
		exit 0;
	}

	# Write HTML and XML files if required
	create_html( sort {$a <=> $b} keys %index_pid ) if $opt{html};
	create_xml( $opt{fxd}, sort {$a <=> $b} keys %index_pid ) if $opt{fxd};
	create_xml( $opt{mythtv}, sort {$a <=> $b} keys %index_pid ) if $opt{mythtv};

	# Get arbitrary pid
	if ( $opt{pid} ) {
		# Remove any url parts from the pid
		$opt{pid} =~ s/^.*(b0[a-z,0-9]{6}).*$/$1/g;
		# Retry loop
		my $count;
		my $retries = 3;
		my $retcode;
		exit 1 if ( ! $opt{streaminfo} ) && check_download_history( $opt{pid} );
		while ( $count < $retries && ($retcode = download_programme( $opt{pid} )) eq 'retry' ) {
			logger "WARNING: Retrying download for PID $opt{pid}\n";
			$count++;
		}
		# Add to history, tag and Run post download command if download was successful
		if ($retcode == 0) {
			add_to_download_history( $opt{pid} );
			tag_file( $opt{pid} );
			run_user_command( $opt{pid}, $opt{command} ) if $opt{command};
		}	
		exit 0;
	}

	# Parse remaining args
	my @match_list;
	for ( @search_args ) {
		chomp();
	
		# If Numerical value < 30000
		if ( /^[\d]+$/ && $_ < 30000) {
			push @match_list, $_;
	
		# If PID then find matching programmes with this PID
		} elsif ( /^.*b0[a-z,0-9]{6}.*$/ ) {
			s/^.*(b0[a-z,0-9]{6}).*$/$1/g;
			push @match_list, get_regex_matches( $1 );
	
		# Else assume this is a programme name regex
		} else {
			push @match_list, get_regex_matches( $_ );
		}
	}
	
	# De-dup matches and retain order
	my %seen = ();
	my @unique = grep { ! $seen{ $_ }++ } @match_list;
	@match_list = @unique;
	
	# Go get the cached data for other programme types if the index numbers require it
	my %require;
	for ( @match_list ) {
		$require{tv} = 1 if $_ >= 1 && $_ < 10000 && ( ! $require{tv} ) && $opt{type} !~ /tv/;
		$require{radio} = 1 if $_ >= 10000 && $_ < 20000 && ( ! $require{radio} ) && $opt{type} !~ /radio/;
		$require{podcast} = 1 if $_ >= 20000 && $_ < 30000 && ( ! $require{podcast} ) && $opt{type} !~ /podcast/;
	}
	# Get extra required programme caches
	logger "INFO: Additionally getting cached programme data for ".(join ', ', keys %require)."\n" if %require > 0;
	# Get stream links from BBC iplayer site or from cache (also populates all hashes)
	for (keys %require) {
		# Get $_ stream links
		get_links( $_ );
		# Add new prog types to the type option
		$opt{type} .= ",$_";
	}

	# Display list for download
	logger "Matches:\n" if @match_list;
	@match_list = list_progs( @match_list );

	# Do the downloads based on list of index numbers if required
	if ( $opt{get} || $opt{stdout} ) {
		for (@match_list) {
			# Retry loop
			my $count = 0;
			my $retries = 3;
			my $retcode;
			my $pid = $index_pid{$_};
			next if ( ! $opt{streaminfo} ) && check_download_history( $pid );
			# Skip and warn if there is no pid
			if ( ! $pid ) {
				logger "ERROR: No PID for index $_ (try using --type option ?)\n";
				next;
			}
			while ( $count < $retries && $pid && ($retcode = download_programme( $pid )) eq 'retry' ) {
				logger "WARNING: Retrying download for '$prog{$pid}{name} - $prog{$pid}{episode}'\n";
				$count++;
			}
			# Add to history, tag file, and run post download command if download was successful
			if ($retcode eq '0') {
				add_to_download_history( $pid );
				tag_file( $pid );
				run_user_command( $pid, $opt{command} ) if $opt{command};
				pvr_report( $pid ) if $opt{pvr};
			}
		}
	}

	return 0;
}



# Lists progs given an array of index numbers, also returns an array with non-existent entries removed
sub list_progs {
	my $ua;
	my @checked;
	my %names;
	# Setup user agent for a persistent connection to get programme metadata
	if ( $opt{info} ) {
		$ua = LWP::UserAgent->new;
		$ua->timeout([$lwp_request_timeout]);
		$ua->proxy( ['http'] => $proxy_url );
		$ua->agent( $user_agent{desktop} );
		$ua->conn_cache(LWP::ConnCache->new());
		# Truncate array if were lisiting info and > $info_limit entries are requested - be nice to the beeb!
		if ( $#_ >= $info_limit ) {
			$#_ = $info_limit - 1;
			logger "WARNING: Only processing the first $info_limit matches\n";
		}
	}
	for (@_) {
		my $pid = $index_pid{$_};
		# Skip if pid isn't in index
		next if ! $pid;
		# Skip if already downloaded and --hide option is specified
		next if $opt{hide} && $pids_history{$pid};
		if (! defined $names{ $prog{$pid}{name} }) {
			list_prog_entry( $pid, '' );
		} else {
			list_prog_entry( $pid, '', 1 );
		}
		$names{ $prog{$pid}{name} } = 1;
		push @checked, $_;
		logger get_pid_metadata( $ua, $pid )."\n" if $opt{info};
	}
	logger "\n";

	logger "INFO: ".($#checked + 1)." Matching Programmes\n";
	return @checked;
}



# Display a line containing programme info (using long, terse, and type options)
sub list_prog_entry {
	my ( $pid, $prefix, $tree ) = ( @_ );
	my $type = '';
	$type = "$prog{$pid}{type}, " if $opt{type} !~ /^(tv|radio|podcast)$/i;
	my $name;
	# If tree view
	if ( $opt{tree} ) {
		$prefix = '  '.$prefix;
		$name = '';
	} else {
		$name = "$prog{$pid}{name} - ";
	}
	# Remove some info depending on type
	my $optional;
	$optional = ", '$prog{$pid}{channel}', $prog{$pid}{categories}, $prog{$pid}{versions}" if $prog{$pid}{type} eq 'tv';
	$optional = ", '$prog{$pid}{channel}', $prog{$pid}{categories}" if $prog{$pid}{type} eq 'radio';
	$optional = ", '$prog{$pid}{available}', '$prog{$pid}{channel}', $prog{$pid}{categories}" if $prog{$pid}{type} eq 'podcast';
	logger "\n${type}$prog{$pid}{name}\n" if $opt{tree} && ! $tree;
	# Display based on output options
	if ( $opt{long} ) {
		my @time = gmtime( time() - $prog{$pid}{timeadded} );
		logger "${prefix}$prog{$pid}{index}:\t${type}${name}$prog{$pid}{episode}${optional}, $time[7] days $time[2] hours ago - $prog{$pid}{desc}\n";
	} elsif ( $opt{terse} ) {
		logger "${prefix}$prog{$pid}{index}:\t${type}${name}$prog{$pid}{episode}\n";
	} else {
		logger "${prefix}$prog{$pid}{index}:\t${type}${name}$prog{$pid}{episode}${optional}\n";
	}
	return 0;
}



# Get matching programme index numbers using supplied regex
sub get_regex_matches {
	my $download_regex = shift;
	my %download_hash;
	my $channel_regex = $opt{channel} || '.*';
	my $category_regex = $opt{category} || '.*';
	my $versions_regex = $opt{versions} || '.*';
	my $channel_exclude_regex = $opt{excludechannel} || '^ROGUE$';
	my $category_exclude_regex = $opt{excludecategory} || '^ROGUE$';
	my $since = $opt{since} || 99999;
	my $now = time();
		
	for (keys %index_pid) {
		my $pid = $index_pid{$_};

		# Only include programmes matching channels and category regexes
		if ( $prog{$pid}{channel} =~ /$channel_regex/i
		  && $prog{$pid}{categories} =~ /$category_regex/i
		  && $prog{$pid}{versions} =~ /$versions_regex/i
		  && $prog{$pid}{channel} !~ /$channel_exclude_regex/i
		  && $prog{$pid}{categories} !~ /$category_exclude_regex/i
		  && $prog{$pid}{timeadded} >= $now - ($since * 3600)
		) {

			# Search prognames/pids while excluding channel_regex and category_regex
			$download_hash{$_} = 1 if (
				$prog{$pid}{name} =~ /$download_regex/i
				|| ( $pid =~ /$download_regex/i && $download_regex =~ /b00/ )
				|| ( $pid =~ /$download_regex/i && $download_regex =~ /b00/ )
			);
			# Also search long descriptions and episode data if -l is specified
			$download_hash{$_} = 1 if (
				$opt{long} 
				&& 
				( $prog{$pid}{desc} =~ /$download_regex/i
				  || $prog{$pid}{episode} =~ /$download_regex/i
				)
			);
		}
	}
	return sort {$a <=> $b} keys %download_hash;
}


# get_links_atom (%channels)
sub get_links_atom {
	my $type = shift;
	my %channels = %{$_[0]};

	my $xml;
	my $feed_data;
	my $res;
	logger "INFO: Getting $type Index Feeds\n";
	# Setup User agent
	my $ua = LWP::UserAgent->new;
	$ua->timeout([$lwp_request_timeout]);
	$ua->proxy( ['http'] => $proxy_url );
	$ua->agent( $user_agent{desktop} );
	$ua->conn_cache(LWP::ConnCache->new());

	# Download index feed
	# Sort feeds so that category based feeds are done last - this makes sure that the channels get defined correctly if there are dups
	my @channel_list;
	push @channel_list, grep !/categor/, keys %channels;
	push @channel_list, grep  /categor/, keys %channels;
	for ( @channel_list ) {

		my $url = "${channel_feed_url}/$_/list/limit/400";
		logger "DEBUG: Getting feed $url\n" if $opt{verbose};
		$xml = request_url_retry($ua, $url, 3, '.', "WARNING: Failed to get programme index feed for $_ from iplayer site\n");
		logger "INFO: Got ".(grep /<entry/, split /\n/, $xml)." programmes\n" if $opt{verbose};
		decode_entities($xml);	
		
		# Feed as of August 2008
		#	 <entry>
		#	   <title type="text">Bargain Hunt: Series 18: Oswestry</title>
		#	   <id>tag:feeds.bbc.co.uk,2008:PIPS:b0088jgs</id>
		#	   <updated>2008-07-22T00:23:50Z</updated>
		#	   <content type="html">
		#	     &lt;p&gt;
		#	       &lt;a href=&quot;http://www.bbc.co.uk/iplayer/episode/b0088jgs?src=a_syn30&quot;&gt;
		#		 &lt;img src=&quot;http://www.bbc.co.uk/iplayer/images/episode/b0088jgs_150_84.jpg&quot; alt=&quot;Bargain Hunt: Series 18: Oswestry&quot; /&gt;
		#	       &lt;/a&gt;
		#	     &lt;/p&gt;
		#	     &lt;p&gt;
		#	       The teams are at an antiques fair in Oswestry showground. Hosted by Tim Wonnacott.
		#	     &lt;/p&gt;
		#	   </content>
		#	   <category term="Factual" />
		#	   <category term="TV" />
		#	   <link rel="via" href="http://www.bbc.co.uk/iplayer/episode/b0088jgs?src=a_syn30" type="text/html" title="Bargain Hunt: Series 18: Oswestry" />
		#       </entry>
		#

		### New Feed
		#  <entry>
		#    <title type="text">House of Lords: 02/07/2008</title>
		#    <id>tag:bbc.co.uk,2008:PIPS:b00cd5p7</id>
		#    <updated>2008-06-24T00:15:11Z</updated>
		#    <content type="html">
		#      <p>
		#	<a href="http://www.bbc.co.uk/iplayer/episode/b00cd5p7?src=a_syn30">
		#	  <img src="http://www.bbc.co.uk/iplayer/images/episode/b00cd5p7_150_84.jpg" alt="House of Lords: 02/07/2008" />
		#	</a>
		#      </p>
		#      <p>
		#	House of Lords, including the third reading of the Health and Social Care Bill. 1 July.
		#      </p>
		#    </content>
		#    <category term="Factual" scheme="urn:bbciplayer:category" />
		#    <link rel="via" href="http://www.bbc.co.uk/iplayer/episode/b00cd5p7?src=a_syn30" type="application/atom+xml" title="House of Lords: 02/07/2008">
		#    </link>
		#  </entry>

		# Parse XML

		# get list of entries within <entry> </entry> tags
		my @entries = split /<entry>/, $xml;
		# Discard first element == header
		shift @entries;

		my ( $name, $episode, $desc, $pid, $available, $channel, $duration, $thumbnail, $type, $versions );
		foreach my $entry (@entries) {

			my $entry_flat = $entry;
			$entry_flat =~ s/\n/ /g;

			# <id>tag:bbc.co.uk,2008:PIPS:b008pj3w</id>
			$pid = $1 if $entry =~ m{<id>.*PIPS:(.+?)</id>};


			# parse name: episode, e.g. Take a Bow: Street Feet on the Farm
			$name = $1 if $entry =~ m{<title\s*.*?>\s*(.*?)\s*</title>};
			$episode = $name;
			$name =~ s/^(.*): .*$/$1/g;
			$episode =~ s/^.*: (.*)$/$1/g;

			# This is not the availability!
			# <updated>2008-06-22T05:01:49Z</updated>
			#$available = get_available_time_string( $1 ) if $entry =~ m{<updated>(\d{4}\-\d\d\-\d\dT\d\d:\d\d:\d\d.).*?</updated>};

			#<p>    House of Lords, including the third reading of the Health and Social Care Bill. 1 July.   </p>    </content>
			$desc = $1 if $entry =~ m{<p>\s*(.*?)\s*</p>\s*</content>};

			# Parse the categories into hash
			# <category term="Factual" />
			my @category;
			for my $line ( grep /<category/, (split /\n/, $entry) ) {
				push @category, $1 if $line =~ m{<category\s+term="(.+?)"};
			}

			# Extract channel and type
			($type, $channel) = (split /\|/, $channels{$_})[0,1];

			logger "DEBUG: '$pid, $name - $episode, $channel'\n" if $opt{debug};

			# Merge and Skip if this pid is a duplicate
			if ( defined $prog{$pid} ) {
				logger "WARNING: '$pid, $prog{$pid}{name} - $prog{$pid}{episode}, $prog{$pid}{channel}' already exists (this channel = $channel)\n" if $opt{verbose};
				# Since we use the 'Signed' channel to get sign zone data, merge the categories from this entry to the existing entry
				if ( $prog{$pid}{categories} ne join(',', @category) ) {
					my %cats;
					$cats{$_} = 1 for ( split /,/, $prog{$pid}{categories} );
					$cats{$_} = 1 for ( @category );
					logger "INFO: Merged categories for $pid from $prog{$pid}{categories} to ".join(',', sort keys %cats)."\n" if $opt{verbose};
					$prog{$pid}{categories} = join(',', sort keys %cats);
				}
				# If this is a dupicate pid and the channel is now Signed then both versions are available
				$prog{$pid}{versions} = 'default,signed' if $channel eq 'Signed';
				next;
			}

			# Check for signed-only version from Channel
			if ($channel eq 'Signed') {
				$versions = 'signed';
			# Else if not channel 'Signed' then this must also have both versions available
			} elsif ( grep /Sign Zone/, @category ) {
				$versions = 'default,signed';
			} else {
				$versions = 'default';
			}
			
			# build data structure
			$prog{$pid} = {
				'name'		=> $name,
				'versions'	=> $versions,
				'episode'	=> $episode,
				'desc'		=> $desc,
				'available'	=> 'Unknown',
				'duration'	=> 'Unknown',
				'thumbnail'	=> "${thumbnail_prefix}/${pid}_150_84.jpg",
				'channel'	=> $channel,
				'categories'	=> join(',', @category),
				'type'		=> $type,
			};
		}
	}
	logger "\n";
	return 0;
}



# Populates the index field of the prog hash as well as creating the %index_pid hash
# Should be run after getting any link lists
sub sort_indexes {

	# Add index field based on alphabetical sorting by prog name
	my %index;
	$index{tv} = 1;
	
	# Start index counter at 10001 for radio progs
	$index{radio} = 10001;

	# Start index counter at 20001 for podcast progs
	$index{podcast} = 20001;

	my @prog_pid;

	# Create unique array of '<progname|pid>'
	push @prog_pid, "$prog{$_}{name}|$_" for (keys %prog);

	# Sort by progname and index 
	for (sort @prog_pid) {
		# Extract pid
		my $pid = (split /\|/)[1];
		my $type = $prog{$pid}{type};
		$index_pid{ $index{$type} } = $pid;
		$prog{$pid}{index} = $index{$type};
		$index{$type}++;
	}
	return 0;
}



# Uses: $podcast_index_feed_url
# get_podcast_links ()
sub get_podcast_links {

	my $xml;
	my $res;
	logger "INFO: Getting podcast Index Feeds\n";
	# Setup User agent
	my $ua = LWP::UserAgent->new;
	$ua->timeout([$lwp_request_timeout]);
	$ua->proxy( ['http'] => $proxy_url );
	$ua->agent( $user_agent{get_iplayer} );
	$ua->conn_cache(LWP::ConnCache->new());
	
	# Method
	# $podcast_index_feed_url (gets list of rss feeds for each podcast prog) =>
	# http://downloads.bbc.co.uk/podcasts/$channel/$name/rss.xml =>
	
	# Download index feed
	my $xmlindex = request_url_retry($ua, $podcast_index_feed_url, 3, '.', "WARNING: Failed to get prodcast index from site\n");
	$xmlindex =~ s/\n/ /g;

	# Every RSS feed has an extry like below (all in a text block - not formatted like below)
	#  <program xmlns="" language="en-gb" typicalDuration="P30M" active="true" public="true" bbcFlavour="Programme Highlights" region="all" wwpid="0">
	#    <title>Best of Chris Moyles</title>
	#    <shortTitle>moyles</shortTitle>
	#    <description>Weekly highlights from the award-winning Chris Moyles breakfast show, as broadcast by Chris and team every morning from 6.30am to 10am.</description>
	#    <network id="radio1" name="BBC Radio 1" />
	#    <image use="itunes" url="http://www.bbc.co.uk/radio/podcasts/moyles/assets/_300x300.jpg" />
	#    <link target="homepage" url="http://www.bbc.co.uk/radio1/chrismoyles/" />
	#    <link target="feed" url="http://downloads.bbc.co.uk/podcasts/radio1/moyles/rss.xml" />
	#    <link target="currentItem" url="http://downloads.bbc.co.uk/podcasts/radio1/moyles/moyles_20080926-0630a.mp3">
	#      <title>Moyles: Guestfest. 26 Sep 08</title>
	#      <description>Rihanna, Ross Kemp, Jack Osbourne, John
	#      Barrowman, Cheggars, the legend that is Roy Walker and more,
	#      all join the team in a celeb laden bundle of mirth and
	#      merriment. It&#226;&#8364;&#8482;s all the best bits of the
	#      week from The Chris Moyles Show on BBC Radio 1.</description>
	#      <publishDate>2008-09-26T06:30:00+01:00</publishDate>
	#    </link>
	#    <bbcGenre id="entertainment" name="Entertainment" />
	#    <systemRef systemId="podcast" key="42" />
	#    <systemRef systemId="pid.brand" key="b006wkqb" />
	#    <feed mimeType="audio/mpeg" content="audio" audioCodec="mp3" audioProfile="cbr" />
	#  </program>
	for ( split /<program/, $xmlindex ) {
		# Extract channel name, rss feed data
		my ($channel, $url);

		# <network id="radio1" name="BBC Radio 1" />
		$channel = $1 if m{<network\s+id=".*?"\s+name="(.*?)"\s*\/>};

		# <link target="feed" url="http://downloads.bbc.co.uk/podcasts/radio1/moyles/rss.xml" />
		$url = $1 if m{<link\s+target="feed"\s+url="(.*?)"\s*\/>};

		# Skip if there is no feed data for channel
		next if ! ($channel || $url);

		my ( $name, $episode, $desc, $pid, $available, $duration, $thumbnail );

		# Get RSS feeds for each podcast programme
		logger "DEBUG: Getting podcast feed $url\n" if $opt{verbose};
		$xml = request_url_retry($ua, $url, 3, '.', "WARNING: Failed to get podcast feed for $channel / $_ from iplayer site\n") if $opt{verbose};
		$xml = request_url_retry($ua, $url, 3, '.', '') if ! $opt{verbose};
		# skip if no data
		next if ! $xml;

		logger "INFO: Got ".(grep /<media:content/, split /<item>/, $xml)." programmes\n" if $opt{verbose};
		decode_entities($xml);
	
		# First entry is channel data
		# <?xml version="1.0" encoding="utf-8"?>
		#<rss xmlns:media="http://search.yahoo.com/mrss/"
		#xmlns:itunes="http://www.itunes.com/dtds/podcast-1.0.dtd"
		#version="2.0">
		#  <channel>
		#    <title>Stuart Maconie's Freak Zone</title>
		#    <link>http://www.bbc.co.uk/6music/shows/freakzone/</link>
		#    <description>Weekly highlights from Stuart Maconie's
		#    ...podcast is only available in the UK.</description>
		#    <itunes:summary>Weekly highlights from Stuart Maconie's
		#    ...podcast is only available in the UK.</itunes:summary>
		#    <itunes:author>BBC 6 Music</itunes:author>
		#    <itunes:owner>
		#      <itunes:name>BBC</itunes:name>
		#      <itunes:email>podcast.support@bbc.co.uk</itunes:email>
		#    </itunes:owner>
		#    <language>en</language>
		#    <ttl>720</ttl>
		#    <image>
		#      <url>
		#      http://www.bbc.co.uk/radio/podcasts/freakzone/assets/_300x300.jpg</url>
		#      <title>Stuart Maconie's Freak Zone</title>
		#      <link>http://www.bbc.co.uk/6music/shows/freakzone/</link>
		#    </image>
		#    <itunes:image href="http://www.bbc.co.uk/radio/podcasts/freakzone/assets/_300x300.jpg" />
		#    <copyright>(C) BBC 2008</copyright>
		#    <pubDate>Sun, 06 Jul 2008 20:00:05 +0100</pubDate>
		#    <itunes:category text="Music" />
		#    <itunes:keywords>Stewart Maconie, Macconie, freekzone,
		#    freakzone, macoonie</itunes:keywords>
		#    <media:keywords>Stewart Maconie, Macconie, freekzone,
		#    freakzone, macoonie</media:keywords>
		#   <itunes:explicit>no</itunes:explicit>
		#    <media:rating scheme="urn:simple">nonadult</media:rating>

		# Parse XML

		# get list of entries within <entry> </entry> tags
		my @entries = split /<item>/, $xml;
		# first element == <channel> header
		my $header = shift @entries;

		# Get podcast name
		$name = $1 if $header =~ m{<title>\s*(.+?)\s*</title>};
	
		# Parse the categories into hash
		# <itunes:category text="Music" />
		my @category;
		for my $line ( grep /<itunes:category/, (split /\n/, $header) ) {
			push @category, $1 if $line =~ m{<itunes:category\s+text="\s*(.+?)\s*"};
		}
	
		# Get thumbnail from header
		# <itunes:image href="http://www.bbc.co.uk/radio/podcasts/freakzone/assets/_300x300.jpg" />
		$thumbnail = $1 if $header =~ m{<itunes:image href="\s*(.+?)\s*"};

		# Followed by items:
		#    <item>
		#      <title>FreakZone: C'est Stuart avec le Professeur Spear et le
		#      pop francais?</title>
		#      <description>Stuart and Justin discuss the sub-genre of
		#      French 'cold wave' in this week's module.</description>
		#      <itunes:subtitle>Stuart and Justin discuss the sub-genre of
		#      French 'cold wave' in this week's
		#      module....</itunes:subtitle>
		#      <itunes:summary>Stuart and Justin discuss the sub-genre of
		#      French 'cold wave' in this week's module.</itunes:summary>
		#      <pubDate>Sun, 06 Jul 2008 20:00:00 +0100</pubDate>
		#      <itunes:duration>14:23</itunes:duration>
		#      <enclosure url="http://downloads.bbc.co.uk/podcasts/6music/freakzone/freakzone_20080706-2000.mp3"
		#      length="13891916" type="audio/mpeg" />
		#      <guid isPermaLink="false">
		#      http://downloads.bbc.co.uk/podcasts/6music/freakzone/freakzone_20080706-2000.mp3</guid>
		#      <link>
		#      http://downloads.bbc.co.uk/podcasts/6music/freakzone/freakzone_20080706-2000.mp3</link>
		#      <media:content url="http://downloads.bbc.co.uk/podcasts/6music/freakzone/freakzone_20080706-2000.mp3"
		#      fileSize="13891916" type="audio/mpeg" medium="audio"
		#      expression="full" duration="863" />
		#      <itunes:author>BBC 6 Music</itunes:author>
		#    </item>
	
		foreach my $entry (@entries) {

			my $entry_flat = $entry;
			$entry_flat =~ s/\n/ /g;
	
			# Use the link as a guid
			# <link>   http://downloads.bbc.co.uk/podcasts/6music/freakzone/freakzone_20080706-2000.mp3</link>
			$pid = $1 if $entry =~ m{<link>\s*(.+?)</link>};
	
			# Skip if this pid is a duplicate
			if ( defined $prog{$pid} ) {
				logger "WARNING: '$pid, $prog{$pid}{name} - $prog{$pid}{episode}, $prog{$pid}{channel}' already exists (this channel = $_)\n" if $opt{verbose};
				next;
			}
	
			# parse episode
			# <title>FreakZone: C'est Stuart avec le Professeur Spear et le pop francais?</title>
			$episode = $1 if $entry =~ m{<title>\s*(.*?)\s*</title>};
	
			# <pubDate>Sun, 06 Jul 2008 20:00:00 +0100</pubDate>
			$available = $1 if $entry =~ m{<pubDate>\s*(.*?)\s*</pubDate>};
	
			# <description>Stuart and Justin discuss the sub-genre of French 'cold wave' in this week's module.</description>
			$desc = $1 if $entry =~ m{<description>\s*(.*?)\s*</description>};
	
			# Duration
			$duration = $1 if $entry =~ m{<itunes:duration>\s*(.*?)\s*</itunes:duration>};
	
			# build data structure
			$prog{$pid} = {
				'name'		=> $name,
				'versions'	=> 'default',
				'episode'	=> $episode,
				'desc'		=> $desc,
				'available'	=> $available,
				'duration'	=> $duration,
				'thumbnail'	=> $thumbnail,
				'channel'	=> $channel,
				'categories'	=> join(',', @category),
				'type'		=> 'podcast',
			};
		}
	}
	logger "\n";
	return 0;
}



# Feed info:
#	# Also see http://derivadow.com/2008/07/18/interesting-bbc-data-to-hack-with/
#	# All podcasts menu (iphone)
#	http://www.bbc.co.uk/radio/podcasts/ip/
#	# All radio1 podcasts
#	http://www.bbc.co.uk/radio/podcasts/ip/lists/radio1.sssi
#	# All radio1 -> moyles podcasts
#	http://www.bbc.co.uk/radio/podcasts/moyles/assets/iphone_keepnet.sssi
#	# RSS Feed (indexed from?)
#	http://downloads.bbc.co.uk/podcasts/radio1/moyles/rss.xml
#	# aod by channel see http://docs.google.com/View?docid=d9sxx7p_38cfsmxfcq
#	# http://www.bbc.co.uk/radio/aod/availability/<channel>.xml
#	# aod index
#	http://www.bbc.co.uk/radio/aod/index_noframes.shtml
# 	# schedule feeds
#	http://www.bbc.co.uk/bbcthree/programmes/schedules.xml
#	# These need drill-down to get episodes:
#	# TV schedules by date
#	http://www.bbc.co.uk/iplayer/widget/schedule/service/cbeebies/date/20080704
#	# TV schedules in JSON, Yaml or XML
#	http://www.bbc.co.uk/cbbc/programmes/schedules.(json|yaml|xml)
#	# TV index on programmes tv
#	http://www.bbc.co.uk/tv/programmes/a-z/by/*/player
#	# TV + Radio
#	http://www.bbc.co.uk/programmes/a-z/by/*/player
#	# All TV (limit has effect of limiting to 2.? times number entries kB??)
#	# seems that only around 50% of progs are available here compared to programmes site:
#	http://feeds.bbc.co.uk/iplayer/categories/tv/list/limit/200
#	# All Radio
#	http://feeds.bbc.co.uk/iplayer/categories/radio/list/limit/999
#	# New:
#	# iCal feeds see: http://www.bbc.co.uk/blogs/radiolabs/2008/07/some_ical_views_onto_programme.shtml
#	http://bbc.co.uk/programmes/b0079cmw/episodes/player.ics
#	# Other data
#	http://www.bbc.co.uk/cbbc/programmes/genres/childrens/player
#	http://www.bbc.co.uk/programmes/genres/childrens/schedules/upcoming.ics
#
# get_links( <radio|tv|podcast> )
sub get_links {
	my @cache;
	my $now = time();
	my $type = shift;

	# Open cache file (need to verify we can even read this)
	if ( open(CACHE, "< $cachefile{$type}") ) {
		# Get file contents less any comments
		@cache = grep !/^[\#\s]/, <CACHE>;
		close (CACHE);
	}

	# Read cache into %pid_old and %index_pid_old if cache exists
	my %prog_old;
	my %index_pid_old;
	if (@cache) {
		for (@cache) {
			# Populate %prog from cache
			chomp();
			my ($index, $type, $name, $pid, $available, $episode, $versions, $duration, $desc, $channel, $categories, $thumbnail, $timeadded) = split /\|/;
			# Create data structure with prog data
			$prog_old{$pid} = {
				'index'		=> $index,
				'name'		=> $name,
				'episode'	=> $episode,
				'desc'		=> $desc,
				'available'	=> $available,
				'duration'	=> $duration,
				'versions'	=> $versions,
				'channel'	=> $channel,
				'categories'	=> $categories,
				'thumbnail'	=> $thumbnail,
				'type'		=> $type,
				'timeadded'	=> $timeadded,
			};
			$index_pid_old{$index}	= $pid;
		}
	}

	# if a cache file doesn't exist/corrupted, flush option is specified or original file is older than $cache_sec then download new data
	if ( (! @cache) || (! -f $cachefile{$type}) || $opt{flush} || ($now >= ( stat($cachefile{$type})->mtime + $cache_secs )) ) {

		# Podcast only
		get_podcast_links() if $type eq 'podcast';

		# Radio and TV
		get_links_atom( $type, \%{$channels{$type}} ) if $type =~ /(tv|radio)/;

		# Sort indexes
		sort_indexes();
		
		# Open cache file for writing
		unlink $cachefile{$type};
		my $now = time();
		if ( open(CACHE, "> $cachefile{$type}") ) {
			print CACHE "#Index|Type|Name|Pid|Available|Episode|Versions|Duration|Desc|Channel|Categories|Thumbnail|TimeAdded\n";
			for (sort {$a <=> $b} keys %index_pid) {
				my $pid = $index_pid{$_};
				# Only write entries for correct prog type
				if ($prog{$pid}{type} eq $type) {
					# Merge old and new data to retain timestamps
					# if the entry was in old cache then retain timestamp from old entry
					if ( $prog_old{$pid}{timeadded} ) {
						$prog{$pid}{timeadded} = $prog_old{$pid}{timeadded};
					# Else this is a new entry
					} else {
						$prog{$pid}{timeadded} = $now;
						list_prog_entry( $pid, 'Added: ' );
					}
					# write to cache file
					print CACHE "$_|$prog{$pid}{type}|$prog{$pid}{name}|$pid|$prog{$pid}{available}|$prog{$pid}{episode}|$prog{$pid}{versions}|$prog{$pid}{duration}|$prog{$pid}{desc}|$prog{$pid}{channel}|$prog{$pid}{categories}|$prog{$pid}{thumbnail}|$prog{$pid}{timeadded}\n";
				}
			}
			close (CACHE);
		} else {
			logger "WARNING: Couldn't open cache file '$cachefile{$type}' for writing\n";
		}


	# Else copy data from existing cache file into existing %prog hash
	} else {
		$prog{$_} = $prog_old{$_} for keys %prog_old;
		$index_pid{$_} = $index_pid_old{$_} for keys %index_pid_old;
	}
	return 0;
}



# Usage: download_programme (<pid>)
sub download_programme {
	my $pid = shift;

	# Setup user-agent
	# Switch off automatic redirects
	my $ua = LWP::UserAgent->new( requests_redirectable => [] );
	# Setup user agent
	$ua->timeout([$lwp_request_timeout]);
	$ua->proxy( ['http'] => $proxy_url );
	$ua->cookie_jar( HTTP::Cookies->new( file => $cookiejar, autosave => 1, ignore_discard => 1 ) );

	my $dir = $download_dir{ $prog{$pid}{type} };
	$prog{$pid}{ext} = 'mov';

	# If were a podcast...
	if ( $prog{$pid}{type} eq 'podcast' ) {
		# Determine the correct filename and extension for this download
		my $filename_orig = $pid;
		$prog{$pid}{ext} = $pid;
		$filename_orig =~ s|^.+/(.+?)\.\w+$|$1|g;
		$prog{$pid}{ext} =~ s|^.*\.(\w+)$|$1|g;
		$prog{$pid}{fileprefix} = generate_download_filename_prefix($pid, $dir, $opt{fileprefix} || "<longname> - <episode> $filename_orig");
		$prog{$pid}{dir} = $dir;
		logger "\rINFO: File name prefix = $prog{$pid}{fileprefix}                  \n";
		my $file_done = "${dir}/$prog{$pid}{fileprefix}.$prog{$pid}{ext}";
		my $file = "${dir}/$prog{$pid}{fileprefix}.partial.$prog{$pid}{ext}";
		$prog{$pid}{filename} = $file_done;
		if ( -f $file_done ) {
			logger "WARNING: File $file_done already exists\n\n";
			return 1;
		}

		# Skip from here if we are only testing downloads
		return 1 if $opt{test};

		# Create symlink filename if required
		my $file_symlink;
		if ( $opt{symlink} ) {
			# Substitute the fields for the pid
			$file_symlink = substitute_fields( $pid, $opt{symlink} );
		}
		
		return download_podcast_stream( $ua, $pid, $file, $file_done, $file_symlink );
	}

	logger "INFO: Attempting to Download: $prog{$pid}{name} - $prog{$pid}{episode}\n";

	# Get version => pid hash
	my ( $type, $title, %version_pids ) = get_version_pids( $ua, $pid );

	# Extract Long Name, e.g.: iplayer.episode.setTitle("DIY SOS: Series 16: Swansea");
	$prog{$pid}{longname} = $title;

	# Strip off the episode name
	$prog{$pid}{longname} =~ s/^(.+):.*?$/$1/g;

	# Detect if this content is for radio
	my $usemp3 = 0;
	if ( $type eq 'radio' ) {

		# Display media stream data if required
		if ( $opt{streaminfo} ) {
			get_media_stream_data( $pid, $version_pids{'default'}, 'all' );
			return 1;
		}

		# Type is definitely radio
		$prog{$pid}{type} = 'radio';
		$dir = $download_dir{ $prog{$pid}{type} };

		# Check for mp3 stream  - unless realaudio option is specified
		if ( ! $opt{realaudio} ) {
			# Check for iphone mp3 radio stream
			if ( get_media_stream_data( $pid, $version_pids{default}, 'iphone' ) ) {
				$usemp3 = 1;
				$prog{$pid}{ext} = 'mp3';
				logger "INFO: MP3 stream media is available\n" if $opt{verbose};

			# if mp3audio option is specified do not fallback to realaudio
			} elsif ( $opt{mp3audio} ) {
				logger "ERROR: No MP3 stream media is available - not falling back to RealAudio\n";
				return 1;

			# if not then force realaudio option as fallback
			} else {
				$opt{realaudio} = 1;
				logger "INFO: No MP3 stream media is available - falling back to RealAudio\n" if $opt{verbose};
			}
		}

		# Use realplayer stream
		if ( $opt{realaudio} ) {

			# Check dependancies for radio programme transcoding / streaming
			# Check if we need 'tee'
			if ( (! exists_in_path($tee)) && $opt{stdout} && (! $opt{nowrite}) ) {
				logger "\nERROR: $tee does not exist in path, skipping\n";
				return 20;
			}
			# Check if we have mplayer and lame
			if ( (! $opt{wav}) && (! $opt{raw}) && (! exists_in_path($lame)) ) {
				logger "\nWARNING: Required $lame does not exist, falling back to wav mode\n";
				$opt{wav} = 1;
			}		
			if (! exists_in_path($mplayer)) {
				logger "\nERROR: Required $mplayer does not exist, skipping\n";
				return 20;
			}

			my $url_2 = get_media_stream_data( $pid, $version_pids{default}, 'realaudio' );
	
			logger "INFO: Version = $prog{$pid}{version}\n" if $opt{verbose};
			logger "INFO: Stage 2 URL = $url_2\n" if $opt{verbose};

			# Report error if no versions are available
			if ( ! $url_2 ) {
				logger "ERROR: No Stage 2 URL\n" if $opt{verbose};
				return 15;
			}

			# Determine the correct filenames for this download
			$prog{$pid}{ext} = 'mp3';
			$prog{$pid}{ext} = 'ra'  if $opt{raw};
			$prog{$pid}{ext} = 'wav' if $opt{wav};
			$prog{$pid}{fileprefix} = generate_download_filename_prefix( $pid, ${dir}, $opt{fileprefix} || "<longname> - <episode> <pid>" );
			logger "\rINFO: File name prefix = $prog{$pid}{fileprefix}                 \n";
			$prog{$pid}{dir} = $dir;
			my $file_done = "${dir}/$prog{$pid}{fileprefix}.$prog{$pid}{ext}";
			my $file = "${dir}/$prog{$pid}{fileprefix}.partial.$prog{$pid}{ext}";
			$prog{$pid}{filename} = $file_done;
			if ( -f $file_done ) {
				logger "WARNING: File $file_done already exists\n\n";
				return 1;
			}

			# Skip from here if we are only testing downloads
			return 1 if $opt{test};

			# Create symlink filename if required
			my $file_symlink;
			if ( $opt{symlink} ) {
				# Substitute the fields for the pid
				$file_symlink = substitute_fields( $pid, $opt{symlink} );
			}

			# Do the audio download
			return download_rtsp_stream( $ua, $url_2, $file, $file_done, $file_symlink, $pid );
		}

	} else {
		# Type is definitely tv
		$prog{$pid}{type} = 'tv';
		$dir = $download_dir{ $prog{$pid}{type} };
	}


	# iPhone mp3/h.264 stream downloading...

	# Check if we have vlc - if not use iPhone mode
	if ( $opt{n95} && (! exists_in_path($vlc)) ) {
		logger "\nWARNING: Required $vlc does not exist, falling back to iPhone mode\n";
		$opt{n95} = 0;
	}		


	my $url_2;
	my $got_url;
	
	# Do this for each version tried in this order (if they appaered in the content)
	for my $version ( @version_search_list ) {

		# Change $verpid to 'default' type if it exists, then Used 'signed' otherwise
		if ( $version_pids{$version} ) {
			logger "INFO: Checking existence of $version version\n";
			$prog{$pid}{version} = $version;
			logger "INFO: Version = $prog{$pid}{version}\n" if $opt{verbose};
			$url_2 = get_iphone_stream_download_url( $ua, $version_pids{$version} );
			$got_url = 1;
		}
		# Break out of loop if we have an actual URL
		last if $got_url && $url_2;
	}

	# Report error if no versions are available
	if ( ! $got_url ) {
		logger "ERROR: No versions exist for download\n";
		return 14;
	}

	# Display media stream data if required
	if ( $opt{streaminfo} ) {
		get_media_stream_data( $pid, $version_pids{'default'}, 'all' );
		return 1;
	}

	# Report error if failed to get URL for version
	if ( $got_url && ! $url_2 ) {
		logger "ERROR: No Stage 2 URL\n" if $opt{verbose};
		# If mp3 audio stream does not exist force realaudio mode and retry
		if ( $usemp3 && ! $opt{mp3audio}) {
			$opt{realaudio} = 1;
			return 'retry';
		}
		return 15;
	}
	
	# Determine the correct filenames for this download
	$prog{$pid}{fileprefix} = generate_download_filename_prefix( $pid, $dir, $opt{fileprefix} || "<longname> - <episode> <pid> <version>" );
	logger "\rINFO: File name prefix = $prog{$pid}{fileprefix}                 \n";
	$prog{$pid}{dir} = $dir;
	my $file_done = "${dir}/$prog{$pid}{fileprefix}.$prog{$pid}{ext}";
	my $file = "${dir}/$prog{$pid}{fileprefix}.partial.$prog{$pid}{ext}";
	$prog{$pid}{filename} = $file_done;
	if ( -f $file_done ) {
		logger "WARNING: File $file_done already exists\n\n";
		return 1;
	}

	# Create symlink filename if required
	my $file_symlink;
	if ( $opt{symlink} ) {
		# Substitute the fields for the pid
		$file_symlink = substitute_fields( $pid, $opt{symlink} );
	}

	# Skip from here if we are only testing downloads
	return 1 if $opt{test};

	# Get subtitles if they exist and are required
	my $subfile_done;
	my $subfile;
	if ( $opt{subtitles} ) {
		$subfile_done = "${dir}/$prog{$pid}{fileprefix}.srt";
		$subfile = "${dir}/$prog{$pid}{fileprefix}.partial.srt";
		download_subtitles( $ua, $subfile, $version_pids{ $prog{$pid}{version} } );
	}

	# Do the N95 h.264 download
	my $return;
	if ( $opt{n95} ) {
		my $url = get_media_stream_data( $pid, $version_pids{ $prog{$pid}{version} }, 'n95_wifi' );
		$return = download_h264_low_stream( $ua, $url, $file, $file_done );

	# Do the iPhone h.264 download
	} elsif ( $prog{$pid}{type} eq 'tv' ) {
		# Disable proxy here if required
		$ua->proxy( ['http'] => undef ) if $opt{partialproxy};
		$return = download_iphone_stream( $ua, $url_2, $file, $file_done, $file_symlink, 1 );
		# Re-enable proxy here if required
		$ua->proxy( ['http'] => $proxy_url ) if $opt{partialproxy};

	# Do the iPhone mp3 download
	} elsif ( $prog{$pid}{type} eq 'radio' ) {
		# Disable proxy here if required
		$ua->proxy( ['http'] => undef ) if $opt{partialproxy};
		$return = download_iphone_stream( $ua, $url_2, $file, $file_done, $file_symlink, 0 );
		# Re-enable proxy here if required
		$ua->proxy( ['http'] => $proxy_url ) if $opt{partialproxy};
		# If the iphone mp3 download fails then it's probably not ready yet so retry using realaudio
		$opt{realaudio} = 1 if $return eq 'retry';
	}
	
	# Rename the subtitle file accordingly
	move($subfile, $subfile_done) if $opt{subtitles} && -f $subfile;

	# Re-symlink file
	if ( $opt{symlink} ) {
		# remove old symlink
		unlink $file_symlink if -l $file_symlink;
		symlink $file_done, $file_symlink;
		logger "INFO: Created symlink from '$file_symlink' -> '$file_done'\n" if $opt{verbose};
	}

	return $return;
}



# Download Subtitles, convert to srt(SubRip) format and apply time offset
sub download_subtitles {
	my ( $ua, $file, $verpid ) = @_;
	my $suburl;
	my $subs;
	logger "INFO: Getting Subtitle metadata for $verpid\n" if $opt{verbose};
	$suburl = get_media_stream_data( undef, $verpid, 'subtitles' );

	# Return if we have no url
	if (! $suburl) {
		logger "INFO: Subtitles not available\n";
		return 2;
	}

	logger "INFO: Getting Subtitles from $suburl\n" if $opt{verbose};

	# Open subs file
	unlink($file);
	my $fh = open_file_append($file);

	# Download subs
	$subs = request_url_retry($ua, $suburl, 2);
	if (! $subs ) {
		logger "ERROR: Subtitle Download failed\n";
		return 1;
	} else {
		logger "INFO: Downloaded Subtitles\n";
	}

	# Convert the format to srt
	# SRT:
	#1
	#00:01:22,490 --> 00:01:26,494
	#Next round!
	#
	#2
	#00:01:33,710 --> 00:01:37,714
	#Now that we've moved to paradise, there's nothing to eat.
	#
	
	# TT:
	#<p begin="0:01:12.400" end="0:01:13.880">Thinking.</p>

	my $count = 1;
	my @lines = grep /<p\s+begin/, split /\n/, $subs;
	for ( @lines ) {
		my ( $begin, $end, $sub );
		$begin = $1 if m{begin="(.+?)"};
		$end =   $1 if m{end="(.+?)"};
		$sub =	 $1 if m{>(.+?)</p>};
		if ($begin && $end && $sub ) {
			$begin =~ s/\./,/g;
			$end =~ s/\./,/g;
			if ($opt{suboffset}) {
				$begin = subtitle_offset( $begin, $opt{suboffset} );
				$end = subtitle_offset( $end, $opt{suboffset} );
			}
			decode_entities($sub);
			# Write to file
			print $fh "$count\n";
			print $fh "$begin --> $end\n";
			print $fh "$sub\n\n";
			$count++;
		}
	}	
	close $fh;

	return 0;
}



# Returns an offset timestamp given an srt begin or end timestamp and offset in ms
sub subtitle_offset {
	my ( $timestamp, $offset ) = @_;
	my ( $hr, $min, $sec, $ms ) = split /[:,\.]/, $timestamp;
	# split into hrs, mins, secs, ms
	my $ts = $ms + $sec*1000 + $min*60*1000 + $hr*60*60*1000 + $offset;
	$hr = int( $ts/(60*60*1000) );
	$ts -= $hr*60*60*1000;
	$min = int( $ts/(60*1000) );
	$ts -= $min*60*1000;
	$sec = int( $ts/1000 );
	$ts -= $sec*1000;
	$ms = $ts;
	return "$hr:$min:$sec,$ms";
}



# Return hash of version => verpid given a pid
sub get_version_pids {
	my ( $ua, $pid ) = @_;
	my %version_pids;
	my $url = $prog_iplayer_metadata.$pid;

	logger "INFO: iPlayer metadata URL = $url\n" if $opt{verbose};
	logger "INFO: Getting version pids for programme $pid        \n" if ! $opt{verbose};

	# send request
	my $res = $ua->request( HTTP::Request->new( GET => $url ) );
	if ( ! $res->is_success ) {
		logger "\rERROR: Failed to get version pid metadata from iplayer site\n\n";
		return %version_pids;
	}

	# The URL http://www.bbc.co.uk/iplayer/playlist/<PID> contains for example:
	#<?xml version="1.0" encoding="UTF-8"?>                                   
	#<playlist xmlns="http://bbc.co.uk/2008/emp/playlist" revision="1">       
	#  <id>tag:bbc.co.uk,2008:pips:b00dlrc8:playlist</id>                     
	#  <link rel="self" href="http://www.bbc.co.uk/iplayer/playlist/b00dlrc8"/>
	#  <link rel="alternate" href="http://www.bbc.co.uk/iplayer/episode/b00dlrc8"/>
	#  <link rel="holding" href="http://www.bbc.co.uk/iplayer/images/episode/b00dlrc8_640_360.jpg" height="360" width="640" type="image/jpeg" />
	#  <title>Amazon with Bruce Parry: Episode 1</title>                                                                                        
	#  <summary>Bruce Parry begins an epic adventure in the Amazon following the river from source to sea, beginning  in the High Andes and visiting the Ashaninka tribe.</summary>                                                                                                        
	#  <updated>2008-09-18T14:03:35Z</updated>                                                                                                  
	#  <item kind="ident">                                                                                                                      
	#    <id>tag:bbc.co.uk,2008:pips:bbc_two</id>                                                                                               
	#    <mediator identifier="bbc_two" name="pips"/>                                                                                           
	#  </item>                                                                                                                                  
	#  <item kind="programme" duration="3600" identifier="b00dlr9p" group="b00dlrc8" publisher="pips">                                          
	#    <tempav>1</tempav>                                                                                                                     
	#    <id>tag:bbc.co.uk,2008:pips:b00dlr9p</id>                                                                                              
	#    <service id="bbc_two" href="http://www.bbc.co.uk/iplayer/bbc_two">BBC Two</service>                                                    
	#    <masterbrand id="bbc_two" href="http://www.bbc.co.uk/iplayer/bbc_two">BBC Two</masterbrand>                                            
	#
	#    <alternate id="default" />
	#    <guidance>Contains some strong language.</guidance>
	#    <mediator identifier="b00dlr9p" name="pips"/>      
	#  </item>
	#  <item kind="programme" duration="3600" identifier="b00dp4xn" group="b00dlrc8" publisher="pips">
	#    <tempav>1</tempav>
	#    <id>tag:bbc.co.uk,2008:pips:b00dp4xn</id>
	#    <service id="bbc_one" href="http://www.bbc.co.uk/iplayer/bbc_one">BBC One</service>
	#    <masterbrand id="bbc_two" href="http://www.bbc.co.uk/iplayer/bbc_two">BBC Two</masterbrand>
	#
	#    <alternate id="signed" />
	#    <guidance>Contains some strong language.</guidance>
	#    <mediator identifier="b00dp4xn" name="pips"/>
	#  </item>

	my $xml = $res->content;	
	# flatten
	$xml =~ s/\n/ /g;

	# Get title
	# <title>Amazon with Bruce Parry: Episode 1</title>
	my ( $title, $type );
	$title = $1 if $xml =~ m{<title>\s*(.+?)\s*<\/title>};

	# Get type
	$type = 'tv' if grep /kind="programme"/, $xml;
	$type = 'radio' if grep /kind="radioProgramme"/, $xml;

	# Split into <item kind="programme"> sections
	for ( split /<item\s+kind="(radioProgramme|programme)"/, $xml ) {
		logger "DEBUG: Block: $_\n" if $opt{debug};
		my ($verpid, $version);
		#  duration="3600" identifier="b00dp4xn" group="b00dlrc8" publisher="pips">
		$verpid = $1 if m{\s+duration=".*?"\s+identifier="(.+?)"};
		# <alternate id="default" />
		$version = lc($1) if m{<alternate\s+id="(.+?)"};
		next if ! ($verpid && $version);
		$version_pids{$version} = $verpid;
		logger "INFO: Version: $version, VersionPid: $verpid\n" if $opt{verbose};  
	}
	# Add to prog hash
	$prog{$pid}{versions} = join ',', keys %version_pids;
	return ( $type, $title, %version_pids );
}



# Gets media streams data for this version pid
# $media = all|flashhigh|flashnormal|iphone|flashwii|n95_wifi|n95_3g|mobile|flashaudio|realaudio|wma|subtitles
sub get_media_stream_data {
	my ( $pid, $verpid, $media ) = @_;
	my %streams;
	my $ua = LWP::UserAgent->new();
	# Setup user agent with redirection enabled
	$ua->timeout([$lwp_request_timeout]);
	$ua->proxy( ['http'] => $proxy_url );
	$ua->cookie_jar( HTTP::Cookies->new( file => $cookiejar, autosave => 1, ignore_discard => 1 ) );
	$opt{quiet} = 0 if $opt{streaminfo};
	logger "INFO: Getting media stream metadata for $prog{$pid}{name} - $prog{$pid}{episode}, $verpid\n" if $pid;
	my $xml1 = request_url_retry($ua, $media_stream_data_prefix.$verpid, 3, '', '');
	logger "\n$xml1\n" if $opt{debug};
	# flatten
	$xml1 =~ s/\n/ /g;

	for my $xml ( split /<media/, $xml1 ) {
		$xml = "<media".$xml;

		my ($server, $authstring, $identifier, $href);

		# h.264 high quality stream
		#	<media kind="video"
		#        width="640"
		#        height="360"
		#        type="video/mp4"
		#        encoding="h264"  >
		#        <connection
		#                priority="10"
		#                application="bbciplayertok"
		#                kind="level3"
		#                server="bbciplayertokfs.fplive.net"
		#                identifier="mp4:b000zxf4-H26490898078"
		#                authString="d52f77fede048f1ffd6587fd47446dee"
		#        />
		if ( $media =~ /^(flashhigh|all)$/ && $xml =~ m{<media\s+kind="video".+?type="video/mp4".+?encoding="h264".+?kind="level3"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?authString="(.+?)"} ) {
			( $server, $identifier, $authstring ) = ( $1, $2, $3 );
			logger "INFO: RTMP h.264 high quality stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  authstring=$authstring\n" if $opt{verbose};
			$streams{'flashhigh'} = "rtmp://${server}:1935/ondemand?_fcs_vhost=${server}&auth=${authstring}&aifp=v001&slist=${identifier}";
			logger "INFO: RTMP high quality stream URL: $streams{'flashhigh'}\n";
		}
	
		# h.264 normal quality stream
		#	<media kind="video"
		#        width="512"
		#        height="288"
		#        type="video/x-flv"
		#        encoding="vp6"  >
		#        <connection
		#                priority="10"
		#                kind="akamai"
		#                server="cp41752.edgefcs.net"
		#                identifier="secure/b000zxf4-streaming90898078"
		#                authString="daEdSdgbcaibFa7biaobCaYdadyaTamazbq-biXsum-cCp-FqrECnEoGBwFvwG"
		#        />
		#	</media>
		#
		if ( $media =~ /^(flashnormal|all)$/ && $xml =~ m{<media\s+kind="video".+?type="video/x-flv".+?encoding="vp6".+?kind="akamai"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?authString="(.+?)"} ) {
			( $server, $identifier, $authstring ) = ( $1, $2, $3 );
			logger "INFO: RTMP h.264 normal quality stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  authstring=$authstring\n" if $opt{verbose};
			$streams{'flashnormal'} = "rtmp://${server}:1935/ondemand?_fcs_vhost=${server}&auth=${authstring}&aifp=v001&slist=${identifier}";
			logger "INFO: RTMP normal quality stream URL: $streams{'flashnormal'}\n";
		}
	
		# Wii h.264 standard quality stream
		#<media kind="video"
		#        width="512"
		#        height="288"
		#        type="video/x-flv"
		#        encoding="spark"  >
		#        <connection
		#                priority="10"
		#                kind="akamai"
		#                server="cp41752.edgefcs.net"
		#                identifier="secure/5242138581547639062"
		#                authString="daEd8dLbGaPaZdzdNcwd.auaydJcxcHandp-biX5YL-cCp-BqsECnxnGEsHwyE"
		#        />
		#</media>
		if ( $media =~ /^(flashwii|all)$/ && $xml =~ m{<media\s+kind="video".+?type="video/x-flv".+?encoding="spark".+?kind="akamai"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?authString="(.+?)"} ) {
			( $server, $identifier, $authstring ) = ( $1, $2, $3 );
			logger "INFO: RTMP Wii normal quality stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  authstring=$authstring\n" if $opt{verbose};
			$streams{'flashwii'} = "rtmp://${server}:1935/ondemand?_fcs_vhost=${server}&auth=${authstring}&aifp=v001&slist=${identifier}";
			logger "INFO: RTMP Wii normal quality stream URL: $streams{'flashwii'}\n";
		}
	
		# iPhone h.264/mp3 stream
		#<media kind="video"
		#        width="480"
		#        height="272"
		#        type="video/mp4"
		#        encoding="h264"  >
		#        <connection
		#                priority="10"
		#                kind="sis"
		#                server="http://www.bbc.co.uk/mediaselector/3/auth/stream/"
		#                identifier="5242138581547639062"
		#                href="http://www.bbc.co.uk/mediaselector/3/auth/stream/5242138581547639062.mp4"
		#        />
		#</media>
		if ( $media =~ /^(iphone|all)$/ && $xml =~ m{<media\s+kind="video".+?type="video/mp4".+?encoding="h264".+?kind="sis"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?href="(.+?)"} ) {
			( $server, $identifier, $href ) = ( $1, $2, $3 );
			logger "INFO: iPhone stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  href=$href\n" if $opt{verbose};
			$streams{'iphone'} = "$href";
			logger "INFO: iPhone stream URL: $streams{'iphone'}\n";
		}
	
		# Nokia N95 h.264 low quality stream (WiFi)
		#<media kind="video"
		#        type="video/mpeg"
		#        encoding="h264"  >
		#        <connection
		#                priority="10"
		#                kind="sis"
		#                server="http://www.bbc.co.uk/mediaselector/4/sdp/"
		#                identifier="b00108ld/iplayer_streaming_n95_wifi"
		#                href="http://www.bbc.co.uk/mediaselector/4/sdp/b00108ld/iplayer_streaming_n95_wifi"
		#        />
		#</media>
		if ( $media =~ /^(n95_wifi|all)$/ && $xml =~ m{<media\s+kind="video".+?type="video/mpeg".+?encoding="h264".+?kind="sis"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?href="(.+?)"} ) {
			( $server, $identifier, $href ) = ( $1, $2, $3 );
			$opt{quiet} = 1 if $opt{streaminfo};
			chomp( my $rtsp = request_url_retry($ua, $href, 2, '', '') );
			$opt{quiet} = 0 if $opt{streaminfo};
			logger "INFO: Nokia N95 h.264 low quality WiFi stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  href=$href\n" if $opt{verbose};
			$streams{'n95_wifi'} = "$rtsp";
			logger "INFO: Nokia N95 h.264 low quality WiFi stream URL: $streams{'n95_wifi'}\n";
		}
	
		# Nokia N95 h.264 low quality stream (3G)
		#<media kind="" 
		#        expires="2008-10-30T12:29:00+00:00"
		#        type="video/mpeg"                  
		#        encoding="h264"  >                 
		#        <connection                        
		#                priority="10"              
		#                kind="sis"                 
		#                server="http://www.bbc.co.uk/mediaselector/4/sdp/" 
		#                identifier="b009tzxx/iplayer_streaming_n95_3g"     
		#                href="http://www.bbc.co.uk/mediaselector/4/sdp/b009tzxx/iplayer_streaming_n95_3g" 
		#        />                                                                                        
		#</media>    
		if ( $media =~ /^(n95_3g|all)$/ && $xml =~ m{<media\s+kind="".+?type="video/mpeg".+?encoding="h264".+?kind="sis"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?href="(.+?)"} ) {
			( $server, $identifier, $href ) = ( $1, $2, $3 );
			$opt{quiet} = 1 if $opt{streaminfo};
			chomp( my $rtsp = request_url_retry($ua, $href, 2, '', '') );
			$opt{quiet} = 0 if $opt{streaminfo};
			logger "INFO: Nokia N95 h.264 low quality 3G stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  href=$href\n" if $opt{verbose};
			$streams{'n95_3g'} = "$rtsp";
			logger "INFO: Nokia N95 h.264 low quality 3G stream URL: $streams{'n95_3g'}\n";
		}
	
	
	
		# Mobile WMV DRM
		#<media kind="video"
		#        expires="2008-10-20T21:59:00+01:00"
		#        type="video/wmv"   >
		#        <connection
		#                priority="10"
		#                kind="licence"
		#                server="http://iplayldsvip.iplayer.bbc.co.uk/WMLicenceIssuer/LicenceDelivery.asmx"
		#                identifier="0A1CA43B-98A8-43EA-B684-DA06672C0575"
		#                href="http://iplayldsvip.iplayer.bbc.co.uk/WMLicenceIssuer/LicenceDelivery.asmx/0A1CA43B-98A8-43EA-B684-DA06672C0575"
		#        />
		#<connection
		#                priority="10"
		#                kind="sis"
		#                server="http://directdl.iplayer.bbc.co.uk/windowsmedia/"
		#                identifier="AmazonwithBruceParry_Episode5_200810132100_mobile"
		#                href="http://directdl.iplayer.bbc.co.uk/windowsmedia/AmazonwithBruceParry_Episode5_200810132100_mobile.wmv"
		#        />
		#</media>
		if ( $media =~ /^(mobile|all)$/ && $xml =~ m{<media\s+kind="video".+?type="video/wmv".+?kind="sis"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?href="(.+?)"} ) {
			( $server, $identifier, $href ) = ( $1, $2, $3 );
			logger "INFO: Mobile WMV DRM stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  href=$href\n" if $opt{verbose};
			$streams{'mobile'} = "$href";
			logger "INFO: Mobile WMV DRM stream URL: $streams{'mobile'}\n";
		}
	
		# Audio rtmp mp3
		#<media kind="audio"
		#        type="audio/mpeg"
		#        encoding="mp3"  >
		#        <connection
		#                priority="10"
		#                kind="akamai"
		#                server="cp48181.edgefcs.net"
		#                identifier="mp3:secure/radio1/RBN2_mashup_b00d67h9_2008_09_05_22_14_25"
		#                authString="daEbQa1c6cda6aHdudxagcCcUcVbvbncmdK-biXtzq-cCp-DnoFIpznNBqHnzF"
		#        />
		#</media>
		if ( $media =~ /^(flashaudio|all)$/ && $xml =~ m{<media\s+kind="audio".+?type="audio/mpeg".+?encoding="mp3".+?kind="akamai"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?authString="(.+?)"} ) {
			( $server, $identifier, $authstring ) = ( $1, $2, $3 );
			# Remove offending mp3: at the start of the identifier
			$identifier =~ s/^mp3://;
			logger "INFO: RTMP MP3 stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  authstring=$authstring\n" if $opt{verbose};
			$streams{'flashaudio'} = "rtmp://${server}:1935/ondemand?_fcs_vhost=${server}&auth=${authstring}&aifp=v001&slist=${identifier}";
			logger "INFO: RTMP stream URL: $streams{'flashaudio'}\n";
		}
	
		# RealAudio stream
		#<media kind="audio"
		#       type="audio/real"
		#        encoding="real"  >
		#        <connection
		#                priority="10"
		#                kind="sis"
		#                server="http://www.bbc.co.uk"
		#                identifier="/radio/aod/playlists/9h/76/d0/0b/2000_bbc_radio_one"
		#                href="http://www.bbc.co.uk/radio/aod/playlists/9h/76/d0/0b/2000_bbc_radio_one.ram"
		#        />
		#</media>
		# Realaudio for worldservice	
		#<media kind=""
		#type="audio/real"
		#encoding="real"  >
		#<connection
		#        priority="10"
		#        kind="edgesuite"
		#        server="http://http-ws.bbc.co.uk.edgesuite.net"
		#        identifier="/generatecssram.esi?file=/worldservice/css/nb/410060838.ra"
		#        href="http://http-ws.bbc.co.uk.edgesuite.net/generatecssram.esi?file=/worldservice/css/nb/410060838.ra"
		#/>
		#</media>
		#</mediaSelection>
		if ( $media =~ /^(realaudio|all)$/ && $xml =~ m{<media\s+kind="(audio|)".+?type="audio/real".+?encoding="real".+?kind="(sis|edgesuite)"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?href="(.+?)"} ) {
			( $server, $identifier, $href ) = ( $3, $4, $5 );
			$opt{quiet} = 1 if $opt{streaminfo};
			chomp( my $rtsp = request_url_retry($ua, $href, 2, '', '') );
			$rtsp =~ s/[\s\n]//g;
			$opt{quiet} = 0 if $opt{streaminfo};
			logger "INFO: RealAudio RTSP stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  href=$href\n" if $opt{verbose};
			$streams{'realaudio'} = "$rtsp";
			logger "INFO: RealAudio RTSP stream URL: $streams{'realaudio'}\n";
		}
	
	
		# Radio WMA (low quality)
		#<mediaSelection xmlns="http://bbc.co.uk/2008/mp/mediaselection">
		#<media kind=""
		#        type="audio/wma"
		#        encoding="wma"  >
		#        <connection
		#                priority="10"
		#                kind="edgesuite"
		#                server="http://http-ws.bbc.co.uk.edgesuite.net"
		#                identifier="/generatecssasx.esi?file=/worldservice/css/nb/410060838"
		#                href="http://http-ws.bbc.co.uk.edgesuite.net/generatecssasx.esi?file=/worldservice/css/nb/410060838.wma"
		#        />
		#</media>
		if ( $media =~ /^(wma|all)$/ && $xml =~ m{<media\s+kind="(audio|)".+?type="audio/wma".+?encoding="wma".+?kind="(sis|edgesuite)"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?href="(.+?)"} ) {
			( $server, $identifier, $href ) = ( $3, $4, $5 );
			$opt{quiet} = 1 if $opt{streaminfo};
			chomp( my $mms = request_url_retry($ua, $href, 2, '', '') );
			$mms =~ s/[\n]//g;
			# HREF="mms://a1899.v394403.c39440.g.vm.akamaistream.net/7/1899/39440/1/bbcworldservice.download.akamai.com/39440//worldservice/css/nb/410060838.wma"
			$mms =~ s/^.*href=\"(.+?)\".*$/$1/gi;
			$opt{quiet} = 0 if $opt{streaminfo};
			logger "INFO: WMA MMS stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  href=$href\n" if $opt{verbose};
			$streams{'wma'} = "$mms";
			logger "INFO: WMA MMS stream URL: $streams{'wma'}\n";
		}
	
	
		# Subtitles stream
		#<media kind="captions"
		#        type="application/ttaf+xml"   >
		#        <connection
		#                priority="10"
		#                kind="http"
		#                server="http://www.bbc.co.uk/iplayer/subtitles/"
		#                identifier="b0008dc8rstreaming89808204.xml"
		#                href="http://www.bbc.co.uk/iplayer/subtitles/b0008dc8rstreaming89808204.xml"
		#        />
		#</media>
		if ( $media =~ /^(subtitles|all)$/ && $xml =~ m{<media\s+kind="captions".+?type="application/ttaf\+xml".+?kind="http"\s+server="(.+?)"\s+?identifier="(.+?)"\s+?href="(.+?)"} ) {
			( $server, $identifier, $href ) = ( $1, $2, $3 );
			logger "INFO: Subtitles stream:\nINFO:  server=$server\nINFO:  identifier=$identifier\nINFO:  href=$href\n" if $opt{verbose};
			$streams{'subtitles'} = "$href";
			logger "INFO: Subtitles stream URL: $streams{'subtitles'}\n";
		}
	}
	logger "\n" if $opt{streaminfo};
	$opt{quiet} = 1 if $opt{streaminfo};

	# Return a hash with media => url if 'all' is specified - otherwise just the specified url
	return %streams if $media eq 'all';
	return $streams{$media};
}



# Actually do the h.264/mp3 downloading
# ( $ua, $pid, $url_2, $file, $file_done, '0|1 == rearrange moov' )
sub download_iphone_stream {
	my ( $ua, $url_2, $file, $file_done, $file_symlink, $rearrange ) = @_;

	# Stage 3a: Download 1st byte to get exact file length
	logger "INFO: Stage 3 URL = $url_2\n" if $opt{verbose};

	# Override the $rearrange value is --raw option is specified
	$rearrange = 0 if $opt{raw};
	
	# Setup request header
	my $h = new HTTP::Headers(
		'User-Agent'	=> $user_agent{coremedia},
		'Accept'	=> '*/*',
		'Range'		=> 'bytes=0-1',
	);
	my $req = HTTP::Request->new ('GET', $url_2, $h);
	my $res = $ua->request($req);
	# e.g. Content-Range: bytes 0-1/181338136 (return if no content length returned)
	my $file_len = $res->header("Content-Range");
	if ( ! $file_len ) {
		logger "ERROR: No Content-Range was obtained\n" if $opt{verbose};
		return 'retry'
	}
	$file_len =~ s|^bytes 0-1/(\d+).*$|$1|;
	logger "INFO: Download File Length $file_len\n" if $opt{verbose};

	# Only do this if we're rearranging QT streams
	my $mdat_start = 0;
	my $moov_start = $file_len + 1;
	my $header;
	if ($rearrange) {
		# Get ftyp+wide header etc
		$mdat_start = 0x1c;
		my $buffer = download_block(undef, $url_2, $ua, 0, $mdat_start + 4);
		# Get bytes upto (but not including) mdat atom start -> $header
		$header = download_block(undef, $url_2, $ua, 0, $mdat_start - 1, $file_len);

		# Detemine moov start
		# Get mdat_end_offset_chars from downloaded block
		my $mdat_end_offset_chars = substr($buffer, $mdat_start, 4);
		my $mdat_end_offset = bytestring_to_int($mdat_end_offset_chars);
		logger "DEBUG: mdat_end_offset = ".get_hex($mdat_end_offset_chars)." = $mdat_end_offset\n" if $opt{debug};
		logger "DEBUG: mdat_end_offset (decimal) = $mdat_end_offset\n" if $opt{debug};
		# The MOOV box starts one byte after MDAT box ends
		$moov_start = $mdat_start + $mdat_end_offset;


		## scan 2nd level atoms in moov atom until we get stco atom(s)
		# We can skip first 8 bytes (moov atom header)
		#my $i = 8;
		#while( $i < $moov_length - 4 ) {
		#  my $atom_len = bytestring_to_int( substr($moovdata, $i, 4) );
		#  my $atom_name = substr($moovdata, $i+4, 4);
		#  logger "Parsing atom: $atom_name, length: $atom_len\n";
		#  # Increment $i by atom_len to get next atom
		#  $i += $atom_len;
		#}
	}

	# If we have partial content and wish to stream, resume the download & spawn off STDOUT from existing file start 
	# Sanity check - we cannot support downloading of partial content if we're streaming also. 
	if ( $opt{stdout} && (! $opt{nowrite}) && -f $file ) {
		logger "WARNING: Partially downloaded file exists, streaming will start from the beginning of the programme\n";
		# Don't do usual streaming code
		$opt{stdout} = 0;
		$childpid = fork();
		if (! $childpid) {
			# Child starts here
			logger "INFO: Streaming directly for partially downloaded file $file\n";
			if ( ! open( STREAMIN, "< $file" ) ) {
				logger "INFO: Cannot Read partially downloaded file to stream\n";
				exit 4;
			}
			my $outbuf;
			# Write out until we run out of bytes
			my $bytes_read = 65536;
			while ( $bytes_read == 65536 ) {
				$bytes_read = read(STREAMIN, $outbuf, 65536 );
				#logger "INFO: Read $bytes_read bytes\n";
				print STDOUT $outbuf;
			}
			close STREAMIN;
			logger "INFO: Stream thread has completed\n";
			exit 0;
		}
	}

	# Open file if required
	my $fh = open_file_append($file);

	# If the partial file already exists, then resume from the correct mdat/download offset
	my $restart_offset = $mdat_start;
	my $moovdata;
	my $moov_length = 0;

	if ($rearrange) {
		# if cookie fails then trigger a retry after deleting cookiejar
		# Determine moov atom length so we can work out if the partially downloaded file has the moov atom in it already
		$moov_length = bytestring_to_int( download_block( undef, $url_2, $ua, $moov_start, $moov_start+3 ) );
		logger "INFO: moov atom length = $moov_length                          \n" if $opt{verbose};
		# Sanity check this moov length - chances are that were being served up a duff file if this is > 10% of the file size or < 64k
		if ( $moov_length > (${moov_start}/9.0) || $moov_length < 65536 ) {
			logger "WARNING: Bad file download, deleting cookie                 \n";
			$ua->cookie_jar( HTTP::Cookies->new( file => $cookiejar, autosave => 0, ignore_discard => 0 ) );
			unlink $cookiejar;
			unlink $file;
			return 'retry';
		}
	}

	# If we have a too-small-sized file and not stdout and not no-write then this is a partial download
	if (-f $file && (! $opt{stdout}) && (! $opt{nowrite}) && stat($file)->size > ($moov_length+$mdat_start) ) {
		# Calculate new start offset (considering that we've put moov first in file)
		$restart_offset = stat($file)->size - $moov_length;
		logger "INFO: Resuming download from $restart_offset                        \n";
	}

	if ($rearrange) {
		# If we have no existing file, a file which doesn't yet even have the moov atom, or using stdout (or no-write option)
		if ( $opt{stdout} || $opt{nowrite} || stat($file)->size < ($moov_length+$mdat_start) ) {
			# get moov chunk into memory
			$moovdata = download_block( undef, $url_2, $ua, $moov_start, (${file_len}-1) );
			# Process the moov data so that we can relocate it (change the chunk offsets that are absolute)
			$moov_length = relocate_moov_chunk_offsets( $moovdata );
			# write moov atom to file next (yes - were rearranging the file - moov+header+mdat - not header+mdat+moov)
			logger "INFO: Appending moov+ftype+wide atoms to $file\n" if $opt{verbose};
			# Write moov atom
			print $fh $moovdata if ! $opt{nowrite};
			print STDOUT $moovdata if $opt{stdout};
			# Write header atoms (ftyp, wide)
			print $fh $header if ! $opt{nowrite};
			print STDOUT $header if $opt{stdout};
		}
	}

	# Create symlink if required
	if ( $opt{symlink} ) {
		# remove old symlink
		unlink $file_symlink if -l $file_symlink;
		symlink $file, $file_symlink;
		logger "INFO: Created symlink from '$file_symlink' -> '$file'\n" if $opt{verbose};
	}

	# Start marker
	my $start_time = time();

	# Download mdat in blocks
	my $chunk_size = $iphone_block_size;
	for ( my $s = $restart_offset; $s < ${moov_start}-1; $s+= $chunk_size ) {
		# get mdat chunk into file
		my $retcode;
		my $e;
		# Get block end offset
		if ( ($s + $chunk_size - 1) > (${moov_start}-1) ) {
			$e = $moov_start - 1;
		} else {
			$e = $s + $chunk_size - 1;
		}
		# Get block from URL and append to $file
		if ( download_block($file, $url_2, $ua, $s, $e, $file_len, $fh ) ) {
			logger "ERROR: Could not download block $s - $e from $file\n\n";
			return 9;
		}
	}

	# end marker
	my $end_time = time();

	# Should now be able to concatenate header.block + mdat.block + moov.block to get movie!
	# Calculate average speed, duration and total bytes downloaded
	logger sprintf("INFO: Downloaded %.2fMB in %s at %5.0fkbps to %s\n", 
		($moov_start - 1 - $restart_offset) / (1024.0 * 1024.0),
		sprintf("%02d:%02d:%02d", ( gmtime($end_time - $start_time))[2,1,0] ), 
		( $moov_start - 1 - $restart_offset ) / ($end_time - $start_time) / 1024.0 * 8.0, 
		$file_done );

	# Moving file into place as complete (if not stdout)
	move($file, $file_done) if ! $opt{stdout};
	return 0;
}



# Actually do the N95 h.264 downloading
sub download_h264_low_stream {
	my ( $ua, $url_2, $file, $file_done ) = @_;

	# Change filename extension
	$file =~ s/mov$/mpg/gi;
	$file_done =~ s/mov$/mpg/gi;

	logger "INFO: Stage 3 URL = $url_2\n" if $opt{verbose};
	if ( ! $opt{stdout} ) {
		logger "INFO: Downloading Low Quality H.264 stream\n";
		my $cmd = "$vlc $vlc_opts --sout file/ts:${file} $url_2 1>&2";
		if ( system($cmd) ) {
			return 2;
		}

	# to STDOUT
	} else {
		logger "INFO: Streaming Low Quality H.264 stream to stdout\n";
		my $cmd = "$vlc $vlc_opts --sout file/ts:- $url_2 1>&2";
		if ( system($cmd) ) {
			return 2;
		}	
	}
	logger "INFO: Downloaded $file_done\n";
	# Moving file into place as complete (if not stdout)
	move($file, $file_done) if ! $opt{stdout};
	return 0;
}



# Actually do the rtsp downloading
sub download_rtsp_stream {
	my ( $ua, $url, $file, $file_done, $file_symlink, $pid ) = @_;
	my $childpid;

	# Create named pipe
	if ( $^O !~ /^MSWin32$/ ) {
		mkfifo($namedpipe, 0700) if (! $opt{wav}) && (! $opt{raw});
	} else {
		logger "WARNING: fifos/named pipes are not supported\n" if $opt{verbose};
	}
	
	logger "INFO: Stage 3 URL = $url\n" if $opt{verbose};

	# Create ID3 tagging options for lame (escape " for shell)
	my ( $id3_name, $id3_episode, $id3_desc, $id3_channel ) = ( $prog{$pid}{name}, $prog{$pid}{episode}, $prog{$pid}{desc}, $prog{$pid}{channel} );
	$id3_name =~ s|"|\"|g for ($id3_name, $id3_episode, $id3_desc, $id3_channel);
	$lame_opts .= "--ignore-tag-errors --ty ".( (localtime())[5] + 1900 )." --tl \"$id3_name\" --tt \"$id3_episode\" --ta \"$id3_channel\" --tc \"$id3_desc\" ";

	# Use post-download transcoding using lame if namedpipes are not supported (i.e. ActivePerl/Windows)
	# (Fallback if no namedpipe support and raw/wav not specified)
	if ( (! -p $namedpipe) && ! ( $opt{raw} || $opt{wav} ) ) {
		my $cmd;
		# Remove filename extension
		$file =~ s/\.mp3$//gi;
		# Remove named pipe
		unlink $namedpipe;
		logger "INFO: Downloading wav format (followed by transcoding)\n";
		$cmd = "$mplayer $mplayer_opts -cache 128 -bandwidth $bandwidth -vc null -vo null -ao pcm:waveheader:fast:file=\"${file}.wav\" \"$url\" 1>&2";
		if ( system($cmd) ) {
			return 2;
		}
		# Transcode
		logger "INFO: Transcoding ${file}.wav\n";
		$cmd = "$lame $lame_opts \"${file}.wav\" \"${file}.mp3\" 1>&2";
		logger "DEGUG: Running $cmd\n" if $opt{debug};
		if ( system($cmd) ) {
			return 2;
		}
		unlink "${file}.wav";
		move "${file}.mp3", $file_done;
		$prog{$pid}{ext} = 'mp3';

	# Fork a child to do transcoding on the fly using a named pipe written to by mplayer
	# else do direct mplayer write to wav file if:
	#  1) we don't have a named pipe available (e.g. in activeperl)
	#  2) --wav was specified to write file only
	} elsif ( $opt{wav} && ! $opt{stdout} ) {
		logger "INFO: Writing wav format\n";
		# Start the mplayer process and write to wav file
		my $cmd = "$mplayer $mplayer_opts -cache 128 -bandwidth $bandwidth -vc null -vo null -ao pcm:waveheader:fast:file=\"$file\" \"$url\" 1>&2";
		logger "DEGUG: Running $cmd\n" if $opt{debug};
		if ( system($cmd) ) {
			return 2;
		}
		# Move file to done state
		move $file, $file_done if ! $opt{nowrite};

	# No transcoding if --raw was specified
	} elsif ( $opt{raw} && ! $opt{stdout} ) {
		# Write out to .ra ext instead (used on fallback if no fifo support)
		logger "INFO: Writing raw realaudio stream\n";
		# Start the mplayer process and write to raw file
		my $cmd = "$mplayer $mplayer_opts -cache 128 -bandwidth $bandwidth -dumpstream -dumpfile \"$file\" \"$url\" 1>&2";
		logger "DEGUG: Running $cmd\n" if $opt{debug};
		if ( system($cmd) ) {
			return 2;
		}
		# Move file to done state
		move $file, $file_done if ! $opt{nowrite};

	# Use transcoding via named pipes
	} else {
		$childpid = fork();
		if (! $childpid) {
			# Child starts here
			$| = 1;
			logger "INFO: Transcoding $file\n";

			# Stream mp3 to file and stdout simultaneously
			if ( $opt{stdout} && ! $opt{nowrite} ) {
				if ( $opt{wav} || $opt{raw} ) {
					# Race condition - closes named pipe immediately unless we wait
					sleep 5;
					tee($namedpipe, $file);
					#system( "cat $namedpipe 2>/dev/null| $tee $file");
				} else {
					my $cmd = "$lame $lame_opts $namedpipe - 2>/dev/null| $tee \"$file\"";
					logger "DEGUG: Running $cmd\n" if $opt{debug};
					system($cmd);
				}

			# Stream mp3 stdout only
			} elsif ( $opt{stdout} && $opt{nowrite} ) {
				if ( $opt{wav} || $opt{raw} ) {
					sleep 5;
					tee($namedpipe);
					#system( "cat $namedpipe 2>/dev/null");
				} else {
					my $cmd = "$lame $lame_opts $namedpipe - 2>/dev/null";
					logger "DEGUG: Running $cmd\n" if $opt{debug};
					system( "$lame $lame_opts $namedpipe - 2>/dev/null");
				}

			# Stream mp3 to file directly
			} elsif ( ! $opt{stdout} ) {
				my $cmd = "$lame $lame_opts $namedpipe \"$file\" >/dev/null 2>/dev/null";
				logger "DEGUG: Running $cmd\n" if $opt{debug};
				system($cmd);
			}
			# Remove named pipe
			unlink $namedpipe;

			# Move file to done state
			move $file, $file_done if ! $opt{nowrite};
			logger "INFO: Transcoding thread has completed\n";
			exit 0;
		}
		# Start the mplayer process and write to named pipe
		# Raw mode
		if ( $opt{raw} ) {
			my $cmd = "$mplayer $mplayer_opts -cache 32 -bandwidth $bandwidth -dumpstream -dumpfile $namedpipe \"$url\" 1>&2";
			logger "DEGUG: Running $cmd\n" if $opt{debug};
			if ( system($cmd) ) {
				# If we fail then kill off child processes
				kill 9, $childpid;
				return 2;
			}
		# WAV / mp3 mode
		} else {
			my $cmd = "$mplayer $mplayer_opts -cache 128 -bandwidth $bandwidth -vc null -vo null -ao pcm:waveheader:fast:file=$namedpipe \"$url\" 1>&2";
			if ( system($cmd) ) {
				# If we fail then kill off child processes
				kill 9, $childpid;
				return 2;
			}
		}
		# Wait for child processes to prevent zombies
		wait;
	}
	logger "INFO: Downloaded $file_done\n";

	# Create symlink if required
	if ( $opt{symlink} ) {
		# remove old symlink
		unlink $file_symlink if -l $file_symlink;
		symlink $file_done, $file_symlink;
		logger "INFO: Created symlink from '$file_symlink' -> '$file_done'\n" if $opt{verbose};
	}

	return 0;
}



# Actually do the podcast downloading
sub download_podcast_stream {
	my ( $ua, $url_2, $file, $file_done, $file_symlink ) = @_;
	my $start_time = time();

	# Set user agent
	$ua->agent( $user_agent{get_iplayer} );

	logger "INFO: Stage 3 URL = $url_2\n" if $opt{verbose};

	# Resume partial download?
	my $start = 0;
	if ( -f $file ) {
		$start = stat($file)->size;
		logger "INFO: Resuming download from $start\n";
	}

	my $fh = open_file_append($file);

	if ( download_block($file, $url_2, $ua, $start, undef, undef, $fh) != 0 ) {
		logger "ERROR: Download failed\n";
		return 22;
	} else {
		# end marker
		my $end_time = time();
		# Final file size
		my $size = stat($file)->size;
		# Calculate average speed, duration and total bytes downloaded
		logger sprintf("INFO: Downloaded %.2fMB in %s at %5.0fkbps to %s\n", 
			($size - $start) / (1024.0 * 1024.0),
			sprintf("%02d:%02d:%02d", ( gmtime($end_time - $start_time))[2,1,0] ), 
			( $size - $start ) / ($end_time - $start_time) / 1024.0 * 8.0, 
			$file_done );
		move $file, $file_done;
		# re-symlink file
		if ( $opt{symlink} ) {
			# remove old symlink
			unlink $file_symlink if -l $file_symlink;
			symlink $file_done, $file_symlink;
			logger "INFO: Created symlink from '$file_symlink' -> '$file_done'\n" if $opt{verbose};
		}
	}
	return 0;
}



# Get streaming iphone URL
sub get_iphone_stream_download_url {
		my $ua = shift;
		my $pid = shift;

		# Create url with appended 6 digit random number
		my $url_1 = ${iphone_download_prefix}.'/'.${pid}.'?'.(sprintf "%06.0f", 1000000*rand(0)).'%20';
		logger "INFO: media stream download URL = $url_1\n" if $opt{verbose};
		
		# Stage 2: e.g. "Location: http://download.iplayer.bbc.co.uk/iplayer_streaming_http_mp4/121285241910131406.mp4?token=iVXexp1yQt4jalB2Hkl%2BMqI25nz2WKiSsqD7LzRmowrwXGe%2Bq94k8KPsm7pI8kDkLslodvHySUyU%0ApM76%2BxEGtoQTF20ZdFjuqo1%2B3b7Qmb2StOGniozptrHEVQl%2FYebFKVNINg%3D%3D%0A"
		logger "\rGetting iplayer download URL         " if ! $opt{verbose};
		my $h = new HTTP::Headers(
			'User-Agent'	=> $user_agent{coremedia},
			'Accept'	=> '*/*',
			'Range'		=> 'bytes=0-1',
		);
		my $req = HTTP::Request->new ('GET', $url_1, $h);
		# send request
		my $res = $ua->request($req);
		# Get resulting Location header (i.e. redirect URL)
		my $url_2 = $res->header("location");
		if ( ! $res->is_redirect ) {
			logger "ERROR: Failed to get redirect from iplayer site\n\n";
			return '';
		}
		# Extract redirection Location URL
		$url_2 =~ s/^Location: (.*)$/$1/g;
		# If we get a Redirection containing statuscode=404 then this prog is not yet ready
		if ( $url_2 =~ /statuscode=404/ ) {
			logger "\rERROR: Programme is not yet ready for download\n";
			return '';
		}

		return $url_2;
}



# Get streaming audio URL (Real => rtsp)
#<media kind="audio"
#        type="audio/real"
#        encoding="real"  >
#        <connection
#                priority="10"
#                kind="sis"
#                server="http://www.bbc.co.uk"
#                identifier="/radio/aod/playlists/gs/5d/c0/0b/0900_bbc_radio_two"
#                href="http://www.bbc.co.uk/radio/aod/playlists/gs/5d/c0/0b/0900_bbc_radio_two.ram"
#        />
#</media>
# OR
#<media kind=""
#        type="audio/real"
#        encoding="real"  >
#        <connection
#                priority="10"
#                kind="edgesuite"
#                server="http://http-ws.bbc.co.uk.edgesuite.net"
#                identifier="/generatecssram.esi?file=/worldservice/css/nb/410591221152760.ra"
#                href="http://http-ws.bbc.co.uk.edgesuite.net/generatecssram.esi?file=/worldservice/css/nb/410591221152760.ra"
#        />
#</media>
#
sub get_audio_stream_download_url {
		my $ua = shift;
		my $url_1 = shift;
		my $url_2;
		
		logger "\rGetting iplayer download URL         " if ! $opt{verbose};
		my $h = new HTTP::Headers(
			'User-Agent'	=> $user_agent{coremedia},
			'Accept'	=> '*/*',
			'Range'		=> 'bytes=0-',
		);
		my $req = HTTP::Request->new ('GET', $url_1, $h);
		# send request
		my $res = $ua->request($req);
		# Get resulting content 
		my $content = $res->content;
		# Flatten
		$content =~ s/\n/ /g;
		if ( ! $res->is_success ) {
			logger "ERROR: Failed to get audio url from iplayer site\n\n";
			return '';
		}
		# If we get a Redirection containing statuscode=404 then this prog is not yet ready
		if ( $content =~ /statuscode=404/ ) {
			logger "\rERROR: Programme is not yet ready for download\n";
			return '';
		}
		# extract ram URL
		$url_2 = $2 if $content =~ m{<media kind="(|audio)"\s*type="audio/real".*href="(.+?)"\s*};

		# If we cannot see 'encoding="real"...' then we don't have real audio transcoded format then skip
		if ( ! $url_2 ) {
			logger "\rERROR: Programme is not yet ready for download in RealAudio format\n";
			return '';
		}

		return $url_2;
}



# Generate the download filename prefix given a pid and optional format such as '<longname> - <episode> <pid> <version>'
sub generate_download_filename_prefix {
	my ( $pid, $dir, $file ) = ( @_ );

	# If we dont have longname defined just set it to name
	$prog{$pid}{longname} = $prog{$pid}{name} if ! $prog{$pid}{longname};

	# substitute fields and sanitize $file
	$file = substitute_fields( $pid, $file );

	# Spaces
	$file =~ s/\s+/_/g if ! $opt{whitespace};

	# Don't create subdir if we are only testing downloads
	# Create a subdir for programme sorting option
	if ( $opt{subdir} && ! $opt{test} ) {
		my $subdir = substitute_fields( $pid, '<longname>' );
		$file = "${subdir}/${file}";
		# Create dir if it does not exist
		mkpath("${dir}/${subdir}") if ! -d "${dir}/${subdir}";
	}

	return $file;
}



# Usage: moov_length = relocate_moov_chunk_offsets(<binary string>)
sub relocate_moov_chunk_offsets {
	my $moovdata = $_[0];
	# Change all the chunk offsets in moov->stco atoms and add moov_length to them all
	# get moov atom length
	my $moov_length = bytestring_to_int( substr($moovdata, 0, 4) );
	# Use index() to seatch for a string within a string
	my $i = -1;
	while (($i = index($moovdata, 'stco', $i)) > -1) {

		# determine length of atom (4 bytes preceding stco)
		my $stco_len = bytestring_to_int( substr($moovdata, $i-4, 4) );
		logger "INFO: Found stco atom at moov atom offset: $i length $stco_len\n" if $opt{verbose};

		# loop through all chunk offsets in this atom and add offset (== moov atom length)
		for (my $j = $i+12; $j < $stco_len+$i-4; $j+=4) {
			my $chunk_offset = bytestring_to_int( substr($moovdata, $j, 4) );
			#logger "chunk_offset @ $i, $j = '".get_hex( substr($moovdata, $j, 4) )."',	$chunk_offset + $moov_length = ";
			$chunk_offset += $moov_length;
			# write back bytes into $moovdata
			substr($moovdata, $j+0, 1) = chr( ($chunk_offset >> 24) & 0xFF );
			substr($moovdata, $j+1, 1) = chr( ($chunk_offset >> 16) & 0xFF );
			substr($moovdata, $j+2, 1) = chr( ($chunk_offset >>  8) & 0xFF );
			substr($moovdata, $j+3, 1) = chr( ($chunk_offset >>  0) & 0xFF );
			#$chunk_offset = bytestring_to_int( substr($moovdata, $j, 4) );
			#logger "$chunk_offset\n";
		}

		# skip over this whole atom now it is processed
		$i += $stco_len;
	}
	# Write $moovdata back to calling string
	$_[0] = $moovdata;
	return $moov_length;
}



# Usage download_block($file, $url_2, $ua, $start, $end, $file_len, $fh);
#  ensure filehandle $fh is open in append mode
# or, $content = download_block(undef, $url_2, $ua, $start, $end, $file_len);
# Called in 4 ways:
# 1) write to real file			=> download_block($file, $url_2, $ua, $start, $end, $file_len, $fh);
# 2) write to real file + STDOUT	=> download_block($file, $url_2, $ua, $start, $end, $file_len, $fh); + $opt{stdout}==true
# 3) write to STDOUT only		=> download_block($file, $url_2, $ua, $start, $end, $file_len, $fh); + $opt{stdout}==true + $opt{nowrite}==false
# 4) write to memory (and return data)  => download_block(undef, $url_2, $ua, $start, $end, $file_len, undef);
# 4) write to memory (and return data)  => download_block(undef, $url_2, $ua, $start, $end);
sub download_block {

	my ($file, $url, $ua, $start, $end, $file_len, $fh) = @_;
	my $orig_length;
	my $buffer;
	my $lastpercent = 0;
	$now = time();

	# If this is an 'append to file' mode call
	if ( defined $file && $fh && (!$opt{nowrite}) ) {
		# Stage 3b: Download File
		$orig_length = tell $fh;
		logger "INFO: Appending to $file\n" if $opt{verbose};
	}

	# Setup request headers
	my $h = new HTTP::Headers(
		'User-Agent'	=> $user_agent{coremedia},
		'Accept'	=> '*/*',
		'Range'        => "bytes=${start}-${end}",
	);

	my $req = HTTP::Request->new ('GET', $url, $h);

	# Set time to use for download rate calculation
	# Define callback sub that gets called during download request
	# This sub actually writes to the open output file and reports on progress
	my $callback = sub {
		my ($data, $res, undef) = @_;
		# Don't write the output to the file if there is no content-length header
		return 0 if ( ! $res->header("Content-Length") );
		# If we don't know file length in advanced then set to size reported reported from server upon download
		$file_len = $res->header("Content-Length") + $start if ! defined $file_len;
		# Write output
		print $fh $data if ! $opt{nowrite};
		print STDOUT $data if $opt{stdout};
		# return if streaming to stdout - no need for progress
		return if $opt{stdout} && $opt{nowrite};
		return if $opt{quiet};
		# current file size
		my $size = tell $fh;
		# Download percent
		my $percent = 100.0 * $size / $file_len;
		# Don't update display if we haven't dowloaded at least another 0.1%
		return if ($percent - $lastpercent) < 0.1;
		$lastpercent = $percent;
		# download rates in bytes per second and time remaining
		my $rate_bps;
		my $rate;
		my $time;
		my $timecalled = time();
		if ($timecalled - $now < 1) {
			$rate = '-----kbps';
			$time = '--:--:--';
		} else {
			$rate_bps = ($size - $orig_length) / ($timecalled - $now);
			$rate = sprintf("%5.0fkbps", (8.0 / 1024.0) * $rate_bps);
			$time = sprintf("%02d:%02d:%02d", ( gmtime( ($file_len - $size) / $rate_bps ) )[2,1,0] );
		}
		printf STDERR "%8.2fMB / %.2fMB %s %5.1f%%, %s remaining         \r", 
			$size / 1024.0 / 1024.0, 
			$file_len / 1024.0 / 1024.0,
			$rate,
			$percent,
			$time,
		;
	};

	my $callback_memory = sub {
		my ($data, $res, undef) = @_;
		# append output to buffer
		$buffer .= $data;
		return if $opt{quiet};
		# current buffer size
		my $size = length($buffer);
		# download rates in bytes per second
		my $timecalled = time();
		my $rate_bps;
		my $rate;
		my $time;
		my $percent;
		# If we can get Content_length then display full progress
		if ($res->header("Content-Length")) {
			$file_len = $res->header("Content-Length") if ! defined $file_len;
			# Download percent
			$percent = 100.0 * $size / $file_len;
			return if ($percent - $lastpercent) < 0.1;
			$lastpercent = $percent;
			# Block length
			$file_len = $res->header("Content-Length");
			if ($timecalled - $now < 0.1) {
				$rate = '-----kbps';
				$time = '--:--:--';
			} else {
				$rate_bps = $size / ($timecalled - $now);
				$rate = sprintf("%5.0fkbps", (8.0 / 1024.0) * $rate_bps );
				$time = sprintf("%02d:%02d:%02d", ( gmtime( ($file_len - $size) / $rate_bps ) )[2,1,0] );
			}
			# time remaining
			printf STDERR "%8.2fMB / %.2fMB %s %5.1f%%, %s remaining         \r", 
				$size / 1024.0 / 1024.0,
				$file_len / 1024.0 / 1024.0,
				$rate,
				$percent,
				$time,
			;
		# Just used simple for if we cannot determine content length
		} else {
			if ($timecalled - $now < 0.1) {
				$rate = '-----kbps';
			} else {
				$rate = sprintf("%5.0fkbps", (8.0 / 1024.0) * $size / ($timecalled - $now) );
			}
			printf STDERR "%8.2fMB %s         \r", $size / 1024.0 / 1024.0, $rate;
		}
	};

	# send request
	logger "\nINFO: Downloading range ${start}-${end}\n" if $opt{verbose};
	logger "\r                              \r";
	my $res;

	# If $fh undefined then get block to memory (fh always defined for stdout or file d/load)
	if (defined $fh) {
		logger "DEBUG: writing stream to stdout, Range: $start - $end of $url\n" if $opt{verbose} && $opt{stdout};
		logger "DEBUG: writing stream to $file, Range: $start - $end of $url\n" if $opt{verbose} && !$opt{nowrite};
		$res = $ua->request($req, $callback);
		if (  (! $res->is_success) || (! $res->header("Content-Length")) ) {
			logger "ERROR: Failed to Download block\n\n";
			return 5;
		}
                logger "INFO: Content-Length = ".$res->header("Content-Length")."                               \n" if $opt{verbose};
		return 0;
		   
	# Memory Block
	} else {
		logger "DEBUG: writing stream to memory, Range: $start - $end of $url\n" if $opt{debug};
		$res = $ua->request($req, $callback_memory);
		if ( (! $res->is_success) ) {
			logger "ERROR: Failed to Download block\n\n";
			return '';
		} else {
			return $buffer;
		}
	}
}



# Converts a string of chars to it's HEX representation
sub get_hex {
        my $buf = shift || '';
        my $ret = '';
        for (my $i=0; $i<length($buf); $i++) {
                $ret .= " ".sprintf("%02lx", ord substr($buf, $i, 1) );
        }
	logger "DEBUG: HEX string value = $ret\n" if $opt{verbose};
        return $ret;
}



# Converts a string of chars to it's MSB decimal value
sub bytestring_to_int {
	# Reverse to LSB order
        my $buf = reverse shift;
        my $dec = 0;
        for (my $i=0; $i<length($buf); $i++) {
		# Multiply byte value by 256^$i then accumulate
                $dec += (ord substr($buf, $i, 1)) * 256 ** $i;
        }
        #logger "DEBUG: Decimal value = $dec\n" if $opt{verbose};
        return $dec;
}



# version of unix tee
# Usage tee ($infile, $outfile)
# If $outfile is undef then just cat file to STDOUT
sub tee {
	my ( $infile, $outfile ) = @_;
	# Open $outfile for writing, $infile for reading
	if ( $outfile) {
		if ( ! open( OUT, "> $outfile" ) ) {
			logger "ERROR: Could not open $outfile for writing\n";
			return 1;
		} else {
			logger "INFO: Opened $outfile for writing\n" if $opt{verbose};
		}
	}
	if ( ! open( IN, "< $infile" ) ) {
		logger "ERROR: Could not open $infile for reading\n";
		return 2;
	} else {
		logger "INFO: Opened $infile for reading\n" if $opt{verbose};
	}
	# Read and redirect IN
	while ( <IN> ) {
		print $_;
		print OUT $_ if $outfile;
	}
	# Close output file
	close OUT if $outfile;
	close IN;
	return 0;
}



# Usage: $fh = open_file_append($filename);
sub open_file_append {
	local *FH;
	my $file = shift;
	# Just in case we actually write to the file - make this /dev/null
	$file = '/dev/null' if $opt{nowrite};
	if ($file) {
		if ( ! open(FH, ">> $file") ) {
			logger "ERROR: Cannot write or append to $file\n\n";
			exit 1;
		}
	}
	# Fix for binary - needed for Windows
	binmode FH;
	return *FH;
}



# Updates and overwrites this script - makes backup as <this file>.old
sub update_script {
	# Get version URL
	my $script_file = $0;
	my $ua = LWP::UserAgent->new;
	$ua->timeout([$lwp_request_timeout]);
	$ua->proxy( ['http'] => $proxy_url );
	$ua->agent( $user_agent{update} );
	$ua->conn_cache(LWP::ConnCache->new());
	logger "INFO: Current version is $version\n";
	logger "INFO: Checking for latest version from linuxcentre.net\n";
	my $res = $ua->request( HTTP::Request->new( GET => $version_url ) );
	chomp( my $latest_ver = $res->content );
	if ( $res->is_success ) {
		# Compare version numbers
		if ( $latest_ver > $version ) {
			logger "INFO: New version $latest_ver available, downloading\n";
			# Check if we are writable
			if ( ! -w $script_file ) {
				logger "ERROR: $script_file is not writable by the current user - Update aborted\n";
				exit 1;
			}
			my $req = HTTP::Request->new ('GET', $update_url);
			# Save content into a $script_file
			my $res = $ua->request($req, $script_file.'.tmp');
			if ( ! -f $script_file.'.tmp' ) {
				logger "ERROR: Could not download update to ${script_file}.tmp - Update aborted\n";
				exit 1;
			}
			# If the download was successful then copy over this script and make executable after making a backup of this script
			if ( $res->is_success ) {
				if ( copy($script_file, $script_file.'.old') ) {
					move($script_file.'.tmp', $script_file);
					chmod 0755, $script_file;
					logger "INFO: Copied new version $latest_ver into place (previous version is now called '${script_file}.old')\n";
					logger "INFO: Please see: http://linuxcentre.net/get_iplayer/CHANGELOG.txt\n";
				} else {
					logger "ERROR: Could not create backup file ${script_file}.old - Update aborted\n";
					exit 1;
				}
			}
		} else {
			logger "INFO: No update is necessary (latest version = $latest_ver)\n";
		}
	} else {
		logger "ERROR: Failed to connect to update site - Update aborted\n";
		exit 2;
	}
	exit 0;
}



# Creates the Freevo FXD or MythTV Streams meta data (and pre-downloads graphics - todo)
sub create_xml {
	my $xmlfile = shift;
	if ( ! open(XML, "> $xmlfile") ) {
		logger "ERROR: Couldn't open xml file $xmlfile for writing\n";
		return 1;
	}
	print XML '<?xml version="1.0" ?>';
	print XML '<freevo>' if $opt{fxd};
	print XML "\n<MediaStreams>\n" if $opt{mythtv};

	if ( $opt{xmlnames} ) {
		# containers sorted by prog names
		print XML "\t<container title=\"iplayer by Programme Name\">\n" if $opt{fxd};
		my %program_index;
		my %program_count;
		# create hash of programme_name -> index
	        for (@_) {
	        	$program_index{$prog{$index_pid{$_}}{name}} = $_;
			$program_count{$prog{$index_pid{$_}}{name}}++;
		}
		for my $name ( sort keys %program_index ) {
			my @count = grep /^$name$/, keys %program_index;
			print XML "\t<container title=\"".encode_entities( $name )." ($program_count{$name})\">\n" if $opt{fxd};
			print XML "\t<Streams>\n" if $opt{mythtv};
			for (@_) {
				my $pid = $index_pid{$_};
				# loop through and find matches for each progname
				if ( $prog{$index_pid{$_}}{name} =~ /^$name$/ ) {
					my $episode = encode_entities( $prog{$pid}{episode} );
					my $desc = encode_entities( $prog{$pid}{desc} );
					my $title = "${episode} ($prog{$pid}{available})";
					print XML "<movie title=\"${title}\">
						<video><url id=\"p1\">${pid}.mov<playlist/></url></video>
						<info><description>${desc}</description></info>
					</movie>\n" if $opt{fxd};
					print XML "<Stream>
						<Name>\"${title}\"</Name>
						<url>${pid}.mov</url>
						<Subtitle></Subtitle>
						<Synopsis>${desc}</Synopsis>
					</Stream>\n" if $opt{mythtv};
				}
			}			
			print XML "\t</container>\n" if $opt{fxd};
			print XML "\t</Streams>\n" if $opt{mythtv};
		}
		print XML "\t</container>\n" if $opt{fxd};
	}


	if ( $opt{xmlchannels} ) {
		# containers for prog names sorted by channel
		print XML "\t<container title=\"iplayer by Channel\">\n" if $opt{fxd};
		my %program_index;
		my %program_count;
		my %channels;
		# create hash of unique channel names and hash of programme_name -> index
	        for (@_) {
	        	$program_index{$prog{$index_pid{$_}}{name}} = $_;
			$program_count{$prog{$index_pid{$_}}{name}}++;
			$channels{$prog{$index_pid{$_}}{channel}} .= '|'.$prog{$index_pid{$_}}{name}.'|';
		}
		for my $channel ( sort keys %channels ) {
			print XML "\t<container title=\"".encode_entities( $channel )."\">\n" if $opt{fxd};
			print XML "\t<Feed>
				\t<Name>".encode_entities( $channel )."</Name>
				\t<Provider>BBC</Provider>\n
				\t<Streams>\n" if $opt{mythtv};
			for my $name ( sort keys %program_index ) {
				# Do we have any of this prog $name on this $channel?
				if ( $channels{$channel} =~ /\|$name\|/ ) {
					my @count = grep /^$name$/, keys %program_index;
					print XML "\t<container title=\"".encode_entities( $name )." ($program_count{$name})\">\n" if $opt{fxd};
					print XML "\t\t<Stream>\n" if $opt{mythtv};
					for (@_) {
						# loop through and find matches for each progname for this channel
						my $pid = $index_pid{$_};
						if ( $prog{$pid}{channel} =~ /^$channel$/ && $prog{$pid}{name} =~ /^$name$/ ) {
							my $episode = encode_entities( $prog{$pid}{episode} );
							my $desc = encode_entities( $prog{$pid}{desc} );
							my $title = "${episode} ($prog{$pid}{available})";
							print XML "<movie title=\"${title}\">
								<video><url id=\"p1\">${pid}.mov<playlist/></url></video>
								<info><description>${desc}</description></info>
							</movie>\n" if $opt{fxd};
							print XML "\t\t<Name>$name</Name>\n\t\t<Url>${pid}.mov</Url>\n\t\t<Subtitle>${episode}</Subtitle>\n\t\t<Synopsis>${desc}</Synopsis>\n" if $opt{mythtv};
						}
					}
					print XML "\t</container>\n" if $opt{fxd};
					print XML "\t</Stream>\n" if $opt{mythtv};
				}
			}
			print XML "\t</container>\n" if $opt{fxd};
			print XML "\t</Streams>\n\t</Feed>\n" if $opt{mythtv};
		}
		print XML "\t</container>\n" if $opt{fxd};
	}


	if ( $opt{xmlalpha} ) {
		my %table = (
			'A-C' => '[abc]',
			'D-F' => '[def]',
			'G-I' => '[ghi]',
			'J-L' => '[jkl]',
			'M-N' => '[mn]',
			'O-P' => '[op]',
			'Q-R' => '[qt]',
			'S-T' => '[st]',
			'U-V' => '[uv]',
			'W-Z' => '[wxyz]',
			'0-9' => '[\d]',
		);
		print XML "\t<container title=\"iplayer A-Z\">\n";
		for my $folder (sort keys %table) {
			print XML "\t<container title=\"iplayer $folder\">\n";
			for (@_) {
				my $pid = $index_pid{$_};
				my $name = encode_entities( $prog{$pid}{name} );
				my $episode = encode_entities( $prog{$pid}{episode} );
				my $desc = encode_entities( $prog{$pid}{desc} );
				my $title = "${name} - ${episode} ($prog{$pid}{available})";
				my $regex = $table{$folder};
				if ( $name =~ /^$regex/i ) {
					print XML "<movie title=\"${title}\">
						<video><url id=\"p1\">${pid}.mov<playlist/></url></video>
						<info><description>${desc}</description></info>
					</movie>\n" if $opt{fxd};
					print XML "<Stream title=\"${title}\">
						<video><url id=\"p1\">${pid}.mov<playlist/></url></video>
						<info><description>${desc}</description></info>
					</Stream>\n" if $opt{mythtv};
				}
			}
			print XML "\t</container>\n";
		}
		print XML "\t</container>\n";
	}

	print XML '</freevo>' if $opt{fxd};
	print XML '</MediaStreams>' if $opt{mythtv};
	close XML;
}



sub create_html {
	# Create local web page
	if ( open(HTML, "> $opt{html}") ) {
		print HTML '<html><head></head><body><table border=1>';
		for (@_) {
			my $pid = $index_pid{$_};
			my $name = encode_entities( $prog{$pid}{name} );
			my $episode = encode_entities( $prog{$pid}{episode} );
			my $desc = encode_entities( $prog{$pid}{desc} );
			my $channel = encode_entities( $prog{$pid}{channel} );
			print HTML "<tr>
					<td rowspan=2 width=150><a href=\"${prog_page_prefix}/${pid}.html\"><img height=84 width=150 src=\"$prog{$pid}{thumbnail}\"></a></td>
					<td>$_</td>
					<td><a href=\"${prog_page_prefix}/${pid}.html\">${name}</a></td>
					<td>${episode}</td>
					<td>${channel}</td>
				</tr>
				<tr>
					<td colspan=5>${desc}</td>
				</tr>
			\n";
		}
		print HTML '</table></body>';
		close (HTML);
	} else {
		logger "Couldn't open html file $opt{html} for writing\n";
	}
}



# Save cmdline-only options to file
sub save_options_file {
	my $optfile = shift;
	unlink $optfile;
	logger "DEBUG: Saving options to $optfile:\n" if $opt{debug};
	open (OPT, "> $optfile") || die ("ERROR: Cannot save options to $optfile\n");
	# Save all opts except for these
	for (grep !/(help|test|debug|get)/, keys %opt_cmdline) {
		print OPT "$_ $opt_cmdline{$_}\n"  if defined $opt_cmdline{$_};
		logger "DEBUG: Setting cmdline option $_ = $opt_cmdline{$_}\n" if $opt{debug} && defined $opt_cmdline{$_};
	}
	close OPT;
	logger "INFO: Command Line Options saved as defult in $optfile\n";
	exit 0;
}



# Load default options from file
sub read_options_file {
	my $optfile = shift;
	return 0 if ! -f $optfile;
	logger "DEBUG: Parsing options from $optfile:\n" if $opt{debug};
	open (OPT, "< $optfile") || die ("ERROR: Cannot read options file $optfile\n");
	while(<OPT>) {
		/^\s*([\w\-_]+)\s+(.*)\s*$/;
		chomp( $opt{$1} = $2 );
		# keep track of which options came from files
		chomp( $opt_file{$1} = $2 );
		logger "DEBUG: Setting option $1 = $2\n" if $opt{debug};
	}
	close OPT;
}



# Display options from files
sub display_default_options {
	logger "Default options:\n";
	for ( grep !/(help|debug|get|^pvr)/, sort keys %opt_file ) {
		logger "\t$_ = $opt_file{$_}\n" if defined $opt_file{$_};
	}
	logger "\n";
	return 0;
}



# Display options currently set
sub display_current_options {
	logger "Current options:\n";
	for ( sort keys %opt ) {
		logger "\t$_ = $opt{$_}\n" if defined $opt{$_} && $opt{$_};
	}
	logger "\n";
	return 0;
}



# Get time ago made available (x days y hours ago) from '2008-06-22T05:01:49Z' and current time
sub get_available_time_string {
	my $datestring = shift;
	# extract $year $mon $mday $hour $min $sec
	$datestring =~ m{(\d\d\d\d)\-(\d\d)\-(\d\d)T(\d\d):(\d\d):(\d\d)Z};
	my ($year, $mon, $mday, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6);
	# Calculate the seconds difference between epoch_now and epoch_datestring and convert back into array_time
	my @time = gmtime( time() - timelocal($sec, $min, $hour, $mday, ($mon-1), ($year-1900), undef, undef, 0) );
	return "$time[7] days $time[2] hours ago";
}



# get full episode metadata given pid and ua. Uses two different urls to get data
sub get_pid_metadata {
	my $ua = shift;
	my $pid = shift;
	my $metadata;
	my $entry3;

	# This URL works for all prog types:
	# http://www.bbc.co.uk/iplayer/playlist/${pid}

	# This URL only works for TV progs:
	# http://www.bbc.co.uk/iplayer/metafiles/episode/${pid}.xml

	# This URL works for tv/radio prog types:
	# http://www.bbc.co.uk/iplayer/widget/episodedetail/episode/${pid}/template/mobile/service_type/tv/

	# This URL works for tv/radio prog types:
	# $prog_feed_url = http://feeds.bbc.co.uk/iplayer/episode/$pid

	if ( $prog{$pid}{type} =~ /(tv|radio)/i ) {
		$entry3 = request_url_retry($ua, $prog_feed_url.$pid, 3, '', '');
		decode_entities($entry3);
		logger "DEBUG: $prog_feed_url.$pid:\n$entry3\n\n" if $opt{debug};
		# Flatten
		$entry3 =~ s|\n| |g;
	}

	# Entry3 format
	#<?xml version="1.0" encoding="utf-8"?>                                      
	#<?xml-stylesheet href="http://www.bbc.co.uk/iplayer/style/rss.css" type="text/css"?>
	#<feed xmlns="http://www.w3.org/2005/Atom" xmlns:dcterms="http://purl.org/dc/terms/" xmlns:media="http://search.yahoo.com/mrss/" xml:lang="en-GB">
	#  <title>BBC iPlayer - Episode Detail: Edith Bowman: 22/09/2008</title>                                                                          
	#  <subtitle>Sara Cox sits in for Edith with another Cryptic Randomizer.</subtitle>
	#  <updated>2008-09-29T10:59:45Z</updated>
	#  <id>tag:feeds.bbc.co.uk,2008:/iplayer/feed/episode/b00djtfh</id>
	#  <link rel="related" href="http://www.bbc.co.uk/iplayer" type="text/html" />
	#  <link rel="self" href="http://feeds.bbc.co.uk/iplayer/episode/b00djtfh" type="application/atom+xml" />
	#  <author>
	#    <name>BBC</name>
	#    <uri>http://www.bbc.co.uk</uri>
	#  </author>
	#  <entry>
	#    <title type="text">Edith Bowman: 22/09/2008</title>
	#    <id>tag:feeds.bbc.co.uk,2008:PIPS:b00djtfh</id>
	#    <updated>2008-09-15T01:28:36Z</updated>
	#    <summary>Sara Cox sits in for Edith with another Cryptic Randomizer.</summary>
	#    <content type="html">
	#      &lt;p&gt;
	#        &lt;a href=&quot;http://www.bbc.co.uk/iplayer/episode/b00djtfh?src=a_syn30&quot;&gt;
	#          &lt;img src=&quot;http://www.bbc.co.uk/iplayer/images/episode/b00djtfh_150_84.jpg&quot; alt=&quot;Edith Bowman: 22/09/2008&quot; /&gt;
	#        &lt;/a&gt;
	#      &lt;/p&gt;
	#      &lt;p&gt;
	#        Sara Cox sits in for Edith with movie reviews and great new music, plus another Cryptic Randomizer.
	#      &lt;/p&gt;
	#    </content>
	#    <link rel="alternate" href="http://www.bbc.co.uk/iplayer/episode/b00djtfh?src=a_syn31" type="text/html" title="Edith Bowman: 22/09/2008">
	#      <media:content medium="audio" duration="10800">
	#        <media:title>Edith Bowman: 22/09/2008</media:title>
	#        <media:description>Sara Cox sits in for Edith with movie reviews and great new music, plus another Cryptic Randomizer.</media:description>
	#        <media:player url="http://www.bbc.co.uk/iplayer/episode/b00djtfh?src=a_syn31" />
	#        <media:category scheme="urn:bbc:metadata:cs:iPlayerUXCategoriesCS" label="Entertainment">9100099</media:category>
	#        <media:category scheme="urn:bbc:metadata:cs:iPlayerUXCategoriesCS" label="Music">9100006</media:category>
	#        <media:category scheme="urn:bbc:metadata:cs:iPlayerUXCategoriesCS" label="Pop &amp; Chart">9200069</media:category>
	#        <media:credit role="Production Department" scheme="urn:ebu">BBC Radio 1</media:credit>
	#        <media:credit role="Publishing Company" scheme="urn:ebu">BBC Radio 1</media:credit>
	#        <media:thumbnail url="http://www.bbc.co.uk/iplayer/images/episode/b00djtfh_86_48.jpg" width="86" height="48" />
	#        <media:thumbnail url="http://www.bbc.co.uk/iplayer/images/episode/b00djtfh_150_84.jpg" width="150" height="84" />
	#        <media:thumbnail url="http://www.bbc.co.uk/iplayer/images/episode/b00djtfh_178_100.jpg" width="178" height="100" />
	#        <media:thumbnail url="http://www.bbc.co.uk/iplayer/images/episode/b00djtfh_512_288.jpg" width="512" height="288" />
	#        <media:thumbnail url="http://www.bbc.co.uk/iplayer/images/episode/b00djtfh_528_297.jpg" width="528" height="297" />
	#        <media:thumbnail url="http://www.bbc.co.uk/iplayer/images/episode/b00djtfh_640_360.jpg" width="640" height="360" />
	#        <dcterms:valid>
	#          start=2008-09-22T15:44:20Z;
	#          end=2008-09-29T15:02:00Z;
	#          scheme=W3C-DTF
	#        </dcterms:valid>
	#      </media:content>
	#    </link>
	#    <link rel="self" href="http://feeds.bbc.co.uk/iplayer/episode/b00djtfh?format=atom" type="application/atom+xml" title="22/09/2008" />
	#    <link rel="related" href="http://www.bbc.co.uk/programmes/b006wks4/microsite" type="text/html" title="Edith Bowman" />
	#    <link rel="parent" href="http://feeds.bbc.co.uk/iplayer/programme_set/b006wks4" type="application/atom+xml" title="Edith Bowman" />
	#  </entry>
	#</feed>

	my ($duration, $available, $channel, $expiry, $longdesc, $versions, $guidance, $type, $categories);

	$expiry = $1 if $entry3 =~ m{<dcterms:valid>\s*start=.+?;\s*end=(.*?);};
	$available = $1 if $entry3 =~ m{<dcterms:valid>\s*start=(.+?);\s*end=.*?;};
	$duration = $1 if $entry3 =~ m{duration=\"(\d+?)\"};
	$type = $1 if $entry3 =~ m{medium=\"(\w+?)\"};
	$longdesc = $1 if $entry3 =~ m{<media:description>\s*(.*?)\s*<\/media:description>};
	$guidance = $1 if $entry3 =~ m{<media:rating scheme="urn:simple">(.+?)<\/media:rating>};

	my @cats;
	for (split /<media:category scheme=\".+?\"/, $entry3) {
		push @cats, $1 if m{\s*label="(.+?)">\d+<\/media:category>};
	}
	$categories = join ',', @cats;

	# populate version pid metadata 
	get_version_pids($ua, $pid);

	# Fill in from cache if not got from metadata
	$metadata .= "\nPid:\t\t$pid\n";
	$metadata .= "Index:\t\t$prog{$pid}{index}\n";
	$metadata .= "Type:\t\t".	($type || $prog{$pid}{type})		."\n";
	$metadata .= "Duration:\t".	($duration || $prog{$pid}{duration})	."\n";
	$metadata .= "Channel:\t".	($channel || $prog{$pid}{channel})	."\n";
	$metadata .= "Available:\t".	($available || $prog{$pid}{available})	."\n";
	$metadata .= "Expires:\t".	($expiry || $prog{$pid}{expiry})	."\n";
	$metadata .= "Versions:\t".	($versions || $prog{$pid}{versions})	."\n";
	$metadata .= "Guidance:\t".	($guidance || $prog{$pid}{guidance})	."\n";
	$metadata .= "Categories:\t".	($categories || $prog{$pid}{categories})."\n";
	$metadata .= "Description:\t".	($longdesc || $prog{$pid}{desc})	."\n";

	return $metadata;
}



# Gets the contents of a URL and retries if it fails, returns '' if no page could be retrieved
# Usage <content> = request_url_retry(<ua>, <url>, <retries>, <succeed message>, [<fail message>]);
sub request_url_retry {
	my ($ua, $url, $retries, $succeedmsg, $failmsg) = @_; 
	my $res;

	my $i;
	logger "INFO: Getting page $url\n" if $opt{verbose};
	for ($i = 0; $i < $retries; $i++) {
		$res = $ua->request( HTTP::Request->new( GET => $url ) );
		if ( ! $res->is_success ) {
			logger $failmsg;
		} else {
			logger $succeedmsg;
			last;
		}
	}
	# Return empty string if we failed
	return '' if $i == $retries;
	# otherwise return content
	return $res->content;
}



# Checks if a particular program exists (or program.exe) in the $ENV{PATH} or if it has a path already check for existence of file
sub exists_in_path {
	my $file = shift;
	# If this has a path specified, does file exist
	return 1 if $file =~ /[\/\\]/ && (-f $file || -f "${file}.exe");
	# Search PATH
	for (@PATH) {
		return 1 if -f "${_}/${file}" || -f "${_}/${file}.exe";
	}
	return 0;
}



# Run a user specified command
# e.g. --command 'echo "<pid> <longname> downloaded"'
# run_user_command($pid, 'echo "<pid> <longname> downloaded"');
sub run_user_command {
	my $pid = shift;
	my $command = shift;

	# Substitute the fields for the pid (don't sanitize)
	$command = substitute_fields( $pid, $command, 1 );

	# Escape chars in command for shell use
	esc_chars(\$command);

	# run command
	logger "INFO: Running command '$command'\n" if $opt{verbose};
	my $exit_value = system $command;
	
	# make exit code sane
	$exit_value = $exit_value >> 8;
	logger "ERROR: Command Exit Code: $exit_value\n" if $exit_value;
	logger "INFO: Command succeeded\n" if $opt{verbose} && ! $exit_value;
        return 0;
}



# Adds pid to history file (with a timestamp) so that it is not redownloaded after deletion
sub add_to_download_history {
	my $pid = shift;
	# Only add if a pid is specified
	return 0 if ! $pid;
	# Don't add to history if stdout streaming is used
	return 0 if ( $opt{stdout} && $opt{nowrite} ) || $opt{streaminfo};

	# Add to history
	if ( ! open(HIST, ">> $historyfile") ) {
		logger "WARNING: Cannot write or append to $historyfile\n\n";
		return 1;
	}
	print HIST "$pid|$prog{$pid}{name}|$prog{$pid}{episode}|$prog{$pid}{type}|".time()."\n";
	close HIST;
	return 0;
}



# returns a hash (<pid> => <data>) for all the pids in the history file
sub load_download_history {
	my %pids_downloaded;

	# Return if force-download option specified or stdout streaming only
	return %pids_downloaded if $opt{forcedownload} || $opt{stdout} || $opt{nowrite};

	logger "INFO: Loading download history\n" if $opt{verbose};
	if ( ! open(HIST, "< $historyfile") ) {
		logger "WARNING: Cannot read $historyfile\n\n";
		return 0;
	}
	while ( <HIST> ) {
		$pids_downloaded{$1} = $2 if m{^(.+?)\|(.*)$};
		logger "DEBUG: Loaded '$1' = '$2' from download history\n" if $opt{debug};
	}
	return %pids_downloaded;
}



# Checks history for previous download of this pid
sub check_download_history {
	my $pid = shift;
	my ($matchedpid, $name, $episode);
	return 0 if ! $pid;
		
	# Return if force-download option specified or stdout streaming only
	return 0 if $opt{forcedownload} || $opt{stdout} || $opt{nowrite};
	
	if ( ! open(HIST, "< $historyfile") ) {
		logger "WARNING: Cannot read $historyfile\n\n";
		return 0;
	}

	# Find and parse first matching line
	($matchedpid, $name, $episode) = ( split /\|/, (grep /^$pid/, <HIST>)[0] )[0,1,2];
	if ( $matchedpid ) {
		chomp $name;
		chomp $episode;
		logger "INFO: $name - $episode ($pid) Already in download history ($historyfile)\n";
		close HIST;
		return 1;

	} else {
		logger "INFO: Programme not in download history\n" if $opt{verbose};
		close HIST;
		return 0;
	}
}



# Add id3 tag to MP3 files if required
sub tag_file {
	my $pid = shift;
	if ( $prog{$pid}{ext} eq 'mp3' ) {
		# Create ID3 tagging options for external tagger program (escape " for shell)
		my ( $id3_name, $id3_episode, $id3_desc, $id3_channel ) = ( $prog{$pid}{name}, $prog{$pid}{episode}, $prog{$pid}{desc}, $prog{$pid}{channel} );
		$id3_name =~ s|"|\"|g for ($id3_name, $id3_episode, $id3_desc, $id3_channel);
		# Only tag if the required tool exists
		if ( exists_in_path($id3v2) ) {
			logger "INFO: id3 tagging MP3 file\n";
			my $cmd = "$id3v2 --artist \"$id3_channel\" --album \"$id3_name\" --song \"$id3_episode\" --comment \"Description\":\"$id3_desc\" --year ".( (localtime())[5] + 1900 )." \"$prog{$pid}{filename}\" 1>&2";
			logger "DEGUG: Running $cmd\n" if $opt{debug};
			if ( system($cmd) ) {
				logger "WARNING: Failed to tag MP3 file\n";
				return 2;
			}
		} else {
			logger "WARNING: Cannot tag MP3 file\n" if $opt{verbose};
		}
	}
}



# Show channels for specified type if required
sub list_unique_element_counts {
	my $element_name = shift;
	my %elements;
	logger "INFO: $opt{type} $element_name List:\n" if $opt{verbose};
	for my $pid (keys %prog) {
		for my $element ( split /,/, $prog{$pid}{$element_name} ) {
			$elements{ $element }++;
		}
	}
	# display element + prog count
	logger "$_ ($elements{$_})\n" for sort keys %elements;
	return 0;
}



# Escape chars in string for shell use
sub esc_chars {
	# will change, for example, a!!a to a\!\!a
	s/([;<>\*\|&\$!#\(\)\[\]\{\}:'"])/\\$1/g;
	return $_;
}



# Signal handler to clean up after a ctrl-c or kill
sub cleanup {
	logger "INFO: Cleaning up\n" if $opt{verbose};
	unlink $namedpipe;
	unlink $lockfile;
	exit 1;
}



# Return a string with formatting fields substituted for a given pid
sub substitute_fields {
	my $pid = shift;
	my $string = shift;
	my $no_sanitize = shift || 0;
	my $replace;
		
	# Tokenize and substitute $format
	for my $key ( keys %{ $prog{$pid} } ) {
		# Remove/replace all non-nice-filename chars if required
		if (! $no_sanitize) {
			$replace = sanitize_path( $prog{$pid}{$key} );
		} else {
			$replace = $prog{$pid}{$key};
		}
		$string =~ s|\<$key\>|$replace|gi;
	}
	if (! $no_sanitize) {
		$replace = sanitize_path( $pid );	
	} else {
		$replace = $pid;
	}
	$string =~ s|<pid>|$replace|gi;
	# Remove/replace all non-nice-filename chars if required except for fwd slashes
	return sanitize_path( $string, 1 );
}



# Make a filename/path sane (optionally allow fwd slashes)
sub sanitize_path {
	my $string = shift;
	my $allow_fwd_slash = shift || 0;

	# Remove fwd slash if reqd
	$string =~ s/\//_/g if ! $allow_fwd_slash;

	# Replace backslashes with _ regardless
	$string =~ s/\\/_/g;
	# Sanitize by default
	$string =~ s/\s/_/g if (! $opt{whitespace}) && (! $allow_fwd_slash);
	$string =~ s/[^\w_\-\.\/\s]//gi if ! $opt{whitespace};
	return $string;
}



# Save the options on the cmdline as a PVR search with the specified name
sub pvr_add {
	my $name = shift;
	my @search_args = @_;
	my @options;
	# validate name
	if ( $name !~ m{[\w\-\+]+} ) {
		logger "ERROR: Invalid PVR search name '$name'\n";
		retu