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