Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Exception/Class.pm |
Statements | Executed 264 statements in 1.33ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 859µs | 4.71ms | BEGIN@10 | Exception::Class::
8 | 1 | 1 | 599µs | 1.19ms | _make_subclass | Exception::Class::
1 | 1 | 1 | 81µs | 1.28ms | import | Exception::Class::
1 | 1 | 1 | 14µs | 14µs | BEGIN@6 | Exception::Class::
1 | 1 | 1 | 13µs | 26µs | BEGIN@8 | Exception::Class::
1 | 1 | 1 | 9µs | 9µs | CORE:sort (opcode) | Exception::Class::
8 | 1 | 1 | 8µs | 8µs | CORE:subst (opcode) | Exception::Class::
1 | 1 | 1 | 7µs | 30µs | BEGIN@11 | Exception::Class::
1 | 1 | 1 | 7µs | 16µs | BEGIN@79 | Exception::Class::
1 | 1 | 1 | 7µs | 16µs | BEGIN@168 | Exception::Class::
1 | 1 | 1 | 7µs | 16µs | BEGIN@46 | Exception::Class::
1 | 1 | 1 | 6µs | 14µs | BEGIN@176 | Exception::Class::
2 | 1 | 1 | 4µs | 4µs | CORE:substcont (opcode) | Exception::Class::
1 | 1 | 1 | 3µs | 3µs | BEGIN@14 | Exception::Class::
0 | 0 | 0 | 0s | 0s | Classes | Exception::Class::
0 | 0 | 0 | 0s | 0s | __ANON__[:170] | Exception::Class::
0 | 0 | 0 | 0s | 0s | _make_parents | Exception::Class::
0 | 0 | 0 | 0s | 0s | caught | Exception::Class::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Exception::Class; | ||||
2 | { | ||||
3 | 2 | 800ns | $Exception::Class::VERSION = '1.37'; | ||
4 | } | ||||
5 | |||||
6 | 2 | 52µs | 1 | 14µs | # spent 14µs within Exception::Class::BEGIN@6 which was called:
# once (14µs+0s) by Iterator::BEGIN@22 at line 6 # spent 14µs making 1 call to Exception::Class::BEGIN@6 |
7 | |||||
8 | 2 | 34µs | 2 | 39µs | # spent 26µs (13+13) within Exception::Class::BEGIN@8 which was called:
# once (13µs+13µs) by Iterator::BEGIN@22 at line 8 # spent 26µs making 1 call to Exception::Class::BEGIN@8
# spent 13µs making 1 call to strict::import |
9 | |||||
10 | 2 | 115µs | 1 | 4.71ms | # spent 4.71ms (859µs+3.85) within Exception::Class::BEGIN@10 which was called:
# once (859µs+3.85ms) by Iterator::BEGIN@22 at line 10 # spent 4.71ms making 1 call to Exception::Class::BEGIN@10 |
11 | 2 | 30µs | 2 | 52µs | # spent 30µs (7+22) within Exception::Class::BEGIN@11 which was called:
# once (7µs+22µs) by Iterator::BEGIN@22 at line 11 # spent 30µs making 1 call to Exception::Class::BEGIN@11
# spent 22µs making 1 call to Exporter::import |
12 | |||||
13 | 1 | 100ns | our $BASE_EXC_CLASS; | ||
14 | 1 | 88µs | 1 | 3µs | # spent 3µs within Exception::Class::BEGIN@14 which was called:
# once (3µs+0s) by Iterator::BEGIN@22 at line 14 # spent 3µs making 1 call to Exception::Class::BEGIN@14 |
15 | |||||
16 | 1 | 300ns | our %CLASSES; | ||
17 | |||||
18 | # spent 1.28ms (81µs+1.20) within Exception::Class::import which was called:
# once (81µs+1.20ms) by Iterator::BEGIN@22 at line 23 of Iterator.pm | ||||
19 | 1 | 400ns | my $class = shift; | ||
20 | |||||
21 | 1 | 500ns | local $Exception::Class::Caller = caller(); | ||
22 | |||||
23 | 1 | 100ns | my %c; | ||
24 | |||||
25 | 1 | 100ns | my %needs_parent; | ||
26 | 1 | 3µs | while ( my $subclass = shift ) { | ||
27 | 8 | 2µs | my $def = ref $_[0] ? shift : {}; | ||
28 | 8 | 5µs | $def->{isa} | ||
29 | = $def->{isa} | ||||
30 | ? ( ref $def->{isa} ? $def->{isa} : [ $def->{isa} ] ) | ||||
31 | : []; | ||||
32 | |||||
33 | 8 | 4µs | $c{$subclass} = $def; | ||
34 | } | ||||
35 | |||||
36 | # We need to sort by length because if we check for keys in the | ||||
37 | # Foo::Bar:: stash, this creates a "Bar::" key in the Foo:: stash! | ||||
38 | MAKE_CLASSES: | ||||
39 | 1 | 16µs | 1 | 9µs | foreach my $subclass ( sort { length $a <=> length $b } keys %c ) { # spent 9µs making 1 call to Exception::Class::CORE:sort |
40 | 8 | 3µs | my $def = $c{$subclass}; | ||
41 | |||||
42 | # We already made this one. | ||||
43 | 8 | 2µs | next if $CLASSES{$subclass}; | ||
44 | |||||
45 | { | ||||
46 | 10 | 113µs | 2 | 25µs | # spent 16µs (7+9) within Exception::Class::BEGIN@46 which was called:
# once (7µs+9µs) by Iterator::BEGIN@22 at line 46 # spent 16µs making 1 call to Exception::Class::BEGIN@46
# spent 9µs making 1 call to strict::unimport |
47 | 8 | 6µs | foreach my $parent ( @{ $def->{isa} } ) { | ||
48 | 7 | 10µs | unless ( keys %{"$parent\::"} ) { | ||
49 | $needs_parent{$subclass} = { | ||||
50 | parents => $def->{isa}, | ||||
51 | def => $def | ||||
52 | }; | ||||
53 | next MAKE_CLASSES; | ||||
54 | } | ||||
55 | } | ||||
56 | } | ||||
57 | |||||
58 | $class->_make_subclass( | ||||
59 | 8 | 20µs | 8 | 1.19ms | subclass => $subclass, # spent 1.19ms making 8 calls to Exception::Class::_make_subclass, avg 149µs/call |
60 | def => $def || {}, | ||||
61 | ); | ||||
62 | } | ||||
63 | |||||
64 | 1 | 5µs | foreach my $subclass ( keys %needs_parent ) { | ||
65 | |||||
66 | # This will be used to spot circular references. | ||||
67 | my %seen; | ||||
68 | $class->_make_parents( \%needs_parent, $subclass, \%seen ); | ||||
69 | } | ||||
70 | } | ||||
71 | |||||
72 | sub _make_parents { | ||||
73 | my $class = shift; | ||||
74 | my $needs = shift; | ||||
75 | my $subclass = shift; | ||||
76 | my $seen = shift; | ||||
77 | my $child = shift; # Just for error messages. | ||||
78 | |||||
79 | 2 | 257µs | 2 | 24µs | # spent 16µs (7+8) within Exception::Class::BEGIN@79 which was called:
# once (7µs+8µs) by Iterator::BEGIN@22 at line 79 # spent 16µs making 1 call to Exception::Class::BEGIN@79
# spent 8µs making 1 call to strict::unimport |
80 | |||||
81 | # What if someone makes a typo in specifying their 'isa' param? | ||||
82 | # This should catch it. Either it's been made because it didn't | ||||
83 | # have missing parents OR it's in our hash as needing a parent. | ||||
84 | # If neither of these is true then the _only_ place it is | ||||
85 | # mentioned is in the 'isa' param for some other class, which is | ||||
86 | # not a good enough reason to make a new class. | ||||
87 | die | ||||
88 | "Class $subclass appears to be a typo as it is only specified in the 'isa' param for $child\n" | ||||
89 | unless exists $needs->{$subclass} | ||||
90 | || $CLASSES{$subclass} | ||||
91 | || keys %{"$subclass\::"}; | ||||
92 | |||||
93 | foreach my $c ( @{ $needs->{$subclass}{parents} } ) { | ||||
94 | |||||
95 | # It's been made | ||||
96 | next if $CLASSES{$c} || keys %{"$c\::"}; | ||||
97 | |||||
98 | die "There appears to be some circularity involving $subclass\n" | ||||
99 | if $seen->{$subclass}; | ||||
100 | |||||
101 | $seen->{$subclass} = 1; | ||||
102 | |||||
103 | $class->_make_parents( $needs, $c, $seen, $subclass ); | ||||
104 | } | ||||
105 | |||||
106 | return if $CLASSES{$subclass} || keys %{"$subclass\::"}; | ||||
107 | |||||
108 | $class->_make_subclass( | ||||
109 | subclass => $subclass, | ||||
110 | def => $needs->{$subclass}{def} | ||||
111 | ); | ||||
112 | } | ||||
113 | |||||
114 | # spent 1.19ms (599µs+591µs) within Exception::Class::_make_subclass which was called 8 times, avg 149µs/call:
# 8 times (599µs+591µs) by Exception::Class::import at line 59, avg 149µs/call | ||||
115 | 8 | 2µs | my $class = shift; | ||
116 | 8 | 9µs | my %p = @_; | ||
117 | |||||
118 | 8 | 3µs | my $subclass = $p{subclass}; | ||
119 | 8 | 1µs | my $def = $p{def}; | ||
120 | |||||
121 | 8 | 800ns | my $isa; | ||
122 | 8 | 8µs | if ( $def->{isa} ) { | ||
123 | $isa = ref $def->{isa} ? join ' ', @{ $def->{isa} } : $def->{isa}; | ||||
124 | } | ||||
125 | 8 | 1µs | $isa ||= $BASE_EXC_CLASS; | ||
126 | |||||
127 | 8 | 1µs | my $version_name = 'VERSION'; | ||
128 | |||||
129 | 8 | 6µs | my $code = <<"EOPERL"; | ||
130 | package $subclass; | ||||
131 | |||||
132 | use base qw($isa); | ||||
133 | |||||
134 | our \$$version_name = '1.1'; | ||||
135 | |||||
136 | 1; | ||||
137 | |||||
138 | EOPERL | ||||
139 | |||||
140 | 8 | 3µs | if ( $def->{description} ) { | ||
141 | 8 | 36µs | 10 | 12µs | ( my $desc = $def->{description} ) =~ s/([\\\'])/\\$1/g; # spent 8µs making 8 calls to Exception::Class::CORE:subst, avg 963ns/call
# spent 4µs making 2 calls to Exception::Class::CORE:substcont, avg 2µs/call |
142 | 8 | 6µs | $code .= <<"EOPERL"; | ||
143 | sub description | ||||
144 | { | ||||
145 | return '$desc'; | ||||
146 | } | ||||
147 | EOPERL | ||||
148 | } | ||||
149 | |||||
150 | 8 | 1µs | my @fields; | ||
151 | 8 | 3µs | if ( my $fields = $def->{fields} ) { | ||
152 | 3 | 11µs | 3 | 4µs | @fields = UNIVERSAL::isa( $fields, 'ARRAY' ) ? @$fields : $fields; # spent 4µs making 3 calls to UNIVERSAL::isa, avg 1µs/call |
153 | |||||
154 | $code | ||||
155 | .= "sub Fields { return (\$_[0]->SUPER::Fields, " | ||||
156 | 3 | 6µs | . join( ", ", map { "'$_'" } @fields ) | ||
157 | . ") }\n\n"; | ||||
158 | |||||
159 | 3 | 1µs | foreach my $field (@fields) { | ||
160 | 3 | 5µs | $code .= sprintf( "sub %s { \$_[0]->{%s} }\n", $field, $field ); | ||
161 | } | ||||
162 | } | ||||
163 | |||||
164 | 8 | 2µs | if ( my $alias = $def->{alias} ) { | ||
165 | die "Cannot make alias without caller" | ||||
166 | unless defined $Exception::Class::Caller; | ||||
167 | |||||
168 | 2 | 58µs | 2 | 25µs | # spent 16µs (7+9) within Exception::Class::BEGIN@168 which was called:
# once (7µs+9µs) by Iterator::BEGIN@22 at line 168 # spent 16µs making 1 call to Exception::Class::BEGIN@168
# spent 9µs making 1 call to strict::unimport |
169 | *{"$Exception::Class::Caller\::$alias"} | ||||
170 | = sub { $subclass->throw(@_) }; | ||||
171 | } | ||||
172 | |||||
173 | 8 | 1µs | if ( my $defaults = $def->{defaults} ) { | ||
174 | $code | ||||
175 | .= "sub _defaults { return shift->SUPER::_defaults, our \%_DEFAULTS }\n"; | ||||
176 | 2 | 126µs | 2 | 21µs | # spent 14µs (6+7) within Exception::Class::BEGIN@176 which was called:
# once (6µs+7µs) by Iterator::BEGIN@22 at line 176 # spent 14µs making 1 call to Exception::Class::BEGIN@176
# spent 7µs making 1 call to strict::unimport |
177 | *{"$subclass\::_DEFAULTS"} = {%$defaults}; | ||||
178 | } | ||||
179 | |||||
180 | 8 | 236µs | eval $code; # spent 54µs executing statements in string eval # includes 8µs spent executing 1 call to 4 subs defined therein. # spent 51µs executing statements in string eval # includes 8µs spent executing 1 call to 4 subs defined therein. # spent 51µs executing statements in string eval # includes 8µs spent executing 1 call to 4 subs defined therein. # spent 33µs executing statements in string eval # includes 8µs spent executing 1 call to 2 subs defined therein. # spent 28µs executing statements in string eval # includes 9µs spent executing 1 call to 2 subs defined therein. # spent 28µs executing statements in string eval # includes 9µs spent executing 1 call to 2 subs defined therein. # spent 28µs executing statements in string eval # includes 8µs spent executing 1 call to 2 subs defined therein. # spent 28µs executing statements in string eval # includes 8µs spent executing 1 call to 2 subs defined therein. | ||
181 | |||||
182 | 8 | 900ns | die $@ if $@; | ||
183 | |||||
184 | 8 | 31µs | $CLASSES{$subclass} = 1; | ||
185 | } | ||||
186 | |||||
187 | sub caught { | ||||
188 | my $e = $@; | ||||
189 | |||||
190 | return $e unless $_[1]; | ||||
191 | |||||
192 | return unless blessed($e) && $e->isa( $_[1] ); | ||||
193 | return $e; | ||||
194 | } | ||||
195 | |||||
196 | sub Classes { sort keys %Exception::Class::CLASSES } | ||||
197 | |||||
198 | 1 | 2µs | 1; | ||
199 | |||||
200 | # ABSTRACT: A module that allows you to declare real exception classes in Perl | ||||
201 | |||||
202 | __END__ | ||||
# spent 9µs within Exception::Class::CORE:sort which was called:
# once (9µs+0s) by Exception::Class::import at line 39 | |||||
# spent 8µs within Exception::Class::CORE:subst which was called 8 times, avg 963ns/call:
# 8 times (8µs+0s) by Exception::Class::_make_subclass at line 141, avg 963ns/call | |||||
# spent 4µs within Exception::Class::CORE:substcont which was called 2 times, avg 2µs/call:
# 2 times (4µs+0s) by Exception::Class::_make_subclass at line 141, avg 2µs/call |