home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-bin.lha / lib / perl5 / auto / Text / ParseWords / quotewords.al < prev    next >
Text File  |  1996-10-09  |  2KB  |  73 lines
  1. # NOTE: Derived from lib/Text/ParseWords.pm.  Changes made here will be lost.
  2. package Text::ParseWords;
  3.  
  4. sub quotewords {
  5.  
  6. # The inner "for" loop builds up each word (or $field) one $snippet
  7. # at a time.  A $snippet is a quoted string, a backslashed character,
  8. # or an unquoted string.  We fall out of the "for" loop when we reach
  9. # the end of $_ or when we hit a delimiter.  Falling out of the "for"
  10. # loop, we push the $field we've been building up onto the list of
  11. # @words we'll be returning, and then loop back and pull another word
  12. # off of $_.
  13. #
  14. # The first two cases inside the "for" loop deal with quoted strings.
  15. # The first case matches a double quoted string, removes it from $_,
  16. # and assigns the double quoted string to $snippet in the body of the
  17. # conditional.  The second case handles single quoted strings.  In
  18. # the third case we've found a quote at the current beginning of $_,
  19. # but it didn't match the quoted string regexps in the first two cases,
  20. # so it must be an unbalanced quote and we croak with an error (which can
  21. # be caught by eval()).
  22. #
  23. # The next case handles backslashed characters, and the next case is the
  24. # exit case on reaching the end of the string or finding a delimiter.
  25. #
  26. # Otherwise, we've found an unquoted thing and we pull of characters one
  27. # at a time until we reach something that could start another $snippet--
  28. # a quote of some sort, a backslash, or the delimiter.  This one character
  29. # at a time behavior was necessary if the delimiter was going to be a
  30. # regexp (love to hear it if you can figure out a better way).
  31.  
  32.     local($delim, $keep, @lines) = @_;
  33.     local(@words,$snippet,$field,$_);
  34.  
  35.     $_ = join('', @lines);
  36.     while ($_) {
  37.     $field = '';
  38.     for (;;) {
  39.             $snippet = '';
  40.         if (s/^"(([^"\\]|\\[\\"])*)"//) {
  41.         $snippet = $1;
  42.                 $snippet = "\"$snippet\"" if ($keep);
  43.         }
  44.         elsif (s/^'(([^'\\]|\\[\\'])*)'//) {
  45.         $snippet = $1;
  46.                 $snippet = "'$snippet'" if ($keep);
  47.         }
  48.         elsif (/^["']/) {
  49.         croak "Unmatched quote";
  50.         }
  51.             elsif (s/^\\(.)//) {
  52.                 $snippet = $1;
  53.                 $snippet = "\\$snippet" if ($keep);
  54.             }
  55.         elsif (!$_ || s/^$delim//) {
  56.                last;
  57.         }
  58.         else {
  59.                 while ($_ && !(/^$delim/ || /^['"\\]/)) {
  60.            $snippet .=  substr($_, 0, 1);
  61.                    substr($_, 0, 1) = '';
  62.                 }
  63.         }
  64.         $field .= $snippet;
  65.     }
  66.     push(@words, $field);
  67.     }
  68.     @words;
  69. }
  70.  
  71.  
  72. 1;
  73.