line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/local/bin/perl -w |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
|
|
8
|
eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}' |
4
|
|
|
|
|
|
|
if 0; # not running under some shell |
5
|
4
|
|
|
4
|
|
22
|
use strict; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
178
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# $Id: shell-quote,v 1.3 2010-06-11 20:00:24 roderick Exp $ |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# Roderick Schertler |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Copyright (C) 1999 Roderick Schertler |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify |
14
|
|
|
|
|
|
|
# it under the terms of the GNU General Public License as published by |
15
|
|
|
|
|
|
|
# the Free Software Foundation; either version 2 of the License, or (at |
16
|
|
|
|
|
|
|
# your option) any later version. |
17
|
|
|
|
|
|
|
# |
18
|
|
|
|
|
|
|
# This program is distributed in the hope that it will be useful, |
19
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
20
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
21
|
|
|
|
|
|
|
# General Public License for more details. |
22
|
|
|
|
|
|
|
# |
23
|
|
|
|
|
|
|
# For a copy of the GNU General Public License write to the Free Software |
24
|
|
|
|
|
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
25
|
|
|
|
|
|
|
|
26
|
4
|
|
|
4
|
|
2090
|
use String::ShellQuote qw(shell_quote); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
9063
|
|
27
|
|
|
|
|
|
|
|
28
|
4
|
50
|
|
|
|
47
|
(my $Me = $0 ne '-e' ? $0 : $^X) =~ s-.*/--; |
29
|
4
|
|
|
|
|
9
|
my $Debug = 0; |
30
|
4
|
|
|
|
|
8
|
my $Exit = 0; |
31
|
4
|
50
|
|
|
|
29
|
my $Version = q$Revision: 1.3 $ =~ /(\d\S+)/ ? $1 : '?'; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my @Option_spec = ( |
34
|
|
|
|
|
|
|
'debug!' => \$Debug, |
35
|
0
|
|
|
0
|
|
0
|
'help!' => sub { usage() }, |
36
|
0
|
|
|
0
|
|
0
|
'version' => sub { print "$Me version $Version\n"; exit }, |
|
0
|
|
|
|
|
0
|
|
37
|
4
|
|
|
|
|
47
|
); |
38
|
|
|
|
|
|
|
|
39
|
4
|
|
|
|
|
22
|
my $Usage = <
|
40
|
|
|
|
|
|
|
usage: $Me [switch]... |
41
|
|
|
|
|
|
|
switches: |
42
|
|
|
|
|
|
|
--debug turn debugging on |
43
|
|
|
|
|
|
|
--help show this and then die |
44
|
|
|
|
|
|
|
--version show the version ($Version) and exit |
45
|
|
|
|
|
|
|
Use \`perldoc $Me\' to see the full documentation. |
46
|
|
|
|
|
|
|
EOF |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub debug { |
49
|
0
|
0
|
|
0
|
|
0
|
print STDERR "debug: ", @_, "\n" if $Debug; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub usage { |
53
|
0
|
0
|
|
0
|
|
0
|
warn "$Me: ", @_ if @_; |
54
|
|
|
|
|
|
|
# Use exit() rather than die(), as Getopt::Long does eval(). |
55
|
0
|
|
|
|
|
0
|
print STDERR $Usage; |
56
|
0
|
|
|
|
|
0
|
exit 1; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# This is basically Getopt::Long but it has the defaults set up the way I |
60
|
|
|
|
|
|
|
# think they should be. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub getopt { |
63
|
|
|
|
|
|
|
# Don't bother if there aren't any switches. This test works because |
64
|
|
|
|
|
|
|
# I'm setting $REQUIRE_ORDER. |
65
|
3
|
50
|
33
|
3
|
|
38
|
return 1 unless @ARGV && substr($ARGV[0], 0, 1) eq '-'; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
0
|
my $bundling = 0; |
68
|
0
|
0
|
0
|
|
|
0
|
if (@_ && ($_[0] eq -bundle || $_[0] eq -bundling)) { |
|
|
|
0
|
|
|
|
|
69
|
0
|
|
|
|
|
0
|
$bundling = 1; |
70
|
0
|
|
|
|
|
0
|
shift; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
{ |
74
|
|
|
|
|
|
|
# I'm setting this environment variable when loading Getopt::Long |
75
|
|
|
|
|
|
|
# so that the defaults for options added later (which aren't set |
76
|
|
|
|
|
|
|
# explicitly below) are more likely to match what I'd like. |
77
|
0
|
|
|
|
|
0
|
local $ENV{POSIXLY_CORRECT} = 1; |
|
0
|
|
|
|
|
0
|
|
78
|
0
|
|
|
|
|
0
|
require Getopt::Long; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
0
|
Getopt::Long->VERSION(2.19); |
82
|
0
|
0
|
|
|
|
0
|
Getopt::Long::Configure( |
83
|
|
|
|
|
|
|
'no_auto_abbrev', |
84
|
|
|
|
|
|
|
'no_getopt_compat', |
85
|
|
|
|
|
|
|
'require_order', |
86
|
|
|
|
|
|
|
$bundling ? 'bundling' : (), |
87
|
|
|
|
|
|
|
'no_ignore_case', |
88
|
|
|
|
|
|
|
'prefix_pattern=(--|-)', |
89
|
|
|
|
|
|
|
) if 1; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# The getopt function puts the vars into its caller's package so |
92
|
|
|
|
|
|
|
# it's necessary to jump to it so that its caller is my caller. |
93
|
|
|
|
|
|
|
#goto &Getopt::Long::GetOptions; |
94
|
0
|
|
|
|
|
0
|
Getopt::Long::GetOptions(@_); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub init { |
98
|
4
|
100
|
33
|
4
|
|
30
|
getopt -bundle, @Option_spec or usage if @ARGV; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub main { |
102
|
4
|
|
|
4
|
|
14
|
init; |
103
|
4
|
100
|
|
|
|
26
|
print shell_quote(@ARGV), "\n" |
104
|
|
|
|
|
|
|
if @ARGV; |
105
|
4
|
|
|
|
|
32
|
return 0; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
4
|
|
33
|
|
|
15
|
$Exit = main || $Exit; |
109
|
4
|
50
|
33
|
|
|
17
|
$Exit = 1 if $Exit && !($Exit % 256); |
110
|
4
|
|
|
|
|
0
|
exit $Exit; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
__END__ |