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     package shellwords;
  13     local($_) = join('', @_) if @_;
  14     local(@words,$snippet,$field);
  15
  16     s/^\s+//;
  17     while ($_ ne '') {
  18         $field = '';
  19         for (;;) {
  20             use re 'taint'; # leave strings tainted
  21             if (s/^"(([^"\\]|\\.)*)"//) {
  22                 ($snippet = $1) =~ s#\\(.)#$1#g;
  23             }
  24             elsif (/^"/) {
  25                 die "Unmatched double quote: $_\n";
  26             }
  27             elsif (s/^'(([^'\\]|\\.)*)'//) {
  28                 ($snippet = $1) =~ s#\\(.)#$1#g;
  29             }
  30             elsif (/^'/) {
  31                 die "Unmatched single quote: $_\n";
  32             }
  33             elsif (s/^\\(.)//) {
  34                 $snippet = $1;
  35             }
  36             elsif (s/^([^\s\\'"]+)//) {
  37                 $snippet = $1;
  38             }
  39             else {
  40                 s/^\s+//;
  41                 last;
  42             }
  43             $field .= $snippet;
  44         }
  45         push(@words, $field);
  46     }
  47     @words;
  48 }
  49 1;