use 5.006_000;
use strict;
-use warnings;
-
-our $VERSION = q(1.0008);
+use warnings FATAL => 'all';
use Fcntl qw( :DEFAULT :flock :seek );
+use constant DEBUG => 0;
+
sub new {
my $class = shift;
my ($args) = @_;
return 1;
}
+sub size {
+ my $self = shift;
+
+ return 0 unless $self->{fh};
+ return -s $self->{fh};
+}
+
sub set_inode {
my $self = shift;
seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
}
+ if ( DEBUG ) {
+ my $caller = join ':', (caller)[0,2];
+ my $len = length( join '', @_ );
+ warn "($caller) print_at( " . (defined $loc ? $loc : '<undef>') . ", $len )\n";
+ }
+
print( $fh @_ ) or die "Internal Error (print_at($loc)): $!\n";
return 1;
seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
}
+ if ( DEBUG ) {
+ my $caller = join ':', (caller)[0,2];
+ warn "($caller) read_at( " . (defined $loc ? $loc : '<undef>') . ", $size )\n";
+ }
+
my $buffer;
read( $fh, $buffer, $size);
# times before unlock(), then the same number of unlocks() must
# be called before the lock is released.
##
+sub lock_exclusive {
+ my $self = shift;
+ my ($obj) = @_;
+ return $self->lock( $obj, LOCK_EX );
+}
+
+sub lock_shared {
+ my $self = shift;
+ my ($obj) = @_;
+ return $self->lock( $obj, LOCK_SH );
+}
+
sub lock {
my $self = shift;
my ($obj, $type) = @_;
if ($self->{locking} && $self->{locked} > 0) {
$self->{locked}--;
- if (!$self->{locked}) { flock($self->{fh}, LOCK_UN); }
- return 1;
+ if (!$self->{locked}) {
+ flock($self->{fh}, LOCK_UN);
+ return 1;
+ }
+
+ return;
}
return;
return 1;
}
+# Taken from http://www.perlmonks.org/?node_id=691054
+sub is_writable {
+ my $self = shift;
+
+ my $fh = $self->{fh};
+ return unless defined $fh;
+ return unless defined fileno $fh;
+ local $\ = ''; # just in case
+ no warnings; # temporarily disable warnings
+ local $^W; # temporarily disable warnings
+ return print $fh '';
+}
+
+sub copy_stats {
+ my $self = shift;
+ my ($temp_filename) = @_;
+
+ my @stats = stat( $self->{fh} );
+ my $perms = $stats[2] & 07777;
+ my $uid = $stats[4];
+ my $gid = $stats[5];
+ chown( $uid, $gid, $temp_filename );
+ chmod( $perms, $temp_filename );
+}
+
1;
__END__