File Coverage

blib/lib/results/exceptions.pm
Criterion Covered Total %
statement 73 79 92.4
branch 9 12 75.0
condition 4 4 100.0
subroutine 19 21 90.4
pod 0 1 0.0
total 105 117 89.7


line stmt bran cond sub pod time code
1 2     2   469890 use 5.014;
  2         19  
2 2     2   15 use strict;
  2         4  
  2         45  
3 2     2   10 use warnings;
  2         4  
  2         137  
4              
5             package results::exceptions;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.005';
9              
10 2     2   833 use results ();
  2         6  
  2         44  
11 2     2   40 use B ();
  2         5  
  2         37  
12 2     2   9 use Exporter::Shiny;
  2         4  
  2         11  
13              
14             sub _exporter_fail {
15 6     6   131981 my ( $class, $err_kind, $opts, $globals ) = @_;
16 6         16 my $caller = $globals->{into};
17              
18 6 100       442 $err_kind =~ /
19             \A
20             (?:[[:upper:]][[:lower:]]*)
21             (?:
22             (?:[[:upper:]][[:lower:]]*)
23             | [0-9]+
24             )*
25             \z
26             /x or Carp::croak( "Bad err_kind name: $err_kind" );
27              
28 5         21 my $exception_class = "$caller\::Exception::$err_kind";
29 5         20 $class->create_exception_class( $exception_class, $err_kind, $opts );
30              
31 5         425 $err_kind => eval sprintf( 'sub () { %s }', B::perlstring($exception_class) );
32             }
33              
34             sub create_exception_class {
35 7     7 0 11325 my ( $class, $exception_class, $err_kind, $opts ) = @_;
36 7   100     27 $opts //= {};
37              
38 2     2   497 no strict 'refs';
  2         4  
  2         960  
39 7         66 *{"$exception_class\::new"} = sub {
40 9     9   37245 my $class = shift;
41 9 50       59 bless { @_==1 ? %{$_[0]} : @_ }, $class;
  0         0  
42 7         29 };
43 7         29 *{"$exception_class\::err"} = sub {
44 6     6   18 my $class = shift;
45 6         20 results::err( $class->new( @_ ) );
46 7         29 };
47 7         27 *{"$exception_class\::throw"} = sub {
48 0     0   0 my $class = shift;
49 0         0 die( $class->new( @_ ) );
50 7         26 };
51 7         24 *{"$exception_class\::err_kind"} = sub {
52 3     3   14 $err_kind
53 7         21 };
54 7         27 *{"$exception_class\::DOES"} = sub {
55 5     5   1591 my ( $class, $role ) = @_;
56 5 50       36 return 1 if $role eq __PACKAGE__;
57 0         0 $class->SUPER::DOES( $role );
58 7         22 };
59 7         29 *{"$exception_class\::to_string"} = sub {
60 5     5   13 my $self = shift;
61 5 100       37 if ( 'CODE' eq ref $opts->{to_string} ) {
    100          
62 2         9 return $opts->{to_string}->( $self );
63             }
64             elsif ( defined $opts->{to_string} ) {
65 1         9 return $opts->{to_string};
66             }
67             else {
68 2         16 return $err_kind;
69             }
70 7         42 };
71 7   100     16 for my $attr ( @{ $opts->{has} // [] } ) {
  7         58  
72 3     6   16 *{"$exception_class\::$attr"} = sub { $_[0]{$attr} };
  3         15  
  6         117  
73             }
74            
75 7         16 local $@;
76 2 50   2   21 eval qq/
  2     2   4  
  2     2   19  
  0     1   0  
  2     0   19  
  2         5  
  2         15  
  3         541  
  2         18  
  2         6  
  2         13  
  3         517  
  1         7  
  1         2  
  1         19  
  0         0  
  7         938  
77             package $exception_class;
78             use overload (
79             fallback => !!1,
80             q[""] => q[to_string],
81             bool => sub { !!1 },
82             );
83             1;
84             / or die( $@ );
85             }
86              
87             1;
88              
89             __END__