| 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 | Exception::Class::Base::BEGIN@7 |
| 1 | 1 | 1 | 286µs | 355µs | Exception::Class::Base::BEGIN@6 |
| 1 | 1 | 1 | 52µs | 52µs | Exception::Class::Base::BEGIN@45 |
| 1 | 1 | 1 | 36µs | 84µs | Exception::Class::Base::BEGIN@12 |
| 1 | 1 | 1 | 13µs | 25µs | Exception::Class::Base::BEGIN@3 |
| 1 | 1 | 1 | 9µs | 82µs | Exception::Class::Base::BEGIN@10 |
| 1 | 1 | 1 | 9µs | 16µs | Exception::Class::Base::BEGIN@4 |
| 1 | 1 | 1 | 9µs | 44µs | Exception::Class::Base::BEGIN@42 |
| 1 | 1 | 1 | 8µs | 18µs | Exception::Class::Base::BEGIN@71 |
| 1 | 1 | 1 | 8µs | 31µs | Exception::Class::Base::BEGIN@8 |
| 1 | 1 | 1 | 8µs | 19µs | Exception::Class::Base::BEGIN@51 |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::Classes |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::Fields |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::NoRefs |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::__ANON__[:42] |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::__ANON__[:49] |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::__ANON__[:70] |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::_initialize |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::as_string |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::caught |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::context_hash |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::description |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::field_hash |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::full_message |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::new |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::rethrow |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::show_trace |
| 0 | 0 | 0 | 0s | 0s | Exception::Class::Base::throw |
| 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 | 8 | 18µs | 1 | 9µs | __PACKAGE__->mk_classdata('Trace'); # spent 9µs making 1 call to Class::Data::Inheritable::mk_classdata |
| 14 | 1 | 8µs | __PACKAGE__->mk_classdata('UnsafeRefCapture'); # spent 8µs making 1 call to Class::Data::Inheritable::mk_classdata | ||
| 15 | |||||
| 16 | 1 | 6µs | __PACKAGE__->mk_classdata('NoContextInfo'); # spent 6µs making 1 call to Class::Data::Inheritable::mk_classdata | ||
| 17 | 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 | 11µs | __PACKAGE__->mk_classdata('RespectOverload'); # spent 11µs making 1 call to Class::Data::Inheritable::mk_classdata | ||
| 20 | 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 | 6µs | __PACKAGE__->mk_classdata('MaxArgLength'); # spent 6µs making 1 call to Class::Data::Inheritable::mk_classdata | ||
| 23 | 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 | 27 | 49µs | my @fields = qw( message pid uid euid gid egid time trace ); | ||
| 47 | |||||
| 48 | foreach my $f (@fields) { | ||||
| 49 | 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 | *{$f} = $sub; | ||||
| 53 | } | ||||
| 54 | *error = \&message; | ||||
| 55 | |||||
| 56 | my %trace_fields = ( | ||||
| 57 | package => 'package', | ||||
| 58 | file => 'filename', | ||||
| 59 | line => 'line', | ||||
| 60 | ); | ||||
| 61 | |||||
| 62 | 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 | }; | ||||
| 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 | *{$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__ |