| Subject: | IO::LockedFile open() does not correctly detect when a file is opened for writing |
Some example cases that are unhandled:
* IO::LockFile->new("+<file"); # open for read and write, do not truncate or create
* IO::LockFile->new("file", "<"); # open for read-only
* IO::LockFile->new("file", O_RDWR); # open for read and write, do not truncate or create
* IO::LockFile->new("file", "<:encoding(UTF-16)"); # open for reading only and read input as UTF-16
A proposed fix (untested, sorry):
sub open {
my $self = shift;
my $writable = 0;
if ( scalar(@_) == 1 ) {
# Perl mode. Look at first character
# Quick sanity check. We can't lock a pipe
if (( substr( $_[0], 0, 1 ) eq '|' ) ||
( substr( $_[0], -1, 1 ) eq '|' ) ) {
croak "Cannot lock a pipe"
}
# OK, now look at first character
$writable = substr( $_[0], 0, 1 ) eq '>' or substr( $_[0], 0, 1 ) eq '+';
}
elsif ( $_[1] =~ /^\d+$/ ) {
# Numeric mode
require Fcntl;
$writable = ( ( $_[1] & O_RDWR ) ||
( $_[1] & O_WRONLY ) )
}
else {
# POSIX mode (we know there were enough parameters since our
# SUPER succeeded).
$writable = ( $_[1] ne 'r' and $_[1] !~ /^</ );
}
$self->_set_writable( $writable );
# call open of the super class (IO::File) with the rest of the parameters
$self->SUPER::open(@_) or return undef;
if ( $self->should_lock() ) {
$self->lock() or return undef;
}
return 1;
} # of open