File Coverage

blib/lib/Data/Object/Args.pm
Criterion Covered Total %
statement 66 67 98.5
branch 15 20 75.0
condition n/a
subroutine 15 15 100.0
pod 5 7 71.4
total 101 109 92.6


line stmt bran cond sub pod time code
1             package Data::Object::Args;
2              
3 1     1   35265 use 5.014;
  1         4  
4              
5 1     1   5 use strict;
  1         2  
  1         21  
6 1     1   4 use warnings;
  1         2  
  1         38  
7              
8 1     1   6 use registry;
  1         2  
  1         8  
9 1     1   6008 use routines;
  1         3  
  1         7  
10              
11 1     1   2333 use Data::Object::Class;
  1         994  
  1         10  
12 1     1   842 use Data::Object::ClassHas;
  1         10284  
  1         9  
13              
14             with 'Data::Object::Role::Buildable';
15             with 'Data::Object::Role::Proxyable';
16             with 'Data::Object::Role::Stashable';
17              
18             our $VERSION = '2.00'; # VERSION
19              
20             # ATTRIBUTES
21              
22             has 'named' => (
23             is => 'ro',
24             isa => 'HashRef',
25             opt => 1,
26             );
27              
28             # BUILD
29              
30 12     12 0 119443 method build_self($args) {
  12         30  
  12         20  
31 12 50       41 $self->{named} = {} if !$args->{named};
32              
33 12         83 my $argv = { map +($_, $ARGV[$_]), 0..$#ARGV };
34              
35 12         48 $self->stash(argv => $argv);
36              
37 12         156 return $self;
38             }
39              
40 2     2 0 893 method build_proxy($package, $method, $value) {
  2         7  
  2         5  
41 2         5 my $has_value = exists $_[2];
42              
43             return sub {
44              
45 2 50   2   42 return $self->get($method) if !$has_value; # no val
46              
47 0         0 return $self->set($method, $value);
48 2         14 };
49             }
50              
51             # METHODS
52              
53 3     3 1 82 method exists($key) {
  3         7  
  3         6  
54 3 50       8 return if not defined $key;
55              
56 3         7 my $pos = $self->name($key);
57              
58 3 100       19 return if not defined $pos;
59              
60 2         4 return exists $self->stashed->{$pos};
61             }
62              
63 5     5 1 88 method get($key) {
  5         12  
  5         8  
64 5 50       14 return if not defined $key;
65              
66 5         14 my $pos = $self->name($key);
67              
68 5 100       23 return if not defined $pos;
69              
70 4         11 return $self->stashed->{$pos};
71             }
72              
73 12     12 1 48 method name($key) {
  12         23  
  12         16  
74 12 100       45 if (defined $self->named->{$key}) {
75 6         32 return $self->named->{$key};
76             }
77              
78 6 100       15 if (defined $self->stashed->{$key}) {
79 3         11 return $key;
80             }
81              
82 3         9 return undef;
83             }
84              
85 3     3 1 83 method set($key, $val) {
  3         7  
  3         5  
86 3 50       13 return if not defined $key;
87              
88 3         9 my $pos = $self->name($key);
89              
90 3 100       20 return if not defined $pos;
91              
92 2         6 return $self->stashed->{$pos} = $val;
93             }
94              
95 15     15 1 48 method stashed() {
  15         19  
96 15         36 my $data = $self->stash('argv');
97              
98 15         233 return $data;
99             }
100              
101             1;
102              
103             =encoding utf8
104              
105             =head1 NAME
106              
107             Data::Object::Args
108              
109             =cut
110              
111             =head1 ABSTRACT
112              
113             Args Class for Perl 5
114              
115             =cut
116              
117             =head1 SYNOPSIS
118              
119             package main;
120              
121             use Data::Object::Args;
122              
123             local @ARGV = qw(--help execute);
124              
125             my $args = Data::Object::Args->new(
126             named => { flag => 0, command => 1 }
127             );
128              
129             # $args->flag; # $ARGV[0]
130             # $args->get(0); # $ARGV[0]
131             # $args->get(1); # $ARGV[1]
132             # $args->action; # $ARGV[1]
133             # $args->exists(0); # exists $ARGV[0]
134             # $args->exists('flag'); # exists $ARGV[0]
135             # $args->get('flag'); # $ARGV[0]
136              
137             =cut
138              
139             =head1 DESCRIPTION
140              
141             This package provides methods for accessing C<@ARGS> items.
142              
143             =cut
144              
145             =head1 INTEGRATES
146              
147             This package integrates behaviors from:
148              
149             L<Data::Object::Role::Buildable>
150              
151             L<Data::Object::Role::Proxyable>
152              
153             L<Data::Object::Role::Stashable>
154              
155             =cut
156              
157             =head1 LIBRARIES
158              
159             This package uses type constraints from:
160              
161             L<Types::Standard>
162              
163             =cut
164              
165             =head1 ATTRIBUTES
166              
167             This package has the following attributes:
168              
169             =cut
170              
171             =head2 named
172              
173             named(HashRef)
174              
175             This attribute is read-only, accepts C<(HashRef)> values, and is optional.
176              
177             =cut
178              
179             =head1 METHODS
180              
181             This package implements the following methods:
182              
183             =cut
184              
185             =head2 exists
186              
187             exists(Str $key) : Any
188              
189             The exists method takes a name or index and returns truthy if an associated
190             value exists.
191              
192             =over 4
193              
194             =item exists example #1
195              
196             # given: synopsis
197              
198             $args->exists(0); # truthy
199              
200             =back
201              
202             =over 4
203              
204             =item exists example #2
205              
206             # given: synopsis
207              
208             $args->exists('flag'); # truthy
209              
210             =back
211              
212             =over 4
213              
214             =item exists example #3
215              
216             # given: synopsis
217              
218             $args->exists(2); # falsy
219              
220             =back
221              
222             =cut
223              
224             =head2 get
225              
226             get(Str $key) : Any
227              
228             The get method takes a name or index and returns the associated value.
229              
230             =over 4
231              
232             =item get example #1
233              
234             # given: synopsis
235              
236             $args->get(0); # --help
237              
238             =back
239              
240             =over 4
241              
242             =item get example #2
243              
244             # given: synopsis
245              
246             $args->get('flag'); # --help
247              
248             =back
249              
250             =over 4
251              
252             =item get example #3
253              
254             # given: synopsis
255              
256             $args->get(2); # undef
257              
258             =back
259              
260             =cut
261              
262             =head2 name
263              
264             name(Str $key) : Any
265              
266             The name method takes a name or index and returns index if the the associated
267             value exists.
268              
269             =over 4
270              
271             =item name example #1
272              
273             # given: synopsis
274              
275             $args->name('flag'); # 0
276              
277             =back
278              
279             =cut
280              
281             =head2 set
282              
283             set(Str $key, Maybe[Any] $value) : Any
284              
285             The set method takes a name or index and sets the value provided if the
286             associated argument exists.
287              
288             =over 4
289              
290             =item set example #1
291              
292             # given: synopsis
293              
294             $args->set(0, '-?'); # -?
295              
296             =back
297              
298             =over 4
299              
300             =item set example #2
301              
302             # given: synopsis
303              
304             $args->set('flag', '-?'); # -?
305              
306             =back
307              
308             =over 4
309              
310             =item set example #3
311              
312             # given: synopsis
313              
314             $args->set('verbose', 1); # undef
315              
316             # is not set
317              
318             =back
319              
320             =cut
321              
322             =head2 stashed
323              
324             stashed() : HashRef
325              
326             The stashed method returns the stashed data associated with the object.
327              
328             =over 4
329              
330             =item stashed example #1
331              
332             # given: synopsis
333              
334             $args->stashed
335              
336             =back
337              
338             =cut
339              
340             =head1 AUTHOR
341              
342             Al Newkirk, C<awncorp@cpan.org>
343              
344             =head1 LICENSE
345              
346             Copyright (C) 2011-2019, Al Newkirk, et al.
347              
348             This is free software; you can redistribute it and/or modify it under the terms
349             of the The Apache License, Version 2.0, as elucidated in the L<"license
350             file"|https://github.com/iamalnewkirk/data-object-args/blob/master/LICENSE>.
351              
352             =head1 PROJECT
353              
354             L<Wiki|https://github.com/iamalnewkirk/data-object-args/wiki>
355              
356             L<Project|https://github.com/iamalnewkirk/data-object-args>
357              
358             L<Initiatives|https://github.com/iamalnewkirk/data-object-args/projects>
359              
360             L<Milestones|https://github.com/iamalnewkirk/data-object-args/milestones>
361              
362             L<Contributing|https://github.com/iamalnewkirk/data-object-args/blob/master/CONTRIBUTE.md>
363              
364             L<Issues|https://github.com/iamalnewkirk/data-object-args/issues>
365              
366             =cut