[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