File Coverage

blib/lib/Venus/Args.pm
Criterion Covered Total %
statement 53 58 91.3
branch 17 22 77.2
condition n/a
subroutine 14 15 93.3
pod 8 10 80.0
total 92 105 87.6


line stmt bran cond sub pod time code
1             package Venus::Args;
2              
3 1     1   19 use 5.018;
  1         4  
4              
5 1     1   5 use strict;
  1         2  
  1         24  
6 1     1   6 use warnings;
  1         1  
  1         37  
7              
8 1     1   4 use Venus::Class 'attr', 'base', 'with';
  1         2  
  1         8  
9              
10             base 'Venus::Kind::Utility';
11              
12             with 'Venus::Role::Valuable';
13             with 'Venus::Role::Buildable';
14             with 'Venus::Role::Accessible';
15             with 'Venus::Role::Proxyable';
16              
17             # ATTRIBUTES
18              
19             attr 'named';
20              
21             # BUILDERS
22              
23             sub build_proxy {
24 2     2 0 7 my ($self, $package, $method, $value) = @_;
25              
26 2         5 my $has_value = exists $_[3];
27              
28             return sub {
29 2 50   2   13 return $self->get($method) if !$has_value; # no value
30 0         0 return $self->set($method, $value);
31 2         10 };
32             }
33              
34             sub build_self {
35 15     15 0 32 my ($self, $data) = @_;
36              
37 15 50       34 $self->named({}) if !$self->named;
38              
39 15         30 return $self;
40             }
41              
42             # METHODS
43              
44              
45             sub assertion {
46 0     0 1 0 my ($self) = @_;
47              
48 0         0 my $assert = $self->SUPER::assertion;
49              
50 0         0 $assert->clear->expression('arrayref');
51              
52 0         0 return $assert;
53             }
54              
55             sub default {
56 1     1 1 5 my ($self) = @_;
57              
58 1         8 return [@ARGV];
59             }
60              
61             sub exists {
62 3     3 1 11 my ($self, $name) = @_;
63              
64 3 50       11 return if not defined $name;
65              
66 3         9 my $pos = $self->name($name);
67              
68 3 100       11 return if not defined $pos;
69              
70 2         8 return CORE::exists $self->indexed->{$pos};
71             }
72              
73             sub get {
74 5     5 1 13 my ($self, $name) = @_;
75              
76 5 50       11 return if not defined $name;
77              
78 5         16 my $pos = $self->name($name);
79              
80 5 100       22 return if not defined $pos;
81              
82 4         10 return $self->indexed->{$pos};
83             }
84              
85             sub indexed {
86 15     15 1 23 my ($self) = @_;
87              
88 15         29 return {map +($_, $self->value->[$_]), 0..$#{$self->value}};
  15         30  
89             }
90              
91             sub name {
92 12     12 1 22 my ($self, $name) = @_;
93              
94 12 100       29 if (defined $self->named->{$name}) {
95 6         16 return $self->named->{$name};
96             }
97              
98 6 100       16 if (defined $self->indexed->{$name}) {
99 3         21 return $name;
100             }
101              
102 3         11 return undef;
103             }
104              
105             sub set {
106 3     3 1 10 my ($self, $name, $data) = @_;
107              
108 3 50       9 return if not defined $name;
109              
110 3         9 my $pos = $self->name($name);
111              
112 3 100       14 return if not defined $pos;
113              
114 2         7 return $self->value->[$pos] = $data;
115             }
116              
117             sub unnamed {
118 2     2 1 5 my ($self) = @_;
119              
120 2         5 my $list = [];
121              
122 2         6 my $argv = $self->indexed;
123 2         5 my $data = +{reverse %{$self->named}};
  2         6  
124              
125 2         13 for my $index (sort keys %$argv) {
126 8 100       18 unless (exists $data->{$index}) {
127 5         10 push @$list, $argv->{$index};
128             }
129             }
130              
131 2         13 return $list;
132             }
133              
134             1;
135              
136              
137              
138             =head1 NAME
139              
140             Venus::Args - Args Class
141              
142             =cut
143              
144             =head1 ABSTRACT
145              
146             Args Class for Perl 5
147              
148             =cut
149              
150             =head1 SYNOPSIS
151              
152             package main;
153              
154             use Venus::Args;
155              
156             my $args = Venus::Args->new(
157             named => { flag => 0, command => 1 }, # optional
158             value => ['--help', 'execute'],
159             );
160              
161             # $args->flag; # $ARGV[0]
162             # $args->get(0); # $ARGV[0]
163             # $args->get(1); # $ARGV[1]
164             # $args->action; # $ARGV[1]
165             # $args->exists(0); # exists $ARGV[0]
166             # $args->exists('flag'); # exists $ARGV[0]
167             # $args->get('flag'); # $ARGV[0]
168              
169             =cut
170              
171             =head1 DESCRIPTION
172              
173             This package provides methods for accessing C<@ARGS> items.
174              
175             =cut
176              
177             =head1 ATTRIBUTES
178              
179             This package has the following attributes:
180              
181             =cut
182              
183             =head2 named
184              
185             named(HashRef)
186              
187             This attribute is read-write, accepts C<(HashRef)> values, is optional, and defaults to C<{}>.
188              
189             =cut
190              
191             =head1 INHERITS
192              
193             This package inherits behaviors from:
194              
195             L
196              
197             =cut
198              
199             =head1 INTEGRATES
200              
201             This package integrates behaviors from:
202              
203             L
204              
205             L
206              
207             L
208              
209             L
210              
211             =cut
212              
213             =head1 METHODS
214              
215             This package provides the following methods:
216              
217             =cut
218              
219             =head2 default
220              
221             default() (ArrayRef)
222              
223             The default method returns the default value, i.e. C<@ARGV>.
224              
225             I>
226              
227             =over 4
228              
229             =item default example 1
230              
231             # given: synopsis;
232              
233             my $default = $args->default;
234              
235             # [@ARGV]
236              
237             # ["--help", "execute"]
238              
239             =back
240              
241             =cut
242              
243             =head2 exists
244              
245             exists(Str $key) (Bool)
246              
247             The exists method returns truthy or falsy if an index or alias value exists.
248              
249             I>
250              
251             =over 4
252              
253             =item exists example 1
254              
255             # given: synopsis;
256              
257             my $exists = $args->exists(0);
258              
259             # 1
260              
261             =back
262              
263             =over 4
264              
265             =item exists example 2
266              
267             # given: synopsis;
268              
269             my $exists = $args->exists('flag');
270              
271             # 1
272              
273             =back
274              
275             =over 4
276              
277             =item exists example 3
278              
279             # given: synopsis;
280              
281             my $exists = $args->exists(2);
282              
283             # undef
284              
285             =back
286              
287             =cut
288              
289             =head2 get
290              
291             get(Str $key) (Any)
292              
293             The get method returns the value of the index or alias.
294              
295             I>
296              
297             =over 4
298              
299             =item get example 1
300              
301             # given: synopsis;
302              
303             my $get = $args->get(0);
304              
305             # "--help"
306              
307             =back
308              
309             =over 4
310              
311             =item get example 2
312              
313             # given: synopsis;
314              
315             my $get = $args->get('flag');
316              
317             # "--help"
318              
319             =back
320              
321             =over 4
322              
323             =item get example 3
324              
325             # given: synopsis;
326              
327             my $get = $args->get(2);
328              
329             # undef
330              
331             =back
332              
333             =cut
334              
335             =head2 indexed
336              
337             indexed() (HashRef)
338              
339             The indexed method returns a set of indices and values.
340              
341             I>
342              
343             =over 4
344              
345             =item indexed example 1
346              
347             # given: synopsis;
348              
349             my $indexed = $args->indexed;
350              
351             # { "0" => "--help", "1" => "execute" }
352              
353             =back
354              
355             =cut
356              
357             =head2 name
358              
359             name(Str $key) (Str | Undef)
360              
361             The name method resolves and returns the index for an index or alias, and
362             returns undefined if not found.
363              
364             I>
365              
366             =over 4
367              
368             =item name example 1
369              
370             # given: synopsis;
371              
372             my $name = $args->name('flag');
373              
374             =back
375              
376             =cut
377              
378             =head2 set
379              
380             set(Str $key, Any $data) (Any)
381              
382             The set method sets and returns the value of an index or alias.
383              
384             I>
385              
386             =over 4
387              
388             =item set example 1
389              
390             # given: synopsis;
391              
392             my $set = $args->set(0, '-?');
393              
394             # "-?"
395              
396             =back
397              
398             =over 4
399              
400             =item set example 2
401              
402             # given: synopsis;
403              
404             my $set = $args->set('flag', '-?');
405              
406             # "-?"
407              
408             =back
409              
410             =over 4
411              
412             =item set example 3
413              
414             # given: synopsis;
415              
416             my $set = $args->set('verbose', 1);
417              
418             # undef
419              
420             =back
421              
422             =cut
423              
424             =head2 unnamed
425              
426             unnamed() (ArrayRef)
427              
428             The unnamed method returns a list of unaliases indices.
429              
430             I>
431              
432             =over 4
433              
434             =item unnamed example 1
435              
436             package main;
437              
438             use Venus::Args;
439              
440             my $args = Venus::Args->new(
441             named => { flag => 0, command => 1 },
442             value => ['--help', 'execute', '--format', 'markdown'],
443             );
444              
445             my $unnamed = $args->unnamed;
446              
447             # ["--format", "markdown"]
448              
449             =back
450              
451             =over 4
452              
453             =item unnamed example 2
454              
455             package main;
456              
457             use Venus::Args;
458              
459             my $args = Venus::Args->new(
460             named => { command => 1 },
461             value => ['execute', 'phase-1', '--format', 'markdown'],
462             );
463              
464             my $unnamed = $args->unnamed;
465              
466             # ["execute", "--format", "markdown"]
467              
468             =back
469              
470             =cut
471              
472             =head1 AUTHORS
473              
474             Awncorp, C
475              
476             =cut
477              
478             =head1 LICENSE
479              
480             Copyright (C) 2000, Al Newkirk.
481              
482             This program is free software, you can redistribute it and/or modify it under
483             the terms of the Apache license version 2.0.
484              
485             =cut