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