On Fri, 17 Nov 2000, Joshua Chamas wrote:
> 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.
I looked through the code and couldn't see how you are doing i/o
flushing. This is more of an issue with Berkeley DB than SDBM I think,
since Berkeley DB will cache things in memory. Can you point to me it?
Also, I'm confused on the usage. Do you open the dbm file and keep it
open, or do you tie/untie on every request?
> Any thoughts?
You might want to look at the Mason caching API. It would be nice to make
an interface like that available on top of a module like this.
- Perrin
> 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]
