line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IO::File::Lockable; |
2
|
1
|
|
|
1
|
|
1276
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
51
|
|
3
|
1
|
|
|
1
|
|
7
|
use base qw(IO::File); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
1216
|
|
4
|
1
|
|
|
1
|
|
14610
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
5
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
503
|
|
6
|
|
|
|
|
|
|
$VERSION = '0.34'; |
7
|
|
|
|
|
|
|
##### override open method , add argument lock mode. |
8
|
2
|
50
|
33
|
2
|
0
|
26
|
sub class :method {ref($_[0]) || $_[0] || __PACKAGE__} |
9
|
2
|
|
|
2
|
1
|
1111
|
sub new :method {(shift()->class->SUPER::new())->init(@_)} |
10
|
2
|
50
|
|
2
|
0
|
90
|
sub init :method {shift()->open(@_) if(@_ > 1);} |
11
|
|
|
|
|
|
|
sub open :method { |
12
|
2
|
|
|
2
|
1
|
3
|
my $fh = shift; |
13
|
2
|
|
50
|
|
|
7
|
my $file = shift || return; |
14
|
2
|
|
|
|
|
3
|
my $mode = shift; |
15
|
2
|
50
|
|
|
|
9
|
$file = IO::Handle::_open_mode_string($mode) . $file if($mode); |
16
|
2
|
50
|
|
|
|
28
|
$fh->SUPER::open($file) or return; |
17
|
2
|
0
|
|
|
|
709
|
my $lock = (defined $_[0]) ? $_[0] |
|
|
50
|
|
|
|
|
|
18
|
|
|
|
|
|
|
: ($file =~ /^(\+?>|\+<)/) ? 'lock_ex' : 'lock_sh'; |
19
|
2
|
|
|
|
|
13
|
return $fh->$lock($_[1]); |
20
|
|
|
|
|
|
|
} |
21
|
0
|
|
|
0
|
1
|
0
|
sub lock_ex :method {carp('please override lock_ex method.');$_[0]} |
|
0
|
|
|
|
|
0
|
|
22
|
0
|
|
|
0
|
1
|
0
|
sub lock_sh :method {carp('please override lock_sh method.');$_[0]} |
|
0
|
|
|
|
|
0
|
|
23
|
0
|
|
|
0
|
1
|
0
|
sub lock_un :method {carp('please override lock_un method.');$_[0]} |
|
0
|
|
|
|
|
0
|
|
24
|
|
|
|
|
|
|
###################################################################### |
25
|
|
|
|
|
|
|
sub set_timeout :method { |
26
|
8
|
|
|
8
|
0
|
14
|
my $self = shift; |
27
|
8
|
|
|
|
|
9
|
my $timeout = shift; |
28
|
8
|
|
|
|
|
8
|
my $sub = shift; |
29
|
|
|
|
|
|
|
my $result = $timeout |
30
|
8
|
|
|
|
|
17
|
? eval { |
31
|
0
|
|
|
0
|
|
0
|
local $SIG{ALRM} = sub {die('TIMEOUT')}; |
|
0
|
|
|
|
|
0
|
|
32
|
0
|
|
|
|
|
0
|
my $old = alarm($timeout); |
33
|
0
|
|
|
|
|
0
|
my $r = $sub->(); |
34
|
0
|
|
|
|
|
0
|
alarm($old); |
35
|
0
|
|
|
|
|
0
|
return $r; |
36
|
|
|
|
|
|
|
} |
37
|
8
|
50
|
|
|
|
18
|
: eval {return $sub->()}; |
38
|
8
|
50
|
|
|
|
19
|
if($@){carp($@);return;} |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
39
|
8
|
|
|
|
|
48
|
return $result; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
###################################################################### |
42
|
|
|
|
|
|
|
__END__ |