File Coverage

blib/lib/Venus/Cli.pm
Criterion Covered Total %
statement 395 515 76.7
branch 120 170 70.5
condition 70 114 61.4
subroutine 61 112 54.4
pod 16 104 15.3
total 662 1015 65.2


line stmt bran cond sub pod time code
1             package Venus::Cli;
2              
3 2     2   1287 use 5.018;
  2         7  
4              
5 2     2   11 use strict;
  2         4  
  2         51  
6 2     2   10 use warnings;
  2         4  
  2         80  
7              
8 2     2   18 use Venus::Class 'attr', 'base', 'with';
  2         4  
  2         17  
9              
10             base 'Venus::Kind::Utility';
11              
12             with 'Venus::Role::Stashable';
13              
14             require POSIX;
15              
16             # ATTRIBUTES
17              
18             attr 'data';
19              
20             # BUILDERS
21              
22             sub build_arg {
23 38     38 0 122 my ($self, $data) = @_;
24              
25             return {
26 38         160 data => $data,
27             };
28             }
29              
30             sub build_self {
31 77     77 0 203 my ($self, $data) = @_;
32              
33 77   100     294 $self->{data} ||= [@ARGV];
34              
35 77         212 return $self;
36             }
37              
38             # HOOKS
39              
40             sub _exit {
41 0     0     POSIX::_exit(shift);
42             }
43              
44             sub _print {
45 0     0     do {local $| = 1; CORE::print(@_, "\n")}
  0            
  0            
46             }
47              
48             sub _prompt {
49 0     0     do {local $\ = ''; local $_ = ; chomp; $_}
  0            
  0            
  0            
  0            
50             }
51              
52             # METHODS
53              
54             sub arg {
55 17     17 1 49 my ($self, $name) = @_;
56              
57 17 50       43 return undef if !$name;
58              
59 17         28 my @values;
60              
61 17 100       51 my $data = $self->get('arg', $name) or return undef;
62 16         39 my $_default = $data->{default};
63 16         36 my $_help = $data->{help};
64 16         37 my $_label = $data->{label};
65 16         22 my $_name = $data->{name};
66 16         35 my $_prompt = $data->{prompt};
67 16         28 my $_range = $data->{range};
68 16         21 my $_required = $data->{required};
69 16         31 my $_type = $data->{type};
70              
71 16         1027 require Venus::Array;
72              
73             # value
74 16   100     33 @values = @{Venus::Array->new($self->parser->unused)->range($_range // 0)};
  16         67  
75              
76             # prompt
77 16 100 33     62 if ($_prompt && (!@values || !defined $values[0])) {
      66        
78 2   33     4 @values = (do{_print join ': ', $_label || $_name, $_prompt; _prompt}); _print;
  2         19  
  2         18  
  2         11  
79             }
80              
81             # default
82 16 50 33     84 if (defined $_default
      66        
      33        
83             && (!@values || !defined $values[0] || $values[0] eq '')
84             && exists $data->{default})
85             {
86 2         11 @values = ($_default);
87             }
88              
89             # return boolean values
90 16 0       73 @values = map +(lc($_type) eq 'boolean' ? ($_ ? true : false) : $_), @values
    50          
    100          
91             if $_type;
92              
93             # returns
94 16 100       100 return wantarray ? (@values) : [@values];
95             }
96              
97             sub cmd {
98 7     7 1 17 my ($self, $name) = @_;
99              
100 7 50       20 return undef if !$name;
101              
102 7 100       15 my $data = $self->get('cmd', $name) or return undef;
103              
104 6         26 my $value = $self->try('arg')->maybe->result($data->{arg});
105              
106 6 100 100     15 return (($value // '') eq $name) ? true : false;
107             }
108              
109             sub exit {
110 10     10 1 185 my ($self, $code, $method, @args) = @_;
111              
112 10 100       48 $self->$method(@args) if $method;
113              
114 10   100     44 $code ||= 0;
115              
116 10         37 _exit($code);
117             }
118              
119             sub fail {
120 2     2 1 11 my ($self, $method, @args) = @_;
121              
122 2         9 return $self->exit(1, $method, @args);
123             }
124              
125             sub get {
126 102     102 1 239 my ($self, $key, $name) = @_;
127              
128 102 100       233 return undef if !$key;
129              
130 101         212 my $method = "get_${key}";
131              
132 101         308 return $self->$method($name);
133             }
134              
135             sub get_arg {
136 42     42 0 97 my ($self, $name) = @_;
137              
138 42         95 return $self->store('arg', $name);
139             }
140              
141             sub get_arg_default {
142 0     0 0 0 my ($self, $name) = @_;
143              
144 0         0 return $self->store('arg', $name, 'default');
145             }
146              
147             sub get_arg_help {
148 0     0 0 0 my ($self, $name) = @_;
149              
150 0         0 return $self->store('arg', $name, 'help');
151             }
152              
153             sub get_arg_label {
154 0     0 0 0 my ($self, $name) = @_;
155              
156 0         0 return $self->store('arg', $name, 'label');
157             }
158              
159             sub get_arg_name {
160 0     0 0 0 my ($self, $name) = @_;
161              
162 0         0 return $self->store('arg', $name, 'name');
163             }
164              
165             sub get_arg_prompt {
166 0     0 0 0 my ($self, $name) = @_;
167              
168 0         0 return $self->store('arg', $name, 'prompt');
169             }
170              
171             sub get_arg_range {
172 0     0 0 0 my ($self, $name) = @_;
173              
174 0         0 return $self->store('arg', $name, 'range');
175             }
176              
177             sub get_arg_required {
178 0     0 0 0 my ($self, $name) = @_;
179              
180 0         0 return $self->store('arg', $name, 'required');
181             }
182              
183             sub get_arg_type {
184 0     0 0 0 my ($self, $name) = @_;
185              
186 0         0 return $self->store('arg', $name, 'type');
187             }
188              
189             sub get_cmd {
190 12     12 0 32 my ($self, $name) = @_;
191              
192 12         28 return $self->store('cmd', $name);
193             }
194              
195             sub get_cmd_arg {
196 0     0 0 0 my ($self, $name) = @_;
197              
198 0         0 return $self->store('cmd', $name, 'arg');
199             }
200              
201             sub get_cmd_help {
202 0     0 0 0 my ($self, $name) = @_;
203              
204 0         0 return $self->store('cmd', $name, 'help');
205             }
206              
207             sub get_cmd_label {
208 0     0 0 0 my ($self, $name) = @_;
209              
210 0         0 return $self->store('cmd', $name, 'label');
211             }
212              
213             sub get_cmd_name {
214 0     0 0 0 my ($self, $name) = @_;
215              
216 0         0 return $self->store('cmd', $name, 'name');
217             }
218              
219             sub get_opt {
220 41     41 0 87 my ($self, $name) = @_;
221              
222 41         88 return $self->store('opt', $name);
223             }
224              
225             sub get_opt_alias {
226 0     0 0 0 my ($self, $name) = @_;
227              
228 0         0 return $self->store('opt', $name, 'alias');
229             }
230              
231             sub get_opt_default {
232 0     0 0 0 my ($self, $name) = @_;
233              
234 0         0 return $self->store('opt', $name, 'default');
235             }
236              
237             sub get_opt_help {
238 0     0 0 0 my ($self, $name) = @_;
239              
240 0         0 return $self->store('opt', $name, 'help');
241             }
242              
243             sub get_opt_label {
244 0     0 0 0 my ($self, $name) = @_;
245              
246 0         0 return $self->store('opt', $name, 'label');
247             }
248              
249             sub get_opt_multi {
250 0     0 0 0 my ($self, $name) = @_;
251              
252 0 0       0 return $self->store('opt', $name, 'multi') ? true : false;
253             }
254              
255             sub get_opt_name {
256 0     0 0 0 my ($self, $name) = @_;
257              
258 0         0 return $self->store('opt', $name, 'name');
259             }
260              
261             sub get_opt_prompt {
262 0     0 0 0 my ($self, $name) = @_;
263              
264 0         0 return $self->store('opt', $name, 'prompt');
265             }
266              
267             sub get_opt_required {
268 0     0 0 0 my ($self, $name) = @_;
269              
270 0         0 return $self->store('opt', $name, 'required');
271             }
272              
273             sub get_opt_type {
274 0     0 0 0 my ($self, $name) = @_;
275              
276 0         0 return $self->store('opt', $name, 'type');
277             }
278              
279             sub get_str {
280 83     83 0 136 my ($self, $name) = @_;
281              
282 83         158 return $self->store('str', $name, 'value');
283             }
284              
285             sub get_str_arg {
286 0     0 0 0 my ($self, $name) = @_;
287              
288 0         0 return $self->store('str', $name, 'arg');
289             }
290              
291             sub get_str_author {
292 0     0 0 0 my ($self, $name) = @_;
293              
294 0         0 return $self->store('str', $name, 'author');
295             }
296              
297             sub get_str_description {
298 0     0 0 0 my ($self, $name) = @_;
299              
300 0         0 return $self->store('str', $name, 'description');
301             }
302              
303             sub get_str_footer {
304 0     0 0 0 my ($self, $name) = @_;
305              
306 0         0 return $self->store('str', $name, 'footer');
307             }
308              
309             sub get_str_header {
310 0     0 0 0 my ($self, $name) = @_;
311              
312 0         0 return $self->store('str', $name, 'header');
313             }
314              
315             sub get_str_name {
316 0     0 0 0 my ($self, $name) = @_;
317              
318 0         0 return $self->store('str', $name, 'name');
319             }
320              
321             sub get_str_opt {
322 0     0 0 0 my ($self, $name) = @_;
323              
324 0         0 return $self->store('str', $name, 'opt');
325             }
326              
327             sub get_str_opts {
328 0     0 0 0 my ($self, $name) = @_;
329              
330 0         0 return $self->store('str', $name, 'opts');
331             }
332              
333             sub get_str_version {
334 0     0 0 0 my ($self, $name) = @_;
335              
336 0         0 return $self->store('str', $name, 'version');
337             }
338              
339             sub help {
340 12     12 1 30 my ($self) = @_;
341              
342 12         37 my @output = ($self->help_usage);
343              
344             # description
345 12 50       46 if (my $description = $self->help_description) {
346 0         0 push @output, $description;
347             }
348              
349             # header
350 12 50       48 if (my $header = $self->help_header) {
351 0         0 push @output, $header;
352             }
353              
354             # arguments
355 12 100       71 if (my $arguments = $self->help_arguments) {
356 6         10 push @output, $arguments;
357             }
358              
359             # options
360 12 100       43 if (my $options = $self->help_options) {
361 2         3 push @output, $options;
362             }
363              
364             # commands
365 12 100       44 if (my $commands = $self->help_commands) {
366 2         4 push @output, $commands;
367             }
368              
369             # footer
370 12 50       37 if (my $footer = $self->help_footer) {
371 0         0 push @output, $footer;
372             }
373              
374 12         94 return join("\n\n", @output);
375             }
376              
377             sub help_arg {
378 6     6 0 17 my ($self, $name) = @_;
379              
380 6         7 my @result;
381              
382 6 50       14 my $data = $self->get('arg', $name) or return ();
383              
384 6         13 my $_help = $data->{help};
385 6         11 my $_name = $data->{name};
386 6         10 my $_range = $data->{range};
387 6         10 my $_required = $data->{required};
388 6         10 my $_type = $data->{type};
389 6   66     19 my $_multi = $_range && $_range =~ /:/;
390              
391 6         10 my $note = $_name;
392              
393 6 100       12 if ($_multi) {
394 1         6 $note = "$note, ...";
395             }
396              
397 6         15 push @result, [
398             '', $note
399             ];
400              
401 6 50       13 if ($_help) {
402 6         35 push @result, [
403             _wrap_text(4, 80, [split / /, $_help])
404             ];
405             }
406              
407 6 100       21 if ($_required) {
408 5         19 push @result, [
409             '', '', '(required)'
410             ];
411             }
412             else {
413 1         4 push @result, [
414             '', '', '(optional)'
415             ];
416             }
417              
418 6 100       25 if ($_type) {
419 1         4 push @result, [
420             '', '', "($_type)"
421             ];
422             }
423              
424 6         10 return join("\n", map join(' ', @{$_}), @result);
  19         66  
425             }
426              
427             sub help_args {
428 12     12 0 42 my ($self) = @_;
429              
430 12         23 my @result;
431              
432 12   100     34 my $order = $self->store('arg_order') || {};
433              
434 12         33 for my $index (sort keys %{$order}) {
  12         48  
435 6         25 push @result, $self->help_arg($order->{$index});
436             }
437              
438 12         76 return join("\n\n", @result);
439             }
440              
441             sub help_arguments {
442 12     12 0 85 my ($self) = @_;
443              
444 12 100       59 my $arguments = $self->help_args or return ();
445              
446 6         23 return join "\n\n", "Arguments:", $arguments;
447             }
448              
449             sub help_author {
450 0     0 0 0 my ($self) = @_;
451              
452 0   0     0 return $self->str('author') || ();
453             }
454              
455             sub help_cmd {
456 2     2 0 23 my ($self, $name) = @_;
457              
458 2         3 my @result;
459              
460 2 50       5 my $data = $self->get('cmd', $name) or return ();
461              
462 2         4 my $_help = $data->{help};
463 2         5 my $_name = $data->{name};
464              
465 2   50     6 my $arg = $self->get('arg', $data->{arg}) || {};
466              
467 2         5 my $_range = $arg->{range};
468 2         4 my $_required = $arg->{required};
469 2         3 my $_type = $arg->{type};
470 2   33     6 my $_multi = $_range && $_range =~ /:/;
471              
472 2         4 my $note = $_name;
473              
474 2 50       5 if ($_multi) {
475 0         0 $note = "$note, ...";
476             }
477              
478 2         8 push @result, [
479             '', $note
480             ];
481              
482 2 50       6 if ($_help) {
483 2         13 push @result, [
484             _wrap_text(4, 80, [split / /, $_help])
485             ];
486             }
487              
488 2 50       8 if ($arg->{name}) {
489             push @result, [
490             '', '', sprintf("(%s)", $arg->{name})
491 2         12 ];
492             }
493              
494 2         8 return join("\n", map join(' ', @{$_}), @result);
  6         24  
495             }
496              
497             sub help_cmds {
498 12     12 0 26 my ($self) = @_;
499              
500 12         17 my @result;
501              
502 12   100     24 my $order = $self->store('cmd_order') || {};
503              
504 12         30 for my $index (sort keys %{$order}) {
  12         33  
505 2         9 push @result, $self->help_cmd($order->{$index});
506             }
507              
508 12         63 return join("\n\n", @result);
509             }
510              
511             sub help_commands {
512 12     12 0 31 my ($self) = @_;
513              
514 12 100       37 my $commands = $self->help_cmds or return ();
515              
516 2         12 return join "\n\n", "Commands:", $commands;
517             }
518              
519             sub help_description {
520 12     12 0 28 my ($self) = @_;
521              
522 12 50       26 my $description = $self->str('description') or return ();
523              
524 0         0 return join "\n", map _wrap_text(0, 80, [split / /, $_]), split /\n/, $description;
525             }
526              
527             sub help_footer {
528 12     12 0 28 my ($self) = @_;
529              
530 12 50       30 my $footer = $self->str('footer') or return ();
531              
532 0         0 return join "\n", map _wrap_text(0, 80, [split / /, $_]), split /\n/, $footer;
533             }
534              
535             sub help_header {
536 12     12 0 23 my ($self) = @_;
537              
538 12 50       31 my $header = $self->str('header') or return ();
539              
540 0         0 return join "\n", map _wrap_text(0, 80, [split / /, $_]), split /\n/, $header;
541             }
542              
543             sub help_name {
544 24     24 0 44 my ($self) = @_;
545              
546 24   100     56 return $self->str('name') || 'application';
547             }
548              
549             sub help_opt {
550 2     2 0 5 my ($self, $name) = @_;
551              
552 2         3 my @result;
553              
554 2 50       5 my $data = $self->get('opt', $name) or return ();
555              
556 2         4 my $_alias = $data->{alias};
557 2         7 my $_help = $data->{help};
558 2         3 my $_multi = $data->{multi};
559 2         4 my $_name = $data->{name};
560 2         5 my $_required = $data->{required};
561 2         4 my $_type = $data->{type};
562              
563 2         4 my $note = "--$_name";
564              
565 2         13 my %type_map = (
566             boolean => undef,
567             float => 'float',
568             number => 'number',
569             string => 'string',
570             yesno => 'yesno',
571             );
572              
573 2 0 33     8 $note = "$note=<$_name>" if $_type && $type_map{$_type};
574              
575 2 50       6 if ($_alias) {
576             $note = join(', ',
577 2 50       8 (map "-$_", (ref $_alias eq 'ARRAY' ? sort @{$_alias} : $_alias)), $note);
  2         11  
578             }
579              
580 2 50       6 if ($_multi) {
581 0         0 $note = "$note, ...";
582             }
583              
584 2         6 push @result, [
585             '', $note
586             ];
587              
588 2 50       6 if ($_help) {
589 2         10 push @result, [
590             _wrap_text(4, 80, [split / /, $_help])
591             ];
592             }
593              
594 2 50       10 if ($_required) {
595 0         0 push @result, [
596             '', '', '(required)'
597             ];
598             }
599             else {
600 2         7 push @result, [
601             '', '', '(optional)'
602             ];
603             }
604              
605 2 50       8 if ($_type) {
606 0         0 push @result, [
607             '', '', "($_type)"
608             ];
609             }
610              
611 2         4 return join("\n", map join(' ', @{$_}), @result);
  6         24  
612             }
613              
614             sub help_options {
615 12     12 0 26 my ($self) = @_;
616              
617 12 100       33 my $options = $self->help_opts or return ();
618              
619 2         8 return join "\n\n", "Options:", $options;
620             }
621              
622             sub help_opts {
623 12     12 0 26 my ($self) = @_;
624              
625 12         14 my @result;
626              
627 12   100     24 my $order = $self->store('opt_order') || {};
628              
629 12         29 for my $index (sort keys %{$order}) {
  12         34  
630 2         10 push @result, $self->help_opt($order->{$index});
631             }
632              
633 12         73 return join("\n\n", @result);
634             }
635              
636             sub help_usage {
637 12     12 0 27 my ($self) = @_;
638              
639 12         20 my @result;
640              
641 12         37 my $name = $self->help_name;
642              
643 12 100       40 if (my $has_args = $self->get('arg')) {
644 6 50       11 my $has_multi = keys(%{$has_args}) > 1 ? 1 : 0;
  6         24  
645 6         12 my $has_required = 0;
646              
647 6         11 for my $data (values(%{$has_args})) {
  6         14  
648 6         14 my $_range = $data->{range};
649 6         10 my $_required = $data->{required};
650 6   66     38 my $_multi = $_range && $_range =~ /:/;
651              
652 6 100       15 $has_multi = 1 if $_multi;
653 6 100       15 $has_required = 1 if $_required;
654             }
655              
656 6         12 my $token = '';
657              
658 6 100       16 $token = "$token, ..." if $has_multi;
659 6 100       16 $token = "[$token]" if !$has_required;
660              
661 6         11 push @result, $token;
662             }
663              
664 12 100       33 if (my $has_opts = $self->get('opt')) {
665 2 50       4 my $has_multi = keys(%{$has_opts}) > 1 ? 1 : 0;
  2         7  
666 2         4 my $has_required = 0;
667              
668 2         3 for my $data (values(%{$has_opts})) {
  2         5  
669 2         7 my $_range = $data->{range};
670 2         5 my $_required = $data->{required};
671 2   33     5 my $_multi = $_range && $_range =~ /:/;
672              
673 2 50       6 $has_multi = 1 if $_multi;
674 2 50       6 $has_required = 1 if $_required;
675             }
676              
677 2         6 my $token = '
678              
679 2 50       5 $token = "$token, ..." if $has_multi;
680 2 50       8 $token = "[$token]" if !$has_required;
681              
682 2         7 push @result, $token;
683             }
684              
685 12         45 return join ' ', 'Usage:', $self->help_name, @result;
686             }
687              
688             sub help_version {
689 0     0 0 0 my ($self) = @_;
690              
691 0   0     0 return $self->str('version') || ();
692             }
693              
694             sub okay {
695 2     2 1 8 my ($self, $method, @args) = @_;
696              
697 2         10 return $self->exit(0, $method, @args);
698             }
699              
700             sub opt {
701 17     17 1 52 my ($self, $name) = @_;
702              
703 17 50       45 return undef if !$name;
704              
705 17         24 my @values;
706              
707 17 100       59 my $data = $self->get('opt', $name) or return undef;
708 16         46 my $_default = $data->{default};
709 16         31 my $_help = $data->{help};
710 16         31 my $_label = $data->{label};
711 16         34 my $_multi = $data->{multi};
712 16         35 my $_name = $data->{name};
713 16         25 my $_prompt = $data->{prompt};
714 16         32 my $_required = $data->{required};
715 16         28 my $_type = $data->{type};
716              
717 16         861 require Venus::Array;
718              
719 16         70 my $parsed = $self->parser->get($name);
720              
721             # value
722 16 100       78 @values = ref $parsed eq 'ARRAY' ? @{$parsed} : $parsed;
  3         9  
723              
724             # prompt
725 16 100 66     81 if ($_prompt && (!@values || !defined $values[0])) {
      100        
726 1   33     4 @values = (do{_print join ': ', $_label || $_name, $_prompt; _prompt}); _print;
  1         10  
  1         9  
  1         6  
727             }
728              
729             # default
730 16 0 0     45 if (defined $_default
      33        
      0        
731             && (!@values || !defined $values[0] || $values[0] eq '')
732             && exists $data->{default})
733             {
734 0         0 @values = ($_default);
735             }
736              
737             # return boolean values
738 16 0       57 @values = map +(lc($_type) eq 'boolean' ? ($_ ? true : false) : $_), @values
    50          
    100          
739             if $_type;
740              
741             # returns
742 16 100       92 return wantarray ? (@values) : [@values];
743             }
744              
745             sub parsed {
746 5     5 1 15 my ($self) = @_;
747              
748 5         13 my $data = {};
749              
750 5   100     17 my $args = $self->store('arg') || {};
751              
752 5         17 for my $key (keys %{$args}) {
  5         19  
753 3         29 my @values = $self->arg($key);
754 3 50       25 $data->{$key} = @values > 1 ? [@values] : $values[0];
755             }
756              
757 5   100     20 my $opts = $self->store('opt') || {};
758              
759 5         22 for my $key (keys %{$opts}) {
  5         24  
760 6         19 my @values = $self->opt($key);
761 6 50       31 $data->{$key} = @values > 1 ? [@values] : $values[0];
762             }
763              
764 5         34 return $data;
765             }
766              
767             sub parser {
768 33     33 1 80 my ($self) = @_;
769              
770 33         1377 require Venus::Opts;
771              
772 33         121 return Venus::Opts->new(value => $self->data, specs => $self->spec);
773             }
774              
775             sub pass {
776 2     2 1 6 my ($self, $method, @args) = @_;
777              
778 2         10 return $self->exit(0, $method, @args);
779             }
780              
781             sub set {
782 104     104 1 287 my ($self, $key, $name, $data) = @_;
783              
784 104 100       220 return undef if !$key;
785              
786 103         225 my $method = "set_${key}";
787              
788 103         764 return $self->$method($name, $data);
789             }
790              
791             sub set_arg {
792 24     24 0 79 my ($self, $name, $data) = @_;
793              
794 24         98 $self->set_arg_name($name, $name);
795              
796 40         86 do{my $method = "set_arg_$_"; $self->$method($name, $data->{$_})}
  40         197  
797 24         48 for keys %{$data};
  24         99  
798              
799 24         74 my $store = $self->store;
800              
801 24   50     165 $store->{arg_order} ||= {};
802              
803 24   50     36 my $index = keys %{$store->{arg_order}} || 0;
804              
805 24         57 $store->{arg_order}->{$index} = $name;
806              
807 24         415 return $self;
808             }
809              
810             sub set_arg_default {
811 2     2 0 6 my ($self, $name, @args) = @_;
812              
813 2         8 return $self->store('arg', $name, 'default', @args);
814             }
815              
816             sub set_arg_help {
817 10     10 0 27 my ($self, $name, @args) = @_;
818              
819 10         34 return $self->store('arg', $name, 'help', @args);
820             }
821              
822             sub set_arg_label {
823 0     0 0 0 my ($self, $name, @args) = @_;
824              
825 0         0 return $self->store('arg', $name, 'label', @args);
826             }
827              
828             sub set_arg_name {
829 24     24 0 61 my ($self, $name, @args) = @_;
830              
831 24         111 return $self->store('arg', $name, 'name', @args);
832             }
833              
834             sub set_arg_prompt {
835 2     2 0 9 my ($self, $name, @args) = @_;
836              
837 2         6 return $self->store('arg', $name, 'prompt', @args);
838             }
839              
840             sub set_arg_range {
841 15     15 0 39 my ($self, $name, @args) = @_;
842              
843 15         31 return $self->store('arg', $name, 'range', @args);
844             }
845              
846             sub set_arg_required {
847 5     5 0 12 my ($self, $name, @args) = @_;
848              
849 5         13 return $self->store('arg', $name, 'required', @args);
850             }
851              
852             sub set_arg_type {
853 6     6 0 27 my ($self, $name, @args) = @_;
854              
855 6         47 my %type_map = (
856             boolean => 'boolean',
857             flag => 'boolean',
858             float => 'float',
859             number => 'number',
860             string => 'string',
861             yesno => 'yesno',
862             );
863              
864 6   50     45 return $self->store('arg', $name, 'type', map +($type_map{$_} || 'boolean'),
865             @args);
866             }
867              
868             sub set_cmd {
869 10     10 0 27 my ($self, $name, $data) = @_;
870              
871 10         35 $self->set_cmd_name($name, $name);
872              
873 10         23 $self->store('cmd', $name, $_, $data->{$_}) for keys %{$data};
  10         52  
874              
875 10         26 my $store = $self->store;
876              
877 10   100     85 $store->{cmd_order} ||= {};
878              
879 10   100     14 my $index = keys %{$store->{cmd_order}} || 0;
880              
881 10         25 $store->{cmd_order}->{$index} = $name;
882              
883 10         164 return $self;
884             }
885              
886             sub set_cmd_arg {
887 0     0 0 0 my ($self, $name, @args) = @_;
888              
889 0         0 return $self->store('cmd', $name, 'arg', @args);
890             }
891              
892             sub set_cmd_help {
893 0     0 0 0 my ($self, $name, @args) = @_;
894              
895 0         0 return $self->store('cmd', $name, 'help', @args);
896             }
897              
898             sub set_cmd_label {
899 0     0 0 0 my ($self, $name, @args) = @_;
900              
901 0         0 return $self->store('cmd', $name, 'label', @args);
902             }
903              
904             sub set_cmd_name {
905 10     10 0 25 my ($self, $name, @args) = @_;
906              
907 10         28 return $self->store('cmd', $name, 'name', @args);
908             }
909              
910             sub set_opt {
911 45     45 0 132 my ($self, $name, $data) = @_;
912              
913 45         146 $self->set_opt_name($name, $name);
914              
915 62         145 do{my $method = "set_opt_$_"; $self->$method($name, $data->{$_})}
  62         307  
916 45         78 for keys %{$data};
  45         178  
917              
918 45         147 my $store = $self->store;
919              
920 45   100     215 $store->{opt_order} ||= {};
921              
922 45   100     65 my $index = keys %{$store->{opt_order}} || 0;
923              
924 45         112 $store->{opt_order}->{$index} = $name;
925              
926 45         690 return $self;
927             }
928              
929             sub set_opt_alias {
930 22     22 0 61 my ($self, $name, @args) = @_;
931              
932 22         62 return $self->store('opt', $name, 'alias', @args);
933             }
934              
935             sub set_opt_default {
936 0     0 0 0 my ($self, $name, @args) = @_;
937              
938 0         0 return $self->store('opt', $name, 'default', @args);
939             }
940              
941             sub set_opt_help {
942 27     27 0 83 my ($self, $name, @args) = @_;
943              
944 27         74 return $self->store('opt', $name, 'help', @args);
945             }
946              
947             sub set_opt_label {
948 0     0 0 0 my ($self, $name, @args) = @_;
949              
950 0         0 return $self->store('opt', $name, 'label', @args);
951             }
952              
953             sub set_opt_multi {
954 5     5 0 17 my ($self, $name, @args) = @_;
955              
956 5 50       30 return $self->store('opt', $name, 'multi', @args ? true : false);
957             }
958              
959             sub set_opt_name {
960 45     45 0 147 my ($self, $name, @args) = @_;
961              
962 45         139 return $self->store('opt', $name, 'name', @args);
963             }
964              
965             sub set_opt_prompt {
966 2     2 0 8 my ($self, $name, @args) = @_;
967              
968 2         6 return $self->store('opt', $name, 'prompt', @args);
969             }
970              
971             sub set_opt_required {
972 0     0 0 0 my ($self, $name, @args) = @_;
973              
974 0         0 return $self->store('opt', $name, 'required', @args);
975             }
976              
977             sub set_opt_type {
978 6     6 0 22 my ($self, $name, @args) = @_;
979              
980 6         50 my %type_map = (
981             boolean => 'boolean',
982             flag => 'boolean',
983             float => 'float',
984             number => 'number',
985             string => 'string',
986             yesno => 'yesno',
987             );
988              
989 6   50     40 return $self->store('opt', $name, 'type', map +($type_map{$_} || 'boolean'),
990             @args);
991             }
992              
993             sub set_str {
994 24     24 0 76 my ($self, $name, $data) = @_;
995              
996 24         76 $self->store('str', $name, 'value', $data);
997              
998 24         203 return $self;
999             }
1000              
1001             sub set_str_arg {
1002 0     0 0 0 my ($self, $name, @args) = @_;
1003              
1004 0         0 return $self->store('str', $name, 'arg', @args);
1005             }
1006              
1007             sub set_str_author {
1008 0     0 0 0 my ($self, $name, @args) = @_;
1009              
1010 0         0 return $self->store('str', $name, 'author', @args);
1011             }
1012              
1013             sub set_str_description {
1014 0     0 0 0 my ($self, $name, @args) = @_;
1015              
1016 0         0 return $self->store('str', $name, 'description', @args);
1017             }
1018              
1019             sub set_str_footer {
1020 0     0 0 0 my ($self, $name, @args) = @_;
1021              
1022 0         0 return $self->store('str', $name, 'footer', @args);
1023             }
1024              
1025             sub set_str_header {
1026 0     0 0 0 my ($self, $name, @args) = @_;
1027              
1028 0         0 return $self->store('str', $name, 'header', @args);
1029             }
1030              
1031             sub set_str_name {
1032 0     0 0 0 my ($self, $name, @args) = @_;
1033              
1034 0         0 return $self->store('str', $name, 'name', @args);
1035             }
1036              
1037             sub set_str_opt {
1038 0     0 0 0 my ($self, $name, @args) = @_;
1039              
1040 0         0 return $self->store('str', $name, 'opt', @args);
1041             }
1042              
1043             sub set_str_opts {
1044 0     0 0 0 my ($self, $name, @args) = @_;
1045              
1046 0         0 return $self->store('str', $name, 'opts', @args);
1047             }
1048              
1049             sub set_str_version {
1050 0     0 0 0 my ($self, $name, @args) = @_;
1051              
1052 0         0 return $self->store('str', $name, 'version', @args);
1053             }
1054              
1055             sub spec {
1056 37     37 0 92 my ($self) = @_;
1057              
1058 37         83 my $result = [];
1059              
1060 37   100     84 my $order = $self->store('opt_order') || {};
1061              
1062 37         67 for my $index (sort keys %{$order}) {
  37         135  
1063 31 50       70 my $item = $self->store('opt', $order->{$index}) or next;
1064 31         115 my $_alias = $item->{alias};
1065 31         49 my $_multi = $item->{multi};
1066 31         57 my $_name = $item->{name};
1067 31         45 my $_type = $item->{type};
1068              
1069 31         62 my $note = "$_name";
1070              
1071 31 100       65 if ($_alias) {
1072             $note = join('|', $note,
1073 21 100       68 (ref $_alias eq 'ARRAY' ? sort @{$_alias} : $_alias));
  17         45  
1074             }
1075              
1076 31         159 my %type_map = (
1077             boolean => undef,
1078             float => 'f',
1079             number => 'i',
1080             string => 's',
1081             yesno => 's',
1082             );
1083              
1084 31 100 33     98 $note = join '=', $note, ($type_map{$_type} || ()) if $_type;
1085 31 100       74 $note = "$note\@" if $_multi;
1086              
1087 31         38 push @{$result}, $note;
  31         120  
1088             }
1089              
1090 37         229 return $result;
1091             }
1092              
1093             sub store {
1094 593     593 0 2534 my ($self, $key, $name, @args) = @_;
1095              
1096 593   100     1184 my $config = $self->stash->{config} ||= {};
1097              
1098 593 100       1177 return $config if !$key;
1099              
1100 514 100       1363 return $config->{$key} if !$name;
1101              
1102             return ((exists $config->{$key})
1103             && (exists $config->{$key}->{$name}))
1104 391 100 66     1292 ? $config->{$key}->{$name}
    100          
1105             : undef
1106             if !@args;
1107              
1108 296         540 my ($prop, @data) = @args;
1109              
1110             return ((exists $config->{$key})
1111             && (exists $config->{$key}->{$name})
1112             && (exists $config->{$key}->{$name}->{$prop}))
1113 296 100 66     1193 ? $config->{$key}->{$name}->{$prop}
    100          
1114             : undef
1115             if !@data;
1116              
1117 219   100     735 $config->{$key} ||= {};
1118              
1119 219   100     674 $config->{$key}->{$name} ||= {};
1120              
1121 219         438 $config->{$key}->{$name}->{$prop} = $data[0];
1122              
1123 219         510 return $self;
1124             }
1125              
1126             sub str {
1127 77     77 1 144 my ($self, $name) = @_;
1128              
1129 77 50       157 return undef if !$name;
1130              
1131 77         176 return $self->get_str($name);
1132             }
1133              
1134             sub test {
1135 6     6 1 17 my ($self, $key, $name) = @_;
1136              
1137 6         36 my @values = $self->$key($name);
1138              
1139 6         24 my $data = $self->get($key, $name);
1140              
1141 6   100     44 my $type = $data->{type} || 'boolean';
1142              
1143 6         41 my %type_map = (
1144             boolean => 'number',
1145             float => 'float',
1146             number => 'number',
1147             string => 'string',
1148             yesno => 'yesno',
1149             );
1150              
1151 6         2026 require Venus::Assert;
1152              
1153 6 50       30 if ($type) {
1154 6         25 for (my $i = 0; $i < @values; $i++) {
1155             my $assert = Venus::Assert->new("at index $i")->expression(
1156 6         52 $type_map{$type}
1157             );
1158 6 100       44 if (my $caught = $assert->catch('validate', $values[$i])) {
1159 3         33 $self->error({
1160             throw => "error_on_${key}_validation",
1161             error => $caught->message,
1162             name => $name,
1163             type => $type,
1164             });
1165             }
1166             }
1167             }
1168              
1169 3 50       32 return wantarray ? (@values) : [@values];
1170             }
1171              
1172             # ROUTINES
1173              
1174             sub _wrap_text {
1175 10     10   19 my ($indent, $length, $parts) = @_;
1176              
1177 10         18 my @results;
1178 10         14 my $size = 0;
1179 10         16 my $index = 0;
1180              
1181 10         14 for my $part (@{$results[$index]}) {
  10         28  
1182 0         0 $size += length($part) + 1 + $indent;
1183             }
1184 10         13 for my $part (@{$parts}) {
  10         16  
1185 30 50       54 if (($size + length($part) + 1 + $indent) > $length) {
1186 0         0 $index += 1;
1187 0         0 $size = length($part);
1188 0         0 $results[$index] = [];
1189             }
1190             else {
1191 30         42 $size += length($part) + 1;
1192             }
1193 30         32 push @{$results[$index]}, $part;
  30         54  
1194             }
1195              
1196             return join "\n",
1197 10 50       30 map {($indent ? (" " x $indent) : '') . join " ", @{$_}} @results;
  10         24  
  10         59  
1198             }
1199              
1200             # ERRORS
1201              
1202             sub error_on_arg_validation {
1203 2     2 1 7 my ($self, $data) = @_;
1204              
1205 2         5 my $message = 'Invalid argument: {{name}}: {{error}}';
1206              
1207             my $stash = {
1208             name => $data->{name},
1209             type => $data->{type},
1210             error => $data->{error},
1211 2         11 };
1212              
1213 2         10 my $result = {
1214             name => 'on.arg.validation',
1215             raise => true,
1216             stash => $stash,
1217             message => $message,
1218             };
1219              
1220 2         18 return $result;
1221             }
1222              
1223             sub error_on_opt_validation {
1224 3     3 1 9 my ($self, $data) = @_;
1225              
1226 3         10 my $message = 'Invalid option: {{name}}: {{error}}';
1227              
1228             my $stash = {
1229             name => $data->{name},
1230             type => $data->{type},
1231             error => $data->{error},
1232 3         14 };
1233              
1234 3         13 my $result = {
1235             name => 'on.opt.validation',
1236             raise => true,
1237             stash => $stash,
1238             message => $message,
1239             };
1240              
1241 3         10 return $result;
1242             }
1243              
1244             1;
1245              
1246              
1247              
1248             =head1 NAME
1249              
1250             Venus::Cli - Cli Class
1251              
1252             =cut
1253              
1254             =head1 ABSTRACT
1255              
1256             Cli Class for Perl 5
1257              
1258             =cut
1259              
1260             =head1 SYNOPSIS
1261              
1262             package main;
1263              
1264             use Venus::Cli;
1265              
1266             my $cli = Venus::Cli->new(['--help']);
1267              
1268             $cli->set('opt', 'help', {
1269             help => 'Show help information',
1270             });
1271              
1272             # $cli->opt('help');
1273              
1274             # [1]
1275              
1276             # $cli->parsed;
1277              
1278             # {help => 1}
1279              
1280             =cut
1281              
1282             =head1 DESCRIPTION
1283              
1284             This package provides a superclass and methods for creating simple yet robust
1285             command-line interfaces.
1286              
1287             =cut
1288              
1289             =head1 ATTRIBUTES
1290              
1291             This package has the following attributes:
1292              
1293             =cut
1294              
1295             =head2 data
1296              
1297             data(ArrayRef $data) (ArrayRef)
1298              
1299             The data attribute holds an arrayref of command-line arguments and defaults to
1300             C<@ARGV>.
1301              
1302             I>
1303              
1304             =over 4
1305              
1306             =item data example 1
1307              
1308             # given: synopsis
1309              
1310             package main;
1311              
1312             my $data = $cli->data([]);
1313              
1314             # []
1315              
1316             =back
1317              
1318             =cut
1319              
1320             =head1 INHERITS
1321              
1322             This package inherits behaviors from:
1323              
1324             L
1325              
1326             =cut
1327              
1328             =head1 INTEGRATES
1329              
1330             This package integrates behaviors from:
1331              
1332             L
1333              
1334             =cut
1335              
1336             =head1 METHODS
1337              
1338             This package provides the following methods:
1339              
1340             =cut
1341              
1342             =head2 arg
1343              
1344             arg(Str $name) (Any)
1345              
1346             The arg method returns the value passed to the CLI that corresponds to the
1347             registered argument using the name provided.
1348              
1349             I>
1350              
1351             =over 4
1352              
1353             =item arg example 1
1354              
1355             package main;
1356              
1357             use Venus::Cli;
1358              
1359             my $cli = Venus::Cli->new(['example', '--help']);
1360              
1361             my $name = $cli->arg('name');
1362              
1363             # undef
1364              
1365             =back
1366              
1367             =over 4
1368              
1369             =item arg example 2
1370              
1371             package main;
1372              
1373             use Venus::Cli;
1374              
1375             my $cli = Venus::Cli->new(['example', '--help']);
1376              
1377             $cli->set('arg', 'name', {
1378             range => '0',
1379             });
1380              
1381             my $name = $cli->arg('name');
1382              
1383             # ["example"]
1384              
1385             =back
1386              
1387             =over 4
1388              
1389             =item arg example 3
1390              
1391             package main;
1392              
1393             use Venus::Cli;
1394              
1395             my $cli = Venus::Cli->new(['example', '--help']);
1396              
1397             $cli->set('arg', 'name', {
1398             range => '0',
1399             });
1400              
1401             my ($name) = $cli->arg('name');
1402              
1403             # "example"
1404              
1405             =back
1406              
1407             =over 4
1408              
1409             =item arg example 4
1410              
1411             package main;
1412              
1413             use Venus::Cli;
1414              
1415             my $cli = Venus::Cli->new(['--help']);
1416              
1417             $cli->set('arg', 'name', {
1418             prompt => 'Enter a name',
1419             range => '0',
1420             });
1421              
1422             my ($name) = $cli->arg('name');
1423              
1424             # prompts for name, e.g.
1425              
1426             # > name: Enter a name
1427             # > example
1428              
1429             # "example"
1430              
1431             =back
1432              
1433             =over 4
1434              
1435             =item arg example 5
1436              
1437             package main;
1438              
1439             use Venus::Cli;
1440              
1441             my $cli = Venus::Cli->new(['--help']);
1442              
1443             $cli->set('arg', 'name', {
1444             default => 'example',
1445             range => '0',
1446             });
1447              
1448             my ($name) = $cli->arg('name');
1449              
1450             # "example"
1451              
1452             =back
1453              
1454             =over 4
1455              
1456             =item arg example 6
1457              
1458             package main;
1459              
1460             use Venus::Cli;
1461              
1462             my $cli = Venus::Cli->new(['example', '--help']);
1463              
1464             $cli->set('arg', 'name', {
1465             type => 'string',
1466             range => '0',
1467             });
1468              
1469             my ($name) = $cli->arg('name');
1470              
1471             # "example"
1472              
1473             =back
1474              
1475             =cut
1476              
1477             =head2 cmd
1478              
1479             cmd(Str $name) (Any)
1480              
1481             The cmd method returns truthy or falsy if the value passed to the CLI that
1482             corresponds to the argument registered and associated with the registered
1483             command using the name provided.
1484              
1485             I>
1486              
1487             =over 4
1488              
1489             =item cmd example 1
1490              
1491             package main;
1492              
1493             use Venus::Cli;
1494              
1495             my $cli = Venus::Cli->new(['example', 'execute']);
1496              
1497             my $name = $cli->cmd('name');
1498              
1499             # undef
1500              
1501             =back
1502              
1503             =over 4
1504              
1505             =item cmd example 2
1506              
1507             package main;
1508              
1509             use Venus::Cli;
1510              
1511             my $cli = Venus::Cli->new(['example', 'execute']);
1512              
1513             $cli->set('arg', 'action', {
1514             range => '1',
1515             });
1516              
1517             $cli->set('cmd', 'execute', {
1518             arg => 'action',
1519             });
1520              
1521             my $is_execute = $cli->cmd('execute');
1522              
1523             # 1
1524              
1525             =back
1526              
1527             =over 4
1528              
1529             =item cmd example 3
1530              
1531             package main;
1532              
1533             use Venus::Cli;
1534              
1535             my $cli = Venus::Cli->new(['example', 'execute']);
1536              
1537             $cli->set('arg', 'action', {
1538             range => '1',
1539             });
1540              
1541             $cli->set('cmd', 'execute', {
1542             arg => 'action',
1543             });
1544              
1545             my ($is_execute) = $cli->cmd('execute');
1546              
1547             # 1
1548              
1549             =back
1550              
1551             =over 4
1552              
1553             =item cmd example 4
1554              
1555             package main;
1556              
1557             use Venus::Cli;
1558              
1559             my $cli = Venus::Cli->new(['example']);
1560              
1561             $cli->set('arg', 'action', {
1562             prompt => 'Enter the desired action',
1563             range => '1',
1564             });
1565              
1566             $cli->set('cmd', 'execute', {
1567             arg => 'action',
1568             });
1569              
1570             my ($is_execute) = $cli->cmd('execute');
1571              
1572             # prompts for action, e.g.
1573              
1574             # > name: Enter the desired action
1575             # > execute
1576              
1577             # 1
1578              
1579             =back
1580              
1581             =over 4
1582              
1583             =item cmd example 5
1584              
1585             package main;
1586              
1587             use Venus::Cli;
1588              
1589             my $cli = Venus::Cli->new(['example']);
1590              
1591             $cli->set('arg', 'action', {
1592             default => 'execute',
1593             range => '1',
1594             });
1595              
1596             $cli->set('cmd', 'execute', {
1597             arg => 'action',
1598             });
1599              
1600             my ($is_execute) = $cli->cmd('execute');
1601              
1602             # 1
1603              
1604             =back
1605              
1606             =over 4
1607              
1608             =item cmd example 6
1609              
1610             package main;
1611              
1612             use Venus::Cli;
1613              
1614             my $cli = Venus::Cli->new(['example', 'execute']);
1615              
1616             $cli->set('arg', 'action', {
1617             type => 'string',
1618             range => '1',
1619             });
1620              
1621             $cli->set('cmd', 'execute', {
1622             arg => 'action',
1623             });
1624              
1625             my ($is_execute) = $cli->cmd('execute');
1626              
1627             # 1
1628              
1629             =back
1630              
1631             =over 4
1632              
1633             =item cmd example 7
1634              
1635             package main;
1636              
1637             use Venus::Cli;
1638              
1639             my $cli = Venus::Cli->new(['example']);
1640              
1641             $cli->set('arg', 'action', {
1642             type => 'string',
1643             range => '1',
1644             });
1645              
1646             $cli->set('cmd', 'execute', {
1647             arg => 'action',
1648             });
1649              
1650             my ($is_execute) = $cli->cmd('execute');
1651              
1652             # 0
1653              
1654             =back
1655              
1656             =cut
1657              
1658             =head2 exit
1659              
1660             exit(Int $code, Str|CodeRef $code, Any @args) (Any)
1661              
1662             The exit method exits the program using the exit code provided. The exit code
1663             defaults to C<0>. Optionally, you can dispatch before exiting by providing a
1664             method name or coderef, and arguments.
1665              
1666             I>
1667              
1668             =over 4
1669              
1670             =item exit example 1
1671              
1672             # given: synopsis
1673              
1674             package main;
1675              
1676             my $exit = $cli->exit;
1677              
1678             # ()
1679              
1680             =back
1681              
1682             =over 4
1683              
1684             =item exit example 2
1685              
1686             # given: synopsis
1687              
1688             package main;
1689              
1690             my $exit = $cli->exit(0);
1691              
1692             # ()
1693              
1694             =back
1695              
1696             =over 4
1697              
1698             =item exit example 3
1699              
1700             # given: synopsis
1701              
1702             package main;
1703              
1704             my $exit = $cli->exit(1);
1705              
1706             # ()
1707              
1708             =back
1709              
1710             =over 4
1711              
1712             =item exit example 4
1713              
1714             # given: synopsis
1715              
1716             package main;
1717              
1718             my $exit = $cli->exit(1, 'stash', 'executed', 1);
1719              
1720             # ()
1721              
1722             =back
1723              
1724             =cut
1725              
1726             =head2 fail
1727              
1728             fail(Str|CodeRef $code, Any @args) (Any)
1729              
1730             The fail method exits the program with the exit code C<1>. Optionally, you can
1731             dispatch before exiting by providing a method name or coderef, and arguments.
1732              
1733             I>
1734              
1735             =over 4
1736              
1737             =item fail example 1
1738              
1739             # given: synopsis
1740              
1741             package main;
1742              
1743             my $fail = $cli->fail;
1744              
1745             # ()
1746              
1747             =back
1748              
1749             =over 4
1750              
1751             =item fail example 2
1752              
1753             # given: synopsis
1754              
1755             package main;
1756              
1757             my $fail = $cli->fail('stash', 'executed', 1);
1758              
1759             # ()
1760              
1761             =back
1762              
1763             =cut
1764              
1765             =head2 get
1766              
1767             get(Str $type, Str $name) (Any)
1768              
1769             The get method returns C, C, C, or C configuration values
1770             from the configuration database.
1771              
1772             I>
1773              
1774             =over 4
1775              
1776             =item get example 1
1777              
1778             package main;
1779              
1780             use Venus::Cli;
1781              
1782             my $cli = Venus::Cli->new;
1783              
1784             my $get = $cli->get;
1785              
1786             # undef
1787              
1788             =back
1789              
1790             =over 4
1791              
1792             =item get example 2
1793              
1794             package main;
1795              
1796             use Venus::Cli;
1797              
1798             my $cli = Venus::Cli->new;
1799              
1800             my $get = $cli->get('opt', 'help');
1801              
1802             # undef
1803              
1804             =back
1805              
1806             =over 4
1807              
1808             =item get example 3
1809              
1810             package main;
1811              
1812             use Venus::Cli;
1813              
1814             my $cli = Venus::Cli->new;
1815              
1816             $cli->set('opt', 'help', {
1817             alias => 'h',
1818             });
1819              
1820             my $get = $cli->get('opt', 'help');
1821              
1822             # {name => 'help', alias => 'h'}
1823              
1824             =back
1825              
1826             =over 4
1827              
1828             =item get example 4
1829              
1830             package main;
1831              
1832             use Venus::Cli;
1833              
1834             my $cli = Venus::Cli->new;
1835              
1836             $cli->set('opt', 'help', {
1837             alias => 'h',
1838             });
1839              
1840             my $get = $cli->get('opt');
1841              
1842             # {help => {name => 'help', alias => 'h'}}
1843              
1844             =back
1845              
1846             =cut
1847              
1848             =head2 help
1849              
1850             help() (Str)
1851              
1852             The help method returns a string representing I<"usage"> information based on
1853             the configuration of the CLI.
1854              
1855             I>
1856              
1857             =over 4
1858              
1859             =item help example 1
1860              
1861             package main;
1862              
1863             use Venus::Cli;
1864              
1865             my $cli = Venus::Cli->new;
1866              
1867             my $help = $cli->help;
1868              
1869             # "Usage: application"
1870              
1871             =back
1872              
1873             =over 4
1874              
1875             =item help example 2
1876              
1877             package main;
1878              
1879             use Venus::Cli;
1880              
1881             my $cli = Venus::Cli->new;
1882              
1883             $cli->set('str', 'name', 'program');
1884              
1885             my $help = $cli->help;
1886              
1887             # "Usage: program"
1888              
1889             =back
1890              
1891             =over 4
1892              
1893             =item help example 3
1894              
1895             package main;
1896              
1897             use Venus::Cli;
1898              
1899             my $cli = Venus::Cli->new;
1900              
1901             $cli->set('str', 'name', 'program');
1902              
1903             $cli->set('arg', 'command', {
1904             help => 'Command to execute',
1905             });
1906              
1907             my $help = $cli->help;
1908              
1909             # "Usage: program []
1910             #
1911             # Arguments:
1912             #
1913             # command
1914             # Command to execute
1915             # (optional)"
1916              
1917             =back
1918              
1919             =over 4
1920              
1921             =item help example 4
1922              
1923             package main;
1924              
1925             use Venus::Cli;
1926              
1927             my $cli = Venus::Cli->new;
1928              
1929             $cli->set('str', 'name', 'program');
1930              
1931             $cli->set('arg', 'command', {
1932             help => 'Command to execute',
1933             required => 1
1934             });
1935              
1936             my $help = $cli->help;
1937              
1938             # "Usage: program
1939             #
1940             # Arguments:
1941             #
1942             # command
1943             # Command to execute
1944             # (required)"
1945              
1946             =back
1947              
1948             =over 4
1949              
1950             =item help example 5
1951              
1952             package main;
1953              
1954             use Venus::Cli;
1955              
1956             my $cli = Venus::Cli->new;
1957              
1958             $cli->set('str', 'name', 'program');
1959              
1960             $cli->set('arg', 'command', {
1961             help => 'Command to execute',
1962             type => 'string',
1963             required => 1,
1964             });
1965              
1966             my $help = $cli->help;
1967              
1968             # "Usage: program
1969             #
1970             # Arguments:
1971             #
1972             # command
1973             # Command to execute
1974             # (required)
1975             # (string)"
1976              
1977             =back
1978              
1979             =over 4
1980              
1981             =item help example 6
1982              
1983             package main;
1984              
1985             use Venus::Cli;
1986              
1987             my $cli = Venus::Cli->new;
1988              
1989             $cli->set('str', 'name', 'program');
1990              
1991             $cli->set('arg', 'command', {
1992             help => 'Command to execute',
1993             required => 1,
1994             });
1995              
1996             $cli->set('cmd', 'create', {
1997             help => 'Create new resource',
1998             arg => 'command',
1999             });
2000              
2001             my $help = $cli->help;
2002              
2003             # "Usage: program
2004             #
2005             # Arguments:
2006             #
2007             # command
2008             # Command to execute
2009             # (required)
2010             #
2011             # Commands:
2012             #
2013             # create
2014             # Create new resource
2015             # (ccommand)"
2016              
2017             =back
2018              
2019             =over 4
2020              
2021             =item help example 7
2022              
2023             package main;
2024              
2025             use Venus::Cli;
2026              
2027             my $cli = Venus::Cli->new;
2028              
2029             $cli->set('str', 'name', 'program');
2030              
2031             $cli->set('arg', 'command', {
2032             help => 'Command to execute',
2033             required => 1,
2034             });
2035              
2036             $cli->set('opt', 'help', {
2037             help => 'Show help information',
2038             alias => ['?', 'h'],
2039             });
2040              
2041             $cli->set('cmd', 'create', {
2042             help => 'Create new resource',
2043             arg => 'command',
2044             });
2045              
2046             my $help = $cli->help;
2047              
2048             # "Usage: program [
2049             #
2050             # Arguments:
2051             #
2052             # command
2053             # Command to execute
2054             # (required)
2055             #
2056             # Options:
2057             #
2058             # -?, -h, --help
2059             # Show help information
2060             # (optional)
2061             #
2062             # Commands:
2063             #
2064             # create
2065             # Create new resource
2066             # (command)"
2067              
2068             =back
2069              
2070             =over 4
2071              
2072             =item help example 8
2073              
2074             package main;
2075              
2076             use Venus::Cli;
2077              
2078             my $cli = Venus::Cli->new;
2079              
2080             $cli->set('str', 'name', 'program');
2081              
2082             $cli->set('arg', 'files', {
2083             help => 'File paths',
2084             required => 1,
2085             range => '0:',
2086             });
2087              
2088             $cli->set('opt', 'verbose', {
2089             help => 'Show details during processing',
2090             alias => ['v'],
2091             });
2092              
2093             my $help = $cli->help;
2094              
2095             # "Usage: program , ... [
2096             #
2097             # Arguments:
2098             #
2099             # files, ...
2100             # File paths
2101             # (required)
2102             #
2103             # Options:
2104             #
2105             # -v, --verbose
2106             # Show details during processing
2107             # (optional)"
2108              
2109             =back
2110              
2111             =cut
2112              
2113             =head2 okay
2114              
2115             okay(Str|CodeRef $code, Any @args) (Any)
2116              
2117             The okay method exits the program with the exit code C<0>. Optionally, you can
2118             dispatch before exiting by providing a method name or coderef, and arguments.
2119              
2120             I>
2121              
2122             =over 4
2123              
2124             =item okay example 1
2125              
2126             # given: synopsis
2127              
2128             package main;
2129              
2130             my $okay = $cli->okay;
2131              
2132             # ()
2133              
2134             =back
2135              
2136             =over 4
2137              
2138             =item okay example 2
2139              
2140             # given: synopsis
2141              
2142             package main;
2143              
2144             my $okay = $cli->okay('stash', 'executed', 1);
2145              
2146             # ()
2147              
2148             =back
2149              
2150             =cut
2151              
2152             =head2 opt
2153              
2154             opt(Str $name) (Any)
2155              
2156             The opt method returns the value passed to the CLI that corresponds to the
2157             registered option using the name provided.
2158              
2159             I>
2160              
2161             =over 4
2162              
2163             =item opt example 1
2164              
2165             package main;
2166              
2167             use Venus::Cli;
2168              
2169             my $cli = Venus::Cli->new(['example', '--help']);
2170              
2171             my $name = $cli->opt('help');
2172              
2173             # undef
2174              
2175             =back
2176              
2177             =over 4
2178              
2179             =item opt example 2
2180              
2181             package main;
2182              
2183             use Venus::Cli;
2184              
2185             my $cli = Venus::Cli->new(['example', '--help']);
2186              
2187             $cli->set('opt', 'help', {});
2188              
2189             my $name = $cli->opt('help');
2190              
2191             # [1]
2192              
2193             =back
2194              
2195             =over 4
2196              
2197             =item opt example 3
2198              
2199             package main;
2200              
2201             use Venus::Cli;
2202              
2203             my $cli = Venus::Cli->new(['example', '--help']);
2204              
2205             $cli->set('opt', 'help', {});
2206              
2207             my ($name) = $cli->opt('help');
2208              
2209             # 1
2210              
2211             =back
2212              
2213             =over 4
2214              
2215             =item opt example 4
2216              
2217             package main;
2218              
2219             use Venus::Cli;
2220              
2221             my $cli = Venus::Cli->new([]);
2222              
2223             $cli->set('opt', 'name', {
2224             prompt => 'Enter a name',
2225             type => 'string',
2226             multi => 0,
2227             });
2228              
2229             my ($name) = $cli->opt('name');
2230              
2231             # prompts for name, e.g.
2232              
2233             # > name: Enter a name
2234             # > example
2235              
2236             # "example"
2237              
2238             =back
2239              
2240             =over 4
2241              
2242             =item opt example 5
2243              
2244             package main;
2245              
2246             use Venus::Cli;
2247              
2248             my $cli = Venus::Cli->new(['--name', 'example']);
2249              
2250             $cli->set('opt', 'name', {
2251             prompt => 'Enter a name',
2252             type => 'string',
2253             multi => 0,
2254             });
2255              
2256             my ($name) = $cli->opt('name');
2257              
2258             # Does not prompt
2259              
2260             # "example"
2261              
2262             =back
2263              
2264             =over 4
2265              
2266             =item opt example 6
2267              
2268             package main;
2269              
2270             use Venus::Cli;
2271              
2272             my $cli = Venus::Cli->new(['example', '--name', 'example', '--name', 'example']);
2273              
2274             $cli->set('opt', 'name', {
2275             type => 'string',
2276             multi => 1,
2277             });
2278              
2279             my (@name) = $cli->opt('name');
2280              
2281             # ("example", "example")
2282              
2283             =back
2284              
2285             =cut
2286              
2287             =head2 parsed
2288              
2289             parsed() (HashRef)
2290              
2291             The parsed method returns the values provided to the CLI for all registered
2292             arguments and options as a hashref.
2293              
2294             I>
2295              
2296             =over 4
2297              
2298             =item parsed example 1
2299              
2300             package main;
2301              
2302             use Venus::Cli;
2303              
2304             my $cli = Venus::Cli->new(['example', '--help']);
2305              
2306             $cli->set('arg', 'name', {
2307             range => '0',
2308             });
2309              
2310             $cli->set('opt', 'help', {
2311             alias => 'h',
2312             });
2313              
2314             my $parsed = $cli->parsed;
2315              
2316             # {name => "example", help => 1}
2317              
2318             =back
2319              
2320             =cut
2321              
2322             =head2 parser
2323              
2324             parser() (Opts)
2325              
2326             The parser method returns a L object using the L returned
2327             based on the CLI configuration.
2328              
2329             I>
2330              
2331             =over 4
2332              
2333             =item parser example 1
2334              
2335             package main;
2336              
2337             use Venus::Cli;
2338              
2339             my $cli = Venus::Cli->new;
2340              
2341             $cli->set('opt', 'help', {
2342             help => 'Show help information',
2343             alias => 'h',
2344             });
2345              
2346             my $parser = $cli->parser;
2347              
2348             # bless({...}, 'Venus::Opts')
2349              
2350             =back
2351              
2352             =cut
2353              
2354             =head2 pass
2355              
2356             pass(Str|CodeRef $code, Any @args) (Any)
2357              
2358             The pass method exits the program with the exit code C<0>. Optionally, you can
2359             dispatch before exiting by providing a method name or coderef, and arguments.
2360              
2361             I>
2362              
2363             =over 4
2364              
2365             =item pass example 1
2366              
2367             # given: synopsis
2368              
2369             package main;
2370              
2371             my $pass = $cli->pass;
2372              
2373             # ()
2374              
2375             =back
2376              
2377             =over 4
2378              
2379             =item pass example 2
2380              
2381             # given: synopsis
2382              
2383             package main;
2384              
2385             my $pass = $cli->pass('stash', 'executed', 1);
2386              
2387             # ()
2388              
2389             =back
2390              
2391             =cut
2392              
2393             =head2 set
2394              
2395             set(Str $type, Str $name, Str|HashRef $data) (Any)
2396              
2397             The set method stores configuration values for C, C, C, or
2398             C data in the configuration database, and returns the invocant.
2399              
2400             The following are configurable C properties:
2401              
2402             =over 4
2403              
2404             =item *
2405              
2406             The C property specifies the "default" value to be used if none is
2407             provided.
2408              
2409             =item *
2410              
2411             The C property specifies the help text to output in usage instructions.
2412              
2413             =item *
2414              
2415             The C
2416              
2417             =item *
2418              
2419             The C property specifies the name of the argument.
2420              
2421             =item *
2422              
2423             The C property specifies the text to be used in a prompt for input if
2424             no value is provided.
2425              
2426             =item *
2427              
2428             The C property specifies the zero-indexed position where the CLI
2429             arguments can be found, using range notation.
2430              
2431             =item *
2432              
2433             The C property specifies whether the argument is required and throws
2434             an exception is missing when fetched.
2435              
2436             =item *
2437              
2438             The C property specifies the data type of the argument. Valid types are
2439             C parsed as a L integer, C parsed as a
2440             L string, C parsed as a L float, C
2441             parsed as a L flag, or C parsed as a L
2442             string. Otherwise, the type will default to C.
2443              
2444             =back
2445              
2446             The following are configurable C properties:
2447              
2448             =over 4
2449              
2450             =item *
2451              
2452             The C property specifies the CLI argument where the command can be found.
2453              
2454             =item *
2455              
2456             The C property specifies the help text to output in usage instructions.
2457              
2458             =item *
2459              
2460             The C
2461              
2462             =item *
2463              
2464             The C property specifies the name of the command.
2465              
2466             =back
2467              
2468             The following are configurable C properties:
2469              
2470             =over 4
2471              
2472             =item *
2473              
2474             The C property specifies the alternate identifiers that can be provided.
2475              
2476             =item *
2477              
2478             The C property specifies the "default" value to be used if none is
2479             provided.
2480              
2481             =item *
2482              
2483             The C property specifies the help text to output in usage instructions.
2484              
2485             =item *
2486              
2487             The C
2488              
2489             =item *
2490              
2491             The C property denotes whether the CLI will accept multiple occurrences
2492             of the option.
2493              
2494             =item *
2495              
2496             The C property specifies the name of the option.
2497              
2498             =item *
2499              
2500             The C property specifies the text to be used in a prompt for input if
2501             no value is provided.
2502              
2503             =item *
2504              
2505             The C property specifies whether the option is required and throws an
2506             exception is missing when fetched.
2507              
2508             =item *
2509              
2510             The C property specifies the data type of the option. Valid types are
2511             C parsed as a L integer, C parsed as a
2512             L string, C parsed as a L float, C
2513             parsed as a L flag, or C parsed as a L
2514             string. Otherwise, the type will default to C.
2515              
2516             =back
2517              
2518             I>
2519              
2520             =over 4
2521              
2522             =item set example 1
2523              
2524             package main;
2525              
2526             use Venus::Cli;
2527              
2528             my $cli = Venus::Cli->new;
2529              
2530             my $set = $cli->set;
2531              
2532             # undef
2533              
2534             =back
2535              
2536             =over 4
2537              
2538             =item set example 2
2539              
2540             package main;
2541              
2542             use Venus::Cli;
2543              
2544             my $cli = Venus::Cli->new;
2545              
2546             my $set = $cli->set('opt', 'help');
2547              
2548             # bless({...}, 'Venus::Cli')
2549              
2550             =back
2551              
2552             =over 4
2553              
2554             =item set example 3
2555              
2556             package main;
2557              
2558             use Venus::Cli;
2559              
2560             my $cli = Venus::Cli->new;
2561              
2562             my $set = $cli->set('opt', 'help', {
2563             alias => 'h',
2564             });
2565              
2566             # bless({...}, 'Venus::Cli')
2567              
2568             =back
2569              
2570             =over 4
2571              
2572             =item set example 4
2573              
2574             package main;
2575              
2576             use Venus::Cli;
2577              
2578             my $cli = Venus::Cli->new;
2579              
2580             my $set = $cli->set('opt', 'help', {
2581             alias => ['?', 'h'],
2582             });
2583              
2584             # bless({...}, 'Venus::Cli')
2585              
2586             =back
2587              
2588             =cut
2589              
2590             =head2 str
2591              
2592             str(Str $name) (Any)
2593              
2594             The str method gets or sets configuration strings used in CLI help text based
2595             on the arguments provided. The L method uses C<"name">,
2596             C<"description">, C<"header">, and C<"footer"> strings.
2597              
2598             I>
2599              
2600             =over 4
2601              
2602             =item str example 1
2603              
2604             package main;
2605              
2606             use Venus::Cli;
2607              
2608             my $cli = Venus::Cli->new;
2609              
2610             $cli->set('str', 'name', 'program');
2611              
2612             my $str = $cli->str('name');
2613              
2614             # "program"
2615              
2616             =back
2617              
2618             =cut
2619              
2620             =head2 test
2621              
2622             test(Str $type, Str $name) (Any)
2623              
2624             The test method validates the values for the C or C specified and
2625             returns the value(s) associated. If validation failed an exception is thrown.
2626              
2627             I>
2628              
2629             =over 4
2630              
2631             =item test example 1
2632              
2633             package main;
2634              
2635             use Venus::Cli;
2636              
2637             my $cli = Venus::Cli->new(['help']);
2638              
2639             $cli->set('arg', 'name', {
2640             type => 'string',
2641             range => '0',
2642             });
2643              
2644             my ($name) = $cli->test('arg', 'name');
2645              
2646             # "help"
2647              
2648             =back
2649              
2650             =over 4
2651              
2652             =item test example 2
2653              
2654             package main;
2655              
2656             use Venus::Cli;
2657              
2658             my $cli = Venus::Cli->new(['--help']);
2659              
2660             $cli->set('arg', 'name', {
2661             type => 'string',
2662             range => '0',
2663             });
2664              
2665             my ($name) = $cli->test('arg', 'name');
2666              
2667             # Exception! (isa Venus::Cli::Error) (see error_on_arg_validation)
2668              
2669             # Invalid argument: name: received (undef), expected (string)
2670              
2671             =back
2672              
2673             =over 4
2674              
2675             =item test example 3
2676              
2677             package main;
2678              
2679             use Venus::Cli;
2680              
2681             my $cli = Venus::Cli->new(['example', '--name', 'example']);
2682              
2683             $cli->set('opt', 'name', {
2684             type => 'string',
2685             multi => 1,
2686             });
2687              
2688             my ($name) = $cli->test('opt', 'name');
2689              
2690             # "example"
2691              
2692             =back
2693              
2694             =over 4
2695              
2696             =item test example 4
2697              
2698             package main;
2699              
2700             use Venus::Cli;
2701              
2702             my $cli = Venus::Cli->new(['example', '--name', 'example']);
2703              
2704             $cli->set('opt', 'name', {
2705             type => 'number',
2706             multi => 1,
2707             });
2708              
2709             my ($name) = $cli->test('opt', 'name');
2710              
2711             # Exception! (isa Venus::Cli::Error) (see error_on_opt_validation)
2712              
2713             # Invalid option: name: received (undef), expected (number)
2714              
2715             =back
2716              
2717             =cut
2718              
2719             =head1 ERRORS
2720              
2721             This package may raise the following errors:
2722              
2723             =cut
2724              
2725             =over 4
2726              
2727             =item error: C
2728              
2729             This package may raise an error_on_arg_validation exception.
2730              
2731             B
2732              
2733             # given: synopsis;
2734              
2735             my $input = {
2736             throw => 'error_on_arg_validation',
2737             error => "...",
2738             name => "example",
2739             type => "string",
2740             };
2741              
2742             my $error = $cli->catch('error', $input);
2743              
2744             # my $name = $error->name;
2745              
2746             # "on_arg_validation"
2747              
2748             # my $message = $error->render;
2749              
2750             # "Invalid argument: example: ..."
2751              
2752             # my $name = $error->stash('name');
2753              
2754             # "example"
2755              
2756             # my $type = $error->stash('type');
2757              
2758             # "string"
2759              
2760             =back
2761              
2762             =over 4
2763              
2764             =item error: C
2765              
2766             This package may raise an error_on_opt_validation exception.
2767              
2768             B
2769              
2770             # given: synopsis;
2771              
2772             my $input = {
2773             throw => 'error_on_opt_validation',
2774             error => "...",
2775             name => "example",
2776             type => "string",
2777             };
2778              
2779             my $error = $cli->catch('error', $input);
2780              
2781             # my $name = $error->name;
2782              
2783             # "on_opt_validation"
2784              
2785             # my $message = $error->render;
2786              
2787             # "Invalid option: example: ..."
2788              
2789             # my $name = $error->stash('name');
2790              
2791             # "example"
2792              
2793             # my $type = $error->stash('type');
2794              
2795             # "string"
2796              
2797             =back
2798              
2799             =head1 AUTHORS
2800              
2801             Awncorp, C
2802              
2803             =cut
2804              
2805             =head1 LICENSE
2806              
2807             Copyright (C) 2000, Al Newkirk.
2808              
2809             This program is free software, you can redistribute it and/or modify it under
2810             the terms of the Apache license version 2.0.
2811              
2812             =cut