source: main/trunk/greenstone2/perllib/cpan/URI/pop.pm@ 27174

Last change on this file since 27174 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: 1.1 KB
Line 
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;
Note: See TracBrowser for help on using the repository browser.