/usr/local/CPAN/LWPng-alpha/LWP/UA/Proxy.pm

• package LWP::UA::Proxy
  • spool_handler
• package LWP::UA
  • no_proxy
  • proxy
  • env_proxy
• EOF

package LWP::UA::Proxy;

# Setup methods that deal with proxies

sub spool_handler
{
    my($ua, $req) = @_;
    my $proxy = $req->proxy;
    unless ($proxy) {
	$proxy = $ua->uri_attr_plain($req->url, "proxy");
	return unless $proxy;
	$req->proxy($proxy);
    }

    # Set up Proxy-Authorization perhaps
    my $realms = $ua->uri_attr_plain($proxy, "proxy_realms");
    return unless $realms && %$realms;

    if (keys %$realms > 1) {
	# there is multiple realms to choose from.  Select the
	# right one, if there is such a thing.
	my $realm = $ua->uri_attr_plain($req->url, "proxy_realm");
	if (my $auth = $realms->{$realm}) {
	    $auth->set_proxy_authorization($req);
	}
    } else {
	# there is only one realm defined for this proxy server,
	# so we might as well use it.
	my($auth) = values %$realms;
	$auth->set_proxy_authorization($req);
    }
}

# We also add some convenience methods to the LWP::UA class.
# XXX should we really do this?  Perhaps this should only be part ot
# the LWP5 compatibility stuff
package LWP::UA;

sub no_proxy
{
    my($self, @no) = @_;
    for (@no) {
	$_ = ".$_" unless /^\./;
	my $h = $self->uri_attr_update("DOMAIN", "http://dummy.$_");
	$h->{"proxy"} = "";
    }
}

sub proxy
{
    my($self, $scheme, $url) = @_;
    my $h = $self->uri_attr_update("SCHEME", "$scheme:");
    $h->{"proxy"} = $url;
}

sub env_proxy {
    my ($self) = @_;
    my($k,$v);
    while(($k, $v) = each %ENV) {
	$k = lc($k);
	next unless $k =~ /^(.*)_proxy$/;
	$k = $1;
	if ($k eq 'no') {
	    $self->no_proxy(split(/\s*,\s*/, $v));
	}
	else {
	    $self->proxy($k, $v);
	}
    }
}

1;