| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Error::Pure::NoDie; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | # Pragmas. | 
| 4 | 4 |  |  | 4 |  | 84669 | use base qw(Exporter); | 
|  | 4 |  |  |  |  | 11 |  | 
|  | 4 |  |  |  |  | 872 |  | 
| 5 | 4 |  |  | 4 |  | 27 | use strict; | 
|  | 4 |  |  |  |  | 7 |  | 
|  | 4 |  |  |  |  | 139 |  | 
| 6 | 4 |  |  | 4 |  | 22 | use warnings; | 
|  | 4 |  |  |  |  | 19 |  | 
|  | 4 |  |  |  |  | 152 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | # Modules. | 
| 9 | 4 |  |  | 4 |  | 4669 | use Error::Pure::Utils qw(err_helper); | 
|  | 4 |  |  |  |  | 28072 |  | 
|  | 4 |  |  |  |  | 124 |  | 
| 10 | 4 |  |  | 4 |  | 7147 | use List::MoreUtils qw(none); | 
|  | 4 |  |  |  |  | 4196 |  | 
|  | 4 |  |  |  |  | 314 |  | 
| 11 | 4 |  |  | 4 |  | 28 | use Readonly; | 
|  | 4 |  |  |  |  | 9 |  | 
|  | 4 |  |  |  |  | 1788 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | # Version. | 
| 14 |  |  |  |  |  |  | our $VERSION = 0.03; | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | # Constants. | 
| 17 |  |  |  |  |  |  | Readonly::Array our @EXPORT_OK => qw(err); | 
| 18 |  |  |  |  |  |  | Readonly::Scalar my $EMPTY_STR => q{}; | 
| 19 |  |  |  |  |  |  | Readonly::Scalar my $EVAL => 'eval {...}'; | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | # Ignore die signal. | 
| 22 |  |  |  |  |  |  | $SIG{__DIE__} = 'IGNORE'; | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | # Process error. | 
| 25 |  |  |  |  |  |  | sub err { | 
| 26 | 7 |  |  | 7 | 1 | 3732 | my @msg = @_; | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | # Get errors structure. | 
| 29 | 7 |  |  |  |  | 28 | my @errors = err_helper(@msg); | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | # Error messages. | 
| 32 | 7 |  |  |  |  | 1825 | chomp $errors[-1]->{'msg'}->[0]; | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | # Finalize in main on last err. | 
| 35 | 7 |  |  |  |  | 15 | my $stack_ar = $errors[-1]->{'stack'}; | 
| 36 | 7 | 100 | 66 |  |  | 52 | if ($stack_ar->[-1]->{'class'} eq 'main' | 
| 37 | 13 | 100 |  | 13 |  | 73 | && none { $_ eq $EVAL || $_ =~ /^eval '/ms } | 
| 38 | 13 |  |  |  |  | 59 | map { $_->{'sub'} } @{$stack_ar}) { | 
|  | 7 |  |  |  |  | 18 |  | 
| 39 |  |  |  |  |  |  |  | 
| 40 | 2 |  |  |  |  | 3 | print join $EMPTY_STR, @{$errors[-1]->{'msg'}}, "\n"; | 
|  | 2 |  |  |  |  | 14 |  | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | # Die for eval. | 
| 43 |  |  |  |  |  |  | } else { | 
| 44 | 5 |  |  |  |  | 13 | my $e = $errors[-1]->{'msg'}->[0]; | 
| 45 | 5 |  |  |  |  | 35 | die "$e\n"; | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  |  | 
| 48 | 2 |  |  |  |  | 36 | return; | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | 1; | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | __END__ |