line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::SSH::Patch::URI::ssh; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
26
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
5
|
1
|
|
|
1
|
|
4
|
no warnings 'redefine'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
513
|
|
6
|
|
|
|
|
|
|
require URI::Escape; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
require URI::ssh; |
9
|
|
|
|
|
|
|
unless (URI::ssh->can('c_params')) { |
10
|
|
|
|
|
|
|
package |
11
|
|
|
|
|
|
|
URI::ssh; # don't index me PAUSE! |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
*sshinfo = sub { |
14
|
0
|
|
|
0
|
|
|
my $self = shift; |
15
|
0
|
|
|
|
|
|
my $old = $self->authority; |
16
|
|
|
|
|
|
|
|
17
|
0
|
0
|
|
|
|
|
if (@_) { |
18
|
0
|
|
|
|
|
|
my $new = $old; |
19
|
0
|
0
|
|
|
|
|
$new = "" unless defined $new; |
20
|
0
|
|
|
|
|
|
$new =~ s/.*@//; # remove old stuff |
21
|
0
|
|
|
|
|
|
my $si = shift; |
22
|
0
|
0
|
|
|
|
|
if (defined $si) { |
23
|
0
|
|
|
|
|
|
$si =~ s/@/%40/g; # protect @ |
24
|
0
|
|
|
|
|
|
$new = "$si\@$new"; |
25
|
|
|
|
|
|
|
} |
26
|
0
|
|
|
|
|
|
$self->authority($new); |
27
|
|
|
|
|
|
|
} |
28
|
0
|
0
|
0
|
|
|
|
return undef if !defined($old) || $old !~ /(.*)@/; |
29
|
0
|
|
|
|
|
|
return $1; |
30
|
|
|
|
|
|
|
}; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
*userinfo = sub { |
33
|
0
|
|
|
0
|
|
|
my $self = shift; |
34
|
0
|
|
|
|
|
|
my $old = $self->sshinfo; |
35
|
|
|
|
|
|
|
|
36
|
0
|
0
|
|
|
|
|
if (@_) { |
37
|
0
|
|
|
|
|
|
my $new = $old; |
38
|
0
|
0
|
|
|
|
|
$new = "" unless defined $new; |
39
|
0
|
|
|
|
|
|
$new =~ s/^[^;]*//; # remove old stuff |
40
|
0
|
|
|
|
|
|
my $ui = shift; |
41
|
0
|
0
|
|
|
|
|
if (defined $ui) { |
42
|
0
|
|
|
|
|
|
$ui =~ s/;/%3B/g; # protect ; |
43
|
0
|
|
|
|
|
|
$new = "$ui$new"; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
else { |
46
|
0
|
0
|
|
|
|
|
$new = undef unless length $new; |
47
|
|
|
|
|
|
|
} |
48
|
0
|
|
|
|
|
|
$self->sshinfo($new); |
49
|
|
|
|
|
|
|
} |
50
|
0
|
0
|
0
|
|
|
|
return undef if !defined($old) || $old !~ /^([^;]+)/; |
51
|
0
|
|
|
|
|
|
return $1; |
52
|
|
|
|
|
|
|
}; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
*c_params = sub { |
55
|
0
|
|
|
0
|
|
|
my $self = shift; |
56
|
0
|
|
|
|
|
|
my $old = $self->sshinfo; |
57
|
0
|
0
|
|
|
|
|
if (@_) { |
58
|
0
|
|
|
|
|
|
my $new = $old; |
59
|
0
|
0
|
|
|
|
|
$new = "" unless defined $new; |
60
|
0
|
|
|
|
|
|
$new =~ s/;.*//; # remove old stuff |
61
|
0
|
|
|
|
|
|
my $cp = shift; |
62
|
0
|
0
|
|
|
|
|
$cp = [] unless defined $cp; |
63
|
0
|
0
|
|
|
|
|
$cp = [$cp] unless ref $cp; |
64
|
0
|
0
|
|
|
|
|
if (@$cp) { |
65
|
0
|
|
|
|
|
|
my @cp = @$cp; |
66
|
0
|
|
|
|
|
|
for (@cp) { |
67
|
0
|
|
|
|
|
|
s/%/%25/g; |
68
|
0
|
|
|
|
|
|
s/,/%2C/g; |
69
|
0
|
|
|
|
|
|
s/;/%3B/g; |
70
|
|
|
|
|
|
|
} |
71
|
0
|
|
|
|
|
|
$new .= ';' . join(',', @cp); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
else { |
74
|
0
|
0
|
|
|
|
|
$new = undef unless length $new; |
75
|
|
|
|
|
|
|
} |
76
|
0
|
|
|
|
|
|
$self->sshinfo($new); |
77
|
|
|
|
|
|
|
} |
78
|
0
|
0
|
0
|
|
|
|
return undef if !defined($old) || $old !~ /;(.+)/; |
79
|
0
|
|
|
|
|
|
[map URI::Escape::uri_unescape($_), split /,/, $1]; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
}; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
1; |