1 package DBM::Deep::File;
8 our $VERSION = q(1.0010);
10 use Fcntl qw( :DEFAULT :flock :seek );
11 use FileHandle::Fmode ();
26 #XXX Migrate this to the engine, where it really belongs.
27 filter_store_key => undef,
28 filter_store_value => undef,
29 filter_fetch_key => undef,
30 filter_fetch_value => undef,
33 # Grab the parameters we want to use
34 foreach my $param ( keys %$self ) {
35 next unless exists $args->{$param};
36 $self->{$param} = $args->{$param};
39 if ( $self->{fh} && !$self->{file_offset} ) {
40 $self->{file_offset} = tell( $self->{fh} );
43 $self->open unless $self->{fh};
51 # Adding O_BINARY should remove the need for the binmode below. However,
52 # I'm not going to remove it because I don't have the Win32 chops to be
53 # absolutely certain everything will be ok.
54 my $flags = O_CREAT | O_BINARY;
56 if ( !-e $self->{file} || -w _ ) {
64 sysopen( $fh, $self->{file}, $flags )
65 or die "DBM::Deep: Cannot sysopen file '$self->{file}': $!\n";
68 # Even though we use O_BINARY, better be safe than sorry.
71 if ($self->{autoflush}) {
94 unless ( defined $self->{inode} ) {
95 my @stats = stat($self->{fh});
96 $self->{inode} = $stats[1];
97 $self->{end} = $stats[7];
109 my $fh = $self->{fh};
110 if ( defined $loc ) {
111 seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
114 print( $fh @_ ) or die "Internal Error (print_at($loc)): $!\n";
121 my ($loc, $size) = @_;
125 my $fh = $self->{fh};
126 if ( defined $loc ) {
127 seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
131 read( $fh, $buffer, $size);
149 #XXX Do I need to reset $self->{end} here? I need a testcase
150 my $loc = $self->{end};
151 $self->{end} += $size;
157 # If db locking is set, flock() the db file. If called multiple
158 # times before unlock(), then the same number of unlocks() must
159 # be called before the lock is released.
163 my ($obj, $type) = @_;
165 $type = LOCK_EX unless defined $type;
167 #XXX This is a temporary fix for Win32 and autovivification. It
168 # needs to improve somehow. -RobK, 2008-03-09
169 if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) {
173 if (!defined($self->{fh})) { return; }
175 #XXX This either needs to allow for upgrading a shared lock to an
176 # exclusive lock or something else with autovivification.
178 if ($self->{locking}) {
179 if (!$self->{locked}) {
180 flock($self->{fh}, $type);
182 # refresh end counter in case file has changed size
183 my @stats = stat($self->{fh});
184 $self->{end} = $stats[7];
186 # double-check file inode, in case another process
187 # has optimize()d our file while we were waiting.
188 if (defined($self->{inode}) && $stats[1] != $self->{inode}) {
193 $obj->{engine}->setup_fh( $obj );
195 flock($self->{fh}, $type); # re-lock
197 # This may not be necessary after re-opening
198 $self->{end} = (stat($self->{fh}))[7]; # re-end
210 # If db locking is set, unlock the db file. See note in lock()
211 # regarding calling lock() multiple times.
216 if (!defined($self->{fh})) { return; }
218 if ($self->{locking} && $self->{locked} > 0) {
220 if (!$self->{locked}) { flock($self->{fh}, LOCK_UN); }
231 # Flush the filehandle
232 my $old_fh = select $self->{fh};
233 my $old_af = $|; $| = 1; $| = $old_af;
241 return FileHandle::Fmode::is_W( $self->{fh} );
246 my ($temp_filename) = @_;
248 my @stats = stat( $self->{fh} );
249 my $perms = $stats[2] & 07777;
252 chown( $uid, $gid, $temp_filename );
253 chmod( $perms, $temp_filename );