root/trunk/grabbers/yahoo7widget @ 959

Revision 959, 21.2 kB (checked in by paul, 6 years ago)

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