Changeset 437

Timestamp:

01/09/07 19:32:15 (6 years ago)

Author:

max

Message:

Reworked channel list

This only affects a small number of rural regions. It provides
a standardised way of distinguishing between similarly named
stations in those areas; e.g. "Prime (Regional)" and "Prime
(Albury)".

Files:

• applications/shepherd (modified) (6 diffs)
• status (modified) (1 diff)

applications/shepherd

@@ -2 +2 @@
 
 my $progname = 'shepherd';
-my $version = '0.4.31';
+my $version = '0.4.32';
 
 # tv_grab_au
@@ -1007 +1007 @@
     else
     {
-        $ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322')
+        $ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322');
     }
 
@@ -1316 +1316 @@
 {
     my $REGIONS = {
-        "ACT" => 126,
-        "NSW: Sydney" => 73,
-        "NSW: Newcastle" => 184,
-        "NSW: Central Coast" => 66,
-        "NSW: Griffith" => 67,
-        "NSW: Broken Hill" => 63,
-        "NSW: Northern NSW" => 69,
-        "NSW: Southern NSW" => 71,
-        "NSW: Remote and Central" => 106,
-        "NT: Darwin" => 74,
-        "NT: Remote & Central" => 108,
-        "QLD: Brisbane" => 75,
-        "QLD: Gold Coast" => 78,
-        "QLD: Regional" => 79,
-        "QLD: Remote & Central" => 114,
-        "SA: Adelaide" => 81,
-        "SA: Renmark" => 82,
-        "SA: Riverland" => 83,
-        "SA: South East SA" => 85,
-        "SA: Spencer Gulf" => 86,
-        "SA: Remote & Central" => 107,
-        "Tasmania" => 88,
-        "VIC: Melbourne" => 94,
-        "VIC: Geelong" => 93,
-        "VIC: Eastern Victoria" => 90,
-        "VIC: Mildura/Sunraysia" => 95,
-        "VIC: Western Victoria" => 98,
-        "WA: Perth" => 101,
-        "WA: Regional" => 102
+        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"
     };
 
     print "\nConfiguring.\n\n" .
           "Select your region:\n";
-    foreach (sort keys %$REGIONS)
-    {
-        printf(" (%3d) %s\n", $REGIONS->{$_}, $_);
-    }
-    $region = ask_choice("Enter region code:", "94", values %$REGIONS);
+    foreach (sort { $REGIONS->{$a} cmp $REGIONS->{$b} } keys %$REGIONS)
+    {
+        printf(" (%3d) %s\n", $_, $REGIONS->{$_});
+    }
+    $region = ask_choice("Enter region code:", "94", keys %$REGIONS);
 
     print "\nFetching channel information... ";
 
-    my @channellist = get_channels();
+    my @channellist = &get_channels($REGIONS->{$region});
 
     print "done.\n\n" .
@@ -1363 +1363 @@
           "of your choice (e.g. \"seven.free.au\"). If you don't need\n" .
           "guide data for this channel, just press Enter.\n\n" .
+          "Your region has the following channels:\n " . 
+          join(', ', @channellist) . ".\n\n" .
           "Please don't subscribe to unneeded channels.\n\nChannels:\n";
     $channels = {};
@@ -1458 +1460 @@
 }
 
-sub get_channels
+# Obsolete but left for now in case we want to go back to it
+sub get_channels_yahoo
 {
     my @date = localtime;
@@ -1468 +1471 @@
     {
         push @channellist, $1;
+    }
+    return @channellist;
+}
+
+# Sourced from YourTV
+sub get_channels
+{
+    my $regionname = shift;
+
+    # Download list
+    my $ua = LWP::UserAgent->new();
+    $ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322');
+    $ua->cookie_jar({});
+    $ua->get('http://www.yourtv.com.au');
+    my $response = $ua->get('http://www.yourtv.com.au/profile/ajax.cfm?action=channels&region_id='.$region);
+
+    my $page = $response->content;
+    die "Unable to download channel list" if ($response->is_error());
+
+    # Rules for Station Names:
+    # Station names are comprised of the channel name (eg "Seven") and an
+    # optional regional qualifier in brackets (eg "(Cairns/Rockhampton)").
+    # Station names shall not contain a regional qualifer unless
+    # necessary to distinguish between identical channel names in
+    # the same region; in this case, a regional qualifier shall always
+    # be included. In the absence of anything better, the region name 
+    # (eg "NSW: Regional NSW") is used as the regional qualifier.
+    my (@channellist, $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 = $channel;
+            $rq = '';
+        }
+        # Is there already a channel with this name?
+        if ($clist->{$cn})
+        {
+            # Set regional qualifier for existing station if not already set
+            if (@{$clist->{$cn}} == 1 and $clist->{$cn}[0] eq '')
+            {
+                $clist->{$cn} = [ "($regionname)" ];
+            }
+            $rq = $regionname if ($rq eq '');
+            die "Bad channel list in region $region!" if (grep($rq eq $_, @{$clist->{$cn}}));
+            push @{$clist->{$cn}}, $rq; 
+        }
+        else
+        {
+            $clist->{$cn} = [ $rq ];
+        }
+    }
+    foreach $cn (keys %$clist)
+    {
+        if (@{$clist->{$cn}} == 1)
+        {
+            push @channellist, $cn;
+        }
+        else
+        {
+            foreach $rq (@{$clist->{$cn}})
+            {
+                push @channellist, "$cn $rq";
+            }
+        }
     }
     return @channellist;

status

@@ -1 @@
-application     shepherd            0.4.31
+application     shepherd            0.4.32
 grabber         yahoo7widget        1.72
 grabber         rex                 3.3.9