File Coverage

blib/lib/Error/Pure/HTTP/Print.pm
Criterion Covered Total %
statement 29 39 74.3
branch 4 10 40.0
condition 1 3 33.3
subroutine 8 8 100.0
pod 1 1 100.0
total 43 61 70.4


line stmt bran cond sub pod time code
1             package Error::Pure::HTTP::Print;
2              
3             # Pragmas.
4 3     3   35357 use base qw(Exporter);
  3         7  
  3         353  
5 3     3   17 use strict;
  3         5  
  3         70  
6 3     3   17 use warnings;
  3         8  
  3         109  
7              
8             # Modules.
9 3     3   2870 use Error::Pure::Utils qw(err_helper);
  3         19231  
  3         75  
10 3     3   3237 use List::MoreUtils qw(none);
  3         39601  
  3         24  
11 3     3   1990 use Readonly;
  3         7  
  3         1255  
12              
13             # Constants.
14             Readonly::Array our @EXPORT_OK => qw(err);
15             Readonly::Scalar my $EMPTY_STR => q{};
16             Readonly::Scalar my $EVAL => 'eval {...}';
17              
18             # Version.
19             our $VERSION = 0.14;
20              
21             # Ignore die signal.
22             $SIG{__DIE__} = 'IGNORE';
23              
24             # Process error.
25             sub err {
26 5     5 1 1913 my @msg = @_;
27              
28             # Get errors structure.
29 5         17 my @errors = err_helper(@msg);
30              
31             # Error message.
32 5         1025 my $e = $errors[-1]->{'msg'}->[0];
33 5 50       12 if (! defined $e) {
34 0         0 $e = 'undef';
35             } else {
36 5         9 chomp $e;
37             }
38              
39             # Finalize in main on last err.
40 5         8 my $stack_ar = $errors[-1]->{'stack'};
41 5 50 33     29 if ($stack_ar->[-1]->{'class'} eq 'main'
42 10 100   10   48 && none { $_ eq $EVAL || $_ =~ /^eval '/ms }
43 10         39 map { $_->{'sub'} } @{$stack_ar}) {
  5         12  
44              
45 0         0 my $class = $errors[-1]->{'stack'}->[0]->{'class'};
46 0 0       0 if ($class eq 'main') {
47 0         0 $class = $EMPTY_STR
48             }
49 0 0       0 if ($class) {
50 0         0 $class .= ': ';
51             }
52 0         0 print "Content-type: text/plain\n\n";
53 0         0 print $class."$e\n";
54 0         0 return;
55              
56             # Die for eval.
57             } else {
58 5         29 die "$e\n";
59             }
60              
61 0           return;
62             }
63              
64             1;
65              
66             __END__