File Coverage

blib/lib/Error/Pure.pm
Criterion Covered Total %
statement 32 37 86.4
branch 7 10 70.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 47 55 85.4


line stmt bran cond sub pod time code
1             package Error::Pure;
2              
3 3     3   78413 use base qw(Exporter);
  3         32  
  3         425  
4 3     3   22 use strict;
  3         5  
  3         83  
5 3     3   16 use warnings;
  3         5  
  3         151  
6              
7 3     3   1033 use English qw(-no_match_vars);
  3         7540  
  3         27  
8 3     3   2271 use Error::Pure::Utils qw();
  3         8  
  3         71  
9 3     3   20 use Readonly;
  3         5  
  3         921  
10              
11             # Constants.
12             Readonly::Array our @EXPORT_OK => qw(err);
13             Readonly::Scalar my $TYPE_DEFAULT => 'Die';
14             Readonly::Scalar my $LEVEL_DEFAULT => 4;
15              
16             our $VERSION = 0.29;
17              
18             # Type of error.
19             our $TYPE;
20              
21             # Level for this class.
22             our $LEVEL = $LEVEL_DEFAULT;
23              
24             # Process error.
25             sub err {
26 7     7 1 3217 my @msg = @_;
27 7         12 $Error::Pure::Utils::LEVEL = $LEVEL;
28 7         12 my $class;
29 7 100       21 if (defined $TYPE) {
    50          
30 3         7 $class = 'Error::Pure::'.$TYPE;
31             } elsif ($ENV{'ERROR_PURE_TYPE'}) {
32             $class = 'Error::Pure::'.
33 0         0 $ENV{'ERROR_PURE_TYPE'};
34             } else {
35 4         9 $class = 'Error::Pure::'.$TYPE_DEFAULT;
36             }
37 7         417 eval "require $class";
38 7 100       31 if ($EVAL_ERROR) {
39              
40             # Switch to default, module doesn't exist.
41 1         4 $class = 'Error::Pure::'.$TYPE_DEFAULT;
42 1         44 eval "require $class";
43 1 50       5 if ($EVAL_ERROR) {
44 0         0 my $err = $EVAL_ERROR;
45 0         0 $err =~ s/\ at.*$//ms;
46 0         0 die $err;
47             }
48             }
49 7         318 eval $class.'::err @msg';
50 7 50       37 if ($EVAL_ERROR) {
51 7         25 die $EVAL_ERROR;
52             }
53 0           return;
54             }
55              
56             1;
57              
58             __END__