[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