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 5     5   125675 use base qw(Exporter);
  5         10  
  5         738  
4 5     5   52 use strict;
  5         10  
  5         205  
5 5     5   22 use warnings;
  5         10  
  5         274  
6              
7 5     5   2127 use English qw(-no_match_vars);
  5         14933  
  5         33  
8 5     5   6302 use Error::Pure::Utils qw();
  5         33  
  5         162  
9 5     5   35 use Readonly;
  5         22  
  5         1879  
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.34;
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 9     9 1 759131 my @msg = @_;
27 9         26 $Error::Pure::Utils::LEVEL = $LEVEL;
28 9         19 my $class;
29 9 100       35 if (defined $TYPE) {
    50          
30 5         15 $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         10 $class = 'Error::Pure::'.$TYPE_DEFAULT;
36             }
37 9         1795 eval "require $class";
38 9 100       55 if ($EVAL_ERROR) {
39              
40             # Switch to default, module doesn't exist.
41 1         2 $class = 'Error::Pure::'.$TYPE_DEFAULT;
42 1         62 eval "require $class";
43 1 50       6 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 9         654 eval $class.'::err @msg';
50 9 50       57 if ($EVAL_ERROR) {
51 9         68 die $EVAL_ERROR;
52             }
53 0           return;
54             }
55              
56             1;
57              
58             __END__