File Coverage

lib/Neo4j/Error.pm
Criterion Covered Total %
statement 72 72 100.0
branch 40 40 100.0
condition 36 36 100.0
subroutine 19 19 100.0
pod 12 12 100.0
total 179 179 100.0


line stmt bran cond sub pod time code
1 5     5   691660 use v5.10;
  5         19  
2 5     5   34 use strict;
  5         11  
  5         168  
3 5     5   27 use warnings;
  5         9  
  5         530  
4              
5             package Neo4j::Error;
6             # ABSTRACT: Common Neo4j exception representations
7             $Neo4j::Error::VERSION = '0.02';
8              
9 5     5   35 use List::Util 1.33 qw(first none);
  5         148  
  5         491  
10 5     5   3045 use Module::Load qw(load);
  5         8743  
  5         42  
11              
12             my @SOURCES = qw( Server Network Internal Usage );
13             my @KEYS = qw(
14             as_string
15             category
16             classification
17             code
18             is_retryable
19             message
20             raw
21             related
22             source
23             title
24             trace
25             );
26              
27              
28             sub _croak {
29 18     18   132 require Carp;
30 18         206 Carp::croak(@_);
31             }
32              
33              
34             sub new {
35 53     53 1 1129210 my ($class, $source, $info, @extra) = @_;
36            
37 53 100       220 _croak "Call as instance method unsupported for %s->new()", __PACKAGE__ if ref $class ne '';
38 52 100 100     277 _croak sprintf "Source param required for %s->new()", __PACKAGE__ unless $source && ref $source eq '';
39 50 100       132 if ($class eq __PACKAGE__) {
40 42     96   369 $class = first { $_ eq $source } @SOURCES;
  96         189  
41 42 100       195 _croak sprintf "Source '%s' is unsupported for %s->new()", $source, __PACKAGE__ unless $class;
42 38         99 $class = __PACKAGE__ . "::$class";
43 38         178 load $class;
44             }
45             else { # subclass
46 8 100       70 _croak sprintf "Class %s fails to implement source()", $class unless $class->can('source');
47 7 100       24 _croak sprintf "Ambiguous source %s for %s", $source, $class if $class->source ne $source;
48             }
49            
50 44 100 100     3321 if ($info && ref $info eq '') {
    100          
51 6         34 $info = { as_string => '' . $info };
52             }
53             elsif (ref $info ne 'HASH') {
54 2         7 _croak sprintf "Hashref or string required for %s->new()", $class;
55             }
56 42 100       156 _croak "Too many arguments for $class->new()" if @extra;
57            
58 40         156 my $self = bless {}, $class;
59 40         655 $self->{$_} = $info->{$_} for @KEYS;
60            
61 40         2649 require Devel::StackTrace;
62 40   100     20330 my $trace_config = $info->{trace} // {};
63 40         107 $trace_config->{skip_frames}++;
64 40   100     302 $trace_config->{message} //= $self->as_string;
65 40         238 $self->{trace} = Devel::StackTrace->new(%$trace_config);
66            
67 40         13600 return $self;
68             }
69              
70              
71             sub append_new {
72 12     12 1 18137 my ($self, $source, $related, @extra) = @_;
73            
74 12 100 100     86 _croak sprintf "Source param required for %s->append_new()", __PACKAGE__ unless $source && ref $source eq '';
75 10 100 100     84 _croak sprintf "Ambiguous source %s for %s", $source, $self if ref $self eq '' && $self->can('source') && $self->source ne $source;
      100        
76            
77 9 100 100     46 if ($related && ref $related eq '') {
    100          
78 1         5 $related = { as_string => '' . $related };
79             }
80             elsif (ref $related ne 'HASH') {
81 2         5 _croak sprintf "Hashref or string required for %s->append_new()", __PACKAGE__;
82             }
83            
84 7 100       16 my $class = ref $self eq '' ? $self : __PACKAGE__;
85 7         17 $related->{trace}{skip_frames}++;
86 7         23 $related = $class->new($source => $related, @extra);
87 4 100       64 return $related if ref $self eq ''; # if called as class method, behave just like new()
88            
89 1         2 my $tail = $self;
90 1         5 $tail = $tail->{related} while $tail->{related};
91 1         2 $tail->{related} = $related;
92 1         7 return $self;
93             }
94              
95              
96             sub as_string {
97 61     61 1 130 my ($self) = @_;
98            
99 61         112 my $str = $self->{as_string};
100 61 100       618 return $str if defined $str;
101            
102 29         98 my $code = $self->code;
103 29         110 my $message = $self->message;
104 29 100 100     123 $str = sprintf "%s: %s", $code, $message if $code && $message;
105 29 100 100     170 $str = sprintf "%s %s", ref $self, $code if $code && ! $message;
106 29 100 100     105 $str = sprintf "%s", $message if ! $code && $message;
107 29 100       84 $str = $self->trace unless $str; # last resort
108 29         179 return $self->{as_string} = $str;
109             }
110              
111              
112 18   100 18 1 90 sub message { shift->{message} // '' }
113 18   100 18 1 104 sub code { shift->{code} // '' }
114 3     3 1 14 sub classification { '' }
115 3     3 1 45 sub category { '' }
116 3     3 1 15 sub title { '' }
117 2     2 1 10 sub is_retryable { !!0 }
118              
119 6     6 1 44 sub related { shift->{related} }
120              
121 2     2 1 10 sub raw { shift->{raw} }
122 21     21 1 4015 sub trace { shift->{trace} }
123              
124              
125             1;
126              
127             __END__