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