Changeset 444

Timestamp:

01/10/07 16:46:47 (6 years ago)

Author:

lincoln

Message:

commit channel-scanning debug output logic for mapping to new shepherd chan names

Files:

• grabbers/yahoo7widget (modified) (4 diffs)

grabbers/yahoo7widget

@@ -97 +97 @@
 }
 
-die "no channel file specified, see --help for instructions\n", unless ((defined $opt->{channels_file}) || (defined $opt->{scanchan}));
+&scan_channels if (defined $opt->{scanchan});
+die "no channel file specified, see --help for instructions\n", unless (defined $opt->{channels_file});
 
 #
@@ -180 +181 @@
 
 ######################################################################################################
+# yahoo7widget times are always localtime on Eastern States .. (pure stupidity - they've missed the
+# whole point of what an epoch time is all about...).
+# we need to calculate the amount of time to offset the data to the user's local timezone.
+#
+# we do this by mapping differeht TZ settings and looking at the time.
+# make sure we set TZ back to something sane & relevant for this user
 
 sub setup_region_map
 {
-        # yahoo7widget times are always localtime on Eastern States .. map it to localtime in
-        # user's timezone
         my $local_time_offset = POSIX::strftime("%z",localtime(time));
 
@@ -197 +202 @@
         # set TZ variable back to an appropriate setting
         if ($opt->{region} =~ /^(74|108|81|107|82|83|85|86)$/) {
-                $ENV{TZ} = "Australia/Adelaide";         # NT/SA
+                $ENV{TZ} = "Australia/Adelaide";        # NT/SA
         } elsif ($opt->{region} =~ /^(101|102)$/) {
                 $ENV{TZ} = "Australia/Perth";           # WA
@@ -209 +214 @@
 }
 
+######################################################################################################
+
+sub scan_channels
+{
+        my %REGIONS = (
+                126 => "ACT",               73 => "NSW: Sydney",            184 => "NSW: Newcastle",
+                66 => "NSW: Central Coast", 67 => "NSW: Griffith",          63 => "NSW: Broken Hill",
+                69 => "NSW: Northern NSW",  71 => "NSW: Southern NSW",      106 => "NSW: Remote and Central",
+                74 => "NT: Darwin",         108 => "NT: Remote & Central",  75 => "QLD: Brisbane",
+                78 => "QLD: Gold Coast",    79 => "QLD: Regional",          114 => "QLD: Remote & Central",
+                81 => "SA: Adelaide",       82 => "SA: Renmark",            83 => "SA: Riverland",
+                85 => "SA: South East SA",  86 => "SA: Spencer Gulf",       107 => "SA: Remote & Central",
+                88 => "Tasmania",           94 => "VIC: Melbourne",         93 => "VIC: Geelong",
+                90 => "VIC: Eastern Victoria", 95 => "VIC: Mildura/Sunraysia", 98 => "VIC: Western Victoria",
+                101 => "WA: Perth",         102 => "WA: Regional");
+
+        my $now = time;
+
+        printf "\nScanning channels:\n\n";
+
+        foreach my $r (sort { $a <=> $b } keys %REGIONS) {
+                sleep 5;
+
+                #
+                # get shepherd channels
+                #
+                my $ua2 = LWP::UserAgent->new();
+                $ua2->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322');
+                $ua2->cookie_jar({});
+                $ua2->get('http://www.yourtv.com.au');
+                my $response = $ua2->get('http://www.yourtv.com.au/profile/ajax.cfm?action=channels&region_id='.$r);
+                my $page = $response->content;
+                if ($response->is_error()) {
+                        printf "Unable to download channel list for region $r from YourTV\n";
+                        next;
+                }
+
+                # shepherd rules for station names
+                my (%shepherd_channels, $clist, $cn, $rq);
+                while ($page =~ /<label for="venue_id.*?>(.*?)<\/label>/sg) {
+                        my $channel = $1;
+                        $channel =~ s/\s{2,}//g;
+                        if ($channel =~ /(.*) (\(.*\))/) {
+                                ($cn, $rq) = ($1, $2);
+                        } else {
+                                ($cn, $rq) = ($channel, "");
+                        }
+        
+                        if ($clist->{$cn}) {    # Is there already a channel with this name?
+                                $clist->{$cn} = [ "(".$REGIONS{$r}.")" ] if (@{$clist->{$cn}} == 1 and $clist->{$cn}[0] eq '');
+                                $rq = $REGIONS{$r} if ($rq eq '');
+                                die "Bad channel list in region $r!" if (grep($rq eq $_, @{$clist->{$cn}}));
+                                push @{$clist->{$cn}}, $rq;
+                        } else {
+                                $clist->{$cn} = [ $rq ];
+                        }
+                }
+        
+                foreach $cn (keys %$clist) {
+                        if (@{$clist->{$cn}} == 1) {
+                                $shepherd_channels{$cn} = 1;
+                        } else {
+                                foreach $rq (@{$clist->{$cn}}) {
+                                        $shepherd_channels{"$cn $rq"} = 1;
+                                }
+                        }
+                }
+
+                #
+                # get widget channels
+                #
+                my $data = get_url("http://au.tv.yahoo.com/widget.html?rg=".$r."&st=".$now."&et=".($now+86400), "region ".$r." (".$REGIONS{$r}.")");
+                my %seen_widget_chan;
+                my $parser = new XML::DOM::Parser;
+                my $tree = $parser->parse($data);
+                my $tree_channels = $tree->getElementsByTagName("venue");
+                for (my $i = 0; $i < $tree_channels->getLength; $i++) {
+                        my $channel = $tree_channels->item($i)->getAttributeNode("co_short")->getValue;
+
+                        # for this channel get every programme ('event')
+                        my $events = $tree_channels->item($i)->getElementsByTagName("event");
+
+                        if (!defined $shepherd_channels{$channel}) {
+                                $shepherd_channels{$channel} = 0;       # shepherd doesn't know about this channel, widget does
+                        } elsif ($shepherd_channels{$channel} == 1) {
+                                $shepherd_channels{$channel} = 2;       # both shepherd & widget know about channel
+                        } elsif ($shepherd_channels{$channel} == 2) {
+                                $shepherd_channels{$channel} = 3;       # shepherd/widget knew about channel but was duplicated!
+                        } elsif ($shepherd_channels{$channel} == 0) {
+                                ;                                       # aiee. a duplicate of a channel that shepherd doesn't know about!
+                        } else {
+                                die "unhandled shepherd_channels case for '$channel' value ".$shepherd_channels{$channel};
+                        }
+
+                        printf "  %20s (%d programmes)%s%s%s\n",
+                                $channel, $events->getLength,
+                                (defined $seen_widget_chan{$channel} ? "\t[Duplicate in Widget]" : ""),
+                                ($shepherd_channels{$channel} == 0 ? "\t[Only known to Widget]" : ""),
+                                ($shepherd_channels{$channel} == 2 ? "\t[Known to both Widget/Shepherd (good!)]" : ""),
+                                ($shepherd_channels{$channel} == 3 ? "\t[Known to both Widget/Shepherd but duplicate in Widget]" : "");
+
+                        $seen_widget_chan{$channel}++;
+                }
+
+                # any channels in Shepherd that Widget didn't return?
+                foreach my $ch (keys %shepherd_channels) {
+                        printf "  %20s [Only known to Shepherd]\n",$ch if ($shepherd_channels{$ch} == 1);
+                }
+
+                printf "\n";
+        }
+
+        exit(0);
+}
 
 ######################################################################################################