File Coverage

blib/lib/URI/_userpass.pm
Criterion Covered Total %
statement 37 38 97.3
branch 21 24 87.5
condition 2 3 66.6
subroutine 5 5 100.0
pod 0 2 0.0
total 65 72 90.2


line stmt bran cond sub pod time code
1             package URI::_userpass;
2              
3 16     16   8290 use strict;
  16         35  
  16         672  
4 16     16   77 use warnings;
  16         71  
  16         1053  
5              
6 16     16   118 use URI::Escape qw(uri_unescape);
  16         27  
  16         9113  
7              
8             our $VERSION = '5.34';
9              
10             sub user
11             {
12 42     42 0 85 my $self = shift;
13 42         171 my $info = $self->userinfo;
14 42 100       106 if (@_) {
15 10         24 my $new = shift;
16 10 100       30 my $pass = defined($info) ? $info : "";
17 10         73 $pass =~ s/^[^:]*//;
18              
19 10 50 66     46 if (!defined($new) && !length($pass)) {
20 0         0 $self->userinfo(undef);
21             } else {
22 10 100       25 $new = "" unless defined($new);
23 10         20 $new =~ s/%/%25/g;
24 10         17 $new =~ s/:/%3A/g;
25 10         42 $self->userinfo("$new$pass");
26             }
27             }
28 42 100       97 return undef unless defined $info;
29 29         171 $info =~ s/:.*//;
30 29         124 uri_unescape($info);
31             }
32              
33             sub password
34             {
35 24     24 0 50 my $self = shift;
36 24         122 my $info = $self->userinfo;
37 24 100       68 if (@_) {
38 9         23 my $new = shift;
39 9 50       32 my $user = defined($info) ? $info : "";
40 9         33 $user =~ s/:.*//;
41              
42 9 100       26 if (!defined($new)) {
43 3 100       15 $self->userinfo(length $user ? $user : undef);
44             } else {
45 6 50       19 $new = "" unless defined($new);
46 6         12 $new =~ s/%/%25/g;
47 6         28 $self->userinfo("$user:$new");
48             }
49             }
50 24 100       70 return undef unless defined $info;
51 20 100       122 return undef unless $info =~ s/^[^:]*://;
52 13         47 uri_unescape($info);
53             }
54              
55             1;