File Coverage

blib/lib/CPAN/LWP/UserAgent.pm
Criterion Covered Total %
statement 13 27 48.1
branch 2 8 25.0
condition n/a
subroutine 4 7 57.1
pod 0 4 0.0
total 19 46 41.3


line stmt bran cond sub pod time code
1             # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2             # vim: ts=4 sts=4 sw=4:
3             package CPAN::LWP::UserAgent;
4 13     13   93 use strict;
  13         32  
  13         457  
5 13     13   88 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
  13         26  
  13         821  
6 13     13   4916 use CPAN::HTTP::Credentials;
  13         32  
  13         3503  
7             # we delay requiring LWP::UserAgent and setting up inheritance until we need it
8              
9             $CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.9601";
10              
11              
12             sub config {
13 0 0   0 0 0 return if $SETUPDONE;
14 0 0       0 if ($CPAN::META->has_usable('LWP::UserAgent')) {
15 0         0 require LWP::UserAgent;
16 0         0 @ISA = qw(Exporter LWP::UserAgent); ## no critic
17 0         0 $SETUPDONE++;
18             } else {
19 0         0 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
20             }
21             }
22              
23             sub get_basic_credentials {
24 2     2 0 2670 my($self, $realm, $uri, $proxy) = @_;
25 2 100       7 if ( $proxy ) {
26 1         5 return CPAN::HTTP::Credentials->get_proxy_credentials();
27             } else {
28 1         6 return CPAN::HTTP::Credentials->get_non_proxy_credentials();
29             }
30             }
31              
32             sub no_proxy {
33 0     0 0   my ( $self, $no_proxy ) = @_;
34 0           return $self->SUPER::no_proxy( split(',',$no_proxy) );
35             }
36              
37             # mirror(): Its purpose is to deal with proxy authentication. When we
38             # call SUPER::mirror, we really call the mirror method in
39             # LWP::UserAgent. LWP::UserAgent will then call
40             # $self->get_basic_credentials or some equivalent and this will be
41             # $self->dispatched to our own get_basic_credentials method.
42              
43             # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
44              
45             # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
46             # although we have gone through our get_basic_credentials, the proxy
47             # server refuses to connect. This could be a case where the username or
48             # password has changed in the meantime, so I'm trying once again without
49             # $USER and $PASSWD to give the get_basic_credentials routine another
50             # chance to set $USER and $PASSWD.
51              
52             sub mirror {
53 0     0 0   my($self,$url,$aslocal) = @_;
54 0           my $result = $self->SUPER::mirror($url,$aslocal);
55 0 0         if ($result->code == 407) {
56 0           CPAN::HTTP::Credentials->clear_credentials;
57 0           $result = $self->SUPER::mirror($url,$aslocal);
58             }
59 0           $result;
60             }
61              
62             1;