snippet
ybiC
Example of LWP syntax for use with authenticated proxy.
<p>
2002-03-23 [cpan://Getopt::Long] and [cpan://Pod::Usage], minor format cleanup<br>
Minor updates 2001-04-27
</p>
<!-- 04/26 at 17:48:33 Petruchio says Dang... nice code! -->
<CODE>#!/usr/bin/perl -w
# dget.pl
# pod at tail
use strict;
use LWP::UserAgent;
use Getopt::Long;
use Pod::Usage;
my ($opt_help, $opt_man);
GetOptions(
'help!' => \$opt_help,
'man!' => \$opt_man,
) or pod2usage(-verbose => 1) && exit;
pod2usage(-verbose => 1) && exit if (defined $opt_help);
pod2usage(-verbose => 2) && exit if (defined $opt_man);
# Begin config parameters
my %parm = (
url => shift,
outfile => shift,
uatimeout => 120, # seconds before giving up on fetch
browser => 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:0.9.9) Gecko/20020310 ',
);
my %proxy = (
host => '', # http://host.dom:port
id => '', # ntdom\userid
pass => '', # empty quotes if no proxy auth
);
# End config parameters
unless(defined $parm{url}) {
print "\n Ooot - you forgot to provide a URL !\n";
Ooot();
}
unless(defined $parm{outfile}) {
print "\n Ooot - your forgot to provide an outfile !\n";
Ooot();
}
print "\n Fetching $parm{url}...\n";
my $ua = new LWP::UserAgent;
$ua->agent($parm{browser});
$ua->timeout($parm{uatimeout});
$ua->proxy(http => "$proxy{host}") if (defined $proxy{host});
$parm{url} = new URI::URL($parm{url});
my $req = new HTTP::Request "GET" => ($parm{url});
$req->proxy_authorization_basic
($proxy{id}, $proxy{pass}) if (defined $proxy{id});
my $res = $ua->request($req);
if ($res -> is_success) {
my $rescont = $res->content;
open (OUT, ">$parm{outfile}")
or die "Error opening $parm{outfile} for write: $!";
print OUT $rescont;
close OUT
or die "Error closing $parm{outfile}: $!";
}
else {
my $resmsg = $res->message;
print "Error fetching $parm{url}:\n $resmsg\n\n";
exit;
}
print " Done! Page saved at '$parm{outfile}'\n\n";
sub Ooot {
print
"\n dget.pl --help",
"\n dget.pl --man",
"\n",
"\n LWP $LWP::VERSION",
"\n Perl $]",
"\n OS $^O",
"\n Program $0",
"\n\n",
;
exit;
}
=head1 NAME
dget.pl
=head1 SYNOPSIS
dget.pl http://host.dom/page
dget.pl [OPTION or ARGUMENT]
=head1 DESCRIPTION
Command-line web-page fetcher
Testbed for figuring out proxy authentication code
=head1 OPTIONS
-h --help display Usage, Arguments, and Options
-m --man display complete man page
=head1 ARGUMENTS
None. All arguments are defined in the code at 'config parameters'
=head1 AUTHOR
ybiC
=head1 TESTED
LWP 5.51+5.48 Perl 5.00503 Debian 2.2r3
LWP 5.5392 Perl 5.00601 Cygwin on Win2kPro
LWP 5.48 SiePerl 5.00503 Win2kPro (zsh|cmd.exe)
LWP 5.48 ActivePerl 5.60 Win2kPro (zsh|cmd.exe)
=head1 CHANGELOG
2002-03-23 22:45 CST
Getopt::Long+Pod::Usage to eliminate sub Usage{...}
Reformat code closer to PerlStyle recommendations
2001-04-27 10:30
Take outfile name from keyboard input instead of hard-coded
More tests
2001-04-26 11:00
More tests
Post to PerlMonks Snippets
Minor format tweaks
2001-04-25 22:15
Initial working code
=head1 TODO
Getopt::Long for proxy, timeout, browser
Save to outfile of same name as URL file
Prompt for user+pass instead of hard-coded
Update TESTED section of pod
=cut
</CODE>