File Coverage

blib/lib/Venus/Vars.pm
Criterion Covered Total %
statement 52 57 91.2
branch 19 24 79.1
condition n/a
subroutine 13 14 92.8
pod 7 9 77.7
total 91 104 87.5


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