Last change
on this file since 31780 was 27174, checked in by davidb, 11 years ago |
Perl modules from CPAN that are used in supporting activate.pl, but not part of the Perl core. Only PMs included.
|
File size:
977 bytes
|
Line | |
---|
1 | package URI::_userpass;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 | use URI::Escape qw(uri_unescape);
|
---|
5 |
|
---|
6 | sub user
|
---|
7 | {
|
---|
8 | my $self = shift;
|
---|
9 | my $info = $self->userinfo;
|
---|
10 | if (@_) {
|
---|
11 | my $new = shift;
|
---|
12 | my $pass = defined($info) ? $info : "";
|
---|
13 | $pass =~ s/^[^:]*//;
|
---|
14 |
|
---|
15 | if (!defined($new) && !length($pass)) {
|
---|
16 | $self->userinfo(undef);
|
---|
17 | } else {
|
---|
18 | $new = "" unless defined($new);
|
---|
19 | $new =~ s/%/%25/g;
|
---|
20 | $new =~ s/:/%3A/g;
|
---|
21 | $self->userinfo("$new$pass");
|
---|
22 | }
|
---|
23 | }
|
---|
24 | return unless defined $info;
|
---|
25 | $info =~ s/:.*//;
|
---|
26 | uri_unescape($info);
|
---|
27 | }
|
---|
28 |
|
---|
29 | sub password
|
---|
30 | {
|
---|
31 | my $self = shift;
|
---|
32 | my $info = $self->userinfo;
|
---|
33 | if (@_) {
|
---|
34 | my $new = shift;
|
---|
35 | my $user = defined($info) ? $info : "";
|
---|
36 | $user =~ s/:.*//;
|
---|
37 |
|
---|
38 | if (!defined($new) && !length($user)) {
|
---|
39 | $self->userinfo(undef);
|
---|
40 | } else {
|
---|
41 | $new = "" unless defined($new);
|
---|
42 | $new =~ s/%/%25/g;
|
---|
43 | $self->userinfo("$user:$new");
|
---|
44 | }
|
---|
45 | }
|
---|
46 | return unless defined $info;
|
---|
47 | return unless $info =~ s/^[^:]*://;
|
---|
48 | uri_unescape($info);
|
---|
49 | }
|
---|
50 |
|
---|
51 | 1;
|
---|
Note:
See
TracBrowser
for help on using the repository browser.