[mythtv-users] [patch] ZapListings.pm

David Watson dwatson at eecs.umich.edu
Tue Jul 1 15:29:57 EDT 2003


While it appears that somebody has already fixed the official
version of tv_grab_na, I'm including a patch against 0.5.8.
This should work with 0.5.7 as well, but I'm not sure how much
has changed before/after that.  (The version of ZapListings.pm
I have is 1.37.)  Hopefully this will make it easier to avoid
the problems with 0.5.11.

Note, this isn't elegant code, and I have know clue what was
changed in the official version, but this works fine for me.

David

-------------- next part --------------
--- ZapListings.pm	2003-07-01 12:54:39.000000000 -0400
+++ /usr/share/perl5/XMLTV/ZapListings.pm	2003-07-01 14:00:03.000000000 -0400
@@ -227,22 +227,17 @@
     my @forms;
 
     while ( 1 ) {
+        $content=~s/<form/<form/gios;
+        $content=~s/<\/form>/<\/form>/gios;
+
 	my $start=index($content, "<form");
-	$start=index($content, "<FORM") if ( $start == -1 );
 
-	if ( $start == -1 ) {
-	    $start=index($content, $1) if ( $start=~m/(<FORM)/ios );
-	}
 	last if ( $start == -1 );
 
 	my $insideContent=substr($content, $start);
 
 	my $end=index($insideContent, "</form>");
-	$end=index($insideContent, "</FORM>") if ( $end == -1 );
 
-	if ( $end == -1 ) {
-	    $end=index($content, $1) if ( $end=~m/(<FORM)/ios );
-	}
 	last if ( $end == -1 );
 
 	#print STDERR "indexes are $start,$end\n";
@@ -297,16 +292,16 @@
 	    }
 	    push(@{$form->{inputs}}, $input);
 	}
-	
+
 	if ( $insideForm=~m/<select/ios ) {
-	    $insideForm=~s/<select/<select/ios;
-	    $insideForm=~s/<\/select>/<\/select>/ios;
+	    $insideForm=~s/<select/<select/gios;
+	    $insideForm=~s/<\/select>/<\/select>/gios;
 	    my $start;
 	    while (($start=index($insideForm, "<select")) != -1 ) {
 		my $end=index($insideForm, "</select>", $start)+length("</select>");
 		my $above=substr($insideForm, 0, $start);
-		
-		my $ntext=substr($insideForm, $start, $end);
+
+		my $ntext=substr($insideForm, $start, $end - $start);
 		$insideForm=$above.substr($insideForm, $end);
 
 		while ( $ntext=~s/^<select\s*([^>]+)>(.*)(?=<\/select>)//ios ) {
@@ -337,6 +332,9 @@
 
 			$option->{cdata}=$optionValue;
 			$option->{value}=$optionValue; # default value is contents
+			while ( $optionAttrs=~s/^\s*selected//ios ) {
+			    $option->{selected}=1;
+			}
 			while ( $optionAttrs=~s/^\s*([^=]+)=//ios ) {
 			    my $attr=$1;
 			    $attr=~tr/[A-Z]/[a-z]/;
@@ -530,6 +528,9 @@
 			    $buf.=" ".prepValue($attr)."=".prepValue($value);
 			}
 		    }
+		    if ( $option->{selected} ) {
+		        $buf.=" selected";
+		    }
 		    $buf.=">\n";
 		}
 	    }
@@ -552,6 +553,7 @@
 
     my $button;
     my @pairs;
