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   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;