http://qs321.pair.com?node_id=126762


in reply to LWP head replacement

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

Replies are listed 'Best First'.
Re: Re: LWP head replacement
by Wassercrats (Initiate) on Sep 19, 2002 at 07:12 UTC

    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__