Filename | /usr/lib/perl5/site_perl/5.12.4/Try/Tiny.pm |
Statements | Executed 39 statements in 3.06ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 176µs | 3.28ms | try | Try::Tiny::
1 | 1 | 1 | 104µs | 130µs | BEGIN@3 | Try::Tiny::
1 | 1 | 1 | 63µs | 63µs | BEGIN@8 | Try::Tiny::
1 | 1 | 1 | 62µs | 62µs | catch | Try::Tiny::
1 | 1 | 1 | 54µs | 347µs | BEGIN@46 | Try::Tiny::
1 | 1 | 1 | 51µs | 470µs | BEGIN@6 | Try::Tiny::
0 | 0 | 0 | 0s | 0s | DESTROY | Try::Tiny::ScopeGuard::
0 | 0 | 0 | 0s | 0s | _new | Try::Tiny::ScopeGuard::
0 | 0 | 0 | 0s | 0s | finally | Try::Tiny::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Try::Tiny; | ||||
2 | |||||
3 | 3 | 160µs | 2 | 156µs | # spent 130µs (104+26) within Try::Tiny::BEGIN@3 which was called:
# once (104µs+26µs) by Module::Implementation::BEGIN@10 at line 3 # spent 130µs making 1 call to Try::Tiny::BEGIN@3
# spent 26µs making 1 call to strict::import |
4 | #use warnings; | ||||
5 | |||||
6 | 3 | 259µs | 2 | 889µs | # spent 470µs (51+419) within Try::Tiny::BEGIN@6 which was called:
# once (51µs+419µs) by Module::Implementation::BEGIN@10 at line 6 # spent 470µs making 1 call to Try::Tiny::BEGIN@6
# spent 419µs making 1 call to vars::import |
7 | |||||
8 | # spent 63µs within Try::Tiny::BEGIN@8 which was called:
# once (63µs+0s) by Module::Implementation::BEGIN@10 at line 11 | ||||
9 | 2 | 64µs | require Exporter; | ||
10 | @ISA = qw(Exporter); | ||||
11 | 1 | 586µs | 1 | 63µs | } # spent 63µs making 1 call to Try::Tiny::BEGIN@8 |
12 | |||||
13 | 1 | 6µs | $VERSION = "0.11"; | ||
14 | |||||
15 | 1 | 75µs | $VERSION = eval $VERSION; # spent 13µs executing statements in string eval | ||
16 | |||||
17 | 1 | 14µs | @EXPORT = @EXPORT_OK = qw(try catch finally); | ||
18 | |||||
19 | 1 | 7µs | $Carp::Internal{+__PACKAGE__}++; | ||
20 | |||||
21 | # Need to prototype as @ not $$ because of the way Perl evaluates the prototype. | ||||
22 | # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list | ||||
23 | # context & not a scalar one | ||||
24 | |||||
25 | # spent 3.28ms (176µs+3.10) within Try::Tiny::try which was called:
# once (176µs+3.10ms) by Module::Implementation::_load_implementation at line 90 of Module/Implementation.pm | ||||
26 | 20 | 178µs | my ( $try, @code_refs ) = @_; | ||
27 | |||||
28 | # we need to save this here, the eval block will be in scalar context due | ||||
29 | # to $failed | ||||
30 | my $wantarray = wantarray; | ||||
31 | |||||
32 | my ( $catch, @finally ); | ||||
33 | |||||
34 | # find labeled blocks in the argument list. | ||||
35 | # catch and finally tag the blocks by blessing a scalar reference to them. | ||||
36 | foreach my $code_ref (@code_refs) { | ||||
37 | next unless $code_ref; | ||||
38 | |||||
39 | my $ref = ref($code_ref); | ||||
40 | |||||
41 | if ( $ref eq 'Try::Tiny::Catch' ) { | ||||
42 | $catch = ${$code_ref}; | ||||
43 | } elsif ( $ref eq 'Try::Tiny::Finally' ) { | ||||
44 | push @finally, ${$code_ref}; | ||||
45 | } else { | ||||
46 | 3 | 1.61ms | 2 | 641µs | # spent 347µs (54+294) within Try::Tiny::BEGIN@46 which was called:
# once (54µs+294µs) by Module::Implementation::BEGIN@10 at line 46 # spent 347µs making 1 call to Try::Tiny::BEGIN@46
# spent 294µs making 1 call to Exporter::import |
47 | confess("Unknown code ref type given '${ref}'. Check your usage & try again"); | ||||
48 | } | ||||
49 | } | ||||
50 | |||||
51 | # save the value of $@ so we can set $@ back to it in the beginning of the eval | ||||
52 | my $prev_error = $@; | ||||
53 | |||||
54 | my ( @ret, $error, $failed ); | ||||
55 | |||||
56 | # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's | ||||
57 | # not perfect, but we could provide a list of additional errors for | ||||
58 | # $catch->(); | ||||
59 | |||||
60 | { | ||||
61 | # localize $@ to prevent clobbering of previous value by a successful | ||||
62 | # eval. | ||||
63 | local $@; | ||||
64 | |||||
65 | # failed will be true if the eval dies, because 1 will not be returned | ||||
66 | # from the eval body | ||||
67 | $failed = not eval { | ||||
68 | $@ = $prev_error; | ||||
69 | |||||
70 | # evaluate the try block in the correct context | ||||
71 | if ( $wantarray ) { | ||||
72 | @ret = $try->(); | ||||
73 | } elsif ( defined $wantarray ) { | ||||
74 | $ret[0] = $try->(); | ||||
75 | } else { | ||||
76 | 1 | 3.10ms | $try->(); # spent 3.10ms making 1 call to Module::Implementation::__ANON__[Module/Implementation.pm:87] | ||
77 | }; | ||||
78 | |||||
79 | return 1; # properly set $fail to false | ||||
80 | }; | ||||
81 | |||||
82 | # copy $@ to $error; when we leave this scope, local $@ will revert $@ | ||||
83 | # back to its previous value | ||||
84 | $error = $@; | ||||
85 | } | ||||
86 | |||||
87 | # set up a scope guard to invoke the finally block at the end | ||||
88 | my @guards = | ||||
89 | map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) } | ||||
90 | @finally; | ||||
91 | |||||
92 | # at this point $failed contains a true value if the eval died, even if some | ||||
93 | # destructor overwrote $@ as the eval was unwinding. | ||||
94 | if ( $failed ) { | ||||
95 | # if we got an error, invoke the catch block. | ||||
96 | if ( $catch ) { | ||||
97 | # This works like given($error), but is backwards compatible and | ||||
98 | # sets $_ in the dynamic scope for the body of C<$catch> | ||||
99 | for ($error) { | ||||
100 | return $catch->($error); | ||||
101 | } | ||||
102 | |||||
103 | # in case when() was used without an explicit return, the C<for> | ||||
104 | # loop will be aborted and there's no useful return value | ||||
105 | } | ||||
106 | |||||
107 | return; | ||||
108 | } else { | ||||
109 | # no failure, $@ is back to what it was, everything is fine | ||||
110 | return $wantarray ? @ret : $ret[0]; | ||||
111 | } | ||||
112 | } | ||||
113 | |||||
114 | # spent 62µs within Try::Tiny::catch which was called:
# once (62µs+0s) by Module::Implementation::_load_implementation at line 90 of Module/Implementation.pm | ||||
115 | 2 | 72µs | my ( $block, @rest ) = @_; | ||
116 | |||||
117 | return ( | ||||
118 | bless(\$block, 'Try::Tiny::Catch'), | ||||
119 | @rest, | ||||
120 | ); | ||||
121 | } | ||||
122 | |||||
123 | sub finally (&;@) { | ||||
124 | my ( $block, @rest ) = @_; | ||||
125 | |||||
126 | return ( | ||||
127 | bless(\$block, 'Try::Tiny::Finally'), | ||||
128 | @rest, | ||||
129 | ); | ||||
130 | } | ||||
131 | |||||
132 | { | ||||
133 | 1 | 6µs | package # hide from PAUSE | ||
134 | Try::Tiny::ScopeGuard; | ||||
135 | |||||
136 | sub _new { | ||||
137 | shift; | ||||
138 | bless [ @_ ]; | ||||
139 | } | ||||
140 | |||||
141 | sub DESTROY { | ||||
142 | my @guts = @{ shift() }; | ||||
143 | my $code = shift @guts; | ||||
144 | $code->(@guts); | ||||
145 | } | ||||
146 | } | ||||
147 | |||||
148 | __PACKAGE__ | ||||
149 | |||||
150 | 1 | 23µs | __END__ |