File Coverage

lib/Gentoo/PerlMod/Version/Env.pm
Criterion Covered Total %
statement 23 23 100.0
branch 8 8 100.0
condition n/a
subroutine 6 6 100.0
pod 3 3 100.0
total 40 40 100.0


line stmt bran cond sub pod time code
1 5     5   19557 use 5.006;
  5         14  
  5         171  
2 5     5   21 use strict;
  5         6  
  5         145  
3 5     5   28 use warnings;
  5         7  
  5         1457  
4              
5             package Gentoo::PerlMod::Version::Env;
6              
7             our $VERSION = '0.7.1';
8              
9             # ABSTRACT: Get/parse settings from %ENV
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13             my $state;
14             my $env_key = 'GENTOO_PERLMOD_VERSION_OPTS';
15              
16              
17              
18              
19              
20              
21              
22             sub opts {
23 92 100   92 1 372 return $state if defined $state;
24 4         7 $state = {};
25 4 100       23 return $state if not defined $ENV{$env_key};
26 1         7 my (@tokes) = split /\s+/msx, $ENV{$env_key};
27 1         2 for my $token (@tokes) {
28 6 100       28 if ( $token =~ /\A([^=]+)=(.+)\z/msx ) {
    100          
29 3         9 $state->{"$1"} = "$2";
30             }
31             elsif ( $token =~ /\A-(.+)\z/msx ) {
32 1         4 delete $state->{"$1"};
33             }
34             else {
35 2         3 $state->{$token} = 1;
36             }
37             }
38 1         6 return $state;
39             }
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51             sub hasopt {
52 89     89 1 142 my ($opt) = @_;
53 89         116 return exists opts()->{$opt};
54             }
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66             sub getopt {
67 3     3 1 4 my ($opt) = @_;
68 3         5 return opts()->{$opt};
69             }
70              
71             1;
72              
73             __END__