root/trunk/grabbers/yahoo7web @ 1106

Revision 1106, 20.2 kB (checked in by max, 5 years ago)

yahoo7web: was flagging everything as a repeat!
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2
3# yahoo7portal au_tv guide grabber - runs from "Shepherd" master grabber
4#  * grabs data from the yahoo7portal (http://au.tv.yahoo.com/)
5#  * this does NOT use any config file - all settings are passed in from shepherd
6
7use strict;
8
9my $progname = "yahoo7web";
10my $version = "0.35";
11
12use XMLTV;
13use POSIX qw(strftime mktime);
14use Getopt::Long;
15use HTML::TreeBuilder;
16use Data::Dumper;
17use Shepherd::Common;
18
19#
20# global variables and settings
21#
22
23$| = 1;
24my $script_start_time = time;
25my %stats;
26my $channels, my $opt_channels, my $gaps;
27my $data_cache;
28my $writer;
29my $prev_url;
30my $d;
31my $opt;
32
33#
34# parse command line
35#
36
37$opt->{days} =          7;                      # default
38$opt->{outputfile} =    "output.xmltv";         # default
39$opt->{cache_file} =    $progname.".storable.cache";    # default
40$opt->{lang} =          "en";
41$opt->{region} =        94;
42
43GetOptions(
44        'log-http'      => \$opt->{log_http},
45        'region=i'      => \$opt->{region},
46        'days=i'        => \$opt->{days},
47        'offset=i'      => \$opt->{offset},
48        'timezone=s'    => \$opt->{timezone},
49        'channels_file=s' => \$opt->{channels_file},
50        'gaps_file=s'   => \$opt->{gaps_file},
51        'output=s'      => \$opt->{outputfile},
52        'cache-file=s'  => \$opt->{cache_file},
53        'fast'          => \$opt->{fast},
54        'no-cache'      => \$opt->{no_cache},
55        'no-details'    => \$opt->{no_details},
56        'debug+'        => \$opt->{debug},
57        'warper'        => \$opt->{warper},
58        'lang=s'        => \$opt->{lang},
59        'obfuscate'     => \$opt->{obfuscate},
60        'anonsocks=s'   => \$opt->{anon_socks},
61        'help'          => \$opt->{help},
62        'verbose'       => \$opt->{help},
63        'version'       => \$opt->{version},
64        'ready'         => \$opt->{version},
65        'v'             => \$opt->{help});
66
67&help if ($opt->{help});
68
69if ($opt->{version}) {
70        printf "%s %s\n",$progname,$version;
71        exit(0);
72}
73
74die "no channel file specified, see --help for instructions\n", if (!$opt->{channels_file});
75$opt->{days} = 8 if ($opt->{days} > 8); # limit to a max of 8 days
76
77#
78# go go go!
79#
80
81&log(sprintf "going to %sgrab %d days%s of data into %s (%s%s%s%s%s)",
82        (defined $opt->{gaps_file} ? "micro-gap " : ""),
83        $opt->{days},
84        (defined $opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
85        $opt->{outputfile},
86        (defined $opt->{fast} ? "with haste" : "slowly"),
87        (defined $opt->{anon_socks} ? ", via multiple endpoints" : ""),
88        (defined $opt->{warper} ? ", anonymously" : ""),
89        (defined $opt->{no_details} ? ", without details" : ", with details"),
90        (defined $opt->{no_cache} ? ", without caching" : ", with caching"));
91
92# set defaults
93Shepherd::Common::set_default("debug", ($opt->{debug} ? 2 : 0));
94Shepherd::Common::set_default("webwarper", 1) if (defined $opt->{warper});
95Shepherd::Common::set_default("squid", 1) if (defined $opt->{obfuscate});
96Shepherd::Common::set_default("referer", "last");
97Shepherd::Common::set_default("retry_delay", 30);
98Shepherd::Common::setup_ua(cookie_jar => 1);
99
100# read channels file
101if (-r $opt->{channels_file}) {
102        local (@ARGV, $/) = ($opt->{channels_file});
103        no warnings 'all'; eval <>; die "$@" if $@;
104} else {
105        die "WARNING: channels file $opt->{channels_file} could not be read\n";
106}
107
108# if just filling in microgaps, parse gaps
109if (defined $opt->{gaps_file}) {
110        if (-r $opt->{gaps_file}) {
111                local (@ARGV, $/) = ($opt->{gaps_file});
112                no warnings 'all'; eval <>; die "$@" if $@;
113        } else {
114                die "WARNING: gaps_file $opt->{gaps_file} could not be read: $!\n";
115        }
116}
117
118&read_cache unless (defined $opt->{no_cache});
119
120if (defined $opt->{anon_socks}) {
121        &log("configured to use Tor, testing that it works by connecting to www.google.com ...");
122        if (Shepherd::Common::setup_socks($opt->{anon_socks})) {
123                &log("success.  Tor appears to be working!");
124        } else {
125                &log("ERROR: Could not connect to www.google.com via Tor, disabling Tor.");
126                &log("       DATA FETCHING WILL BE VERY SLOW.");
127                &log("       DISABLING DETAILS-FETCHING BECAUSE OF THIS - SIGNIFICANTLY LOWER DATA QUALITY!!");
128
129                $opt->{no_details} = 1;
130                delete $opt->{anon_socks};
131                $stats{fallback_to_non_tor}++;
132        }
133}
134
135&start_writing_xmltv;
136
137&get_summary_pages;
138&get_detailed_pages;
139
140&write_cache unless (defined $opt->{no_cache});
141$writer->end();
142
143&print_stats;
144exit(0);
145
146##############################################################################
147# help
148
149sub help
150{
151        print<<EOF
152$progname $version
153
154options are as follows:
155        --help                  show these help options
156        --days=N                fetch 'n' days of data (default: $opt->{days})
157        --output=file           send xml output to file (default: "$opt->{outputfile}")
158        --no-cache              don't use a cache to optimize (reduce) number of web queries
159        --no-details            don't fetch detailed descriptions (default: do)
160        --cache-file=file       where to store cache (default "$opt->{cache_file}")
161        --fast                  don't run slow - get data as quick as you can - not recommended
162        --anonsocks=(ip:port)   use SOCKS4A server at (ip):(port) (for Tor: recommended)
163
164        --debug                 increase debug level
165        --warper                fetch data using WebWarper web anonymizer service
166        --obfuscate             pretend to be a proxy servicing multiple clients
167        --lang=[s]              set language of xmltv output data (default $opt->{lang})
168
169        --region=N              set region for where to collect data from (default: $opt->{region})
170        --channels_file=file    where to get channel data from
171        --gaps_file=file        micro-fetch gaps only
172
173EOF
174;
175
176        exit(0);
177}
178
179##############################################################################
180# populate cache
181
182sub read_cache
183{
184        my $store = Shepherd::Common::read_cache(\$opt->{cache_file});
185       
186        if ($store) {
187                $data_cache->{progs} = $store->{data_cache} if (defined $store->{data_cache});
188
189                if (defined $store->{day_cache}) {
190                        $data_cache->{day} = $store->{day_cache};
191
192                        # age day cache on reading..
193                        for my $url (keys %{($data_cache->{day})}) {
194                                if ($data_cache->{day}->{$url}->{fetched} < (time-(4*3600))) {
195                                        delete $data_cache->{day}->{$url};
196                                        $stats{expired_url_from_cache}++;
197                                }
198                        }
199                }
200        }
201}
202
203##############################################################################
204# write out updated cache
205
206sub write_cache
207{
208        # cleanup old prog entries from cache
209        if (defined $data_cache->{progs}) {
210                for my $cache_key (keys %{($data_cache->{progs})}) {
211                        my ($starttime, @rest) = split(/:/,$cache_key);
212                        if ($starttime < (time-86400)) {
213                                delete $data_cache->{progs}->{$cache_key};
214                                $stats{expired_from_cache}++;
215                        }
216                }
217        }
218
219        my $store = { };
220        $store->{data_cache} = $data_cache->{progs} if (defined $data_cache->{progs});
221        $store->{day_cache} = $data_cache->{day} if (defined $data_cache->{day});
222        Shepherd::Common::write_cache($opt->{cache_file}, $store);
223}
224
225##############################################################################
226
227sub log
228{
229        my ($entry) = @_;
230        printf "%s\n",$entry;
231}
232
233##############################################################################
234
235sub print_stats
236{
237        printf "STATS: %s v%s completed in %d seconds",$progname, $version, time-$script_start_time;
238        foreach my $key (sort keys %stats) {
239                printf ", %d %s",$stats{$key},$key;
240        }
241        printf "\n";
242}
243
244##############################################################################
245
246sub start_writing_xmltv
247{
248        my %writer_args = ( encoding => 'ISO-8859-1' );
249        if ($opt->{outputfile}) {
250                my $fh = new IO::File(">$opt->{outputfile}") || die "can't open $opt->{outputfile}: $!";
251                $writer_args{OUTPUT} = $fh;
252        }
253
254        $writer = new XMLTV::Writer(%writer_args);
255
256        $writer->start
257          ( { 'source-info-name'   => "$progname $version",
258              'generator-info-name' => "$progname $version"} );
259
260        for my $channel (sort keys %{$channels}) {
261                $writer->write_channel( {
262                        'display-name' => [[ $channel, $opt->{lang} ]],
263                        'id' => $channels->{$channel}
264                        } );
265        }
266}
267
268##############################################################################
269
270sub translate_category
271{
272        my $genre = shift;
273        my %translation = (
274                'Sport' => 'sports',
275                'Soap Opera' => 'Soap',
276                'Science and Technology' => 'Science/Nature',
277                'Real Life' => 'Reality',
278                'Cartoon' => 'Animation',
279                'Family' => 'Children',
280                'Murder' => 'Crime' );
281
282        return $translation{$genre} if defined $translation{$genre};
283        return $genre;
284}
285
286##############################################################################
287
288sub build_channel_quirks_map
289{
290        # set up channel name exceptions list
291        my %chan_map;
292#       if ($opt->{region} == 90) {
293#               # VIC: Eastern Victoria
294#               push (@{($chan_map{"Prime"})},
295#                       "Prime (Regional Victoria)",
296#                       "Prime (Albury)");
297#       }
298
299        return %chan_map;
300}
301
302##############################################################################
303
304sub get_summary_pages
305{
306        my $starttime = time;
307        my $day_num = 0;
308        my $skip_days = 0;
309        my $prev_http_successful_requests = 0;
310        $stats{programmes} = 0;
311
312        my @timeattr = localtime($starttime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
313        $timeattr[0] = 0;       # zero sec
314        $timeattr[1] = 0;       # zero min
315        $timeattr[2] = 0;       # zero hour (midnight)
316        my $starttime_midnight = mktime(@timeattr);
317
318        $skip_days = $opt->{offset} if (defined $opt->{offset});
319        while ($day_num < $opt->{days}) {
320                my $day_start = $starttime_midnight + (60*60*24 * $day_num);
321                $day_num++;
322
323                # skip if --offset applies against this day
324                if ($skip_days > 0) {
325                        $skip_days--;
326                        next;
327                }
328               
329                # within each day, fetch in groups of 3 hours
330                for (my $hr = 0; $hr < 23; $hr += 3) {
331                        my $currtime = $day_start + ($hr * 60 * 60);
332                        next if (($currtime + (3 * 60 * 60)) < $starttime); # no point fetching the past
333
334                        # if we are fetching microgaps, skip this summary page if we aren't
335                        # interested in anything from it anyway
336                        next if ((defined $opt->{gaps_file}) && (!window_is_within_microgap($currtime,$currtime+(60*60*3))));
337
338                        my $url = sprintf "http://au.tv.yahoo.com/tv-guide/?hour=%s&min=%s&date=%s&mon=%s&year=%s&tvrg=%s&next=%s",
339                                POSIX::strftime("%H",localtime($starttime_midnight)),
340                                POSIX::strftime("%M",localtime($starttime_midnight)),
341                                POSIX::strftime("%d",localtime($starttime_midnight)),
342                                POSIX::strftime("%m",localtime($starttime_midnight)),
343                                POSIX::strftime("%Y",localtime($starttime_midnight)),
344                                $opt->{region}, $currtime;
345
346                        &log("fetching day $day_num summary page hour $hr ($url)");
347                        &parse_summary_page($url, $day_num, $day_start);
348                }
349
350                if ((defined $stats{http_successful_requests}) && ($stats{http_successful_requests} > $prev_http_successful_requests)) {
351                        $prev_http_successful_requests = $stats{http_successful_requests};
352                        my $wait_for = 5 + int(rand(5));
353                        $stats{slept_for} += $wait_for;
354                        sleep($wait_for);
355                }
356        }
357}
358
359##############################################################################
360
361sub parse_summary_page
362{
363        my ($url, $day_num, $day_start) = @_;
364        my %chan_map = &build_channel_quirks_map;
365        my $data;
366        my $first_time = 1;
367
368        if ((defined $data_cache->{day}->{$url}) &&
369            (defined $data_cache->{day}->{$url}->{data})) {
370                $data = $data_cache->{day}->{$url}->{data};
371                $stats{used_cached_day_page}++;
372        } else {
373                $data = Shepherd::Common::get_url(url => $url, retries => 4);
374                if (!$data) {
375                    if (!$stats{summary_pages_with_progs}) {
376                        &log("Aborting: couldn't fetch first summary page.");
377                        exit 10;
378                    }
379                    return;
380                }
381                $data_cache->{day}->{$url}->{fetched} = time;
382                $data_cache->{day}->{$url}->{data} = $data;
383
384                my $wait_for = 2;
385                $stats{slept_for} += $wait_for;
386                sleep($wait_for);
387        }
388
389        my $tree = HTML::TreeBuilder->new_from_content($data);
390        if (!$tree) {
391                &log("Format change? No valid HTML in $url");
392                exit 20 unless ($stats{summary_pages_with_progs})
393        }
394
395        my $tree_table = $tree->look_down('_tag' => 'table', 'id' => 'listing-table');
396        if (!$tree_table) {
397                &log("Format change? No TV table in $url?");
398                exit 20 unless ($stats{summary_pages_with_progs});
399        }
400
401        my $progs_in_table = 0;
402
403        for my $tree_tr ($tree_table->look_down('_tag' => 'tr', 'class' => 'lt-listing-row')) {
404                # get channel
405                my $this_chan = "";
406                if (my $channel_td = $tree_tr->look_down('_tag' => 'td', 'class' => 'lt-channel')) {
407                        $this_chan = $channel_td->as_text();
408                }
409
410                if ($this_chan eq "") {
411                        &log("ignoring blank channel in $url") if (defined $opt->{debug});
412                        $stats{blank_channels_ignored}++;
413                        next;
414                }
415
416                if (defined $chan_map{$this_chan}) {
417                        my $new_channame = splice(@{($chan_map{$this_chan})},0,1);
418                        if (not $new_channame) {
419                                &log("new unmapped channel for '$this_chan'");
420                        } else {
421                                &log("substituted channel name '$new_channame' for '$this_chan'") if (defined $opt->{debug});
422                                $stats{substituted_channels}++;
423                                $this_chan = $new_channame;
424                        }
425                }
426
427                if (!defined $channels->{$this_chan}) {
428                        &log("skipping unlisted channel '$this_chan'") if (!defined $d->{skipped_channels}->{$this_chan});
429                        $d->{skipped_channels}->{$this_chan} = 1 if (!defined $opt->{debug});
430                        $stats{skipped_channels}++;
431                        next;
432                }
433
434                for my $tree_td ($tree_tr->look_down('_tag' => 'td', 'class' => 'lt-listing')) {
435                        if (my $listing_div = $tree_td->look_down('_tag' => 'div')) {
436                                next if ($listing_div->attr('class') !~ /^lt-listing-wrapper/i);
437
438                                my @listing_links = $listing_div->look_down('_tag' => 'a', 'class' => 'listing-link');
439                                my @listing_data = $listing_div->look_down('_tag' => 'strong');
440
441                                for (my $i=0; $i <= $#listing_links; $i++) {
442                                        my $prog;
443                                        $prog->{channel} = $channels->{$this_chan};
444
445                                        if ($listing_links[$i]->attr('rel') =~ /^(\d+)-(\d+)-(\d+)$/) {
446                                                $prog->{event_id} = $3;
447                                        }
448                                        $prog->{title} = [[ $listing_links[$i]->as_text(), $opt->{lang} ]];
449
450                                        my $listing_text = $listing_data[$i]->as_text();
451                                        if ($listing_text =~ /^(.*)\((\d+)\)(\d+):(\d+)(.)m - (\d+):(\d+)(.)m$/i) {
452                                                my ($rating_text, $prog_length, $start_sec, $stop_sec) = ($1, $2, parse_time($3, $4, $5), parse_time($6, $7, $8));
453                                                if ($stop_sec < $start_sec) { # program wrap around midnight
454                                                        if ($first_time) {
455                                                                $start_sec -= (60*60*24);
456                                                        } else {
457                                                                $stop_sec += (60*60*24);
458                                                        }
459                                                }
460                                                $first_time = 0;
461                                                $prog->{rating} = [[ $rating_text, 'ABA', undef ]] if ((defined $rating_text) && ($rating_text ne ""));
462                                                $prog->{length} = ($prog_length * 60) if ((defined $prog_length) && ($prog_length > 0));
463                                                $prog->{starttime} = $day_start + $start_sec;
464                                                $prog->{stoptime} = $day_start + $stop_sec;
465                                        } else {
466                                                &log("malformed listing_text '$listing_text' for prog '".$listing_links[$i]->as_text()."'; ignored.");
467                                                $stats{malformed_listing}++;
468                                                next;
469                                        }
470
471                                        $progs_in_table++;
472
473                                        # if we are fetching microgaps, skip if this isn't in a micro-gap.
474                                        if (defined $opt->{gaps_file}) {
475                                                next if (!window_is_within_microgap($prog->{starttime},$prog->{stoptime},$this_chan));
476                                                $stats{gaps_included}++;
477                                        }
478
479                                        # include programme
480                                        &log("found prog: '".$prog->{title}->[0]->[0]."', channel ".$prog->{channel}.
481                                          " start ".$prog->{starttime}." stop ".$prog->{stoptime}) if (defined $opt->{debug});
482
483                                        my $cache_key = sprintf "%d:%d:%s:%s", $prog->{starttime}, $prog->{stoptime}, $prog->{channel}, $prog->{title}->[0]->[0];
484                                        if (!defined $d->{progs}->{$cache_key}) {
485                                                $d->{progs}->{$cache_key} = $prog;
486                                                $stats{programmes}++;
487                                        }
488                                }
489                        }
490                }
491        }
492
493        $tree->delete;
494
495        $stats{summary_pages_with_progs}++ if ($progs_in_table > 0);
496
497        &log("WARNING: Data may be bad. Only $progs_in_table programmes seen in $url") if ($progs_in_table * scalar(keys %$channels) < 4);
498}
499
500##############################################################################
501# loop through our progs, fetching details where we don't have a pre-cached
502# entry for them.
503# write out XMLTV
504
505sub get_detailed_pages
506{
507        &log("fetching details for up to ".$stats{programmes}." programmes ...") if (!defined $opt->{no_details});
508
509        my $prog_count = 0;
510        my $added_to_cache = 0;
511        $stats{used_existing_cache_entry} = 0;
512        $stats{added_to_cache} = 0;
513
514        foreach my $cache_key (sort keys %{($d->{progs})}) {
515                my $prog = $d->{progs}->{$cache_key};
516                $prog_count++;
517
518                if ((!defined $data_cache->{progs}->{$cache_key}) &&
519                    (!defined $opt->{no_details}) &&
520                    (defined $prog->{event_id}) &&
521                    ($prog->{title}->[0]->[0] ne "Station Close")) {
522                        &fetch_one_prog($cache_key, $prog->{event_id});
523                        &write_cache if ((($stats{added_to_cache} % 15) == 0) && (!defined $opt->{no_cache}));
524                } elsif (!defined $opt->{no_details}) {
525                        $stats{used_existing_cache_entry}++;
526                }
527
528                if ((($prog_count % 25) == 0) && (!defined $opt->{no_details})) {
529                        &log(" ... at ".$prog_count." of ".$stats{programmes}." programmes (used ".$stats{used_existing_cache_entry}." from cache)");
530                }
531
532                # if we got additional details from the cache, add them now
533                if (defined $data_cache->{progs}->{$cache_key}) {
534                        foreach my $key (keys %{($data_cache->{progs}->{$cache_key})}) {
535                                $prog->{$key} = $data_cache->{progs}->{$cache_key}->{$key};
536                        }
537                }
538
539                # convert epoch starttime into XMLTV starttime
540                $prog->{start} = POSIX::strftime("%Y%m%d%H%M", localtime($prog->{starttime}));
541                delete $prog->{starttime};
542
543                # convert epoch stoptime into XMLTV stoptime
544                $prog->{stop} = POSIX::strftime("%Y%m%d%H%M", localtime($prog->{stoptime}));
545                delete $prog->{stoptime};
546
547                delete $prog->{event_id};
548                Shepherd::Common::cleanup($prog);
549
550                printf "DEBUG: programme xmltv: ".Dumper($prog) if ((defined $opt->{debug}) && ($opt->{debug} > 1));
551                $writer->write_programme($prog);
552        }
553}
554
555##############################################################################
556
557sub fetch_one_prog
558{
559        my ($cache_key, $event_id) = @_;
560        &log("fetching detail page for $cache_key with event_id $event_id") if (defined $opt->{debug});
561
562        my $url = "http://au.tv.yahoo.com/tv-guide/broker.html?event_id=".$event_id;
563        my $data = Shepherd::Common::get_url(url => $url, retries => 4);
564
565        if ((!$data) || ($data !~ /^\{.*\}$/)) {
566                $stats{bad_details_page}++;
567                return;
568        }
569
570        $stats{added_to_cache}++;
571
572        if (($stats{added_to_cache} % 35) == 0) {
573                my $wait_for = 12 + int(rand(5));
574                $stats{slept_for} += $wait_for;
575                sleep $wait_for;
576        }
577
578        my @genre;
579
580        $data =~ s/(^\{|\}$)//g; # strip leading/trailing { and }
581        foreach my $field_item (split(/,"/,$data)) {
582                if ($field_item =~ /^([A-Za-z0-9\_\"]+):(.*)/) {
583                        my ($f, $v) = ($1, $2);
584                        $f =~ s/(^\"|\"$)//g;   # strip leading/trailing quotes from field if present
585                        $v =~ s/(^\"|\"$)//g;   # strip leading/trailing quotes from value if present
586                        next if ($v eq "");
587
588                        if ($f eq "title") {
589                                ; # nothing
590                        } elsif ($f eq "subtitle") {
591                                $data_cache->{progs}->{$cache_key}->{'sub-title'} = [[ $v, $opt->{lang} ]];
592                        } elsif ($f eq "description") {
593                                $data_cache->{progs}->{$cache_key}->{desc} = [[ $v, $opt->{lang} ]];
594                        } elsif ($f eq "genre") {
595                                push(@genre, translate_category($v));
596                        } elsif ($f eq "captions") {
597                                $data_cache->{progs}->{$cache_key}->{subtitles} = [ { 'type' => 'teletext' } ] if ($v eq "true");
598                        } elsif ($f eq "repeat" and $v and $v eq "true") {
599                                $data_cache->{progs}->{$cache_key}->{'previously-shown'} = { };
600                        } elsif ($f eq "start_date") {
601                                ; # nothing
602                        } elsif ($f eq "end_date") {
603                                ; # nothing
604                        } elsif ($f eq "rating") {
605                                ; # nothing
606                        } elsif ($f eq "channel") {
607                                ; # nothing
608                        } elsif ($f eq "hotpick") {
609                                ; # nothing
610                        } elsif ($f eq "venue_url") {
611                                ; # nothing
612                        } elsif ($f eq "url") {
613                                ; # nothing
614                        } elsif ($f eq "alt_url") {
615                                ; # nothing
616                        } elsif ($f eq "alt_text") {
617                                ; # nothing
618                        } elsif ($f eq "img") {
619                                ; # nothing
620                        } else {
621                                &log("unknown field '$f' in $url") if (!defined $d->{unknown_fields}->{$f});
622                                $d->{unknown_fields}->{$f} = 1;
623                        }
624
625                        $data_cache->{progs}->{$cache_key}->{category} = [[ @genre ]] if ($#genre != -1);
626
627                } else {
628                        &log("unknown field format '$field_item' in details. Has the format changed?");
629                        $stats{unknown_details_field_format}++;
630                }
631        }
632
633        printf "DEBUG: cached entries for '$cache_key': ".Dumper($data_cache->{progs}->{$cache_key})
634          if (defined $opt->{debug});
635}
636
637##############################################################################
638
639sub parse_time
640{
641        my ($hr, $min, $ampm) = @_;
642
643        $hr = 0 if ($hr == 12);
644        $hr += 12 if ($ampm =~ /p/i);
645
646        return(($hr*60*60)+($min*60));
647}
648
649##############################################################################
650
651sub window_is_within_microgap
652{
653        my ($start, $stop, $channel) = @_;
654
655        return window_channel_is_within_microgap($start, $stop, $channel) if (defined $channel);
656
657        foreach my $ch (keys %{$channels}) {
658                return 1 if window_channel_is_within_microgap($start, $stop, $ch);
659        }
660        return 0;
661}
662
663sub window_channel_is_within_microgap
664{
665        my ($start, $stop, $channel) = @_;
666
667        if (defined $gaps->{$channel}) {
668                foreach my $g (@{($gaps->{$channel})}) {
669                        my ($s, $e) = split(/-/,$g);
670                        return 1 if
671                          ((($s >= $start) && ($s <= $stop)) ||
672                           (($e >= $start) && ($e <= $stop)) ||
673                           (($s <= $start) && ($e >= $stop)));
674                }
675        }
676        $stats{gaps_skipped}++;
677        return 0;
678}
679
680##############################################################################
Note: See TracBrowser for help on using the browser.