File Coverage

blib/script/shell-quote

Criterion	Covered	Total	%
statement	21	38	55.2
branch	8	20	40.0
condition	4	18	22.2
subroutine	5	9	55.5
pod			n/a
total	38	85	44.7

#!/usr/local/bin/perl -w

eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
use strict;

# $Id: shell-quote,v 1.3 2010-06-11 20:00:24 roderick Exp $
#
# Roderick Schertler

# Copyright (C) 1999 Roderick Schertler
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# For a copy of the GNU General Public License write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use String::ShellQuote	qw(shell_quote);

(my $Me		= $0 ne '-e' ? $0 : $^X) =~ s-.*/--;
my $Debug	= 0;
my $Exit	= 0;
my $Version	= q$Revision: 1.3 $ =~ /(\d\S+)/ ? $1 : '?';

my @Option_spec = (
    'debug!'	=> \$Debug,
    'help!'	=> sub { usage() },
    'version'	=> sub { print "$Me version $Version\n"; exit },
);

my $Usage = <
usage: $Me [switch]...
switches:
    --debug	turn debugging on
    --help	show this and then die
    --version	show the version ($Version) and exit
Use \`perldoc $Me\' to see the full documentation.
EOF

sub debug {
    print STDERR "debug: ", @_, "\n" if $Debug;
}

sub usage {
    warn "$Me: ", @_ if @_;
    # Use exit() rather than die(), as Getopt::Long does eval().
    print STDERR $Usage;
    exit 1;
}

# This is basically Getopt::Long but it has the defaults set up the way I
# think they should be.

sub getopt {
    # Don't bother if there aren't any switches.  This test works because
    # I'm setting $REQUIRE_ORDER.
    return 1 unless @ARGV && substr($ARGV[0], 0, 1) eq '-';

    my $bundling = 0;
    if (@_ && ($_[0] eq -bundle || $_[0] eq -bundling)) {
	$bundling = 1;
	shift;
    }

    {
	# I'm setting this environment variable when loading Getopt::Long
	# so that the defaults for options added later (which aren't set
	# explicitly below) are more likely to match what I'd like.
	local $ENV{POSIXLY_CORRECT} = 1;
	require Getopt::Long;
    }

    Getopt::Long->VERSION(2.19);
    Getopt::Long::Configure(
	'no_auto_abbrev',
	'no_getopt_compat',
	'require_order',
	$bundling ? 'bundling' : (),
	'no_ignore_case',
	'prefix_pattern=(--|-)',
    ) if 1;

    # The getopt function puts the vars into its caller's package so
    # it's necessary to jump to it so that its caller is my caller.
    #goto &Getopt::Long::GetOptions;
    Getopt::Long::GetOptions(@_);
}

sub init {
    getopt -bundle, @Option_spec or usage if @ARGV;
}

sub main {
    init;
    print shell_quote(@ARGV), "\n"
	if @ARGV;
    return 0;
}

$Exit = main || $Exit;
$Exit = 1 if $Exit && !($Exit % 256);
exit $Exit;

__END__