| Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Exception/Class.pm |
| Statements | Executed 264 statements in 1.85ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 1.19ms | 6.41ms | Exception::Class::BEGIN@10 |
| 8 | 1 | 1 | 895µs | 1.77ms | Exception::Class::_make_subclass |
| 1 | 1 | 1 | 116µs | 1.90ms | Exception::Class::import |
| 1 | 1 | 1 | 18µs | 18µs | Exception::Class::BEGIN@6 |
| 1 | 1 | 1 | 12µs | 12µs | Exception::Class::CORE:sort (opcode) |
| 8 | 1 | 1 | 11µs | 11µs | Exception::Class::CORE:subst (opcode) |
| 1 | 1 | 1 | 11µs | 41µs | Exception::Class::BEGIN@11 |
| 1 | 1 | 1 | 10µs | 24µs | Exception::Class::BEGIN@176 |
| 1 | 1 | 1 | 10µs | 23µs | Exception::Class::BEGIN@168 |
| 1 | 1 | 1 | 9µs | 22µs | Exception::Class::BEGIN@46 |
| 1 | 1 | 1 | 9µs | 22µs | Exception::Class::BEGIN@79 |
| 1 | 1 | 1 | 9µs | 23µs | Exception::Class::BEGIN@8 |
| 2 | 1 | 1 | 8µs | 8µs | Exception::Class::CORE:substcont (opcode) |
| 1 | 1 | 1 | 4µs | 4µs | Exception::Class::BEGIN@14 |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Classes |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::__ANON__[:170] |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::_make_parents |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::caught |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Exception::Class; | ||||
| 2 | { | ||||
| 3 | 2 | 1µs | $Exception::Class::VERSION = '1.37'; | ||
| 4 | } | ||||
| 5 | |||||
| 6 | 2 | 51µs | 1 | 18µs | # spent 18µs within Exception::Class::BEGIN@6 which was called:
# once (18µs+0s) by Iterator::BEGIN@22 at line 6 # spent 18µs making 1 call to Exception::Class::BEGIN@6 |
| 7 | |||||
| 8 | 2 | 28µs | 2 | 37µs | # spent 23µs (9+14) within Exception::Class::BEGIN@8 which was called:
# once (9µs+14µs) by Iterator::BEGIN@22 at line 8 # spent 23µs making 1 call to Exception::Class::BEGIN@8
# spent 14µs making 1 call to strict::import |
| 9 | |||||
| 10 | 2 | 122µs | 1 | 6.41ms | # spent 6.41ms (1.19+5.23) within Exception::Class::BEGIN@10 which was called:
# once (1.19ms+5.23ms) by Iterator::BEGIN@22 at line 10 # spent 6.41ms making 1 call to Exception::Class::BEGIN@10 |
| 11 | 2 | 41µs | 2 | 72µs | # spent 41µs (11+31) within Exception::Class::BEGIN@11 which was called:
# once (11µs+31µs) by Iterator::BEGIN@22 at line 11 # spent 41µs making 1 call to Exception::Class::BEGIN@11
# spent 31µs making 1 call to Exporter::import |
| 12 | |||||
| 13 | 1 | 100ns | our $BASE_EXC_CLASS; | ||
| 14 | 1 | 121µs | 1 | 4µs | # spent 4µs within Exception::Class::BEGIN@14 which was called:
# once (4µs+0s) by Iterator::BEGIN@22 at line 14 # spent 4µs making 1 call to Exception::Class::BEGIN@14 |
| 15 | |||||
| 16 | 1 | 300ns | our %CLASSES; | ||
| 17 | |||||
| 18 | # spent 1.90ms (116µs+1.78) within Exception::Class::import which was called:
# once (116µs+1.78ms) by Iterator::BEGIN@22 at line 23 of Iterator.pm | ||||
| 19 | 1 | 500ns | my $class = shift; | ||
| 20 | |||||
| 21 | 1 | 900ns | local $Exception::Class::Caller = caller(); | ||
| 22 | |||||
| 23 | 1 | 300ns | my %c; | ||
| 24 | |||||
| 25 | 1 | 100ns | my %needs_parent; | ||
| 26 | 1 | 5µs | while ( my $subclass = shift ) { | ||
| 27 | 8 | 3µs | my $def = ref $_[0] ? shift : {}; | ||
| 28 | 8 | 9µs | $def->{isa} | ||
| 29 | = $def->{isa} | ||||
| 30 | ? ( ref $def->{isa} ? $def->{isa} : [ $def->{isa} ] ) | ||||
| 31 | : []; | ||||
| 32 | |||||
| 33 | 8 | 6µ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 | 22µs | 1 | 12µs | foreach my $subclass ( sort { length $a <=> length $b } keys %c ) { # spent 12µs making 1 call to Exception::Class::CORE:sort |
| 40 | 8 | 4µs | my $def = $c{$subclass}; | ||
| 41 | |||||
| 42 | # We already made this one. | ||||
| 43 | 8 | 3µs | next if $CLASSES{$subclass}; | ||
| 44 | |||||
| 45 | { | ||||
| 46 | 10 | 163µs | 2 | 35µs | # spent 22µs (9+13) within Exception::Class::BEGIN@46 which was called:
# once (9µs+13µs) by Iterator::BEGIN@22 at line 46 # spent 22µs making 1 call to Exception::Class::BEGIN@46
# spent 13µs making 1 call to strict::unimport |
| 47 | 8 | 8µs | foreach my $parent ( @{ $def->{isa} } ) { | ||
| 48 | 7 | 14µ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 | 30µs | 8 | 1.77ms | subclass => $subclass, # spent 1.77ms making 8 calls to Exception::Class::_make_subclass, avg 221µs/call |
| 60 | def => $def || {}, | ||||
| 61 | ); | ||||
| 62 | } | ||||
| 63 | |||||
| 64 | 1 | 7µ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 | 380µs | 2 | 34µs | # spent 22µs (9+12) within Exception::Class::BEGIN@79 which was called:
# once (9µs+12µs) by Iterator::BEGIN@22 at line 79 # spent 22µs making 1 call to Exception::Class::BEGIN@79
# spent 12µ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.77ms (895µs+872µs) within Exception::Class::_make_subclass which was called 8 times, avg 221µs/call:
# 8 times (895µs+872µs) by Exception::Class::import at line 59, avg 221µs/call | ||||
| 115 | 8 | 4µs | my $class = shift; | ||
| 116 | 8 | 12µs | my %p = @_; | ||
| 117 | |||||
| 118 | 8 | 3µs | my $subclass = $p{subclass}; | ||
| 119 | 8 | 2µs | my $def = $p{def}; | ||
| 120 | |||||
| 121 | 8 | 1µs | my $isa; | ||
| 122 | 8 | 12µs | if ( $def->{isa} ) { | ||
| 123 | $isa = ref $def->{isa} ? join ' ', @{ $def->{isa} } : $def->{isa}; | ||||
| 124 | } | ||||
| 125 | 8 | 2µs | $isa ||= $BASE_EXC_CLASS; | ||
| 126 | |||||
| 127 | 8 | 2µs | my $version_name = 'VERSION'; | ||
| 128 | |||||
| 129 | 8 | 8µ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 | 4µs | if ( $def->{description} ) { | ||
| 141 | 8 | 54µs | 10 | 19µs | ( my $desc = $def->{description} ) =~ s/([\\\'])/\\$1/g; # spent 11µs making 8 calls to Exception::Class::CORE:subst, avg 1µs/call
# spent 8µs making 2 calls to Exception::Class::CORE:substcont, avg 4µs/call |
| 142 | 8 | 8µs | $code .= <<"EOPERL"; | ||
| 143 | sub description | ||||
| 144 | { | ||||
| 145 | return '$desc'; | ||||
| 146 | } | ||||
| 147 | EOPERL | ||||
| 148 | } | ||||
| 149 | |||||
| 150 | 8 | 2µs | my @fields; | ||
| 151 | 8 | 5µs | if ( my $fields = $def->{fields} ) { | ||
| 152 | 3 | 15µs | 3 | 4µs | @fields = UNIVERSAL::isa( $fields, 'ARRAY' ) ? @$fields : $fields; # spent 4µs making 3 calls to UNIVERSAL::isa, avg 2µs/call |
| 153 | |||||
| 154 | $code | ||||
| 155 | .= "sub Fields { return (\$_[0]->SUPER::Fields, " | ||||
| 156 | 3 | 9µs | . join( ", ", map { "'$_'" } @fields ) | ||
| 157 | . ") }\n\n"; | ||||
| 158 | |||||
| 159 | 3 | 2µs | foreach my $field (@fields) { | ||
| 160 | 3 | 8µs | $code .= sprintf( "sub %s { \$_[0]->{%s} }\n", $field, $field ); | ||
| 161 | } | ||||
| 162 | } | ||||
| 163 | |||||
| 164 | 8 | 3µs | if ( my $alias = $def->{alias} ) { | ||
| 165 | die "Cannot make alias without caller" | ||||
| 166 | unless defined $Exception::Class::Caller; | ||||
| 167 | |||||
| 168 | 2 | 84µs | 2 | 36µs | # spent 23µs (10+13) within Exception::Class::BEGIN@168 which was called:
# once (10µs+13µs) by Iterator::BEGIN@22 at line 168 # spent 23µs making 1 call to Exception::Class::BEGIN@168
# spent 13µs making 1 call to strict::unimport |
| 169 | *{"$Exception::Class::Caller\::$alias"} | ||||
| 170 | = sub { $subclass->throw(@_) }; | ||||
| 171 | } | ||||
| 172 | |||||
| 173 | 8 | 2µs | if ( my $defaults = $def->{defaults} ) { | ||
| 174 | $code | ||||
| 175 | .= "sub _defaults { return shift->SUPER::_defaults, our \%_DEFAULTS }\n"; | ||||
| 176 | 2 | 183µs | 2 | 39µs | # spent 24µs (10+15) within Exception::Class::BEGIN@176 which was called:
# once (10µs+15µs) by Iterator::BEGIN@22 at line 176 # spent 24µs making 1 call to Exception::Class::BEGIN@176
# spent 15µs making 1 call to strict::unimport |
| 177 | *{"$subclass\::_DEFAULTS"} = {%$defaults}; | ||||
| 178 | } | ||||
| 179 | |||||
| 180 | 8 | 362µs | eval $code; # spent 80µs executing statements in string eval # includes 12µs spent executing 1 call to 4 subs defined therein. # spent 80µs executing statements in string eval # includes 12µs spent executing 1 call to 4 subs defined therein. # spent 76µs executing statements in string eval # includes 12µs spent executing 1 call to 4 subs defined therein. # spent 42µs executing statements in string eval # includes 12µs spent executing 1 call to 2 subs defined therein. # spent 42µs executing statements in string eval # includes 12µs spent executing 1 call to 2 subs defined therein. # spent 41µs executing statements in string eval # includes 12µs spent executing 1 call to 2 subs defined therein. # spent 40µs executing statements in string eval # includes 12µs spent executing 1 call to 2 subs defined therein. # spent 40µs executing statements in string eval # includes 12µs spent executing 1 call to 2 subs defined therein. | ||
| 181 | |||||
| 182 | 8 | 2µs | die $@ if $@; | ||
| 183 | |||||
| 184 | 8 | 44µ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 | 3µs | 1; | ||
| 199 | |||||
| 200 | # ABSTRACT: A module that allows you to declare real exception classes in Perl | ||||
| 201 | |||||
| 202 | __END__ | ||||
# spent 12µs within Exception::Class::CORE:sort which was called:
# once (12µs+0s) by Exception::Class::import at line 39 | |||||
# spent 11µs within Exception::Class::CORE:subst which was called 8 times, avg 1µs/call:
# 8 times (11µs+0s) by Exception::Class::_make_subclass at line 141, avg 1µs/call | |||||
# spent 8µs within Exception::Class::CORE:substcont which was called 2 times, avg 4µs/call:
# 2 times (8µs+0s) by Exception::Class::_make_subclass at line 141, avg 4µs/call |