String::ShellQuote als fallback und abhängigkeit hinzugefügt.

diff --git a/modules/fallback/String/ShellQuote.pm b/modules/fallback/String/ShellQuote.pm
new file mode 100644 (file)
index 0000000..0bd0a35
--- /dev/null
+++ b/modules/fallback/String/ShellQuote.pm
@@ -0,0 +1,197 @@
+# $Id: ShellQuote.pm,v 1.11 2010-06-11 20:08:57 roderick Exp $
+#
+# Copyright (c) 1997 Roderick Schertler.  All rights reserved.  This
+# program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+=head1 NAME
+
+String::ShellQuote - quote strings for passing through the shell
+
+=head1 SYNOPSIS
+
+    $string = shell_quote @list;
+    $string = shell_quote_best_effort @list;
+    $string = shell_comment_quote $string;
+
+=head1 DESCRIPTION
+
+This module contains some functions which are useful for quoting strings
+which are going to pass through the shell or a shell-like object.
+
+=over
+
+=cut
+
+package String::ShellQuote;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+
+require Exporter;
+
+$VERSION    = '1.04';
+@ISA        = qw(Exporter);
+@EXPORT     = qw(shell_quote shell_quote_best_effort shell_comment_quote);
+
+sub croak {
+    require Carp;
+    goto &Carp::croak;
+}
+
+sub _shell_quote_backend {
+    my @in = @_;
+    my @err = ();
+
+    if (0) {
+  require RS::Handy;
+  print RS::Handy::data_dump(\@in);
+    }
+
+    return \@err, '' unless @in;
+
+    my $ret = '';
+    my $saw_non_equal = 0;
+    foreach (@in) {
+  if (!defined $_ or $_ eq '') {
+      $_ = "''";
+      next;
+  }
+
+  if (s/\x00//g) {
+      push @err, "No way to quote string containing null (\\000) bytes";
+  }
+
+      my $escape = 0;
+
+  # = needs quoting when it's the first element (or part of a
+  # series of such elements), as in command position it's a
+  # program-local environment setting
+
+  if (/=/) {
+      if (!$saw_non_equal) {
+        $escape = 1;
+      }
+  }
+  else {
+      $saw_non_equal = 1;
+  }
+
+  if (m|[^\w!%+,\-./:=@^]|) {
+      $escape = 1;
+  }
+
+  if ($escape
+    || (!$saw_non_equal && /=/)) {
+
+      # ' -> '\''
+          s/'/'\\''/g;
+
+      # make multiple ' in a row look simpler
+      # '\'''\'''\'' -> '"'''"'
+          s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;
+
+      $_ = "'$_'";
+      s/^''//;
+      s/''$//;
+  }
+    }
+    continue {
+  $ret .= "$_ ";
+    }
+
+    chop $ret;
+    return \@err, $ret;
+}
+
+=item B<shell_quote> [I<string>]...
+
+B<shell_quote> quotes strings so they can be passed through the shell.
+Each I<string> is quoted so that the shell will pass it along as a
+single argument and without further interpretation.  If no I<string>s
+are given an empty string is returned.
+
+If any I<string> can't be safely quoted B<shell_quote> will B<croak>.
+
+=cut
+
+sub shell_quote {
+    my ($rerr, $s) = _shell_quote_backend @_;
+
+    if (@$rerr) {
+      my %seen;
+      @$rerr = grep { !$seen{$_}++ } @$rerr;
+  my $s = join '', map { "shell_quote(): $_\n" } @$rerr;
+  chomp $s;
+  croak $s;
+    }
+    return $s;
+}
+
+=item B<shell_quote_best_effort> [I<string>]...
+
+This is like B<shell_quote>, excpet if the string can't be safely quoted
+it does the best it can and returns the result, instead of dying.
+
+=cut
+
+sub shell_quote_best_effort {
+    my ($rerr, $s) = _shell_quote_backend @_;
+
+    return $s;
+}
+
+=item B<shell_comment_quote> [I<string>]
+
+B<shell_comment_quote> quotes the I<string> so that it can safely be
+included in a shell-style comment (the current algorithm is that a sharp
+character is placed after any newlines in the string).
+
+This routine might be changed to accept multiple I<string> arguments
+in the future.  I haven't done this yet because I'm not sure if the
+I<string>s should be joined with blanks ($") or nothing ($,).  Cast
+your vote today!  Be sure to justify your answer.
+
+=cut
+
+sub shell_comment_quote {
+    return '' unless @_;
+    unless (@_ == 1) {
+  croak "Too many arguments to shell_comment_quote "
+            . "(got " . @_ . " expected 1)";
+    }
+    local $_ = shift;
+    s/\n/\n#/g;
+    return $_;
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 EXAMPLES
+
+    $cmd = 'fuser 2>/dev/null ' . shell_quote @files;
+    @pids = split ' ', `$cmd`;
+
+    print CFG "# Configured by: ",
+    shell_comment_quote($ENV{LOGNAME}), "\n";
+
+=head1 BUGS
+
+Only Bourne shell quoting is supported.  I'd like to add other shells
+(particularly cmd.exe), but I'm not familiar with them.  It would be a
+big help if somebody supplied the details.
+
+=head1 AUTHOR
+
+Roderick Schertler <F<roderick@argon.org>>
+
+=head1 SEE ALSO
+
+perl(1).
+
+=cut
+