IO::File::Lockable - supply lock based methods for I/O File objects

package IO::File::Lockable;
use strict;
use base qw(IO::File);
use vars qw($VERSION);
use Carp;
$VERSION		= '0.34';
#####  override open method , add argument lock mode.
sub class		:method {ref($_[0]) || $_[0] || __PACKAGE__}
sub new 		:method {(shift()->class->SUPER::new())->init(@_)}
sub init		:method {shift()->open(@_)		if(@_ > 1);}
sub open		:method {
	my $fh		= shift;
	my $file	= shift || return;
	my $mode	= shift;
	$file		= IO::Handle::_open_mode_string($mode) . $file	if($mode);
	$fh->SUPER::open($file) or return;
	my $lock	= (defined $_[0]) ? $_[0]
				: ($file =~ /^(\+?>|\+<)/) ? 'lock_ex' : 'lock_sh';
	return $fh->$lock($_[1]);
}
sub lock_ex		:method {carp('please override lock_ex method.');$_[0]}
sub lock_sh		:method {carp('please override lock_sh method.');$_[0]}
sub lock_un		:method {carp('please override lock_un method.');$_[0]}
######################################################################
sub set_timeout :method {
	my $self		= shift;
	my $timeout 	= shift;
	my $sub 		= shift;
	my $result		= $timeout
		? eval {
			local $SIG{ALRM} = sub {die('TIMEOUT')};
			my $old	= alarm($timeout);
			my $r	= $sub->();
			alarm($old);
			return $r;
		}
		: eval {return $sub->()};
	if($@){carp($@);return;}
	return $result;
}
######################################################################
__END__