Filename | /Users/ap13/perl5/lib/perl5/Exception/Class/Base.pm |
Statements | Executed 58 statements in 1.46ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.22ms | 2.16ms | BEGIN@7 | Exception::Class::Base::
1 | 1 | 1 | 286µs | 355µs | BEGIN@6 | Exception::Class::Base::
1 | 1 | 1 | 52µs | 52µs | BEGIN@45 | Exception::Class::Base::
1 | 1 | 1 | 36µs | 84µs | BEGIN@12 | Exception::Class::Base::
1 | 1 | 1 | 13µs | 25µs | BEGIN@3 | Exception::Class::Base::
1 | 1 | 1 | 9µs | 82µs | BEGIN@10 | Exception::Class::Base::
1 | 1 | 1 | 9µs | 16µs | BEGIN@4 | Exception::Class::Base::
1 | 1 | 1 | 9µs | 44µs | BEGIN@42 | Exception::Class::Base::
1 | 1 | 1 | 8µs | 18µs | BEGIN@71 | Exception::Class::Base::
1 | 1 | 1 | 8µs | 31µs | BEGIN@8 | Exception::Class::Base::
1 | 1 | 1 | 8µs | 19µs | BEGIN@51 | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | Classes | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | Fields | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | NoRefs | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | __ANON__[:42] | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | __ANON__[:49] | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | __ANON__[:70] | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | _initialize | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | as_string | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | caught | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | context_hash | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | description | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | field_hash | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | full_message | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | new | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | rethrow | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | show_trace | Exception::Class::Base::
0 | 0 | 0 | 0s | 0s | throw | Exception::Class::Base::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Exception::Class::Base; | ||||
2 | 1 | 600ns | $Exception::Class::Base::VERSION = '1.39'; | ||
3 | 2 | 26µs | 2 | 37µs | # spent 25µs (13+12) within Exception::Class::Base::BEGIN@3 which was called:
# once (13µs+12µs) by Exception::Class::BEGIN@9 at line 3 # spent 25µs making 1 call to Exception::Class::Base::BEGIN@3
# spent 12µs making 1 call to strict::import |
4 | 2 | 26µs | 2 | 22µs | # spent 16µs (9+6) within Exception::Class::Base::BEGIN@4 which was called:
# once (9µs+6µs) by Exception::Class::BEGIN@9 at line 4 # spent 16µs making 1 call to Exception::Class::Base::BEGIN@4
# spent 6µs making 1 call to warnings::import |
5 | |||||
6 | 3 | 132µs | 2 | 364µs | # spent 355µs (286+69) within Exception::Class::Base::BEGIN@6 which was called:
# once (286µs+69µs) by Exception::Class::BEGIN@9 at line 6 # spent 355µs making 1 call to Exception::Class::Base::BEGIN@6
# spent 10µs making 1 call to UNIVERSAL::VERSION |
7 | 3 | 141µs | 2 | 2.17ms | # spent 2.16ms (1.22+936µs) within Exception::Class::Base::BEGIN@7 which was called:
# once (1.22ms+936µs) by Exception::Class::BEGIN@9 at line 7 # spent 2.16ms making 1 call to Exception::Class::Base::BEGIN@7
# spent 10µs making 1 call to UNIVERSAL::VERSION |
8 | 2 | 24µs | 2 | 54µs | # spent 31µs (8+23) within Exception::Class::Base::BEGIN@8 which was called:
# once (8µs+23µs) by Exception::Class::BEGIN@9 at line 8 # spent 31µs making 1 call to Exception::Class::Base::BEGIN@8
# spent 23µs making 1 call to Exporter::import |
9 | |||||
10 | 2 | 111µs | 2 | 154µs | # spent 82µs (9+72) within Exception::Class::Base::BEGIN@10 which was called:
# once (9µs+72µs) by Exception::Class::BEGIN@9 at line 10 # spent 82µs making 1 call to Exception::Class::Base::BEGIN@10
# spent 72µs making 1 call to base::import |
11 | |||||
12 | # spent 84µs (36+48) within Exception::Class::Base::BEGIN@12 which was called:
# once (36µs+48µs) by Exception::Class::BEGIN@9 at line 37 | ||||
13 | 1 | 4µs | 1 | 9µs | __PACKAGE__->mk_classdata('Trace'); # spent 9µs making 1 call to Class::Data::Inheritable::mk_classdata |
14 | 1 | 2µs | 1 | 8µs | __PACKAGE__->mk_classdata('UnsafeRefCapture'); # spent 8µs making 1 call to Class::Data::Inheritable::mk_classdata |
15 | |||||
16 | 1 | 2µs | 1 | 6µs | __PACKAGE__->mk_classdata('NoContextInfo'); # spent 6µs making 1 call to Class::Data::Inheritable::mk_classdata |
17 | 1 | 2µs | 1 | 3µs | __PACKAGE__->NoContextInfo(0); # spent 3µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23] |
18 | |||||
19 | 1 | 2µs | 1 | 11µs | __PACKAGE__->mk_classdata('RespectOverload'); # spent 11µs making 1 call to Class::Data::Inheritable::mk_classdata |
20 | 1 | 2µs | 1 | 2µs | __PACKAGE__->RespectOverload(0); # spent 2µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23] |
21 | |||||
22 | 1 | 1µs | 1 | 6µs | __PACKAGE__->mk_classdata('MaxArgLength'); # spent 6µs making 1 call to Class::Data::Inheritable::mk_classdata |
23 | 1 | 4µs | 1 | 2µs | __PACKAGE__->MaxArgLength(0); # spent 2µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23] |
24 | |||||
25 | sub NoRefs { | ||||
26 | my $self = shift; | ||||
27 | if (@_) { | ||||
28 | my $val = shift; | ||||
29 | return $self->UnsafeRefCapture(!$val); | ||||
30 | } | ||||
31 | else { | ||||
32 | return $self->UnsafeRefCapture(); | ||||
33 | } | ||||
34 | } | ||||
35 | |||||
36 | sub Fields { () } | ||||
37 | 1 | 35µs | 1 | 84µs | } # spent 84µs making 1 call to Exception::Class::Base::BEGIN@12 |
38 | |||||
39 | use overload | ||||
40 | |||||
41 | # an exception is always true | ||||
42 | 2 | 60µs | 2 | 79µs | # spent 44µs (9+35) within Exception::Class::Base::BEGIN@42 which was called:
# once (9µs+35µs) by Exception::Class::BEGIN@9 at line 42 # spent 44µs making 1 call to Exception::Class::Base::BEGIN@42
# spent 35µs making 1 call to overload::import |
43 | |||||
44 | # Create accessor routines | ||||
45 | # spent 52µs within Exception::Class::Base::BEGIN@45 which was called:
# once (52µs+0s) by Exception::Class::BEGIN@9 at line 74 | ||||
46 | 1 | 2µs | my @fields = qw( message pid uid euid gid egid time trace ); | ||
47 | |||||
48 | 1 | 600ns | foreach my $f (@fields) { | ||
49 | 8 | 12µs | my $sub = sub { my $s = shift; return $s->{$f}; }; | ||
50 | |||||
51 | 2 | 108µs | 2 | 31µs | # spent 19µs (8+11) within Exception::Class::Base::BEGIN@51 which was called:
# once (8µs+11µs) by Exception::Class::BEGIN@9 at line 51 # spent 19µs making 1 call to Exception::Class::Base::BEGIN@51
# spent 11µs making 1 call to strict::unimport |
52 | 8 | 11µs | *{$f} = $sub; | ||
53 | } | ||||
54 | 1 | 500ns | *error = \&message; | ||
55 | |||||
56 | 1 | 2µs | my %trace_fields = ( | ||
57 | package => 'package', | ||||
58 | file => 'filename', | ||||
59 | line => 'line', | ||||
60 | ); | ||||
61 | |||||
62 | 1 | 8µs | while ( my ( $f, $m ) = each %trace_fields ) { | ||
63 | my $sub = sub { | ||||
64 | my $s = shift; | ||||
65 | return $s->{$f} if exists $s->{$f}; | ||||
66 | |||||
67 | my $frame = $s->trace->frame(0); | ||||
68 | |||||
69 | return $s->{$f} = $frame ? $frame->$m() : undef; | ||||
70 | 3 | 8µs | }; | ||
71 | 2 | 31µs | 2 | 28µs | # spent 18µs (8+10) within Exception::Class::Base::BEGIN@71 which was called:
# once (8µs+10µs) by Exception::Class::BEGIN@9 at line 71 # spent 18µs making 1 call to Exception::Class::Base::BEGIN@71
# spent 10µs making 1 call to strict::unimport |
72 | 3 | 3µs | *{$f} = $sub; | ||
73 | } | ||||
74 | 1 | 692µs | 1 | 52µs | } # spent 52µs making 1 call to Exception::Class::Base::BEGIN@45 |
75 | |||||
76 | sub Classes { Exception::Class::Classes() } | ||||
77 | |||||
78 | sub throw { | ||||
79 | my $proto = shift; | ||||
80 | |||||
81 | $proto->rethrow if ref $proto; | ||||
82 | |||||
83 | die $proto->new(@_); | ||||
84 | } | ||||
85 | |||||
86 | sub rethrow { | ||||
87 | my $self = shift; | ||||
88 | |||||
89 | die $self; | ||||
90 | } | ||||
91 | |||||
92 | sub new { | ||||
93 | my $proto = shift; | ||||
94 | my $class = ref $proto || $proto; | ||||
95 | |||||
96 | my $self = bless {}, $class; | ||||
97 | |||||
98 | $self->_initialize(@_); | ||||
99 | |||||
100 | return $self; | ||||
101 | } | ||||
102 | |||||
103 | sub _initialize { | ||||
104 | my $self = shift; | ||||
105 | my %p = @_ == 1 ? ( error => $_[0] ) : @_; | ||||
106 | |||||
107 | $self->{message} = $p{message} || $p{error} || ''; | ||||
108 | |||||
109 | $self->{show_trace} = $p{show_trace} if exists $p{show_trace}; | ||||
110 | |||||
111 | if ( $self->NoContextInfo() ) { | ||||
112 | $self->{show_trace} = 0; | ||||
113 | $self->{package} = $self->{file} = $self->{line} = undef; | ||||
114 | } | ||||
115 | else { | ||||
116 | # CORE::time is important to fix an error with some versions of | ||||
117 | # Perl | ||||
118 | $self->{time} = CORE::time(); | ||||
119 | $self->{pid} = $$; | ||||
120 | $self->{uid} = $<; | ||||
121 | $self->{euid} = $>; | ||||
122 | $self->{gid} = $(; | ||||
123 | $self->{egid} = $); | ||||
124 | |||||
125 | my @ignore_class = (__PACKAGE__); | ||||
126 | my @ignore_package = 'Exception::Class'; | ||||
127 | |||||
128 | if ( my $i = delete $p{ignore_class} ) { | ||||
129 | push @ignore_class, ( ref($i) eq 'ARRAY' ? @$i : $i ); | ||||
130 | } | ||||
131 | |||||
132 | if ( my $i = delete $p{ignore_package} ) { | ||||
133 | push @ignore_package, ( ref($i) eq 'ARRAY' ? @$i : $i ); | ||||
134 | } | ||||
135 | |||||
136 | $self->{trace} = Devel::StackTrace->new( | ||||
137 | ignore_class => \@ignore_class, | ||||
138 | ignore_package => \@ignore_package, | ||||
139 | unsafe_ref_capture => $self->UnsafeRefCapture, | ||||
140 | respect_overload => $self->RespectOverload, | ||||
141 | max_arg_length => $self->MaxArgLength, | ||||
142 | ); | ||||
143 | } | ||||
144 | |||||
145 | my %fields = map { $_ => 1 } $self->Fields; | ||||
146 | while ( my ( $key, $value ) = each %p ) { | ||||
147 | next if $key =~ /^(?:error|message|show_trace)$/; | ||||
148 | |||||
149 | if ( $fields{$key} ) { | ||||
150 | $self->{$key} = $value; | ||||
151 | } | ||||
152 | else { | ||||
153 | Exception::Class::Base->throw( | ||||
154 | error => "unknown field $key passed to constructor for class " | ||||
155 | . ref $self ); | ||||
156 | } | ||||
157 | } | ||||
158 | } | ||||
159 | |||||
160 | sub context_hash { | ||||
161 | my $self = shift; | ||||
162 | |||||
163 | return { | ||||
164 | time => $self->{time}, | ||||
165 | pid => $self->{pid}, | ||||
166 | uid => $self->{uid}, | ||||
167 | euid => $self->{euid}, | ||||
168 | gid => $self->{gid}, | ||||
169 | egid => $self->{egid}, | ||||
170 | }; | ||||
171 | } | ||||
172 | |||||
173 | sub field_hash { | ||||
174 | my $self = shift; | ||||
175 | |||||
176 | my $hash = {}; | ||||
177 | |||||
178 | for my $field ( $self->Fields ) { | ||||
179 | $hash->{$field} = $self->$field; | ||||
180 | } | ||||
181 | |||||
182 | return $hash; | ||||
183 | } | ||||
184 | |||||
185 | sub description { | ||||
186 | return 'Generic exception'; | ||||
187 | } | ||||
188 | |||||
189 | sub show_trace { | ||||
190 | my $self = shift; | ||||
191 | |||||
192 | return 0 unless $self->{trace}; | ||||
193 | |||||
194 | if (@_) { | ||||
195 | $self->{show_trace} = shift; | ||||
196 | } | ||||
197 | |||||
198 | return exists $self->{show_trace} ? $self->{show_trace} : $self->Trace; | ||||
199 | } | ||||
200 | |||||
201 | sub as_string { | ||||
202 | my $self = shift; | ||||
203 | |||||
204 | my $str = $self->full_message; | ||||
205 | unless ( defined $str && length $str ) { | ||||
206 | my $desc = $self->description; | ||||
207 | $str = defined $desc | ||||
208 | && length $desc ? "[$desc]" : "[Generic exception]"; | ||||
209 | } | ||||
210 | |||||
211 | $str .= "\n\n" . $self->trace->as_string | ||||
212 | if $self->show_trace; | ||||
213 | |||||
214 | return $str; | ||||
215 | } | ||||
216 | |||||
217 | sub full_message { $_[0]->{message} } | ||||
218 | |||||
219 | # | ||||
220 | # The %seen bit protects against circular inheritance. | ||||
221 | # | ||||
222 | 1 | 800ns | eval <<'EOF' if $] == 5.006; | ||
223 | sub isa { | ||||
224 | my ( $inheritor, $base ) = @_; | ||||
225 | $inheritor = ref($inheritor) if ref($inheritor); | ||||
226 | |||||
227 | my %seen; | ||||
228 | |||||
229 | no strict 'refs'; | ||||
230 | my @parents = ( $inheritor, @{"$inheritor\::ISA"} ); | ||||
231 | while ( my $class = shift @parents ) { | ||||
232 | return 1 if $class eq $base; | ||||
233 | |||||
234 | push @parents, grep { !$seen{$_}++ } @{"$class\::ISA"}; | ||||
235 | } | ||||
236 | return 0; | ||||
237 | } | ||||
238 | EOF | ||||
239 | |||||
240 | sub caught { | ||||
241 | my $class = shift; | ||||
242 | |||||
243 | my $e = $@; | ||||
244 | |||||
245 | return unless defined $e && blessed($e) && $e->isa($class); | ||||
246 | return $e; | ||||
247 | } | ||||
248 | |||||
249 | 1 | 4µs | 1; | ||
250 | |||||
251 | # ABSTRACT: A base class for exception objects | ||||
252 | |||||
253 | __END__ |