lib/Text/ParseWords.pm

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