root/grabbers/d1 @ 48

Revision 48, 38.9 kB (checked in by lincoln, 7 years ago)

SBS news support for d1 + quieten down being called with debug enabled
  • Property svn:executable set to *
RevLine 
[43]1#!/usr/bin/perl -w
2
3eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
4    if 0; # not running under some shell
5
6=head1 NAME
7
[48]8tv_grab_au (0.6.2.3) - Grab TV listings for Australia.
[43]9
10=head1 SYNOPSIS
11
12tv_grab_au --help
13
14tv_grab_au --configure [--config-file FILE]
15
16tv_grab_au [--config-file FILE] [--output FILE] [--days N]
17           [--offset N] [--dual-names] [--no-icons] [--quiet] [--debug]
18
19tv_grab_au  --list-channels [--loc STATE] [--srv SERVICE]
20            [--output FILE] [--dual-names] [--no-icons]
21
22=head1 DESCRIPTION
23
24Output XMLTV listings for various channels available in Australia.
25
26First run B<tv_grab_au --configure> to choose your region and
27service provider (ie: free-to-air, pay TV, etc), and which
28channels you want to download.
29
30Then running B<tv_grab_au> with no arguments will output listings
31in XMLTV format to standard output.
32
33 ********************************************************************
34 * NOTE: As of 0.6.2.1, this can be run from shepherd.  When called *
35 *       from shepherd, no configuration is necessary!              *
36 ********************************************************************
37
38B<--configure> Prompt for region, prompt for Free-to-Air or Pay-TV,
39prompt for which channels, and write the configuration file.
40
41B<--config-file FILE> Set the name of the configuration file, the
42default is B<~/.xmltv/tv_grab_au.conf>.  This is the file written by
43B<--configure> and read when grabbing.
44
45B<--list-channels> Grabs a list of channels only and outputs as XMLTV.
46Use B<--loc> to specify region and B<--srv> to specify service.
47Use B<--list-channels> with no B<--loc> or B<--srv> to list of options
48for B<--loc>, use B<--list-channels> with B<--loc [option]> to see a
49list of options for B<--srv>.
50
51B<--output FILE> Write to FILE rather than standard output.
52
53B<--days N> Grab N days, default is 7.
54
55B<--offset N> Start N days in the future.  The default is to start
56from today.
57
58B<--loc REGION> Grab channels for REGION. use B<--list-channels> with no
59options to see list of regions.
60
61B<--srv SERVICE> Grab channels for SERVICE. use B<--list-channels> with
62B<--loc> option to see list of services (Foxtel, Optus, Free-To-Air, etc).
63
64B<--no-icons> Force grabber to NOT write channel icons as URLs.
65
66B<--dual-names> Force grabber to write a second display-name for each
67channel found using the channel frequency as the second name.
68This helps furious_tv users.
69
70B<--quiet> Suppress the progress messages normally written to standard
71error.
72
73B<--debug> Output debugging info.
74
75B<--share> Specify alternate directory for channel_ids file, usally found
76in /usr/share/xmltv/tv_grab_au/.
77
78=head1 SEE ALSO
79
80L<xmltv(5)>. L<http://www.onlinetractorparts.com.au/rohbags/>
81
82=head1 AUTHOR
83
84Written by rohbags (rohbags@onlinetractorparts.com.au).
85
86=head1 BUGS
87
88The data source, L<d1.com.au>, do some strange things with the timezones
89included with their data. For example data for Darwin claims to be in EST
90timezone (+1000) but it actually is CST (+0930). Due to this bug the grabber
91changes the timezones for start and stop times but does not convert the
92actual time itself. If the start and/or stop times for any shows you notice
93seem to be out, please contact the author.
94
95Some long descriptions seem to be cut short. This is the way the grabber
96gets it data from its source. I hope D1 can sort this out soon.
97
98The channel_ids file contains the Time Zones for each region, this may be
99specified as EST, WST or CST, or +10:00 format (hours from GMT).
100
101Channels are identified by the RFC2838 form recommended by the XMLTV DTD, i think.
102(ie: Free-to-Air, Darwin, 7, free.Darwin.7.d1.com.au)
103
104Please email the Author if any bugs are found.
105
106=cut
107
108use strict;
109use Getopt::Long;
110use Date::Manip;
111use IO::File;
112use XMLTV;
113use XMLTV::Memoize;
114use XMLTV::Ask;
115use XMLTV::Config_file;
116use XMLTV::Get_nice;
117use XMLTV::Usage <<END
118
[48]119$0 (0.6.2.3): grab Australian television listings in XMLTV format
[43]120To configure: $0 --configure [--config-file FILE]
121To grab listings: $0 [--config-file FILE] [--output FILE] [--days N]
122        [--offset N] [--dual-names] [--no-icons] [--quiet] [--debug]
123To list channels: $0 --list-channels [--loc STATE] [--srv SERVICE] [--dual-names] [--no-icons]
124END
125  ;
126#To grab icons: $0 --get-icons --icon-dir DIRECTORY [--loc STATE] [--srv SERVICE]
127
128# Use Term::ProgressBar if installed.
129use constant Have_bar => eval { require Term::ProgressBar; 1 };
130
131# Use Log::TraceMessages if installed. FIXME
132BEGIN {
133  eval { require Log::TraceMessages };
134  if ($@) {*t = sub {}; *d = sub { '' }; }
135  else {*t = \&Log::TraceMessages::t;
136        *d = \&Log::TraceMessages::d;
137        Log::TraceMessages::check_argv();
138  }
139}
140
141# Memoize some date parsing routines, if possible.
142eval { require Memoize };
143unless ($@) {
144  foreach (qw(nextdate ParseDate UnixDate dc)) {
145    Memoize::memoize($_) or warn "cannot memoize $_";
146  }
147}
148
149sub xhead( $$ );
150sub configure();
151sub get_channels( $$ );
152sub nextdate( $ );
153sub extract_channel_data( $$$ );
154sub get_programs( $$$$$$$ );
155sub dc( $$ );
156sub get_channel_ids( $$ );
157sub write_xml_program( $$ );
158
159my %STATES = (
160  'SA - Adelaide' => 'Adelaide', 'Queensland - Brisbane' => 'Brisbane',
161  'ACT - Canberra' => 'Canberra', 'NT - Darwin' => 'Darwin',
162  'Tasmania - Hobart' => 'Hobart', 'Victoria - Melbourne' => 'Melbourne',
163  'NSW - Regional' => 'NSWReg', 'NT - Regional' => 'NTReg',
164  'WA - Perth' => 'Perth', 'Queensland - Regional' => 'QLDReg',
165  'SA - Regional' => 'SAReg', 'NSW - Sydney' => 'Sydney',
166  'Tasmania - Regional' => 'TASReg', 'Victoria - Regional' => 'VICReg',
167  'WA - Regional' => 'WAReg'
168);
169
170my %SERVICES = (
171  'Austar Analogue' => 'austar', 'Austar Digital' => 'austard',
172  'Foxtel Analogue' => 'foxtel', 'Foxtel Digital' => 'foxteld',
173  'Free to Air' => 'free', 'Free to Air Digital' => 'freesd',
174  'Free to Air Digital (High Definition)' => 'freehd', 'Optus' => 'optus'
175);
176
177# Get options, including undocumented --cache option.
178XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux');
179
180# set user-agent manually
[48]181$XMLTV::Get_nice::ua->agent("tv_grab_au/0.6.2.3");
[43]182
183my ($opt_days, $opt_offset, $opt_help, $opt_output,
184  $opt_list_channels, $opt_loc, $opt_debug, $opt_share,
185  $opt_configure, $opt_config_file, $opt_quiet, $opt_srv,
186  $opt_dual_names, $opt_nodelay, $opt_no_icons);
187#  $opt_slow, $opt_nodelay, $doonce);
188my ($opt_timezone, $opt_channels_file, $opt_region, $opt_version, $opt_desc); # shepherd specific
189
190$opt_days  = 7; $opt_offset = 0; $opt_nodelay = 0;
191$opt_quiet  = 0; $opt_debug  = 0;
192#$opt_dual_names = 0; $opt_no_icons = 0;
193#$doonce = 0;
194GetOptions('days=i'        => \$opt_days,
195           'offset=i'      => \$opt_offset,
196           'help'          => \$opt_help,
197           'configure'     => \$opt_configure,
198           'config-file=s' => \$opt_config_file,
199           'output=s'      => \$opt_output,
200           'quiet'         => \$opt_quiet,
201           'list-channels' => \$opt_list_channels,
202           'loc=s'         => \$opt_loc,
203           'srv=s'         => \$opt_srv,
204           'debug'         => \$opt_debug,
205           'share=s'       => \$opt_share, # undocumented
206           'dual-names'    => \$opt_dual_names,
207           'nodelay'       => \$opt_nodelay,
208
209           'timezone=s'    => \$opt_timezone,
210           'channels_file=s' => \$opt_channels_file,
211           'region=i'      => \$opt_region,
212           'version'       => \$opt_version,
213           'ready'         => \$opt_version,
214           'desc'          => \$opt_desc,
215
216           'no-icons'      => \$opt_no_icons
217          )
218  or usage(0);
219
220die 'number of days must not be negative'
221  if (defined $opt_days && $opt_days < 0);
222
223usage(1) if $opt_help;
224
225if ($opt_configure and $opt_list_channels) {
226  print STDERR "cannot both configure and list channels, assuming --list-channels only\n";
227  $opt_configure = 0;
228}
229if ($opt_quiet and $opt_debug) {
230  print STDERR "cannot both be quiet and debugin' (you fool!), assuming --debug only\n";
231  $opt_quiet = 0;
232}
233
234use vars '%regmap';
235use vars '%namemap';
236use vars '$BASE_TZ';
237my ($region, $service, $ch_xid, $ch_wid, $ch_name, $ch_xmlid);
238my (%channels, %nochannels, %channels_name, %nochannels_name, %channels_freq);
239my $writer;
240# track # of urls and d/l bytes
241my $total_fetches = 0; my $total_bytes = 0;
242my @to_get;
243my $proc_time = ParseDate('now');
244
[48]245print "d1 v0.6.2.3  tv_grab_au\n";
[43]246printf "d1 grabs tv guide data from Development 1 Australia (www.d1.com.au).\n" if $opt_desc;
247exit(0) if ($opt_version || $opt_desc);
248
[47]249if (($opt_channels_file) && ($opt_region) && ($opt_output)) {
[48]250  printf "called from shepherd!\n";
251  $opt_debug = 0; # hack - shepherd calls with --debug which is noisy in here
[43]252  # called from shepherd!
[47]253  if ($opt_timezone) {
254        $BASE_TZ = "+".$opt_timezone;
255        Date_Init("TZ=$BASE_TZ");
256  }
[43]257
258  # based on $opt_region set 'region' appropriately
259  $region = "", my @reglist;
260  @reglist = (93,94);           foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Melbourne"; } }
261  @reglist = (95,90,98);        foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "VICReg"; } }
262  @reglist = (73);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Sydney"; } }
263  @reglist = (66,67,63,69,71,106,184); foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "NSWReg"; } }
264  @reglist = (75,78);           foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Brisbane"; } }
265  @reglist = (79,114);          foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "QLDReg"; } }
266  @reglist = (101);             foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Perth"; } }
267  @reglist = (102);             foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "WAReg"; } }
268  @reglist = (81);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Adelaide"; } }
269  @reglist = (82,83,85,86,107); foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "SAReg"; } }
270  @reglist = (74);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Darwin"; } }
271  @reglist = (108);             foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "NTReg"; } }
272  @reglist = (73);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Canberra"; } }
273  @reglist = (88);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Hobart"; } }
274  die "tv_grab_au_d1 doesn't support region $opt_region!\n" if ($region eq "");
275  $regmap{$region} = "";
276
277  $service = "freesd"; # only support free-to-air digital tv
278
279  # populate channels
280  my $channels;
281  if (-r $opt_channels_file) {
282        local (@ARGV, $/) = ($opt_channels_file);
283        no warnings 'all'; eval <>; die "$@" if $@;
284  } else {
285        die "WARNING: channels file $opt_channels_file could not be read\n";
286  }
287
288  my %w_args;
289  my $fh = new IO::File(">$opt_output") || die "cannot write to $opt_output: $!";
290  $w_args{OUTPUT} = $fh;
291  $w_args{encoding} = 'ISO-8859-1';
292  $writer = new XMLTV::Writer(%w_args);
293  $writer->start(xhead($region, $service));
294
295  foreach my $chan (keys %{$channels}) {
296        my $chan_name = "freesd.".$region.".";
297        if    ($chan eq "ABC")          { $chan_name .= "2"; }
298        elsif ($chan eq "ABC2")         { $chan_name .= "2-2"; }
299        elsif ($chan eq "SBS")          { $chan_name .= "SBS"; }
[48]300        elsif ($chan eq "SBS News")     { $chan_name .= "SBS-2"; }
[43]301        elsif ($chan eq "Seven")        { $chan_name .= "7"; }
302        elsif ($chan eq "Nine")         { $chan_name .= "9"; }
303        elsif ($chan eq "TEN")          { $chan_name .= "10"; }
304        else { $chan_name .= "unknown.$chan"; }
305
306        $writer->write_channel( { 'display-name' => [[ $chan, "en" ]], 'id' => $channels->{$chan} });
307
308        my $day = dc(ParseDate('now'), "$opt_offset days");
309        for (my $i = 0; $i < $opt_days; $i++) { # for each day
310                $day = dc($day, '+ 1 day') if ($i > 0);
311                push @to_get, [ $day, $channels->{$chan}, $chan_name, $chan_name, $chan, $service ];
312        }
313  }
314
315  goto PROCESS; # hate goto's but want to minimize changes to existing code
316}
317
318# share/ directory for storing region-to-channel mapping files.
319# The directory can be overridden with the --share option.
320my $SHARE_DIR='/usr/share/xmltv';
321$SHARE_DIR = $opt_share if defined $opt_share;
322my $OUR_SHARE_DIR = (defined $SHARE_DIR) ? "$SHARE_DIR/tv_grab_au" : '.';
323my $channel_ids_file = "$OUR_SHARE_DIR/channel_ids";
324#die "file not found: $channel_ids_file" if not -f $channel_ids_file;
325
326if (not -f $channel_ids_file) {print STDERR "file not found: $channel_ids_file\nAborting...\n"; exit(1);}
327
328# app banner - yyyy-mm-dd format
329#if (not $opt_quiet) {print STDERR "\ttv_grab_au - (version 0.6.2 - release 2004-12-27)\n\n";}
330if (not $opt_quiet) {print STDERR "\ttv_grab_au - (version 0.6.2 - release 2005-05-31)\n\n";}
331
332# XMLTV config file.
333my $config_file  = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_au', $opt_quiet);
334#print STDERR "\n" if not $opt_quiet;
335
336if ($opt_debug) {print "DEBUGGIN ON!\n";}
337
338if ($opt_nodelay){$XMLTV::Get_nice::Delay=0;}
339else{$XMLTV::Get_nice::Delay=5;}
340
341if ($opt_configure) {
342  configure();
343  exit();
344}
345
346# not configuring, writing output.
347my %w_args;
348if (defined $opt_output) {
349  my $fh = new IO::File(">$opt_output");
350  die "cannot write to $opt_output: $!" if not defined $fh;
351  $w_args{OUTPUT} = $fh;
352}
353
354$w_args{encoding} = 'ISO-8859-1';
355$writer = new XMLTV::Writer(%w_args);
356
357# list channels only
358if ($opt_list_channels) {
359  if (not defined $opt_loc) {
360    my $msg = "--loc option required with --list-channels:\n";
361    foreach (sort keys %STATES) {$msg .= "    --loc $STATES{$_} for $_\n";}
362    die $msg;
363  }
364  if (not defined $opt_srv) {
365    my $msg = "--srv option required with --list-channels:\n";
366    foreach (sort keys %SERVICES) {$msg .= "    --srv $SERVICES{$_} for $_\n";}
367    die $msg;
368  }
369  if ($opt_debug) {print "sending $opt_loc to get_channel_ids\n";}
370  %regmap = get_channel_ids($opt_loc, $opt_srv);
371  if ($opt_debug) {print "recieving $regmap{'TZ'} from get_channel_ids\n";}
372  $writer->start(xhead($opt_loc, $opt_srv));
373#print STDERR "Doing foreach..\n";
374  foreach my $chan (get_channels($opt_loc, $opt_srv)) {
375     my $ch_wid = $chan->{wid};
376     my $ch_xid = $chan->{xid};
377     my $ch_icon = $chan->{icon};
378     my $ch_name = $chan->{'display-name'}->[0]->[0];
379#print STDERR "DB: wid:$ch_wid - xid:$ch_xid - icon:$ch_icon - name:$ch_name\n";
380     my $lang = "en";
381     my $ch_xmlid = "$ch_wid.d1.com.au";
382     if (($opt_no_icons) || (!$ch_icon)){
383       if ($opt_dual_names){$writer->write_channel(
384         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ], [ $ch_xid ] ] }); }
385       else {$writer->write_channel(
386         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ] ] }); }
387     }
388     else {
389       if ($opt_dual_names){$writer->write_channel(
390         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang],[$ch_xid]],icon=>[{src=>$ch_icon}]}); }
391       else {$writer->write_channel(
392         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang]],icon=>[{src=>$ch_icon}]}); }
393     }
394  }
395  $writer->end();
396  exit();
397}
398
399# Not configuring or listing, must be grabbing.
400my $line_num = 0;
401foreach (XMLTV::Config_file::read_lines($config_file)){
402  ++ $line_num;
403  next if not defined;
404  my $where = "$config_file:$line_num";
405  if (/^region:?\s+(\w+)$/){
406    warn "$where: already seen region\n" if defined $region;
407    $region = $1;
408    if ($opt_debug){print "* D1: region= $region\n";}
409  }
410  elsif (/^service:?\s+(\w+)$/){
411    warn "$where: already seen service\n" if defined $service;
412    $service = $1;
413    if ($opt_debug){print "* D1b: service= $service\n";}
414  }
415  elsif (/^\+channel:?\s(\S+)$/){$channels{$1}=$1;}
416  elsif (/^-channel:?\s(\S+)$/){$nochannels{$1}=$1;}
417  elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"$/){$channels{$1}=$1; $channels_name{$1}=$2;}
418  elsif (/^-channel:?\s(\S+)\s\"(.*?)\"$/){$nochannels{$1}=$1; $nochannels_name{$1}=$2;}
419  elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"\s(\d+)$/){$channels{$1}=$1;$channels_name{$1}=$2;$channels_freq{$1}=$3;}
420  elsif (/^-channel:?\s(\S+)\s\"(.*?)\"\s(\d+)$/){$nochannels{$1}=$1;$nochannels_name{$1}=$2;$channels_freq{$1}=$3;}
421  else {warn "$where: bad line\n";}
422}
423die "No channels specified, run me with --configure\n"
424  if not %channels;
425  %regmap = get_channel_ids($region, $service);
426  if ($opt_debug) {print "recieving $regmap{$region} from get_channel_ids\n";}
427  if (defined $regmap{$region}) {
428     $BASE_TZ = $regmap{$region}; if ($opt_debug) {print "regmap IS defined\n";}
429  }
430  else {
431     $BASE_TZ = "EST";
432     warn "$channel_ids_file: no TZ for $region!, using EST\n";
433  }
434
435#exit();
436
437Date_Init('TZ=$BASE_TZ');
438
439# set now date (with offset)
440my $now = dc(ParseDate('now'), "$opt_offset days");
441
442$writer->start(xhead($region, $service));
443
444# the order in which we fetch the channels do not matter
445my %all_xid; my %all_names; my %all_icons;
446
447# get all channels for region from www page
448 foreach (get_channels($region, $service)) {
449   $all_xid{$_->{wid}} = $_->{xid};
450   $all_icons{$_->{wid}} = $_->{icon};
451   if ($opt_debug){
452     print "get_ch (xid)  DB1: $_->{xid} \n";
453     print "get_ch (wid)  DB2: $_->{wid} \n";
454     print "get_ch (name) DB3: $_->{'display-name'}->[0]->[0] \n";
455     if ($_->{'icon'}){print "get_ch (icon) DB4: $_->{icon} \n";}
456       else {print "get_ch (icon) DB4: <NO ICON FOUND>\n";}
457   }
458   if ((!defined $channels_freq{$_->{wid}}) || ($channels_freq{$_->{wid}} != $_->{xid})){
459      if ($opt_debug){print "NEW FREQ: $channels_freq{$_->{wid}} was: $_->{xid}\n";}
460      $_->{xid} = $channels_freq{$_->{wid}};
461      $all_xid{$_->{wid}} = $channels_freq{$_->{wid}};
462   }
463   else {if ($opt_debug){print "NO NEW FREQs!\n";}}
464   if ($channels_name{$_->{wid}}){
465      if ($opt_debug){print "tv_grab_au.conf: channel $_->{wid} named $channels_name{$_->{wid}}.\n";}
466      $all_names{$_->{wid}} = [ [ $channels_name{$_->{wid}}, "en" ] ];
467   }
468   elsif ($namemap{$_->{wid}}){
469        if ($opt_debug){print "channel $_->{wid} has alt name, using $namemap{$_->{wid}} "};
470        if ($opt_debug){print "instead of $_->{'display-name'}->[0]->[0]\n";}
471        $all_names{$_->{wid}} = [ [ $namemap{$_->{'wid'}}, "en" ] ];
472   }
473   else {$all_names{$_->{wid}} = $_->{'display-name'};}
474#   if ($opt_debug) {
475##     print "GetChannels: X:$_->{xid} W:$_->{wid} N:$all_names{$_->{wid}}->[0]->[0]\n";
476#      print "GetChannels: X:$_->{xid} W:$_->{wid} N:$all_names{$_->{wid}}-[]->[] ";
477#   }
478   
479 }
480
481# make sure wanted channels exist
482foreach (keys %channels) {
483  if (not $all_xid{$_}) {
484    if ($opt_debug){print "channel configured but not from www page->: $_\n";}
485    if (defined $namemap{$_}) { # force to grab with channel name
486        if ($opt_debug){print "this channel: $_ has a alternate name - must be forced\n";}
487        $all_xid{$_} = $regmap{$_};
488        $all_names{$_} = [ [ $namemap{$_}, "en" ] ];
489    }
490    else {
491        # remove this channel from hash
492        delete $channels{$_};
493        warn "\nchannel: $_ not found on website (OFF-AIR?)\n";
494    }
495  }
496}
497
498# check for new channels
499foreach (keys %all_xid) {
500  if ($channels{$_}) {if ($opt_debug) {print "all_xid $_ known and wanted\n";} }
501  elsif ($nochannels{$_}) {if ($opt_debug) {print "all_xid $_ known and NOT wanted\n";} }
502  else {if ($opt_debug) {print "all_xid $_ unknown (NEW?)\n";}
503    warn "\nFound NEW Channel: $_ on website. Consider re-configuring.\n\n";
504  }
505}
506
507# write channels
508foreach my $ch_wid (keys %channels) {
509  my $ch_name = $all_names{$ch_wid}->[0]->[0];
510  my $ch_xid = $all_xid{$ch_wid};
511  my $ch_xmlid = "$ch_wid.d1.com.au";
512  my $ch_icon;
513  if ($all_icons{$ch_wid}){$ch_icon = $all_icons{$ch_wid};}
514#    else {$ch_icon = ""; $opt_no_icons = 1;}
515  my $lang="en"; ## FIXME: read from page, sbs has dual langs (en & 'other'(fr/es/jp/de))
516#  if ($opt_debug) {print "DB2: X:$ch_xid W:$ch_wid N:$ch_name\n";}
517  if ($opt_debug){print "wr_ch(xid): $ch_xid\nwr_ch(wid): $ch_wid\nwr_ch(icon): $ch_icon\nwr_ch(name): $ch_name\n";}
518  if (($opt_no_icons) || (!$ch_icon)){
519    if ($opt_dual_names){$writer->write_channel(
520      { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ], [ $ch_xid ] ] }); }
521    else {$writer->write_channel(
522         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ] ] }); }
523  }
524  else {
525    if ($opt_dual_names){$writer->write_channel(
526      { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang],[$ch_xid]],icon=>[{src=>$ch_icon}]}); }
527    else {$writer->write_channel(
528         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang]],icon=>[{src=>$ch_icon}]}); }
529  }
530  my $day=$now;
531  for (my $i = 0; $i < $opt_days; $i++) { # for each day
532    if ($i > 0) {$day = dc($day, '+ 1 day');}
533    push @to_get, [ $day, $ch_xmlid.".d1.com.au", $ch_xid, $ch_wid, $ch_name, $service ];
534  }
535}
536
537#exit();
538PROCESS:
539
540# The progress bar!
541my $bar;
542  $bar = new Term::ProgressBar('grabing listings', scalar @to_get)
543    if Have_bar && not $opt_quiet;
544
545my (%xmltv_id, %event_id, %rating, %today, %chan);
546foreach (@to_get) {
547  my ($day, $ch_xmlid, $ch_xid, $ch_wid, $ch_name, $service) = @$_;
548  if ($opt_debug) {print "** QDB2: name= $ch_name\t ch_Xid= $ch_xid"};
549  if ($opt_debug) {print "\t ch_Wid= $ch_wid\t Xmlid= $ch_xmlid Srv= $service\n"};
550  get_programs($writer, $day, $ch_xmlid, $ch_xid, $ch_wid, $ch_name, $service);
551  update $bar if Have_bar && not $opt_quiet;
552}
553
554$writer->end();
555# calc and format last line stats (# of urls, duration, total bytes)
556my $proc_time_end = &ParseDate("today");
557my $err; my $mins = 0; my $secs = 0;
558my $delta=&DateCalc($proc_time,$proc_time_end,\$err);
559if ($delta=~/^.*?:(\d+):(\d+)$/s) {$mins = $1; $secs = $2;}
560my $totbytes; my @bytes; my $totlen = length($total_bytes);
561if ($totlen > 0) {$bytes[2] = substr($total_bytes,-3,3); $totbytes = $bytes[2];}
562if ($totlen > 3) {$bytes[1] = substr($total_bytes,-6,3); $totbytes = "$bytes[1],$totbytes";}
563if ($totlen > 6) {$bytes[0] = substr($total_bytes,-9,3); $totbytes = "$bytes[0],$totbytes";}
564if (not $opt_quiet) {print STDERR "Completed $total_fetches URL grabs ($totbytes Bytes) in $mins minutes & $secs seconds\n";}
565exit();
566
567sub xhead( $$ ) {
568  my ($region, $service) = @_;
569  return { 'source-info-url'     => 'http://www.d1.com.au/',
570           'source-info-name'    => "D1 Australia",
571           'source-data-url'     => "http://www.d1.com.au/d1xmltv.asmx/GetChannels?provider=$service&region=$region",
572           'generator-info-name' => "XMLTV - tv_grab_au v0.6.2.1",
573           'generator-info-url'  => 'http://www.onlinetractorparts.com.au/rohbags/',
574         };
575}
576
577sub configure() {
578    XMLTV::Config_file::check_no_overwrite($config_file);
579    open(CONF, ">$config_file") or die "cannot write to $config_file: $!";
580    my $default_st = "NT - Darwin";
581    my $default_srv = "Free to Air";
582#    my $cn = askQuestion('Grab listings for which region?', $default_st, sort keys %STATES);
583    my $cn = ask_choice('Grab listings for which region?', $default_st, sort keys %STATES);
584
585    my $c = $STATES{$cn}; die if not defined $c;
586#    my $dn = askQuestion('Grab listings for which service?', $default_srv, sort keys %SERVICES);
587    my $dn = ask_choice('Grab listings for which service?', $default_srv, sort keys %SERVICES);
588
589    my $d = $SERVICES{$dn}; die if not defined $d;
590    print CONF "# tv_grab_au 0.6.2 config file\nregion $c\nservice $d\n";
591    print CONF "# \"channel name\" and \"frequency\" can be changed to suit\n";
592    print CONF "# [+yes/-no] [channel ID] [channel name] [frequency]\n";
593    my $answer; my $answer_all; my %compmap;
594    foreach (get_channels($c, $d)) {
595        my $ch_wid = $_->{wid};
596        my $ch_name = $_->{'display-name'};
597        my $ch_icon = $_->{'icon'};
598        my $ch_xid = $_->{'xid'};
599        my $ch_name_old;
600        $compmap{$ch_wid} = $ch_name;
601        if ($opt_debug){print "ch_wid: $ch_wid\nname: $ch_name->[0]->[0]\nxid: $ch_xid\n";}
602        if ($opt_debug && $ch_icon){print "icon: $ch_icon\n";}
603        if (defined $namemap{$ch_wid}){
604           if ($opt_debug){print "HAS a namemap: $namemap{$ch_wid}\n";}
605           $ch_name_old = $ch_name->[0]->[0];
606           $ch_name->[0]->[0] = $namemap{$ch_wid};
607        }
608        if ($answer_all) {
609            $answer = $answer_all;
610            print($answer eq 'yes' ? 'adding' : 'ignoring', " new channel $ch_name->[0]->[0]\n");
611        }
612        else {
613#           if (defined $ch_name_old){$answer=askQuestion("add channel: $ch_name->[0]->[0] ($ch_name_old)?", 'yes', 'yes', 'no', 'all', 'none');}
614            if (defined $ch_name_old){$answer=ask_choice("add channel: $ch_name->[0]->[0] ($ch_name_old)?", 'yes', 'yes', 'no', 'all', 'none');}
615            else {$answer=ask_choice("add channel: $ch_name->[0]->[0]?", 'yes', 'yes', 'no', 'all', 'none');}
616            if ( $answer eq 'all' ) {$answer='yes'; $answer_all='yes';}
617            elsif ( $answer eq 'none' ) {$answer='no'; $answer_all='no';}
618        }
619        if ($answer eq 'yes') {print CONF "+channel $ch_wid \"$ch_name->[0]->[0]\" $ch_xid\n";}
620        else {print CONF "-channel $ch_wid \"$ch_name->[0]->[0]\" $ch_xid\n";}
621    }
622    foreach my $key (keys %regmap){
623        if ($opt_debug){print "doing foreach keys regmap! --> $key\n";}
624        if (not defined $compmap{$key}){
625        if ($opt_debug){print "key matches compmap.\n";}
626         if (not $key eq "TZ"){
627           if ($opt_debug){print "key NO match.\n";}
628#          $answer=askQuestion("add extra channel $namemap{$key}?", 'yes', 'yes', 'no', 'all', 'none');
629           $answer=ask_choice("add extra channel $namemap{$key}?", 'yes', 'yes', 'no', 'all', 'none');
630           if ($opt_debug){print "answer is: $answer\n";}
631           if ($answer eq 'yes') {print CONF "channel $key \"$namemap{$key}\"\n";}
632           else {print CONF "-channel $key \"$namemap{$key}\"\n";}
633         }
634        if ($opt_debug){print "done foreach keys regmap!\n";}
635        }
636    }
637    close CONF or warn "cannot close $config_file: $!";
638    print "All done, run with no arguments to grab listings.\n";
639}
640
641# list the channels for a state.
642sub get_channels($$) {
643    my ($c, $d) = @_;
644    if ($opt_debug) {print "\n--> doing get_channels: c=$c d=$d \n";}
645    my $bar = new Term::ProgressBar('grabing channels', 1)
646      if Have_bar && not $opt_quiet;
647#    my $dt = UnixDate($now, "%Y-%m-%d");
648#    if ($opt_debug) {print "\n--> got UnixDate: $dt \n";}
649    my $url="http://www.d1.com.au/d1xmltv.asmx/GetChannels?provider=$d&region=$c";
650    if ($opt_debug) {print "\n--> getting url: $url \n";}
651    my $data = get_nice($url);
652    die "could not get channel listing $url, aborting\n"
653      if not defined $data;
654    update $bar if Have_bar && not $opt_quiet;
655    if ($opt_debug) {print "get_channels-> URL total_fetches ($total_fetches -> ";}
656    $total_fetches++; if ($opt_debug) {print "$total_fetches)\n";}
657    my $dbytes = length($data);
658    if ($opt_debug) {print "get_channels-> total_bytes (total:$total_bytes + current:$dbytes = ";}
659    $total_bytes = $total_bytes + $dbytes; if ($opt_debug) {print "$total_bytes)\n";}
660    if ($opt_debug) {print "\n--> got http data: $data \n";}
661    return extract_channel_data($data, $c, $d);
662}
663
664# Grabs per channel listings - GetChannels
665sub extract_channel_data( $$$ ) {
666   my ($data, $c, $d) = @_; my @r;
667   $data =~ /<NewDataSet(.*?)<\/NewDataSet>/s
668     or die "\nERROR: can't find DataSet for $c - $d\n";
669   $_ = $1;
670#   while (/<Channels.*?<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>.*?<\/Channels>/sg) {
671    foreach my $tmpdat ($1 =~ /<Channels(.*?)<\/Channels>/sg){
672    if ($opt_debug){print "Doing FOREACH loop: $tmpdat\n";}
673    $_ = $tmpdat;
674#    while (/<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>/sg) {
675#    $_=~/<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>/sg;
676     if ($opt_debug){print "Doing WHILE loop...\n";}
677     my ($ch_wid, $ch_xid, $ch_name, $ch_icon);
678#      if (defined $1){$ch_wid=$1;}
679#       else {print STDERR "ERROR! - no xmltv id found!\n";}
680#      if (defined $2){$ch_xid=$2;}
681#       else {print STDERR "ERROR! - no frequency found!\n";}
682#      if (defined $3){$ch_name=$3;}
683#       else {print STDERR "ERROR! - no channel name found!\n";}
684#      if (defined $4){$ch_icon=$4;}
685#       else {print STDERR "ERROR! - no channel icon found!\n";}
686     if ($_=~/<ChannelID>(.*?)<\/ChannelID/sg){$ch_wid=$1;}
687      else {print STDERR "ERROR! - no xmltv id found!\nData: $_\nDying!";die}
688     if ($_=~/<FreqID>(.*?)<\/FreqID>/sg){$ch_xid=$1;}
689      elsif ($_=~/<Channel>(.*?)<\/Channel>/sg){$ch_xid=$1;}
690      else {print STDERR "ERROR! - no frequency found for $ch_wid!\n";}
691     if ($_=~/<Name>(.*?)<\/Name>/sg){$ch_name=$1;}
692      else {print STDERR "ERROR! - no channel name found for $ch_wid!\n";}
693     if ($_=~/<Icon>(.*?)<\/Icon>/sg){$ch_icon=$1;}
694      else {print STDERR "ERROR! - no channel icon found for $ch_wid!\n";}
695     my $lang="en";
696     my $ch = { 'display-name' => [ [ $ch_name, $lang ] ], 'xid' => $ch_xid , 'wid' => $ch_wid, 'icon' => $ch_icon };
697     push @r, $ch;
698     if ($opt_debug){print "Found Channel:\tName= $ch_name\tWeb-ID= $ch_wid\tXml-ID= $ch_xid\t";}
699     if ($opt_debug && $ch_icon){print "Icon=$ch_icon\n";}
700       else {if ($opt_debug){print "\n";}}
701#    } # end while
702   } # end foreach
703   return @r;
704}
705
706# grab 1 days list of programmes for channel N.
707sub get_programs( $$$$$$$ ) {
708    my ($w, $date, $ch_xmltv_id, $ch_xid, $ch_www_id, $ch_name, $service) = @_;
709    if ($opt_debug){print "doing get_programs...\n"}
710    my $today = UnixDate($date, "%Y-%m-%d"); $today=~s/ //;
711    my $url="http://www.d1.com.au/d1xmltv.asmx/GetPrograms?channelid=$ch_www_id&date=$today";
712    if ($opt_debug) {print "getting URL: $url\n";}
713    my $data=get_nice($url);
714    if (not defined $data) {
715        warn "could not fetch $url, skipping this channel\n";
716        return;
717    }
718    if ($opt_debug) {print "get_programs-> URL total_fetches ($total_fetches -> ";}
719    $total_fetches++;
720    if ($opt_debug) {print "$total_fetches)\n";}
721    my $dbytes = length($data);
722    if ($opt_debug) {print "get_programs-> total_bytes (total:$total_bytes + current:$dbytes = ";}
723    $total_bytes = $total_bytes + $dbytes;
724    if ($opt_debug) {print "$total_bytes)\n";}
725    local $SIG{__WARN__} = sub {if ($opt_debug) {print "local SIG _WARN_ here\n";}
726        warn "$url: $_[0]";
727    };
728    if ($opt_debug){print "looking for NewDataSet.....\n";}
729    if ($data =~ /<NewDataSet(.*?)<\/NewDataSet>/s){
730#      or die "\nERROR: can't find DataSet for $ch_name - $today\nData is:\n$data\n";
731#      or warn "\nERROR: can't find DataSet for $ch_name - $today\nData is:\n$data\n";
732    $data = $1;
733    if ($opt_debug){print "Must have found NewDataSet!\n";}
734    foreach my $tmpdat ($data=~/<Programs(.*?)<\/Programs>/sg) {
735        if ($opt_debug){print "Found SOMETHING between <programs>!\n";}
736        if ($opt_debug){print "SOMETHING is:\n$tmpdat\nEND-SOMETHING\n";}
737        foreach my $tmpdat2 ($tmpdat){
738          my $mainhash;
739          ${$mainhash}{'xmltv_id'} = $ch_xmltv_id;
740          if ( $tmpdat2=~/<Start>(.*?)<\/Start>/sg ) {
741            if ($opt_debug){print "found start - $1 -|\n";}
742            ${$mainhash}{'starttime'}=$1;
743          }
744          if ( $tmpdat2=~/<Stop>(.*?)<\/Stop>/sg ) {
745            if ($opt_debug){print "found stop - $1 -|\n";}
746            ${$mainhash}{'stoptime'}=$1;
747          }
748          if ( $tmpdat2=~/<Title>(.*?)<\/Title>/sg ) {
749            if ($opt_debug){print "found title - $1 -|\n";}
750            ${$mainhash}{'title'}=$1;
751          }
752          if ( $tmpdat2=~/<Subtitle>(.*?)<\/Subtitle>/sg ) {
753            if ($opt_debug){print "found subtitle - $1 -|\n";}
754            ${$mainhash}{'subtitle'}=$1;
755          }
756          if ( $tmpdat2=~/<Description>(.*?)<\/Description>/sg ) {
757            if ($opt_debug){print "found description - $1 -|\n";}
758            ${$mainhash}{'desc'}=$1;
759          }
760          if ( $tmpdat2=~/<Category>(.*?)<\/Category>/sg ) {
761            if ($opt_debug){print "found category - $1 -|\n";}
762            ${$mainhash}{'genre'}=$1;
763          }
764          if ( $tmpdat2=~/<Rating>(.*?)<\/Rating>/sg ) {
765            my $rate = $1;
766            if ( $rate=~/(.*?)\t$/ ) { $rate=$1; if ($opt_debug){print "-->rating has tab\n";}}
767            if ( $rate=~/(.*?)\s*$/ ) { $rate=$1; if ($opt_debug){print "-->rating has space(s)\n";}}
768            if ($opt_debug) {print "found rating - $rate -|- $1 -|\n";}
769            ${$mainhash}{'rating'}=$rate;
770          }
771                ${$mainhash}{'xid'}=$ch_xid;
772                write_xml_program($w, $mainhash);
773        }
774    }
775   }
776   else {
777     print STDERR "\nERROR: can't find DataSet for $ch_name - $today\n";
778     if ($opt_debug){"Data is:\n$data\n";}
779     }
780 } #-> end get_programs
781
782# get channel-to-region ids from file, also gets local timezone
783sub get_channel_ids( $$ ) {
784  if ($opt_debug) {print "doing get_channel_ids!\n";}
785  my ($region, $service) = @_;
786  if ($opt_debug) {print "Region is: $region\n";}
787  if ($opt_debug) {print "Service is: $service\n";}
788  my $line_num = 0;
789  foreach (XMLTV::Config_file::read_lines($channel_ids_file, 1)) {
790    ++ $line_num;
791    next if not defined;
792    my $ch = $_;
793    if (not defined $ch) {warn "$channel_ids_file:$line_num: unknown channel id $_\n";}
794    else {
795       if ($ch=~m/^$region:(.*?)$/sg){
796        if ($opt_debug) {print "region matches! $region->$1<-\n";}
797         $regmap{$region} = $1;
798       }
799      else {
800        if ($opt_debug) {print "no match! - $ch.\n";} 
801      }
802    }
803  }
804  if (defined $regmap{$region}) {if ($opt_debug) {print "regmap IS defined-> ($region = $regmap{$region})\n";}
805  } else {$regmap{$region}="EST"; warn "$channel_ids_file: no TZ for $region!, using EST\n";}
806  # to do - can fix daylight savings prob from here
807  if ($regmap{$region} eq "EST") {$regmap{$region}="+1000"}
808  if ($regmap{$region} eq "CST") {$regmap{$region}="+0930"}
809  if ($regmap{$region} eq "WST") {$regmap{$region}="+0800"}
810  if ($opt_debug) {print "done get_channel_ids!\n";}
811  return %regmap;
812}
813
814# Bump a YYYYMMDD date by one. (20030607)
815sub nextdate( $ ) {
816  if ($opt_debug) {print "start nextdate\n";}
817  my $d = shift; $d =~ /^\d{8}$/ or die;
818  my $p = ParseDate($d);
819  my $n = dc($p, '+ 1 day');
820  if ($opt_debug) {print "end nextdate\n";}
821  return UnixDate($n, '%Q');
822}
823
824# Wrapper for DateCalc().
825sub dc( $$ ) {
826  if ($opt_debug) {print "start dc\n";}
827  my $err;
828  my $r = DateCalc(@_, \$err);
829  die "DateCalc() failed with $err" if $err;
830  die 'DateCalc() returned undef' if not defined $r;
831  if ($opt_debug) {print "end dc\n";}
832  return $r;
833}
834
835sub write_xml_program( $$ ) {
836  my ($w, $mainhash) = @_;
837  my ($starttime, $stoptime);
838  if ($opt_debug) {print "---> doing write_xml_program\n";}
839  # convert times to standard format
840#  $starttime=UnixDate(${$mainhash}{'starttime'}, "%H%M");
841#  $starttime="${$mainhash}{'today'}$starttime"."00"." $BASE_TZ";
842  if ($opt_debug){print "DB: regmap(region) is: $regmap{$region}\n";}
843  # fixme - source times are EST!
844  $starttime = ${$mainhash}{'starttime'};
845  $stoptime = ${$mainhash}{'stoptime'};
846 
847  # convert times from EST to local times (broken due to source!)
848#  Date_Init('TZ=+0930');
849#  $starttime = UnixDate($starttime, "%Y%m%d%H%M%S %z");
850#  $stoptime = UnixDate($stoptime, "%Y%m%d%H%M%S %z");
851
852  # ugly hack - change TZ to local TZ NOT convert actual times!
853  if ($opt_debug){print "***> SEARCHING for TZ in starttime.... ($starttime)\n";}
854  if ($starttime=~/^(.*?)\s(.*?)$/) {
855    my $time = $1; my $timetz = $2;
856    if ($opt_debug){print "**> FOUND TZ in starttime: $timetz - ($starttime)\n";}
857    $starttime = $time . " " . $regmap{$region};
858    if ($opt_debug){print "**> NEW starttime is: $starttime\n";}
859  }
860  if ($opt_debug){print "***> SEARCHING for TZ in stoptime.... ($stoptime)\n";}
861  if ($stoptime=~/^(.*?)\s(.*?)$/) {
862    my $time = $1; my $timetz = $2;
863    if ($opt_debug){print "**> FOUND TZ in stoptime: $timetz - ($stoptime)\n";}
864    $stoptime = $time . " " . $regmap{$region};
865    if ($opt_debug){print "**> NEW stoptime is: $stoptime\n";}
866  }
867  if ($opt_debug){print "***> DONE looking and swapping TZ's!\n";}
868
869  if ($opt_debug) {print "---> mainhash=$mainhash\n";}
870  if ($opt_debug) {print "---> hash(xmltv_id)=${$mainhash}{'xmltv_id'}\n";}
871  if ($opt_debug) {print "---> hash(xid)=${$mainhash}{'xid'}\n";}
872  if ($opt_debug) {print "---> hash(starttime)=$starttime (${$mainhash}{'starttime'})\n";}
873  if ($opt_debug && ${$mainhash}{'stoptime'}) {print "---> hash(stoptime)=$stoptime (${$mainhash}{'stoptime'})\n";}
874#  if ($opt_debug) {print "---> hash(today)=${$mainhash}{'today'}\n";}
875  if ($opt_debug) {print "---> hash(title)=${$mainhash}{'title'}\n";}
876  if ($opt_debug && ${$mainhash}{'subtitle'}) {print "---> hash(subtitle)=${$mainhash}{'subtitle'}\n";}
877  if ($opt_debug && ${$mainhash}{'rating'}) {print "---> hash(rating)=${$mainhash}{'rating'}\n";}
878  # start writing xmltv programme element
879  if (${$mainhash}{'stoptime'} && ${$mainhash}{'starttime'}) {
880     $w->startTag('programme', start=> $starttime, stop => $stoptime, channel=> ${$mainhash}{'xmltv_id'});
881  } elsif (${$mainhash}{'starttime'} && not ${$mainhash}{'stoptime'}) {
882     $w->startTag('programme', start=> $starttime, channel=> ${$mainhash}{'xmltv_id'});
883  } else {
884     warn "\n\n **  im outa here! **\nno start-stop time combo! :O\n"; die;
885  }
886  $w->dataElement('title', ${$mainhash}{'title'}, 'lang'=>"en"); # fixme: get lang
887  if (${$mainhash}{'subtitle'}) {$w->dataElement('sub-title',${$mainhash}{'subtitle'},'lang'=>"en");}
888  if (${$mainhash}{'desc'}) {$w->dataElement('desc', ${$mainhash}{'desc'}, 'lang' => "en");}
889#  if (%{$dcpdesc}) {
890#    $w->startTag('credits');
891#    if (${$dcpdesc}{'director'}) {$w->dataElement('director', ${$dcpdesc}{'director'});}
892#    if (${$dcpdesc}{'writer'}) {$w->dataElement('writer', ${$dcpdesc}{'writer'});}
893#    if (${$dcpdesc}{'adapter'}) {$w->dataElement('adapter', ${$dcpdesc}{'adapter'});}
894#    if (${$dcpdesc}{'producer'}) {$w->dataElement('producer', ${$dcpdesc}{'producer'});}
895#    if (${$dcpdesc}{'presenter'}) {$w->dataElement('presenter', ${$dcpdesc}{'presenter'});}
896#    if (${$dcpdesc}{'host'}) {$w->dataElement('presenter', $$dcpdesc{'host'});} # fixme?
897#    if (${$dcpdesc}{'commentator'}) {$w->dataElement('commentator', ${$dcpdesc}{'commentator'});}
898#    if (${$dcpdesc}{'guest'}) {$w->dataElement('guest', ${$dcpdesc}{'guest'});}
899#    if (@{$pcast}) { foreach $_ (@{$pcast}){$w->dataElement('actor', $_);} }
900#    $w->endTag('credits');
901#  }
902  if (${$mainhash}{'date'}) {$w->dataElement('category', ${$mainhash}{'date'}, 'lang' => "en");}
903  if (${$mainhash}{'genre'}) {$w->dataElement('category', ${$mainhash}{'genre'}, 'lang' => "en");}
904  if (${$mainhash}{'live'}) {$w->dataElement('category', "Live", 'lang' => "en");}
905  if (${$mainhash}{'lang'}) {$w->dataElement('language', ${$mainhash}{'lang'}, 'lang' => "en");}
906  if (${$mainhash}{'olang'}) {$w->dataElement('orig-language', ${$mainhash}{'olang'}, 'lang' => "en");}
907#  if (${$mainhash}{'length'}) {$w->dataElement('length', ${$mainhash}{'length'}, 'units' => "minutes");}
908  if (${$mainhash}{'length'}) {
909    my $l = ${$mainhash}{'length'}; my $units = 'minutes';
910    if ($l % 60 == 0) {$units = 'hours'; $l /= 60;}
911    $w->dataElement('length', $l, 'units' => $units);
912  }
913  # icon goes here
914  if (${$mainhash}{'url'}) {$w->dataElement('url',${$mainhash}{'url'});}
915  if (${$mainhash}{'country'}) {$w->dataElement('country', ${$mainhash}{'country'}, 'lang' => "en");}
916  if (${$mainhash}{'epnum'}) {$w->dataElement('episode-num',${$mainhash}{'epnum'});}
917  if (${$mainhash}{'video-col'} or ${$mainhash}{'video-asp'}) { # present(yes/no), color(yes/no), aspect(4:3/16:9)
918    $w->startTag('video');
919    if (${$mainhash}{'video-col'}) {$w->dataElement('color', "no");}
920    if (${$mainhash}{'video-asp'}) {$w->dataElement('aspect', ${$mainhash}{'video-asp'});}
921    $w->endTag('video');
922  }
923  if (${$mainhash}{'audio'}) { # present(yes/no),stereo(mono/stereo/surround)
924    $w->startTag('audio');
925    $w->dataElement('present', "yes");
926    $w->dataElement('stereo', "surround");
927    $w->endTag('audio');
928  }
929  if (${$mainhash}{'repeat'}) {$w->emptyTag('previously-shown',"");}
930  if (${$mainhash}{'premiere'}) {$w->emptyTag('premiere',"");}
931  if (${$mainhash}{'last'}) {$w->emptyTag('last-chance',"");}
932  if (${$mainhash}{'new'}) {$w->emptyTag('new',"");}
933  if (${$mainhash}{'captions'}) {$w->emptyTag('subtitles', 'type' => "teletext");}
934  if (${$mainhash}{'rating'}) {
935    $w->startTag('rating', 'system' => "CTVA");
936    $w->dataElement('value', ${$mainhash}{'rating'});
937    $w->endTag('rating');
938  }
939  if (${$mainhash}{'stars'}) {
940    $w->startTag('star-rating');
941    $w->dataElement('value', ${$mainhash}{'stars'});
942    $w->endTag('star-rating');
943  }
944  $w->endTag('programme');
945  if ($opt_debug) {print "---> done write_xml_program <-|\n";}
946}
947
948# the end :)
Note: See TracBrowser for help on using the browser.