Filename | /Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Try/Tiny.pm |
Statements | Executed 72 statements in 731µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 1 | 67µs | 6.88ms | try | Try::Tiny::
1 | 1 | 1 | 14µs | 14µs | BEGIN@2 | Try::Tiny::
2 | 1 | 1 | 11µs | 20µs | catch | Try::Tiny::
1 | 1 | 1 | 8µs | 18µs | BEGIN@10 | Try::Tiny::
1 | 1 | 1 | 6µs | 43µs | BEGIN@167 | Try::Tiny::ScopeGuard::
1 | 1 | 1 | 5µs | 35µs | BEGIN@13 | Try::Tiny::
1 | 1 | 1 | 5µs | 5µs | BEGIN@16 | Try::Tiny::
1 | 1 | 1 | 5µs | 6µs | BEGIN@7 | Try::Tiny::
1 | 1 | 1 | 3µs | 15µs | BEGIN@8 | 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 | __ANON__[:28] | Try::Tiny::
0 | 0 | 0 | 0s | 0s | finally | Try::Tiny::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Try::Tiny; # git description: v0.30-11-g1b81d0a | ||||
2 | 2 | 38µs | 1 | 14µs | # spent 14µs within Try::Tiny::BEGIN@2 which was called:
# once (14µs+0s) by Module::Implementation::BEGIN@9 at line 2 # spent 14µs making 1 call to Try::Tiny::BEGIN@2 |
3 | # ABSTRACT: Minimal try/catch with proper preservation of $@ | ||||
4 | |||||
5 | 1 | 0s | our $VERSION = '0.31'; | ||
6 | |||||
7 | 2 | 15µs | 2 | 7µs | # spent 6µs (5+1000ns) within Try::Tiny::BEGIN@7 which was called:
# once (5µs+1000ns) by Module::Implementation::BEGIN@9 at line 7 # spent 6µs making 1 call to Try::Tiny::BEGIN@7
# spent 1µs making 1 call to strict::import |
8 | 2 | 16µs | 2 | 27µs | # spent 15µs (3+12) within Try::Tiny::BEGIN@8 which was called:
# once (3µs+12µs) by Module::Implementation::BEGIN@9 at line 8 # spent 15µs making 1 call to Try::Tiny::BEGIN@8
# spent 12µs making 1 call to warnings::import |
9 | |||||
10 | 3 | 37µs | 3 | 28µs | # spent 18µs (8+10) within Try::Tiny::BEGIN@10 which was called:
# once (8µs+10µs) by Module::Implementation::BEGIN@9 at line 10 # spent 18µs making 1 call to Try::Tiny::BEGIN@10
# spent 7µs making 1 call to Exporter::import
# spent 3µs making 1 call to UNIVERSAL::VERSION |
11 | 1 | 1µs | our @EXPORT = our @EXPORT_OK = qw(try catch finally); | ||
12 | |||||
13 | 2 | 118µs | 2 | 65µs | # spent 35µs (5+30) within Try::Tiny::BEGIN@13 which was called:
# once (5µs+30µs) by Module::Implementation::BEGIN@9 at line 13 # spent 35µs making 1 call to Try::Tiny::BEGIN@13
# spent 30µs making 1 call to Exporter::import |
14 | 1 | 1µs | $Carp::Internal{+__PACKAGE__}++; | ||
15 | |||||
16 | # spent 5µs within Try::Tiny::BEGIN@16 which was called:
# once (5µs+0s) by Module::Implementation::BEGIN@9 at line 30 | ||||
17 | 1 | 1µs | my $su = $INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname; | ||
18 | 1 | 1µs | my $sn = $INC{'Sub/Name.pm'} && eval { Sub::Name->VERSION(0.08) }; | ||
19 | 1 | 0s | unless ($su || $sn) { | ||
20 | $su = eval { require Sub::Util; } && defined &Sub::Util::set_subname; | ||||
21 | unless ($su) { | ||||
22 | $sn = eval { require Sub::Name; Sub::Name->VERSION(0.08) }; | ||||
23 | } | ||||
24 | } | ||||
25 | |||||
26 | *_subname = $su ? \&Sub::Util::set_subname | ||||
27 | : $sn ? \&Sub::Name::subname | ||||
28 | 1 | 0s | : sub { $_[1] }; | ||
29 | 1 | 5µs | *_HAS_SUBNAME = ($su || $sn) ? sub(){1} : sub(){0}; | ||
30 | 1 | 277µs | 1 | 5µs | } # spent 5µs making 1 call to Try::Tiny::BEGIN@16 |
31 | |||||
32 | 1 | 0s | my %_finally_guards; | ||
33 | |||||
34 | # Need to prototype as @ not $$ because of the way Perl evaluates the prototype. | ||||
35 | # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list | ||||
36 | # context & not a scalar one | ||||
37 | |||||
38 | # spent 6.88ms (67µs+6.82) within Try::Tiny::try which was called 2 times, avg 3.44ms/call:
# 2 times (67µs+6.82ms) by Module::Implementation::_load_implementation at line 98 of Module/Implementation.pm, avg 3.44ms/call | ||||
39 | 2 | 2µs | my ( $try, @code_refs ) = @_; | ||
40 | |||||
41 | # we need to save this here, the eval block will be in scalar context due | ||||
42 | # to $failed | ||||
43 | 2 | 0s | my $wantarray = wantarray; | ||
44 | |||||
45 | # work around perl bug by explicitly initializing these, due to the likelyhood | ||||
46 | # this will be used in global destruction (perl rt#119311) | ||||
47 | 2 | 1µs | my ( $catch, @finally ) = (); | ||
48 | |||||
49 | # find labeled blocks in the argument list. | ||||
50 | # catch and finally tag the blocks by blessing a scalar reference to them. | ||||
51 | 2 | 33µs | foreach my $code_ref (@code_refs) { | ||
52 | |||||
53 | 2 | 1µs | if ( ref($code_ref) eq 'Try::Tiny::Catch' ) { | ||
54 | 2 | 0s | croak 'A try() may not be followed by multiple catch() blocks' | ||
55 | if $catch; | ||||
56 | 2 | 1µs | $catch = ${$code_ref}; | ||
57 | } elsif ( ref($code_ref) eq 'Try::Tiny::Finally' ) { | ||||
58 | push @finally, ${$code_ref}; | ||||
59 | } else { | ||||
60 | croak( | ||||
61 | 'try() encountered an unexpected argument (' | ||||
62 | . ( defined $code_ref ? $code_ref : 'undef' ) | ||||
63 | . ') - perhaps a missing semi-colon before or' | ||||
64 | ); | ||||
65 | } | ||||
66 | } | ||||
67 | |||||
68 | # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's | ||||
69 | # not perfect, but we could provide a list of additional errors for | ||||
70 | # $catch->(); | ||||
71 | |||||
72 | # name the blocks if we have Sub::Name installed | ||||
73 | 2 | 9µs | 2 | 5µs | _subname(caller().'::try {...} ' => $try) # spent 5µs making 2 calls to Sub::Util::set_subname, avg 2µs/call |
74 | if _HAS_SUBNAME; | ||||
75 | |||||
76 | # set up scope guards to invoke the finally blocks at the end. | ||||
77 | # this should really be a function scope lexical variable instead of | ||||
78 | # file scope + local but that causes issues with perls < 5.20 due to | ||||
79 | # perl rt#119311 | ||||
80 | local $_finally_guards{guards} = [ | ||||
81 | 2 | 3µs | map Try::Tiny::ScopeGuard->_new($_), | ||
82 | @finally | ||||
83 | ]; | ||||
84 | |||||
85 | # save the value of $@ so we can set $@ back to it in the beginning of the eval | ||||
86 | # and restore $@ after the eval finishes | ||||
87 | 2 | 1µs | my $prev_error = $@; | ||
88 | |||||
89 | 2 | 0s | my ( @ret, $error ); | ||
90 | |||||
91 | # failed will be true if the eval dies, because 1 will not be returned | ||||
92 | # from the eval body | ||||
93 | 2 | 4µs | my $failed = not eval { | ||
94 | 2 | 0s | $@ = $prev_error; | ||
95 | |||||
96 | # evaluate the try block in the correct context | ||||
97 | 2 | 2µs | if ( $wantarray ) { | ||
98 | @ret = $try->(); | ||||
99 | } elsif ( defined $wantarray ) { | ||||
100 | $ret[0] = $try->(); | ||||
101 | } else { | ||||
102 | 2 | 2µs | 2 | 6.81ms | $try->(); # spent 6.81ms making 2 calls to Module::Implementation::try {...} , avg 3.41ms/call |
103 | }; | ||||
104 | |||||
105 | 2 | 1µs | return 1; # properly set $failed to false | ||
106 | }; | ||||
107 | |||||
108 | # preserve the current error and reset the original value of $@ | ||||
109 | 2 | 2µs | $error = $@; | ||
110 | 2 | 0s | $@ = $prev_error; | ||
111 | |||||
112 | # at this point $failed contains a true value if the eval died, even if some | ||||
113 | # destructor overwrote $@ as the eval was unwinding. | ||||
114 | 2 | 1µs | if ( $failed ) { | ||
115 | # pass $error to the finally blocks | ||||
116 | push @$_, $error for @{$_finally_guards{guards}}; | ||||
117 | |||||
118 | # if we got an error, invoke the catch block. | ||||
119 | if ( $catch ) { | ||||
120 | # This works like given($error), but is backwards compatible and | ||||
121 | # sets $_ in the dynamic scope for the body of C<$catch> | ||||
122 | for ($error) { | ||||
123 | return $catch->($error); | ||||
124 | } | ||||
125 | |||||
126 | # in case when() was used without an explicit return, the C<for> | ||||
127 | # loop will be aborted and there's no useful return value | ||||
128 | } | ||||
129 | |||||
130 | return; | ||||
131 | } else { | ||||
132 | # no failure, $@ is back to what it was, everything is fine | ||||
133 | 2 | 7µs | return $wantarray ? @ret : $ret[0]; | ||
134 | } | ||||
135 | } | ||||
136 | |||||
137 | # spent 20µs (11+9) within Try::Tiny::catch which was called 2 times, avg 10µs/call:
# 2 times (11µs+9µs) by Module::Implementation::_load_implementation at line 98 of Module/Implementation.pm, avg 10µs/call | ||||
138 | 2 | 0s | my ( $block, @rest ) = @_; | ||
139 | |||||
140 | 2 | 1µs | croak 'Useless bare catch()' unless wantarray; | ||
141 | |||||
142 | 2 | 14µs | 2 | 9µs | _subname(caller().'::catch {...} ' => $block) # spent 9µs making 2 calls to Sub::Util::set_subname, avg 4µs/call |
143 | if _HAS_SUBNAME; | ||||
144 | return ( | ||||
145 | 2 | 6µs | bless(\$block, 'Try::Tiny::Catch'), | ||
146 | @rest, | ||||
147 | ); | ||||
148 | } | ||||
149 | |||||
150 | sub finally (&;@) { | ||||
151 | my ( $block, @rest ) = @_; | ||||
152 | |||||
153 | croak 'Useless bare finally()' unless wantarray; | ||||
154 | |||||
155 | _subname(caller().'::finally {...} ' => $block) | ||||
156 | if _HAS_SUBNAME; | ||||
157 | return ( | ||||
158 | bless(\$block, 'Try::Tiny::Finally'), | ||||
159 | @rest, | ||||
160 | ); | ||||
161 | } | ||||
162 | |||||
163 | { | ||||
164 | package # hide from PAUSE | ||||
165 | Try::Tiny::ScopeGuard; | ||||
166 | |||||
167 | 2 | 126µs | 2 | 80µs | # spent 43µs (6+37) within Try::Tiny::ScopeGuard::BEGIN@167 which was called:
# once (6µs+37µs) by Module::Implementation::BEGIN@9 at line 167 # spent 43µs making 1 call to Try::Tiny::ScopeGuard::BEGIN@167
# spent 37µs making 1 call to constant::import |
168 | |||||
169 | sub _new { | ||||
170 | shift; | ||||
171 | bless [ @_ ]; | ||||
172 | } | ||||
173 | |||||
174 | sub DESTROY { | ||||
175 | my ($code, @args) = @{ $_[0] }; | ||||
176 | |||||
177 | local $@ if UNSTABLE_DOLLARAT; | ||||
178 | eval { | ||||
179 | $code->(@args); | ||||
180 | 1; | ||||
181 | } or do { | ||||
182 | warn | ||||
183 | "Execution of finally() block $code resulted in an exception, which " | ||||
184 | . '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. ' | ||||
185 | . 'Your program will continue as if this event never took place. ' | ||||
186 | . "Original exception text follows:\n\n" | ||||
187 | . (defined $@ ? $@ : '$@ left undefined...') | ||||
188 | . "\n" | ||||
189 | ; | ||||
190 | } | ||||
191 | } | ||||
192 | } | ||||
193 | |||||
194 | 1 | 0s | __PACKAGE__ | ||
195 | __END__ | ||||
196 | 1 | 4µs |