root/trunk/grabbers/foxtel_swf

Revision 1393, 41.5 kB (checked in by max, 5 months ago)

foxtel_swf: Update for datasource change
  • Property svn:executable set to *
Line 
1#!/usr/bin/env perl
2
3# foxtel_swf australian paytv grabber
4#  * grabs data from www.foxtel.com.au
5#  * this does NOT use any config file - all settings (channels) are passed in from shepherd
6
7use strict;
8
9my $progname = "foxtel_swf";
10my $version = "3.00";
11my $cache_file = $progname.".storable.cache";
12
13use XML::Simple;
14use XMLTV;
15use POSIX qw(strftime mktime);
16use Getopt::Long;
17use Data::Dumper;
18use Time::Local;
19#use Common;              #### NOTE<---- for stand alone testing somewhere else
20use Shepherd::Common;     #### NOTE<---- for shepherd
21use Crypt::SSLeay;
22
23#
24# global variables and settings
25#
26
27$| = 1;
28my $script_start_time = time;
29my %stats;
30my $channels, my $opt_channels, my $gaps;
31my $data_cache;
32my $writer;
33my $d;
34my $opt;
35my $cache_dirty = 0;
36my $first_start_time;
37
38$d->{common_post_start} = "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n<e:Envelope xmlns:s=\"http://epg.foxtel.com.au/schema\" xmlns:e=\"http://schemas.xmlsoap.org/soap/envelope/\"><e:Header><s:SecurityHeader><s:Code>bae4e7</s:Code><s:Code>c263a851-f</s:Code><s:Code>b85b5aee-485</s:Code><s:Code>3ec1fba0-24</s:Code></s:SecurityHeader></e:Header><e:Body>";
39$d->{common_post_end} = "</e:Body></e:Envelope>";
40
41#
42# parse command line
43#
44
45$opt->{days}            = 12;                   # default   
46$opt->{outputfile}      = "output.xmltv";       # default
47$opt->{lang}            = "en";
48$opt->{region}          = 94;
49
50#$opt->{days}           = 2;                  #   11 ### NOTE<---- for stand alone testing somewhere else
51#$opt->{offset}         = 1;                  #   10 ### NOTE<---- for stand alone testing somewhere else
52#$opt->{channels_file}   =  "channels_test";  #### NOTE<---- for stand alone testing somewhere else
53#$opt->{debug} = 1 ;                          #### NOTE<---- for stand alone testing somewhere else
54
55GetOptions(
56        'log-http'      => \$opt->{log_http},
57        'region=i'      => \$opt->{region},
58        'days=i'        => \$opt->{days},
59        'offset=i'      => \$opt->{offset},
60        'timezone=s'    => \$opt->{timezone},
61        'channels_file=s' => \$opt->{channels_file},
62        'gaps_file=s'   => \$opt->{gaps_file},
63        'output=s'      => \$opt->{outputfile},
64        'fast'          => \$opt->{fast},
65        'debug+'        => \$opt->{debug},
66        'all_channels'  => \$opt->{all_channels},
67        'warper'        => \$opt->{warper},
68        'lang=s'        => \$opt->{lang},
69        'obfuscate'     => \$opt->{obfuscate},
70        'anonsocks=s'   => \$opt->{anon_socks},
71        'help'          => \$opt->{help},
72        'verbose'       => \$opt->{help},
73        'version'       => \$opt->{version},
74        'daynum=i'      => \$opt->{daynum},     #mb added - get day starting at day number
75        'getdays=i'     => \$opt->{getdays},    #mb added - number of days to get
76        'ready'         => \$opt->{version},
77        'chans=s'       => \$opt->{chans},
78        'v'             => \$opt->{help});
79
80&help if ($opt->{help});
81
82if ($opt->{version}) {
83        printf "%s %s\n",$progname,$version;
84        exit(0);
85}
86
87if ($opt->{chans})  { $opt->{channels_file} = "Channels_".$opt->{chans} ;}
88
89die "no channel file specified, see --help for instructions\n", if (!$opt->{channels_file});
90
91#
92# go go go!
93#
94
95Shepherd::Common::log(sprintf "%s v%s going to %sgrab %d days%s of data into %s (%s%s%s)",
96        $progname, $version,
97        (defined $opt->{gaps_file} ? "micro-gap " : ""),
98        $opt->{days},
99        (defined $opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
100        $opt->{outputfile},
101        (defined $opt->{fast} ? "with haste" : "slowly"),
102        (defined $opt->{anon_socks} ? ", via multiple endpoints" : ""),
103        (defined $opt->{warper} ? ", anonymously" : ""));
104
105# read channels file
106if (-r $opt->{channels_file}) {
107        local (@ARGV, $/) = ($opt->{channels_file});
108        no warnings 'all'; eval <>; die "$@" if $@;
109} else {
110        die "WARNING: channels file $opt->{channels_file} could not be read\n";
111}
112
113# if just filling in microgaps, parse gaps
114if (defined $opt->{gaps_file}) {
115        if (-r $opt->{gaps_file}) {
116                local (@ARGV, $/) = ($opt->{gaps_file});
117                no warnings 'all'; eval <>; die "$@" if $@;
118        } else {
119                die "WARNING: gaps_file $opt->{gaps_file} could not be read: $!\n";
120        }
121}
122
123# set defaults
124Shepherd::Common::set_default("debug", (defined $opt->{debug} ? 2 : 0));
125Shepherd::Common::set_default("webwarper", 1) if (defined $opt->{warper});
126Shepherd::Common::set_default("squid", 1) if (defined $opt->{obfuscate});
127Shepherd::Common::set_default("referer", "https://www.foxtel.com.au/cms/fragments/fragment_epgflash/epg2main.swf");
128Shepherd::Common::set_default("retry_delay", 10);
129Shepherd::Common::setup_ua('cookie_jar' => 1, 'fake' => 1);
130Shepherd::Common::setup_socks($opt->{anon_socks}) if (defined $opt->{anon_socks});
131
132$d->{chosen_state} = Shepherd::Common::which_state($opt->{region});
133
134
135
136  if (defined $opt->{daynum}) {
137        # for working out which day in advance is daynum - if daynum is used (not used by shepherd)
138        my $starttime;
139        my $endtime;
140        my $gotime;
141        my ($nnow);
142        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
143        $nnow = localtime($script_start_time);
144        #print("   Now is: $nnow\n");
145
146        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($script_start_time);
147        $sec = 0; $hour = 0; $min = 0;
148        $gotime = timelocal($sec,$min,$hour,$mday,$mon,$year);
149
150        $nnow = localtime( $gotime);
151        #print(" Go time:  $nnow\n");
152   
153        $starttime = $gotime + ( $opt->{daynum} * 86400);
154        $nnow = localtime( $starttime);
155        #print(" Starting:  $nnow\n");
156   
157        $opt->{getdays} = 1 if (! defined $opt->{getdays});
158   
159        $endtime = $starttime + ($opt->{getdays} * 86400)-1;
160        $nnow = localtime( $endtime);
161        #print(" Ending  :  $nnow\n");
162  }
163
164&read_cache;
165
166&get_initial_page;
167&get_reference_data();
168&start_writing_xmltv;
169&choose_channel_lineup();
170
171if (!defined $opt->{gaps_file}) {
172  my $starttime;
173  my $endtime;
174  my $gotime;
175  my ($nnow);
176
177  if (defined $opt->{daynum}) {
178 
179        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($script_start_time);
180        $nnow = localtime($script_start_time);
181         #print("   Now is: $nnow\n");
182        $sec = 0; $hour = 0; $min = 0;
183        $gotime = timelocal($sec,$min,$hour,$mday,$mon,$year);
184
185        $nnow = localtime( $gotime);
186        #print(" Go time:  $nnow\n");
187   
188        $starttime = $gotime + ( $opt->{daynum} * 86400);
189
190        $opt->{getdays} = 1 if (! defined $opt->{getdays});
191        $endtime = $starttime + ($opt->{getdays} * 86400)-1;
192   
193        $nnow = localtime( $starttime); #print(" Start:  $nnow");
194        $nnow = localtime( $endtime);   #print(" End:  $nnow\n");
195        $first_start_time = $starttime;
196        &get_program_window($starttime, $endtime);
197
198  }
199  else {
200        $starttime = $script_start_time;
201        $endtime = $starttime + ($opt->{days} * 86400);
202        $starttime += ($opt->{offset} * 86400) if (defined $opt->{offset});
203
204        &get_program_window($starttime, $endtime);
205        }
206} else {
207        Shepherd::Common::log("microgaps not yet supported."); # TODO: microgaps
208}
209
210$writer->end();
211
212&write_cache   if ($cache_dirty == 1);
213
214Shepherd::Common::print_stats($progname, $version, $script_start_time, %stats);
215exit(0);
216
217##############################################################################
218# help
219
220sub help
221{
222        print<<EOF
223$progname $version
224
225options are as follows:
226        --help                  show these help options
227        --days=N                fetch 'n' days of data (default: $opt->{days})
228        --output=file           send xml output to file (default: "$opt->{outputfile}")
229        --fast                  don't run slow - get data as quick as you can - not recommended
230        --anonsocks=(ip:port)   use SOCKS4A server at (ip):(port) (for Tor: recommended)
231
232        --debug                 increase debug level
233        --warper                fetch data using WebWarper web anonymizer service
234        --obfuscate             pretend to be a proxy servicing multiple clients
235        --lang=[s]              set language of xmltv output data (default $opt->{lang})
236
237        --region=N              set region for where to collect data from (default: $opt->{region})
238        --channels_file=file    where to get channel data from
239        --gaps_file=file        micro-fetch gaps only
240
241EOF
242;
243
244        exit(0);
245}
246
247##############################################################################
248# logic to fetch a page via http
249
250sub get_url
251{
252        my %cnf = @_;
253        my ($html_data, $success, $status_msg, $bytes_fetched, $seconds_slept, $failed_attempts) = Shepherd::Common::get_url(%cnf);
254
255        $stats{failed_requests} += $failed_attempts;
256        $stats{slept_for} += $seconds_slept;
257        $stats{bytes_fetched} += $bytes_fetched;
258
259        return undef if ((!$html_data) || (!$success));
260        return $html_data;
261}
262
263##############################################################################
264# populate cache
265
266sub read_cache
267{
268        my $store = Shepherd::Common::read_cache(\$cache_file);
269       
270        if ($store) {
271                $data_cache = $store->{data_cache};
272
273                # age out old entries
274                for my $k (keys %{($data_cache->{prog_cache})}) {
275                        # not used for 30 days
276                        if ($data_cache->{prog_cache}->{$k}->{last_used} < ($script_start_time - (86400*30))) {
277                                delete $data_cache->{prog_cache}->{$k};
278                                $cache_dirty = 1;
279                                $stats{expired_from_cache}++;
280                                next;
281                        }
282                        # add new field if doesn't exist and expire within a month (2007/07/30)
283                        $data_cache->{prog_cache}->{$k}->{first_used} =
284                                $data_cache->{prog_cache}->{$k}->{last_used} - (86400*30*5)
285                                        if not defined $data_cache->{prog_cache}->{$k}->{first_used};
286                        # not updated for 6 months
287                        if ($data_cache->{prog_cache}->{$k}->{first_used} < ($script_start_time - (86400*30*6))) {
288                                delete $data_cache->{prog_cache}->{$k}; 
289                                $cache_dirty = 1;
290                                $stats{expired_from_cache}++;
291                        }
292                }
293               
294               
295                for my $k (keys %{($data_cache->{event_cache})}) {
296                        # not used for 12 days
297                        if ($data_cache->{event_cache}->{$k}->{last_used} < ($script_start_time - (86400*12))) {
298                                delete $data_cache->{event_cache}->{$k};
299                                $cache_dirty = 1;
300                                $stats{expired_from_cache}++;
301                                next;
302                        }
303                        # add new field if doesn't exist and expire within a month (2007/07/30)
304                        $data_cache->{event_cache}->{$k}->{first_used} =
305                                $data_cache->{event_cache}->{$k}->{last_used} - (86400*30*5)
306                                        if not defined $data_cache->{event_cache}->{$k}->{first_used};
307                        # not updated for 12 days
308                        if ($data_cache->{event_cache}->{$k}->{first_used} < ($script_start_time - (86400*12))) {
309                                delete $data_cache->{event_cache}->{$k}; 
310                                $cache_dirty = 1;
311                                $stats{expired_from_cache}++;
312                        }
313                }
314
315               
316        }
317}
318
319##############################################################################
320# write out updated cache
321
322sub write_cache
323{
324        my $store;
325        $store->{data_cache} = $data_cache;
326        Shepherd::Common::write_cache($cache_file, $store);
327        $cache_dirty = 0;
328}
329
330##############################################################################
331
332sub start_writing_xmltv
333{
334        my %writer_args = ( encoding => 'ISO-8859-1' );
335        if ($opt->{outputfile}) {
336                my $fh = new IO::File(">$opt->{outputfile}") || die "can't open $opt->{outputfile}: $!";
337                $writer_args{OUTPUT} = $fh;
338        }
339
340        $writer = new XMLTV::Writer(%writer_args);
341
342        $writer->start
343          ( { 'source-info-name' => "$progname $version",
344              'generator-info-name' => "$progname $version"} );
345}
346
347##############################################################################
348
349sub get_initial_page
350{
351        my $data;
352
353        Shepherd::Common::log(" - fetching initial page...");
354
355        $data = &get_url(url => "http://www.foxtel.com.au/whats-on/tv-guide/default.htm", retries => 4);
356        die "Failed to retrieve initial page! Aborting..\n" if (!$data);
357
358        $data = &get_url(url => "https://epg.foxtel.com.au/epg-service/epg/EpgServiceV2?wsdl", retries => 4);
359        Shepherd::Common::log("DEBUG: get_initial_page got: $data") if ((defined $opt->{debug}) && ($opt->{debug} > 1));
360}
361
362##############################################################################
363
364sub get_reference_data
365{
366        my $data, my $postvars;
367       
368        Shepherd::Common::log(" - fetching reference data...");
369       
370        $postvars = $d->{common_post_start}.
371                "<s:InitialiseEpgIn>".
372                        "<s:FoxtelAccountId></s:FoxtelAccountId>".
373                        "<s:StateCode>".$d->{chosen_state}."</s:StateCode>".
374                "</s:InitialiseEpgIn>".
375                $d->{common_post_end};
376       
377        $data = &soap_request("InitialiseEpg", $postvars);
378       
379        die "Failed to get ReferenceData\n" if !$data;
380
381        Shepherd::Common::log("DEBUG: get_reference_data got: $data") if ((defined $opt->{debug}) && ($opt->{debug} > 1));
382
383        my $parsed_xml = XMLin($data);
384
385        die "Failed to retrieve valid ReferenceData\n"
386          if (!defined $parsed_xml->{'soapenv:Body'}->{'ns5:InitialiseEpgOut'});
387        my $ref = $parsed_xml->{'soapenv:Body'}->{'ns5:InitialiseEpgOut'};
388
389        # check for error response
390        die "ReferenceData page indicated failure code: ".$ref->{'ns5:EPGFault'}->{'ns5:Message'}.": aborting!\n"
391          if ($ref->{'ns5:EPGFault'}->{'ns5:Message'});
392
393        # get bouqet
394        die "Failed to retrieve Bouquet\n"
395                if (!defined $ref->{'ns5:Bouquet'});
396        $d->{bouquet}->{bouquet_id} = $ref->{'ns5:Bouquet'}->{'ns5:BouquetId'};
397        $d->{bouquet}->{subbouquet_id} = $ref->{'ns5:Bouquet'}->{'ns5:SubBouquetId'};
398       
399        # get state
400        die "Failed to retrieve State\n"
401                if (!defined $ref->{'ns5:State'});
402        $d->{state}->{id} = $ref->{'ns5:State'}->{'ns5:Id'};
403        $d->{state}->{code} = $ref->{'ns5:State'}->{'ns5:Code'};
404        $d->{state}->{name} = $ref->{'ns5:State'}->{'ns5:Name'};
405        Shepherd::Common::log(" - parsed state id:$d->{state}->{id}, code:$d->{state}->{code}, bouquet_id:$d->{bouquet}->{bouquet_id}, subbouquet_id:$d->{bouquet}->{subbouquet_id}, name:$d->{state}->{name}") if (defined $opt->{debug});
406
407        # gather up channel categories
408        foreach my $category_ref (@{($ref->{'ns5:ChannelCategories'}->{'ns5:Category'})}) {
409                my $category_id = $category_ref->{'ns5:Id'};
410                my $category_name = $category_ref->{'ns5:Name'};
411
412                $d->{categories}->{$category_id} = $category_name;
413                Shepherd::Common::log(" - parsed category $category_id: $category_name") if (defined $opt->{debug});
414        }
415
416        # gather up genres and subgenres
417        $d->{genre_count} = 0;
418        $d->{subgenre_count} = 0;
419        foreach my $genre_ref (@{($ref->{'ns5:Genres'}->{'ns5:Genre'})}) {
420                my $genre_code = $genre_ref->{'ns5:Code'};
421                my $genre_name = $genre_ref->{'ns5:Name'};
422
423                $d->{genres}->{$genre_code}->{name} = $genre_name;
424                $d->{genre_count}++;
425               
426                foreach my $subgenre_ref (@{($genre_ref->{'ns5:SubGenre'})}) {
427                        # GetEventDetails returns ns5:SubGenreCode Id, not Code, so we store the Id
428                        my $subgenre_code = $subgenre_ref->{'ns5:Id'};
429                        my $subgenre_name = $subgenre_ref->{'ns5:Name'};
430                       
431                        $d->{genres}->{$genre_code}->{$subgenre_code} = $subgenre_name;
432                        $d->{subgenre_count}++;
433                        Shepherd::Common::log(" - parsed subgenre code $subgenre_code for genre code $genre_code: $subgenre_name") if (defined $opt->{debug});
434                }
435                Shepherd::Common::log(" - parsed genre $genre_code: $genre_name") if (defined $opt->{debug});
436        }
437        Shepherd::Common::log("   ".$d->{genre_count}." genres, ".$d->{subgenre_count}." subgenres");
438
439        # gather up channels
440        $d->{channel_count} = 0;
441        foreach my $channel_ref (@{($ref->{'ns5:Channels'}->{'ns5:Channel'})}) {
442                my $channel_id = $channel_ref->{'ns5:Id'};
443                my $channel_name = $channel_ref->{'ns5:ChannelName'};
444                my $orig_channel_name = $channel_name;
445                $channel_name =~ s/[ \t()\[\]\+\.\-]//g;        # remove special chars
446                $channel_name =~ s/(&amp;|&)/and/g;             # &amp; to and
447                $channel_name =~ s|[/,].*||;                    # and deleting after / or ,
448
449                $d->{channel_names}->{$channel_name} = $channel_id;
450                $d->{channels}->{$channel_id}->{name} = $orig_channel_name;
451                $d->{channels}->{$channel_id}->{number} = $channel_ref->{'ns5:DigitalNumber'};
452                $d->{channels}->{$channel_id}->{category} = $channel_ref->{'ns5:ChannelCategoryId'};
453                $d->{channels}->{$channel_id}->{content_warning} = $channel_ref->{'ns5:ContentWarningInd'};
454                $d->{channels}->{$channel_id}->{available} = $channel_ref->{'ns5:ChannelAvailableInd'};
455                $d->{channels}->{$channel_id}->{timeshift} = $channel_ref->{'ns5:TimeShiftInd'};
456
457                $d->{channel_count}++;
458                Shepherd::Common::log(" - parsed channel $channel_id: (".$d->{channels}->{$channel_id}->{number}.") $channel_name)") if (defined $opt->{debug});
459        }
460        Shepherd::Common::log("   ".$d->{channel_count}." channels for region");
461}
462
463##############################################################################
464
465sub choose_channel_lineup
466{
467        $d->{included_chan_count} = 0;
468
469        foreach my $ch (keys %{($d->{channel_names})}) {
470                if ((defined $channels->{$ch}) ||
471                    (defined $opt_channels->{$ch}) ||
472                    (defined $opt->{all_channels})) {
473                        my $ch_id = $d->{channel_names}->{$ch};
474                        my $ch_xmlid = $ch;
475                        $ch_xmlid = $channels->{$ch} if (defined $channels->{$ch});
476                        $ch_xmlid = $opt_channels->{$ch} if (defined $opt_channels->{$ch});
477
478                        $d->{including_channels}->{$ch_id} = $ch_xmlid;
479                        $d->{channels}->{$ch_id}->{xmlid} = $ch_xmlid;
480                        $d->{included_chan_count}++;
481
482                        $writer->write_channel( {
483                                'display-name' => [[ $d->{channels}->{$ch_id}->{name}, $opt->{lang} ]],
484                                'id' => $ch_xmlid } );
485                }
486        }
487
488        die "no channels found to include. aborting! (channels:".
489                join(",",keys %$channels).", opt_channels:".
490                join(",",keys %$opt_channels)."\n"
491          if ($d->{included_chan_count} == 0);
492}
493
494##############################################################################
495
496sub get_program_window
497{
498        my ($starttime, $stoptime) = @_;
499        my $curr_start, my $curr_stop;
500        my $consecutive_failures = 0;
501
502        Shepherd::Common::log("fetching program data for ".$d->{included_chan_count}." channels from lineup");
503
504        $curr_start = $starttime;
505        while ($curr_start < $stoptime) {
506                $curr_stop = $curr_start + (3 * 60 * 60); # 6 hours
507                $curr_stop = $stoptime if ($curr_stop > $stoptime);
508
509                my $success;
510                my $goback = 0;
511                while ((!($success = &get_programs($curr_start,$curr_stop))) && ($goback++ < 2)) {
512                        $curr_start -= 5 * 60;
513                        $curr_stop  -= 5 * 60;
514                        $stoptime   -= 5 * 60;
515                        Shepherd::Common::log("  going back 5 minutes");
516                        $stats{gone_back}++;
517                }
518
519                if (!$success) {
520                        $consecutive_failures++;
521
522                        if ($consecutive_failures >= 2) {
523                                Shepherd::Common::log(" aborting fetching due to errors.");
524                                $stats{aborted_fetching}++;
525                                last;
526                        }
527                } else {
528                        $consecutive_failures = 0;
529                }
530
531                $curr_start = $curr_stop;
532
533                my $waittime = 6 + int(rand(5));
534                $waittime = 2 if (defined $opt->{fast});
535                $stats{slept_for} += $waittime;
536                sleep($waittime);
537        }
538}
539
540##############################################################################
541
542sub get_programs
543{
544  my ($starttime, $stoptime) = @_;
545  my $ref;
546       
547  Shepherd::Common::log(" - ".POSIX::strftime("%a %e %b %H:%M", localtime($starttime))." to ".POSIX::strftime("%a %e %b %H:%M", localtime($stoptime))." ...");
548# print "Local Start time: ".localtime( $starttime). "Stop: ".localtime( $stoptime)."\n" ;
549  $ref = &soap_search_events($starttime, $stoptime);
550  return 1 if (! defined($ref));
551  Shepherd::Common::log("   gathering synopsis for up to ".(scalar(@{($ref->{'ns5:Events'}->{'ns5:Event'})}))." progs ...");
552       
553  #
554  # Loop through each programme and see if we have it in the cache.  If it's in the cache grab it and write it to the output file.
555  # If it's not in the cache store it's EventId for lookup.
556  #
557  my $prog_count = 0;
558  my $cache_hit = 0;
559  my $event_hit = 0;
560  my $cache_miss = 0;
561       
562  my @event_list;
563  foreach my $prog_ref (@{($ref->{'ns5:Events'}->{'ns5:Event'})}) {
564        $prog_count++;
565   
566        ### first check the program start, stop and durations (new_start & new_stop are used to overide the cache entry
567   
568        my $new_start = 0;
569        my $new_stop = 0;
570        my $new_channel = "none";
571        my $new_length  = int($prog_ref->{'ns5:Duration'} * 60);
572        my $new_title;
573        $new_title = $prog_ref->{'ns5:ProgramTitle'} if (defined $prog_ref->{'ns5:ProgramTitle'});
574               
575        if ((defined $prog_ref->{'ns5:ScheduledDate'}) &&
576                    ($prog_ref->{'ns5:ScheduledDate'} =~ /^(\d{4})-(\d{2})\-(\d{2})T(\d{2}):(\d{2}):(\d{2})\.(\d{3})\+(\d{2}):(\d{2})$/)) {
577                        my $prog_tz = "+".$8.$9;
578                        my @t = ($6, $5, $4, $3, ($2-1), ($1-1900), -1, -1, -1);
579
580                        my $prog_start = mktime(@t);
581                        my $prog_stop = $prog_start + $new_length;
582
583                        $new_start = POSIX::strftime("%Y%m%d%H%M%S", localtime($prog_start))." ".$prog_tz;
584                        $new_stop =  POSIX::strftime("%Y%m%d%H%M%S", localtime($prog_stop))." ".$prog_tz;
585                        if ((defined $opt->{daynum}) and ( $prog_start < $first_start_time ))
586                          { print("Skipping, starts before requested time at $prog_ref->{'ns5:ScheduledDate'}\n"); next; }
587        } else {
588                        $stats{skipped_prog_bad_starttime}++;
589                        Shepherd::Common::log("unparsable date ".$prog_ref->{'ns5:ScheduledDate'})
590                                if ((defined $prog_ref->{'ns5:ScheduledDate'}) &&
591                                        ($stats{skipped_prog_bad_starttime} < 10));
592                        next;
593        }
594       
595        ### and its on the same channel (new_channl is used as a cache key
596
597        if ((defined $prog_ref->{'ns5:ChannelId'}) &&
598                                (defined $d->{channels}->{$prog_ref->{'ns5:ChannelId'}}->{xmlid})) {
599                        $new_channel = $d->{channels}->{$prog_ref->{'ns5:ChannelId'}}->{xmlid};
600        } else {
601                        $stats{skipped_prog_bad_channel}++;
602                        next;
603        }
604
605
606        ### now check the program cache for a;; other details....
607                               
608        # if we have a ProgramId...
609        if (defined $prog_ref->{'ns5:ProgramId'}) {
610                        my $prog_id = $new_channel . $prog_ref->{'ns5:ProgramId'};
611                        # check the cache
612                        # print ("Checking prog cache for $prog_id.... ($prog_ref->{'ns5:ProgramTitle'})\n");
613                        if ((defined $data_cache->{prog_cache}->{$prog_id}) && (ref $data_cache->{prog_cache}->{$prog_id}->{details})) {
614                                $cache_hit++;
615                                $stats{programmes}++;
616                                $stats{used_prog_cache}++;
617                                $data_cache->{prog_cache}->{$prog_id}->{last_used} = $script_start_time;
618                               
619                                $data_cache->{prog_cache}->{$prog_id}->{details}->{start}  = $new_start;
620                                $data_cache->{prog_cache}->{$prog_id}->{details}->{stop}   = $new_stop;
621                                $data_cache->{prog_cache}->{$prog_id}->{details}->{length} = $new_length;
622                               
623
624#                               print ("    Found cache Program entry for $prog_id\n");
625                               
626                                my $hghghgh = $data_cache->{prog_cache}->{$prog_id}->{details};
627                                $writer->write_programme($data_cache->{prog_cache}->{$prog_id}->{details});
628        my $eptitle = "";
629        $eptitle = $data_cache->{prog_cache}->{$prog_id}->{eptitle} if (defined $data_cache->{prog_cache}->{$prog_id}->{eptitle});
630#       print ("    Found cache Progm for $prog_id ($new_title) [$eptitle] \n");               
631                               
632        Shepherd::Common::log("DEBUG: Found cache Program for ".$prog_id ."... (".($prog_ref->{'ns5:ProgramTitle'}).")") if (defined $opt->{debug}) ; 
633        Shepherd::Common::log("DEBUG: PCache: ".Dumper($hghghgh)) if ((defined $opt->{debug}) && ($opt->{debug} > 1));
634
635                                next;
636                        }
637               
638                }
639               
640        ### now check the event cache for other details....
641        # if we have an EventID ... (must be one!)
642        my $event_id = $new_channel . $prog_ref->{'ns5:EventId'};
643                       
644        # print ("Checking event cache for $event_id.... ($prog_ref->{'ns5:ProgramTitle'})\n");
645
646        if ((defined $data_cache->{event_cache}->{$event_id}) && (ref $data_cache->{event_cache}->{$event_id}->{details})) {
647                                $event_hit++;
648                                $stats{programmes}++;
649                                $stats{used_prog_cache}++;
650                                $data_cache->{event_cache}->{$event_id}->{last_used} = $script_start_time;
651                               
652                                $data_cache->{tevent_cache}->{$event_id}->{details}->{start}  = $new_start;
653                                $data_cache->{event_cache}->{$event_id}->{details}->{stop}   = $new_stop;
654                                $data_cache->{event_cache}->{$event_id}->{details}->{length} = $new_length;
655
656                                my $hghghgh = $data_cache->{event_cache}->{$event_id}->{details};
657                                $writer->write_programme($data_cache->{event_cache}->{$event_id}->{details});
658        my $eptitle = "";
659        $eptitle = $data_cache->{event_cache}->{$event_id}->{eptitle} if (defined $data_cache->{event_cache}->{$event_id}->{eptitle}) ;
660#       print ("    Found cache Event for $event_id ($new_title) [$eptitle] \n");                       
661
662        Shepherd::Common::log("DEBUG: Found cache Event entry for ".$event_id."... (".($prog_ref->{'ns5:ProgramTitle'}).")") if (defined $opt->{debug}) ;
663        Shepherd::Common::log("DEBUG: ECach: ".Dumper($hghghgh)) if ((defined $opt->{debug}) && ($opt->{debug} > 1));
664                                next;
665        }
666               
667               
668        $cache_miss++;
669        # print ("     Pushing event $prog_ref->{'ns5:EventId'} for lookup\n");
670        push(@event_list, $prog_ref->{'ns5:EventId'});
671  } ### foreach my $prog_ref
672       
673  if ( $cache_miss == 0) {
674            Shepherd::Common::log("   All details from cache ... (Caches - Prog: $cache_hit, Event: $event_hit)");
675            return 1;
676  }
677  #
678  Shepherd::Common::log("   Fetching details for $cache_miss ...  (Caches - Prog: $cache_hit, Event: $event_hit)");
679  #
680  # now retrieve the details for every programme that wasn't in the cache
681  #
682  $ref = &soap_get_event_details(@event_list); 
683  foreach my $prog_ref (@{($ref->{'ns5:EventDetail'})}) {
684        my $prog;
685       
686        $prog->{title} = [[ $prog_ref->{'ns5:ProgramTitle'}, $opt->{lang} ]];
687        if ($prog->{title}->[0]->[0] =~ s/\s*(?:S(\d+)\s*)?Ep(\d+)(?:\s*&(?:amp;)?\s*\d+$)?//i) { # "S1 Ep5 &amp; 6"
688                        my $xmltv_ns = ($1 ? ($1 - 1) : "") ." . ". ($2 ? ($2 - 1) : "") ." . "; # drops " & 6"
689                        $prog->{'episode-num'} = [[ $xmltv_ns, 'xmltv_ns' ]];
690                        #<title lang="en">Brotherhood S1 Ep5 &amp; 6</title>
691        }
692        $prog->{length} = int($prog_ref->{'ns5:Duration'} * 60);
693               
694        if (!defined $prog_ref->{'ns5:Duration'}) {
695                        $stats{skipped_prog_no_duration}++;
696                        next;
697        }
698               
699        if ((defined $prog_ref->{'ns5:ScheduledDate'}) &&
700                    ($prog_ref->{'ns5:ScheduledDate'} =~ /^(\d{4})-(\d{2})\-(\d{2})T(\d{2}):(\d{2}):(\d{2})\.(\d{3})\+(\d{2}):(\d{2})$/)) {
701                        my $prog_tz = "+".$8.$9;
702                        my @t = ($6, $5, $4, $3, ($2-1), ($1-1900), -1, -1, -1);
703
704                        my $prog_start = mktime(@t);
705                        my $prog_stop = $prog_start + $prog->{length};
706
707                        $prog->{start} = POSIX::strftime("%Y%m%d%H%M%S", localtime($prog_start))." ".$prog_tz;
708                        $prog->{stop} =  POSIX::strftime("%Y%m%d%H%M%S", localtime($prog_stop))." ".$prog_tz;
709        } else {
710                        $stats{skipped_prog_bad_starttime}++;
711                        Shepherd::Common::log("unparsable date ".$prog_ref->{'ns5:ScheduledDate'})
712                                if ((defined $prog_ref->{'ns5:ScheduledDate'}) &&
713                                        ($stats{skipped_prog_bad_starttime} < 10));
714                        next;
715        }
716               
717        if ((defined $prog_ref->{'ns5:ChannelId'}) &&
718                                (defined $d->{channels}->{$prog_ref->{'ns5:ChannelId'}}->{xmlid})) {
719                        $prog->{channel} = $d->{channels}->{$prog_ref->{'ns5:ChannelId'}}->{xmlid};
720        } else {
721                        $stats{skipped_prog_bad_channel}++;
722                        next;
723        }
724               
725        if ((defined $prog_ref->{'ns5:EpisodeTitle'}) &&
726                                (ref $prog_ref->{'ns5:EpisodeTitle'} ne "HASH") &&
727                                ($prog_ref->{'ns5:EpisodeTitle'} ne "")) {
728                        $prog->{'sub-title'} = [[ $prog_ref->{'ns5:EpisodeTitle'}, $opt->{lang} ]];
729                        if ($prog->{'sub-title'}->[0]->[0] =~ /(?:Series\s*(\d+),\s*)?Episode\s*(\d+)/i) {      # "Series 2, Episode 19"
730                                my $xmltv_ns = ($1 ? ($1 - 1) : "") ." . ". ($2 ? ($2 - 1) : "") ." . ";
731                                $prog->{'episode-num'} = [[ $xmltv_ns, 'xmltv_ns' ]];
732                                #<sub-title lang="en">Episode 1084</sub-title> <desc lang="en">S1, Ep84.
733                        }
734        }
735               
736
737        # Program rating and consumer advice
738        if ($prog_ref->{'ns5:ParentalRating'} ne "-") {
739                if (defined $prog_ref->{'ns5:ConsumerAdvice'}) {
740                        my $advice = $prog_ref->{'ns5:ConsumerAdvice'};
741                        $advice =~ s/\s//g;
742                        $prog->{rating} = [[ $prog_ref->{'ns5:ParentalRating'}." ".$advice, 'ABA', undef ]] ;
743                }
744                else {
745                        $prog->{rating} = [[ $prog_ref->{'ns5:ParentalRating'}, 'ABA', undef ]] ;
746                }
747        }
748
749        $prog->{subtitles} = [ { 'type' => 'teletext' } ]
750                        if (((defined $prog_ref->{'ns5:SubtitledInd'}) && ($prog_ref->{'ns5:SubtitledInd'} ne "false")) ||
751                                ((defined $prog_ref->{'ns5:ClosedCaptionInd'}) && ($prog_ref->{'ns5:ClosedCaptionInd'} ne "false")));
752        $prog->{video}->{aspect} = "16:9"
753                        if ((defined $prog_ref->{'ns5:WidescreenInd'}) && ($prog_ref->{'ns5:WidescreenInd'} ne "false"));
754        $prog->{video}->{quality} = "HDTV"
755                        if (defined $prog_ref->{'ns5:HDInd'} && ($prog_ref->{'ns5:HDInd'} ne "false"));
756               
757        if (defined $prog_ref->{'ns5:Audio'}) {
758                        # try to match bad values like 'dolby stereo'
759                        $prog->{audio}->{stereo} = 'mono' if ($prog_ref->{'ns5:Audio'} =~ m/mono/i);
760                        $prog->{audio}->{stereo} = 'stereo' if ($prog_ref->{'ns5:Audio'} =~ m/stereo/i);
761                        $prog->{audio}->{stereo} = 'dolby' if ($prog_ref->{'ns5:Audio'} =~ m/dolby/i);
762                        $prog->{audio}->{stereo} = 'dolby digital' if ($prog_ref->{'ns5:Audio'} =~ m/digital/i);
763                        $prog->{audio}->{stereo} = 'surround' if ($prog_ref->{'ns5:Audio'} =~ m/surround/i);
764        }
765               
766        # get actors, directors and writers
767        foreach my $actor (@{$prog_ref->{'ns5:Actor'}}) { push(@{($prog->{credits}->{actor})}, $actor); }
768        foreach my $director (@{$prog_ref->{'ns5:Director'}}) { push(@{($prog->{credits}->{director})}, $director); }
769        foreach my $writer (@{$prog_ref->{'ns5:Writer'}}) { push(@{($prog->{credits}->{writer})}, $writer); }
770               
771        # get description/synopsis
772        $prog->{desc} = [[ $prog_ref->{'ns5:ExtendedSynopsis'}, $opt->{lang} ]] if (defined $prog_ref->{'ns5:ExtendedSynopsis'});
773
774# TODO: get series and episode number
775#                               my $series_num = (defined $prog_ref->{'ns5:SeriesNumber'}) ? $prog_ref->{'ns5:SeriesNumber'} : "";
776#                               my $episode_num = (defined $prog_ref->{'ns5:EpisodeNumber'}) ? $prog_ref->{'ns5:EpisodeNumber'} : "";
777#                               if ((defined ) && (defined )) {
778#                                       if ($prog_ref->{'ns5:SeriesNumber'} =~ s/(?:S(?:Series\s*)?(\d+),\s*)//i) {
779#                                               my $xmltv_ns = ($1 - 1)." . ".($prog_ref->{'ns5:EpisodeNumber'} - 1)." . ";
780#                                               $prog->{'episode-num'} = [[ $xmltv_ns, 'xmltv_ns' ]];
781#                                       }
782#                                       else {
783#                                               my $xmltv_ns = ($prog_ref->{'ns5:SeriesNumber'} - 1)." . ".($prog_ref->{'ns5:EpisodeNumber'} - 1)." . 0";
784#                                               $prog->{'episode-num'} = [[ $xmltv_ns, 'xmltv_ns' ]];
785#                                       }
786#                               }
787#                               else {
788#                                       $prog->{'episode-num'} = [[ $prog_ref->{'ns5:EpisodeNumber'}, 'onscreen' ]] if (defined $prog_ref->{'ns5:EpisodeNumber'});
789#                               }
790######### here #### mb try to get episode numbers - not real good with fox - lots of prints to get rid of
791#########
792        if (defined($prog->{'episode-num'}) )  { print("#### Episodes pre-defined: Title: $prog_ref->{'ns5:ProgramTitle'} \n"); }
793        else {  ## process episode nums
794                my $se_num = " ";
795                my $ep_num = " ";
796                my $ep_tit = "";
797                my $xmltv_ns = "";
798                if (defined($prog_ref->{'ns5:EpisodeTitle'}))  { $ep_tit = $prog_ref->{'ns5:EpisodeTitle'}; }
799                if (defined($prog_ref->{'ns5:SeriesNumber'}))  { $se_num = $prog_ref->{'ns5:SeriesNumber'} ;}
800                if (defined($prog_ref->{'ns5:EpisodeNumber'})) { $ep_num = $prog_ref->{'ns5:EpisodeNumber'}; }
801                       
802                if (( $se_num ne " ") or ( $ep_num ne " "))
803                {  ## one of them exists
804                print("#### Episodes found: Se_num: $se_num Ep_num: ($ep_num $prog_ref->{'ns5:ProgramTitle'}) [$ep_tit]\n");
805               
806                if ( $se_num=~ /^S(\d+)$/)          { $se_num = $1; }
807                if ( $se_num=~ /^Series\s+?(\d+)$/) { $se_num = $1; }
808                if ( $ep_num=~ /^S\d+-(\d+)$/)       { $ep_num = $1; }
809                       
810                if ( ($se_num=~ /\D/) or ( $ep_num=~ /\D/))     ## either has a non digit in it
811                        { 
812                        print("#########  Episodes : non digit $se_num $ep_num\n");
813                        if (  ($se_num=~ /\d+/) and ($ep_num=~ /\d+ \& \d+/) )      # Se_num: 2 Ep_num: 1 & 2 The Tudors
814                                {       $xmltv_ns = "##S".$se_num." Ep".$ep_num; 
815                                        $prog->{'episode-num'} = [[ $xmltv_ns, 'onscreen' ]] ;
816                                        print("      Episodes : Created onscreen: $xmltv_ns\n");
817                                        $xmltv_ns = "";
818                                } 
819                         elsif  (  ($se_num!~ /\d+/) and ($ep_num!~ /\D/) and ($ep_num < 100) )      # Se_num:   Ep_num: \d
820                                {       $xmltv_ns = "#". $ep_num; 
821                                        $prog->{'episode-num'} = [[ $xmltv_ns, 'onscreen' ]] ;
822                                        print("      Episodes : Created onscreen episode: $xmltv_ns\n");
823                                        $xmltv_ns = "";
824                                } 
825                         elsif  (  ($se_num!~ /\D/) and ($ep_num!~ /\d+/) and ($se_num < 30)  and ($se_num > 0))      # Se_num:   Ep_num: \d
826                                {       $xmltv_ns = ($se_num-1). ". . "; 
827                                        $prog->{'episode-num'} = [[ $xmltv_ns, 'xmltv_ns' ]] ;
828                                        print("      Episodes : Created series only: $xmltv_ns\n");
829                                        $xmltv_ns = "";
830                                } 
831                         else { print("####  Episodes crud format: Se_num: $se_num Ep_num: $ep_num Ep_ns $xmltv_ns\n"); }
832                         $se_num = " "; 
833                         $ep_num = " ";
834                        }
835                else    {                                       ## both are digits
836                        print("#########  Episodes : are digit $se_num $ep_num\n");
837                        if (($se_num > 30) or ( $ep_num > 30)) 
838                        { 
839                                print("####  Episodes too big: Se_num: $se_num Ep_num: $ep_num Ep_ns $xmltv_ns\n");
840                                $se_num = " "; 
841                                $ep_num = " ";
842                        }
843                        if ($se_num =~ /^[\d]/)  { $xmltv_ns = ($se_num- 1)."."; }
844                                            else { $xmltv_ns = " ."; }
845                        if ($ep_num =~ /^[\d]/)  { $xmltv_ns .= ($ep_num- 1).". "; }
846                                            else { $xmltv_ns .= " . "; }
847                        print("####  Episodes mods: Se_num: $se_num Ep_num: $ep_num Ep_ns $xmltv_ns\n");
848                        if ( $xmltv_ns ne " . . ")  {  $prog->{'episode-num'} = [[ $xmltv_ns, 'xmltv_ns' ]];  }
849
850                        }
851                       
852               
853                }  ## one of them exists
854        }       ## process episode nums
855### here '.1.'
856
857
858        # get genre and subgenre
859        if ((defined $prog_ref->{'ns5:GenreCode'}) &&
860                                (defined $prog_ref->{'ns5:SubGenreCode'}) &&
861                                (defined $d->{genres}->{$prog_ref->{'ns5:GenreCode'}}->{$prog_ref->{'ns5:SubGenreCode'}})) {
862                my $category = $d->{genres}->{$prog_ref->{'ns5:GenreCode'}}->{$prog_ref->{'ns5:SubGenreCode'}};
863                $prog->{category} = [[ $category , $opt->{lang} ]];
864
865              #more accurate than method below, gets movies on non-movie channels, and misses shows on movie channels
866                push(@{$prog->{category}}, ['Movie', $opt->{lang}]) if $d->{genres}->{$prog_ref->{'ns5:GenreCode'}}->{name} eq 'Movies';
867#               push(@{$prog->{category}}, ['Sports', $opt->{lang}]) if $d->{genres}->{$prog_ref->{'ns5:GenreCode'}}->{name} eq 'Sport';
868
869                if ((defined $d->{channels}->{$prog_ref->{'ns5:ChannelId'}}->{category}) &&
870                                        (defined $d->{categories}->{$d->{channels}->{$prog_ref->{'ns5:ChannelId'}}->{category}})) {
871                        my $ch_category = $d->{categories}->{$d->{channels}->{$prog_ref->{'ns5:ChannelId'}}->{category}};
872#                       push(@{$prog->{category}}, ['Movie', $opt->{lang}]) if $ch_category eq 'Movies';
873                        push(@{$prog->{category}}, ['Sports', $opt->{lang}]) if $ch_category eq 'Sport';
874                }
875
876        } else { $stats{skipped_categories}++; }
877
878        # get urls/weblinks
879        if (defined $prog_ref->{'ns5:WebLink'}) { 
880                if (ref($prog_ref->{'ns5:WebLink'}) eq "HASH") {
881                        push(@{$prog->{url}}, $prog_ref->{'ns5:WebLink'}->{'ns5:Url'})
882                }
883                elsif (ref($prog_ref->{'ns5:WebLink'}) eq "ARRAY") {
884                        my @webarray = @{$prog_ref->{'ns5:WebLink'}};
885                        my $u = 0;
886                        while ($u <= $#webarray) {
887                                push(@{$prog->{url}}, $webarray[$u]->{'ns5:Url'});
888                                $u++;
889                        }
890                }
891        }
892
893        # TODO: get star-rating/criticsRating
894
895        # get date/YearOfProduction
896        $prog->{date} = $prog_ref->{'ns5:YearOfProduction'} if (defined $prog_ref->{'ns5:YearOfProduction'});
897               
898        # get country
899        push(@{($prog->{country})}, [$prog_ref->{'ns5:CountryOfOrigin'}]) if (defined $prog_ref->{'ns5:CountryOfOrigin'});
900               
901        # get language
902        $prog->{language}->[0] = $prog_ref->{'ns5:Language'} if (defined $prog_ref->{'ns5:Language'});
903               
904        # get colour
905        if (defined $prog_ref->{'ns5:ColourType'}) {
906                        $prog->{video}->{colour} = ($prog_ref->{'ns5:ColourType'} =~ /colour|color/i) ? "1" : "0";
907                }
908
909        # get premiere
910        $prog->{premiere} = ["New Episode", $opt->{lang} ]
911                        if (defined $prog_ref->{'ns5:NewEpisode'} && ($prog_ref->{'ns5:NewEpisode'} ne "false"));
912        $prog->{premiere} = ["Premiere", $opt->{lang} ]
913                        if (defined $prog_ref->{'ns5:PremiereInd'} && ($prog_ref->{'ns5:PremiereInd'} ne "false"));
914
915        # <ContentWarning>als</ContentWarning>
916        # 'DSTInd' => 'true', 'ProgramAvailableInd' => 'true'
917        Shepherd::Common::cleanup($prog);
918               
919        if (defined $prog_ref->{'ns5:ProgramId'}) {
920                        my $prog_id = $prog->{channel} . $prog_ref->{'ns5:ProgramId'};
921                        my $eptitle = "";
922                        $eptitle = $prog_ref->{'ns5:EpisodeTitle'} if (defined($prog_ref->{'ns5:EpisodeTitle'}));
923                       
924#                       print ("*** Inserting ProgID $prog_id into cache...($prog_ref->{'ns5:ProgramTitle'})[$eptitle]\n");
925                       
926                        $data_cache->{prog_cache}->{$prog_id}->{progid}     = $prog_id;
927                        $data_cache->{prog_cache}->{$prog_id}->{title}      = $prog_ref->{'ns5:ProgramTitle'};
928                        $data_cache->{prog_cache}->{$prog_id}->{eptitle}    = $eptitle;
929                        $data_cache->{prog_cache}->{$prog_id}->{first_used} = $script_start_time;
930                        $data_cache->{prog_cache}->{$prog_id}->{last_used}  = $script_start_time;
931                        $data_cache->{prog_cache}->{$prog_id}->{details}    = $prog;
932
933                        $stats{inserted_prog_cache}++;
934                        $cache_dirty = 1;
935                        # &write_cache;
936        }
937        elsif (defined $prog_ref->{'ns5:EventId'}) {
938                        my $event_id = $prog->{channel} . $prog_ref->{'ns5:EventId'};
939                        my $eptitle = "";
940                        $eptitle = $prog_ref->{'ns5:EpisodeTitle'} if (defined($prog_ref->{'ns5:EpisodeTitle'}));
941
942                        print ("*** Inserting EventID $event_id into cache... ($prog_ref->{'ns5:ProgramTitle'})[$eptitle]\n");
943                       
944                        $data_cache->{event_cache}->{$event_id}->{eventid}    = $event_id;
945                        $data_cache->{event_cache}->{$event_id}->{title}      = $prog_ref->{'ns5:ProgramTitle'};
946                        $data_cache->{event_cache}->{$event_id}->{eptitle}    = $eptitle;
947                        $data_cache->{event_cache}->{$event_id}->{first_used} = $script_start_time;
948                        $data_cache->{event_cache}->{$event_id}->{last_used}  = $script_start_time;
949                        $data_cache->{event_cache}->{$event_id}->{details}    = $prog;
950                        $stats{inserted_prog_cache}++;
951                        $cache_dirty = 1;
952                # &write_cache;
953        }
954               
955        Shepherd::Common::log("DEBUG: programme xmltv: ".Dumper($prog)) if ((defined $opt->{debug}) && ($opt->{debug} > 1));
956        $writer->write_programme($prog);
957               
958        $stats{programmes}++;
959  }
960  &write_cache  if ($cache_dirty == 1);
961#
962  return 1;
963}
964
965##############################################################################
966
967sub soap_search_events
968{
969        my ($starttime, $stoptime) = @_;
970        my $data, my $postvars;
971        my $parsed_xml;
972        my $ref;
973        my $found_array = 0;
974        my $failure_code = "";
975
976 my $retries = 3;
977 
978 while  ( $retries > 0) {
979   $retries--;
980        $postvars = $d->{common_post_start}.
981                "<s:SearchEventsIn>".
982                        "<s:Bouquet>".
983                                "<s:BouquetId xmlns:types=\"http://epg.foxtel.com.au/schema\">".$d->{bouquet}->{bouquet_id}."</s:BouquetId>".
984                                "<s:SubBouquetId xmlns:types=\"http://epg.foxtel.com.au/schema\">".$d->{bouquet}->{subbouquet_id}."</s:SubBouquetId>".
985                        "</s:Bouquet>".
986                        "<s:StateId>".$d->{state}->{id}."</s:StateId>".
987                        "<s:DateRange>".
988                                "<s:StartDate xmlns:types=\"http://epg.foxtel.com.au/schema\">".POSIX::strftime("%Y-%m-%dT%H:%M:00.000Z",gmtime($starttime))."</s:StartDate>".
989                                "<s:EndDate xmlns:types=\"http://epg.foxtel.com.au/schema\">".POSIX::strftime("%Y-%m-%dT%H:%M:00.000Z",gmtime($stoptime))."</s:EndDate>".
990                        "</s:DateRange>".
991                        "<s:ExtendedSearchInd>false</s:ExtendedSearchInd>".
992                        "<s:Channels>";
993        foreach my $ch_id (keys %{($d->{including_channels})}) {
994                $postvars .= "<s:Id>".$ch_id."</s:Id>";
995        }
996        $postvars .= "</s:Channels>".
997                        "<s:IsSeriesLinkStart>false</s:IsSeriesLinkStart>".
998                        "<s:InProgressInd>true</s:InProgressInd>".
999                        "<s:StartRecordNbr>0</s:StartRecordNbr>".
1000                        "<s:NbrRecordsRequested>0</s:NbrRecordsRequested>".
1001                        "</s:SearchEventsIn>".
1002                        $d->{common_post_end};
1003
1004        Shepherd::Common::log("DEBUG: sending Request Postvars: ".$postvars) if ((defined $opt->{debug}) && ($opt->{debug} > 1));
1005# print(": sending Request Postvars: $postvars") ;
1006       
1007        $data = &soap_request("SearchEvents", $postvars);
1008       
1009       
1010        undef $parsed_xml;
1011        undef $ref;
1012        $found_array = 0;
1013        $failure_code = "";
1014       
1015        if (!$data) {
1016                $failure_code = "no_SearchEvents_data";
1017        } else {
1018                Shepherd::Common::log("DEBUG: soap_search_events got: $data") if ((defined $opt->{debug}) && ($opt->{debug} > 1));
1019
1020        $parsed_xml = XMLin($data , forcearray => [ qw(ns5:Event) ]);
1021       
1022print Dumper( $parsed_xml) if ((defined $opt->{debug}) && ($opt->{debug} > 1)); 
1023                if (!defined $parsed_xml->{'soapenv:Body'}->{'ns5:SearchEventsOut'}) {
1024                        $failure_code = "no_SearchEventsOut";
1025                } else {
1026                        $ref = $parsed_xml->{'soapenv:Body'}->{'ns5:SearchEventsOut'};
1027                        if (!defined $ref->{'ns5:Events'}->{'ns5:Event'}) {
1028                                $failure_code = "no_Events";
1029                        } else {
1030###                     
1031                        if ((ref $ref->{'ns5:Events'}->{'ns5:Event'} ne "ARRAY") || (scalar(@{$ref->{'ns5:Events'}->{'ns5:Event'}}) < 1)) 
1032                               { $failure_code = "not_array_Event";
1033                       
1034###                             if (ref $ref->{'ns5:Events'}->{'ns5:Event'} ne "ARRAY") {
1035###                                     $failure_code = "not_array_Events";
1036                                } else {
1037                                        $found_array = 1; # success
1038                                        $retries = 0;
1039                                }
1040                        }
1041                }
1042        }
1043       
1044        if (!$found_array) {
1045                Shepherd::Common::log("   failed to retrieve programme guide Events: error: $failure_code"); 
1046                Shepherd::Common::log("   aborting fetching this programme guide");
1047                $stats{$failure_code}++;
1048                $stats{aborted_fetching_programs}++;
1049                undef $ref;
1050        }
1051        }
1052        return $ref;
1053}
1054
1055##############################################################################
1056
1057sub soap_get_event_details
1058{
1059        my (@event_list) = @_;
1060        my $data, my $postvars;
1061       
1062        $postvars = $d->{common_post_start}.
1063                "<s:GetEventDetailsIn>".
1064                        "<s:StateId>".$d->{state}->{id}."</s:StateId>";
1065        foreach my $event_id (@event_list) {
1066                $postvars .= "<s:EventId>".$event_id."</s:EventId>";
1067        }
1068        $postvars .= "</s:GetEventDetailsIn>".
1069                $d->{common_post_end};
1070       
1071        $data = &soap_request("GetEventDetails", $postvars);
1072       
1073        my $parsed_xml;
1074        my $ref;
1075        my $found_array = 0;
1076        my $failure_code = "";
1077
1078        if (!$data) {
1079                $failure_code = "no_GetEventDetails_data";
1080        } else {
1081                Shepherd::Common::log("DEBUG: soap_get_event_details got: $data") if ((defined $opt->{debug}) && ($opt->{debug} > 1));
1082                $parsed_xml = XMLin($data, forcearray => [ qw( ns5:EventDetail ns5:Actor ns5:Director ns5:Writer) ]);
1083               
1084                if (!defined $parsed_xml->{'soapenv:Body'}->{'ns5:GetEventDetailsOut'}) {
1085                        $failure_code = "no_GetEventDetailsOut";
1086                } else {
1087                        $ref = $parsed_xml->{'soapenv:Body'}->{'ns5:GetEventDetailsOut'};
1088                        if (ref $ref->{'ns5:EventDetail'} ne "ARRAY") {
1089                        my $s1st = ref $ref->{'ns5:EventDetail'};
1090                                $failure_code = "not_array_EventDetail It is a $s1st";
1091                        } else {
1092                                $found_array = 1; # success
1093                        }
1094                }
1095        }
1096       
1097        if (!$found_array) {
1098                Shepherd::Common::log("   failed to retrieve programme guide details: error: $failure_code"); 
1099                Shepherd::Common::log("   aborting fetching this programme guide");
1100                $stats{$failure_code}++;
1101                $stats{aborted_fetching_programs}++;
1102                undef $ref;
1103        }
1104       
1105        return $ref;
1106}
1107
1108##############################################################################
1109
1110sub window_is_within_microgap
1111{
1112        my ($start, $stop, $channel) = @_;
1113
1114        return window_channel_is_within_microgap($start, $stop, $channel) if (defined $channel);
1115
1116        foreach my $ch (keys %{$channels}) {
1117                return 1 if window_channel_is_within_microgap($start, $stop, $ch);
1118        }
1119        return 0;
1120}
1121
1122sub window_channel_is_within_microgap
1123{
1124        my ($start, $stop, $channel) = @_;
1125
1126        if (defined $gaps->{$channel}) {
1127                foreach my $g (@{($gaps->{$channel})}) {
1128                        my ($s, $e) = split(/-/,$g);
1129                        return 1 if
1130                          ((($s >= $start) && ($s <= $stop)) ||
1131                           (($e >= $start) && ($e <= $stop)) ||
1132                           (($s <= $start) && ($e >= $stop)));
1133                }
1134        }
1135        $stats{gaps_skipped}++;
1136        return 0;
1137}
1138
1139##############################################################################
1140
1141sub soap_request
1142{
1143        my ($soap_action, $postvars) = @_;
1144        my @additional_headers;
1145       
1146        push(@additional_headers, "Content-type: text/xml; charset=utf-8");
1147        push(@additional_headers, "SOAPAction: http://epg.foxtel.com.au/$soap_action");
1148       
1149# print "Posting: $postvars\n" if ((defined $opt->{debug}) && ($opt->{debug} > 1));
1150
1151        return &get_url(
1152                url => "https://epg.foxtel.com.au/epg-service/epg/EpgServiceV2",
1153                retries => 0,
1154                method => "POST",
1155                postvars => $postvars,
1156                headers => \@additional_headers);
1157}
Note: See TracBrowser for help on using the browser.