—
—
—
—
—

              
# $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.
HideShow 19 lines of Pod
=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;
}
HideShow 11 lines of Pod
=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;
}
HideShow 7 lines of Pod
=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;
}
HideShow 13 lines of Pod
=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__
HideShow 26 lines of Pod
=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