line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- mode: perl; coding: utf-8 -*- |
2
|
|
|
|
|
|
|
package YATT::Util::Finalizer; |
3
|
12
|
|
|
12
|
|
503400
|
use strict; |
|
12
|
|
|
|
|
19
|
|
|
12
|
|
|
|
|
370
|
|
4
|
12
|
|
|
12
|
|
59
|
use warnings qw(FATAL all NONFATAL misc); |
|
12
|
|
|
|
|
16
|
|
|
12
|
|
|
|
|
501
|
|
5
|
|
|
|
|
|
|
|
6
|
12
|
|
|
12
|
|
55
|
use base qw(Exporter); |
|
12
|
|
|
|
|
19
|
|
|
12
|
|
|
|
|
1264
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
12
|
|
|
12
|
|
42
|
our @EXPORT = qw(with_select capture finally); |
9
|
12
|
|
|
|
|
4783
|
our @EXPORT_OK = @EXPORT; |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub new { |
13
|
162
|
|
|
162
|
0
|
490
|
my ($pack, $code) = splice @_, 0, 2; |
14
|
162
|
|
|
|
|
735
|
bless [$code, @_], $pack; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub finally (&@) { |
18
|
162
|
|
|
162
|
0
|
1271
|
__PACKAGE__->new(@_); |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub DESTROY { |
22
|
162
|
|
|
162
|
|
342
|
my $self = shift; |
23
|
162
|
100
|
|
|
|
557
|
if ($@) { |
24
|
|
|
|
|
|
|
# XXX: This can be hard to catch. |
25
|
32
|
50
|
|
|
|
139
|
syswrite STDOUT, "\n\n[$@]" if $ENV{DEBUG_ERROR}; |
26
|
|
|
|
|
|
|
} |
27
|
162
|
50
|
|
|
|
518
|
my $code = $self->[0] or return; |
28
|
162
|
|
|
|
|
599
|
$code->(@$self[1 .. $#$self]); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub cancel { |
32
|
0
|
|
|
0
|
0
|
0
|
undef shift->[0]; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub with_select { |
36
|
|
|
|
|
|
|
# newfh, body, [strref] |
37
|
162
|
|
|
162
|
0
|
278
|
my $strref; |
38
|
162
|
50
|
|
|
|
532
|
unless (defined $_[0]) { |
39
|
162
|
|
33
|
|
|
519
|
$strref = $_[2] || do {my $str = ""; \$str}; |
40
|
162
|
50
|
|
3
|
|
3471
|
open $_[0], '>', $strref or die "Can't open strref: $!"; |
|
3
|
|
|
|
|
23
|
|
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
24
|
|
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
my $finalizer = finally { |
43
|
162
|
|
|
162
|
|
1886
|
select($_[0]); |
44
|
162
|
|
|
|
|
5124
|
} select; |
45
|
162
|
|
|
|
|
588
|
select($_[0]); |
46
|
162
|
|
|
|
|
602
|
$_[1]->($finalizer); |
47
|
130
|
50
|
|
|
|
939
|
defined $strref && $$strref; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub capture (&@) { |
51
|
162
|
|
|
162
|
0
|
602
|
with_select my ($fh), $_[0]; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
1; |