home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _9ed7652024af07be134638b4ca6b4015 < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.2 KB  |  69 lines
  1. package URI::pop;   # RFC 2384
  2.  
  3. require URI::_server;
  4. @ISA=qw(URI::_server);
  5.  
  6. use strict;
  7. use URI::Escape qw(uri_unescape);
  8.  
  9. sub default_port { 110 }
  10.  
  11. #pop://<user>;auth=<auth>@<host>:<port>
  12.  
  13. sub 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.  
  39. sub 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.  
  68. 1;
  69.