File Coverage

blib/lib/Connector/Builtin/Env.pm
Criterion Covered Total %
statement 35 37 94.5
branch 4 4 100.0
condition n/a
subroutine 10 11 90.9
pod 3 3 100.0
total 52 55 94.5


line stmt bran cond sub pod time code
1             # Connector::Builtin::Env
2             #
3             # Read values from the environment
4             #
5             # Written by Oliver Welter for the OpenXPKI project 2014
6             #
7             package Connector::Builtin::Env;
8              
9 1     1   140001 use strict;
  1         18  
  1         24  
10 1     1   5 use warnings;
  1         4  
  1         19  
11 1     1   4 use English;
  1         1  
  1         7  
12 1     1   388 use File::Spec;
  1         2  
  1         19  
13 1     1   563 use Data::Dumper;
  1         5910  
  1         57  
14              
15 1     1   449 use Moose;
  1         399746  
  1         10  
16             extends 'Connector::Builtin';
17              
18             has '+LOCATION' => ( required => 0 );
19              
20             has prefix => (
21             is => 'rw',
22             isa => 'Str',
23             default => ''
24             );
25              
26             sub get {
27              
28 6     6 1 23 my $self = shift;
29 6         11 my $key = shift;
30 6         16 my $val = $self->_get_node( $key );
31              
32 6 100       18 if (!defined $val) {
33 2         18 return $self->_node_not_exists( $key );
34             }
35              
36 4         19 return $val;
37              
38             }
39              
40             sub get_meta {
41 0     0 1 0 my $self = shift;
42 0         0 return { TYPE => "scalar" };
43             }
44              
45             sub exists {
46              
47 4     4 1 10 my $self = shift;
48 4         8 my $val = $self->_get_node( shift );
49 4         21 return defined $val;
50              
51             }
52              
53             sub _get_node {
54              
55 10     10   15 my $self = shift;
56              
57 10         294 my $prefix = $self->prefix();
58              
59 10         14 my $key = shift;
60             # We expect only a scalar key, so this is a fast and valid conversion
61 10 100       25 $key = $key->[0] if (ref $key eq 'ARRAY');
62              
63 10         27 return $ENV{$prefix.$key};
64              
65             }
66              
67 1     1   7646 no Moose;
  1         4  
  1         7  
68             __PACKAGE__->meta->make_immutable;
69              
70             1;
71             __END__
72              
73             =head1 Name
74              
75             Connector::Builtin::Env
76              
77             =head1 Description
78              
79             Return the contents of a environment value.
80             The value of LOCATION is not used.
81              
82             =head2 Configuration
83              
84             Connector::Builtin::Env->new({
85             'LOCATION' => 'Not Used'
86             'prefix' => 'optional prefix to be prepended to all keys',
87             });
88