File Coverage

blib/lib/Text/ParseWords.pm
Criterion Covered Total %
statement 74 82 90.2
branch 38 44 86.3
condition 17 21 80.9
subroutine 10 10 100.0
pod 0 5 0.0
total 139 162 85.8


line stmt bran cond sub pod time code
1             package Text::ParseWords;
2              
3 2     2   996 use strict;
  2         9  
  2         46  
4 2     2   8 use warnings;
  2         4  
  2         66  
5             require 5.006;
6             our $VERSION = "3.30_02";
7              
8              
9 2     2   8 use Exporter;
  2         3  
  2         775  
10             our @ISA = qw(Exporter);
11             our @EXPORT = qw(shellwords quotewords nested_quotewords parse_line);
12             our @EXPORT_OK = qw(old_shellwords);
13             our $PERL_SINGLE_QUOTE;
14              
15              
16             sub shellwords {
17 5     5 0 2586 my (@lines) = @_;
18 5         7 my @allwords;
19              
20 5         9 foreach my $line (@lines) {
21 7         20 $line =~ s/^\s+//;
22 7         16 my @words = parse_line('\s+', 0, $line);
23 7 100 100     26 pop @words if (@words and !defined $words[-1]);
24 7 100 66     24 return() unless (@words || !length($line));
25 5         12 push(@allwords, @words);
26             }
27 3         18 return(@allwords);
28             }
29              
30              
31              
32             sub quotewords {
33 4     4 0 2728 my($delim, $keep, @lines) = @_;
34 4         7 my($line, @words, @allwords);
35              
36 4         5 foreach $line (@lines) {
37 4         9 @words = parse_line($delim, $keep, $line);
38 4 100 66     16 return() unless (@words || !length($line));
39 3         8 push(@allwords, @words);
40             }
41 3         12 return(@allwords);
42             }
43              
44              
45              
46             sub nested_quotewords {
47 2     2 0 856 my($delim, $keep, @lines) = @_;
48 2         3 my($i, @allwords);
49              
50 2         8 for ($i = 0; $i < @lines; $i++) {
51 4         8 @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
  4         9  
52 4 100 66     5 return() unless (@{$allwords[$i]} || !length($lines[$i]));
  4         16  
53             }
54 1         3 return(@allwords);
55             }
56              
57              
58              
59             sub parse_line {
60 26     26 0 4663 my($delimiter, $keep, $line) = @_;
61 26         36 my($word, @pieces);
62              
63 2     2   14 no warnings 'uninitialized'; # we will be testing undef strings
  2         2  
  2         567  
64              
65 26         54 while (length($line)) {
66             # This pattern is optimised to be stack conservative on older perls.
67             # Do not refactor without being careful and testing it on very long strings.
68             # See Perl bug #42980 for an example of a stack busting input.
69 106 100       1355 $line =~ s/^
70             (?:
71             # double quoted string
72             (") # $quote
73             ((?>[^\\"]*(?:\\.[^\\"]*)*))" # $quoted
74             | # --OR--
75             # singe quoted string
76             (') # $quote
77             ((?>[^\\']*(?:\\.[^\\']*)*))' # $quoted
78             | # --OR--
79             # unquoted string
80             ( # $unquoted
81             (?:\\.|[^\\"'])*?
82             )
83             # followed by
84             ( # $delim
85             \Z(?!\n) # EOL
86             | # --OR--
87             (?-x:$delimiter) # delimiter
88             | # --OR--
89             (?!^)(?=["']) # a quote
90             )
91             )//xs or return; # extended layout
92 101 100       328 my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6);
93              
94              
95 101 50 100     278 return() unless( defined($quote) || length($unquoted) || length($delim));
      66        
96              
97 101 100       141 if ($keep) {
98 27         42 $quoted = "$quote$quoted$quote";
99             }
100             else {
101 74         112 $unquoted =~ s/\\(.)/$1/sg;
102 74 100       115 if (defined $quote) {
103 17 100       43 $quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
104 17 100 100     42 $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
105             }
106             }
107 101         142 $word .= substr($line, 0, 0); # leave results tainted
108 101 100       143 $word .= defined $quote ? $quoted : $unquoted;
109            
110 101 100       156 if (length($delim)) {
111 55         75 push(@pieces, $word);
112 55 100       88 push(@pieces, $delim) if ($keep eq 'delimiters');
113 55         64 undef $word;
114             }
115 101 100       198 if (!length($line)) {
116 21         50 push(@pieces, $word);
117             }
118             }
119 21         88 return(@pieces);
120             }
121              
122              
123              
124             sub old_shellwords {
125              
126             # Usage:
127             # use ParseWords;
128             # @words = old_shellwords($line);
129             # or
130             # @words = old_shellwords(@lines);
131             # or
132             # @words = old_shellwords(); # defaults to $_ (and clobbers it)
133              
134 2     2   22 no warnings 'uninitialized'; # we will be testing undef strings
  2         15  
  2         756  
135 2 50   2 0 474 local *_ = \join('', @_) if @_;
136 2         5 my (@words, $snippet);
137              
138 2         7 s/\A\s+//;
139 2         7 while ($_ ne '') {
140 2         6 my $field = substr($_, 0, 0); # leave results tainted
141 2         3 for (;;) {
142 5 50       43 if (s/\A"(([^"\\]|\\.)*)"//s) {
    50          
    50          
    50          
    100          
    100          
143 0         0 ($snippet = $1) =~ s#\\(.)#$1#sg;
144             }
145             elsif (/\A"/) {
146 0         0 require Carp;
147 0         0 Carp::carp("Unmatched double quote: $_");
148 0         0 return();
149             }
150             elsif (s/\A'(([^'\\]|\\.)*)'//s) {
151 0         0 ($snippet = $1) =~ s#\\(.)#$1#sg;
152             }
153             elsif (/\A'/) {
154 0         0 require Carp;
155 0         0 Carp::carp("Unmatched single quote: $_");
156 0         0 return();
157             }
158             elsif (s/\A\\(.?)//s) {
159 1         2 $snippet = $1;
160             }
161             elsif (s/\A([^\s\\'"]+)//) {
162 2         7 $snippet = $1;
163             }
164             else {
165 2         3 s/\A\s+//;
166 2         4 last;
167             }
168 3         6 $field .= $snippet;
169             }
170 2         8 push(@words, $field);
171             }
172 2         8 return @words;
173             }
174              
175             1;
176              
177             __END__