File Coverage

blib/lib/Test/SSH/Patch/URI/ssh.pm
Criterion Covered Total %
statement 9 56 16.0
branch 0 32 0.0
condition 0 9 0.0
subroutine 3 6 50.0
pod n/a
total 12 103 11.6


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