File Coverage

blib/lib/IO/File/Lockable.pm
Criterion Covered Total %
statement 29 43 67.4
branch 7 16 43.7
condition 2 5 40.0
subroutine 9 13 69.2
pod 5 8 62.5
total 52 85 61.1


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__