| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Devel::Unwind; |
|
2
|
22
|
|
|
22
|
|
416839
|
use strict; |
|
|
22
|
|
|
|
|
52
|
|
|
|
22
|
|
|
|
|
577
|
|
|
3
|
22
|
|
|
22
|
|
110
|
use XSLoader; |
|
|
22
|
|
|
|
|
38
|
|
|
|
22
|
|
|
|
|
432
|
|
|
4
|
22
|
|
|
22
|
|
106
|
use Exporter; |
|
|
22
|
|
|
|
|
47
|
|
|
|
22
|
|
|
|
|
2058
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
|
7
|
|
|
|
|
|
|
our $VERSION = '0.013'; |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
XSLoader::load(__PACKAGE__, $VERSION); |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=pod |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=encoding utf8 |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 NAME |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
Devel::Unwind - What if you could die to a labeled eval? |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
use Devel::Unwind; |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
$SIG{__DIE__} = sub { print "I die: @_" }; |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
mark FOO { |
|
26
|
|
|
|
|
|
|
unwind FOO; |
|
27
|
|
|
|
|
|
|
}; |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
mark FOO { |
|
30
|
|
|
|
|
|
|
unwind FOO "foobar"; |
|
31
|
|
|
|
|
|
|
1; |
|
32
|
|
|
|
|
|
|
} or do { |
|
33
|
|
|
|
|
|
|
print "or do: $@"; |
|
34
|
|
|
|
|
|
|
}; |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
mark FOO { |
|
37
|
|
|
|
|
|
|
unwind FOO 1..5; |
|
38
|
|
|
|
|
|
|
}; |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
package BAR { |
|
41
|
|
|
|
|
|
|
sub PROPAGATE {print "I propagate: @_\n"; $_[0]->[0]} |
|
42
|
|
|
|
|
|
|
} |
|
43
|
|
|
|
|
|
|
mark FOO { |
|
44
|
|
|
|
|
|
|
$@ = bless ["baz"], "BAR"; |
|
45
|
|
|
|
|
|
|
unwind FOO; |
|
46
|
|
|
|
|
|
|
} |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Imagine Perl had the ability to die to a labeled eval so that when |
|
51
|
|
|
|
|
|
|
you write |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
FOO: eval {...} |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
you could die to that labeled eval |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
die FOO "bar"; |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
That is essentially what Devel::Unwind gives you. Two custom keywords |
|
60
|
|
|
|
|
|
|
'mark','unwind' are added allowing you two write |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
use Devel::Unwind; |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
mark FOO {...} or do {...} |
|
65
|
|
|
|
|
|
|
unwind FOO "bar"; |
|
66
|
|
|
|
|
|
|
unwind FOO "bar","baz"; |
|
67
|
|
|
|
|
|
|
unwind FOO (bless [], "Bar"); |
|
68
|
|
|
|
|
|
|
unwind FOO; |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Wherever you would put a block 'eval' an 'mark' expression can be |
|
71
|
|
|
|
|
|
|
used. And wherever you would 'die' you can 'unwind'. If a |
|
72
|
|
|
|
|
|
|
$SIG{__DIE__} handler is installed then it gets called on |
|
73
|
|
|
|
|
|
|
'unwind'. The arguments to 'unwind' are treated the same way as the |
|
74
|
|
|
|
|
|
|
arguments to 'die'. Multiple arguments are joined to togeter, a single |
|
75
|
|
|
|
|
|
|
argument is passed through untouched unless it is a object with |
|
76
|
|
|
|
|
|
|
PROPAGATE method in which case $@ gets replaced by the return value of |
|
77
|
|
|
|
|
|
|
that method. For details read the documentation of die. |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head1 AUTHORS |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Andreas Guðmundsson C<< andreasg@cpan.org >> |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
1; |