[mythtv-users] [patch] ZapListings.pm
mojo
mojospam at thegeekclub.net
Wed Jul 2 02:13:13 EDT 2003
n/m.. i guess people are getting it working with 0.5.14
mojo wrote:
> 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
>
>
> _______________________________________________
> 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