This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
There was no need to bump $Text::ParseWords::VERSION to 3.24
[perl5.git] / lib / Text / ParseWords.pm
1 package Text::ParseWords;
2
3 use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE);
4 $VERSION = "3.23";
5
6 require 5.000;
7
8 use Exporter;
9 @ISA = qw(Exporter);
10 @EXPORT = qw(shellwords quotewords nested_quotewords parse_line);
11 @EXPORT_OK = qw(old_shellwords);
12
13
14 sub shellwords {
15     local(@lines) = @_;
16     $lines[$#lines] =~ s/\s+$//;
17     return(quotewords('\s+', 0, @lines));
18 }
19
20
21
22 sub quotewords {
23     my($delim, $keep, @lines) = @_;
24     my($line, @words, @allwords);
25     
26
27     foreach $line (@lines) {
28         @words = parse_line($delim, $keep, $line);
29         return() unless (@words || !length($line));
30         push(@allwords, @words);
31     }
32     return(@allwords);
33 }
34
35
36
37 sub nested_quotewords {
38     my($delim, $keep, @lines) = @_;
39     my($i, @allwords);
40     
41     for ($i = 0; $i < @lines; $i++) {
42         @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
43         return() unless (@{$allwords[$i]} || !length($lines[$i]));
44     }
45     return(@allwords);
46 }
47
48
49
50 sub parse_line {
51         # We will be testing undef strings
52         no warnings;
53         use re 'taint'; # if it's tainted, leave it as such
54
55     my($delimiter, $keep, $line) = @_;
56     my($word, @pieces);
57
58     while (length($line)) {
59         $line =~ s/^(["'])                      # a $quote
60                     ((?:\\.|(?!\1)[^\\])*)      # and $quoted text
61                     \1                          # followed by the same quote
62                    |                            # --OR--
63                    ^((?:\\.|[^\\"'])*?)         # an $unquoted text
64                     (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["']))  
65                                                 # plus EOL, delimiter, or quote
66                   //xs;                         # extended layout
67         my($quote, $quoted, $unquoted, $delim) = ($1, $2, $3, $4);
68         return() unless( defined($quote) || length($unquoted) || length($delim));
69
70         if ($keep) {
71             $quoted = "$quote$quoted$quote";
72         }
73         else {
74             $unquoted =~ s/\\(.)/$1/sg;
75             if (defined $quote) {
76                 $quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
77                 $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
78             }
79         }
80         $word .= defined $quote ? $quoted : $unquoted;
81  
82         if (length($delim)) {
83             push(@pieces, $word);
84             push(@pieces, $delim) if ($keep eq 'delimiters');
85             undef $word;
86         }
87         if (!length($line)) {
88             push(@pieces, $word);
89         }
90     }
91     return(@pieces);
92 }
93
94
95
96 sub old_shellwords {
97
98     # Usage:
99     #   use ParseWords;
100     #   @words = old_shellwords($line);
101     #   or
102     #   @words = old_shellwords(@lines);
103
104     local($_) = join('', @_);
105     my(@words,$snippet,$field);
106
107     s/^\s+//;
108     while ($_ ne '') {
109         $field = '';
110         for (;;) {
111             if (s/^"(([^"\\]|\\.)*)"//) {
112                 ($snippet = $1) =~ s#\\(.)#$1#g;
113             }
114             elsif (/^"/) {
115                 return();
116             }
117             elsif (s/^'(([^'\\]|\\.)*)'//) {
118                 ($snippet = $1) =~ s#\\(.)#$1#g;
119             }
120             elsif (/^'/) {
121                 return();
122             }
123             elsif (s/^\\(.)//) {
124                 $snippet = $1;
125             }
126             elsif (s/^([^\s\\'"]+)//) {
127                 $snippet = $1;
128             }
129             else {
130                 s/^\s+//;
131                 last;
132             }
133             $field .= $snippet;
134         }
135         push(@words, $field);
136     }
137     @words;
138 }
139
140 1;
141
142 __END__
143
144 =head1 NAME
145
146 Text::ParseWords - parse text into an array of tokens or array of arrays
147
148 =head1 SYNOPSIS
149
150   use Text::ParseWords;
151   @lists = &nested_quotewords($delim, $keep, @lines);
152   @words = &quotewords($delim, $keep, @lines);
153   @words = &shellwords(@lines);
154   @words = &parse_line($delim, $keep, $line);
155   @words = &old_shellwords(@lines); # DEPRECATED!
156
157 =head1 DESCRIPTION
158
159 The &nested_quotewords() and &quotewords() functions accept a delimiter 
160 (which can be a regular expression)
161 and a list of lines and then breaks those lines up into a list of
162 words ignoring delimiters that appear inside quotes.  &quotewords()
163 returns all of the tokens in a single long list, while &nested_quotewords()
164 returns a list of token lists corresponding to the elements of @lines.
165 &parse_line() does tokenizing on a single string.  The &*quotewords()
166 functions simply call &parse_line(), so if you're only splitting
167 one line you can call &parse_line() directly and save a function
168 call.
169
170 The $keep argument is a boolean flag.  If true, then the tokens are
171 split on the specified delimiter, but all other characters (quotes,
172 backslashes, etc.) are kept in the tokens.  If $keep is false then the
173 &*quotewords() functions remove all quotes and backslashes that are
174 not themselves backslash-escaped or inside of single quotes (i.e.,
175 &quotewords() tries to interpret these characters just like the Bourne
176 shell).  NB: these semantics are significantly different from the
177 original version of this module shipped with Perl 5.000 through 5.004.
178 As an additional feature, $keep may be the keyword "delimiters" which
179 causes the functions to preserve the delimiters in each string as
180 tokens in the token lists, in addition to preserving quote and
181 backslash characters.
182
183 &shellwords() is written as a special case of &quotewords(), and it
184 does token parsing with whitespace as a delimiter-- similar to most
185 Unix shells.
186
187 =head1 EXAMPLES
188
189 The sample program:
190
191   use Text::ParseWords;
192   @words = &quotewords('\s+', 0, q{this   is "a test" of\ quotewords \"for you});
193   $i = 0;
194   foreach (@words) {
195       print "$i: <$_>\n";
196       $i++;
197   }
198
199 produces:
200
201   0: <this>
202   1: <is>
203   2: <a test>
204   3: <of quotewords>
205   4: <"for>
206   5: <you>
207
208 demonstrating:
209
210 =over 4
211
212 =item 0
213
214 a simple word
215
216 =item 1
217
218 multiple spaces are skipped because of our $delim
219
220 =item 2
221
222 use of quotes to include a space in a word
223
224 =item 3
225
226 use of a backslash to include a space in a word
227
228 =item 4
229
230 use of a backslash to remove the special meaning of a double-quote
231
232 =item 5
233
234 another simple word (note the lack of effect of the
235 backslashed double-quote)
236
237 =back
238
239 Replacing C<&quotewords('\s+', 0, q{this   is...})>
240 with C<&shellwords(q{this   is...})>
241 is a simpler way to accomplish the same thing.
242
243 =head1 AUTHORS
244
245 Maintainer is Hal Pomeranz <pomeranz@netcom.com>, 1994-1997 (Original
246 author unknown).  Much of the code for &parse_line() (including the
247 primary regexp) from Joerk Behrends <jbehrends@multimediaproduzenten.de>.
248
249 Examples section another documentation provided by John Heidemann 
250 <johnh@ISI.EDU>
251
252 Bug reports, patches, and nagging provided by lots of folks-- thanks
253 everybody!  Special thanks to Michael Schwern <schwern@envirolink.org>
254 for assuring me that a &nested_quotewords() would be useful, and to 
255 Jeff Friedl <jfriedl@yahoo-inc.com> for telling me not to worry about
256 error-checking (sort of-- you had to be there).
257
258 =cut