File Coverage

blib/lib/Positron/Environment.pm
Criterion Covered Total %
statement 38 38 100.0
branch 16 16 100.0
condition 11 11 100.0
subroutine 9 9 100.0
pod 3 3 100.0
total 77 77 100.0


line stmt bran cond sub pod time code
1             package Positron::Environment;
2             our $VERSION = 'v0.1.3'; # VERSION
3              
4             =head1 NAME
5              
6             Positron::Environment - container class for template parameters
7              
8             =head1 VERSION
9              
10             version v0.1.3
11              
12             =head1 SYNOPSIS
13              
14             use Positron::Environment;
15             my $env = Positron::Environment->new({ key1 => 'value 1', key2 => 'value 2'});
16             my $child = Positron::Environment->new({ key1 => 'value 3'}, { parent => $env });
17              
18             say $env->get('key1'); # value 1
19             say $env->get('key2'); # value 2
20             say $child->get('key1'); # value 3
21             say $child->get('key2'); # value 2
22              
23             $child->set( key2 => 'value 4' );
24             say $child->get('key2'); # value 4
25             say $env->get('key2'); # value 2
26              
27             =head1 DESCRIPTION
28              
29             C is basically a thin wrapper around hashes (key-value mappings)
30             with hierarchy extensions. It is used internally by the C template systems
31             to store template variables.
32              
33             C provides getters and setters for values. It can also optionally
34             refer to a parent environment. If the environment does not contain anything for an
35             asked-for key, it will ask its parent in turn.
36             Note that if a key refers to C as its value, this counts as "containing something",
37             and the parent will not be asked.
38              
39             Getting or setting the special key C<_> (a single underscore) accesses the entire data,
40             i.e. the hash that was used in the constructor.
41             These requests are never passed to any parents.
42              
43             =head2 Non-hash data
44              
45             Although C is built for hashes, it can also be used with plain
46             scalar data (strings, numbers, C) or array references.
47             Calling C when the data is a string results in C being returned.
48             Calling C when the data is a string results in a warning, and returns C,
49             but currently does not raise an exception. Just don't expect to get that value back
50             again.
51              
52             Calling C or C when the data is an array (reference) works by first converting
53             the key to an integer via the builtin C function.
54             This means that alphabetic keys will be coerced to the number C<0> (with the regular
55             Perl warning) and floating point values get rounded towards 0.
56             On the other hand, this means that negative keys will start counting from the back of
57             the array.
58              
59             =cut
60              
61 37     37   299838 use v5.10;
  37         140  
  37         1871  
62 37     37   313 use strict;
  37         72  
  37         1428  
63 37     37   194 use warnings;
  37         67  
  37         1375  
64 37     37   204 use Carp qw(croak carp);
  37         72  
  37         9920  
65              
66             =head1 CONSTRUCTOR
67              
68             =head2 new
69              
70             my $env = Positron::Environment->new( \%data, \%options );
71              
72             Creates a new environment which serves the data passed in a hash reference. The following options are supported:
73              
74             =over 4
75              
76             =item immutable
77              
78             If set to a true value, the constructed environment will be immutable; calling the
79             C method will raise an exception.
80              
81             =item parent
82              
83             A reference to another environment. If the newly constructed environment does not
84             contain a key when asked with C, it will ask this parent environment (which
85             can have a parent in turn).
86              
87             =back
88              
89             =cut
90              
91             sub new {
92 453     453 1 10566 my($class, $data, $options) = @_;
93 453   100     1790 $options //= {};
94 453   100     4212 my $self = {
      100        
      100        
95             data => $data // {},
96             immutable => $options->{'immutable'} // 0,
97             # We don't need to weaken, since we are always pointing upwards only!
98             parent => $options->{'parent'} // undef,
99             };
100 453         2271 return bless($self, $class);
101             }
102              
103             =head1 METHODS
104              
105             =head2 get
106              
107             my $value = $env->get('key');
108              
109             Returns the value stored under the key C in the data of this environment.
110             This is very much like a standard hash ref. If this environment does not know
111             about this key (i.e. it does not exist in the data hash), it returns C,
112             unless a parent environment is set. In this case, it will recursively query
113             its parent for the key.
114              
115             The special key C<_> returns the entire data of this environment, never
116             querying the parent.
117              
118             =cut
119              
120             sub get {
121 616     616 1 16010 my ($self, $key) = @_;
122 616 100       1351 if ($key eq '_') {
123 14         94 return $self->{'data'};
124             }
125 602 100 100     3568 if (ref($self->{'data'}) eq 'HASH' and exists $self->{'data'}->{$key}) {
    100          
    100          
126 503         3012 return $self->{'data'}->{$key};
127             } elsif (ref($self->{'data'}) eq 'ARRAY') {
128             # What about parents with array refs?
129 37     37   239 no warnings 'numeric'; # all else is 0, that's ok.
  37         106  
  37         6468  
130 4         27 return $self->{'data'}->[int($key)];
131             # N.B.: other scalars (non-refs, objects) never perform subqueries, always 'undef'
132             } elsif ($self->{'parent'}) {
133 58         160 return $self->{'parent'}->get($key);
134             }
135 37         238 return undef; # always scalar
136             }
137              
138             =head2 set
139              
140             my $value = $env->set('key', 'value');
141              
142             Sets the key to the given value in this environment's data hash.
143             This call will croak if the environment has been marked as immutable.
144             Setting the value to C will effectively mask any parent; a C
145             call will return C even if the parent has a defined value.
146              
147             The special key C<_> sets the entire data of this environment.
148              
149             Returns the value again I<(this may change in future versions)>.
150              
151             =cut
152              
153             # Why do we need this, again?
154             # TODO: Should this delete if no value is passed?
155             sub set {
156 37     37 1 2233 my ($self, $key, $value) = @_;
157 37 100       179 croak "Immutable environment being changed" if $self->{'immutable'};
158 34 100       165 if ($key eq '_') {
    100          
    100          
159 2         5 $self->{'data'} = $value;
160             } elsif (ref($self->{'data'}) eq 'ARRAY') {
161 37     37   229 no warnings 'numeric';
  37         75  
  37         5122  
162 4         13 $self->{'data'}->[int($key)] = $value;
163             } elsif (ref($self->{'data'}) eq 'HASH') {
164 27         70 $self->{'data'}->{$key} = $value;
165             } else {
166 1         30 carp "Setting an environment which is neither hash nor array";
167             }
168 34         444 return $value;
169             }
170              
171             1; # End of Positron::Environment
172              
173             __END__