lib/shellwords.pl

   1 ;# shellwords.pl
   2 ;#
   3 ;# Usage:
   4 ;#      require 'shellwords.pl';
   5 ;#      @words = shellwords($line);
   6 ;#      or
   7 ;#      @words = shellwords(@lines);
   8 ;#      or
   9 ;#      @words = shellwords();          # defaults to $_ (and clobbers it)
  10
  11 sub shellwords {
  12     local *_ = \join('', @_) if @_;
  13     my (@words, $snippet);
  14
  15     s/\A\s+//;
  16     while ($_ ne '') {
  17         my $field = substr($_, 0, 0);   # leave results tainted
  18         for (;;) {
  19             if (s/\A"(([^"\\]|\\.)*)"//s) {
  20                 ($snippet = $1) =~ s#\\(.)#$1#sg;
  21             }
  22             elsif (/\A"/) {
  23                 die "Unmatched double quote: $_\n";
  24             }
  25             elsif (s/\A'(([^'\\]|\\.)*)'//s) {
  26                 ($snippet = $1) =~ s#\\(.)#$1#sg;
  27             }
  28             elsif (/\A'/) {
  29                 die "Unmatched single quote: $_\n";
  30             }
  31             elsif (s/\A\\(.)//s) {
  32                 $snippet = $1;
  33             }
  34             elsif (s/\A([^\s\\'"]+)//) {
  35                 $snippet = $1;
  36             }
  37             else {
  38                 s/\A\s+//;
  39                 last;
  40             }
  41             $field .= $snippet;
  42         }
  43         push(@words, $field);
  44     }
  45     return @words;
  46 }
  47 1;