lib/Text/ParseWords.pm

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