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