+    my %radio;
 
     if ( defined($form->{attrs}->{id}) &&
 	 defined($form->{attrs}->{name}) ) {
@@ -574,22 +576,40 @@
 	    $button=$input;
 	}
 	if ( defined($input->{name}) ) {
-	    if ( !defined($input->{value}) ) {
+	    if ( !defined($input->{value}) &&
+		 !defined($self->{formSettings}->{$input->{name}}) ) {
+	        main::errorMessage("zap2it form has input '$input->{name}' we don't have a value for");
+		return(undef);
+	    }
+	    if ( !defined($input->{value}) || $input->{value} eq "") {
 		if ( defined($self->{formSettings}->{$input->{name}}) ) {
 		    $input->{value}=$self->{formSettings}->{$input->{name}};
 		}
-		else {
-		  main::errorMessage("zap2it form has input '$input->{name}' we don't have a value for");
-		    
-		    return(undef);
-		}
 	    }
 	}
 	if ( $input->{type} eq "image" ) {
-	    push(@pairs, $input->{name}.".x");
-	    push(@pairs, "1");
-	    push(@pairs, $input->{name}.".y");
-	    push(@pairs, "1");
+	    if ( defined($input->{name}) ) {
+	        push(@pairs, $input->{name}.".x");
+		push(@pairs, "1");
+		push(@pairs, $input->{name}.".y");
+		push(@pairs, "1");
+	    }
+            else {
+                push(@pairs, "x");
+		push(@pairs, "1");
+		push(@pairs, "y");
+		push(@pairs, "1");
+	    }
+	}
+        elsif ( $input->{type} eq "radio" ) {
+	    # Always pick the first radio button.
+	    # The caller can always set the value explicitly (which will
+	    # be caught the first time we see this radio button.
+            if ( !defined($radio{$input->{name}}) ) {
+	        $radio{$input->{name}} = $input->{value};
+		push(@pairs, $input->{name});
+		push(@pairs, $input->{value});
+	    }
 	}
 	else {
 	    push(@pairs, $input->{name});
@@ -600,13 +620,24 @@
 	for my $select (@{$form->{selects}}) {
 	    if ( defined($select->{attrs}->{name}) ) {
 		my $name=$select->{attrs}->{name};
+		my $found_value = 0;
 		if ( defined($self->{formSettings}->{$name}) ) {
+		    $found_value = 1;
 		    push(@pairs, $name);
 		    push(@pairs, $self->{formSettings}->{$name});
 		}
-		else {
+                elsif ( defined($select->{options}) ) {
+		  for my $option (@{$select->{options}}) {
+		    if ( $option->{selected} ) {
+		      $found_value = 1;
+		      push(@pairs, $name);
+		      push(@pairs, $option->{attrs}->{value});
+		    }
+		  }
+		}
+		if ( !$found_value ) {
 		  main::errorMessage("zap2it form has select '$name' we don't have a value for");
-		    
+
 		    return(undef);
 		}
 	    }
@@ -653,6 +684,29 @@
 	}
     }
 
+    if ( $req->method() eq "POST" ) {
+      # Zap2It is broken, redirect POST as GET.
+      # XXX Probably better to do this in our subclass...
+      my $res = $ua->simple_request($req);
+      my $code = $res->code;
+      if ( $code == &HTTP::Status::RC_MOVED_PERMANENTLY or
+	   $code == &HTTP::Status::RC_MOVED_TEMPORARILY) {
+
+	# Update the URL based on the Location:-header.
+	my($referral_uri) = $res->header('Location');
+	{
+	      # Some servers erroneously return a relative URL for redirects,
+	      # so make it absolute if it not already is.
+	  local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
+	      my $base = $res->base;
+	  $referral_uri = $HTTP::URI_CLASS->new($referral_uri, $base)
+	                ->abs($base);
+	}
+
+	# Make a new request with the new location.
+	$req = GET($referral_uri);
+      }
+    }
     my $res = $ua->request($req);
     if ( $debug ) {
       main::statusMessage("==== response status: ".$res->status_line." ====\n");
@@ -736,6 +790,7 @@
     my $urlbase=shift;
 
     $self->{formSettings}->{zipcode}=$geocode;
+    $self->{formSettings}->{listingssite}="tvl";
     $self->{formSettings}->{urlbase}=$urlbase;
 
     return($self->Form2Request($self->{ZipCodeForm}));
@@ -797,7 +852,7 @@
     # todo - this should be a query instead of a dump/scan
     for my $form (getForms($content)) {
 	my $dump=dumpForm($form);
-	if ( $dump=~m/\s+name=provider/oi ) {
+	if ( $dump=~m/\s+name=\"form1\"/oi ) {
 	    $self->{ProviderForm}=$form;
 	    #print STDERR "Providers Form:\n$dump";
 	    last;
@@ -891,41 +946,8 @@
 	return(undef);
     }
 
-    if ( !($res->content()=~m;<a href="([^\"]+)"[^>]+><B>All Channels</B></a>;ios) ) { 
-	main::errorMessage("zap2it gave us a grid listings, but no <All Channels> link\n");
-	return(undef);
-    }
-    $req=GET(URI->new_abs($1,$self->{formSettings}->{urlbase}));
-
-    $res=&doRequest($self->{ua}, $req, $self->{Debug});
-    if ( !$res->is_success || $res->content()=~m/your session has timed out/i ) {
-	# again.
-	$res=&doRequest($self->{ua}, $req, $self->{Debug});
-
-	# looks like some requests require two identical calls since
-	# the zap2it server gives us a cookie that works with the second
-	# attempt after the first fails
-	if ( !$res->is_success || $res->content()=~m/your session has timed out/i ) {
-	    # again.
-	    $res=&doRequest($self->{ua}, $req, $self->{Debug});
-	}
-    }
-
-    if ( !$res->is_success ) {
-	main::errorMessage("zap2it failed to give us a page: ".$res->code().":".
-			 HTTP::Status::status_message($res->code())."\n");
-	main::errorMessage("check postal/zip code or www site (maybe they're down)\n");
-	return(undef);
-    }
-
     my $content=$res->content();
 
-    if ( $self->{Debug} ) {
-	open(FD, "> channels.html") || die "channels.html: $!";
-	print FD $content;
-	close(FD);
-    }
-
     # todo - this should be a query instead of a dump/scan
     for my $form (getForms($content)) {
 	my $dump=dumpForm($form);
@@ -944,6 +966,41 @@
 	return(undef);
     }
 
+    # XXX Use the ChannelByTextForm to get the complete list of channels.
+    $self->{formSettings}->{displayType}="Grid";
+    $self->{formSettings}->{duration}="1";
+    $self->{formSettings}->{rowdisplay}="0";
+
+    $req=$self->Form2Request($self->{ChannelByTextForm});
+    if ( !defined($req) ) {
+      return(undef);
+    }
+
+    $res=&doRequest($self->{ua}, $req, $self->{Debug});
+
+    # looks like some requests require two identical calls since
+    # the zap2it server gives us a cookie that works with the second
+    # attempt after the first fails
+    if ( !$res->is_success || $res->content()=~m/your session has timed out/i ) {
+      # again.
+      $res=&doRequest($self->{ua}, $req, $self->{Debug});
+    }
+
+    if ( !$res->is_success ) {
+      main::errorMessage("zap2it failed to give us a page: ".$res->code().":".
+			 HTTP::Status::status_message($res->code())."\n");
+      main::errorMessage("check postal/zip code or www site (maybe they're down)\n");
+      return(undef);
+    }
+
+    $content=$res->content();
+
+    if ( $self->{Debug} ) {
+	open(FD, "> channels.html") || die "channels.html: $!";
+	print FD $content;
+	close(FD);
+    }
+
     my @channels;
 
     my $rowNumber=0;


More information about the mythtv-users mailing list