git.maemo.org Git - pkg-perl/blob - deb-src/liburi-perl/liburi-perl-1.35.dfsg.1/URI/_userpass.pm

   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;