File Coverage

blib/lib/Net/OpenSSH/ShellQuoter/POSIX.pm
Criterion Covered Total %
statement 14 32 43.7
branch 7 24 29.1
condition 0 2 0.0
subroutine 5 7 71.4
pod 0 4 0.0
total 26 69 37.6


line stmt bran cond sub pod time code
1             package Net::OpenSSH::ShellQuoter::POSIX;
2              
3 4     4   29 use strict;
  4         7  
  4         178  
4 4     4   23 use warnings;
  4         8  
  4         178  
5 4     4   21 use Carp;
  4         7  
  4         2882  
6              
7 6     6 0 34 sub new { __PACKAGE__ }
8              
9             my $noquote_class = '.\\w/\\-@,:';
10             my $glob_class = '*?\\[\\],\\{\\}:!^~';
11              
12             sub quote {
13 1833     1833 0 3133414 shift;
14             my $quoted = join '',
15 1833 100       9056 map { ( m|\A'\z| ? "\\'" :
  4578 100       31627  
    100          
16             m|\A'| ? "\"$_\"" :
17             m|\A[$noquote_class]+\z|o ? $_ :
18             "'$_'" )
19             } split /('+)/, $_[0];
20 1833 50       10945 length $quoted ? $quoted : "''";
21             }
22              
23              
24             sub quote_glob {
25 0     0 0   shift;
26 0           my $arg = shift;
27 0           my @parts;
28 0   0       while ((pos $arg ||0) < length $arg) {
29 0 0         if ($arg =~ m|\G('+)|gc) {
    0          
    0          
    0          
    0          
30 0 0         push @parts, (length($1) > 1 ? "\"$1\"" : "\\'");
31             }
32             elsif ($arg =~ m|\G([$noquote_class$glob_class]+)|gco) {
33 0           push @parts, $1;
34             }
35             elsif ($arg =~ m|\G(\\[$glob_class\\])|gco) {
36 0           push @parts, $1;
37             }
38             elsif ($arg =~ m|\G\\|gc) {
39 0           push @parts, '\\\\'
40             }
41             elsif ($arg =~ m|\G([^$glob_class\\']+)|gco) {
42 0           push @parts, "'$1'";
43             }
44             else {
45 0           require Data::Dumper;
46 0           $arg =~ m|\G(.+)|gc;
47 0           die "Internal error: unquotable string:\n". Data::Dumper::Dumper($1) ."\n";
48             }
49             }
50 0           my $quoted = join('', @parts);
51 0 0         length $quoted ? $quoted : "''";
52             }
53              
54             my %fragments = ( stdin_discard => '
55             stdout_discard => '>/dev/null',
56             stderr_discard => '2>/dev/null',
57             stdout_and_stderr_discard => '>/dev/null 2>&1',
58             stderr_to_stdout => '2>&1' );
59              
60             sub shell_fragments {
61 0     0 0   shift;
62 0           my @f = grep defined, @fragments{@_};
63 0 0         wantarray ? @f : join(' ', @f);
64             }
65              
66             1;