home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Text / ParseWords.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  4.4 KB  |  167 lines
  1. package Text::ParseWords;
  2.  
  3. use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE);
  4. $VERSION = "3.26";
  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.     my @allwords;
  16.  
  17.     foreach my $line (@lines) {
  18.     $line =~ s/^\s+//;
  19.     my @words = parse_line('\s+', 0, $line);
  20.     pop @words if (@words and !defined $words[-1]);
  21.     return() unless (@words || !length($line));
  22.     push(@allwords, @words);
  23.     }
  24.     return(@allwords);
  25. }
  26.  
  27. sub quotewords {
  28.     my($delim, $keep, @lines) = @_;
  29.     my($line, @words, @allwords);
  30.  
  31.     foreach $line (@lines) {
  32.     @words = parse_line($delim, $keep, $line);
  33.     return() unless (@words || !length($line));
  34.     push(@allwords, @words);
  35.     }
  36.     return(@allwords);
  37. }
  38.  
  39. sub nested_quotewords {
  40.     my($delim, $keep, @lines) = @_;
  41.     my($i, @allwords);
  42.  
  43.     for ($i = 0; $i < @lines; $i++) {
  44.     @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
  45.     return() unless (@{$allwords[$i]} || !length($lines[$i]));
  46.     }
  47.     return(@allwords);
  48. }
  49.  
  50. sub parse_line {
  51.     my($delimiter, $keep, $line) = @_;
  52.     my($word, @pieces);
  53.  
  54.     no warnings 'uninitialized';    # we will be testing undef strings
  55.  
  56.     while (length($line)) {
  57.         # This pattern is optimised to be stack conservative on older perls.
  58.         # Do not refactor without being careful and testing it on very long strings.
  59.         # See Perl bug #42980 for an example of a stack busting input.
  60.         $line =~ s/^
  61.                     (?: 
  62.                         # double quoted string
  63.                         (")                             # $quote
  64.                         ((?>[^\\"]*(?:\\.[^\\"]*)*))"   # $quoted 
  65.             |    # --OR--
  66.                         # singe quoted string
  67.                         (')                             # $quote
  68.                         ((?>[^\\']*(?:\\.[^\\']*)*))'   # $quoted
  69.                     |   # --OR--
  70.                         # unquoted string
  71.                 (                               # $unquoted 
  72.                             (?:\\.|[^\\"'])*?           
  73.                         )        
  74.                         # followed by
  75.                 (                               # $delim
  76.                             \Z(?!\n)                    # EOL
  77.                         |   # --OR--
  78.                             (?-x:$delimiter)            # delimiter
  79.                         |   # --OR--                    
  80.                             (?!^)(?=["'])               # a quote
  81.                         )  
  82.             )//xs or return;        # extended layout                  
  83.         my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6);
  84.  
  85.     return() unless( defined($quote) || length($unquoted) || length($delim));
  86.  
  87.         if ($keep) {
  88.         $quoted = "$quote$quoted$quote";
  89.     }
  90.         else {
  91.         $unquoted =~ s/\\(.)/$1/sg;
  92.         if (defined $quote) {
  93.         $quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
  94.         $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
  95.             }
  96.     }
  97.         $word .= substr($line, 0, 0);    # leave results tainted
  98.         $word .= defined $quote ? $quoted : $unquoted;
  99.  
  100.         if (length($delim)) {
  101.             push(@pieces, $word);
  102.             push(@pieces, $delim) if ($keep eq 'delimiters');
  103.             undef $word;
  104.         }
  105.         if (!length($line)) {
  106.             push(@pieces, $word);
  107.     }
  108.     }
  109.     return(@pieces);
  110. }
  111.  
  112. sub old_shellwords {
  113.  
  114.     # Usage:
  115.     #    use ParseWords;
  116.     #    @words = old_shellwords($line);
  117.     #    or
  118.     #    @words = old_shellwords(@lines);
  119.     #    or
  120.     #    @words = old_shellwords();    # defaults to $_ (and clobbers it)
  121.  
  122.     no warnings 'uninitialized';    # we will be testing undef strings
  123.     local *_ = \join('', @_) if @_;
  124.     my (@words, $snippet);
  125.  
  126.     s/\A\s+//;
  127.     while ($_ ne '') {
  128.     my $field = substr($_, 0, 0);    # leave results tainted
  129.     for (;;) {
  130.         if (s/\A"(([^"\\]|\\.)*)"//s) {
  131.         ($snippet = $1) =~ s#\\(.)#$1#sg;
  132.         }
  133.         elsif (/\A"/) {
  134.         require Carp;
  135.         Carp::carp("Unmatched double quote: $_");
  136.         return();
  137.         }
  138.         elsif (s/\A'(([^'\\]|\\.)*)'//s) {
  139.         ($snippet = $1) =~ s#\\(.)#$1#sg;
  140.         }
  141.         elsif (/\A'/) {
  142.         require Carp;
  143.         Carp::carp("Unmatched single quote: $_");
  144.         return();
  145.         }
  146.         elsif (s/\A\\(.?)//s) {
  147.         $snippet = $1;
  148.         }
  149.         elsif (s/\A([^\s\\'"]+)//) {
  150.         $snippet = $1;
  151.         }
  152.         else {
  153.         s/\A\s+//;
  154.         last;
  155.         }
  156.         $field .= $snippet;
  157.     }
  158.     push(@words, $field);
  159.     }
  160.     return @words;
  161. }
  162.  
  163. 1;
  164.  
  165. __END__
  166.  
  167.