Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / CPAN / LWP / UserAgent.pm
CommitLineData
3fea05b9 1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2# vim: ts=4 sts=4 sw=4:
3package CPAN::LWP::UserAgent;
4use strict;
5use vars qw(@ISA $USER $PASSWD $SETUPDONE);
6# we delay requiring LWP::UserAgent and setting up inheritance until we need it
7
8$CPAN::LWP::UserAgent::VERSION = $CPAN::LWP::UserAgent::VERSION = "1.00";
9
10sub config {
11 return if $SETUPDONE;
12 if ($CPAN::META->has_usable('LWP::UserAgent')) {
13 require LWP::UserAgent;
14 @ISA = qw(Exporter LWP::UserAgent); ## no critic
15 $SETUPDONE++;
16 } else {
17 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
18 }
19}
20
21sub get_basic_credentials {
22 my($self, $realm, $uri, $proxy) = @_;
23 if ($USER && $PASSWD) {
24 return ($USER, $PASSWD);
25 }
26 if ( $proxy ) {
27 ($USER,$PASSWD) = $self->get_proxy_credentials();
28 } else {
29 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
30 }
31 return($USER,$PASSWD);
32}
33
34sub get_proxy_credentials {
35 my $self = shift;
36 my ($user, $password);
37 if ( defined $CPAN::Config->{proxy_user} ) {
38 $user = $CPAN::Config->{proxy_user};
39 $password = $CPAN::Config->{proxy_pass} || "";
40 return ($user, $password);
41 }
42 my $username_prompt = "\nProxy authentication needed!
43 (Note: to permanently configure username and password run
44 o conf proxy_user your_username
45 o conf proxy_pass your_password
46 )\nUsername:";
47 ($user, $password) =
48 _get_username_and_password_from_user($username_prompt);
49 return ($user,$password);
50}
51
52sub get_non_proxy_credentials {
53 my $self = shift;
54 my ($user,$password);
55 if ( defined $CPAN::Config->{username} ) {
56 $user = $CPAN::Config->{username};
57 $password = $CPAN::Config->{password} || "";
58 return ($user, $password);
59 }
60 my $username_prompt = "\nAuthentication needed!
61 (Note: to permanently configure username and password run
62 o conf username your_username
63 o conf password your_password
64 )\nUsername:";
65
66 ($user, $password) =
67 _get_username_and_password_from_user($username_prompt);
68 return ($user,$password);
69}
70
71sub _get_username_and_password_from_user {
72 my $username_message = shift;
73 my ($username,$password);
74
75 ExtUtils::MakeMaker->import(qw(prompt));
76 $username = prompt($username_message);
77 if ($CPAN::META->has_inst("Term::ReadKey")) {
78 Term::ReadKey::ReadMode("noecho");
79 }
80 else {
81 $CPAN::Frontend->mywarn(
82 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
83 );
84 }
85 $password = prompt("Password:");
86
87 if ($CPAN::META->has_inst("Term::ReadKey")) {
88 Term::ReadKey::ReadMode("restore");
89 }
90 $CPAN::Frontend->myprint("\n\n");
91 return ($username,$password);
92}
93
94# mirror(): Its purpose is to deal with proxy authentication. When we
95# call SUPER::mirror, we relly call the mirror method in
96# LWP::UserAgent. LWP::UserAgent will then call
97# $self->get_basic_credentials or some equivalent and this will be
98# $self->dispatched to our own get_basic_credentials method.
99
100# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
101
102# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
103# although we have gone through our get_basic_credentials, the proxy
104# server refuses to connect. This could be a case where the username or
105# password has changed in the meantime, so I'm trying once again without
106# $USER and $PASSWD to give the get_basic_credentials routine another
107# chance to set $USER and $PASSWD.
108
109# mirror(): Its purpose is to deal with proxy authentication. When we
110# call SUPER::mirror, we relly call the mirror method in
111# LWP::UserAgent. LWP::UserAgent will then call
112# $self->get_basic_credentials or some equivalent and this will be
113# $self->dispatched to our own get_basic_credentials method.
114
115# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
116
117# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
118# although we have gone through our get_basic_credentials, the proxy
119# server refuses to connect. This could be a case where the username or
120# password has changed in the meantime, so I'm trying once again without
121# $USER and $PASSWD to give the get_basic_credentials routine another
122# chance to set $USER and $PASSWD.
123
124sub mirror {
125 my($self,$url,$aslocal) = @_;
126 my $result = $self->SUPER::mirror($url,$aslocal);
127 if ($result->code == 407) {
128 undef $USER;
129 undef $PASSWD;
130 $result = $self->SUPER::mirror($url,$aslocal);
131 }
132 $result;
133}
134
1351;