File Coverage

blib/lib/Venus/Cli.pm
Criterion Covered Total %
statement 390 510 76.4
branch 120 170 70.5
condition 70 114 61.4
subroutine 61 112 54.4
pod 16 104 15.3
total 657 1010 65.0


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