File Coverage

blib/lib/CPAN/LWP/UserAgent.pm
Criterion Covered Total %
statement 18 27 66.6
branch 4 8 50.0
condition n/a
subroutine 5 7 71.4
pod 3 4 75.0
total 30 46 65.2


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 12     12   42 use strict;
  12         13  
  12         324  
5 12     12   36 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
  12         13  
  12         614  
6 12     12   3713 use CPAN::HTTP::Credentials;
  12         17  
  12         2308  
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 1 50   1 0 4 return if $SETUPDONE;
14 1 50       6 if ($CPAN::META->has_usable('LWP::UserAgent')) {
15 1         11 require LWP::UserAgent;
16 1         21 @ISA = qw(Exporter LWP::UserAgent); ## no critic
17 1         4 $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 1 1706 my($self, $realm, $uri, $proxy) = @_;
25 2 100       6 if ( $proxy ) {
26 1         4 return CPAN::HTTP::Credentials->get_proxy_credentials();
27             } else {
28 1         32 return CPAN::HTTP::Credentials->get_non_proxy_credentials();
29             }
30             }
31              
32             sub no_proxy {
33 0     0 1   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 1   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;