This is how we do it with an OO LWP wrapper we use, hope it helps:
sub new {
my $class = shift;
my %args = @_;
my $self = { _ua => LWP::Custom->new() };
bless $self, $class;
# check for passed args to modify defaults
$self->{cookie_dir} = $args{cookie_dir} ? $args{cookie_dir} : '/tm
+p';
# pretend to be IE6 by default ;-)
$self->{agent} = $args{agent} ? $args{agent} : 'Mozilla/4.0 (compa
+tible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.0.3705)';
# use a 30 secont timout by default
$self->{timeout} = $args{timeout} ? $args{timeout} : 30;
# meta refresh threshold
$self->{meta_threshold} = $args{meta_threshold} ? $args{meta_thres
+hold} : 15;
# support cookies, first make a unique cookie file for this instan
+ce
my ( $fh, $name ) = get_tempfile ( $self->{cookie_dir}, 'cookie' )
+;
# as we have created the file we need to make it look like a cooki
+e file
# so that LWP does not winge about the missing header
print $fh "#LWP-Cookies-1.0\n";
close $fh;
$self->{cookie_file} = "$self->{cookie_dir}/$name";
# set up the cookie jar
$self->{_cookie_jar} = HTTP::Cookies->new(
file => $self->{cookie_fil
+e},
autosave => 0,
ignore_discard => 1
);
$self->{_cookie_jar}->load( $self->{cookie_file} );
$self->{_ua}->agent( $self->{agent} );
$self->{_ua}->timeout( $self->{timeout} );
return $self;
}
# this is the simplified guts of the fetch method:
my $request = HTTP::Request->new( $method, $url );
# this call can choke, an example is shopping.aol.co.uk which meta
+
# refreshes to aol://1722:ukshopping causing this call to explode
eval{$self->{_cookie_jar}->add_cookie_header($request)};
my $response = $self->{_ua}->request($request);
$self->{_cookie_jar}->extract_cookies($response);
$self->{_cookie_jar}->save( $self->{cookie_file} );
$obj->{content} = $response->content;
$obj->{code} = $response->code;
$obj->{message} = $response->message;
$obj->{title} = $response->headers->title;
# we customize the LWP::UserAgent class to suit our needs
package LWP::Custom;
use base 'LWP::UserAgent';
# add a set_basic_credentials method, using a closure to remember
{
my ( $username, $password );
sub set_basic_credentials{ ( $username, $password ) = @_[1..2] }
sub get_basic_credentials{ $username, $password };
}
cheers
tachyon
s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print