| 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__ |