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