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; 69