Email::Fingerprint::Cache::AnyDBM - AnyDBM backend for Email::Fingerprint::Cache

    use Email::Fingerprint::Cache;

    my $foo = Email::Fingerprint::Cache->new({
        backend => 'AnyDBM',
    });
    ...

  $cache = new Email::Fingerprint::Cache::AnyDBM({
    file => $filename,  # Mandatory
  });

    $cache->open or die;

  $cache->lock or die;                  # returns immediately
  $cache->lock( block => 1 ) or die;    # Waits for a lock

  $cache->unlock or cluck "Unlock failed";

    perldoc Email::Fingerprint::Cache::AnyDBM

package Email::Fingerprint::Cache::AnyDBM;
use Class::Std;

use warnings;
use strict;

use Fcntl;
use AnyDBM_File;
use Carp qw(carp);
use File::Basename;
use LockFile::Simple;

our $VERSION = '0.01';

my %file :ATTR( :init_arg<file>, :set<file> ) = ();
my %hash :ATTR( :init_arg<hash> )             = ();
my %lock :ATTR                                = ();
my %mgr  :ATTR                                = ();

sub BUILD {
    my ( $self, $ident, $args ) = @_;

    $mgr{$ident} = LockFile::Simple->make(
        -nfs       => 1,
        -warn      => 0,
        -efunc     => undef,
        -autoclean => 1,
    );
}

sub open {
    my $self = shift;

    my $file = $file{ ident $self } || '';
    return unless $file;

    my $hash = $self->get_hash;

    tie %$hash, 'AnyDBM_File', $file, O_CREAT|O_RDWR, oct(600);

    if ( not $self->is_open ) {
        carp "Couldn't open $file";
        return;
    }

    1;
}

sub close {
    my $self = shift;

    return unless $self->is_open;

    untie %{ $self->get_hash };
}

sub is_open {
    my $self = shift;
    my $hash = $self->get_hash;

    return 0 unless defined $hash and ref $hash eq 'HASH';
    return 0 unless tied %{ $hash };
    return 1;
}

sub is_locked {
    my $self = shift;
    return defined $lock{ ident $self } ? 1 : 0;
}

sub lock {
    my $self = shift;
    my %opts = @_;

    return 1 if exists $lock{ ident $self };    # Success if already locked

    return unless defined $file{ ident $self }; # Can't lock nothing!
    my $file = $file{ ident $self };

    my $mgr = $mgr{ ident $self };

    # Minor validation that LockFile::Simple doesn't perform
    if (not -w dirname($file)) {
        warn "Directory " . dirname($file) . " is not writable\n";
        return;
    }

    # Perform the lock
    my $lock
        = $opts{block}
        ? $mgr->lock($file)
        : $mgr->trylock($file);
    return unless $lock;

    # Remember the lock
    $lock{ ident $self } = $lock;

    1;
}

sub unlock {
    my $self = shift;
    my $lock = delete $lock{ ident $self } or return 1; # Success if no lock

    $lock->release();

    1;
}

sub get_hash : PRIVATE {
    my $self = shift;
    return $hash{ ident $self };
}

1;