Hey,
I'm working on a new module to be used for mod_perl style
caching. I'm calling it MLDBM::Sync because its a subclass
of MLDBM that makes sure concurrent access is serialized with
flock() and i/o flushing between reads and writes. Below is
the code for the module. I believe it could be used too as a
safe backing store for Memoize in a multi-process environment.
It could be used like:
tie %mldbm, 'MLDBM::Sync', '/tmp/mldbm_dbm', O_CREAT|O_RDWR, 0666;
$mldbm{rand()} = [ rand() ];
%mldbm = ();
The history is that I hunted around for on disk caching in
which I can stuff db query results temporarily, and the best I
liked was File::Cache, which is really cool BTW. I would use it,
but MLDBM::Sync using default SDBM_File seems to be 2 to 3 times
faster, getting about 1000 writes / sec on my dual PIII 400.
MLDBM::Sync using MLDBM in DB_File mode is considerably slower
than File::Cache, by 5-10 times, so it really depends on the
data you want to store, for which you might use. The 1024 byte
limit on SDBM_File makes it often not the right choice.
I also thought about calling it MLDBM::Lock, MLDBM::Serialize,
MLDBM::Multi ... I like MLDBM::Sync though. For modperl
caching usage, I imagine tieing to it in each child, and clearing
when necessary, perhaps even at parent httpd initialization...
no auto-expiration here, use File::Cache, IPC::Cache for that!
Any thoughts?
--Joshua
_________________________________________________________________
Joshua Chamas Chamas Enterprises Inc.
NodeWorks >> free web link monitoring Huntington Beach, CA USA
http://www.nodeworks.com 1-714-625-4051
package MLDBM::Sync;
use MLDBM;
use Fcntl qw(:flock);
use strict;
no strict qw(refs);
use vars qw($AUTOLOAD);
sub TIEHASH {
my($class, $file, @args) = @_;
my $fh = "$file.lock";
open($fh, ">>$fh") || die("can't open file $fh: $!");
bless {
'args' => [ $file, @args ],
'lock' => $fh,
'keys' => [],
};
}
sub DESTROY {
my $self = shift;
if (($self->{lock})) {
close($self->{lock})
}
}
sub AUTOLOAD {
my $self = shift;
$AUTOLOAD =~ /::([^:]+)$/;
my $func = $1;
$self->exlock;
my $rv = $self->{dbm}->$func(@_);
$self->unlock;
$rv;
}
sub STORE {
my $self = shift;
$self->exlock;
my $rv = $self->{dbm}->STORE(@_);
$self->unlock;
$rv;
};
sub FETCH {
my $self = shift;
$self->shlock;
my $rv = $self->{dbm}->FETCH(@_);
$self->unlock;
$rv;
};
sub FIRSTKEY {
my $self = shift;
$self->shlock;
$self->{keys} = [ keys %{$self->{dbm_hash}} ];
$self->unlock;
$self->NEXTKEY;
}
sub NEXTKEY {
shift(@{shift->{keys}});
}
sub mldbm_tie {
my $self = shift;
my $args = $self->{args};
my %dbm_hash;
my $dbm = tie(%dbm_hash, 'MLDBM', @$args) || die("can't tie to MLDBM with args:
".join(',', @$args)."; error: $!");
$self->{dbm_hash} = \%dbm_hash;
$self->{dbm} = $dbm;
}
sub exlock {
my $self = shift;
flock($self->{lock}, LOCK_EX) || die("can't write lock $self->{lock}: $!");
$self->mldbm_tie;
}
sub shlock {
my $self = shift;
flock($self->{lock}, LOCK_SH) || die("can't share lock $self->{lock}: $!");
$self->mldbm_tie;
}
sub unlock {
my $self = shift;
undef $self->{dbm};
untie %{$self->{dbm_hash}};
flock($self->{lock}, LOCK_UN) || die("can't unlock $self->{lock}: $!");
}
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]