projekt kivitendo

# $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