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 or return;               # 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