root/trunk/grabbers/yahoo7widget @ 1061

Revision 1061, 22.2 kB (checked in by paul, 5 years ago)

regions 90 and 98 change and new regions 266,267,268
remove Prime (Regional Victoria),Prime (Albury) and Prime Canberra/Sth Coast
add TEN HD to region 74 darwin
other cleanups
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2
3# yahoo7_widget au_tv guide grabber - runs from "Shepherd" master grabber
4#  * written by ltd
5#  * uses yahoo7 widget for ABC/7/9/10/SBS (all they have)
6#  * when used in conjunction with Shepherd, shepherd can collect other channels
7#    using other grabbers
8#  * this does NOT use any config file - all settings are passed in from shepherd
9
10#  changelog:
11#    1.50  22sep06      added support for "shepherd" master grabber script
12#    1.51  02oct06      --ready option
13#    1.52  03oct06      split out yahoo7 grabber into its own grabber
14#    1.54  16oct06      put date/cast/credits/year into correct xmltv fields
15#    1.70  15dec06      sometimes there are holes in data; augment those from yahoo7web
16#    1.78  04feb07      remove augmenting - micrograbbing from other grabbers
17#                       can now fill those in
18#    1.80  22feb07      bugfix: stop throwing away multiple category data
19#    1.81  01mar07      more informative error on no connectivity
20
21use strict;
22
23my $progname = "yahoo7widget";
24my $version = "1.106";
25
26use XMLTV;
27use XML::DOM;
28use XML::DOM::NodeList;
29use POSIX qw(strftime mktime);
30use Getopt::Long;
31use HTML::TreeBuilder;
32use Data::Dumper;
33use Shepherd::Common;
34
35#
36# some initial cruft
37#
38
39my %month_map = ( qw{ Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5 Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11 } );
40
41my $script_start_time = time;
42my %stats;
43my $channels, my $opt_channels;
44my $tv_guide;
45my $input_xml;
46my $d;
47$| = 1;
48
49#
50# parse command line
51#
52
53my $opt;
54$opt->{outputfile} =    "output.xmltv"; # default
55$opt->{days} =          7;              # default
56$opt->{lang} =          "en";
57$opt->{region} =        94;
58
59GetOptions(
60        'region=i'      => \$opt->{region},
61        'days=i'        => \$opt->{days},
62        'offset=i'      => \$opt->{offset},
63        'channels_file=s' => \$opt->{channels_file},
64        'cachefile=s' => \$opt->{obsolete},
65        'output=s'      => \$opt->{outputfile},
66        'fast'          => \$opt->{fast},
67        'warper'        => \$opt->{warper},
68        'lang=s'        => \$opt->{lang},
69        'obfuscate'     => \$opt->{obfuscate},
70        'rawout=s'      => \$opt->{rawout},
71        'rawin=s'       => \$opt->{rawin},
72        'scan-chan=s'   => \$opt->{scanchan},
73        'debug+'        => \$opt->{debug},
74        'help'          => \$opt->{help},
75        'verbose'       => \$opt->{help},
76        'version'       => \$opt->{version},
77        'ready'         => \$opt->{version},
78        'desc'          => \$opt->{desc},
79        'v'             => \$opt->{help});
80
81&help if (defined $opt->{help});
82
83if (defined $opt->{version} || defined $opt->{desc}) {
84        printf "%s %s\n",$progname,$version;
85        printf "%s is a details-aware grabber that collects very high quality data (full title/subtitle/description/genre and year/cast/credits data) using the Yahoo7 widget for ABC/7/9/10/SBS only.",$progname if (defined $opt->{desc});
86        exit(0);
87}
88
89# set defaults
90Shepherd::Common::set_default("debug", ($opt->{debug} * 2)) if (defined $opt->{debug});
91Shepherd::Common::set_default("webwarper", 1) if (defined $opt->{warper});
92Shepherd::Common::set_default("squid", 1) if (defined $opt->{obfuscate});
93Shepherd::Common::set_default("referer", "last");
94Shepherd::Common::set_default("retry_delay", 10);
95Shepherd::Common::setup_ua('agent' => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-us)');
96
97&scan_channels if (defined $opt->{scanchan});
98die "no channel file specified, see --help for instructions\n", unless (defined $opt->{channels_file});
99
100$opt->{days} = 8 if $opt->{days} > 8;   # no data beyond 8 days
101
102#
103# go go go!
104#
105
106my $starttime = $script_start_time;
107
108# correct $starttime to remove gap between local and Eastern States time
109my $local_time_offset = POSIX::strftime("%z",localtime(time));
110# yahoo7widget times are always localtime on Eastern States ..
111$ENV{TZ}="Australia/Melbourne";
112my $melbourne_time_offset = POSIX::strftime("%z",localtime(time));
113my $time_offset = ((int(substr($melbourne_time_offset,1,2))-int(substr($local_time_offset,1,2)))*(60*60)) +
114                ((int(substr($melbourne_time_offset,3,2))-int(substr($local_time_offset,3,2)))*(60));
115$starttime -= $time_offset;
116
117my $endtime = $starttime + ($opt->{days} * 86400);
118$starttime += (86400 * $opt->{offset}) if (defined $opt->{offset});
119
120&log(sprintf "going to grab %d days%s of data into %s (%s%s) region %s",
121        $opt->{days},
122        ($opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
123        $opt->{outputfile},
124        (defined $opt->{fast} ? "with haste" : "slowly"),
125        (defined $opt->{warper} ? ", anonymously" : ""),
126        $opt->{region});
127
128if (-r $opt->{channels_file}) {
129        local (@ARGV, $/) = ($opt->{channels_file});
130        no warnings 'all'; eval <>; die "$@" if $@;
131} else {
132        die "WARNING: channels file $opt->{channels_file} could not be read\n";
133}
134
135unlink($opt->{rawout}) if (defined $opt->{rawout});
136
137if (defined $opt->{rawin}) {
138        &log("using previously fetched raw xml data from ".$opt->{rawin});
139        open(F,"<$opt->{rawin}") || die "could not read raw input $opt->{rawin}: $!\n";
140        while(<F>) {
141                $input_xml .= $_;
142        }
143        close(F);
144        &parse_xml_data($input_xml);
145} else {
146        for (my $currtime = $starttime; $currtime < $endtime; $currtime += 86400) {
147                # pace ourselves
148                if (($currtime != $starttime) && (!defined $opt->{fast})) {
149                        my $sleeptimer = int(rand(5)) + 1;  # sleep anywhere from 1 to 5 seconds
150                        $stats{slept_for} += $sleeptimer;
151                        sleep $sleeptimer;
152                }
153
154                # get data
155                my $tries = 5;
156                my $url = sprintf "http://au.tv.yahoo.com/widget.html?rg=%d&st=%d&et=%d", $opt->{region}, $currtime,($currtime+86400);
157                my ($data, $success, $status_msg, $bytes_fetched, $seconds_slept, $failed_attempts, $response) = 
158                  Shepherd::Common::get_url(url => $url, retries => ($tries-1));
159
160                $stats{failed_requests} += $failed_attempts;
161                $stats{slept_for} += $seconds_slept;
162                $stats{bytes_fetched} += $bytes_fetched;
163
164                if ((!$data) || (!$success)) {
165                        &log("Failed to fetch '$url' after $tries attempts.");
166
167                        # if its our first page, abort now
168                        if ($currtime == $starttime) {
169                                &log("Aborting: likely format change or blocked!");
170                                exit 10;
171                        }
172                        next;
173                }
174
175                if ($response and $response->header('Content-type') and $response->header('Content-type') eq 'xapplication/ywe-octet-stream') {
176                        $stats{transformed_pages}++;
177                        $data = &transform_output($data);
178                }
179
180                $stats{http_successful_requests}++;
181                &parse_xml_data($data);
182        }
183}
184
185&write_data;
186&print_stats;
187exit(0);
188
189######################################################################################################
190# help
191
192sub help
193{
194        print<<EOF
195$progname $version
196
197$0 [options]
198    options are as follows:
199        --region=N              set region for where to collect data from (default: $opt->{region})
200        --channels_file=file    where to get channel data from (MANDATORY)
201        --days=N                fetch 'n' days of data (default: $opt->{days})
202        --output=file           send xml output to file (default: "$opt->{outputfile}")
203
204        --fast                  don't run slow - get data as quick as you can - not recommended
205        --debug                 increase debug level
206        --warper                fetch data using WebWarper web anonymizer service
207        --obfuscate             pretend to be a proxy servicing multiple clients
208        --lang=[s]              set language of xmltv output data (default $opt->{lang})
209
210        --scan-chan=(chanfile)  (debugging) check channel discrepancies
211        --rawin=(file), --rawout=(file) (debugging) feed raw XML in/out
212
213EOF
214;
215
216        exit(0);
217}
218
219######################################################################################################
220# fixup any channel name quirks for this region
221
222sub region_channels
223{
224        my $r = shift;
225        my %chan_map;
226
227#       if ($r == 90) { # VIC: Eastern Victoria
228#               push (@{($chan_map{"Prime"})}, "Prime (Regional Victoria)", "Prime (Albury)");
229#       }
230
231        return %chan_map;
232}
233
234######################################################################################################
235
236sub scan_channels
237{
238        my %REGIONS = (
239                63 => "NSW: Broken Hill",       66 => "NSW: Central Coast",     67 => "NSW: Griffith",
240                69 => "NSW: Tamworth",  71 => "NSW: Wollongong",        73 => "NSW: Sydney",
241                74 => "NT: Darwin",     75 => "QLD: Brisbane",  78 => "QLD: Gold Coast",
242                79 => "QLD: Cairns",    81 => "SA: Adelaide",   82 => "SA: Renmark",
243                83 => "SA: Riverland",  85 => "SA: South East SA",      86 => "SA: Spencer Gulf",
244                88 => "TAS: Tasmania",  90 => "VIC: Ballarat",  93 => "VIC: Geelong",
245                94 => "VIC: Melbourne", 95 => "VIC: Mildura/Sunraysia", 98 => "VIC: Gippsland",
246                101 => "WA: Perth",     102 => "WA: Regional",  106 => "NSW: Remote and Central",
247                107 => "SA: Remote and Central",        108 => "NT: Remote and Central",        114 => "QLD: Remote and Central",
248                126 => "ACT: Canberra", 184 => "NSW: Newcastle",        253 => "QLD: Mackay",
249                254 => "QLD: Rockhampton",      255 => "QLD: Sunshine Coast",   256 => "QLD: Toowoomba",
250                257 => "QLD: Townsville",       258 => "QLD: Wide Bay", 259 => "NSW: Far South Coast",
251                261 => "NSW: Lismore/Coffs Harbour",    262 => "NSW: Orange/Dubbo",     263 => "NSW: Taree/Port Macquarie",
252                264 => "NSW: Wagga Wagga",      266 => "VIC: Bendigo",  267 => "VIC: Shepparton",
253                268 => "VIC: Albury/Wodonga",);
254
255        my $now = time;
256        my %all_channels;
257
258        printf "\nScanning channels: (".$opt->{scanchan}.")\n\n";
259
260        #
261        # read shepherd channels
262        #
263        open(F,"<".$opt->{scanchan}) || die "could not open ".$opt->{scanchan}." for reading: $!\n";
264        while (<F>) {
265                chop;
266                last if $_ eq "---migrate---";
267                $all_channels{$1} = $2 if (/^(\d+):(.*)$/);
268        }
269        close(F);
270
271        foreach my $r (sort { $a <=> $b } keys %REGIONS) {
272                printf "Region %d (%s): [%s]\n",$r,$REGIONS{$r},$all_channels{$r};
273
274                my %local_chan_map = region_channels($r);
275
276                # get shepherd channels
277                my %shepherd_channels;
278                foreach my $ch (split(/,/,$all_channels{$r})) {
279                        $shepherd_channels{$ch} = 1;
280                }
281
282                #
283                # get widget channels
284                #
285                my $url = sprintf "http://au.tv.yahoo.com/widget.html?rg=%d&st=%d&et=%d", $r, $now,($now+86400);
286                my $tries = 2;
287                my ($data, $success, $status_msg, $bytes_fetched, $seconds_slept, $failed_attempts, $response) = 
288                  Shepherd::Common::get_url(url => $url, retries => ($tries-1));
289
290                if ((!$data) || (!$success)) {
291                        print "Failed to fetch '$url' after $tries attempts.";
292                        next;
293                }
294
295                $data = &transform_output($data) if ($response->header('Content-type') and $response->header('Content-type') eq 'xapplication/ywe-octet-stream');
296
297                my $parser = new XML::DOM::Parser;
298                my $tree = $parser->parse($data);
299                my $tree_channels = $tree->getElementsByTagName("venue");
300                for (my $i = 0; $i < $tree_channels->getLength; $i++) {
301                        my $channel = $tree_channels->item($i)->getAttributeNode("co_short")->getValue;
302
303                        my $old_channel = "", my $new_channel;
304                        $new_channel = splice(@{($local_chan_map{$channel})},0,1) if (defined $local_chan_map{$channel});
305                        if (defined $new_channel) {
306                                $old_channel = $channel;
307                                $channel = $new_channel;
308                        }
309
310                        # for this channel get every programme ('event')
311                        my $events = $tree_channels->item($i)->getElementsByTagName("event");
312
313                        if (!defined $shepherd_channels{$channel}) {
314                                $shepherd_channels{$channel} = 0;       # shepherd doesn't know about this channel, widget does
315                        } elsif ($shepherd_channels{$channel} == 1) {
316                                $shepherd_channels{$channel} = 2;       # both shepherd & widget know about channel
317                        } elsif ($shepherd_channels{$channel} == 2) {
318                                $shepherd_channels{$channel} = 3;       # shepherd/widget knew about channel but was duplicated!
319                        } elsif ($shepherd_channels{$channel} == 3) {
320                                $shepherd_channels{$channel} = 3;       # shepherd/widget knew about channel but was duplicated again!
321                        } elsif ($shepherd_channels{$channel} == 0) {
322                                ;                                       # aiee. a duplicate of a channel that shepherd doesn't know about!
323                        } else {
324                                die "unhandled shepherd_channels case for '$channel' value ".$shepherd_channels{$channel};
325                        }
326
327                        printf "  %30s %s%s%s (%d progs)%s\n",
328                                $channel, 
329                                ($shepherd_channels{$channel} == 0 ? "[Only known to Widget]" : ""),
330                                ($shepherd_channels{$channel} == 2 ? "[Known to both (good!)]" : ""),
331                                ($shepherd_channels{$channel} == 3 ? "[Known to both (good), but duplicate in widget]" : ""),
332                                $events->getLength,
333                                ($old_channel ne "" ? " [translated from '$old_channel']" : "");
334                }
335
336                # any channels in Shepherd that Widget didn't return?
337                foreach my $ch (keys %shepherd_channels) {
338                        printf "  %30s [Only known to Shepherd]\n", $ch if ($shepherd_channels{$ch} == 1);
339                }
340
341                printf "\n";
342        }
343
344        exit(0);
345}
346
347######################################################################################################
348# transcode ywe-octet-stream back into text
349
350sub transform_output
351{
352        my $data = shift;
353        my $datasize = length($data);
354
355        my @xform_map = (
356          0x39, 0x9E, 0x05, 0x72, 0x6C, 0x06, 0x38, 0x15, 0x42, 0x1E, 0xB9, 0xFD, 0x4D, 0x08, 0x0C, 0x2E,
357          0x57, 0xC7, 0x62, 0x6E, 0xC5, 0x3A, 0x3C, 0xA4, 0x1D, 0xC6, 0x3D, 0x18, 0x2D, 0x1B, 0x83, 0x20,
358          0x78, 0xFC, 0xA5, 0xDE, 0x28, 0xE8, 0x3E, 0x9B, 0x7C, 0x22, 0x1C, 0x89, 0xFF, 0x52, 0x54, 0x43,
359          0x51, 0x7F, 0x71, 0x40, 0x7A, 0xCF, 0x65, 0xE4, 0x36, 0xEB, 0xC9, 0x1F, 0x80, 0x9A, 0x31, 0x4A,
360          0x45, 0xD4, 0x2B, 0x02, 0x4C, 0xF4, 0x53, 0xBD, 0xA8, 0xF9, 0x50, 0x61, 0x8A, 0xD5, 0xBF, 0x81,
361          0xC0, 0xDB, 0xFE, 0xF7, 0xBA, 0xEC, 0xFA, 0x73, 0xA9, 0x8F, 0xB1, 0x70, 0x33, 0xCE, 0x60, 0xAC,
362          0xB2, 0x58, 0x26, 0x85, 0x6B, 0x7D, 0x93, 0x03, 0x64, 0x47, 0x04, 0x88, 0x01, 0xA6, 0x3B, 0x90,
363          0x98, 0xF5, 0x97, 0x3F, 0xF6, 0xD3, 0x94, 0xB7, 0x29, 0x07, 0x96, 0x6F, 0x14, 0x35, 0x8D, 0x2A,
364          0x16, 0x17, 0x8B, 0xD1, 0x48, 0xD6, 0xF1, 0xE2, 0x79, 0x2C, 0x41, 0x5B, 0xBC, 0xB5, 0x68, 0xDC,
365          0x49, 0xD2, 0x6A, 0xCC, 0x25, 0xB4, 0xAA, 0x63, 0x9C, 0x56, 0x4B, 0xB8, 0x87, 0x5E, 0x86, 0x09,
366          0xC4, 0x95, 0xB6, 0x12, 0xF8, 0x84, 0x4E, 0x21, 0x32, 0xCA, 0x66, 0xC3, 0xBB, 0x27, 0xEE, 0xE0,
367          0x1A, 0xD8, 0x6D, 0x4F, 0xAF, 0x82, 0xEF, 0xCD, 0x5F, 0x8C, 0x67, 0xA2, 0xCB, 0xED, 0xAB, 0xB0,
368          0xA7, 0x92, 0x75, 0x5A, 0xF2, 0x0A, 0x0E, 0xE6, 0x7E, 0xC8, 0xE9, 0x19, 0x24, 0x37, 0x11, 0xA0,
369          0xE3, 0xDD, 0xD7, 0x23, 0x9F, 0x00, 0xA1, 0xC1, 0x74, 0xF0, 0x99, 0x77, 0xAE, 0x91, 0x7B, 0xFB,
370          0xD9, 0xDA, 0xC2, 0x44, 0x0D, 0x76, 0x10, 0x9D, 0xEA, 0xE7, 0xE5, 0x59, 0xF3, 0xD0, 0x5D, 0x2F,
371          0x69, 0xAD, 0x34, 0x0F, 0x5C, 0x8E, 0xBE, 0x13, 0x30, 0x55, 0xE1, 0xDF, 0x0B, 0xB3, 0x46, 0xA3);
372        my ($xlate_pos1, $xlate_pos2, $xlate_pos3, $xlate_pos4) = (0,0,0,0);
373        my $outputdata;
374
375        return undef if (($datasize < 1) || (ord(substr($data,0,1)) != 1)); # not valid
376
377        for (my $pos = 1; $pos < $datasize; $pos++) {
378                $xlate_pos1 = ($xlate_pos1 + 1) % 256;
379                $xlate_pos3 = $xform_map[$xlate_pos1];
380                $xlate_pos4 = ($xlate_pos2 + $xlate_pos3) % 256;
381                $xlate_pos2 = $xform_map[$xlate_pos4];
382                $xform_map[$xlate_pos1] = $xlate_pos2;
383                $xlate_pos2 += $xlate_pos3;
384                $xform_map[$xlate_pos4] = $xlate_pos3;
385                $xlate_pos2 = $xlate_pos2 % 256;
386                $xlate_pos3 = $xform_map[$xlate_pos2];
387                $xlate_pos2 = $xlate_pos4;
388                $outputdata .= chr((((ord(substr($data,$pos,1))) % 256) ^ ($xlate_pos3 % 256)) % 256);
389        }
390        if (defined $opt->{rawout}) {
391                if (open(F,">>$opt->{rawout}")) {
392                        print F $outputdata;
393                        close F;
394                }
395        }
396        return($outputdata);
397}
398
399######################################################################################################
400
401sub log
402{
403        my ($entry) = @_;
404        printf "%s\n",$entry;
405}
406
407######################################################################################################
408
409sub print_stats
410{
411        printf "STATS: %s v%s completed in %d seconds",$progname,$version,(time-$script_start_time);
412        foreach my $key (sort keys %stats) {
413                printf ", %d %s",$stats{$key},$key;
414        }
415        printf "\n";
416}
417
418######################################################################################################
419# given yahoo7 xml data, parse it into 'shows' ..
420# parse it into $tv_guide->{$channel}->{data}->{$event_id}-> structures..
421
422sub parse_xml_data
423{
424        my $data = shift;
425
426        unless ($data) {
427            print STDERR "ERROR: no data to parse.\n";
428            return;
429        }
430
431        my %local_chan_map = region_channels($opt->{region});
432
433        my $parser = new XML::DOM::Parser;
434        my $tree = $parser->parse($data);
435        my $tree_channels = $tree->getElementsByTagName("venue");
436        for (my $i = 0; $i < $tree_channels->getLength; $i++) {
437                my $channel = $tree_channels->item($i)->getAttributeNode("co_short")->getValue;
438
439                # see if we need to do any mappings for this channel
440                my @mapped_channels;
441
442                if (defined $local_chan_map{$channel}) {
443                        my $new_channel = splice(@{($local_chan_map{$channel})},0,1);
444                        if (not $new_channel) {
445                                &log("new unmapped channel for '$channel'");
446                        } else {
447                                &log("mapped '$channel' to '$new_channel'") if (defined $opt->{debug});
448                                $channel = $new_channel;
449                        }
450                }
451
452                if ((!defined $channels->{$channel}) && (!defined $opt_channels->{$channel})) {
453                        if (!defined $d->{ignored_channels}->{$channel}) {
454                                $d->{ignored_channels}->{$channel} = 1;
455                                $stats{skipped_channels}++;
456                                &log("ignoring unknown channel '$channel'");
457                        }
458                        next;
459                }
460
461                # for this channel get every programme ('event')
462                my $events = $tree_channels->item($i)->getElementsByTagName("event");
463                for (my $j = 0; $j < $events->getLength; $j++) {
464                        my $event = $events->item($j);
465                        my $event_id = $event->getElementsByTagName("event_id")->item(0)->getFirstChild->getNodeValue;
466
467                        # mandatory fields
468                        my $event_start =       $event->getElementsByTagName("event_date")->item(0)->getFirstChild->getNodeValue;
469                        my $event_end =         $event->getElementsByTagName("end_date")->item(0)->getFirstChild->getNodeValue;
470
471                        # TEMPORARY HACK UNTIL YAHOO FIX UP TIMEZONE FILE ON THEIR SERVER!
472                        # if ($event_start < 1207414800) {  # real daylight savings end
473                        #       $event_start -= 3600;
474                        #       $event_end -= 3600;
475                        # }
476
477                        if ($event_start < 10) {
478                                $stats{progs_with_invalid_start}++;
479                                printf "WARNING: programme with event_id '$event_id' had an invalid start time of '$event_start'; skipped\n";
480                                next;
481                        }
482                        if ($event_end < 10) {
483                                $stats{progs_with_invalid_end}++;
484                                printf "WARNING: programme with event_id '$event_id' had an invalid end time of '$event_end'; skipped\n";
485                                next;
486                        }
487
488                        $event_id = $event_start.":".$event_end.":".$event_id; # event_id actually isn't unique - so make it so
489
490                        $stats{programmes}++;
491                        $stats{duplicate_programmes}++ if ($tv_guide->{$channel}->{data}->{$event_id});
492
493                        # wrap these non-mandatory fields in an eval so if they don't exist the script doesn't barf out
494                        my %e;
495                        foreach my $field ('title', 'subtitle', 'description_1', 'main_cast', 'year_released', 'rating',
496                          'genre', 'running_time', 'repeat', 'country', 'movie', 'premiere', 'final', 'captions',
497                          'warnings', 'colour', 'language', 'director', 'live', 'return') {
498                                eval { $e{$field} = $event->getElementsByTagName("$field")->item(0)->getFirstChild->getNodeValue; };
499                        }
500                        # other fields we dont pick up but exist in source xml data include:
501                        #  other_title, description_2, genre_id, sub_category, highlight, ext_url, y7_url
502                        # 'return' unseen
503
504                        my %video_details;
505                        $video_details{'colour'} = 1 if $e{colour};
506
507                        my $rating = "";
508                        $rating .= $e{rating} if $e{rating};
509                        $rating .= " " if $e{rating} and $e{warnings};
510                        $rating .= lc $e{warnings} if $e{warnings};
511
512                        # store it in the correct XMLTV schema!
513                        $tv_guide->{$channel}->{data}->{$event_id}->{'channel'} = $channels->{$channel} if (defined $channels->{$channel});
514                        $tv_guide->{$channel}->{data}->{$event_id}->{'channel'} = $opt_channels->{$channel} if (defined $opt_channels->{$channel});
515
516                        $tv_guide->{$channel}->{data}->{$event_id}->{'start'} =         POSIX::strftime("%Y%m%d%H%M", localtime($event_start));
517                        $tv_guide->{$channel}->{data}->{$event_id}->{'stop'} =          POSIX::strftime("%Y%m%d%H%M", localtime($event_end));
518                        $tv_guide->{$channel}->{data}->{$event_id}->{'title'} =         [[ $e{title}, $opt->{lang} ]] if $e{title};
519                        $tv_guide->{$channel}->{data}->{$event_id}->{'sub-title'} =     [[ $e{subtitle}, $opt->{lang} ]] if $e{subtitle};
520                        $tv_guide->{$channel}->{data}->{$event_id}->{'desc'} =          [[ $e{description_1}, $opt->{lang} ]] if $e{description_1};
521                        $tv_guide->{$channel}->{data}->{$event_id}->{'category'} =      [ &Shepherd::Common::generate_category($e{title}, $e{genre}, %e) ];
522                        $tv_guide->{$channel}->{data}->{$event_id}->{'country'} =       [ map([$_,$opt->{lang}], split(/\//, $e{country})) ] if $e{country};
523                        $tv_guide->{$channel}->{data}->{$event_id}->{'premiere'} =      [ 'premiere', $opt->{lang} ] if $e{premiere};
524                        $tv_guide->{$channel}->{data}->{$event_id}->{'rating'} =        [[ $rating, 'ABA', undef ]] if $rating ne "";
525                        $tv_guide->{$channel}->{data}->{$event_id}->{'credits'}{'actor'} = [ split(/, /, $e{main_cast}) ] if $e{main_cast};
526                        $tv_guide->{$channel}->{data}->{$event_id}->{'credits'}{'director'} = [ split(/, /, $e{director}) ] if $e{director};
527                        $tv_guide->{$channel}->{data}->{$event_id}->{'credits'}{'writer'} = [ split(/, /, $e{writer}) ] if $e{writer}; # unseen
528                        $tv_guide->{$channel}->{data}->{$event_id}->{'date'} =  $e{year_released} if $e{year_released};
529                        $tv_guide->{$channel}->{data}->{$event_id}->{'previously-shown'} = { } if $e{repeat};
530                        $tv_guide->{$channel}->{data}->{$event_id}->{'subtitles'} =     [ { 'type' => 'teletext' } ] if $e{captions};
531                        $tv_guide->{$channel}->{data}->{$event_id}->{'last-chance'} =   [ 'final', $opt->{lang} ] if $e{final};
532                        $tv_guide->{$channel}->{data}->{$event_id}->{'video'} =         \%video_details;
533                        $tv_guide->{$channel}->{data}->{$event_id}->{'length'} =        ($e{running_time} * 60) if $e{running_time};
534                        $tv_guide->{$channel}->{data}->{$event_id}->{'language'} =      [ $e{language}, $opt->{lang} ] if $e{language};
535
536                        $d->{seen_progs}->{$channel}++;
537                }
538        }
539        $tree->dispose;
540}
541
542######################################################################################################
543
544sub write_data
545{
546        my %writer_args = ( encoding => 'ISO-8859-1' );
547        if ($opt->{outputfile}) {
548                my $fh = new IO::File(">$opt->{outputfile}")  or die "can't open $opt->{outputfile}: $!";
549                $writer_args{OUTPUT} = $fh;
550        }
551
552        my $writer = new XMLTV::Writer(%writer_args);
553
554        $writer->start
555          ( { 'source-info-name'   => "$progname $version",
556              'generator-info-name' => "$progname $version"} );
557
558        for my $channel (sort keys %{$channels}) {
559                $writer->write_channel( {'display-name' => [[ $channel, $opt->{lang} ]], 'id' => $channels->{$channel}} )
560                  if (defined $d->{seen_progs}->{$channel});
561        }
562        for my $channel (sort keys %{$opt_channels}) {
563                $writer->write_channel( {'display-name' => [[ $channel, $opt->{lang} ]], 'id' => $opt_channels->{$channel}} )
564                  if (defined $d->{seen_progs}->{$channel});
565        }
566
567        for my $channel (sort keys %{($d->{seen_progs})}) {
568                for my $event_id (sort {$a cmp $b} keys %{($tv_guide->{$channel}->{data})}) {
569                        my $show = $tv_guide->{$channel}->{data}->{$event_id};
570                        Shepherd::Common::cleanup($show);
571                        $writer->write_programme($show);
572                }
573        }
574
575        $writer->end();
576}
577
578######################################################################################################
Note: See TracBrowser for help on using the browser.