Author: jzucker
Date: Thu Mar 4 21:24:19 2004
New Revision: 188
Modified:
dbi/trunk/lib/DBD/DBM.pm
dbi/trunk/lib/DBD/File.pm
Log:
added file locking with flock(), tested on Debian
Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm (original)
+++ dbi/trunk/lib/DBD/DBM.pm Thu Mar 4 21:24:19 2004
@@ -247,6 +247,7 @@
package DBD::DBM::Statement;
############################
use base qw( DBD::File::Statement );
+use IO::File; # for locking only
use Fcntl;
# you must define open_table;
@@ -261,7 +262,6 @@
# between global, per-table, and default settings
#
sub open_table ($$$$$) {
- # NEED TO ADD FILE LOCKING
my($self, $data, $table, $createMode, $lockMode) = @_;
my $dbh = $data->{Database};
@@ -322,6 +322,12 @@
$tie_type = $dbm_type;
}
+ # open and flock the lockfile, creating it if necessary
+ #
+ my $lock_table = $self->DBD::File::Statement::open_table(
+ $data, "$table.lck", $createMode, $lockMode
+ ) or die "Couldn't open lockfile!\n";
+
eval { tie(%h, $tie_type, $file, $open_mode, 0666) }
unless $self->{command} eq 'DROP';
die "Cannot tie file '$file': $@" if $@;
@@ -350,6 +356,7 @@
dbm_type => $dbm_type,
store_metadata => $store,
mldbm => $serializer,
+ lock_fh => $lock_table->{fh},
col_nums => \%col_nums,
col_names => $col_names
};
@@ -438,7 +445,8 @@
unlink $self->{file}.$ext if -f $self->{file}.$ext;
unlink $self->{file}.'.dir' if -f $self->{file}.'.dir'
and $ext eq '.pag';
- # put code to delete lockfile here
+ $self->{lock_fh}->close if $self->{lock_fh};
+ unlink $self->{file}.'.lck' if -f $self->{file}.'.lck';
return 1;
}
@@ -464,26 +472,25 @@
}
return (@ary) if wantarray;
return [EMAIL PROTECTED];
-=pod
+
# fetch without %each
#
- $self->{keys} = [sort keys %{$self->{hash}}] unless $self->{keys};
- my $key = shift @{$self->{keys}};
- $key = shift @{$self->{keys}} if $self->{store_metadata}
- and $key
- and $key eq "_metadata \0";
- return undef unless defined $key;
- my @ary;
- $row = $self->{hash}->{$key};
- if (ref $row eq 'ARRAY') {
- @ary = ( $key, @{$row} );
- }
- else {
- @ary = ($key,$row);
- }
- return (@ary) if wantarray;
- return [EMAIL PROTECTED];
-=cut
+ # $self->{keys} = [sort keys %{$self->{hash}}] unless $self->{keys};
+ # my $key = shift @{$self->{keys}};
+ # $key = shift @{$self->{keys}} if $self->{store_metadata}
+ # and $key
+ # and $key eq "_metadata \0";
+ # return undef unless defined $key;
+ # my @ary;
+ # $row = $self->{hash}->{$key};
+ # if (ref $row eq 'ARRAY') {
+ # @ary = ( $key, @{$row} );
+ # }
+ # else {
+ # @ary = ($key,$row);
+ # }
+ # return (@ary) if wantarray;
+ # return [EMAIL PROTECTED];
}
# you must define push_row
@@ -541,8 +548,9 @@
#
sub DESTROY ($) {
my $self=shift;
- # code to release lock goes here
untie %{$self->{hash}} if $self->{hash};
+ # release the flock on the lock file
+ $self->{lock_fh}->close if $self->{lock_fh};
}
# truncate() and seek() must be defined to satisfy DBI::SQL::Nano
@@ -684,6 +692,14 @@
See the L<GOTCHAS AND WARNINGS> for using DROP on tables.
+=head2 Table locking and flock()
+
+Table locking is accomplished using a lockfile which has the same name as the table's
file but with the file extension '.lck'. This file is created along with the table
during a CREATE and removed during a DROP. Every time the table itself is opened, the
lockfile is flocked(). For SELECT, this is an shared lock. For all other operations,
it is an exclusive lock.
+
+Since the locking depends on flock(), it only works on operating systems that support
flock(). In cases where flock() is not implemented, DBD::DBM will not complain, it
will simply behave as if the flock() had occurred although no actual locking will
happen. Read the documentation for flock() if you need to understand this.
+
+Even on those systems that do support flock(), the locking is only advisory - as is
allways the case with flock(). This means that if some other program tries to access
the table while DBD::DBM has the table locked, that other program will *succeed* at
opening the table. DBD::DBM's locking only applies to DBD::DBM.
+
=head2 Specifying the DBM type
Each "flavor" of DBM stores its files in a different format and has different
capabilities and different limitations. See L<AnyDBM_File> for a comparison of DBM
types.
@@ -863,6 +879,8 @@
When using MLDBM, there is a very powerful serializer - it will allow you to store
Perl code or objects in database columns. When these get de-serialized, they may be
evaled - in other words MLDBM (or actually Data::Dumper when used by MLDBM) may take
the values and try to execute them in Perl. Obviously, this can present dangers, so
if you don't know what's in a file, be careful before you access it with MLDBM turned
on!
+See the entire section on L<Table locking and flock()> for gotchas and warnings about
the use of flock().
+
=head1 GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS
If you need help installing or using DBD::DBM, please write to the DBI users mailing
list at [EMAIL PROTECTED] or to the comp.lang.perl.modules newsgroup on usenet. I'm
afraid I can't always answer these kinds of questions quickly and there are many on
the mailing list or in the newsgroup who can.
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Thu Mar 4 21:24:19 2004
@@ -243,8 +243,6 @@
} elsif ($attrib eq (lc $attrib)) {
# Driver private attributes are lower cased
-=pod
-
# I'm not implementing this yet becuase other drivers may be
# setting f_ and sql_ attrs I don't know about
# I'll investigate and publicize warnings to DBD authors
@@ -254,15 +252,15 @@
# not implemented yet
# my $class = $dbh->FETCH('ImplementorClass');
#
- if ( !$dbh->{f_valid_attrs}->{$attrib}
- and !$dbh->{sql_valid_attrs}->{$attrib}
- ) {
- return $dbh->set_err( 1,"Invalid attribute '$attrib'!");
- }
- else {
- $dbh->{$attrib} = $value;
- }
-=cut
+ # if ( !$dbh->{f_valid_attrs}->{$attrib}
+ # and !$dbh->{sql_valid_attrs}->{$attrib}
+ # ) {
+ # return $dbh->set_err( 1,"Invalid attribute '$attrib'!");
+ # }
+ # else {
+ # $dbh->{$attrib} = $value;
+ # }
+
if ($attrib eq 'f_dir') {
return $dbh->set_err( 1,"No such directory '$value'!")
unless -d $value;
