Apache::Quota::BerkeleyDB - Uses BerkeleyDB to lock the quota db file

  PerlSetVar  QuotaLocker  BerkeleyDB

package Apache::Quota::BerkeleyDB;

use strict;

use BerkeleyDB qw( DB_CREATE DB_RDONLY DB_INIT_LOCK DB_INIT_MPOOL );
use File::Basename ();

sub _open_db
{
    my $class = shift;
    my %p = @_;

    my $env = BerkeleyDB::Env->new( -Home  => File::Basename::dirname( $p{file} ),
                                    -Flags => DB_INIT_LOCK|DB_INIT_MPOOL,
                                  );

    # BerkeleyDB doesn't allow you to open a db with both DB_CREATE
    # and DB_RDONLY specified, so if it doesn't exist we need to
    # create it now.
    unless ( -f $p{file} )
    {
        BerkeleyDB::Hash->new( -Filename => $p{file},
                               -Flags    => DB_CREATE,
                               -Mode     => 0644,
                               -Env      => $env,
                             );
    }

    my $flags;
    $flags = DB_RDONLY if $p{mode} eq 'read';

    my %db;
    tie %db, 'BerkeleyDB::Hash', ( -Filename => $p{file},
                                   -Flags    => $flags,
                                   -Mode     => 0644,
                                   -Env      => $env,
                                 );

    die "Cannot tie to $p{file} with BerkeleyDB: $BerkeleyDB::Error"
        unless tied %db;

    return \%db;
}


1;

__END__