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