Re: LWP head replacement

[tachyon]

Neat trick. BTW you don't need to specifically use the HTTP entities with LWPUA. Golf:

#!/usr/bin/perl -w

$^W = 336 >> 3;

use strict;
use LWP::UserAgent;
my $UA = new LWP::UserAgent;
$UA->proxy('http', 'http://proxy.ahcl.com:8080/');

HEAD('http://123box.co.uk/');
HEAD('http://japhy.perlmonk.org/book/');

real_HEAD('http://123box.co.uk/');
real_HEAD('http://japhy.perlmonk.org/book/');

sub HEAD {
    my $req = HTTP::Request->new(GET => shift);
    my $res = $UA->request($req, sub { }, 1);
    print "HEAD\n\n", $res->as_string(), "\n";
}

sub real_HEAD {
    my $req = HTTP::Request->new(HEAD => shift);
    my $res = $UA->request($req);
    print "real_HEAD\n\n", $res->as_string(), "\n";
}
__END__

HEAD

HTTP/1.1 200 OK
Connection: close
Date: Wed, 21 Nov 2001 12:27:24 GMT
Via: HTTP/1.1  (IBM-PROXY-WTE), 1.0 NSW-PROXY
Server: Apache/1.3.19 (Unix) mod_gzip/1.3.19.1a Resin/1.2.2
Content-Length: 8514
Content-Type: text/html
Content-Type: text/html;
Client-Date: Wed, 21 Nov 2001 12:33:16 GMT
Client-Peer: 10.1.17.5:8080
Title: login



HEAD

HTTP/1.1 200 OK
Connection: close
Date: Wed, 21 Nov 2001 12:18:07 GMT
Via: 1.1 NSW-PROXY
Age: 940
Server: Apache/1.3.22 (Unix) mod_perl/1.26 PHP/4.0.6
Content-Length: 1766
Content-Type: text/html
ETag: "57532-6e6-3bf6bcac"
Last-Modified: Sat, 17 Nov 2001 19:38:20 GMT
Client-Date: Wed, 21 Nov 2001 12:33:18 GMT
Client-Peer: 10.1.17.5:8080
Title: Regular Expressions in Perl



real_HEAD

HTTP/1.1 504 (Gateway Timeout) Proxy Error: Remote host did not send a
+ny data - URL "http://123box.co.uk/".
Cache-Control: no-cache
Connection: close
Date: Wed, 21 Nov 2001 12:36:20 GMT
Pragma: no-cache
Via: HTTP/1.1  (IBM-PROXY-WTE), 1.0 NSW-PROXY
Server: IBM-PROXY-WTE/3.0
Content-Type: text/html
Expires: Wed, 21 Nov 2001 12:36:20 GMT
Last-Modified: Wed, 21 Nov 2001 12:36:20 GMT
Client-Date: Wed, 21 Nov 2001 12:33:18 GMT
Client-Peer: 10.1.17.5:8080



real_HEAD

HTTP/1.1 200 OK
Connection: close
Date: Wed, 21 Nov 2001 12:43:15 GMT
Via: HTTP/1.1  (IBM-PROXY-WTE), 1.0 NSW-PROXY
Server: Apache/1.3.22 (Unix) mod_perl/1.26 PHP/4.0.6
Content-Length: 1766
Content-Type: text/html
ETag: "57532-6e6-3bf6bcac"
Last-Modified: Sat, 17 Nov 2001 19:38:20 GMT
Client-Date: Wed, 21 Nov 2001 12:33:19 GMT
Client-Peer: 10.1.17.5:8080

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

[Wassercrats]

Here's crazyinsomniac's version with a few extras that it took me way to long to figure out it needed to work for me (I still have to view source to see the output, but at least I don't get an internal service error), and two extra new-lines to clarify error messages.

Also, I think one of the addresses in the script used to return a bad header, but someone apparently fixed it, so I changed an address to a nonexistant one so I could see the error handler at work.


#!/usr/bin/perl -w
######################################################################
+########
print "Cache-Control: no-cache, must-revalidate\n";
print "Pragma: no-cache\n";

print "Content-type: text/html\n\n";


$^W = 552 >> 3;

use strict;          # for sanity (ALWAYS!!!)
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;

HEAD('http://12box.co.uk/');
HEAD('http://japhy.perlmonk.org/book/');

real_HEAD('http://123box.co.uk/');
real_HEAD('http://japhy.perlmonk.org/book/');

sub HEAD {
    my $req = HTTP::Request->new(GET => shift);
    my $UA = new LWP::UserAgent;

    my $res = $UA->request($req, sub { die }, 1);
    
    if($res->is_success) {
        print $res->as_string();
    } else {
        print "\nError: " . $res->status_line . "\n\n";
    }
}

sub real_HEAD {
    my $req = HTTP::Request->new(HEAD => shift);
    my $UA = new LWP::UserAgent;

    my $res = $UA->request($req);
    
    if($res->is_success) {
        print $res->as_string();
    } else {
        print "Error: " . $res->status_line . "\n\n";
    }
}
__END__