# Copyright (c) 2001-2009 bivio Software, Inc. All rights reserved. # # Visit http://www.bivio.biz for more info. # # This library is free software; you can redistribute it and/or modify # it under the terms of the GNU Lesser General Public License as # published by the Free Software Foundation; either version 2.1 of the # License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; If not, you may get a copy from: # http://www.opensource.org/licenses/lgpl-license.html # # $Id: LWPUserAgent.pm,v 2.3 2009/11/28 23:52:53 nagler Exp $ package Bivio::Ext::LWPUserAgent; use strict; use base 'LWP::UserAgent'; use Bivio::IO::Config; use Bivio::IO::Trace; use LWP::Debug (); # C adds timeouts and proxy handling to LWP::UserAgent. # # If you trace this module, also turns on tracing in LWP::Debug. See # L. our($VERSION) = sprintf('%d.%02d', q$Revision: 2.3 $ =~ /\d+/g); our($_TRACE); my($_PKG) = __PACKAGE__; Bivio::IO::Trace->register; my($_HTTP_PROXY); Bivio::IO::Config->register(my $_CFG = { http_proxy => undef, timeout => 60, }); sub handle_config { # (proto, hash) : undef # http_proxy : string [undef] my(undef, $cfg) = @_; $_CFG = $cfg; return; } sub new { # (proto, boolean) : Ext.LWPUserAgent # Calls SUPER::new and sets timeout and proxy. # # If I is true, L will return true. # # Turns on LWP::Debug if $_TRACE is true for this class. my($proto, $want_redirects) = @_; my($self) = $proto->SUPER::new; my($fields) = $self->{$_PKG} = { want_redirects => $want_redirects ? 1 : 0, }; # Relatively short timeout, so we don't get stuck in remote services. $self->timeout($_CFG->{timeout}); # Use a proxy if configured if (defined($_CFG->{http_proxy})) { $self->proxy(['http', 'https'], $_CFG->{http_proxy}); } elsif ($ENV{http_proxy}) { $self->proxy(['http', 'https'], $ENV{http_proxy}); } LWP::Debug::level("+debug") if $_TRACE; return $self; } sub redirect_ok { # (self) : boolean # Always returns false. Redirects need to be handled at higher level for cookies # and logging. return shift->{$_PKG}->{want_redirects}; } 1;