Mandanten-WebDAV-Upgrade: nicht an Konfigurationseinstellung sondern Existenz von...
[kivitendo-erp.git] / modules / fallback / String / ShellQuote.pm
1 # $Id: ShellQuote.pm,v 1.11 2010-06-11 20:08:57 roderick Exp $
2 #
3 # Copyright (c) 1997 Roderick Schertler.  All rights reserved.  This
4 # program is free software; you can redistribute it and/or modify it
5 # under the same terms as Perl itself.
6
7 =head1 NAME
8
9 String::ShellQuote - quote strings for passing through the shell
10
11 =head1 SYNOPSIS
12
13     $string = shell_quote @list;
14     $string = shell_quote_best_effort @list;
15     $string = shell_comment_quote $string;
16
17 =head1 DESCRIPTION
18
19 This module contains some functions which are useful for quoting strings
20 which are going to pass through the shell or a shell-like object.
21
22 =over
23
24 =cut
25
26 package String::ShellQuote;
27
28 use strict;
29 use vars qw($VERSION @ISA @EXPORT);
30
31 require Exporter;
32
33 $VERSION    = '1.04';
34 @ISA        = qw(Exporter);
35 @EXPORT     = qw(shell_quote shell_quote_best_effort shell_comment_quote);
36
37 sub croak {
38     require Carp;
39     goto &Carp::croak;
40 }
41
42 sub _shell_quote_backend {
43     my @in = @_;
44     my @err = ();
45
46     if (0) {
47   require RS::Handy;
48   print RS::Handy::data_dump(\@in);
49     }
50
51     return \@err, '' unless @in;
52
53     my $ret = '';
54     my $saw_non_equal = 0;
55     foreach (@in) {
56   if (!defined $_ or $_ eq '') {
57       $_ = "''";
58       next;
59   }
60
61   if (s/\x00//g) {
62       push @err, "No way to quote string containing null (\\000) bytes";
63   }
64
65       my $escape = 0;
66
67   # = needs quoting when it's the first element (or part of a
68   # series of such elements), as in command position it's a
69   # program-local environment setting
70
71   if (/=/) {
72       if (!$saw_non_equal) {
73         $escape = 1;
74       }
75   }
76   else {
77       $saw_non_equal = 1;
78   }
79
80   if (m|[^\w!%+,\-./:=@^]|) {
81       $escape = 1;
82   }
83
84   if ($escape
85     || (!$saw_non_equal && /=/)) {
86
87       # ' -> '\''
88           s/'/'\\''/g;
89
90       # make multiple ' in a row look simpler
91       # '\'''\'''\'' -> '"'''"'
92           s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;
93
94       $_ = "'$_'";
95       s/^''//;
96       s/''$//;
97   }
98     }
99     continue {
100   $ret .= "$_ ";
101     }
102
103     chop $ret;
104     return \@err, $ret;
105 }
106
107 =item B<shell_quote> [I<string>]...
108
109 B<shell_quote> quotes strings so they can be passed through the shell.
110 Each I<string> is quoted so that the shell will pass it along as a
111 single argument and without further interpretation.  If no I<string>s
112 are given an empty string is returned.
113
114 If any I<string> can't be safely quoted B<shell_quote> will B<croak>.
115
116 =cut
117
118 sub shell_quote {
119     my ($rerr, $s) = _shell_quote_backend @_;
120
121     if (@$rerr) {
122       my %seen;
123       @$rerr = grep { !$seen{$_}++ } @$rerr;
124   my $s = join '', map { "shell_quote(): $_\n" } @$rerr;
125   chomp $s;
126   croak $s;
127     }
128     return $s;
129 }
130
131 =item B<shell_quote_best_effort> [I<string>]...
132
133 This is like B<shell_quote>, excpet if the string can't be safely quoted
134 it does the best it can and returns the result, instead of dying.
135
136 =cut
137
138 sub shell_quote_best_effort {
139     my ($rerr, $s) = _shell_quote_backend @_;
140
141     return $s;
142 }
143
144 =item B<shell_comment_quote> [I<string>]
145
146 B<shell_comment_quote> quotes the I<string> so that it can safely be
147 included in a shell-style comment (the current algorithm is that a sharp
148 character is placed after any newlines in the string).
149
150 This routine might be changed to accept multiple I<string> arguments
151 in the future.  I haven't done this yet because I'm not sure if the
152 I<string>s should be joined with blanks ($") or nothing ($,).  Cast
153 your vote today!  Be sure to justify your answer.
154
155 =cut
156
157 sub shell_comment_quote {
158     return '' unless @_;
159     unless (@_ == 1) {
160   croak "Too many arguments to shell_comment_quote "
161             . "(got " . @_ . " expected 1)";
162     }
163     local $_ = shift;
164     s/\n/\n#/g;
165     return $_;
166 }
167
168 1;
169
170 __END__
171
172 =back
173
174 =head1 EXAMPLES
175
176     $cmd = 'fuser 2>/dev/null ' . shell_quote @files;
177     @pids = split ' ', `$cmd`;
178
179     print CFG "# Configured by: ",
180     shell_comment_quote($ENV{LOGNAME}), "\n";
181
182 =head1 BUGS
183
184 Only Bourne shell quoting is supported.  I'd like to add other shells
185 (particularly cmd.exe), but I'm not familiar with them.  It would be a
186 big help if somebody supplied the details.
187
188 =head1 AUTHOR
189
190 Roderick Schertler <F<roderick@argon.org>>
191
192 =head1 SEE ALSO
193
194 perl(1).
195
196 =cut
197