line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Devel::Unwind; |
2
|
22
|
|
|
22
|
|
435501
|
use strict; |
|
22
|
|
|
|
|
51
|
|
|
22
|
|
|
|
|
625
|
|
3
|
22
|
|
|
22
|
|
117
|
use XSLoader; |
|
22
|
|
|
|
|
40
|
|
|
22
|
|
|
|
|
468
|
|
4
|
22
|
|
|
22
|
|
104
|
use Exporter; |
|
22
|
|
|
|
|
48
|
|
|
22
|
|
|
|
|
2184
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
7
|
|
|
|
|
|
|
our $VERSION = '0.012'; |
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; |