[mythtv-users] [patch] ZapListings.pm

mojo mojospam at thegeekclub.net
Tue Jul 1 23:22:57 EDT 2003


anyone tried this on 0.5.10 or could give me a quick "paste it right 
here in place of this part of this code" kinda newbie guide to hacking it?

i'd really like to get some listings :-)

as it so happens i had just wiped out my db when i loaded up the latest 
cvs right when the zap2it.com issue arose.

tia,
Sean

David Watson wrote:

> 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
> 
> 
> 
> ------------------------------------------------------------------------
> 
> --- 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;
> 
> 
> ------------------------------------------------------------------------
> 
> _______________________________________________
> mythtv-users mailing list
> mythtv-users at snowman.net
> http://lists.snowman.net/cgi-bin/mailman/listinfo/mythtv-users



More information about the mythtv-users mailing list