root/trunk/grabbers/yahoo7widget @ 979

Revision 979, 22.1 kB (checked in by paul, 6 years ago)

yahoo7widget: change color to colour
  • 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.98";
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 == 69) { # NSW: Northern NSW
228                push (@{($chan_map{"Prime"})}, "Prime Tamworth/Taree/Port", "Prime Lismore/Coffs Hbr");
229        } elsif ($r == 71) { # NSW: Southern NSW
230                push (@{($chan_map{"TEN"})}, "TEN (NSW: Southern NSW)", "TEN (Mildura Digital)");
231                push (@{($chan_map{"Prime"})}, "Prime Canberra/Sth Coast", "Prime Wagga Wagga",
232                                "Prime Wollongong", "Prime Orange");
233        } elsif ($r == 79) { # QLD: Regional
234                push (@{($chan_map{"Seven"})},  "Seven (Townsville/Mackay/Wide Bay/Sunshine Coast)",
235                        "Seven (Rockhampton/Toowoomba)", "Seven Cairns");
236                push (@{($chan_map{"WIN"})}, "WIN (QLD: Regional)", "WIN (Mackay/Wide Bay)");
237        } elsif ($r == 90) { # VIC: Eastern Victoria
238                push (@{($chan_map{"Prime"})}, "Prime (Regional)", "Prime (Albury)");
239        } elsif ($r == 106) { # NSW: Remote and Central
240                push (@{($chan_map{"Prime"})}, "Prime Wagga Wagga");
241        } elsif ($r == 126) { # ACT
242                push (@{($chan_map{"Prime"})}, "Prime Canberra/Sth Coast");
243        }
244
245        return %chan_map;
246}
247
248######################################################################################################
249
250sub scan_channels
251{
252        my %REGIONS = (
253                126 => "ACT",               73 => "NSW: Sydney",            184 => "NSW: Newcastle",
254                66 => "NSW: Central Coast", 67 => "NSW: Griffith",          63 => "NSW: Broken Hill",
255                69 => "NSW: Northern NSW",  71 => "NSW: Southern NSW",      106 => "NSW: Remote and Central",
256                74 => "NT: Darwin",         108 => "NT: Remote & Central",  75 => "QLD: Brisbane",
257                78 => "QLD: Gold Coast",    79 => "QLD: Regional",          114 => "QLD: Remote & Central",
258                81 => "SA: Adelaide",       82 => "SA: Renmark",            83 => "SA: Riverland",
259                85 => "SA: South East SA",  86 => "SA: Spencer Gulf",       107 => "SA: Remote & Central",
260                88 => "Tasmania",           94 => "VIC: Melbourne",         93 => "VIC: Geelong",
261                90 => "VIC: Eastern Victoria", 95 => "VIC: Mildura/Sunraysia", 98 => "VIC: Western Victoria",
262                101 => "WA: Perth",         102 => "WA: Regional");
263
264        my $now = time;
265        my %all_channels;
266
267        printf "\nScanning channels: (".$opt->{scanchan}.")\n\n";
268
269        #
270        # read shepherd channels
271        #
272        open(F,"<".$opt->{scanchan}) || die "could not open ".$opt->{scanchan}." for reading: $!\n";
273        while (<F>) {
274                chop;
275                last if $_ eq "---migrate---";
276                $all_channels{$1} = $2 if (/^(\d+):(.*)$/);
277        }
278        close(F);
279
280        foreach my $r (sort { $a <=> $b } keys %REGIONS) {
281                printf "Region %d (%s): [%s]\n",$r,$REGIONS{$r},$all_channels{$r};
282
283                my %local_chan_map = region_channels($r);
284
285                # get shepherd channels
286                my %shepherd_channels;
287                foreach my $ch (split(/,/,$all_channels{$r})) {
288                        $shepherd_channels{$ch} = 1;
289                }
290
291                #
292                # get widget channels
293                #
294                my $url = sprintf "http://au.tv.yahoo.com/widget.html?rg=%d&st=%d&et=%d", $r, $now,($now+86400);
295                my $tries = 2;
296                my ($data, $success, $status_msg, $bytes_fetched, $seconds_slept, $failed_attempts, $response) = 
297                  Shepherd::Common::get_url(url => $url, retries => ($tries-1));
298
299                if ((!$data) || (!$success)) {
300                        print "Failed to fetch '$url' after $tries attempts.";
301                        next;
302                }
303
304                $data = &transform_output($data) if ($response->header('Content-type') and $response->header('Content-type') eq 'xapplication/ywe-octet-stream');
305
306                my $parser = new XML::DOM::Parser;
307                my $tree = $parser->parse($data);
308                my $tree_channels = $tree->getElementsByTagName("venue");
309                for (my $i = 0; $i < $tree_channels->getLength; $i++) {
310                        my $channel = $tree_channels->item($i)->getAttributeNode("co_short")->getValue;
311
312                        my $old_channel = "", my $new_channel;
313                        $new_channel = splice(@{($local_chan_map{$channel})},0,1) if (defined $local_chan_map{$channel});
314                        if (defined $new_channel) {
315                                $old_channel = $channel;
316                                $channel = $new_channel;
317                        }
318
319                        # for this channel get every programme ('event')
320                        my $events = $tree_channels->item($i)->getElementsByTagName("event");
321
322                        if (!defined $shepherd_channels{$channel}) {
323                                $shepherd_channels{$channel} = 0;       # shepherd doesn't know about this channel, widget does
324                        } elsif ($shepherd_channels{$channel} == 1) {
325                                $shepherd_channels{$channel} = 2;       # both shepherd & widget know about channel
326                        } elsif ($shepherd_channels{$channel} == 2) {
327                                $shepherd_channels{$channel} = 3;       # shepherd/widget knew about channel but was duplicated!
328                        } elsif ($shepherd_channels{$channel} == 0) {
329                                ;                                       # aiee. a duplicate of a channel that shepherd doesn't know about!
330                        } else {
331                                die "unhandled shepherd_channels case for '$channel' value ".$shepherd_channels{$channel};
332                        }
333
334                        printf "  %30s %s%s%s (%d progs)%s\n",
335                                $channel, 
336                                ($shepherd_channels{$channel} == 0 ? "[Only known to Widget]" : ""),
337                                ($shepherd_channels{$channel} == 2 ? "[Known to both (good!)]" : ""),
338                                ($shepherd_channels{$channel} == 3 ? "[Known to both (good), but duplicate in widget]" : ""),
339                                $events->getLength,
340                                ($old_channel ne "" ? " [translated from '$old_channel']" : "");
341                }
342
343                # any channels in Shepherd that Widget didn't return?
344                foreach my $ch (keys %shepherd_channels) {
345                        printf "  %30s [Only known to Shepherd]\n", $ch if ($shepherd_channels{$ch} == 1);
346                }
347
348                printf "\n";
349        }
350
351        exit(0);
352}
353
354######################################################################################################
355# transcode ywe-octet-stream back into text
356
357sub transform_output
358{
359        my $data = shift;
360        my $datasize = length($data);
361
362        my @xform_map = (
363          0x39, 0x9E, 0x05, 0x72, 0x6C, 0x06, 0x38, 0x15, 0x42, 0x1E, 0xB9, 0xFD, 0x4D, 0x08, 0x0C, 0x2E,
364          0x57, 0xC7, 0x62, 0x6E, 0xC5, 0x3A, 0x3C, 0xA4, 0x1D, 0xC6, 0x3D, 0x18, 0x2D, 0x1B, 0x83, 0x20,
365          0x78, 0xFC, 0xA5, 0xDE, 0x28, 0xE8, 0x3E, 0x9B, 0x7C, 0x22, 0x1C, 0x89, 0xFF, 0x52, 0x54, 0x43,
366          0x51, 0x7F, 0x71, 0x40, 0x7A, 0xCF, 0x65, 0xE4, 0x36, 0xEB, 0xC9, 0x1F, 0x80, 0x9A, 0x31, 0x4A,
367          0x45, 0xD4, 0x2B, 0x02, 0x4C, 0xF4, 0x53, 0xBD, 0xA8, 0xF9, 0x50, 0x61, 0x8A, 0xD5, 0xBF, 0x81,
368          0xC0, 0xDB, 0xFE, 0xF7, 0xBA, 0xEC, 0xFA, 0x73, 0xA9, 0x8F, 0xB1, 0x70, 0x33, 0xCE, 0x60, 0xAC,
369          0xB2, 0x58, 0x26, 0x85, 0x6B, 0x7D, 0x93, 0x03, 0x64, 0x47, 0x04, 0x88, 0x01, 0xA6, 0x3B, 0x90,
370          0x98, 0xF5, 0x97, 0x3F, 0xF6, 0xD3, 0x94, 0xB7, 0x29, 0x07, 0x96, 0x6F, 0x14, 0x35, 0x8D, 0x2A,
371          0x16, 0x17, 0x8B, 0xD1, 0x48, 0xD6, 0xF1, 0xE2, 0x79, 0x2C, 0x41, 0x5B, 0xBC, 0xB5, 0x68, 0xDC,
372          0x49, 0xD2, 0x6A, 0xCC, 0x25, 0xB4, 0xAA, 0x63, 0x9C, 0x56, 0x4B, 0xB8, 0x87, 0x5E, 0x86, 0x09,
373          0xC4, 0x95, 0xB6, 0x12, 0xF8, 0x84, 0x4E, 0x21, 0x32, 0xCA, 0x66, 0xC3, 0xBB, 0x27, 0xEE, 0xE0,
374          0x1A, 0xD8, 0x6D, 0x4F, 0xAF, 0x82, 0xEF, 0xCD, 0x5F, 0x8C, 0x67, 0xA2, 0xCB, 0xED, 0xAB, 0xB0,
375          0xA7, 0x92, 0x75, 0x5A, 0xF2, 0x0A, 0x0E, 0xE6, 0x7E, 0xC8, 0xE9, 0x19, 0x24, 0x37, 0x11, 0xA0,
376          0xE3, 0xDD, 0xD7, 0x23, 0x9F, 0x00, 0xA1, 0xC1, 0x74, 0xF0, 0x99, 0x77, 0xAE, 0x91, 0x7B, 0xFB,
377          0xD9, 0xDA, 0xC2, 0x44, 0x0D, 0x76, 0x10, 0x9D, 0xEA, 0xE7, 0xE5, 0x59, 0xF3, 0xD0, 0x5D, 0x2F,
378          0x69, 0xAD, 0x34, 0x0F, 0x5C, 0x8E, 0xBE, 0x13, 0x30, 0x55, 0xE1, 0xDF, 0x0B, 0xB3, 0x46, 0xA3);
379        my ($xlate_pos1, $xlate_pos2, $xlate_pos3, $xlate_pos4) = (0,0,0,0);
380        my $outputdata;
381
382        return undef if (($datasize < 1) || (ord(substr($data,0,1)) != 1)); # not valid
383
384        for (my $pos = 1; $pos < $datasize; $pos++) {
385                $xlate_pos1 = ($xlate_pos1 + 1) % 256;
386                $xlate_pos3 = $xform_map[$xlate_pos1];
387                $xlate_pos4 = ($xlate_pos2 + $xlate_pos3) % 256;
388                $xlate_pos2 = $xform_map[$xlate_pos4];
389                $xform_map[$xlate_pos1] = $xlate_pos2;
390                $xlate_pos2 += $xlate_pos3;
391                $xform_map[$xlate_pos4] = $xlate_pos3;
392                $xlate_pos2 = $xlate_pos2 % 256;
393                $xlate_pos3 = $xform_map[$xlate_pos2];
394                $xlate_pos2 = $xlate_pos4;
395                $outputdata .= chr((((ord(substr($data,$pos,1))) % 256) ^ ($xlate_pos3 % 256)) % 256);
396        }
397        if (defined $opt->{rawout}) {
398                if (open(F,">>$opt->{rawout}")) {
399                        print F $outputdata;
400                        close F;
401                }
402        }
403        return($outputdata);
404}
405
406######################################################################################################
407
408sub log
409{
410        my ($entry) = @_;
411        printf "%s\n",$entry;
412}
413
414######################################################################################################
415
416sub print_stats
417{
418        printf "STATS: %s v%s completed in %d seconds",$progname,$version,(time-$script_start_time);
419        foreach my $key (sort keys %stats) {
420                printf ", %d %s",$stats{$key},$key;
421        }
422        printf "\n";
423}
424
425######################################################################################################
426# given yahoo7 xml data, parse it into 'shows' ..
427# parse it into $tv_guide->{$channel}->{data}->{$event_id}-> structures..
428
429sub parse_xml_data
430{
431        my $data = shift;
432
433        unless ($data) {
434            print STDERR "ERROR: no data to parse.\n";
435            return;
436        }
437
438        my %local_chan_map = region_channels($opt->{region});
439
440        my $parser = new XML::DOM::Parser;
441        my $tree = $parser->parse($data);
442        my $tree_channels = $tree->getElementsByTagName("venue");
443        for (my $i = 0; $i < $tree_channels->getLength; $i++) {
444                my $channel = $tree_channels->item($i)->getAttributeNode("co_short")->getValue;
445
446                # see if we need to do any mappings for this channel
447                my @mapped_channels;
448
449                if (defined $local_chan_map{$channel}) {
450                        my $new_channel = splice(@{($local_chan_map{$channel})},0,1);
451                        if (not $new_channel) {
452                                &log("new unmapped channel for '$channel'");
453                        } else {
454                                &log("mapped '$channel' to '$new_channel'") if (defined $opt->{debug});
455                                $channel = $new_channel;
456                        }
457                }
458
459                if ((!defined $channels->{$channel}) && (!defined $opt_channels->{$channel})) {
460                        if (!defined $d->{ignored_channels}->{$channel}) {
461                                $d->{ignored_channels}->{$channel} = 1;
462                                $stats{skipped_channels}++;
463                                &log("ignoring unknown channel '$channel'");
464                        }
465                        next;
466                }
467
468                # for this channel get every programme ('event')
469                my $events = $tree_channels->item($i)->getElementsByTagName("event");
470                for (my $j = 0; $j < $events->getLength; $j++) {
471                        my $event = $events->item($j);
472                        my $event_id = $event->getElementsByTagName("event_id")->item(0)->getFirstChild->getNodeValue;
473
474                        # mandatory fields
475                        my $event_start =       $event->getElementsByTagName("event_date")->item(0)->getFirstChild->getNodeValue;
476                        my $event_end =         $event->getElementsByTagName("end_date")->item(0)->getFirstChild->getNodeValue;
477
478                        if ($event_start < 10) {
479                                $stats{progs_with_invalid_start}++;
480                                printf "WARNING: programme with event_id '$event_id' had an invalid start time of '$event_start'; skipped\n";
481                                next;
482                        }
483                        if ($event_end < 10) {
484                                $stats{progs_with_invalid_end}++;
485                                printf "WARNING: programme with event_id '$event_id' had an invalid end time of '$event_end'; skipped\n";
486                                next;
487                        }
488
489                        $event_id = $event_start.":".$event_end.":".$event_id; # event_id actually isn't unique - so make it so
490
491                        $stats{programmes}++;
492                        $stats{duplicate_programmes}++ if ($tv_guide->{$channel}->{data}->{$event_id});
493
494                        # wrap these non-mandatory fields in an eval so if they don't exist the script doesn't barf out
495                        my %e;
496                        foreach my $field ('title', 'subtitle', 'description_1', 'main_cast', 'year_released', 'rating',
497                          'genre', 'running_time', 'repeat', 'country', 'movie', 'premiere', 'final', 'captions',
498                          'warnings', 'colour', 'language', 'director', 'live', 'return') {
499                                eval { $e{$field} = $event->getElementsByTagName("$field")->item(0)->getFirstChild->getNodeValue; };
500                        }
501                        # other fields we dont pick up but exist in source xml data include:
502                        #  other_title, description_2, genre_id, sub_category, highlight, ext_url, y7_url
503                        # 'return' unseen
504
505                        my %video_details;
506                        $video_details{'colour'} = "yes" if $e{colour};
507
508                        my $rating = "";
509                        $rating .= $e{rating} if $e{rating};
510                        $rating .= " " if $e{rating} and $e{warnings};
511                        $rating .= lc $e{warnings} if $e{warnings};
512
513                        # store it in the correct XMLTV schema!
514                        $tv_guide->{$channel}->{data}->{$event_id}->{'channel'} = $channels->{$channel} if (defined $channels->{$channel});
515                        $tv_guide->{$channel}->{data}->{$event_id}->{'channel'} = $opt_channels->{$channel} if (defined $opt_channels->{$channel});
516
517                        $tv_guide->{$channel}->{data}->{$event_id}->{'start'} =         POSIX::strftime("%Y%m%d%H%M", localtime($event_start));
518                        $tv_guide->{$channel}->{data}->{$event_id}->{'stop'} =          POSIX::strftime("%Y%m%d%H%M", localtime($event_end));
519                        $tv_guide->{$channel}->{data}->{$event_id}->{'title'} =         [[ $e{title}, $opt->{lang} ]] if $e{title};
520                        $tv_guide->{$channel}->{data}->{$event_id}->{'sub-title'} =     [[ $e{subtitle}, $opt->{lang} ]] if $e{subtitle};
521                        $tv_guide->{$channel}->{data}->{$event_id}->{'desc'} =          [[ $e{description_1}, $opt->{lang} ]] if $e{description_1};
522                        $tv_guide->{$channel}->{data}->{$event_id}->{'category'} =      [ &Shepherd::Common::generate_category($e{title}, $e{genre}, %e) ];
523                        $tv_guide->{$channel}->{data}->{$event_id}->{'country'} =       [[ $e{country}, $opt->{lang} ]] if $e{country};
524                        $tv_guide->{$channel}->{data}->{$event_id}->{'premiere'} =      [ 'premiere', $opt->{lang} ] if $e{premiere};
525                        $tv_guide->{$channel}->{data}->{$event_id}->{'rating'} =        [[ $rating, 'ABA', undef ]] if $rating ne "";
526                        $tv_guide->{$channel}->{data}->{$event_id}->{'credits'}{'actor'} = [ split(/, /, $e{main_cast}) ] if $e{main_cast};
527                        $tv_guide->{$channel}->{data}->{$event_id}->{'credits'}{'director'} = [ split(/, /, $e{director}) ] if $e{director};
528                        $tv_guide->{$channel}->{data}->{$event_id}->{'credits'}{'writer'} = [ split(/, /, $e{writer}) ] if $e{writer}; # unseen
529                        $tv_guide->{$channel}->{data}->{$event_id}->{'date'} =  $e{year_released} if $e{year_released};
530                        $tv_guide->{$channel}->{data}->{$event_id}->{'previously-shown'} = { } if $e{repeat};
531                        $tv_guide->{$channel}->{data}->{$event_id}->{'subtitles'} =     [ { 'type' => 'teletext' } ] if $e{captions};
532                        $tv_guide->{$channel}->{data}->{$event_id}->{'last-chance'} =   [ 'final', $opt->{lang} ] if $e{final};
533                        $tv_guide->{$channel}->{data}->{$event_id}->{'video'} =         \%video_details;
534                        $tv_guide->{$channel}->{data}->{$event_id}->{'length'} =        ($e{running_time} * 60) if $e{running_time};
535                        $tv_guide->{$channel}->{data}->{$event_id}->{'language'} =      [ $e{language}, $opt->{lang} ] if $e{language};
536
537                        $d->{seen_progs}->{$channel}++;
538                }
539        }
540        $tree->dispose;
541}
542
543######################################################################################################
544
545sub write_data
546{
547        my %writer_args = ( encoding => 'ISO-8859-1' );
548        if ($opt->{outputfile}) {
549                my $fh = new IO::File(">$opt->{outputfile}")  or die "can't open $opt->{outputfile}: $!";
550                $writer_args{OUTPUT} = $fh;
551        }
552
553        my $writer = new XMLTV::Writer(%writer_args);
554
555        $writer->start
556          ( { 'source-info-name'   => "$progname $version",
557              'generator-info-name' => "$progname $version"} );
558
559        for my $channel (sort keys %{$channels}) {
560                $writer->write_channel( {'display-name' => [[ $channel, $opt->{lang} ]], 'id' => $channels->{$channel}} )
561                  if (defined $d->{seen_progs}->{$channel});
562        }
563        for my $channel (sort keys %{$opt_channels}) {
564                $writer->write_channel( {'display-name' => [[ $channel, $opt->{lang} ]], 'id' => $opt_channels->{$channel}} )
565                  if (defined $d->{seen_progs}->{$channel});
566        }
567
568        for my $channel (sort keys %{($d->{seen_progs})}) {
569                for my $event_id (sort {$a cmp $b} keys %{($tv_guide->{$channel}->{data})}) {
570                        my $show = $tv_guide->{$channel}->{data}->{$event_id};
571                        Shepherd::Common::cleanup($show);
572                        $writer->write_programme($show);
573                }
574        }
575
576        $writer->end();
577}
578
579######################################################################################################
Note: See TracBrowser for help on using the browser.