line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# ABSTRACT: Subroutines for making simple command line scripts |
2
|
|
|
|
|
|
|
# RECOMMEND PREREQ: App::Nopaste |
3
|
|
|
|
|
|
|
# RECOMMEND PREREQ: Term::ReadLine::Gnu |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
use strict; |
6
|
1
|
|
|
1
|
|
26398
|
use feature qw(state); |
|
1
|
|
|
|
|
9
|
|
|
1
|
|
|
|
|
26
|
|
7
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
95
|
|
8
|
1
|
|
|
1
|
|
5
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
9
|
|
|
|
|
|
|
use Capture::Tiny qw(capture); |
10
|
1
|
|
|
1
|
|
4
|
use File::Basename; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
31
|
|
11
|
1
|
|
|
1
|
|
4
|
use Getopt::Long qw(GetOptionsFromArray :config pass_through); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
97
|
|
12
|
1
|
|
|
1
|
|
590
|
use IO::Interactive qw( is_interactive ); |
|
1
|
|
|
|
|
8529
|
|
|
1
|
|
|
|
|
4
|
|
13
|
1
|
|
|
1
|
|
502
|
use Module::Load qw(load); |
|
1
|
|
|
|
|
800
|
|
|
1
|
|
|
|
|
4
|
|
14
|
1
|
|
|
1
|
|
415
|
use Ref::Util qw(is_ref is_arrayref is_hashref); |
|
1
|
|
|
|
|
905
|
|
|
1
|
|
|
|
|
8
|
|
15
|
1
|
|
|
1
|
|
431
|
use Sys::Syslog qw(:standard); |
|
1
|
|
|
|
|
1296
|
|
|
1
|
|
|
|
|
60
|
|
16
|
1
|
|
|
1
|
|
506
|
use Term::ANSIColor 2.01 qw(color colored colorstrip); |
|
1
|
|
|
|
|
16747
|
|
|
1
|
|
|
|
|
124
|
|
17
|
1
|
|
|
1
|
|
548
|
use Term::ReadKey; |
|
1
|
|
|
|
|
6859
|
|
|
1
|
|
|
|
|
1399
|
|
18
|
1
|
|
|
1
|
|
378
|
use Term::ReadLine; |
|
1
|
|
|
|
|
1633
|
|
|
1
|
|
|
|
|
58
|
|
19
|
1
|
|
|
1
|
|
422
|
use YAML; |
|
1
|
|
|
|
|
2156
|
|
|
1
|
|
|
|
|
26
|
|
20
|
1
|
|
|
1
|
|
365
|
|
|
1
|
|
|
|
|
5697
|
|
|
1
|
|
|
|
|
73
|
|
21
|
|
|
|
|
|
|
our $VERSION = '1.9'; # VERSION |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# Capture ARGV at Load |
24
|
|
|
|
|
|
|
my @ORIG_ARGS; |
25
|
|
|
|
|
|
|
BEGIN { |
26
|
|
|
|
|
|
|
@ORIG_ARGS = @ARGV; |
27
|
1
|
|
|
1
|
|
200
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
require Exporter; |
31
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my @output_tags = qw(output verbose debug debug_var cli_helpers_initialize); |
34
|
|
|
|
|
|
|
my @input_tags = qw(prompt menu text_input confirm pwprompt); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
our @EXPORT_OK = ( @output_tags, @input_tags ); |
37
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
38
|
|
|
|
|
|
|
all => [@output_tags,@input_tags], |
39
|
|
|
|
|
|
|
input => \@input_tags, |
40
|
|
|
|
|
|
|
output => \@output_tags, |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my $ARGV_AT_INIT = 0; |
44
|
|
|
|
|
|
|
my $COPY_ARGV = 0; |
45
|
|
|
|
|
|
|
our $_init_complete = 0; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
my (@args) = @_; |
48
|
|
|
|
|
|
|
|
49
|
1
|
|
|
1
|
|
9
|
my @import = (); |
50
|
|
|
|
|
|
|
# We need to process the config options |
51
|
1
|
|
|
|
|
2
|
foreach my $arg ( @args ) { |
52
|
|
|
|
|
|
|
if( $arg eq 'delay_argv' ) { |
53
|
1
|
|
|
|
|
3
|
$ARGV_AT_INIT = 0; |
54
|
3
|
100
|
|
|
|
8
|
} |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
55
|
1
|
|
|
|
|
1
|
elsif( $arg eq 'preprocess_argv' ) { |
56
|
|
|
|
|
|
|
$ARGV_AT_INIT = 1; |
57
|
|
|
|
|
|
|
} |
58
|
0
|
|
|
|
|
0
|
elsif( $arg eq 'copy_argv' ) { |
59
|
|
|
|
|
|
|
$COPY_ARGV = 1; |
60
|
|
|
|
|
|
|
} |
61
|
0
|
|
|
|
|
0
|
# Not a config option, pass through |
62
|
|
|
|
|
|
|
else { |
63
|
|
|
|
|
|
|
push @import, $arg; |
64
|
|
|
|
|
|
|
} |
65
|
2
|
|
|
|
|
4
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
CLI::Helpers->export_to_level( 1, @import ); |
68
|
|
|
|
|
|
|
} |
69
|
1
|
|
|
|
|
136
|
|
70
|
|
|
|
|
|
|
{ |
71
|
|
|
|
|
|
|
## no critic (ProhibitNoWarnings) |
72
|
|
|
|
|
|
|
no warnings; |
73
|
|
|
|
|
|
|
INIT { |
74
|
1
|
|
|
1
|
|
6
|
return if $_init_complete++; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3429
|
|
75
|
|
|
|
|
|
|
cli_helpers_initialize() if $ARGV_AT_INIT; |
76
|
1
|
50
|
|
1
|
|
4
|
} |
77
|
1
|
50
|
|
|
|
5
|
## use critic |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
{ |
82
|
|
|
|
|
|
|
my @argv_original = (); |
83
|
|
|
|
|
|
|
my $parsed_argv = 0; |
84
|
|
|
|
|
|
|
my ($opt_ref) = @_; |
85
|
|
|
|
|
|
|
my @opt_spec = qw( |
86
|
|
|
|
|
|
|
color! |
87
|
7
|
|
|
7
|
|
11
|
verbose|v+ |
88
|
7
|
|
|
|
|
23
|
debug |
89
|
|
|
|
|
|
|
debug-class=s |
90
|
|
|
|
|
|
|
quiet |
91
|
|
|
|
|
|
|
data-file=s |
92
|
|
|
|
|
|
|
syslog! |
93
|
|
|
|
|
|
|
syslog-facility=s |
94
|
|
|
|
|
|
|
syslog-tag=s |
95
|
|
|
|
|
|
|
syslog-debug! |
96
|
|
|
|
|
|
|
tags=s |
97
|
|
|
|
|
|
|
nopaste |
98
|
|
|
|
|
|
|
nopaste-public |
99
|
|
|
|
|
|
|
nopaste-service=s |
100
|
|
|
|
|
|
|
); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
my $argv; |
103
|
|
|
|
|
|
|
my %opt; |
104
|
|
|
|
|
|
|
if( defined $opt_ref && is_arrayref($opt_ref) ) { |
105
|
7
|
|
|
|
|
10
|
# If passed an argv array, use that |
106
|
|
|
|
|
|
|
$argv = $COPY_ARGV ? [ @{ $opt_ref } ] : $opt_ref; |
107
|
7
|
100
|
66
|
|
|
29
|
} |
108
|
|
|
|
|
|
|
else { |
109
|
5
|
50
|
|
|
|
11
|
# Ensure multiple calls to cli_helpers_initialize() yield the same results |
|
0
|
|
|
|
|
0
|
|
110
|
|
|
|
|
|
|
if ( $parsed_argv ) { |
111
|
|
|
|
|
|
|
## no critic |
112
|
|
|
|
|
|
|
@ARGV = @argv_original; |
113
|
2
|
100
|
|
|
|
6
|
## use critic |
114
|
|
|
|
|
|
|
} |
115
|
1
|
|
|
|
|
2
|
else { |
116
|
|
|
|
|
|
|
@argv_original = @ARGV; |
117
|
|
|
|
|
|
|
$parsed_argv++; |
118
|
|
|
|
|
|
|
} |
119
|
1
|
|
|
|
|
3
|
# Operate on @ARGV |
120
|
1
|
|
|
|
|
2
|
$argv = $COPY_ARGV ? [ @ARGV ] : \@ARGV; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
GetOptionsFromArray($argv, \%opt, @opt_spec ); |
123
|
2
|
50
|
|
|
|
5
|
return \%opt; |
124
|
|
|
|
|
|
|
} |
125
|
7
|
|
|
|
|
25
|
} |
126
|
7
|
|
|
|
|
5341
|
|
127
|
|
|
|
|
|
|
my $DATA_HANDLE = undef; |
128
|
|
|
|
|
|
|
my $data_file = shift; |
129
|
|
|
|
|
|
|
eval { |
130
|
|
|
|
|
|
|
open($DATA_HANDLE, '>', $data_file) or die "data file unwritable: $!"; |
131
|
|
|
|
|
|
|
1; |
132
|
0
|
|
|
0
|
|
0
|
} or do { |
133
|
|
|
|
|
|
|
my $error = $@; |
134
|
0
|
0
|
|
|
|
0
|
output({color=>'red',stderr=>1}, "Attempted to write to $data_file failed: $!"); |
135
|
0
|
|
|
|
|
0
|
}; |
136
|
0
|
0
|
|
|
|
0
|
} |
137
|
0
|
|
|
|
|
0
|
|
138
|
0
|
|
|
|
|
0
|
|
139
|
|
|
|
|
|
|
# Set defaults |
140
|
|
|
|
|
|
|
my %DEF = (); |
141
|
|
|
|
|
|
|
my $TERM = undef; |
142
|
|
|
|
|
|
|
my @STICKY = (); |
143
|
|
|
|
|
|
|
my @NOPASTE = (); |
144
|
|
|
|
|
|
|
my %TAGS = (); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
my ($argv) = @_; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
my $opts = _parse_options($argv); |
150
|
|
|
|
|
|
|
_open_data_file($opts->{'data-file'}) if $opts->{'data-file'}; |
151
|
|
|
|
|
|
|
|
152
|
7
|
|
|
7
|
1
|
5585
|
# Initialize Global Definitions |
153
|
|
|
|
|
|
|
%DEF = ( |
154
|
7
|
|
|
|
|
15
|
DEBUG => $opts->{debug} || 0, |
155
|
7
|
50
|
|
|
|
20
|
DEBUG_CLASS => $opts->{'debug-class'} || 'main', |
156
|
|
|
|
|
|
|
VERBOSE => $opts->{verbose} || 0, |
157
|
|
|
|
|
|
|
KV_FORMAT => ': ', |
158
|
|
|
|
|
|
|
QUIET => $opts->{quiet} || 0, |
159
|
|
|
|
|
|
|
SYSLOG => $opts->{syslog} || 0, |
160
|
|
|
|
|
|
|
SYSLOG_TAG => exists $opts->{'syslog-tag'} && length $opts->{'syslog-tag'} ? $opts->{'syslog-tag'} : basename($0), |
161
|
|
|
|
|
|
|
SYSLOG_FACILITY => exists $opts->{'syslog-facility'} && length $opts->{'syslog-facility'} ? $opts->{'syslog-facility'} : 'local0', |
162
|
|
|
|
|
|
|
SYSLOG_DEBUG => $opts->{'syslog-debug'} || 0, |
163
|
|
|
|
|
|
|
TAGS => $opts->{tags} ? { map { $_ => 1 } split /,/, $opts->{tags} } : undef, |
164
|
|
|
|
|
|
|
NOPASTE => $opts->{nopaste} || 0, |
165
|
|
|
|
|
|
|
NOPASTE_SERVICE => $opts->{'nopaste-service'}, |
166
|
|
|
|
|
|
|
NOPASTE_PUBLIC => $opts->{'nopaste-public'}, |
167
|
|
|
|
|
|
|
); |
168
|
0
|
|
|
|
|
0
|
$DEF{COLOR} = $opts->{color} // git_color_check(); |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
debug("DEFINITIONS"); |
171
|
7
|
50
|
100
|
|
|
324
|
debug_var(\%DEF); |
|
|
50
|
50
|
|
|
|
|
|
|
50
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
172
|
|
|
|
|
|
|
|
173
|
7
|
|
33
|
|
|
25
|
# Setup the Syslog Subsystem |
174
|
|
|
|
|
|
|
if( $DEF{SYSLOG} ) { |
175
|
7
|
|
|
|
|
116
|
eval { |
176
|
7
|
|
|
|
|
16
|
openlog($DEF{SYSLOG_TAG}, 'ndelay,pid', $DEF{SYSLOG_FACILITY}); |
177
|
|
|
|
|
|
|
1; |
178
|
|
|
|
|
|
|
} or do { |
179
|
7
|
50
|
|
|
|
42
|
my $error = $@; |
180
|
|
|
|
|
|
|
$DEF{SYSLOG}=0; |
181
|
0
|
|
|
|
|
0
|
output({stderr=>1,color=>'red'}, "CLI::Helpers could not open syslog: $error"); |
182
|
0
|
|
|
|
|
0
|
}; |
183
|
0
|
0
|
|
|
|
0
|
} |
184
|
0
|
|
|
|
|
0
|
|
185
|
0
|
|
|
|
|
0
|
# Optionally Attempt Loading App::NoPaste |
186
|
0
|
|
|
|
|
0
|
if( $DEF{NOPASTE} ) { |
187
|
|
|
|
|
|
|
eval { |
188
|
|
|
|
|
|
|
load 'App::Nopaste'; |
189
|
|
|
|
|
|
|
1; |
190
|
|
|
|
|
|
|
} or do { |
191
|
7
|
50
|
|
|
|
17
|
$DEF{NOPASTE} = 0; |
192
|
|
|
|
|
|
|
output({stderr=>1,color=>'red',sticky=>1}, |
193
|
0
|
|
|
|
|
0
|
'App::Nopaste is not installed, please cpanm App::Nopaste for --nopaste support', |
194
|
0
|
|
|
|
|
0
|
); |
195
|
0
|
0
|
|
|
|
0
|
}; |
196
|
0
|
|
|
|
|
0
|
} |
197
|
0
|
|
|
|
|
0
|
|
198
|
|
|
|
|
|
|
return 1; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# Allow some messages to be fired at the end the of program |
203
|
7
|
|
|
|
|
16
|
END { |
204
|
|
|
|
|
|
|
# Show discovered tags |
205
|
|
|
|
|
|
|
if( keys %TAGS ) { |
206
|
|
|
|
|
|
|
output({color=>'cyan',stderr=>1}, |
207
|
|
|
|
|
|
|
sprintf "# Tags discovered: %s", |
208
|
|
|
|
|
|
|
join(', ', map { "$_=$TAGS{$_}" } sort keys %TAGS) |
209
|
|
|
|
|
|
|
); |
210
|
1
|
50
|
|
1
|
|
1018
|
} |
211
|
|
|
|
|
|
|
# Show Sticky Output |
212
|
|
|
|
|
|
|
if(@STICKY) { |
213
|
0
|
|
|
|
|
0
|
foreach my $args (@STICKY) { |
|
0
|
|
|
|
|
0
|
|
214
|
|
|
|
|
|
|
output(@{ $args }); |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
} |
217
|
1
|
50
|
|
|
|
3
|
# Do the Nopaste |
218
|
0
|
|
|
|
|
0
|
if( @NOPASTE ) { |
219
|
0
|
|
|
|
|
0
|
my $command_string = join(" ", $0, @ORIG_ARGS); |
|
0
|
|
|
|
|
0
|
|
220
|
|
|
|
|
|
|
unshift @NOPASTE, "\$ $command_string"; |
221
|
|
|
|
|
|
|
# Figure out what services to use |
222
|
|
|
|
|
|
|
my $services = $DEF{NOPASTE_SERVICE} ? [ split /,/, $DEF{NOPASTE_SERVICE} ] |
223
|
1
|
50
|
|
|
|
3
|
: $ENV{NOPASTE_SERVICES} ? [ split /,/, $ENV{NOPASTE_SERVICES} ] |
224
|
0
|
|
|
|
|
0
|
: undef; |
225
|
0
|
|
|
|
|
0
|
my %paste = ( |
226
|
|
|
|
|
|
|
text => join("\n", @NOPASTE), |
227
|
|
|
|
|
|
|
summary => $command_string, |
228
|
0
|
0
|
|
|
|
0
|
desc => $command_string, |
|
|
0
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Default to a Private Paste |
230
|
|
|
|
|
|
|
private => $DEF{NOPASTE_PUBLIC} ? 0 : 1, |
231
|
|
|
|
|
|
|
); |
232
|
|
|
|
|
|
|
debug_var(\%paste); |
233
|
|
|
|
|
|
|
if( $services ) { |
234
|
|
|
|
|
|
|
output({color=>'cyan',stderr=>1}, "# NoPaste: " |
235
|
0
|
0
|
|
|
|
0
|
. App::Nopaste->nopaste(%paste, services => $services) |
236
|
|
|
|
|
|
|
); |
237
|
0
|
|
|
|
|
0
|
} |
238
|
0
|
0
|
|
|
|
0
|
else { |
239
|
0
|
|
|
|
|
0
|
output({color=>'red',stderr=>1,clear=>1}, |
240
|
|
|
|
|
|
|
"!! In order to use --nopaste, you need to your environment variable", |
241
|
|
|
|
|
|
|
"!! NOPASTE_SERVICES or pass --nopaste-service, e.g.:", |
242
|
|
|
|
|
|
|
"!! export NOPASTE_SERVICES=Shadowcat,PastebinCom"); |
243
|
|
|
|
|
|
|
} |
244
|
0
|
|
|
|
|
0
|
} |
245
|
|
|
|
|
|
|
closelog() if $DEF{SYSLOG}; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
1
|
50
|
|
|
|
6
|
|
251
|
|
|
|
|
|
|
return unless is_interactive(); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
my @cmd = qw(git config --global --get color.ui); |
254
|
2
|
50
|
|
2
|
1
|
14
|
my($stdout,$stderr,$rc) = capture { |
255
|
|
|
|
|
|
|
system @cmd; |
256
|
|
|
|
|
|
|
}; |
257
|
|
|
|
|
|
|
if( $rc != 0 ) { |
258
|
7
|
50
|
|
7
|
1
|
36
|
debug("git_color_check error: $stderr"); |
259
|
|
|
|
|
|
|
return 0; |
260
|
0
|
|
|
|
|
0
|
} |
261
|
|
|
|
|
|
|
debug("git_color_check out: $stdout"); |
262
|
0
|
|
|
0
|
|
0
|
if( $stdout =~ /auto/ || $stdout =~ /true/ ) { |
263
|
0
|
|
|
|
|
0
|
return 1; |
264
|
0
|
0
|
|
|
|
0
|
} |
265
|
0
|
|
|
|
|
0
|
|
266
|
0
|
|
|
|
|
0
|
return 0; |
267
|
|
|
|
|
|
|
} |
268
|
0
|
|
|
|
|
0
|
|
269
|
0
|
0
|
0
|
|
|
0
|
|
270
|
0
|
|
|
|
|
0
|
my ($color,$string) = @_; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
if( defined $color && $DEF{COLOR} ) { |
273
|
0
|
|
|
|
|
0
|
$string=colored([ $color ], $string); |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
return $string; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
0
|
1
|
0
|
|
279
|
|
|
|
|
|
|
my $opts = is_hashref($_[0]) ? shift @_ : {}; |
280
|
0
|
0
|
0
|
|
|
0
|
|
281
|
0
|
|
|
|
|
0
|
# Return unless we have something to work with; |
282
|
|
|
|
|
|
|
return unless @_; |
283
|
0
|
|
|
|
|
0
|
|
284
|
|
|
|
|
|
|
# Ensure we're all setup |
285
|
|
|
|
|
|
|
cli_helpers_initialize() unless keys %DEF; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# Input/output Arrays |
288
|
16
|
100
|
|
16
|
1
|
5153
|
my @input = map { my $x=$_; chomp($x) if defined $x; $x; } @_; |
289
|
|
|
|
|
|
|
my @output = (); |
290
|
|
|
|
|
|
|
|
291
|
16
|
50
|
|
|
|
34
|
# Determine the color |
292
|
|
|
|
|
|
|
my $color = exists $opts->{color} && defined $opts->{color} ? $opts->{color} : undef; |
293
|
|
|
|
|
|
|
|
294
|
16
|
50
|
|
|
|
45
|
# Determine indentation |
295
|
|
|
|
|
|
|
my $indent = exists $opts->{indent} ? " "x(2*$opts->{indent}) : ''; |
296
|
|
|
|
|
|
|
|
297
|
16
|
50
|
|
|
|
24
|
# If tagged, we only output if the tag is requested |
|
16
|
|
|
|
|
19
|
|
|
16
|
|
|
|
|
32
|
|
|
16
|
|
|
|
|
37
|
|
298
|
16
|
|
|
|
|
18
|
if( $DEF{TAGS} && exists $opts->{tag} ) { |
299
|
|
|
|
|
|
|
# Skip this altogether |
300
|
|
|
|
|
|
|
$TAGS{$opts->{tag}} ||= 0; |
301
|
16
|
50
|
33
|
|
|
36
|
$TAGS{$opts->{tag}}++; |
302
|
|
|
|
|
|
|
return unless $DEF{TAGS}->{$opts->{tag}}; |
303
|
|
|
|
|
|
|
} |
304
|
16
|
50
|
|
|
|
31
|
|
305
|
|
|
|
|
|
|
# Determine if we're doing Key Value Pairs |
306
|
|
|
|
|
|
|
my $DO_KV = (scalar(@input) % 2 == 0 ) && (exists $opts->{kv} && $opts->{kv} == 1) ? 1 : 0; |
307
|
16
|
0
|
33
|
|
|
28
|
|
308
|
|
|
|
|
|
|
if( $DO_KV ) { |
309
|
0
|
|
0
|
|
|
0
|
while( @input ) { |
310
|
0
|
|
|
|
|
0
|
my $k = shift @input; |
311
|
0
|
0
|
|
|
|
0
|
# We only colorize the value |
312
|
|
|
|
|
|
|
my $v = shift @input; |
313
|
|
|
|
|
|
|
$v ||= $DEF{KV_FORMAT} eq ': ' ? '~' : ''; |
314
|
|
|
|
|
|
|
push @output, join($DEF{KV_FORMAT}, $k, colorize($color,$v)); |
315
|
16
|
50
|
33
|
|
|
34
|
} |
316
|
|
|
|
|
|
|
} |
317
|
16
|
50
|
|
|
|
26
|
else { |
318
|
0
|
|
|
|
|
0
|
@output = map { defined $color ? colorize($color, $_) : $_; } @input; |
319
|
0
|
|
|
|
|
0
|
} |
320
|
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
0
|
# Out to the console |
322
|
0
|
0
|
0
|
|
|
0
|
if( !$DEF{QUIET} || $opts->{IMPORTANT} ) { |
323
|
0
|
|
|
|
|
0
|
my $out_handle = $opts->{stderr} ? \*STDERR : \*STDOUT; |
324
|
|
|
|
|
|
|
# Do clearing |
325
|
|
|
|
|
|
|
print $out_handle "\n"x$opts->{clear} if exists $opts->{clear}; |
326
|
|
|
|
|
|
|
# Print output |
327
|
16
|
50
|
|
|
|
20
|
print $out_handle "${indent}$_\n" for @output; |
|
16
|
|
|
|
|
41
|
|
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
# Handle data, which is raw |
331
|
16
|
50
|
33
|
|
|
31
|
if(defined $DATA_HANDLE && $opts->{data}) { |
332
|
16
|
100
|
|
|
|
33
|
print $DATA_HANDLE "$_\n" for @input; |
333
|
|
|
|
|
|
|
} |
334
|
16
|
50
|
|
|
|
27
|
elsif( $DEF{SYSLOG} && !$opts->{no_syslog}) { |
335
|
|
|
|
|
|
|
my $level = exists $opts->{syslog_level} ? $opts->{syslog_level} : |
336
|
16
|
|
|
|
|
462
|
exists $opts->{stderr} ? 'err' : |
337
|
|
|
|
|
|
|
'notice'; |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
# Warning for syslogging data file |
340
|
16
|
50
|
33
|
|
|
84
|
unshift @output, "CLI::Helpers logging a data section, use --data-file to suppress this in syslog." |
|
|
50
|
33
|
|
|
|
|
341
|
0
|
|
|
|
|
0
|
if $opts->{data}; |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# Now syslog the message |
344
|
|
|
|
|
|
|
debug({no_syslog=>1,color=>'magenta'}, sprintf "[%s] Syslogging %d messages, with: %s", $level, scalar(@output), join(",", map { $_=>$opts->{$_} } keys %{ $opts })); |
345
|
0
|
0
|
|
|
|
0
|
for( @output ) { |
|
|
0
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# One bad message means no more syslogging |
347
|
|
|
|
|
|
|
eval { |
348
|
|
|
|
|
|
|
syslog($level, colorstrip($_)); |
349
|
|
|
|
|
|
|
1; |
350
|
0
|
0
|
|
|
|
0
|
} or do { |
351
|
|
|
|
|
|
|
my $error = $@; |
352
|
|
|
|
|
|
|
$DEF{SYSLOG} = 0; |
353
|
0
|
|
|
|
|
0
|
output({stderr=>1,color=>'red',no_syslog=>1}, "syslog() failed: $error"); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
354
|
0
|
|
|
|
|
0
|
}; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
} |
357
|
0
|
|
|
|
|
0
|
|
358
|
0
|
|
|
|
|
0
|
# Sticky messages don't just go away |
359
|
0
|
0
|
|
|
|
0
|
if(exists $opts->{sticky}) { |
360
|
0
|
|
|
|
|
0
|
my %o = %{ $opts }; # Make a copy because we shifted this off @_ |
361
|
0
|
|
|
|
|
0
|
# So this doesn't happen in the END block again |
362
|
0
|
|
|
|
|
0
|
delete $o{$_} for grep { exists $o{$_} } qw(sticky data); |
363
|
|
|
|
|
|
|
$o{no_syslog} = 1; |
364
|
|
|
|
|
|
|
push @STICKY, [ \%o, @input ]; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
if( $DEF{NOPASTE} ) { |
367
|
|
|
|
|
|
|
push @NOPASTE, map { $indent . colorstrip($_) } @output; |
368
|
16
|
50
|
|
|
|
26
|
} |
369
|
0
|
|
|
|
|
0
|
} |
|
0
|
|
|
|
|
0
|
|
370
|
|
|
|
|
|
|
|
371
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
372
|
0
|
|
|
|
|
0
|
my $opts = is_hashref($_[0]) ? shift @_ : {}; |
373
|
0
|
|
|
|
|
0
|
$opts->{level} = 1 unless exists $opts->{level}; |
374
|
|
|
|
|
|
|
$opts->{syslog_level} = $opts->{level} > 1 ? 'debug' : 'info'; |
375
|
16
|
50
|
|
|
|
86
|
my @msgs=@_; |
376
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
377
|
|
|
|
|
|
|
# Ensure we're all configured |
378
|
|
|
|
|
|
|
cli_helpers_initialize() unless keys %DEF; |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
if( !$DEF{DEBUG} ) { |
381
|
|
|
|
|
|
|
return unless $DEF{VERBOSE} >= $opts->{level}; |
382
|
10
|
100
|
|
10
|
1
|
44
|
} |
383
|
10
|
100
|
|
|
|
25
|
output( $opts, @msgs ); |
384
|
10
|
100
|
|
|
|
21
|
} |
385
|
10
|
|
|
|
|
19
|
|
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
my $opts = is_hashref($_[0]) ? shift @_ : {}; |
388
|
10
|
50
|
|
|
|
19
|
my @msgs=@_; |
389
|
|
|
|
|
|
|
|
390
|
10
|
100
|
|
|
|
25
|
# Ensure we're all configured |
391
|
8
|
100
|
|
|
|
39
|
cli_helpers_initialize() unless keys %DEF; |
392
|
|
|
|
|
|
|
|
393
|
5
|
|
|
|
|
13
|
# Smarter handling of debug output |
394
|
|
|
|
|
|
|
return unless $DEF{DEBUG}; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# Check against caller class |
397
|
|
|
|
|
|
|
my $package = exists $opts->{_caller_package} ? $opts->{_caller_package} : (caller)[0]; |
398
|
19
|
100
|
|
19
|
1
|
34037
|
return unless lc $DEF{DEBUG_CLASS} eq 'all' || $package eq $DEF{DEBUG_CLASS}; |
399
|
19
|
|
|
|
|
38
|
|
400
|
|
|
|
|
|
|
# Check if we really want to debug syslog data |
401
|
|
|
|
|
|
|
$opts->{syslog_level} = 'debug'; |
402
|
19
|
50
|
|
|
|
38
|
$opts->{no_syslog} //= !$DEF{SYSLOG_DEBUG}; |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
# Output |
405
|
19
|
100
|
|
|
|
53
|
output( $opts, @msgs ); |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
3
|
100
|
|
|
|
18
|
|
409
|
3
|
100
|
66
|
|
|
17
|
my $opts = { |
410
|
|
|
|
|
|
|
clear => 1, # Meant for the screen |
411
|
|
|
|
|
|
|
no_syslog => 1, # Meant for the screen |
412
|
1
|
|
|
|
|
3
|
_caller_package => (caller)[0], # Make sure this is set on entry |
413
|
1
|
|
33
|
|
|
7
|
}; |
414
|
|
|
|
|
|
|
# Merge with options |
415
|
|
|
|
|
|
|
if( is_hashref($_[0]) && defined $_[1] && is_ref($_[1]) ) { |
416
|
1
|
|
|
|
|
3
|
my $ref = shift; |
417
|
|
|
|
|
|
|
foreach my $k (keys %{ $ref } ) { |
418
|
|
|
|
|
|
|
$opts->{$k} = $ref->{$k}; |
419
|
|
|
|
|
|
|
}; |
420
|
|
|
|
|
|
|
} |
421
|
7
|
|
|
7
|
1
|
29
|
debug($opts, Dump shift); |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
my %_allow_override = map { $_ => 1 } qw(debug verbose); |
426
|
|
|
|
|
|
|
my ($var,$value) = @_; |
427
|
7
|
50
|
33
|
|
|
30
|
|
|
|
|
33
|
|
|
|
|
428
|
0
|
|
|
|
|
0
|
return unless exists $_allow_override{lc $var}; |
429
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
430
|
0
|
|
|
|
|
0
|
my $def_var = uc $var; |
431
|
|
|
|
|
|
|
$DEF{$def_var} = $value; |
432
|
|
|
|
|
|
|
} |
433
|
7
|
|
|
|
|
21
|
|
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
my $_Confirm_Valid; |
436
|
|
|
|
|
|
|
my ($question) = @_; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# Initialize Globals |
439
|
0
|
|
|
0
|
1
|
|
$_Confirm_Valid ||= {qw(y 1 yes 1 n 0 no 0)}; |
440
|
|
|
|
|
|
|
|
441
|
0
|
0
|
|
|
|
|
$question =~ s/\s*$/ [yN] /; |
442
|
|
|
|
|
|
|
my $answer = undef; |
443
|
0
|
|
|
|
|
|
until( defined $answer && exists $_Confirm_Valid->{$answer} ) { |
444
|
0
|
|
|
|
|
|
output({color=>'red',stderr=>1},"ERROR: must be one of 'y','n','yes','no'") if defined $answer; |
445
|
|
|
|
|
|
|
$answer = lc _get_input($question); |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
return $_Confirm_Valid->{$answer}; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
0
|
|
|
0
|
1
|
|
|
451
|
|
|
|
|
|
|
my $question = shift; |
452
|
|
|
|
|
|
|
my %args = @_; |
453
|
0
|
|
0
|
|
|
|
|
454
|
|
|
|
|
|
|
# Prompt fixes |
455
|
0
|
|
|
|
|
|
chomp($question); |
456
|
0
|
|
|
|
|
|
my $terminator = $question =~ s/([^a-zA-Z0-9\)\]\}])\s*$// ? $1 : ':'; |
457
|
0
|
|
0
|
|
|
|
if(exists $args{default}) { |
458
|
0
|
0
|
|
|
|
|
$question .= " (default=$args{default}) "; |
459
|
0
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
$question .= "$terminator "; |
461
|
0
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# Make sure there's a space before the prompt |
463
|
|
|
|
|
|
|
$question =~ s/\s*$/ /; |
464
|
|
|
|
|
|
|
my $validate = exists $args{validate} ? $args{validate} : {}; |
465
|
|
|
|
|
|
|
|
466
|
0
|
|
|
0
|
1
|
|
my $text; |
467
|
0
|
|
|
|
|
|
my $error = undef; |
468
|
|
|
|
|
|
|
until( defined $text && !defined $error ) { |
469
|
|
|
|
|
|
|
output({color=>'red',stderr=>1},"ERROR: $error") if defined $error; |
470
|
0
|
|
|
|
|
|
|
471
|
0
|
0
|
|
|
|
|
# Try to have the user answer the question |
472
|
0
|
0
|
|
|
|
|
$text = _get_input($question => \%args); |
473
|
0
|
|
|
|
|
|
$error = undef; |
474
|
|
|
|
|
|
|
|
475
|
0
|
|
|
|
|
|
# Check the default if the person just hit enter |
476
|
|
|
|
|
|
|
if( exists $args{default} && length($text) == 0 ) { |
477
|
|
|
|
|
|
|
return $args{default}; |
478
|
0
|
|
|
|
|
|
} |
479
|
0
|
0
|
|
|
|
|
foreach my $v (keys %{$validate}) { |
480
|
|
|
|
|
|
|
local $_ = $text; |
481
|
0
|
|
|
|
|
|
if( $validate->{$v}->() > 0 ) { |
482
|
0
|
|
|
|
|
|
debug({indent=>1}," + Validated: $v"); |
483
|
0
|
|
0
|
|
|
|
next; |
484
|
0
|
0
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
$error = $v; |
486
|
|
|
|
|
|
|
last; |
487
|
0
|
|
|
|
|
|
} |
488
|
0
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
return $text; |
490
|
|
|
|
|
|
|
} |
491
|
0
|
0
|
0
|
|
|
|
|
492
|
0
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
my ($question,$opts) = @_; |
494
|
0
|
|
|
|
|
|
my %desc = (); |
|
0
|
|
|
|
|
|
|
495
|
0
|
|
|
|
|
|
|
496
|
0
|
0
|
|
|
|
|
# Determine how to handle this list |
497
|
0
|
|
|
|
|
|
if( is_arrayref($opts) ) { |
498
|
0
|
|
|
|
|
|
%desc = map { $_ => $_ } @{ $opts }; |
499
|
|
|
|
|
|
|
} |
500
|
0
|
|
|
|
|
|
elsif( is_hashref($opts) ) { |
501
|
0
|
|
|
|
|
|
%desc = %{ $opts }; |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
|
504
|
0
|
|
|
|
|
|
print "$question\n\n"; |
505
|
|
|
|
|
|
|
my %ref = (); |
506
|
|
|
|
|
|
|
my $id = 0; |
507
|
|
|
|
|
|
|
foreach my $key (sort keys %desc) { |
508
|
|
|
|
|
|
|
$ref{++$id} = $key; |
509
|
0
|
|
|
0
|
1
|
|
} |
510
|
0
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
my $choice; |
512
|
|
|
|
|
|
|
until( defined $choice && exists $ref{$choice} ) { |
513
|
0
|
0
|
|
|
|
|
output({color=>'red',stderr=>1},"ERROR: invalid selection") if defined $choice; |
|
|
0
|
|
|
|
|
|
514
|
0
|
|
|
|
|
|
foreach my $id (sort { $a <=> $b } keys %ref) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
printf " %d. %s\n", $id, $desc{$ref{$id}}; |
516
|
|
|
|
|
|
|
} |
517
|
0
|
|
|
|
|
|
print "\n"; |
|
0
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
$choice = _get_input("Selection (1-$id): "); |
519
|
|
|
|
|
|
|
} |
520
|
0
|
|
|
|
|
|
return $ref{$choice}; |
521
|
0
|
|
|
|
|
|
} |
522
|
0
|
|
|
|
|
|
|
523
|
0
|
|
|
|
|
|
|
524
|
0
|
|
|
|
|
|
my ($prompt, %args) = @_; |
525
|
|
|
|
|
|
|
$prompt ||= "Password: "; |
526
|
|
|
|
|
|
|
my @more_validate; |
527
|
0
|
|
|
|
|
|
if (my $validate = $args{validate}){ |
528
|
0
|
|
0
|
|
|
|
@more_validate = %$validate; |
529
|
0
|
0
|
|
|
|
|
} |
530
|
0
|
|
|
|
|
|
return text_input($prompt, |
|
0
|
|
|
|
|
|
|
531
|
0
|
|
|
|
|
|
noecho => 1, |
532
|
|
|
|
|
|
|
validate => { "password length can't be zero." => sub { defined && length }, |
533
|
0
|
|
|
|
|
|
@more_validate, |
534
|
0
|
|
|
|
|
|
}, |
535
|
|
|
|
|
|
|
); |
536
|
0
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
my ($prompt) = shift; |
540
|
|
|
|
|
|
|
my %args = @_; |
541
|
0
|
|
|
0
|
1
|
|
|
542
|
0
|
|
0
|
|
|
|
return confirm($prompt) if exists $args{yn}; |
543
|
0
|
|
|
|
|
|
return menu($prompt, $args{menu}) if exists $args{menu}; |
544
|
0
|
0
|
|
|
|
|
# Check for a password prompt |
545
|
0
|
|
|
|
|
|
if( lc($prompt) =~ /passw(or)?d/ ) { |
546
|
|
|
|
|
|
|
$args{noecho} = 1; |
547
|
|
|
|
|
|
|
$args{validate} ||= {}; |
548
|
|
|
|
|
|
|
$args{validate}->{"password length can't be zero."} = sub { defined && length }; |
549
|
0
|
0
|
|
0
|
|
|
} |
550
|
0
|
|
|
|
|
|
return text_input($prompt,%args); |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
my ($prompt,$args) = @_; |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
state $interactive = is_interactive(); |
556
|
|
|
|
|
|
|
state $term; |
557
|
0
|
|
|
0
|
1
|
|
|
558
|
0
|
|
|
|
|
|
my $text = ''; |
559
|
|
|
|
|
|
|
if( $interactive ) { |
560
|
0
|
0
|
|
|
|
|
# Initialize Term |
561
|
0
|
0
|
|
|
|
|
$term ||= Term::ReadLine->new($0); |
562
|
|
|
|
|
|
|
$args ||= {}; |
563
|
0
|
0
|
|
|
|
|
if( exists $args->{noecho} ) { |
564
|
0
|
|
|
|
|
|
my $attrs = $term->Attribs; |
565
|
0
|
|
0
|
|
|
|
if( $attrs->{shadow_redisplay} ) { |
566
|
0
|
0
|
|
0
|
|
|
my $restore = $attrs->{redisplay_function}; |
|
0
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
$attrs->{redisplay_function} = $attrs->{shadow_redisplay}; |
568
|
0
|
|
|
|
|
|
$text = $term->readline($prompt); |
569
|
|
|
|
|
|
|
$attrs->{redisplay_function} = $restore; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
else { |
572
|
0
|
|
|
0
|
|
|
# Disable all the Term ReadLine magic |
573
|
|
|
|
|
|
|
local $|=1; |
574
|
0
|
|
|
|
|
|
print $prompt; |
575
|
0
|
|
|
|
|
|
ReadMode('noecho'); |
576
|
|
|
|
|
|
|
1 until ReadKey(-1); |
577
|
0
|
|
|
|
|
|
$text = ReadLine(); |
578
|
0
|
0
|
|
|
|
|
ReadMode('restore'); |
579
|
|
|
|
|
|
|
print "\n"; |
580
|
0
|
|
0
|
|
|
|
chomp($text); |
581
|
0
|
|
0
|
|
|
|
} |
582
|
0
|
0
|
|
|
|
|
} |
583
|
0
|
|
|
|
|
|
else { |
584
|
0
|
0
|
|
|
|
|
$text = $term->readline($prompt); |
585
|
0
|
|
|
|
|
|
$term->addhistory($text) if length $text && $text =~ /\S/; |
586
|
0
|
|
|
|
|
|
} |
587
|
0
|
|
|
|
|
|
} |
588
|
0
|
|
|
|
|
|
else { |
589
|
|
|
|
|
|
|
# Read one line from STDIN |
590
|
|
|
|
|
|
|
$text = <>; |
591
|
|
|
|
|
|
|
} |
592
|
0
|
|
|
|
|
|
return $text; |
593
|
0
|
|
|
|
|
|
} |
594
|
0
|
|
|
|
|
|
|
595
|
0
|
|
|
|
|
|
|
596
|
0
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
|
# Return True |
598
|
0
|
|
|
|
|
|
1; |
599
|
0
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=pod |
602
|
|
|
|
|
|
|
|
603
|
0
|
|
|
|
|
|
=encoding UTF-8 |
604
|
0
|
0
|
0
|
|
|
|
|
605
|
|
|
|
|
|
|
=head1 NAME |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
CLI::Helpers - Subroutines for making simple command line scripts |
608
|
|
|
|
|
|
|
|
609
|
0
|
|
|
|
|
|
=head1 VERSION |
610
|
|
|
|
|
|
|
|
611
|
0
|
|
|
|
|
|
version 1.9 |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
=head1 SYNOPSIS |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
Use this module to make writing intelligent command line scripts easier. |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
#!/usr/bin/env perl |
618
|
|
|
|
|
|
|
use CLI::Helpers qw(:all); |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
output({color=>'green'}, "Hello, World!"); |
621
|
|
|
|
|
|
|
verbose({indent=>1,color=>'yellow'}, "Shiny, happy people!"); |
622
|
|
|
|
|
|
|
verbose({level=>2,kv=>1,color=>'red'}, a => 1, b => 2); |
623
|
|
|
|
|
|
|
debug_var({ c => 3, d => 4}); |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
# Data |
626
|
|
|
|
|
|
|
output({data=>1}, join(',', qw(a b c d))); |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
# Wait for confirmation |
629
|
|
|
|
|
|
|
die "ABORTING" unless confirm("Are you sure?"); |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
# Ask for a number |
632
|
|
|
|
|
|
|
my $integer = prompt "Enter an integer:", validate => { "not a number" => sub { /^\d+$/ } } |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
# Ask for next move |
635
|
|
|
|
|
|
|
my %menu = ( |
636
|
|
|
|
|
|
|
north => "Go north.", |
637
|
|
|
|
|
|
|
south => "Go south.", |
638
|
|
|
|
|
|
|
); |
639
|
|
|
|
|
|
|
my $dir = prompt "Where to, adventurous explorer?", menu => \%menu; |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# Ask for a favorite animal |
642
|
|
|
|
|
|
|
my $favorite = menu("Select your favorite animal:", [qw(dog cat pig fish otter)]); |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
Running: |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
$ ./test.pl |
647
|
|
|
|
|
|
|
Hello, World! |
648
|
|
|
|
|
|
|
a,b,c,d |
649
|
|
|
|
|
|
|
$ ./test.pl --verbose |
650
|
|
|
|
|
|
|
Hello, World! |
651
|
|
|
|
|
|
|
Shiny, Happy people! |
652
|
|
|
|
|
|
|
a,b,c,d |
653
|
|
|
|
|
|
|
$ ./test.pl -vv |
654
|
|
|
|
|
|
|
Hello, World! |
655
|
|
|
|
|
|
|
Shiny, Happy people! |
656
|
|
|
|
|
|
|
a: 1 |
657
|
|
|
|
|
|
|
b: 2 |
658
|
|
|
|
|
|
|
a,b,c,d |
659
|
|
|
|
|
|
|
$ ./test.pl --debug |
660
|
|
|
|
|
|
|
Hello, World! |
661
|
|
|
|
|
|
|
Shiny, Happy people! |
662
|
|
|
|
|
|
|
a: 1 |
663
|
|
|
|
|
|
|
b: 2 |
664
|
|
|
|
|
|
|
--- |
665
|
|
|
|
|
|
|
c: 3 |
666
|
|
|
|
|
|
|
d: 4 |
667
|
|
|
|
|
|
|
a,b,c,d |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
$ ./test.pl --data-file=output.csv |
670
|
|
|
|
|
|
|
Hello, World! |
671
|
|
|
|
|
|
|
a,b,c,d |
672
|
|
|
|
|
|
|
$ cat output.csv |
673
|
|
|
|
|
|
|
a,b,c,d |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
Colors would be automatically enabled based on the user's ~/.gitconfig |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=head1 OVERVIEW |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
This module provides a library of useful functions for constructing simple command |
680
|
|
|
|
|
|
|
line interfaces. It is able to extract information from the environment and your |
681
|
|
|
|
|
|
|
~/.gitconfig to display data in a reasonable manner. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
Using this module adds argument parsing using L<Getopt::Long> to your script. It |
684
|
|
|
|
|
|
|
enables pass-through, so you can still use your own argument parsing routines or |
685
|
|
|
|
|
|
|
Getopt::Long in your script. |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=head1 FUNCTIONS |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
=head2 cli_helpers_initialize |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
This is called automatically when C<preprocess_argv> is set. By default, it'll |
692
|
|
|
|
|
|
|
be run the first time a definition is needed, usually the first call to |
693
|
|
|
|
|
|
|
C<output()>. If called automatically, it will operate on C<@ARGV>. You can |
694
|
|
|
|
|
|
|
optionally pass an array reference to this function and it'll operate that |
695
|
|
|
|
|
|
|
instead. |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
In most cases, you don't need to call this function directly. It must be |
698
|
|
|
|
|
|
|
explicitly requested in the import. |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
use CLI::Helpers qw( :output ); |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
... |
703
|
|
|
|
|
|
|
# I want access to ARGV before CLI::Helpers; |
704
|
|
|
|
|
|
|
my %opts = get_important_things_from(\@ARGV); |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
# Now, let CLI::Helpers take the rest, implicit |
707
|
|
|
|
|
|
|
# call to cli_helpers_initialize() |
708
|
|
|
|
|
|
|
output("ready"); |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
Alternatively, you could: |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
use CLI::Helpers qw( :output preprocess_argv ); |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
... |
715
|
|
|
|
|
|
|
# Since CLI::Helpers opts are stripped from @ARGV, |
716
|
|
|
|
|
|
|
# Getopt::Long::Descriptive won't complain about extra args |
717
|
|
|
|
|
|
|
my ($opt,$usage) = describe_option( ... ); |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
# Now, let CLI::Helpers take the rest, implicit |
720
|
|
|
|
|
|
|
# call to cli_helpers_initialize() |
721
|
|
|
|
|
|
|
output("ready"); |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
Or if you'd prefer not to touch C<@ARGV> at all, you pass in an array ref: |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
use CLI::Helpers qw( :output ); |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
my ($opt,$usage) = describe_option( ... ); |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
cli_helpers_initialize([ qw( --verbose ) ]); |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
output("ready?"); |
732
|
|
|
|
|
|
|
verbose("you bet I am"); |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=head2 def |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
Not exported by default, returns the setting defined. |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=head2 git_color_check |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
Not exported by default. Returns 1 if git is configured to output |
741
|
|
|
|
|
|
|
using color of 0 if color is not enabled. |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=head2 colorize( $color => 'message to be output' ) |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
Not exported by default. Checks if color is enabled and applies |
746
|
|
|
|
|
|
|
the specified color to the string. |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=head2 output( \%opts, @messages ) |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Exported. Takes an optional hash reference and a list of |
751
|
|
|
|
|
|
|
messages to be output. |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=head2 verbose( \%opts, @messages ) |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
Exported. Takes an optional hash reference of formatting options. Automatically |
756
|
|
|
|
|
|
|
overrides the B<level> parameter to 1 if it's not set. |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=head2 debug( \%opts, @messages ) |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Exported. Takes an optional hash reference of formatting options. |
761
|
|
|
|
|
|
|
Does not output anything unless DEBUG is set. |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
=head2 debug_var( \%opts, \%Variable ) |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
Exported. Takes an optional hash reference of formatting options. |
766
|
|
|
|
|
|
|
Does not output anything unless DEBUG is set. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=head2 override( variable => 1 ) |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
Exported. Allows a block of code to override the debug or verbose level. This |
771
|
|
|
|
|
|
|
can be used during development to enable/disable the DEBUG/VERBOSE settings. |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=head2 confirm("prompt") |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
Exported. Creates a Yes/No Prompt which accepts y/n or yes/no case insensitively |
776
|
|
|
|
|
|
|
but requires one or the other. |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
Returns 1 for 'yes' and 0 for 'no' |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=head2 text_input("prompt", validate => { "too short" => sub { length $_ > 10 } }) |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
Exported. Provides a prompt to the user for input. If validate is passed, it should be a hash reference |
783
|
|
|
|
|
|
|
containing keys of error messages and values which are subroutines to validate the input available as $_. |
784
|
|
|
|
|
|
|
If a validator fails, it's error message will be displayed, and the user will be re-prompted. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
Valid options are: |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=over 4 |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=item B<default> |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
Any string which will be used as the default value if the user just presses enter. |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=item B<validate> |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
A hashref, keys are error messages, values are sub routines that return true when the value meets the criteria. |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
=item B<noecho> |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
Set as a key with any value and the prompt will turn off echoing responses as well as disabling all |
801
|
|
|
|
|
|
|
ReadLine magic. See also B<pwprompt>. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=back |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
Returns the text that has passed all validators. |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=head2 menu("prompt", $ArrayOrHashRef) |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
Exported. Used to create a menu of options from a list. Can be either a hash or array reference |
810
|
|
|
|
|
|
|
as the second argument. In the case of a hash reference, the values will be displayed as options while |
811
|
|
|
|
|
|
|
the selected key is returned. In the case of an array reference, each element in the list is displayed |
812
|
|
|
|
|
|
|
the selected element will be returned. |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
Returns selected element (HashRef -> Key, ArrayRef -> The Element) |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=head2 pwprompt("Prompt", options ) |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
Exported. Synonym for text_input("Password: ", noecho => 1); Also requires the password to be longer than 0 characters. |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=head2 prompt("Prompt", options ) |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
Exported. Wrapper function with rudimentary mimicry of IO::Prompt(er). |
823
|
|
|
|
|
|
|
Uses: |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
# Mapping back to confirm(); |
826
|
|
|
|
|
|
|
my $value = prompt "Are you sure?", yn => 1; |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
# Mapping back to text_input(); |
829
|
|
|
|
|
|
|
my $value = prompt "Enter something:"; |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
# With Validator |
832
|
|
|
|
|
|
|
my $value = prompt "Enter an integer:", validate => { "not a number" => sub { /^\d+$/ } } |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
# Pass to menu(); |
835
|
|
|
|
|
|
|
my $value = prompt "Select your favorite animal:", menu => [qw(dog cat pig fish otter)]; |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
# If you request a password, autodisable echo: |
838
|
|
|
|
|
|
|
my $passwd = prompt "Password: "; # sets noecho => 1, disables ReadLine history. |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
See also: B<text_input> |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=head1 EXPORT |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
This module uses L<Sub::Exporter> for flexible imports, the defaults provided by |
845
|
|
|
|
|
|
|
:all are as follows. |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=head2 Exported Functions |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
output ( \%options, @messages ) |
850
|
|
|
|
|
|
|
verbose ( \%options, @messages ) |
851
|
|
|
|
|
|
|
debug ( \%options, @messages ) |
852
|
|
|
|
|
|
|
debug_var ( \$var ) |
853
|
|
|
|
|
|
|
override( option => $value ) |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
menu ( "Question", \%Options or \@Options ) |
856
|
|
|
|
|
|
|
text_input ( "Question", validate => { "error message" => sub { length $_[0] } } ) |
857
|
|
|
|
|
|
|
confirm ( "Question" ) |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
prompt() Wrapper which mimics IO::Prompt a bit |
860
|
|
|
|
|
|
|
pwprompt() Wrapper to get sensitive data |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=head2 Import Time Configurations |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
It's possible to change the behavior of the import process. |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
=over 2 |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
=item B<copy_argv> |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
Instead of messing with C<@ARGV>, operate on a copy of C<@ARGV>. |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
use CLI::Helpers qw( :output copy_argv ); |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
=item B<preprocess_argv> |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
This causes the C<@ARGV> processing to happen during the C<INIT> phase, after |
877
|
|
|
|
|
|
|
import but before runtime. This is usually OK for scripts, but for use in |
878
|
|
|
|
|
|
|
libraries, it may be undesirable. |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
use CLI::Helpers qw( :output preprocess_argv ); |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
=item B<delay_argv> |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
This causes the C<@ARGV> processing to happen when the first call to a function |
885
|
|
|
|
|
|
|
needing it run, usually an C<output()> call. This is the default. |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
use CLI::Helpers qw( :output delay_argv ); |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=back |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=head1 ARGS |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
From CLI::Helpers: |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
--data-file Path to a file to write lines tagged with 'data => 1' |
896
|
|
|
|
|
|
|
--tags A comma separated list of tags to display |
897
|
|
|
|
|
|
|
--color Boolean, enable/disable color, default use git settings |
898
|
|
|
|
|
|
|
--verbose Incremental, increase verbosity (Alias is -v) |
899
|
|
|
|
|
|
|
--debug Show developer output |
900
|
|
|
|
|
|
|
--debug-class Show debug messages originating from a specific package, default: main |
901
|
|
|
|
|
|
|
--quiet Show no output (for cron) |
902
|
|
|
|
|
|
|
--syslog Generate messages to syslog as well |
903
|
|
|
|
|
|
|
--syslog-facility Default "local0" |
904
|
|
|
|
|
|
|
--syslog-tag The program name, default is the script name |
905
|
|
|
|
|
|
|
--syslog-debug Enable debug messages to syslog if in use, default false |
906
|
|
|
|
|
|
|
--nopaste Use App::Nopaste to paste output to configured paste service |
907
|
|
|
|
|
|
|
--nopaste-public Defaults to false, specify to use public paste services |
908
|
|
|
|
|
|
|
--nopaste-service Comma-separated App::Nopaste service, defaults to Shadowcat |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
=head1 NOPASTE |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
This is optional and will only work if you have L<App::Nopaste> installed. If |
913
|
|
|
|
|
|
|
you just specify C<--nopaste>, any output that would be displayed to the screen |
914
|
|
|
|
|
|
|
is submitted to the L<App::Nopaste::Service::Shadowcat> paste bin. This |
915
|
|
|
|
|
|
|
paste service is pretty simple, but works reliably. |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
During the C<END> block, the output is submitted and the URL of the paste is |
918
|
|
|
|
|
|
|
returned to the user. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
=head1 OUTPUT OPTIONS |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
Every output function takes an optional HASH reference containing options for |
923
|
|
|
|
|
|
|
that output. The hash may contain the following options: |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
=over 4 |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
=item B<tag> |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
Add a keyword to tag output with. The user may then specify C<--tags |
930
|
|
|
|
|
|
|
keyword1,keyword2> to only view output at the appropriate level. This option |
931
|
|
|
|
|
|
|
will affect C<data-file> and C<syslog> output. The output filter requires both |
932
|
|
|
|
|
|
|
the presence of the C<tag> in the output options B<and> the user to specify |
933
|
|
|
|
|
|
|
C<--tags> on the command line. |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
Consider a script, C<status.pl>: |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
output("System Status: Normal") |
938
|
|
|
|
|
|
|
output({tag=>'foo'}, "Component Foo: OK"); |
939
|
|
|
|
|
|
|
output({tag=>'bar'}, "Component Bar: OK"); |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
If an operator runs: |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
$ status.pl |
944
|
|
|
|
|
|
|
System Status: Normal |
945
|
|
|
|
|
|
|
Component Foo: OK |
946
|
|
|
|
|
|
|
Component Bar: OK |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
$ status.pl --tags bar |
949
|
|
|
|
|
|
|
System Status: Normal |
950
|
|
|
|
|
|
|
Component Bar: OK |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
$ status.pl --tags foo |
953
|
|
|
|
|
|
|
System Status: Normal |
954
|
|
|
|
|
|
|
Component Foo: OK |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
This could be helpful for selecting one or more pertinent tags to display. |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=item B<sticky> |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Any lines tagged with 'sticky' will be replayed at the end program's end. This |
961
|
|
|
|
|
|
|
is to allow a developer to ensure message are seen at the termination of the program. |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
=item B<color> |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
String. Using Term::ANSIColor for output, use the color designated, i.e.: |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
red,blue,green,yellow,cyan,magenta,white,black, etc.. |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
=item B<level> |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
Integer. For verbose output, this is basically the number of -v's necessary to see |
972
|
|
|
|
|
|
|
this output. |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=item B<syslog_level> |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
String. Can be any valid syslog_level as a string: debug, info, notice, warning, err, crit, |
977
|
|
|
|
|
|
|
alert, emerg. |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
=item B<no_syslog> |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
Bool. Even if the user specifies --syslog, these lines will not go to the syslog destination. |
982
|
|
|
|
|
|
|
alert, emerg. |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=item B<IMPORTANT> |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
Bool. Even if --quiet is specified, output this message. Use sparingly, and yes, |
987
|
|
|
|
|
|
|
it is case sensitive. You need to yell at it for it to yell at your users. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=item B<stderr> |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
Bool. Use STDERR for this message instead of STDOUT. The advantage to using this is the |
992
|
|
|
|
|
|
|
"quiet" option will silence these messages as well. |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=item B<indent> |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
Integer. This will indent by 2 times the specified integer the next string. Useful |
997
|
|
|
|
|
|
|
for creating nested output in a script. |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=item B<clear> |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
Integer. The number of newlines before this output. |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
=item B<kv> |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
Bool. The array of messages is actually a key/value pair, this implements special coloring and |
1006
|
|
|
|
|
|
|
expects the number of messages to be even. |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
output(qw(a 1 b 2)); |
1009
|
|
|
|
|
|
|
# a |
1010
|
|
|
|
|
|
|
# 1 |
1011
|
|
|
|
|
|
|
# b |
1012
|
|
|
|
|
|
|
# 2 |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
Using kv, the output will look like this: |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
output({kv=>1}, qw(a 1 b 2)); |
1017
|
|
|
|
|
|
|
# a: 1 |
1018
|
|
|
|
|
|
|
# b: 2 |
1019
|
|
|
|
|
|
|
# |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item B<data> |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
Bool. Lines tagged with "data => 1" will be output to the data-file if a user specifies it. This allows |
1024
|
|
|
|
|
|
|
you to provide header/footers and inline context for the main CLI, but output just the data to a file for |
1025
|
|
|
|
|
|
|
piping elsewhere. |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
=back |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
=head1 AUTHOR |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
Brad Lhotsky <brad@divisionbyzero.net> |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
This software is Copyright (c) 2022 by Brad Lhotsky. |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
This is free software, licensed under: |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
The (three-clause) BSD License |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
=for stopwords Kang-min Liu Kevin M. Goess Mohammad S Anwar |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=over 4 |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
=item * |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
Kang-min Liu <gugod@gugod.org> |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
=item * |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
Kevin M. Goess <kgoess@craigslist.org> |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
=item * |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
Mohammad S Anwar <mohammad.anwar@yahoo.com> |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
=back |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
=for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
=head1 SUPPORT |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=head2 Websites |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
The following websites have more information about this module, and may be of help to you. As always, |
1068
|
|
|
|
|
|
|
in addition to those websites please use your favorite search engine to discover more resources. |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
=over 4 |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
=item * |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
MetaCPAN |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
A modern, open-source CPAN search engine, useful to view POD in HTML format. |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
L<https://metacpan.org/release/CLI-Helpers> |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
=item * |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
RT: CPAN's Bug Tracker |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
L<https://rt.cpan.org/Public/Dist/Display.html?Name=CLI-Helpers> |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=back |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
=head2 Source Code |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
This module's source code is available by visiting: |
1093
|
|
|
|
|
|
|
L<https://github.com/reyjrar/CLI-Helpers> |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
=cut |