view release on metacpan or  search on metacpan

Bio/Root/HTTPget.pm  view on Meta::CPAN

           http_proxy if present.
 Returns : a string indicating the proxy
 Args    : $protocol : string for the protocol to set/get
           $proxyurl : url of the proxy to use for the specified protocol
           $username : username (if proxy requires authentication)
           $password : password (if proxy requires authentication)

=cut

sub proxy {
    my $self;
    if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) {
	$self = shift;
    }
    my ($protocol,$proxy,$username,$password) = @_;
    my $atts = ref($self) ? $self : \%attributes;
    $protocol ||= 'http';
    if (!$proxy) {
        if (defined $ENV{http_proxy}) {
            $proxy = $ENV{http_proxy};
            if ($proxy =~ /\@/) {
                ($username, $password, $proxy) = $proxy =~ m{http://(\S+):(\S+)\@(\S+)};
                $proxy = 'http://'.$proxy;
            }
        }
    }
    if (defined $proxy) {
        # default to class method call
        __PACKAGE__->authentication($username, $password) 
        if ($username && $password);
        $atts->{'_proxy'}->{$protocol} = $proxy;
    }
    return $atts->{'_proxy'}->{$protocol};
}

=head2 clear_proxy

 Title   : clear_proxy
 Usage   : my $old_prozy = $db->clear_proxy('http')
 Function: Unsets (clears) the proxy for the protocol indicated 
 Returns : a string indicating the old proxy value
 Args    : $protocol : string for the protocol to clear

=cut

sub clear_proxy {
    my $self;
    if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) {
        $self = shift;
    }
    my ($protocol) = @_;
    my $atts = ref($self) ? $self : \%attributes;
    $protocol ||= 'http';
    delete $atts->{'_proxy'}->{$protocol};
}

=head2 authentication

 Title   : authentication
 Usage   : $db->authentication($user,$pass)
 Function: Get/Set authentication credentials
 Returns : Array of user/pass 
 Args    : Array or user/pass


=cut

sub authentication {
    my $self;
    if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) {
	$self = shift;
    }
    my $atts = ref($self) ? $self : \%attributes;
    if (@_) {
	my ($u,$p) = @_;
	my $atts = ref($self) ? $self : \%attributes;
     
	$atts->{'_authentication'} = [ $u,$p];
    }
    return @{$atts->{'_authentication'} || []};
}

}

1;