File Coverage

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


line stmt bran cond sub pod time code
1 5     5   20007 use 5.006;
  5         15  
2 5     5   22 use strict;
  5         7  
  5         119  
3 5     5   27 use warnings;
  5         7  
  5         1603  
4              
5             package Gentoo::PerlMod::Version::Env;
6              
7             our $VERSION = '0.8.0';
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 378 return $state if defined $state;
24 4         7 $state = {};
25 4 100       27 return $state if not defined $ENV{$env_key};
26 1         25 my (@tokes) = split /\s+/msx, $ENV{$env_key};
27 1         3 for my $token (@tokes) {
28 6 100       21 if ( $token =~ /\A([^=]+)=(.+)\z/msx ) {
    100          
29 3         9 $state->{"$1"} = "$2";
30             }
31             elsif ( $token =~ /\A-(.+)\z/msx ) {
32 1         3 delete $state->{"$1"};
33             }
34             else {
35 2         4 $state->{$token} = 1;
36             }
37             }
38 1         9 return $state;
39             }
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51             sub hasopt {
52 89     89 1 141 my ($opt) = @_;
53 89         115 return exists opts()->{$opt};
54             }
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66             sub getopt {
67 3     3 1 7 my ($opt) = @_;
68 3         4 return opts()->{$opt};
69             }
70              
71             1;
72              
73             __END__