home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl / 5.8.8 / Text / ParseWords.pm < prev    next >
Encoding:
Perl POD Document  |  2006-07-07  |  3.2 KB  |  140 lines
  1. package Text::ParseWords;
  2.  
  3. use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE);
  4. $VERSION = "3.24";
  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. sub shellwords {
  14.     my(@lines) = @_;
  15.     $lines[$#lines] =~ s/\s+$//;
  16.     return(quotewords('\s+', 0, @lines));
  17. }
  18.  
  19. sub quotewords {
  20.     my($delim, $keep, @lines) = @_;
  21.     my($line, @words, @allwords);
  22.  
  23.     foreach $line (@lines) {
  24.     @words = parse_line($delim, $keep, $line);
  25.     return() unless (@words || !length($line));
  26.     push(@allwords, @words);
  27.     }
  28.     return(@allwords);
  29. }
  30.  
  31. sub nested_quotewords {
  32.     my($delim, $keep, @lines) = @_;
  33.     my($i, @allwords);
  34.  
  35.     for ($i = 0; $i < @lines; $i++) {
  36.     @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
  37.     return() unless (@{$allwords[$i]} || !length($lines[$i]));
  38.     }
  39.     return(@allwords);
  40. }
  41.  
  42. sub parse_line {
  43.     my($delimiter, $keep, $line) = @_;
  44.     my($word, @pieces);
  45.  
  46.     no warnings 'uninitialized';    # we will be testing undef strings
  47.  
  48.     while (length($line)) {
  49.     $line =~ s/^(["'])            # a $quote
  50.                 ((?:\\.|(?!\1)[^\\])*)    # and $quoted text
  51.             \1                # followed by the same quote
  52.            |                # --OR--
  53.            ^((?:\\.|[^\\"'])*?)        # an $unquoted text
  54.             (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["']))  
  55.                             # plus EOL, delimiter, or quote
  56.           //xs or return;        # extended layout
  57.     my($quote, $quoted, $unquoted, $delim) = ($1, $2, $3, $4);
  58.     return() unless( defined($quote) || length($unquoted) || length($delim));
  59.  
  60.         if ($keep) {
  61.         $quoted = "$quote$quoted$quote";
  62.     }
  63.         else {
  64.         $unquoted =~ s/\\(.)/$1/sg;
  65.         if (defined $quote) {
  66.         $quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
  67.         $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
  68.             }
  69.     }
  70.         $word .= substr($line, 0, 0);    # leave results tainted
  71.         $word .= defined $quote ? $quoted : $unquoted;
  72.  
  73.         if (length($delim)) {
  74.             push(@pieces, $word);
  75.             push(@pieces, $delim) if ($keep eq 'delimiters');
  76.             undef $word;
  77.         }
  78.         if (!length($line)) {
  79.             push(@pieces, $word);
  80.     }
  81.     }
  82.     return(@pieces);
  83. }
  84.  
  85. sub old_shellwords {
  86.  
  87.     # Usage:
  88.     #    use ParseWords;
  89.     #    @words = old_shellwords($line);
  90.     #    or
  91.     #    @words = old_shellwords(@lines);
  92.     #    or
  93.     #    @words = old_shellwords();    # defaults to $_ (and clobbers it)
  94.  
  95.     no warnings 'uninitialized';    # we will be testing undef strings
  96.     local *_ = \join('', @_) if @_;
  97.     my (@words, $snippet);
  98.  
  99.     s/\A\s+//;
  100.     while ($_ ne '') {
  101.     my $field = substr($_, 0, 0);    # leave results tainted
  102.     for (;;) {
  103.         if (s/\A"(([^"\\]|\\.)*)"//s) {
  104.         ($snippet = $1) =~ s#\\(.)#$1#sg;
  105.         }
  106.         elsif (/\A"/) {
  107.         require Carp;
  108.         Carp::carp("Unmatched double quote: $_");
  109.         return();
  110.         }
  111.         elsif (s/\A'(([^'\\]|\\.)*)'//s) {
  112.         ($snippet = $1) =~ s#\\(.)#$1#sg;
  113.         }
  114.         elsif (/\A'/) {
  115.         require Carp;
  116.         Carp::carp("Unmatched single quote: $_");
  117.         return();
  118.         }
  119.         elsif (s/\A\\(.)//s) {
  120.         $snippet = $1;
  121.         }
  122.         elsif (s/\A([^\s\\'"]+)//) {
  123.         $snippet = $1;
  124.         }
  125.         else {
  126.         s/\A\s+//;
  127.         last;
  128.         }
  129.         $field .= $snippet;
  130.     }
  131.     push(@words, $field);
  132.     }
  133.     return @words;
  134. }
  135.  
  136. 1;
  137.  
  138. __END__
  139.  
  140.