File Coverage

blib/lib/Data/Hopen/Scope/Environment.pm
Criterion Covered Total %
statement 33 34 97.0
branch 8 10 80.0
condition n/a
subroutine 9 10 90.0
pod 1 1 100.0
total 51 55 92.7


line stmt bran cond sub pod time code
1             # Data::Hopen::Scope::Environment - a hopen Scope for %ENV
2             # TODO handle $set == FIRST_ONLY
3             package Data::Hopen::Scope::Environment;
4 7     7   7633 use strict;
  7         17  
  7         235  
5 7     7   41 use Data::Hopen::Base;
  7         14  
  7         59  
6              
7             our $VERSION = '0.000019';
8              
9 7     7   1740 use Data::Hopen::Scope qw(:default :internal);
  7         15  
  7         668  
10 7     7   45 use parent 'Data::Hopen::Scope';
  7         15  
  7         37  
11              
12 7     7   427 use Data::Hopen qw(hlog getparameters);
  7         15  
  7         347  
13 7     7   46 use Set::Scalar;
  7         25  
  7         2807  
14              
15             # Docs {{{1
16              
17             =head1 NAME
18              
19             Data::Hopen::Scope::Environment - a Data::Hopen::Scope of %ENV
20              
21             =head1 SYNOPSIS
22              
23             This is a thin wrapper around C<%ENV>, implemented as a
24             L. It only supports one set of data
25             (L), which is named C<0> for consistency
26             with L.
27              
28             =head1 METHODS
29              
30             Note: L is unsupported.
31              
32             =cut
33              
34             # }}}1
35              
36             ### Protected functions ###
37              
38             =head2 _find_here
39              
40             Find a named data item in C<%ENV> and return it. Returns undef on
41             failure.
42              
43             =cut
44              
45             sub _find_here {
46 12     12   42 my ($self, %args) = getparameters('self', [qw(name ; set)], @_);
47 12 50       723 _set0 $args{set} or croak 'I only support set 0';
48 12         36 my $val = $ENV{$args{name}};
49 12 100       33 return undef unless defined $val;
50 9 100       41 return ($args{set} eq '*') ? { 0 => $val } : $val;
51             } #_find_here()
52              
53             =head2 put
54              
55             Updates the corresponding environment variables, in order, by setting C<$ENV{}>.
56             Returns the instance.
57              
58             =cut
59              
60             sub put {
61 3     3 1 1603 my $self = shift;
62 3 100       257 croak "Got an odd number of parameters" if @_%2;
63 2         8 while(@_) {
64 1         2 my $k = shift;
65 1         11 $ENV{$k} = shift;
66             }
67 2         5 return $self;
68             } #add()
69              
70             =head2 _names_here
71              
72             Add the names in C<%ENV> to the given L.
73              
74             =cut
75              
76             sub _names_here {
77 4     4   40 my ($self, %args) = getparameters('self', [qw(retval ; set)], @_);
78 4 50       519 _set0 $args{set} or croak 'I only support set 0';
79 4         56 $args{retval}->insert(keys %ENV);
80 4     0   910 hlog { __PACKAGE__ . '::_names_here', Dumper $args{retval} } 9;
  0            
81             # Don't usually log, since the environment is often fairly hefty!
82             } #_names_here()
83              
84             1;
85             __END__