home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / ParseWords.pm < prev    next >
Text File  |  2005-01-27  |  6KB  |  259 lines

  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 = "ewords($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 "ewords() 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.  "ewords()
  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. "ewords() 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 "ewords(), 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 = "ewords('\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<"ewords('\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
  259.