Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / URI / pop.pm
CommitLineData
3fea05b9 1package URI::pop; # RFC 2384
2
3require URI::_server;
4@ISA=qw(URI::_server);
5
6use strict;
7use URI::Escape qw(uri_unescape);
8
9sub default_port { 110 }
10
11#pop://<user>;auth=<auth>@<host>:<port>
12
13sub user
14{
15 my $self = shift;
16 my $old = $self->userinfo;
17
18 if (@_) {
19 my $new_info = $old;
20 $new_info = "" unless defined $new_info;
21 $new_info =~ s/^[^;]*//;
22
23 my $new = shift;
24 if (!defined($new) && !length($new_info)) {
25 $self->userinfo(undef);
26 } else {
27 $new = "" unless defined $new;
28 $new =~ s/%/%25/g;
29 $new =~ s/;/%3B/g;
30 $self->userinfo("$new$new_info");
31 }
32 }
33
34 return unless defined $old;
35 $old =~ s/;.*//;
36 return uri_unescape($old);
37}
38
39sub auth
40{
41 my $self = shift;
42 my $old = $self->userinfo;
43
44 if (@_) {
45 my $new = $old;
46 $new = "" unless defined $new;
47 $new =~ s/(^[^;]*)//;
48 my $user = $1;
49 $new =~ s/;auth=[^;]*//i;
50
51
52 my $auth = shift;
53 if (defined $auth) {
54 $auth =~ s/%/%25/g;
55 $auth =~ s/;/%3B/g;
56 $new = ";AUTH=$auth$new";
57 }
58 $self->userinfo("$user$new");
59
60 }
61
62 return unless defined $old;
63 $old =~ s/^[^;]*//;
64 return uri_unescape($1) if $old =~ /;auth=(.*)/i;
65 return;
66}
67
681;