1#!/usr/local/bin/perl -w 2# 3# Copyright G. Westcott - September 2013 4# 5# This code is distributed under the GNU General Public License v2 (GPLv2) . 6# 7# For extended help information run 8# tv_grab_uk_atlas --info 9# 10 11# NOTE 2015-06-20 12# It seems Metabroadcast have (unannounced) switched off the anonymous bbc.co.uk feed. This feed was used by the XMLTV nightly tester. 13# The only way to get Atlas data now is via a personal API key. This means the nightly automated tester will report failure although 14# this grabber is working no problem. 15 16my $_version = '$Id: tv_grab_uk_atlas,v 1.30 2015/06/22 23:46:39 knowledgejunkie Exp $'; 17 18 19eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' 20 if 0; # not running under some shell 21 22use strict; 23use warnings; 24use constant { true => 1, false => 0 }; 25use Data::Dumper; 26 27use XMLTV; 28# perl-version safe $VERSION check 29my ($v1,$v2,$v3) = XMLTV->VERSION =~ /^(.*?)\.(.*?)\.(.*?)$/; 30if ( ($v1)+($v2/1000)+($v3/1000000) < 0.005064 ) { 31 print STDERR 'XMLTV version 0.5.64 required -- this is only version '.XMLTV->VERSION."\n"; 32 exit(1); 33 # 0.5.64 is required for fix to 'role' attribute in credits 34} 35 36use XMLTV::ProgressBar; 37use XMLTV::Options qw/ParseOptions/; 38use XMLTV::Supplement qw/GetSupplement SetSupplementRoot/; 39use XMLTV::Configure::Writer; 40use XMLTV::Ask; 41use XMLTV::Get_nice 0.005065; 42use XMLTV::Date 0.005066; 43 44use File::Path; 45use POSIX qw(strftime); 46use DateTime; 47use Date::Parse; 48use Encode; 49use URI::Escape; 50 51# Atlas can provide data in JSON and XML formsts - we use the JSON format (it's much faster than using xmltree) 52use JSON::PP; 53 54use HTTP::Cookies; 55use LWP::UserAgent; 56my $lwp = initialise_ua(); 57 58use subs qw(t warning); 59my $warnings = 0; 60 61 62 63# ------------------------------------------------------------------------------------------------------------------------------------- # 64# Grabber details 65my $VERSION = $_version; 66my $GRABBER_NAME = 'tv_grab_uk_atlas'; 67my $GRABBER_DESC = 'UK - Atlas (atlas.metabroadcast.com)'; 68my $GRABBER_URL = 'http://wiki.xmltv.org/index.php/XMLTVProject'; 69my $ROOT_URL = 'http://atlas.metabroadcast.com/3.0/'; 70my $SOURCE_NAME = 'MetaBroadcast Atlas'; 71my $SOURCE_URL = 'http://atlas.metabroadcast.com/'; 72# 73my $generator_info_name = $GRABBER_NAME; 74my $generator_info_url = $GRABBER_URL; 75my $source_info_name = $SOURCE_NAME; 76my $source_info_url = $SOURCE_URL; 77 78 79 80# ------------------------------------------------------------------------------------------------------------------------------------- # 81# Grabber limits 82 83# Atlas now produces an error if you ask for more than 14 days' worth of data (a strict 14*24 policy; i.e. with no accounting for BST->GMT transition) 84my $MAX_DAYS_TO_GRAB = 14; 85 86 87 88# Options.pm hi-jacks the --help arg and creates its own POD synopsis! This means we can't tell people about our added 89# parameters. I would posit that's a bug. Let's redefine the PrintUsage to our POD. 90my ($opt, $conf); 91{ 92 no warnings 'redefine'; 93 local *XMLTV::Options::PrintUsage = sub { 94 use Pod::Usage; pod2usage(-verbose => 0) 95 }; 96 use warnings 'redefine'; 97 98# ------------------------------------------------------------------------------------------------------------------------------------- # 99# Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should 100 ($opt, $conf) = ParseOptions({ 101 grabber_name => $GRABBER_NAME, 102 capabilities => [qw/baseline manualconfig apiconfig lineups cache/], 103 stage_sub => \&config_stage, 104 listchannels_sub => \&list_channels, 105 list_lineups_sub => \&list_lineups, 106 get_lineup_sub => \&get_lineup, 107 version => $VERSION, 108 description => $GRABBER_DESC, 109 extra_options => [qw/hours=i date=s dst channel=s/], 110 defaults => {'hours'=>0, 'channel'=>''} 111}); 112} 113#print Dumper($conf, $opt); exit; 114 115# any overrides? 116if (defined( $conf->{'generator-info-name'} )) { $generator_info_name = $conf->{'generator-info-name'}->[0]; } 117if (defined( $conf->{'generator-info-url'} )) { $generator_info_url = $conf->{'generator-info-url'}->[0]; } 118if (defined( $conf->{'source-info-name'} )) { $source_info_name = $conf->{'source-info-name'}->[0]; } 119if (defined( $conf->{'source-info-url'} )) { $source_info_url = $conf->{'source-info-url'}->[0]; } 120 121 122 123# ------------------------------------------------------------------------------------------------------------------------------------- # 124# Let's play nice and use a short-term cache to reduce load on Atlas site 125# Initialise the web page cache 126use HTTP::Cache::Transparent; 127init_cachedir( $conf->{cachedir}->[0] ); 128HTTP::Cache::Transparent::init( { 129 BasePath => $conf->{cachedir}->[0], 130 NoUpdate => 60*60, # cache time in seconds 131 MaxAge => 4, # flush time in hours 132 Verbose => $opt->{debug}, 133} ); 134 135 136# ------------------------------------------------------------------------------------------------------------------------------------- # 137# Used by the configure sub 138my @platforms; my %regions; 139my $selected_platform; my $selected_region; 140my $platform_title; my $region_title; 141 142 143# ------------------------------------------------------------------------------------------------------------------------------------- # 144# Check we have all our required conf params 145config_check(); 146 147# Load the conf file containing mapped channels and categories information 148my %mapchannelhash; 149my %mapcategoryhash; 150loadmapconf(); 151 152# Load the category (genre) mappings for Press Association data 153my %mapgenrehash; 154loadmapgenre(); 155 156 157 158# ------------------------------------------------------------------------------------------------------------------------------------- # 159# Progress Bar :) 160my $bar = new XMLTV::ProgressBar({ 161 name => "Fetching listings", 162 count => ( $opt->{'channel'} ne '' ? 1 : (scalar @{$conf->{channel}}) ) 163}) unless ($opt->{quiet} || $opt->{debug}); 164 165 166 167# ------------------------------------------------------------------------------------------------------------------------------------- # 168# Data store before being written as XML 169my $programmes = (); 170my $channels = (); 171 172# Start/Stop times for grabbing 173my $starttime; 174my $stoptime; 175 176# Get the schedule(s) from Atlas 177fetch_listings(); 178 179#print Dumper($programmes); 180 181# Progress Bar 182$bar->finish() && undef $bar if defined $bar; 183 184 185 186# ------------------------------------------------------------------------------------------------------------------------------------- # 187# Filter duplicate programmes 188if (defined $programmes) { 189 190$bar = new XMLTV::ProgressBar({ 191 name => "Filtering duplicates", 192 count => scalar @{$programmes} 193}) unless ($opt->{quiet} || $opt->{debug}); 194 195# Remove any duplicate programmes and set clumps where necessary 196filter_listings(); 197 198# Progress Bar 199$bar->finish() && undef $bar if defined $bar; 200 201} 202 203 204# ------------------------------------------------------------------------------------------------------------------------------------- # 205# Generate the XML 206my $encoding = 'UTF-8'; 207my $credits = { 'generator-info-name' => $generator_info_name, 208 'generator-info-url' => $generator_info_url, 209 'source-info-name' => $source_info_name, 210 'source-info-url' => $source_info_url }; 211 212XMLTV::write_data([ $encoding, $credits, $channels, $programmes ]); 213# Finished! 214 215 216 217# ------------------------------------------------------------------------------------------------------------------------------------- # 218# Signal that something went wrong if there were warnings. 219exit(1) if $warnings; 220 221# All data fetched ok. 222t "Exiting without warnings."; 223exit(0); 224 225 226# ############################################################################# 227# # THE MEAT ##################################################################### 228# ------------------------------------------------------------------------------------------------------------------------------------- # 229 230sub fetch_listings { 231 # Fetch listings per channel 232 233 # Specific channel requested on commandline? Else use normal conf file. 234 if ($opt->{'channel'} ne '') { 235 undef @{$conf->{channel}}; 236 push @{$conf->{channel}}, $opt->{'channel'}; 237 } 238 239 foreach my $channel_id (@{$conf->{channel}}) { 240 # 241 # Construct the url 242 # http://atlas.metabroadcast.com/3.0/schedule.json?apiKey=*****************&publisher=pressassociation.com&from=now&to=now.plus.6h&channel_id=cbbh&annotations=channel,brand_summary,series_summary,extended_description,broadcasts 243 # https://atlas.metabroadcast.com/3.0/schedule.json?channel_id=cbbh&publisher=bbc.co.uk&annotations=channel,description,broadcasts,brand_summary&from=2013-09-08T00:00:00.000Z&to=2013-09-09T00:00:00.000Z 244 245 # -------------------------------------------------------------------------------------------------------------------------------- # 246 # Get the 'from'/'to' times 247 # 248 # Atlas accepts from/to params of the form "2013-09-08T00:00:00.000Z" or like "now.plus.6h" or epoch times 249 # This grabber accepts either (i) --days and --offset or (ii) --hours and --offset or (iii) --date YYYYMMDD 250 # (in (i) the --offset is in days; in (ii) it's hours) 251 # 252 my $from = ''; 253 my $to = ''; 254 if ($opt->{offset} eq '') { $opt->{offset} = 0; } 255 256 if ($opt->{date}) { 257 $from = str2time( $opt->{date} ); 258 $to = $from + 86400; # this will be wrong the days that DST changes :( 259 # if the 'clocks have gone back' we need to fetch an extra hour 260 $to += 3600 if ((localtime($from))[8] == 1 && (localtime($to))[8] == 0); 261 # if the 'clocks have goneforward' the day is 1 hour shorter 262 $to -= 3600 if ((localtime($from))[8] == 0 && (localtime($to))[8] == 1); 263 264 } elsif ($opt->{hours}) { # test 'hours' first since 'days' has a default 265 $from = DateTime->now->add( hours => $opt->{offset} )->set_time_zone('UTC')->epoch(); 266 $to = $from + ($opt->{hours} * 3600); # todo: adjust for DST? 267 268 } elsif ($opt->{days}) { 269 $from = DateTime->today->add( days => $opt->{offset} )->set_time_zone('UTC')->epoch(); 270 $to = $from + ($opt->{days} * 86400); 271 272 # we need to fetch a 'calendar' day so we must adjust the times for DST 273 $from -= 3600 if ((localtime($from))[8] == 1); 274 $to -= 3600 if ((localtime($to))[8] == 1); 275 276 } else { # unlikely to get here since 'days' has a default 277 # default to today only (todo: adjust for DST) 278 $from = DateTime->today->set_time_zone('UTC')->epoch(); 279 $to = DateTime->today->add( days => 1 )->set_time_zone('UTC')->epoch(); 280 } 281 282 # Adjust for --dst param 283 $to += 3600 if ($opt->{dst}); 284 285 # Check we are within source site's max limit 286 $to = min($to, $from + ($MAX_DAYS_TO_GRAB * 86400)); 287 288 # Store the Start/Stop times for grabbing 289 $starttime = $from; 290 $stoptime = $to; 291 292 # testing above code for DST handling 293 # we're aiming for epoch times which cover a *calendar* day irrespective of DST 294 if (0) { 295 foreach (qw/20130330 20130331 20130401 20131026 20131027 20131028/) { 296 $from = DateTime->from_epoch( epoch=>str2time( $_ )+7200 )->truncate( to => 'day' )->add( days => $opt->{offset} )->set_time_zone('UTC')->epoch(); 297 $to = $from + ($opt->{days} * 86400); 298 print STDERR "$from --> $to \n"; 299 $from -= 3600 if ((localtime($from))[8] == 1); 300 $to -= 3600 if ((localtime($to))[8] == 1); 301 print STDERR "$from --> $to \n"; 302 print STDERR (localtime($from))[8] ." ".(localtime($to))[8] ."\n"; 303 print STDERR "$from --> $to \n" . DateTime->from_epoch( epoch=>$from )->set_time_zone('Europe/London')->strftime('%F %T %z').' -- '.DateTime->from_epoch( epoch=>$to )->set_time_zone('Europe/London')->strftime('%F %T %z')."\n----------\n" 304 } exit; 305 } 306 # debug 307 #print STDERR "$from --> $to \n" . DateTime->from_epoch( epoch=>$from )->set_time_zone('Europe/London')->strftime('%F %T %z').' -- '.DateTime->from_epoch( epoch=>$to )->set_time_zone('Europe/London')->strftime('%F %T %z')."\n" if $opt->{debug}; exit; 308 309 310 # -------------------------------------------------------------------------------------------------------------------------------- # 311 # translate the channel-id to Atlas' if it's a 'local' one 312 $channel_id = unmap_channel_id($channel_id); 313 314 my $baseurl = $ROOT_URL.'schedule.json'; 315 my $publisher = $conf->{'publisher'}->[0] || 'pressassociation.com'; # (undocumented option needed for xmltv automatic testing) 316 my $apiKey = $conf->{'api-key'}->[0]; 317 chomp($apiKey); chop($apiKey) if ($apiKey =~ m/\r$/); 318 if ($apiKey eq '' && $publisher ne 'bbc.co.uk') { 319 print STDERR 'You must obtain a free API key from http://atlas.metabroadcast.com/ before you can use this grabber'."\n"; 320 print STDERR 'Instructions are available at http://metabroadcast.com/blog/create-and-manage-your-atlas-api-key'."\n"; 321 exit(1); 322 } 323 $apiKey = '&apiKey='.$apiKey if ($apiKey ne ''); 324 my $annotations = 'extended_description,broadcasts,series_summary,brand_summary,people,channel'; 325 326 my $url = $baseurl.'?'."channel_id=$channel_id&from=$from&to=$to&annotations=$annotations&publisher=$publisher$apiKey"; 327 print $url ."\n" if ($opt->{debug}); 328 #print STDERR "$url \n"; 329 330 if (1) { 331 332 # If we need to map the fetched channel_id to a different value 333 my $xmlchannel_id = $channel_id; 334 if (defined(&map_channel_id)) { $xmlchannel_id = map_channel_id($channel_id); } 335 my $channelname = $xmlchannel_id; 336 my $channelicon = ''; 337 338 # Fetch the page 339 my $res = $lwp->get( $url ); 340 341 if ($res->is_success) { 342 get_schedule_from_json($xmlchannel_id, $res->content, \$channelname, \$channelicon); 343 } else { 344 # get the specific error if poss 345 my $error = ''; 346 if ($res->content) { 347 my $data = JSON::PP->new()->utf8(1)->decode($res->content); 348 $error = $data->{'error'}->{'message'} if defined $data->{'error'}->{'message'}; 349 } 350 # error - format as a valid http status line for cgi script 351 print STDERR "Status: ".$res->status_line.($error ne ''?" ($error)":'')."\n"; 352 } 353 354 # Add to the channels hash 355 $channels->{$channel_id} = { 'id'=> $xmlchannel_id , 'display-name' => [[ codify( $channelname), 'en']] }; 356 $channels->{$channel_id}->{'icon'} = [{'src' => $channelicon }] if $channelicon; 357 358 $bar->update if defined $bar; 359 } 360 } 361} 362 363# ------------------------------------------------------------------------------------------------------------------------------------- # 364 365sub get_schedule_from_json { 366 # Extract the schedule for this channel. 367 # 368 # Credit: Gordon M.Lack (http://birdman.dynalias.org/xmltv-from-Atlas/) for some of the original data abstraction principles used here. 369 # 370 371 my( $channel_id, $input, $channelname, $channelicon ) = @_; 372 my $data = JSON::PP->new()->utf8(1)->decode($input); 373 $input = undef; 374 375 ${$channelname} = $data->{'schedule'}[0]->{'channel_title'}; 376 ${$channelicon} = $data->{'schedule'}[0]->{'channel'}->{'image'}; 377 378 my $prog_item = $data->{'schedule'}[0]->{'items'}; 379 foreach my $p (@$prog_item) { 380 my %prog = %$p; 381 382 my %item = (); 383 384 # "What is on the item is the episode title. To get the brand title (which is normally what you will want to display in a schedule) 385 # you need to take the title of the parent container (which you can include using the brand_summary annotation). 386 # Where an item is not in a container, the item title should be used. 387 # Title is: container.title or item.title if no container 388 # Subtitle is: item.title if container, otherwise empty" (Jonathan Tweed) 389 # 390 # e.g. "title": "Ford's Dagenham Dream", (with no "brand" container) 391 # gives title = Ford's Dagenham Dream episode = 392 # but 393 # "title": "Fatal Attraction", 394 # "container": { "title": "The Sky at Night", ... "type": "brand" } 395 # gives title = The Sky at Night episode = Fatal Attraction 396 # 397 # But https://docs.metabroadcast.com/display/ATLAS/Display+title refers to a "series" entity. I've never seen one 398 # (not sure if they actually mean "series_summary") but let's try and allow for one anyway: 399 # 400 if ( (exists $prog{'container'}) && ( $prog{'container'}->{'type'} eq 'brand' ) && $prog{'container'}->{'title'} ) { 401 $item{'title'} = $prog{'container'}->{'title'}; 402 $item{'episodetitle'} = ''; 403 404 if ( (exists $prog{'series'}) && $prog{'series'}->{'title'} && ( $prog{'series'}->{'title'} ne $prog{'container'}->{'title'} ) ) { 405 $item{'episodetitle'} = $prog{'series'}->{'title'} . ': '; 406 } 407 if ( (exists $prog{'series_summary'}) && $prog{'series_summary'}->{'title'} && ( $prog{'series_summary'}->{'title'} ne $prog{'container'}->{'title'} ) ) { 408 $item{'episodetitle'} = $prog{'series_summary'}->{'title'} . ': '; 409 } 410 411 if ( $prog{'title'} && ($prog{'title'} ne $prog{'container'}->{'title'} ) ) { 412 $item{'episodetitle'} .= $prog{'title'}; 413 } elsif ( $prog{'first_broadcast'} ) { # never seen one of these - what format is it? 414 $item{'episodetitle'} .= 415 DateTime->from_epoch( epoch => str2time( $prog{'first_broadcast'} ) )->set_time_zone('Europe/London')->strftime("%d/%m/%Y"); 416 } 417 418 } else { 419 $item{'title'} = defined($prog{'title'}) ? $prog{'title'} : ''; 420 $item{'episodetitle'} = ''; 421 } 422 423 $item{'desc'} = defined($prog{'description'}) ? $prog{'description'} : ''; 424 $item{'epno'} = defined($prog{'episode_number'}) ? $prog{'episode_number'} : ''; 425 $item{'seriesno'} = defined($prog{'series_number'}) ? $prog{'series_number'} : ''; 426 $item{'totaleps'} = ''; 427 if ( (exists $prog{'series_summary'}) && ($prog{'series_summary'}->{'type'} eq 'series') ) { 428 $item{'totaleps'} = defined($prog{'series_summary'}->{'total_episodes'}) ? $prog{'series_summary'}->{'total_episodes'} : ''; 429 } 430 431 # get the Atlasobject "id"s 432 $item{'itemid'} = defined($prog{'id'}) ? $prog{'id'} : ''; 433 $item{'seriesid'} = ( defined($prog{'series_summary'}->{'id'}) && ( $prog{'series_summary'}->{'type'} eq 'series' ) ) ? $prog{'series_summary'}->{'id'} : ''; 434 $item{'brandid'} = ( defined($prog{'container'}->{'id'}) && ( $prog{'container'}->{'type'} eq 'brand' ) ) ? $prog{'container'}->{'id'} : ''; 435 436 $item{'image'} = defined($prog{'image'}) ? $prog{'image'} : ''; 437 $item{'media'} = defined($prog{'media_type'}) ? $prog{'media_type'} : ''; 438 $item{'year'} = defined($prog{'year'}) ? $prog{'year'} : ''; 439 $item{'film'} = (defined($prog{'type'}) && $prog{'type'} eq 'film') ? true : false; 440 $item{'black_and_white'} = (defined($prog{'black_and_white'}) && $prog{'black_and_white'} eq 'false') ? true : false; 441 $item{'star_rating'} = ''; # sadly not available in Atlas :-( 442 $item{'certificate'} = ''; 443 $item{'certificate_code'} = ''; 444 if (exists $prog{'certificates'}) { 445 $item{'certificate'} = defined($prog{'certificates'}[0]->{'classification'}) ? $prog{'certificates'}[0]->{'classification'} : ''; 446 $item{'certificate_code'} = defined($prog{'certificates'}[0]->{'code'}) ? $prog{'certificates'}[0]->{'code'} : ''; 447 } 448 449 # Store all the (unique) genres (aka categories). Map them to alternative name if requested. 450 # 451 # 6-Mar-2014 452 # We use a hash to store the genres to avoid manually de-duping the list. However, using a hash means the 453 # output order of the categories is indeterminate (& varies). 454 # To assist those PVRs which can only handle 1 category/genre per programme we will have to sort the keys. 455 # 456 # It seems the categories ("genres") added by Atlas are intended to be a top-level category (the PA ones are quite 457 # detailed (and unnecessarily so in some cases). So we'll output the Atlas genres first and then the PA ones. 458 # PVRs which can handle multiple categories won't care, and those which can handle only 1 category will get a 459 # top-level category (assuming Atlas have added one) rather than a sub-category. 460 # (Aside: I don't know how those single-cat PVRs cope with films; they will all come out as "Film" with no clue 461 # whatsoever as to what the film is about! That seems like a tremendous oversight IMO.) 462 # 463 # In an ideal world the XMLTV DTD would differentiate between top-level categories and sub-categories; but it doesn't. 464 # 465 # Atlas don't say if the order of the Atlas genres (when there's more than 1) is important - I think it merely reflects 466 # the order of the PA codes in their database (which in itself is random?) 467 # 468 # Although the PA genres usually come first this isn't always the case (I've seen them jumbled up e.g. "Daily Politics" on BBC2) 469 # Also note there might not be an Atlas category at all! 470 # 471 # Atlas genres are here: https://github.com/atlasapi/atlas-model/blob/master/src/main/java/org/atlasapi/genres/AtlasGenre.java 472 # PA genres are here: https://docs.metabroadcast.com/display/ATLAS/PA+Genres 473 # 474 # 475 $item{'genres'} = {}; # use a hash so we can auto-ignore duplicate values 476 my $i = 0; 477 foreach my $gtext (@{$prog{'genres'}}) { 478 $i++; 479 if ($gtext =~ m|^http://pressassociation.com/genres/(.*)|) { 480 foreach ( map_category( uc_words( map_PA_category($1) ) ) ) { 481 # $item{'genres'}->{ $_ } = 1; 482 $item{'genres'}->{ $_ } = $i | 32 if !defined $item{'genres'}->{ $_ } ; 483 } 484 # (nb: if genre not found then the code will be passed through to XML - this way we can spot any which are missing 485 } 486 elsif ( $gtext =~ m|^http://ref.atlasapi.org/genres/atlas/(.*)|) { 487 foreach ( map_category( uc_words( $1 ) ) ) { 488 # $item{'genres'}->{ $_ } = 1; 489 $item{'genres'}->{ $_ } = $i if ( !defined $item{'genres'}->{ $_ } || $item{'genres'}->{ $_ } > (0 | 32) ); 490 } 491 } 492 } 493 494 495 # Get the people information 496 # (note: Although Presenter is a defined <role> it seems Commentator and Presenter are defined with <role> = 'actor' 497 # e.g. <character>Presenter</character> <displayRole>Actor</displayRole> <name>Suzi Perry</name> <role>actor</role> 498 # <character>Commentator</character> <displayRole>Actor</displayRole> <name>David Coulthard</name> <role>actor</role> 499 # "CrewMember" - https://github.com/atlasapi/atlas-model/blob/master/src/main/java/org/atlasapi/media/entity/CrewMember.java 500 # 501 # <!ELEMENT credits (director*, actor*, writer*, adapter*, producer*, composer*, editor*, presenter*, commentator*, guest* )> 502 # 503 foreach my $person (@{$prog{'people'}}) { 504 SWITCH: { 505 $person->{'role'} eq 'director' && do { push @{$item{'directors'}}, $person->{'name'}; last SWITCH; }; 506 $person->{'role'} eq 'co-director' && do { push @{$item{'directors'}}, $person->{'name'}; last SWITCH; }; 507 $person->{'role'} eq 'writer' && do { push @{$item{'writers'}}, $person->{'name'}; last SWITCH; }; 508 $person->{'role'} eq 'dramatised_by' && do { push @{$item{'writers'}}, $person->{'name'}; last SWITCH; }; 509 $person->{'role'} eq 'adapted_by' && do { push @{$item{'adapters'}}, $person->{'name'}; last SWITCH; }; 510 $person->{'role'} eq 'abridged_by' && do { push @{$item{'adapters'}}, $person->{'name'}; last SWITCH; }; 511 $person->{'role'} eq 'producer' && do { push @{$item{'producers'}}, $person->{'name'}; last SWITCH; }; 512 $person->{'role'} eq 'composer' && do { push @{$item{'composers'}}, $person->{'name'}; last SWITCH; }; 513 $person->{'role'} eq 'editor' && do { push @{$item{'editors'}}, $person->{'name'}; last SWITCH; }; 514 $person->{'role'} eq 'presenter' && do { push @{$item{'presenters'}}, $person->{'name'}; last SWITCH; }; 515 $person->{'role'} eq 'commentator' && do { push @{$item{'commentators'}}, $person->{'name'}; last SWITCH; }; 516 $person->{'role'} eq 'participant' && do { push @{$item{'guest'}}, $person->{'name'}; last SWITCH; }; 517 $person->{'role'} eq 'expert' && do { push @{$item{'guest'}}, $person->{'name'}; last SWITCH; }; 518 519 $person->{'role'} eq 'narrator' && do { push @{$item{'actors'}}, [$person->{'name'},$person->{'character'}]; last SWITCH; }; 520 $person->{'role'} eq 'reporter' && do { push @{$item{'actors'}}, [$person->{'name'},$person->{'character'}]; last SWITCH; }; 521 $person->{'role'} eq 'actor' && do { push @{$item{'actors'}}, [$person->{'name'},$person->{'character'}]; last SWITCH; }; 522 } 523 } 524 525 526 # Now we process all of the broadcasts of the programme and add each one to the schedule along with its per-broadcast info. 527 # Atlas allow for multiple broadcasts per programme (although this seems unused at present). 528 # 529 foreach my $b (@{$prog{'broadcasts'}}) { 530 my %bdc = %$b; 531 my %bcast = (); 532 533 $bcast{'repeat'} = (defined($bdc{'repeat'}) && $bdc{'repeat'} eq true) ? true : false; 534 $bcast{'subtitles'} = (defined($bdc{'subtitled'}) && $bdc{'subtitled'} eq true) ? true : false; 535 $bcast{'deaf_signed'} = (defined($bdc{'signed'}) && $bdc{'signed'} eq true) ? true : false; 536 $bcast{'audio_described'} = (defined($bdc{'audio_described'}) && $bdc{'audio_described'} eq true) ? true : false; 537 $bcast{'high_def'} = (defined($bdc{'high_definition'}) && $bdc{'high_definition'} eq true) ? true : false; 538 $bcast{'widescreen'} = (defined($bdc{'widescreen'}) && $bdc{'widescreen'} eq true) ? true : false; 539 $bcast{'surround'} = (defined($bdc{'surround'}) && $bdc{'surround'} eq true) ? true : false; 540 $bcast{'live'} = (defined($bdc{'live'}) && $bdc{'live'} eq true) ? true : false; 541 $bcast{'premiere'} = (defined($bdc{'premiere'}) && $bdc{'premiere'} eq true) ? true : false; 542 $bcast{'new_series'} = (defined($bdc{'new_series'}) && $bdc{'new_series'} eq true) ? true : false; 543 $bcast{'new_episode'} = (defined($bdc{'new_episode'}) && $bdc{'new_episode'} eq true) ? true : false; 544 545 $bcast{'start'} = str2time( $bdc{'transmission_time'} ); 546 $bcast{'stop'} = str2time( $bdc{'transmission_end_time'} ); 547 548 # Note: we may need to do something about e.g. "Weather" - this comes in with a zero duration and also overlaps the previous programme 549 # 550 # "title": "BBC News", "transmission_time": "2013-10-14T17:00:00Z", "transmission_end_time": "2013-10-14T17:30:00Z", 551 # "title": "Weather", "transmission_time": "2013-10-14T17:30:00Z", "transmission_end_time": "2013-10-14T17:30:00Z", 552 # "title": "South Today", "transmission_time": "2013-10-14T17:30:00Z", "transmission_end_time": "2013-10-14T18:00:00Z", 553 # 554 # Some PVRs are going to barf on either (or both) these 555 # According to MetaBroadcast it's what PA use to signify a "follow-on" programme. Hmm.... 556 557 558 # By default XMLTV grabbers should start with the first programme which *starts* within the requested period 559 # (i.e. ignore any programme already running but which started before the requested period) 560 # 561 if ( !defined $conf->{'overlaps'} || $conf->{'overlaps'}->[0] ne 'allow' ) { 562 next if ( $bcast{'start'} < $starttime ); 563 } 564 565 # Convert the broadcast/programme to XMLTV format 566 add_programme_to_xml($channel_id, \%item, \%bcast); 567 } 568 } 569} 570 571# ------------------------------------------------------------------------------------------------------------------------------------- # 572 573sub add_programme_to_xml { 574 # Add a programme to the XML hash 575 # 576 # <!ELEMENT programme (title+, sub-title*, desc*, credits?, date?, 577 # category*, language?, orig-language?, length?, 578 # icon*, url*, country*, episode-num?, video?, audio?, 579 # previously-shown?, premiere?, last-chance?, new?, 580 # subtitles*, rating*, star-rating? )> 581 # <!ATTLIST programme start CDATA #REQUIRED 582 # stop CDATA #IMPLIED 583 # pdc-start CDATA #IMPLIED 584 # vps-start CDATA #IMPLIED 585 # showview CDATA #IMPLIED 586 # videoplus CDATA #IMPLIED 587 # channel CDATA #REQUIRED 588 # clumpidx CDATA "0/1" > 589 # <!ELEMENT credits (director*, actor*, writer*, adapter*, producer*, 590 # presenter*, commentator*, guest* )> 591 # <!ELEMENT video (present?, colour?, aspect?)> 592 # 593 594 my ($channel_id, $item, $bcast) = @_; 595 my %item = %$item; 596 my %bcast = %$bcast; 597 my %xmlprog = (); 598 599 $xmlprog{'channel'} = $channel_id; 600 $xmlprog{'start'} = DateTime->from_epoch( epoch => $bcast{'start'} )->set_time_zone('Europe/London')->strftime("%Y%m%d%H%M%S %z"); 601 $xmlprog{'stop'} = DateTime->from_epoch( epoch => $bcast{'stop'} )->set_time_zone('Europe/London')->strftime("%Y%m%d%H%M%S %z"); 602 603 $xmlprog{'title'} = [[ codify( $item{'title'} ), 'en' ]]; 604 $xmlprog{'sub-title'} = [[ codify( $item{'episodetitle'} ), 'en' ]] if ($item{'episodetitle'}); 605 $xmlprog{'desc'} = [[ codify( $item{'desc'} ), 'en' ]] if ($item{'desc'}); 606 607 my $showepnum = make_ns_epnum($item{'seriesno'}, $item{'epno'}, $item{'totaleps'}); 608 $xmlprog{'episode-num'} = [[ $showepnum, 'xmltv_ns' ]] if ($showepnum && $showepnum ne '..'); 609 610 # Output an additional 'episode_num' with the Atlas ids for brand, series and item. 611 # These can be used to match existing objects in your EPG (& so avoid having to do title matching etc.). 612 # However some poorly written EPG processors may not allow for multiple 'episode_num' tags, so we'll let the user 613 # disable this additional tag. 614 if ( (not defined( $conf->{writeids} )) || ( not $conf->{writeids}->[0] =~ /no?/i ) ) { 615 my $showids = $item{'brandid'} .'.'. $item{'seriesid'} .'.'. $item{'itemid'}; 616 push @{$xmlprog{'episode-num'}}, [ $showids, 'brand.series.episode' ] if ($showids && $showids ne '..'); 617 } 618 619 foreach my $role ( qw/director actor writer adapter producer composer editor presenter commentator guest/ ) { 620 if ($item{($role.'s')} && scalar @{$item{($role.'s')}} > 0) { 621 foreach my $showperson ( @{$item{$role.'s'}}) { 622 if (ref($showperson) eq 'ARRAY') { 623 push @{$xmlprog{'credits'}{$role}}, [ codify( @{$showperson}[0] ), codify( @{$showperson}[1] ) ]; 624 } else { 625 push @{$xmlprog{'credits'}{$role}}, codify( $showperson ); 626 } 627 } 628 } 629 } 630 631 $xmlprog{'date'} = $item{'year'} if $item{'year'}; 632 push @{$xmlprog{'icon'}}, {'src' => $item{'image'}} if $item{'image'}; 633 634 # add 'Film' genre if it's a film 635 if ($item{'film'}) { 636 foreach ( map_category( 'Film' ) ) { 637 $item{'genres'}->{ $_ } = (0 | 32) if ( !defined $item{'genres'}->{ $_ } || $item{'genres'}->{ $_ } > (0 | 32) ); 638 } 639 } 640 if (scalar (keys %{$item{'genres'}}) > 0) { 641 # 6-Mar-2014: while (my ($key, $value) = each %{$item{'genres'}}) { 642 foreach ( sort { $item{'genres'}{$a} <=> $item{'genres'}{$b} } keys %{$item{'genres'}} ) { 643 push @{$xmlprog{category}}, [ codify( $_ ), 'en' ]; 644 } 645 } 646 647 push @{$xmlprog{'subtitles'}}, {'type' => 'teletext'} if $bcast{'subtitles'}; 648 push @{$xmlprog{'subtitles'}}, {'type' => 'deaf-signed'} if $bcast{'deaf_signed'}; 649 # bug 489 audio described is different to deaf signed 650 ##push @{$xmlprog{'subtitles'}}, {'type' => 'deaf-signed'} if $bcast{'audio_described'}; 651 $xmlprog{'premiere'} = [] if $bcast{'premiere'}; 652 $xmlprog{'previously-shown'} = {} if $bcast{'repeat'}; 653 $xmlprog{'new'} = {} if $bcast{'new_series'} || $bcast{'new_episode'}; 654 $xmlprog{'video'}->{'present'} = 1 if $item{'media'} && $item{'media'} eq 'video'; 655 $xmlprog{'video'}->{'present'} = 0 if $item{'media'} && $item{'media'} eq 'audio'; 656 $xmlprog{'video'}->{'colour'} = 0 if $item{'black_and_white'}; 657 # (v1.16) remove these tags - the Atlas database displays them for *every* 'broadcast' irrespective 658 # of whether the showing is on a HD or SD channel, etc. This is misleading. 659 # $xmlprog{'video'}->{'aspect'} = '16:9' if $bcast{'widescreen'}; 660 # $xmlprog{'video'}->{'quality'} = 'HDTV' if $bcast{'high_def'}; 661 # $xmlprog{'audio'}->{'stereo'} = 'surround' if $bcast{'surround'}; 662 $xmlprog{'rating'} = [[ $item{'certificate'}, $item{'certificate_code'} ]] if $item{'certificate'}; 663 $xmlprog{'star-rating'} = [ $item{'star_rating'} . '/5' ] if $item{'star_rating'}; 664 665 #print Dumper \%xmlprog; 666 push(@{$programmes}, \%xmlprog); 667 668 return; 669} 670 671# ------------------------------------------------------------------------------------------------------------------------------------- # 672 673sub filter_listings { 674 # Given a hash ready to be fed into XMLTV writer, perform some last minute work on the programmes: 675 # 1) Remove any duplicate programmes 676 # 2) Create clumps where necessary (i.e. where programmes overlap) 677 # 678 679 # Test scenarios (list of prog times) for clumpidx generation 680 # 1800-1830 1820-1830 1830-1900 681 # 1800-1830 1830-1835 1830-1900 682 # 1800-1830 1800-1805 1830-1900 683 # 1800-1830 1810-1815 1830-1900 684 # 1800-1830 1825-1835 1830-1900 685 # 686 ## For author's testing purposes: 687 ## require './filter_test.pl'; ($channels, $programmes) = set_test_data(); 688 689 690 # Walk the array (note: this assumes, (i) the programmes are stored in channel+starttime order, (ii) they have stop times ) 691 my ($clumpidx, $clumptot, @curr_clumps) = (0, 2, ()); 692 for (my $i=0; $i<scalar @{$programmes}; $i++) { 693 my ($this, $next) = ($i, $i+1); 694 695 FILTER: 696 697 # any more progs after this one? 698 last if ($next >= scalar @{$programmes} ); 699 700 # get programme's times as epoch seconds 701 my $this_start = time_xmltv_to_epoch( @$programmes[$this]->{'start'} ); 702 my $this_stop = time_xmltv_to_epoch( @$programmes[$this]->{'stop'} ); 703 my $next_start = time_xmltv_to_epoch( @$programmes[$next]->{'start'} ); 704 my $next_stop = time_xmltv_to_epoch( @$programmes[$next]->{'stop'} ); 705 706 707 # (Task #1) 708 # Is prog a duplicate with next 709 # (duplicate = same channel + same start & stop times + same title 710 if ( @$programmes[$next]->{'channel'} eq @$programmes[$this]->{'channel'} 711 && @$programmes[$next]->{'start'} eq @$programmes[$this]->{'start'} 712 && @$programmes[$next]->{'stop'} eq @$programmes[$this]->{'stop'} 713 && @$programmes[$next]->{'title'}[0][0] eq @$programmes[$this]->{'title'}[0][0] ) { 714 # delete the duplicate 715 splice(@{$programmes}, $next, 1); 716 goto FILTER; 717 } 718 719 720 # (Task #2) 721 # Check times of next prog on this channel; is there an overlap? 722 if ( @$programmes[$next]->{'channel'} eq @$programmes[$this]->{'channel'} 723 && $next_start < $this_stop ) { 724 725 if ( !scalar @curr_clumps ) { 726 @$programmes[$this]->{'clumpidx'} = $clumpidx++ .'/'. $clumptot; 727 @$programmes[$next]->{'clumpidx'} = $clumpidx .'/'. $clumptot; 728 push @curr_clumps, $this; # remember the current array index 729 730 } else { # current prog is already part of a clump :( 731 # adjust rest of current clump 732 $clumptot++; 733 $clumpidx = 0; 734 foreach (@curr_clumps) { 735 @$programmes[$_]->{'clumpidx'} = $clumpidx++ .'/'. $clumptot; 736 } 737 @$programmes[$this]->{'clumpidx'} = $clumpidx++ .'/'. $clumptot; 738 @$programmes[$next]->{'clumpidx'} = $clumpidx .'/'. $clumptot; 739 push @curr_clumps, $this; # remember the current array index 740 } 741 742 743 } else { 744 # reset vars ready for next pass 745 ($clumpidx, $clumptot, @curr_clumps) = (0, 2, ()); 746 } 747 748 $bar->update if defined $bar; 749 } 750} 751# ------------------------------------------------------------------------------------------------------------------------------------- # 752 753 754# ############################################################################# 755# # THE VEG ###################################################################### 756# ------------------------------------------------------------------------------------------------------------------------------------- # 757 758sub make_ns_epnum { 759 # Convert an episode number to its xmltv_ns compatible - i.e. reset the base to zero 760 # Input = series number, episode number, total episodes, part number, total parts, 761 # e.g. "1, 3, 6, 2, 4" >> "0.2/6.1/4", "3, 4" >> "2.3." 762 # 763 my ($s, $e, $e_of, $p, $p_of) = @_; 764 #print Dumper(@_); 765 766 # "Part x of x" may contain integers or words (e.g. "Part 1 of 2", or "Part one") 767 $p = text_to_num($p) if defined $p; 768 $p_of = text_to_num($p_of) if defined $p_of; 769 770 # validation check 771 undef($s) if defined $s && $s eq '0'; 772 undef($e) if defined $e && $e eq '0'; 773 undef($p) if defined $p && $p eq '0'; 774 undef($p_of) if defined $p_of && $p_of eq '0'; 775 776 # re-base the series/episode/part numbers 777 $s-- if (defined $s && $s ne ''); 778 $e-- if (defined $e && $e ne ''); 779 $p-- if (defined $p && $p ne ''); 780 781 # make the xmltv_ns compliant episode-num 782 my $episode_ns = ''; 783 $episode_ns .= $s if (defined $s && $s ne ''); 784 $episode_ns .= '.'; 785 $episode_ns .= $e if (defined $e && $e ne ''); 786 $episode_ns .= '/'.$e_of if (defined $e_of && $e_of ne ''); 787 $episode_ns .= '.'; 788 $episode_ns .= $p if (defined $p && $p ne ''); 789 $episode_ns .= '/'.$p_of if (defined $p_of && $p_of ne ''); 790 791 #print "--$episode_ns--"; 792 return $episode_ns; 793} 794 795sub text_to_num { 796 # Convert a word number to int e.g. 'one' >> '1' 797 # 798 my ($text) = @_; 799 if ($text !~ /^[+-]?\d+$/) { # standard test for an int 800 my %nums = (one => 1, two => 2, three => 3, four => 4, five => 5, six => 6, seven => 7, eight => 8, nine => 9); 801 return $nums{$text} if exists $nums{$text}; 802 } 803 return $text 804} 805 806sub unmap_channel_id { 807 # Map the requested channel_id to an Atlas value 808 # 809 # Since the user could ask for *any* channel (using the --channel option) we can't be 810 # certain whether the channel is an 'Atlas' one or a 'mapped' one 811 # (without maintaining a list of all the channels known to Atlas which is too error-prone). 812 # 813 # But that's not important - we only need to check the 'mapped' list and reverse-map the id if found. 814 # 815 # To cater for the situation where an id exists in the map file as both an Atlas id *and* a mapped id 816 # (!!! - does this even make sense?) we'll check for an Atlas id first and *not* translate if found. 817 # 818 # Can't handle situation where mapped id occurs > once in map file - will just pick up the first one (alphabetically). 819 # 820 # Thus: (i) Check if channel_id is in 'fromchan' = return; 821 # (ii) Check if channel_id is in 'tochan' = return 'fromchan' 822 # (iii) else return 823 # 824 # ( c.f. map_channel_id() ) 825 # 826 my ($channel_id) = @_; 827 if (%mapchannelhash && exists $mapchannelhash{$channel_id}) { 828 return $channel_id; 829 } 830 if (%mapchannelhash && ( grep { $_ eq $channel_id } values %mapchannelhash ) ) { 831 while (my ($key, $value) = each %mapchannelhash) { 832 if ($value eq $channel_id) { 833 return $key; 834 } 835 } 836 } 837 return $channel_id; 838} 839 840sub map_channel_id { 841 # Map the fetched channel_id to a different value (e.g. our PVR needs specific channel ids) 842 # mapped channels should be stored in a file called tv_grab_uk_atlas.map.conf 843 # containing lines of the form: map==fromchan==tochan e.g. 'map==5-star==5STAR' 844 # 845 my ($channel_id) = @_; 846 if (%mapchannelhash && exists $mapchannelhash{$channel_id}) { 847 return $mapchannelhash{$channel_id} ; 848 } 849 return $channel_id; 850} 851 852sub map_category { 853 # Map the fetched category to a different value (e.g. our PVR needs specific genres) 854 # mapped categories should be stored in a file called tv_grab_uk_atlas.map.conf 855 # containing lines of the form: cat==fromcategory==tocategory e.g. 'cat==General Movie==Film' 856 # 857 # If the 'tocategory' is blank then the category will be removed from the programme 858 # e.g. cat==General Movie== 859 # Multiple 'tocategory' can be specified separated by ~ 860 # e.g. cat==Adventure/War==Adventure~War 861 # 862 my ($category) = @_; 863 if (%mapcategoryhash && exists $mapcategoryhash{$category}) { 864 return split('~', $mapcategoryhash{$category} ); 865 } 866 return split('~', $category); # force input to be an array 867} 868 869sub map_PA_category { 870 # Press Association uses codes for categories 871 # e.g. '1400' means 'Comedy' 872 # Map the fetched category code to its genre 873 # 874 my ($category) = @_; 875 if (%mapgenrehash && exists $mapgenrehash{$category}) { 876 return $mapgenrehash{$category} ; 877 } 878 return $category; 879} 880 881sub loadmapconf { 882 # Load the files containing mappings for channels and genres (categories) 883 # 884 # There are 3 files: 885 # grabber specified channel mappings 886 # grabber specified genre mappings 887 # user specified channel & genre mappings (optional file) 888 # 889 # Any user specified mappings will override the corresponding grabber specified mapping. 890 # 891 # There are 2 record types: 892 # lines starting with "map" are used to 'translate' the Atlas channel id to those required by your PVR 893 # e.g. map==cbjc==DAVE will output "DAVE" in your XML file instead of "cbjc" 894 # lines starting with "cat" are used to translate categories (genres) in the Atlas data to those required by your PVR 895 # e.g. cat==Science Fiction==Sci-fi will output "Sci-Fi" in your XML file instead of "Science Fiction" 896 # 897 898 my $mapchannels = \%mapchannelhash; 899 my $mapcategories = \%mapcategoryhash; 900 # 901 foreach ( qw/channels genres/ ) { 902 903 # Retrieve grabber map file via XMLTV::Supplement 904 my $supplement = GetSupplement($GRABBER_NAME, 'tv_grab_uk_atlas.map.'.$_.'.conf'); 905 die "Error: XMLTV $_ map data is missing, exiting" 906 if (! defined $supplement || $supplement eq ''); 907 my @lines = split /[\r\n]+/, $supplement; 908 foreach my $line (@lines) { 909 chomp $line; chop($line) if ($line =~ m/\r$/); trim($line); 910 next if $line =~ /^#/ || $line eq ''; 911 912 my ($type, $mapfrom, $mapto, $trash) = $line =~ /^(.*)==(.*)==(.*?)([\s\t]*#.*)?$/; 913 SWITCH: { 914 lc($type) eq 'map' && do { $mapchannels->{$mapfrom} = $mapto; last SWITCH; }; 915 lc($type) eq 'cat' && do { $mapcategories->{$mapfrom} = $mapto; last SWITCH; }; 916 warning("Unknown type in map file: \n $line"); 917 } 918 } 919 920 } 921 922 # Retrieve user map file from 'supplement' dir (*not* using XMLTV::Supplement) 923 # and overwrite any corresponding grabber mappings 924 my $fn = get_supplement_dir() . '/'. $GRABBER_NAME . '.user.map.conf'; 925 if ( -e $fn ) { 926 my $fhok = open my $fh, '<', $fn or warning("Cannot open conf file $fn"); 927 if ($fhok) { 928 while (my $line = <$fh>) { 929 chomp $line; chop($line) if ($line =~ m/\r$/); trim($line); 930 next if $line =~ /^#/ || $line eq ''; 931 932 my ($type, $mapfrom, $mapto, $trash) = $line =~ /^(.*)==(.*)==(.*?)([\s\t]*#.*)?$/; 933 SWITCH: { 934 lc($type) eq 'map' && do { $mapchannels->{$mapfrom} = $mapto; last SWITCH; }; 935 lc($type) eq 'cat' && do { $mapcategories->{$mapfrom} = $mapto; last SWITCH; }; 936 warning("Unknown type in map file: \n $line"); 937 } 938 } 939 close $fh; 940 } 941 } 942 # print Dumper ($mapchannels, $mapcategories); 943} 944 945sub loadmapgenre { 946 # Load the file containing mappings for Press Association categories (genres) 947 # 948 # This is used to convert the PA category codes into textual genre names. 949 # Note these are then fed through map_category() to convert them to your personal wants, so keep 950 # the PA file generic (it will be easier to update in the future that way). 951 # 952 953 my $mapgenrehash = \%mapgenrehash; 954 # 955 # Retrieve PA genres file via XMLTV::Supplement 956 my $supplement = GetSupplement($GRABBER_NAME, 'tv_grab_uk_atlas.pa.genres.conf'); 957 die "Error: XMLTV PA genres data is missing, exiting" 958 if (! defined $supplement || $supplement eq ''); 959 my @lines = split /[\r\n]+/, $supplement; 960 foreach my $line (@lines) { 961 chomp $line; chop($line) if ($line =~ m/\r$/); trim($line); 962 next if $line =~ /^#/ || $line eq ''; 963 964 my ($mapfrom, $mapto, $trash) = $line =~ /^(.*)==(.*?)([\s\t]*#.*)?$/; 965 $mapgenrehash->{$mapfrom} = $mapto; 966 } 967 #print Dumper ($mapgenrehash); 968} 969 970sub list_lineups ( $ ) { 971 # Returns an xml-string containing a list of all the channel lineups for which the grabber can deliver data (in xmltv-lineups.xsd format). 972 973 my $nb = 'Note: list-lineups and get-lineup is still unofficial in XMLTV, and the format and content of this xml is liable to change.'; print STDERR $nb."\n"; 974 975 my $opts = $_; 976 fetch_platforms(); 977 978 # There doesn't seem to be a proc in XMLTV for writing the xmltv-lineups.xml 979 # so we'll have to roll our own 980 # (to validate use " xmllint -noout -schema xmltv-lineups.xsd filename " ) 981 982 # The lineups xml doesn't map well to the Atlas database but we'll try 983 984 use XML::Writer; 985 986 my $w = XML::Writer->new( 'ENCODING' => 'UTF-8', 'DATA_MODE' => 1, 'DATA_INDENT' => 1 ); # OUTPUT to stdout 987 $w->xmlDecl('UTF-8'); 988 $w->comment($nb); 989 $w->startTag('xmltv-lineups', 990 'modified' => strftime("%FT%T %z", localtime), 991 'source-info-name' => $source_info_name, 992 'source-info-url' => $source_info_url, 993 'generator-info-name' => $generator_info_name, 994 'generator-info-url' => $generator_info_url ); 995 996 foreach my $platform (@platforms) { 997 $w->startTag('xmltv-lineup', 'id' => $platform->{'id'} ); 998 $w->startTag('type'); 999 $w->characters('STB'); 1000 $w->endTag('type'); 1001 $w->startTag('display-name', 'lang' => 'en' ); 1002 $w->characters( codify( $platform->{'title'} ) ); 1003 $w->endTag('display-name'); 1004 foreach my $country (@{$platform->{'countrieslist'}}) { 1005 $w->startTag('availability', 'area' => 'country' ); 1006 $w->characters( codify( $country ) ); 1007 $w->endTag('availability'); 1008 } 1009 $w->endTag('xmltv-lineup'); 1010 foreach my $region (@{$platform->{'regions'}}) { 1011 $w->startTag('xmltv-lineup', 'id' => $region->{'id'} ); 1012 $w->startTag('type'); 1013 $w->characters('STB'); 1014 $w->endTag('type'); 1015 $w->startTag('display-name', 'lang' => 'en' ); 1016 $w->characters( codify( $platform->{'title'} .' - '. $region->{'title'} ) ); 1017 $w->endTag('display-name'); 1018 $w->startTag('availability', 'area' => 'region' ); 1019 $w->characters( codify( $region->{'title'} ) ); 1020 $w->endTag('availability'); 1021 $w->endTag('xmltv-lineup'); 1022 } 1023 } 1024 1025 $w->endTag('xmltv-lineups'); 1026 $w->end(); 1027 return; 1028} 1029 1030sub get_lineup ( $$ ) { 1031 # Returns an xml-string describing the configured lineup (in xmltv-lineups.xsd format). 1032 1033 my $nb = 'Note: list-lineups and get-lineup is still unofficial in XMLTV, and the format and content of this xml is liable to change.'; print STDERR $nb."\n"; 1034 1035 my ($conf, $opt) = @_; 1036 my @channels = fetch_channels ($conf, $opt); 1037 1038 use XML::Writer; 1039 1040 my $w = XML::Writer->new( 'ENCODING' => 'UTF-8', 'DATA_MODE' => 1, 'DATA_INDENT' => 1 ); # OUTPUT to stdout 1041 $w->xmlDecl('UTF-8'); 1042 $w->comment($nb); 1043 $w->startTag('xmltv-lineups', 1044 'modified' => strftime("%FT%T %z", localtime), 1045 'source-info-name' => $source_info_name, 1046 'source-info-url' => $source_info_url, 1047 'generator-info-name' => $generator_info_name, 1048 'generator-info-url' => $generator_info_url ); 1049 1050 $w->startTag('xmltv-lineup', 'id' => $conf->{'platform'}[0] ); 1051 $w->startTag('type'); 1052 $w->characters('STB'); 1053 $w->endTag('type'); 1054 $w->startTag('display-name', 'lang' => 'en' ); 1055 $w->characters( codify( $conf->{'platform-title'}[0] ) ); 1056 $w->endTag('display-name'); 1057 1058 foreach my $channel (@channels) { 1059 $w->startTag('lineup-entry'); 1060 $w->startTag('preset'); 1061 $w->characters($channel->{'num'}); 1062 $w->endTag('preset'); 1063 $w->startTag('station', 'rfc2838' => map_channel_id($channel->{'id'}) ); 1064 $w->startTag('name', 'lang' => 'en' ); 1065 $w->characters( codify( $channel->{'title'} ) ); 1066 $w->endTag('name'); 1067 $w->emptyTag('logo', 'url' => $channel->{'image'} ) if $channel->{'image'}; 1068 if ($channel->{'media_type'} && $channel->{'media_type'} eq 'video') { 1069 if (defined $channel->{'high_definition'}) { 1070 $w->startTag('video'); 1071 $w->startTag('format'); 1072 $w->characters( ($channel->{'high_definition'} eq 1 ? 'HDTV' : 'SDTV') ); 1073 $w->endTag('format'); 1074 $w->endTag('video'); 1075 } else { 1076 $w->emptyTag('video'); 1077 } 1078 } 1079 if ($channel->{'media_type'} && $channel->{'media_type'} eq 'audio') { 1080 $w->emptyTag('audio'); 1081 } 1082 $w->endTag('station'); 1083 $w->startTag('stb-channel'); 1084 $w->startTag('stb-preset'); 1085 $w->characters($channel->{'num'}); 1086 $w->endTag('stb-preset'); 1087 $w->endTag('stb-channel'); 1088 $w->endTag('lineup-entry'); 1089 } 1090 1091 $w->endTag('xmltv-lineup'); 1092 $w->endTag('xmltv-lineups'); 1093 $w->end(); 1094 return; 1095} 1096 1097sub list_channels ( $$ ) { 1098 # List all available channels on the configured 'region' (in xmltv.dtd format). 1099 1100 my @channels = fetch_channels (@_); 1101 1102 # We must return an xml-string (c.f. Options.pm), E.g.: 1103 # <channel id="cbbR"> 1104 # <display-name lang="en">BBC News Channel</display-name> 1105 # </channel> 1106 # <channel id="cbbT"> 1107 # <display-name lang="en">BBC Parliament</display-name> 1108 # </channel> 1109 # 1110 # Map the list of channels to a hash XMLTV::Writer will understand 1111 my $channels_conf = {}; 1112 foreach my $c (@channels) { 1113 my %channel = %$c; 1114 $channels_conf->{$channel{'num'}} = { 1115 'id' => $channel{'id'}, 1116 'display-name' => [[ codify( $channel{'title'} ), 'en' ]], 1117 }; 1118 $channels_conf->{$channel{'num'}}->{'icon'} = [{'src' => $channel{'image'} }] if $channel{'image'}; 1119 } 1120 # 1121 # Let XMLTV::Writer format the results as xml. 1122 my $result; 1123 my $writer = new XMLTV::Writer(OUTPUT => \$result, encoding => 'UTF-8'); 1124 $writer->start({'generator-info-name' => $generator_info_name}); 1125 $writer->write_channels($channels_conf); 1126 $writer->end(); 1127 return $result; 1128} 1129 1130sub fetch_channels ( $$ ) { 1131 # Fetch Atlas' channels for a Region for a Platform 1132 1133 # This sub is used by both --configure and --list-channels (and --get-lineup) 1134 # For --configure we have a Platform & Region from config_stage() 1135 # For --list-channels we have a Platform & Region from %conf 1136 # For --list-channels it's not practical to list all channels for all regions for all platforms 1137 # (this would take too long (over 10 mins) and would place an unnecessary load on the Atlas server - 1138 # if you really want to see all 38,242 (!) records this would generate then please see the static files 1139 # in the 'data' directory on github) 1140 # 1141 1142 my ($conf, $opt) = @_; 1143 1144 if ($opt->{'configure'}) { 1145 # temporary diversion... 1146 # Store some extra data in the conf file (just for info) 1147 # 1148 # Ideally we would do this in config_stage but that will only write data captured va 'Ask' 1149 # (i.e. we can't add our own data). Neither does it have the $opt array with the config_file 1150 # name so we can't even write it manually! The only place we can do that is here. 1151 # 1152 open OUT, ">> ".$opt->{'config-file'} 1153 or die "Failed to open $opt->{'config-file'} for writing"; 1154 print OUT "platform-title=$platform_title\n"; 1155 print OUT "region-title=$region_title\n"; 1156 if ($conf->{'lineupcode'}[0] ne '') { 1157 # if user selected a lineup then we need to manually write the platform/region (since there's no configure_stage for them) 1158 print OUT "platform=$selected_platform\n"; 1159 print OUT "region=$selected_region\n"; 1160 } 1161 close OUT; 1162 # ...now back to the normal listchannels_sub 1163 } 1164 else { 1165 $selected_platform = $conf->{'platform'}[0]; 1166 $selected_region = $conf->{'region'}[0]; 1167 1168 # Need to load our 'map' file. --list-channels doesn't reach that part of the code 1169 loadmapconf(); 1170 } 1171 1172 1173 # http://atlas.metabroadcast.com/3.0/channel_groups/cbhN.json?annotations=channels 1174 # 1175 # Channels are a concatenation of platform-wide channels + region-specific channels 1176 # 1177 # Platform code is $selected_platform (captured by select-platform in config_stage() 1178 # Region code is $selected_region (captured by select-region in config_stage() 1179 # 1180 my @urls = (); 1181 push @urls, $ROOT_URL.'channel_groups/'.$selected_platform.'.json?annotations=channels'; 1182 push @urls, $ROOT_URL.'channel_groups/'.$selected_region.'.json?annotations=channels' if $selected_region; 1183 1184 my @channels = (); 1185 1186 my $bar = new XMLTV::ProgressBar({ 1187 name => "Fetching channels", 1188 count => 1 1189 }) unless ($opt->{quiet} || $opt->{debug}); 1190 1191 foreach my $url (@urls) { 1192 print STDERR $url ."\n" if ($opt->{debug}); 1193 1194 # Fetch the page 1195 my $res = $lwp->get( $url ); 1196 1197 if ($res->is_success) { 1198 #print $res->content; 1199 1200 # Extract the available channels 1201 my $data = JSON::PP->new()->utf8(1)->decode($res->content); 1202 $res = undef; 1203 1204 my $channels = $data->{'channel_groups'}[0]->{'channels'}; 1205 foreach my $c (@$channels) { 1206 my %chan = %$c; 1207 next unless ($chan{'channel'}->{'type'} eq 'channel'); 1208 1209 my %channel = (); 1210 1211 $channel{'num'} = $chan{'channel_number'}; 1212 $channel{'id'} = $chan{'channel'}->{'id'}; 1213 $channel{'title'} = $chan{'channel'}->{'title'}; 1214 $channel{'image'} = $chan{'channel'}->{'image'}; 1215 $channel{'media_type'} = $chan{'channel'}->{'media_type'}; 1216 $channel{'high_definition'} = $chan{'channel'}->{'high_definition'}; 1217 1218 if ($opt->{'list-channels'}) { 1219 # if the user has a 'map' file then map the Atlas channel_id to the user's one (since this is the one which will be 1220 # displayed in xml listings) 1221 if (defined(&map_channel_id)) { $channel{'id'} = map_channel_id($channel{'id'}); } 1222 } 1223 1224 push @channels, \%channel; 1225 } 1226 1227 } else { 1228 print $res->status_line . "\n"; 1229 } 1230 1231 } 1232 1233 $bar->update() && $bar->finish && undef $bar if defined $bar; 1234 1235 #print Dumper(@channels);exit; 1236 return @channels; 1237} 1238 1239sub fetch_platforms () { 1240 # Fetch Atlas' channel_groups 1241 1242 # (note: if called during --configure then $opt & $conf have not been returned by ParseOptions() yet, since that hasn't exited yet) 1243 1244 # http://atlas.metabroadcast.com/3.0/channel_groups.json?type=platform 1245 my $url = $ROOT_URL.'channel_groups.json?type=platform'; 1246 #print STDERR $url ."\n"; 1247 1248 @platforms = (); 1249 undef %regions; 1250 1251 my $bar = new XMLTV::ProgressBar({ 1252 name => "Fetching platforms", 1253 count => 1 1254 }) unless ($opt->{quiet} || $opt->{debug}); 1255 1256 # Fetch the page 1257 my $res = $lwp->get( $url ); 1258 1259 if ($res->is_success) { 1260 #print $res->content; 1261 1262 # Extract the available platforms 1263 my $data = JSON::PP->new()->utf8(1)->decode($res->content); 1264 $res = undef; 1265 1266 my $channel_group = $data->{'channel_groups'}; 1267 foreach my $g (@$channel_group) { 1268 my %group = %$g; 1269 next unless ($group{'type'} eq 'platform'); 1270 1271 my %platform = (); 1272 1273 $platform{'id'} = $group{'id'}; 1274 $platform{'title'} = $group{'title'}; 1275 1276 $platform{'countrieslist'} = $group{'available_countries'}; 1277 $platform{'countries'} = ''; 1278 foreach my $country (@{$group{'available_countries'}}) { 1279 $platform{'countries'} .= '(' . $country . ')'; 1280 } 1281 1282 $platform{'regions'} = (); 1283 foreach my $region (@{$group{'regions'}}) { 1284 push @{$platform{'regions'}}, { 'id' => $region->{'id'}, 'title' => $region->{'title'} }; 1285 $regions{$region->{'id'}} = { 'title' => $region->{'title'}, 'platform_id' => $platform{'id'}, 'platform_title' => $platform{'title'} }; 1286 } 1287 1288 push @platforms, \%platform; 1289 } 1290 1291 } else { 1292 print $res->status_line . "\n"; 1293 } 1294 1295 $bar->update() && $bar->finish && undef $bar if defined $bar; 1296 1297 #print Dumper(@platforms);exit; 1298 #print Dumper(\%regions);exit; 1299 return; 1300} 1301 1302sub config_stage ( $$ ) { 1303 my ( $stage, $conf ) = @_; # note that $conf is mostly empty at this stage of course 1304 1305 my $result; 1306 my $writer = new XMLTV::Configure::Writer( OUTPUT => \$result, encoding => 'UTF-8' ); 1307 $writer->start( { grabber => $GRABBER_NAME } ); 1308 1309 # ------------------------------------------------------------------ # 1310 if ( ($stage eq 'start') || 1311 ($stage eq 'select-cache') ) { 1312 1313 $writer->write_string( { 1314 id => 'cachedir', 1315 title => [ [ 'Directory to store the cache', 'en' ] ], 1316 description => [ [ $GRABBER_NAME.' uses a cache with files that it has already downloaded. Please specify a location for this cache.', 'en' ] ], 1317 default => get_default_cachedir(), 1318 } ); 1319 1320 $writer->end('select-apikey'); 1321 1322 } 1323 # ------------------------------------------------------------------ # 1324 elsif ($stage eq 'select-apikey') { 1325 1326 $writer->write_string( { 1327 id => 'api-key', 1328 title => [ [ 'Enter your Atlas API key', 'en' ] ], 1329 description => [ [ $GRABBER_NAME.' requires an API key which you must obtain from MetaBroadcast.com', 'en' ] ], 1330 default => '', 1331 } ); 1332 1333 $writer->end('select-option'); 1334 1335 } 1336 # ------------------------------------------------------------------ # 1337 elsif ($stage eq 'select-option') { 1338 1339 $writer->write_string( { 1340 id => 'writeids', 1341 title => [ [ 'Output brand/series/summary ids? (yes/no)', 'en' ] ], 1342 description => [ [ $GRABBER_NAME.' normally outputs an episode-num tag with brand.series.episode ids from the Atlas database.', 'en' ] ], 1343 default => 'yes', 1344 } ); 1345 1346 $writer->end('select-lineup'); 1347 1348 } 1349 # ------------------------------------------------------------------ # 1350 elsif ($stage eq 'select-lineup') { 1351 1352 # I don't like the way the "lineup" functionality is supposed to work: 1353 # If user selects a lineup then we are supposed to get ALL channels for that lineup. Every time. No exception 1354 # Not only does that mean (i) we have to do a fetch of the channels for the lineup EVERY time the grabber is run, 1355 # (since the channels for the lineup would *not* be stored in the config file) 1356 # but (ii) we are potentially grabbing 600 channels *just because* the user selected a lineup -- not only does this 1357 # place a load on the data source, but it might not even be what the user needs. 1358 # AIUI "lineup" is so a user's PVR can grab data in a (semi-) automated way. But that doesn't mean that just because 1359 # I am using MythTV that I want to get all 600 channels! (Especially if it's a paid for service where you pay per channel 1360 # downloaded.) 1361 # Therefore I'm going to still run the channels selector. If a user/PVR software really wants all 600 channels then all 1362 # they have to do is send "all" in response to the subsequent question. 1363 1364 $writer->write_string( { 1365 id => 'lineupcode', # don't use 'lineup' or else we don't run the channels selector 1366 title => [ [ 'Enter your viewing region', 'en' ] ], 1367 description => [ [ 'Enter the region code you want or leave blank to select from a list', 'en' ] ], 1368 default => '', 1369 } ); 1370 1371 $writer->end('check-lineup'); 1372 1373 } 1374 # ------------------------------------------------------------------ # 1375 elsif ($stage eq 'check-lineup') { 1376 1377 fetch_platforms(); 1378 1379 if ($conf->{'lineupcode'}[0] ne '') { 1380 # selected 'code' could be a platform OR a region 1381 my $lineupcode = $conf->{'lineupcode'}[0]; 1382 { LOOP: 1383 foreach my $platform (@platforms) { 1384 if ($platform->{'id'} eq $lineupcode) { 1385 $selected_platform = $platform->{'id'}; 1386 $platform_title = $platform->{'title'}; 1387 $selected_region = ''; 1388 $region_title = ''; 1389 last LOOP; 1390 } 1391 foreach my $region (@{$platform->{'regions'}}) { 1392 if ($region->{'id'} eq $lineupcode) { 1393 $selected_platform = $platform->{'id'}; 1394 $platform_title = $platform->{'title'}; 1395 $selected_region = $region->{'id'}; 1396 $region_title = $region->{'title'}; 1397 last LOOP; 1398 } 1399 } 1400 } 1401 } 1402 1403 if (defined $selected_platform && $selected_platform ne '') { 1404 $writer->end('select-channels'); 1405 } 1406 } 1407 else 1408 { 1409 $writer->end('select-platform'); 1410 } 1411 1412 } 1413 # ------------------------------------------------------------------ # 1414 elsif ($stage eq 'select-platform') { 1415 1416 #fetch_platforms(); 1417 1418 $writer->start_selectone( { 1419 id => 'platform', 1420 title => [ [ 'Choose your viewing platform', 'en' ] ], 1421 description => [ [ $GRABBER_NAME.' selects channels to download based on your viewing platform.', 'en' ] ], 1422 } ); 1423 1424 foreach my $p (@platforms) { 1425 my %platform = %$p; 1426 1427 $writer->write_option( { 1428 value => $platform{'id'}, 1429 text => [ [ $platform{'title'} . ' ' . $platform{'countries'}, 'en' ] ], 1430 } ); 1431 } 1432 1433 $writer->end_selectone(); 1434 $writer->end('select-region'); 1435 1436 } 1437 # ------------------------------------------------------------------ # 1438 elsif ($stage eq 'select-region') { 1439 1440 # store platform selected in previous stage 1441 $selected_platform = $conf->{'platform'}[0]; 1442 1443 $writer->start_selectone( { 1444 id => 'region', 1445 title => [ [ 'Choose your viewing region', 'en' ] ], 1446 description => [ [ $GRABBER_NAME.' selects channels to download based on your TV region.', 'en' ] ], 1447 } ); 1448 1449 foreach my $p (@platforms) { 1450 my %platform = %$p; 1451 next unless $platform{'id'} eq $conf->{'platform'}[0]; 1452 1453 # may not be a regionalised platform (e.g. Saorview) 1454 if ( (!defined $platform{'regions'}) || (scalar @{$platform{'regions'}} == 0) ) { 1455 1456 $writer->write_option( { 1457 value => $platform{'id'}, 1458 text => [ [ $platform{'title'}, 'en' ] ], 1459 } ); 1460 1461 } else { 1462 1463 foreach my $r (@{$platform{'regions'}}) { 1464 my %region = %$r; 1465 1466 $writer->write_option( { 1467 value => $region{'id'}, 1468 text => [ [ $region{'title'}, 'en' ] ], 1469 } ); 1470 1471 } 1472 1473 } 1474 } 1475 1476 $writer->end_selectone(); 1477 $writer->end('clean-up'); 1478 1479 } 1480 # ------------------------------------------------------------------ # 1481 elsif ($stage eq 'clean-up') { 1482 1483 # Store some extra data in the conf file (just for info) 1484 # 1485 # Can't use $conf for this since configure_stage() only writes values it collects (i.e. it doesn't write the hash itself) 1486 # 1487 1488 foreach my $p (@platforms) { 1489 my %platform = %$p; 1490 next unless $platform{'id'} eq $conf->{'platform'}[0]; 1491 1492 #$conf->{'platform-title'} = [ $platform{'title'} ]; 1493 $platform_title = $platform{'title'}; 1494 $region_title = ''; 1495 1496 foreach my $r (@{$platform{'regions'}}) { 1497 my %region = %$r; 1498 next unless $region{'id'} eq $conf->{'region'}[0]; 1499 1500 #$conf->{'region-title'} = [ $region{'title'} ]; 1501 $region_title = $region{'title'}; 1502 last; 1503 } 1504 1505 last; 1506 } 1507 1508 # Store the selected platform & region for use by 'select-channels' 1509 $selected_platform = $conf->{'platform'}[0]; 1510 $selected_region = $conf->{'region'}[0]; 1511 $writer->end('select-channels'); 1512 1513 } 1514 # ------------------------------------------------------------------ # 1515 else { 1516 die "Unknown stage $stage"; 1517 } 1518 1519 # ------------------------------------------------------------------ # 1520 return $result; 1521} 1522 1523sub config_check { 1524 if (not defined( $conf->{cachedir} )) { 1525 print STDERR "No cachedir defined in config file " . 1526 $opt->{'config-file'} . "\n" . 1527 "Please run the grabber with --configure.\n"; 1528 exit 1; 1529 } 1530 1531 if (not defined( $conf->{'channel'} )) { 1532 print STDERR "No channels selected in config file " . 1533 $opt->{'config-file'} . "\n" . 1534 "Please run the grabber with --configure.\n"; 1535 exit 1; 1536 } 1537 1538 if (not defined( $conf->{'api-key'} )) { 1539 print STDERR "No api-key defined in config file " . 1540 $opt->{'config-file'} . "\n" . 1541 "Please run the grabber with --configure.\n"; 1542 exit 1; 1543 } 1544} 1545 1546sub get_default_dir { 1547 my $winhome = $ENV{HOMEDRIVE} . $ENV{HOMEPATH} 1548 if defined( $ENV{HOMEDRIVE} ) 1549 and defined( $ENV{HOMEPATH} ); 1550 1551 my $home = $ENV{HOME} || $winhome || "."; 1552 return $home; 1553} 1554 1555sub get_supplement_dir { 1556 return $ENV{XMLTV_SUPPLEMENT} . "/" . $GRABBER_NAME if defined( $ENV{XMLTV_SUPPLEMENT} ); 1557 return get_default_dir() . "/.xmltv/supplement/" . $GRABBER_NAME; 1558} 1559 1560sub get_default_cachedir { 1561 return get_default_dir() . "/.xmltv/cache"; 1562} 1563 1564sub init_cachedir { 1565 my( $path ) = @_; 1566 if( not -d $path ) { 1567 mkpath( $path ) or die "Failed to create cache-directory $path: $@"; 1568 } 1569} 1570 1571sub initialise_ua { 1572 my $cookies = HTTP::Cookies->new; 1573 #my $ua = LWP::UserAgent->new(keep_alive => 1); 1574 my $ua = LWP::UserAgent->new; 1575 # Cookies 1576 $ua->cookie_jar($cookies); 1577 # Define user agent type 1578 $ua->agent('Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.0; Trident/5.0'); 1579 # Define timouts 1580 $ua->timeout(240); 1581 # Use proxy if set in http_proxy etc. 1582 $ua->env_proxy; 1583 1584 return $ua; 1585} 1586 1587sub codify ( $ ) { 1588 # Encode the text as UTF-8 1589 return encode( 'UTF-8', $_[0] ); 1590} 1591 1592sub uc_words { 1593 # Uppercase the first letter of each word 1594 my ($string) = @_; 1595 $string =~ s/\b(\w)/\U$1/g; 1596 return $string; 1597} 1598 1599sub trim { 1600 # Remove leading & trailing spaces 1601 $_[0] =~ s/^\s+|\s+$//g; 1602} 1603 1604sub max ($$) { 1605 return $_[$_[0] < $_[1]]; 1606} 1607 1608sub min ($$) { 1609 return $_[$_[0] > $_[1]]; 1610} 1611 1612sub t { 1613 my( $message ) = @_; 1614 print STDERR $message . "\n" if $opt->{debug}; 1615} 1616 1617sub warning { 1618 my( $message ) = @_; 1619 print STDERR $message . "\n"; 1620 $warnings++; 1621} 1622 1623# ############################################################################# 1624 1625__END__ 1626 1627=pod 1628 1629=head1 NAME 1630 1631tv_grab_uk_atlas - Grab TV and radio programme listings for UK from MetaBroadcast website (Atlas database). 1632 1633=head1 SYNOPSIS 1634 1635tv_grab_uk_atlas --help 1636 1637tv_grab_uk_atlas --info 1638 1639tv_grab_uk_atlas --version 1640 1641tv_grab_uk_atlas --capabilities 1642 1643tv_grab_uk_atlas --description 1644 1645tv_grab_uk_atlas 1646 [--days N] [--offset N] [--dst] 1647 [--channel S] 1648 [--config-file FILE] 1649 [--output FILE] [--quiet] [--debug] 1650 1651tv_grab_uk_atlas 1652 --hours N [--offset N] 1653 [--channel S] 1654 [--config-file FILE] 1655 [--output FILE] [--quiet] [--debug] 1656 1657tv_grab_uk_atlas 1658 --date DATE [--dst] 1659 [--channel S] 1660 [--config-file FILE] 1661 [--output FILE] [--quiet] [--debug] 1662 1663tv_grab_uk_atlas --configure [--config-file FILE] 1664 1665tv_grab_uk_atlas --configure-api [--stage NAME] 1666 [--config-file FILE] 1667 [--output FILE] 1668 1669tv_grab_uk_atlas --list-channels [--config-file FILE] 1670 [--output FILE] [--quiet] [--debug] 1671 1672tv_grab_uk_atlas --list-lineups [--output FILE] 1673 [--quiet] [--debug] 1674 1675tv_grab_uk_atlas --get-lineup [--config-file FILE] [--output FILE] 1676 [--quiet] [--debug] 1677 1678=head1 DESCRIPTION 1679 1680Output TV listings in XMLTV format for many channels available in UK. 1681The data come from L<http://atlas.metabroadcast.com> 1682 1683First you must run B<tv_grab_uk_atlas --configure> to choose which channels 1684you want to receive. 1685 1686Then running B<tv_grab_uk_atlas> with no arguments will get a listings in XML 1687format for the channels you chose for available days including today. 1688 1689=head1 OPTIONS 1690 1691B<--configure> Prompt for which channels to download and write the 1692configuration file. 1693 1694B<--config-file FILE> Set the name of the configuration file, the 1695default is B<~/.xmltv/tv_grab_uk_atlas.conf>. This is the file written by 1696B<--configure> and read when grabbing. 1697 1698B<--output FILE> When grabbing, write output to FILE rather than 1699standard output. 1700 1701B<--hours N> When grabbing, grab N hours of data. 1702 1703B<--days N> When grabbing, grab N days rather than all available days. 1704 1705B<--offset N> Start grabbing at today/now + N days. When B<--hours> is used 1706this is number of hours instead of days. N may be negative. 1707 1708B<--date N> Grab just this date (instead of days/offset). 1709 1710B<--dst> Some PVRs have trouble with BST times and "lose" an hour at the end 1711of the day schedule. This adds an extra hour to the schedule fetched. 1712 1713B<--channel S> Grab just this channel (ignore the channels in the config file). 1714Can be specified either as Atlas channel id (e.g. "cbbw") or mapped 1715channel name (e.g. "south.bbc1.bbc.co.uk"). 1716 1717B<--quiet> Suppress the progress-bar normally shown on standard error. 1718 1719B<--debug> Provide more information on progress to stderr to help in 1720debugging. 1721 1722B<--list-channels> Write output giving <channel> elements for every 1723channel available in the current configuration. 1724 1725B<--list-lineups> Write output giving list of available viewing regions. 1726 1727B<--get-lineup> Write output giving <channel> elements for every 1728channel available in the current lineup. 1729 1730B<--capabilities> Show which capabilities the grabber supports. For more 1731information, see L<http://wiki.xmltv.org/index.php/XmltvCapabilities> 1732 1733B<--version> Show the version of the grabber. 1734 1735B<--help> Print a help message and exit. 1736 1737B<--info> Print a help page and exit. 1738 1739=head1 INSTALLATION 1740 17411. 1742First you must obtain an Atlas API key from MetaBroadcast. This is free 1743(at the present time) for personal use and is necessary to allow you to 1744access the full schedule published by the Press Association. Any commercial 1745use of the data obtained from Atlas will require a paid-for license. 1746 1747Instructions are available here: 1748L<http://metabroadcast.com/blog/create-and-manage-your-atlas-api-key> 1749 1750You will need to enter your API key during the --configure stage. 1751 1752Remember to request Press Association (PA) as the content provider on your 1753Atlas API key. 1754 17552. 1756Grabber configuration consists of the usual: 1757B<tv_grab_uk_atlas --configure> 1758 1759Atlas have regionalised data which means you can obtain listings specific to your 1760TV region. When you run the --configure option you will be asked which viewing 1761platform (e.g. Freeview; Sky HD) and region (e.g. London; South East) you wish 1762to access. (You can select only 1 region!). 1763 1764Then you select which channels you want to fetch. 1765 17663. 1767The file F<tv_grab_uk_atlas.user.map.conf> has two purposes. Firstly you can map 1768the channel ids used by Atlas into something more meaningful to your PVR. E.g. 1769 1770 map==cbdm==FILM4 1771 1772will change "cbdm" to "FILM4" in the output XML. 1773 1774Note: the lines are of the form "map=={channel id}=={my name}". 1775 1776The second purpose is to likewise translate genre names. So if your PVR doesn"t 1777have a category for "Science Fiction" but uses "Sci-fi" instead, then you can 1778specify 1779 1780 cat==Science Fiction==Sci-fi 1781 1782and the output XML will have "Sci-fi". 1783 1784 1785IMPORTANT: the downloaded "tv_grab_uk_atlas.user.map.conf" contains example lines 1786to illustrate the format - you should edit this file to suit your own purposes! 1787 1788=head1 USAGE 1789 1790All the normal XMLTV capabilities are included but there is an additional parameter 1791"--hours". Atlas allows schedule data to be retrieved either by number-of-days or 1792by number-of-hours. 1793 1794Where possible you should use this "hours" facility to reduce unnecessary load on 1795the Atlas server. 1796 1797When --hours is specified the --offset is interpreted as hours. 1798 1799For example: 1800 1801 - to retrieve a schedule for the next 12 hours: 1802 1803 tv_grab_uk_atlas --hours 12 1804 1805 - to retrieve a schedule for the next 12 hours starting tomorrow: 1806 1807 tv_grab_uk_atlas --hours 12 --offset 24 1808 1809 1810Alternatively you can use the familiar "days" format: 1811 1812 tv_grab_uk_atlas --days 1 1813 1814 tv_grab_uk_atlas --days 1 --offset 1 1815 1816 1817Negative numbers are allowed, so for example the following are valid: 1818 1819 tv_grab_uk_atlas --offset -4 --hours 12 1820 1821 tv_grab_uk_atlas --offset -1 --days 1 1822 1823 1824Note that Atlas only has data for a maximum 14 days ahead and it varies; some 1825channels have less than this. 1826 1827 1828An additional parameter "--date YYYYMMDD" allows you to fetch the schedule 1829just for this date. (This is obviously similar to --days 1 with an appropriate 1830--offset but avoids you having to calculate the offset; this is easier for 1831some automated fetchers.) E.g. 1832 1833 tv_grab_uk_atlas --date 20130923 1834 1835 1836A new parameter "--dst" allows you to add an extra hour to the schedule fetched 1837from Atlas. Some PVRs have trouble with BST times and "lose" an hour at the 1838end of the day"s schedule. This parameter might help to alleviate that. 1839 1840 tv_grab_uk_atlas --days 1 --dst 1841 1842 1843A new parameter "--channel" allows you to override the config file and retrieve 1844data for a specific channel: 1845 1846 tv_grab_uk_atlas --offset -4 --hours 12 --channel cbdm 1847 1848 1849=head1 BROWSER INTERFACE 1850 1851If you wish to run the fetcher via a browser then you can install the supplied 1852cgi script. 1853 1854(Note you must obviously have a webserver installed or be using a web-host for 1855this to work.) 1856 1857Copy the file F<getatlas.pl> into the cgi-enabled directory on your web space. 1858(Hint: This directory is often called "cgi-bin".) Ensure the file has execute 1859permission. 1860 1861(Tech note: use a "normal" cgi handler to run this file; fastcgi may not work.) 1862 1863Specify the parameters on the URI as follows: 1864 offset=xxxx 1865 hours=xxxx 1866 days=xxxx 1867 date=YYYYMMDD 1868 channel=xxxx 1869 dst 1870 1871 e.g. 1872 http://my.webspace.com/cgi-bin/getatlas.pl?hours=12 1873 http://my.webspace.com/cgi-bin/getatlas.pl?hours=12&offset=6 1874 http://my.webspace.com/cgi-bin/getatlas.pl?date=20130930 1875 http://my.webspace.com/cgi-bin/getatlas.pl?days=1&dst 1876 1877Valid combinations are: 1878 "offset" and "hours" 1879 or "offset" and "days" - in which case the offset is "days" also (otherwise 1880it"s "hours") 1881 or "date" - fetch just this day 1882 1883 1884=head1 ERROR HANDLING 1885 1886If the grabber fails to download data for some channel on a specific day, 1887it will print an errormessage to STDERR and then continue with the other 1888channels and days. The grabber will exit with a status code of 1 to indicate 1889that the data is incomplete. 1890 1891=head1 ENVIRONMENT VARIABLES 1892 1893The environment variable HOME can be set to change where configuration 1894files are stored. All configuration is stored in $HOME/.xmltv/. On Windows, 1895it might be necessary to set HOME to a path without spaces in it. 1896 1897=head1 SUPPORTED CHANNELS 1898 1899For information on supported channels, see the tv_grab_uk_atlas.map.channels.conf 1900file in your $HOME/.xmltv/supplement/tv_grab_uk_atlas/ directory after you have 1901run the grabber at least once. 1902 1903=head1 XMLTV VALIDATION 1904 1905B<tv_validate_grabber> may report an error similar to: 1906 1907 "Line 5 Invalid channel-id BBC 1" 1908 1909This is a because ValidateFile.pm insists the channel-id adheres to RFC2838 1910despite the xmltv.dtd only saying "preferably" not "SHOULD". 1911(Having channel ids of the form "bbc1.bbc.co.uk" will be rejected by many PVRs 1912since they require the data to match their own list.) 1913 1914This error can be ignored. 1915 1916=head1 FAQs 1917 19181. What does "Enter your Atlas API key" mean? 1919 1920You must obtain an API key free from Atlas MetaBroadcast before you can use 1921this grabber. Instructions are available here: 1922L<https://metabroadcast.com/blog/create-and-manage-your-atlas-api-key> 1923 19242. I"m getting the error "Status: 400 Bad Request" 1925 1926Typically this is because you haven"t entered your API key during the 1927--configure stage. 1928Or your API key does not allow access to Press Association data (log-in to your 1929account at http://atlas.metabroadcast.com/admin and "Request Access" to "PA" 1930source data). 1931Or if you requested a particular channel with the --channel option but the 1932channel cannot be found. 1933 1934 1935=head1 DISCLAIMER 1936 1937The MetaBroadcast free license for these data does not allow non-personal use. 1938 1939Certainly any commercial use of listings data obtained by using this grabber 1940will breach copyright law, but if you are just using the data for your own 1941personal use then you are probably fine. 1942 1943By using this grabber you aver you are using the listings data for your own 1944personal use only and you absolve the author(s) from any liability under 1945copyright law or otherwise. 1946 1947=head1 AUTHOR 1948 1949Geoff Westcott. This documentation and parts of the code 1950based on various other tv_grabbers from the XMLTV-project. 1951 1952=head1 COPYRIGHT 1953 1954Copyright (c) 2013 Geoff Westcott. 1955 1956This program is free software; you can redistribute it and/or 1957modify it under the terms of the GNU General Public License 1958(version 2) as published by the Free Software Foundation. 1959 1960This program is distributed in the hope that it will be useful, 1961but WITHOUT ANY WARRANTY; without even the implied warranty of 1962MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 1963GNU General Public License for more details. 1964 1965=head1 SEE ALSO 1966 1967L<xmltv(5)>. 1968 1969=cut 1970 1971