view release on metacpan or  search on metacpan

lib/Email/Fingerprint/Cache/AnyDBM.pm  view on Meta::CPAN

    );
}

=head2 open

    $cache->open or die;

Open the associated file, and tie it to our hash. This method does not
lock the file, nor unlock it on failure. See C<lock> and C<unlock>.

=cut

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;
}

=head2 close

Unties the hash, which causes the underlying DB file to be written and
closed.

=cut

sub close {
    my $self = shift;

    return unless $self->is_open;

    untie %{ $self->get_hash };
}

=head2 is_open

Returns true if the cache is open; false otherwise.

=cut

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;
}

=head2 is_locked

Returns true if the cache is locked; false otherwise.

=cut

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

=head2 lock

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

Lock the DB file. Returns false on failure, true on success.

=cut

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;
}

=head2 unlock

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

Unlocks the DB file. Returns false on failure, true on success.

=cut

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

    $lock->release();

    1;
}

=head1 PRIVATE METHODS

=head2 get_hash

Returns a reference to the hash which is tied to the backend storage.

=cut

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

=head1 AUTHOR

Len Budney, C<< <lbudney at pobox.com> >>

=head1 BUGS