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
9String::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
19This module contains some functions which are useful for quoting strings
20which are going to pass through the shell or a shell-like object.
21
22=over
23
24=cut
25
26package String::ShellQuote;
27
28use strict;
29use vars qw($VERSION @ISA @EXPORT);
30
31require Exporter;
32
33$VERSION	= '1.04';
34@ISA		= qw(Exporter);
35@EXPORT		= qw(shell_quote shell_quote_best_effort shell_comment_quote);
36
37sub croak {
38    require Carp;
39    goto &Carp::croak;
40}
41
42sub _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
109B<shell_quote> quotes strings so they can be passed through the shell.
110Each I<string> is quoted so that the shell will pass it along as a
111single argument and without further interpretation.  If no I<string>s
112are given an empty string is returned.
113
114If any I<string> can't be safely quoted B<shell_quote> will B<croak>.
115
116=cut
117
118sub 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
133This is like B<shell_quote>, excpet if the string can't be safely quoted
134it does the best it can and returns the result, instead of dying.
135
136=cut
137
138sub 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
146B<shell_comment_quote> quotes the I<string> so that it can safely be
147included in a shell-style comment (the current algorithm is that a sharp
148character is placed after any newlines in the string).
149
150This routine might be changed to accept multiple I<string> arguments
151in the future.  I haven't done this yet because I'm not sure if the
152I<string>s should be joined with blanks ($") or nothing ($,).  Cast
153your vote today!  Be sure to justify your answer.
154
155=cut
156
157sub 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
1681;
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
184Only 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
186big help if somebody supplied the details.
187
188=head1 AUTHOR
189
190Roderick Schertler <F<roderick@argon.org>>
191
192=head1 SEE ALSO
193
194perl(1).
195
196=cut
197