home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / auto / Text / ParseWords / quotewords.al < prev    next >
Encoding:
Text File  |  1997-06-22  |  2.3 KB  |  78 lines  |  [TEXT/McPL]
  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.     my ($delim, $keep, @lines) = @_;
  33.     my (@words, $snippet, $field);
  34.  
  35.     local $_ = join ('', @lines);
  36.  
  37.     while (length) {
  38.     $field = '';
  39.  
  40.     for (;;) {
  41.         $snippet = '';
  42.  
  43.         if (s/^"([^"\\]*(\\.[^"\\]*)*)"//) {
  44.         $snippet = $1;
  45.         $snippet = qq|"$snippet"| if $keep;
  46.         }
  47.         elsif (s/^'([^'\\]*(\\.[^'\\]*)*)'//) {
  48.         $snippet = $1;
  49.         $snippet = "'$snippet'" if $keep;
  50.         }
  51.         elsif (/^["']/) {
  52.         croak 'Unmatched quote';
  53.         }
  54.         elsif (s/^\\(.)//) {
  55.         $snippet = $1;
  56.         $snippet = "\\$snippet" if $keep;
  57.         }
  58.         elsif (!length || s/^$delim//) {
  59.            last;
  60.         }
  61.         else {
  62.         while (length && !(/^$delim/ || /^['"\\]/)) {
  63.            $snippet .= substr ($_, 0, 1);
  64.            substr($_, 0, 1) = '';
  65.         }
  66.         }
  67.  
  68.         $field .= $snippet;
  69.     }
  70.  
  71.     push @words, $field;
  72.     }
  73.  
  74.     return @words;
  75. }
  76.  
  77. 1;
  78.