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 3     3   144898 use base qw(Exporter);
  3         6  
  3         487  
4 3     3   18 use strict;
  3         7  
  3         84  
5 3     3   11 use warnings;
  3         8  
  3         153  
6              
7 3     3   1463 use Error::Pure::Utils qw(err_helper);
  3         22783  
  3         99  
8 3     3   2293 use List::MoreUtils qw(none);
  3         55710  
  3         27  
9 3     3   4127 use Readonly;
  3         7  
  3         1572  
10              
11             # Constants.
12             Readonly::Array our @EXPORT_OK => qw(err);
13             Readonly::Scalar my $EMPTY_STR => q{};
14             Readonly::Scalar my $EVAL => 'eval {...}';
15              
16             # Version.
17             our $VERSION = 0.16;
18              
19             # Ignore die signal.
20             $SIG{__DIE__} = 'IGNORE';
21              
22             # Process error.
23             sub err {
24 5     5 1 392941 my @msg = @_;
25              
26             # Get errors structure.
27 5         24 my @errors = err_helper(@msg);
28              
29             # Error message.
30 5         1236 my $e = $errors[-1]->{'msg'}->[0];
31 5 50       16 if (! defined $e) {
32 0         0 $e = 'undef';
33             } else {
34 5         12 chomp $e;
35             }
36              
37             # Finalize in main on last err.
38 5         10 my $stack_ar = $errors[-1]->{'stack'};
39 5 50 33     40 if ($stack_ar->[-1]->{'class'} eq 'main'
40 10 100   10   46 && none { $_ eq $EVAL || $_ =~ /^eval '/ms }
41 10         41 map { $_->{'sub'} } @{$stack_ar}) {
  5         13  
42              
43 0         0 my $class = $errors[-1]->{'stack'}->[0]->{'class'};
44 0 0       0 if ($class eq 'main') {
45 0         0 $class = $EMPTY_STR
46             }
47 0 0       0 if ($class) {
48 0         0 $class .= ': ';
49             }
50 0         0 print "Content-type: text/plain\n\n";
51 0         0 print $class."$e\n";
52 0         0 return;
53              
54             # Die for eval.
55             } else {
56 5         50 die "$e\n";
57             }
58              
59 0           return;
60             }
61              
62             1;
63              
64             __END__