1 package DBM::Deep::File;
8 our $VERSION = q(0.99_03);
10 use Fcntl qw( :DEFAULT :flock :seek );
25 filter_store_key => undef,
26 filter_store_value => undef,
27 filter_fetch_key => undef,
28 filter_fetch_value => undef,
31 # Grab the parameters we want to use
32 foreach my $param ( keys %$self ) {
33 next unless exists $args->{$param};
34 $self->{$param} = $args->{$param};
37 if ( $self->{fh} && !$self->{file_offset} ) {
38 $self->{file_offset} = tell( $self->{fh} );
41 $self->open unless $self->{fh};
49 # Adding O_BINARY should remove the need for the binmode below. However,
50 # I'm not going to remove it because I don't have the Win32 chops to be
51 # absolutely certain everything will be ok.
52 my $flags = O_RDWR | O_CREAT | O_BINARY;
55 sysopen( $fh, $self->{file}, $flags )
56 or die "DBM::Deep: Cannot sysopen file '$self->{file}': $!\n";
59 # Even though we use O_BINARY, better be safe than sorry.
62 if ($self->{autoflush}) {
85 unless ( defined $self->{inode} ) {
86 my @stats = stat($self->{fh});
87 $self->{inode} = $stats[1];
88 $self->{end} = $stats[7];
100 my $fh = $self->{fh};
101 if ( defined $loc ) {
102 seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
112 my ($loc, $size) = @_;
113 print join(":",map{$_||''}caller) . " - read_at(@{[$loc || 'undef']}, $size)\n" if $::DEBUG;
117 my $fh = $self->{fh};
118 if ( defined $loc ) {
119 seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
123 read( $fh, $buffer, $size);
141 #XXX Do I need to reset $self->{end} here? I need a testcase
142 my $loc = $self->{end};
143 $self->{end} += $size;
149 # If db locking is set, flock() the db file. If called multiple
150 # times before unlock(), then the same number of unlocks() must
151 # be called before the lock is released.
155 my ($obj, $type) = @_;
157 $type = LOCK_EX unless defined $type;
159 if (!defined($self->{fh})) { return; }
161 if ($self->{locking}) {
162 if (!$self->{locked}) {
163 flock($self->{fh}, $type);
165 # refresh end counter in case file has changed size
166 my @stats = stat($self->{fh});
167 $self->{end} = $stats[7];
169 # double-check file inode, in case another process
170 # has optimize()d our file while we were waiting.
171 if (defined($self->{inode}) && $stats[1] != $self->{inode}) {
176 $obj->{engine}->setup_fh( $obj );
178 flock($self->{fh}, $type); # re-lock
180 # This may not be necessary after re-opening
181 $self->{end} = (stat($self->{fh}))[7]; # re-end
193 # If db locking is set, unlock the db file. See note in lock()
194 # regarding calling lock() multiple times.
199 if (!defined($self->{fh})) { return; }
201 if ($self->{locking} && $self->{locked} > 0) {
203 if (!$self->{locked}) { flock($self->{fh}, LOCK_UN); }
214 # Flush the filehandle
215 my $old_fh = select $self->{fh};
216 my $old_af = $|; $| = 1; $| = $old_af;