root/grabbers/d1 @ 47

Revision 47, 38.7 kB (checked in by lincoln, 7 years ago)

get rid of d1 timezone cruft
  • Property svn:executable set to *
Line 
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
8tv_grab_au (0.6.2.2) - Grab TV listings for Australia.
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
119$0 (0.6.2.2): grab Australian television listings in XMLTV format
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
181$XMLTV::Get_nice::ua->agent("tv_grab_au/0.6.2.2");
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
245print "d1 v0.6.2.2  tv_grab_au\n";
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
249if (($opt_channels_file) && ($opt_region) && ($opt_output)) {
250  # called from shepherd!
251  if ($opt_timezone) {
252        $BASE_TZ = "+".$opt_timezone;
253        Date_Init("TZ=$BASE_TZ");
254  }
255
256  # based on $opt_region set 'region' appropriately
257  $region = "", my @reglist;
258  @reglist = (93,94);           foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Melbourne"; } }
259  @reglist = (95,90,98);        foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "VICReg"; } }
260  @reglist = (73);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Sydney"; } }
261  @reglist = (66,67,63,69,71,106,184); foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "NSWReg"; } }
262  @reglist = (75,78);           foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Brisbane"; } }
263  @reglist = (79,114);          foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "QLDReg"; } }
264  @reglist = (101);             foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Perth"; } }
265  @reglist = (102);             foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "WAReg"; } }
266  @reglist = (81);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Adelaide"; } }
267  @reglist = (82,83,85,86,107); foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "SAReg"; } }
268  @reglist = (74);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Darwin"; } }
269  @reglist = (108);             foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "NTReg"; } }
270  @reglist = (73);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Canberra"; } }
271  @reglist = (88);              foreach my $reg (@reglist) { if ($opt_region == $reg) { $region = "Hobart"; } }
272  die "tv_grab_au_d1 doesn't support region $opt_region!\n" if ($region eq "");
273  $regmap{$region} = "";
274
275  $service = "freesd"; # only support free-to-air digital tv
276
277  # populate channels
278  my $channels;
279  if (-r $opt_channels_file) {
280        local (@ARGV, $/) = ($opt_channels_file);
281        no warnings 'all'; eval <>; die "$@" if $@;
282  } else {
283        die "WARNING: channels file $opt_channels_file could not be read\n";
284  }
285
286  my %w_args;
287  my $fh = new IO::File(">$opt_output") || die "cannot write to $opt_output: $!";
288  $w_args{OUTPUT} = $fh;
289  $w_args{encoding} = 'ISO-8859-1';
290  $writer = new XMLTV::Writer(%w_args);
291  $writer->start(xhead($region, $service));
292
293  foreach my $chan (keys %{$channels}) {
294        my $chan_name = "freesd.".$region.".";
295        if    ($chan eq "ABC")          { $chan_name .= "2"; }
296        elsif ($chan eq "ABC2")         { $chan_name .= "2-2"; }
297        elsif ($chan eq "SBS")          { $chan_name .= "SBS"; }
298        elsif ($chan eq "Seven")        { $chan_name .= "7"; }
299        elsif ($chan eq "Nine")         { $chan_name .= "9"; }
300        elsif ($chan eq "TEN")          { $chan_name .= "10"; }
301        else { $chan_name .= "unknown.$chan"; }
302
303        $writer->write_channel( { 'display-name' => [[ $chan, "en" ]], 'id' => $channels->{$chan} });
304
305        my $day = dc(ParseDate('now'), "$opt_offset days");
306        for (my $i = 0; $i < $opt_days; $i++) { # for each day
307                $day = dc($day, '+ 1 day') if ($i > 0);
308                push @to_get, [ $day, $channels->{$chan}, $chan_name, $chan_name, $chan, $service ];
309        }
310  }
311
312  goto PROCESS; # hate goto's but want to minimize changes to existing code
313}
314
315# share/ directory for storing region-to-channel mapping files.
316# The directory can be overridden with the --share option.
317my $SHARE_DIR='/usr/share/xmltv';
318$SHARE_DIR = $opt_share if defined $opt_share;
319my $OUR_SHARE_DIR = (defined $SHARE_DIR) ? "$SHARE_DIR/tv_grab_au" : '.';
320my $channel_ids_file = "$OUR_SHARE_DIR/channel_ids";
321#die "file not found: $channel_ids_file" if not -f $channel_ids_file;
322
323if (not -f $channel_ids_file) {print STDERR "file not found: $channel_ids_file\nAborting...\n"; exit(1);}
324
325# app banner - yyyy-mm-dd format
326#if (not $opt_quiet) {print STDERR "\ttv_grab_au - (version 0.6.2 - release 2004-12-27)\n\n";}
327if (not $opt_quiet) {print STDERR "\ttv_grab_au - (version 0.6.2 - release 2005-05-31)\n\n";}
328
329# XMLTV config file.
330my $config_file  = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_au', $opt_quiet);
331#print STDERR "\n" if not $opt_quiet;
332
333if ($opt_debug) {print "DEBUGGIN ON!\n";}
334
335if ($opt_nodelay){$XMLTV::Get_nice::Delay=0;}
336else{$XMLTV::Get_nice::Delay=5;}
337
338if ($opt_configure) {
339  configure();
340  exit();
341}
342
343# not configuring, writing output.
344my %w_args;
345if (defined $opt_output) {
346  my $fh = new IO::File(">$opt_output");
347  die "cannot write to $opt_output: $!" if not defined $fh;
348  $w_args{OUTPUT} = $fh;
349}
350
351$w_args{encoding} = 'ISO-8859-1';
352$writer = new XMLTV::Writer(%w_args);
353
354# list channels only
355if ($opt_list_channels) {
356  if (not defined $opt_loc) {
357    my $msg = "--loc option required with --list-channels:\n";
358    foreach (sort keys %STATES) {$msg .= "    --loc $STATES{$_} for $_\n";}
359    die $msg;
360  }
361  if (not defined $opt_srv) {
362    my $msg = "--srv option required with --list-channels:\n";
363    foreach (sort keys %SERVICES) {$msg .= "    --srv $SERVICES{$_} for $_\n";}
364    die $msg;
365  }
366  if ($opt_debug) {print "sending $opt_loc to get_channel_ids\n";}
367  %regmap = get_channel_ids($opt_loc, $opt_srv);
368  if ($opt_debug) {print "recieving $regmap{'TZ'} from get_channel_ids\n";}
369  $writer->start(xhead($opt_loc, $opt_srv));
370#print STDERR "Doing foreach..\n";
371  foreach my $chan (get_channels($opt_loc, $opt_srv)) {
372     my $ch_wid = $chan->{wid};
373     my $ch_xid = $chan->{xid};
374     my $ch_icon = $chan->{icon};
375     my $ch_name = $chan->{'display-name'}->[0]->[0];
376#print STDERR "DB: wid:$ch_wid - xid:$ch_xid - icon:$ch_icon - name:$ch_name\n";
377     my $lang = "en";
378     my $ch_xmlid = "$ch_wid.d1.com.au";
379     if (($opt_no_icons) || (!$ch_icon)){
380       if ($opt_dual_names){$writer->write_channel(
381         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ], [ $ch_xid ] ] }); }
382       else {$writer->write_channel(
383         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ] ] }); }
384     }
385     else {
386       if ($opt_dual_names){$writer->write_channel(
387         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang],[$ch_xid]],icon=>[{src=>$ch_icon}]}); }
388       else {$writer->write_channel(
389         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang]],icon=>[{src=>$ch_icon}]}); }
390     }
391  }
392  $writer->end();
393  exit();
394}
395
396# Not configuring or listing, must be grabbing.
397my $line_num = 0;
398foreach (XMLTV::Config_file::read_lines($config_file)){
399  ++ $line_num;
400  next if not defined;
401  my $where = "$config_file:$line_num";
402  if (/^region:?\s+(\w+)$/){
403    warn "$where: already seen region\n" if defined $region;
404    $region = $1;
405    if ($opt_debug){print "* D1: region= $region\n";}
406  }
407  elsif (/^service:?\s+(\w+)$/){
408    warn "$where: already seen service\n" if defined $service;
409    $service = $1;
410    if ($opt_debug){print "* D1b: service= $service\n";}
411  }
412  elsif (/^\+channel:?\s(\S+)$/){$channels{$1}=$1;}
413  elsif (/^-channel:?\s(\S+)$/){$nochannels{$1}=$1;}
414  elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"$/){$channels{$1}=$1; $channels_name{$1}=$2;}
415  elsif (/^-channel:?\s(\S+)\s\"(.*?)\"$/){$nochannels{$1}=$1; $nochannels_name{$1}=$2;}
416  elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"\s(\d+)$/){$channels{$1}=$1;$channels_name{$1}=$2;$channels_freq{$1}=$3;}
417  elsif (/^-channel:?\s(\S+)\s\"(.*?)\"\s(\d+)$/){$nochannels{$1}=$1;$nochannels_name{$1}=$2;$channels_freq{$1}=$3;}
418  else {warn "$where: bad line\n";}
419}
420die "No channels specified, run me with --configure\n"
421  if not %channels;
422  %regmap = get_channel_ids($region, $service);
423  if ($opt_debug) {print "recieving $regmap{$region} from get_channel_ids\n";}
424  if (defined $regmap{$region}) {
425     $BASE_TZ = $regmap{$region}; if ($opt_debug) {print "regmap IS defined\n";}
426  }
427  else {
428     $BASE_TZ = "EST";
429     warn "$channel_ids_file: no TZ for $region!, using EST\n";
430  }
431
432#exit();
433
434Date_Init('TZ=$BASE_TZ');
435
436# set now date (with offset)
437my $now = dc(ParseDate('now'), "$opt_offset days");
438
439$writer->start(xhead($region, $service));
440
441# the order in which we fetch the channels do not matter
442my %all_xid; my %all_names; my %all_icons;
443
444# get all channels for region from www page
445 foreach (get_channels($region, $service)) {
446   $all_xid{$_->{wid}} = $_->{xid};
447   $all_icons{$_->{wid}} = $_->{icon};
448   if ($opt_debug){
449     print "get_ch (xid)  DB1: $_->{xid} \n";
450     print "get_ch (wid)  DB2: $_->{wid} \n";
451     print "get_ch (name) DB3: $_->{'display-name'}->[0]->[0] \n";
452     if ($_->{'icon'}){print "get_ch (icon) DB4: $_->{icon} \n";}
453       else {print "get_ch (icon) DB4: <NO ICON FOUND>\n";}
454   }
455   if ((!defined $channels_freq{$_->{wid}}) || ($channels_freq{$_->{wid}} != $_->{xid})){
456      if ($opt_debug){print "NEW FREQ: $channels_freq{$_->{wid}} was: $_->{xid}\n";}
457      $_->{xid} = $channels_freq{$_->{wid}};
458      $all_xid{$_->{wid}} = $channels_freq{$_->{wid}};
459   }
460   else {if ($opt_debug){print "NO NEW FREQs!\n";}}
461   if ($channels_name{$_->{wid}}){
462      if ($opt_debug){print "tv_grab_au.conf: channel $_->{wid} named $channels_name{$_->{wid}}.\n";}
463      $all_names{$_->{wid}} = [ [ $channels_name{$_->{wid}}, "en" ] ];
464   }
465   elsif ($namemap{$_->{wid}}){
466        if ($opt_debug){print "channel $_->{wid} has alt name, using $namemap{$_->{wid}} "};
467        if ($opt_debug){print "instead of $_->{'display-name'}->[0]->[0]\n";}
468        $all_names{$_->{wid}} = [ [ $namemap{$_->{'wid'}}, "en" ] ];
469   }
470   else {$all_names{$_->{wid}} = $_->{'display-name'};}
471#   if ($opt_debug) {
472##     print "GetChannels: X:$_->{xid} W:$_->{wid} N:$all_names{$_->{wid}}->[0]->[0]\n";
473#      print "GetChannels: X:$_->{xid} W:$_->{wid} N:$all_names{$_->{wid}}-[]->[] ";
474#   }
475   
476 }
477
478# make sure wanted channels exist
479foreach (keys %channels) {
480  if (not $all_xid{$_}) {
481    if ($opt_debug){print "channel configured but not from www page->: $_\n";}
482    if (defined $namemap{$_}) { # force to grab with channel name
483        if ($opt_debug){print "this channel: $_ has a alternate name - must be forced\n";}
484        $all_xid{$_} = $regmap{$_};
485        $all_names{$_} = [ [ $namemap{$_}, "en" ] ];
486    }
487    else {
488        # remove this channel from hash
489        delete $channels{$_};
490        warn "\nchannel: $_ not found on website (OFF-AIR?)\n";
491    }
492  }
493}
494
495# check for new channels
496foreach (keys %all_xid) {
497  if ($channels{$_}) {if ($opt_debug) {print "all_xid $_ known and wanted\n";} }
498  elsif ($nochannels{$_}) {if ($opt_debug) {print "all_xid $_ known and NOT wanted\n";} }
499  else {if ($opt_debug) {print "all_xid $_ unknown (NEW?)\n";}
500    warn "\nFound NEW Channel: $_ on website. Consider re-configuring.\n\n";
501  }
502}
503
504# write channels
505foreach my $ch_wid (keys %channels) {
506  my $ch_name = $all_names{$ch_wid}->[0]->[0];
507  my $ch_xid = $all_xid{$ch_wid};
508  my $ch_xmlid = "$ch_wid.d1.com.au";
509  my $ch_icon;
510  if ($all_icons{$ch_wid}){$ch_icon = $all_icons{$ch_wid};}
511#    else {$ch_icon = ""; $opt_no_icons = 1;}
512  my $lang="en"; ## FIXME: read from page, sbs has dual langs (en & 'other'(fr/es/jp/de))
513#  if ($opt_debug) {print "DB2: X:$ch_xid W:$ch_wid N:$ch_name\n";}
514  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";}
515  if (($opt_no_icons) || (!$ch_icon)){
516    if ($opt_dual_names){$writer->write_channel(
517      { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ], [ $ch_xid ] ] }); }
518    else {$writer->write_channel(
519         { id => $ch_xmlid, 'display-name' => [ [ $ch_name, $lang ] ] }); }
520  }
521  else {
522    if ($opt_dual_names){$writer->write_channel(
523      { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang],[$ch_xid]],icon=>[{src=>$ch_icon}]}); }
524    else {$writer->write_channel(
525         { id=>$ch_xmlid,'display-name'=>[[$ch_name,$lang]],icon=>[{src=>$ch_icon}]}); }
526  }
527  my $day=$now;
528  for (my $i = 0; $i < $opt_days; $i++) { # for each day
529    if ($i > 0) {$day = dc($day, '+ 1 day');}
530    push @to_get, [ $day, $ch_xmlid.".d1.com.au", $ch_xid, $ch_wid, $ch_name, $service ];
531  }
532}
533
534#exit();
535PROCESS:
536
537# The progress bar!
538my $bar;
539  $bar = new Term::ProgressBar('grabing listings', scalar @to_get)
540    if Have_bar && not $opt_quiet;
541
542my (%xmltv_id, %event_id, %rating, %today, %chan);
543foreach (@to_get) {
544  my ($day, $ch_xmlid, $ch_xid, $ch_wid, $ch_name, $service) = @$_;
545  if ($opt_debug) {print "** QDB2: name= $ch_name\t ch_Xid= $ch_xid"};
546  if ($opt_debug) {print "\t ch_Wid= $ch_wid\t Xmlid= $ch_xmlid Srv= $service\n"};
547  get_programs($writer, $day, $ch_xmlid, $ch_xid, $ch_wid, $ch_name, $service);
548  update $bar if Have_bar && not $opt_quiet;
549}
550
551$writer->end();
552# calc and format last line stats (# of urls, duration, total bytes)
553my $proc_time_end = &ParseDate("today");
554my $err; my $mins = 0; my $secs = 0;
555my $delta=&DateCalc($proc_time,$proc_time_end,\$err);
556if ($delta=~/^.*?:(\d+):(\d+)$/s) {$mins = $1; $secs = $2;}
557my $totbytes; my @bytes; my $totlen = length($total_bytes);
558if ($totlen > 0) {$bytes[2] = substr($total_bytes,-3,3); $totbytes = $bytes[2];}
559if ($totlen > 3) {$bytes[1] = substr($total_bytes,-6,3); $totbytes = "$bytes[1],$totbytes";}
560if ($totlen > 6) {$bytes[0] = substr($total_bytes,-9,3); $totbytes = "$bytes[0],$totbytes";}
561if (not $opt_quiet) {print STDERR "Completed $total_fetches URL grabs ($totbytes Bytes) in $mins minutes & $secs seconds\n";}
562exit();
563
564sub xhead( $$ ) {
565  my ($region, $service) = @_;
566  return { 'source-info-url'     => 'http://www.d1.com.au/',
567           'source-info-name'    => "D1 Australia",
568           'source-data-url'     => "http://www.d1.com.au/d1xmltv.asmx/GetChannels?provider=$service&region=$region",
569           'generator-info-name' => "XMLTV - tv_grab_au v0.6.2.1",
570           'generator-info-url'  => 'http://www.onlinetractorparts.com.au/rohbags/',
571         };
572}
573
574sub configure() {
575    XMLTV::Config_file::check_no_overwrite($config_file);
576    open(CONF, ">$config_file") or die "cannot write to $config_file: $!";
577    my $default_st = "NT - Darwin";
578    my $default_srv = "Free to Air";
579#    my $cn = askQuestion('Grab listings for which region?', $default_st, sort keys %STATES);
580    my $cn = ask_choice('Grab listings for which region?', $default_st, sort keys %STATES);
581
582    my $c = $STATES{$cn}; die if not defined $c;
583#    my $dn = askQuestion('Grab listings for which service?', $default_srv, sort keys %SERVICES);
584    my $dn = ask_choice('Grab listings for which service?', $default_srv, sort keys %SERVICES);
585
586    my $d = $SERVICES{$dn}; die if not defined $d;
587    print CONF "# tv_grab_au 0.6.2 config file\nregion $c\nservice $d\n";
588    print CONF "# \"channel name\" and \"frequency\" can be changed to suit\n";
589    print CONF "# [+yes/-no] [channel ID] [channel name] [frequency]\n";
590    my $answer; my $answer_all; my %compmap;
591    foreach (get_channels($c, $d)) {
592        my $ch_wid = $_->{wid};
593        my $ch_name = $_->{'display-name'};
594        my $ch_icon = $_->{'icon'};
595        my $ch_xid = $_->{'xid'};
596        my $ch_name_old;
597        $compmap{$ch_wid} = $ch_name;
598        if ($opt_debug){print "ch_wid: $ch_wid\nname: $ch_name->[0]->[0]\nxid: $ch_xid\n";}
599        if ($opt_debug && $ch_icon){print "icon: $ch_icon\n";}
600        if (defined $namemap{$ch_wid}){
601           if ($opt_debug){print "HAS a namemap: $namemap{$ch_wid}\n";}
602           $ch_name_old = $ch_name->[0]->[0];
603           $ch_name->[0]->[0] = $namemap{$ch_wid};
604        }
605        if ($answer_all) {
606            $answer = $answer_all;
607            print($answer eq 'yes' ? 'adding' : 'ignoring', " new channel $ch_name->[0]->[0]\n");
608        }
609        else {
610#           if (defined $ch_name_old){$answer=askQuestion("add channel: $ch_name->[0]->[0] ($ch_name_old)?", 'yes', 'yes', 'no', 'all', 'none');}
611            if (defined $ch_name_old){$answer=ask_choice("add channel: $ch_name->[0]->[0] ($ch_name_old)?", 'yes', 'yes', 'no', 'all', 'none');}
612            else {$answer=ask_choice("add channel: $ch_name->[0]->[0]?", 'yes', 'yes', 'no', 'all', 'none');}
613            if ( $answer eq 'all' ) {$answer='yes'; $answer_all='yes';}
614            elsif ( $answer eq 'none' ) {$answer='no'; $answer_all='no';}
615        }
616        if ($answer eq 'yes') {print CONF "+channel $ch_wid \"$ch_name->[0]->[0]\" $ch_xid\n";}
617        else {print CONF "-channel $ch_wid \"$ch_name->[0]->[0]\" $ch_xid\n";}
618    }
619    foreach my $key (keys %regmap){
620        if ($opt_debug){print "doing foreach keys regmap! --> $key\n";}
621        if (not defined $compmap{$key}){
622        if ($opt_debug){print "key matches compmap.\n";}
623         if (not $key eq "TZ"){
624           if ($opt_debug){print "key NO match.\n";}
625#          $answer=askQuestion("add extra channel $namemap{$key}?", 'yes', 'yes', 'no', 'all', 'none');
626           $answer=ask_choice("add extra channel $namemap{$key}?", 'yes', 'yes', 'no', 'all', 'none');
627           if ($opt_debug){print "answer is: $answer\n";}
628           if ($answer eq 'yes') {print CONF "channel $key \"$namemap{$key}\"\n";}
629           else {print CONF "-channel $key \"$namemap{$key}\"\n";}
630         }
631        if ($opt_debug){print "done foreach keys regmap!\n";}
632        }
633    }
634    close CONF or warn "cannot close $config_file: $!";
635    print "All done, run with no arguments to grab listings.\n";
636}
637
638# list the channels for a state.
639sub get_channels($$) {
640    my ($c, $d) = @_;
641    if ($opt_debug) {print "\n--> doing get_channels: c=$c d=$d \n";}
642    my $bar = new Term::ProgressBar('grabing channels', 1)
643      if Have_bar && not $opt_quiet;
644#    my $dt = UnixDate($now, "%Y-%m-%d");
645#    if ($opt_debug) {print "\n--> got UnixDate: $dt \n";}
646    my $url="http://www.d1.com.au/d1xmltv.asmx/GetChannels?provider=$d&region=$c";
647    if ($opt_debug) {print "\n--> getting url: $url \n";}
648    my $data = get_nice($url);
649    die "could not get channel listing $url, aborting\n"
650      if not defined $data;
651    update $bar if Have_bar && not $opt_quiet;
652    if ($opt_debug) {print "get_channels-> URL total_fetches ($total_fetches -> ";}
653    $total_fetches++; if ($opt_debug) {print "$total_fetches)\n";}
654    my $dbytes = length($data);
655    if ($opt_debug) {print "get_channels-> total_bytes (total:$total_bytes + current:$dbytes = ";}
656    $total_bytes = $total_bytes + $dbytes; if ($opt_debug) {print "$total_bytes)\n";}
657    if ($opt_debug) {print "\n--> got http data: $data \n";}
658    return extract_channel_data($data, $c, $d);
659}
660
661# Grabs per channel listings - GetChannels
662sub extract_channel_data( $$$ ) {
663   my ($data, $c, $d) = @_; my @r;
664   $data =~ /<NewDataSet(.*?)<\/NewDataSet>/s
665     or die "\nERROR: can't find DataSet for $c - $d\n";
666   $_ = $1;
667#   while (/<Channels.*?<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>.*?<\/Channels>/sg) {
668    foreach my $tmpdat ($1 =~ /<Channels(.*?)<\/Channels>/sg){
669    if ($opt_debug){print "Doing FOREACH loop: $tmpdat\n";}
670    $_ = $tmpdat;
671#    while (/<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>/sg) {
672#    $_=~/<ChannelID>(.*?)<\/ChannelID>.*?<FreqID>(.*?)<\/FreqID>.*?<Name>(.*?)<\/Name>.*?<Icon>(.*?)<\/Icon>/sg;
673     if ($opt_debug){print "Doing WHILE loop...\n";}
674     my ($ch_wid, $ch_xid, $ch_name, $ch_icon);
675#      if (defined $1){$ch_wid=$1;}
676#       else {print STDERR "ERROR! - no xmltv id found!\n";}
677#      if (defined $2){$ch_xid=$2;}
678#       else {print STDERR "ERROR! - no frequency found!\n";}
679#      if (defined $3){$ch_name=$3;}
680#       else {print STDERR "ERROR! - no channel name found!\n";}
681#      if (defined $4){$ch_icon=$4;}
682#       else {print STDERR "ERROR! - no channel icon found!\n";}
683     if ($_=~/<ChannelID>(.*?)<\/ChannelID/sg){$ch_wid=$1;}
684      else {print STDERR "ERROR! - no xmltv id found!\nData: $_\nDying!";die}
685     if ($_=~/<FreqID>(.*?)<\/FreqID>/sg){$ch_xid=$1;}
686      elsif ($_=~/<Channel>(.*?)<\/Channel>/sg){$ch_xid=$1;}
687      else {print STDERR "ERROR! - no frequency found for $ch_wid!\n";}
688     if ($_=~/<Name>(.*?)<\/Name>/sg){$ch_name=$1;}
689      else {print STDERR "ERROR! - no channel name found for $ch_wid!\n";}
690     if ($_=~/<Icon>(.*?)<\/Icon>/sg){$ch_icon=$1;}
691      else {print STDERR "ERROR! - no channel icon found for $ch_wid!\n";}
692     my $lang="en";
693     my $ch = { 'display-name' => [ [ $ch_name, $lang ] ], 'xid' => $ch_xid , 'wid' => $ch_wid, 'icon' => $ch_icon };
694     push @r, $ch;
695     if ($opt_debug){print "Found Channel:\tName= $ch_name\tWeb-ID= $ch_wid\tXml-ID= $ch_xid\t";}
696     if ($opt_debug && $ch_icon){print "Icon=$ch_icon\n";}
697       else {if ($opt_debug){print "\n";}}
698#    } # end while
699   } # end foreach
700   return @r;
701}
702
703# grab 1 days list of programmes for channel N.
704sub get_programs( $$$$$$$ ) {
705    my ($w, $date, $ch_xmltv_id, $ch_xid, $ch_www_id, $ch_name, $service) = @_;
706    if ($opt_debug){print "doing get_programs...\n"}
707    my $today = UnixDate($date, "%Y-%m-%d"); $today=~s/ //;
708    my $url="http://www.d1.com.au/d1xmltv.asmx/GetPrograms?channelid=$ch_www_id&date=$today";
709    if ($opt_debug) {print "getting URL: $url\n";}
710    my $data=get_nice($url);
711    if (not defined $data) {
712        warn "could not fetch $url, skipping this channel\n";
713        return;
714    }
715    if ($opt_debug) {print "get_programs-> URL total_fetches ($total_fetches -> ";}
716    $total_fetches++;
717    if ($opt_debug) {print "$total_fetches)\n";}
718    my $dbytes = length($data);
719    if ($opt_debug) {print "get_programs-> total_bytes (total:$total_bytes + current:$dbytes = ";}
720    $total_bytes = $total_bytes + $dbytes;
721    if ($opt_debug) {print "$total_bytes)\n";}
722    local $SIG{__WARN__} = sub {if ($opt_debug) {print "local SIG _WARN_ here\n";}
723        warn "$url: $_[0]";
724    };
725    if ($opt_debug){print "looking for NewDataSet.....\n";}
726    if ($data =~ /<NewDataSet(.*?)<\/NewDataSet>/s){
727#      or die "\nERROR: can't find DataSet for $ch_name - $today\nData is:\n$data\n";
728#      or warn "\nERROR: can't find DataSet for $ch_name - $today\nData is:\n$data\n";
729    $data = $1;
730    if ($opt_debug){print "Must have found NewDataSet!\n";}
731    foreach my $tmpdat ($data=~/<Programs(.*?)<\/Programs>/sg) {
732        if ($opt_debug){print "Found SOMETHING between <programs>!\n";}
733        if ($opt_debug){print "SOMETHING is:\n$tmpdat\nEND-SOMETHING\n";}
734        foreach my $tmpdat2 ($tmpdat){
735          my $mainhash;
736          ${$mainhash}{'xmltv_id'} = $ch_xmltv_id;
737          if ( $tmpdat2=~/<Start>(.*?)<\/Start>/sg ) {
738            if ($opt_debug){print "found start - $1 -|\n";}
739            ${$mainhash}{'starttime'}=$1;
740          }
741          if ( $tmpdat2=~/<Stop>(.*?)<\/Stop>/sg ) {
742            if ($opt_debug){print "found stop - $1 -|\n";}
743            ${$mainhash}{'stoptime'}=$1;
744          }
745          if ( $tmpdat2=~/<Title>(.*?)<\/Title>/sg ) {
746            if ($opt_debug){print "found title - $1 -|\n";}
747            ${$mainhash}{'title'}=$1;
748          }
749          if ( $tmpdat2=~/<Subtitle>(.*?)<\/Subtitle>/sg ) {
750            if ($opt_debug){print "found subtitle - $1 -|\n";}
751            ${$mainhash}{'subtitle'}=$1;
752          }
753          if ( $tmpdat2=~/<Description>(.*?)<\/Description>/sg ) {
754            if ($opt_debug){print "found description - $1 -|\n";}
755            ${$mainhash}{'desc'}=$1;
756          }
757          if ( $tmpdat2=~/<Category>(.*?)<\/Category>/sg ) {
758            if ($opt_debug){print "found category - $1 -|\n";}
759            ${$mainhash}{'genre'}=$1;
760          }
761          if ( $tmpdat2=~/<Rating>(.*?)<\/Rating>/sg ) {
762            my $rate = $1;
763            if ( $rate=~/(.*?)\t$/ ) { $rate=$1; if ($opt_debug){print "-->rating has tab\n";}}
764            if ( $rate=~/(.*?)\s*$/ ) { $rate=$1; if ($opt_debug){print "-->rating has space(s)\n";}}
765            if ($opt_debug) {print "found rating - $rate -|- $1 -|\n";}
766            ${$mainhash}{'rating'}=$rate;
767          }
768                ${$mainhash}{'xid'}=$ch_xid;
769                write_xml_program($w, $mainhash);
770        }
771    }
772   }
773   else {
774     print STDERR "\nERROR: can't find DataSet for $ch_name - $today\n";
775     if ($opt_debug){"Data is:\n$data\n";}
776     }
777 } #-> end get_programs
778
779# get channel-to-region ids from file, also gets local timezone
780sub get_channel_ids( $$ ) {
781  if ($opt_debug) {print "doing get_channel_ids!\n";}
782  my ($region, $service) = @_;
783  if ($opt_debug) {print "Region is: $region\n";}
784  if ($opt_debug) {print "Service is: $service\n";}
785  my $line_num = 0;
786  foreach (XMLTV::Config_file::read_lines($channel_ids_file, 1)) {
787    ++ $line_num;
788    next if not defined;
789    my $ch = $_;
790    if (not defined $ch) {warn "$channel_ids_file:$line_num: unknown channel id $_\n";}
791    else {
792       if ($ch=~m/^$region:(.*?)$/sg){
793        if ($opt_debug) {print "region matches! $region->$1<-\n";}
794         $regmap{$region} = $1;
795       }
796      else {
797        if ($opt_debug) {print "no match! - $ch.\n";} 
798      }
799    }
800  }
801  if (defined $regmap{$region}) {if ($opt_debug) {print "regmap IS defined-> ($region = $regmap{$region})\n";}
802  } else {$regmap{$region}="EST"; warn "$channel_ids_file: no TZ for $region!, using EST\n";}
803  # to do - can fix daylight savings prob from here
804  if ($regmap{$region} eq "EST") {$regmap{$region}="+1000"}
805  if ($regmap{$region} eq "CST") {$regmap{$region}="+0930"}
806  if ($regmap{$region} eq "WST") {$regmap{$region}="+0800"}
807  if ($opt_debug) {print "done get_channel_ids!\n";}
808  return %regmap;
809}
810
811# Bump a YYYYMMDD date by one. (20030607)
812sub nextdate( $ ) {
813  if ($opt_debug) {print "start nextdate\n";}
814  my $d = shift; $d =~ /^\d{8}$/ or die;
815  my $p = ParseDate($d);
816  my $n = dc($p, '+ 1 day');
817  if ($opt_debug) {print "end nextdate\n";}
818  return UnixDate($n, '%Q');
819}
820
821# Wrapper for DateCalc().
822sub dc( $$ ) {
823  if ($opt_debug) {print "start dc\n";}
824  my $err;
825  my $r = DateCalc(@_, \$err);
826  die "DateCalc() failed with $err" if $err;
827  die 'DateCalc() returned undef' if not defined $r;
828  if ($opt_debug) {print "end dc\n";}
829  return $r;
830}
831
832sub write_xml_program( $$ ) {
833  my ($w, $mainhash) = @_;
834  my ($starttime, $stoptime);
835  if ($opt_debug) {print "---> doing write_xml_program\n";}
836  # convert times to standard format
837#  $starttime=UnixDate(${$mainhash}{'starttime'}, "%H%M");
838#  $starttime="${$mainhash}{'today'}$starttime"."00"." $BASE_TZ";
839  if ($opt_debug){print "DB: regmap(region) is: $regmap{$region}\n";}
840  # fixme - source times are EST!
841  $starttime = ${$mainhash}{'starttime'};
842  $stoptime = ${$mainhash}{'stoptime'};
843 
844  # convert times from EST to local times (broken due to source!)
845#  Date_Init('TZ=+0930');
846#  $starttime = UnixDate($starttime, "%Y%m%d%H%M%S %z");
847#  $stoptime = UnixDate($stoptime, "%Y%m%d%H%M%S %z");
848
849  # ugly hack - change TZ to local TZ NOT convert actual times!
850  if ($opt_debug){print "***> SEARCHING for TZ in starttime.... ($starttime)\n";}
851  if ($starttime=~/^(.*?)\s(.*?)$/) {
852    my $time = $1; my $timetz = $2;
853    if ($opt_debug){print "**> FOUND TZ in starttime: $timetz - ($starttime)\n";}
854    $starttime = $time . " " . $regmap{$region};
855    if ($opt_debug){print "**> NEW starttime is: $starttime\n";}
856  }
857  if ($opt_debug){print "***> SEARCHING for TZ in stoptime.... ($stoptime)\n";}
858  if ($stoptime=~/^(.*?)\s(.*?)$/) {
859    my $time = $1; my $timetz = $2;
860    if ($opt_debug){print "**> FOUND TZ in stoptime: $timetz - ($stoptime)\n";}
861    $stoptime = $time . " " . $regmap{$region};
862    if ($opt_debug){print "**> NEW stoptime is: $stoptime\n";}
863  }
864  if ($opt_debug){print "***> DONE looking and swapping TZ's!\n";}
865
866  if ($opt_debug) {print "---> mainhash=$mainhash\n";}
867  if ($opt_debug) {print "---> hash(xmltv_id)=${$mainhash}{'xmltv_id'}\n";}
868  if ($opt_debug) {print "---> hash(xid)=${$mainhash}{'xid'}\n";}
869  if ($opt_debug) {print "---> hash(starttime)=$starttime (${$mainhash}{'starttime'})\n";}
870  if ($opt_debug && ${$mainhash}{'stoptime'}) {print "---> hash(stoptime)=$stoptime (${$mainhash}{'stoptime'})\n";}
871#  if ($opt_debug) {print "---> hash(today)=${$mainhash}{'today'}\n";}
872  if ($opt_debug) {print "---> hash(title)=${$mainhash}{'title'}\n";}
873  if ($opt_debug && ${$mainhash}{'subtitle'}) {print "---> hash(subtitle)=${$mainhash}{'subtitle'}\n";}
874  if ($opt_debug && ${$mainhash}{'rating'}) {print "---> hash(rating)=${$mainhash}{'rating'}\n";}
875  # start writing xmltv programme element
876  if (${$mainhash}{'stoptime'} && ${$mainhash}{'starttime'}) {
877     $w->startTag('programme', start=> $starttime, stop => $stoptime, channel=> ${$mainhash}{'xmltv_id'});
878  } elsif (${$mainhash}{'starttime'} && not ${$mainhash}{'stoptime'}) {
879     $w->startTag('programme', start=> $starttime, channel=> ${$mainhash}{'xmltv_id'});
880  } else {
881     warn "\n\n **  im outa here! **\nno start-stop time combo! :O\n"; die;
882  }
883  $w->dataElement('title', ${$mainhash}{'title'}, 'lang'=>"en"); # fixme: get lang
884  if (${$mainhash}{'subtitle'}) {$w->dataElement('sub-title',${$mainhash}{'subtitle'},'lang'=>"en");}
885  if (${$mainhash}{'desc'}) {$w->dataElement('desc', ${$mainhash}{'desc'}, 'lang' => "en");}
886#  if (%{$dcpdesc}) {
887#    $w->startTag('credits');
888#    if (${$dcpdesc}{'director'}) {$w->dataElement('director', ${$dcpdesc}{'director'});}
889#    if (${$dcpdesc}{'writer'}) {$w->dataElement('writer', ${$dcpdesc}{'writer'});}
890#    if (${$dcpdesc}{'adapter'}) {$w->dataElement('adapter', ${$dcpdesc}{'adapter'});}
891#    if (${$dcpdesc}{'producer'}) {$w->dataElement('producer', ${$dcpdesc}{'producer'});}
892#    if (${$dcpdesc}{'presenter'}) {$w->dataElement('presenter', ${$dcpdesc}{'presenter'});}
893#    if (${$dcpdesc}{'host'}) {$w->dataElement('presenter', $$dcpdesc{'host'});} # fixme?
894#    if (${$dcpdesc}{'commentator'}) {$w->dataElement('commentator', ${$dcpdesc}{'commentator'});}
895#    if (${$dcpdesc}{'guest'}) {$w->dataElement('guest', ${$dcpdesc}{'guest'});}
896#    if (@{$pcast}) { foreach $_ (@{$pcast}){$w->dataElement('actor', $_);} }
897#    $w->endTag('credits');
898#  }
899  if (${$mainhash}{'date'}) {$w->dataElement('category', ${$mainhash}{'date'}, 'lang' => "en");}
900  if (${$mainhash}{'genre'}) {$w->dataElement('category', ${$mainhash}{'genre'}, 'lang' => "en");}
901  if (${$mainhash}{'live'}) {$w->dataElement('category', "Live", 'lang' => "en");}
902  if (${$mainhash}{'lang'}) {$w->dataElement('language', ${$mainhash}{'lang'}, 'lang' => "en");}
903  if (${$mainhash}{'olang'}) {$w->dataElement('orig-language', ${$mainhash}{'olang'}, 'lang' => "en");}
904#  if (${$mainhash}{'length'}) {$w->dataElement('length', ${$mainhash}{'length'}, 'units' => "minutes");}
905  if (${$mainhash}{'length'}) {
906    my $l = ${$mainhash}{'length'}; my $units = 'minutes';
907    if ($l % 60 == 0) {$units = 'hours'; $l /= 60;}
908    $w->dataElement('length', $l, 'units' => $units);
909  }
910  # icon goes here
911  if (${$mainhash}{'url'}) {$w->dataElement('url',${$mainhash}{'url'});}
912  if (${$mainhash}{'country'}) {$w->dataElement('country', ${$mainhash}{'country'}, 'lang' => "en");}
913  if (${$mainhash}{'epnum'}) {$w->dataElement('episode-num',${$mainhash}{'epnum'});}
914  if (${$mainhash}{'video-col'} or ${$mainhash}{'video-asp'}) { # present(yes/no), color(yes/no), aspect(4:3/16:9)
915    $w->startTag('video');
916    if (${$mainhash}{'video-col'}) {$w->dataElement('color', "no");}
917    if (${$mainhash}{'video-asp'}) {$w->dataElement('aspect', ${$mainhash}{'video-asp'});}
918    $w->endTag('video');
919  }
920  if (${$mainhash}{'audio'}) { # present(yes/no),stereo(mono/stereo/surround)
921    $w->startTag('audio');
922    $w->dataElement('present', "yes");
923    $w->dataElement('stereo', "surround");
924    $w->endTag('audio');
925  }
926  if (${$mainhash}{'repeat'}) {$w->emptyTag('previously-shown',"");}
927  if (${$mainhash}{'premiere'}) {$w->emptyTag('premiere',"");}
928  if (${$mainhash}{'last'}) {$w->emptyTag('last-chance',"");}
929  if (${$mainhash}{'new'}) {$w->emptyTag('new',"");}
930  if (${$mainhash}{'captions'}) {$w->emptyTag('subtitles', 'type' => "teletext");}
931  if (${$mainhash}{'rating'}) {
932    $w->startTag('rating', 'system' => "CTVA");
933    $w->dataElement('value', ${$mainhash}{'rating'});
934    $w->endTag('rating');
935  }
936  if (${$mainhash}{'stars'}) {
937    $w->startTag('star-rating');
938    $w->dataElement('value', ${$mainhash}{'stars'});
939    $w->endTag('star-rating');
940  }
941  $w->endTag('programme');
942  if ($opt_debug) {print "---> done write_xml_program <-|\n";}
943}
944
945# the end :)
Note: See TracBrowser for help on using the browser.