view release on metacpan or  search on metacpan

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

=cut

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

    # Default hash is a fresh-n-tasty anonymous hash
    $hash{$ident} = defined $args->{hash} ? $args->{hash} : {};

    # Backend will also need access to the hash
    $args->{hash} = $hash{$ident};

    # Default backend is AnyDBM
    my $backend = defined $args->{backend} ? $args->{backend} : 'AnyDBM';

    # Default cache file
    $args->{file} ||= '.maildups';

    # Try accessing package as a subclass of Email::Fingerprint::Cache
    my $package = __PACKAGE__ . "::" . $backend;
    eval "use $package";                                    ## no critic

    # Try accessing package using the given name exactly. If this fails,
    # we try constructing a backend anyway, in case the module is already
    # imported--or, e.g., defined in the script file itself.
    if ($@) {
        $package = $backend;
        eval "use $package";                                ## no critic
    }

    undef $backend;

    # Perhaps the correct module was loaded by our caller;
    # try instantiating the backend even if the above steps
    # all failed.
    eval {
        $backend =  $package->new({
            file => $args->{file},
            hash => $args->{hash},
        });
    };

    # It's a fatal error if the backend doesn't load
    croak "Can't load backend module" if $@ or not $backend;

    $backend{$ident} = $backend;
}

=head2 set_file

  $file = $cache->set_file( 'foo' ) or die "Failed to set filename";
  # now $file eq 'foo.db' or 'foo.dir', etc., depending on the backend;
  # it is almost certainly NOT 'foo'.

Sets the file to be used for the cache. Returns the actual filename
on success; false on failure.

The actual filename will probably differ from the 'foo', because
the backend will usually add an extension or otherwise munge it.

C<set_file> has I<no> effect while the cache file is locked or open!

=cut

sub set_file {
    my ($self, $file) = @_;

    # Validation
    return if $self->get_backend->is_locked;
    return if $self->get_backend->is_open;

    # OK, there's no harm in changing the file attribute
    $self->get_backend->set_file($file);

    1; 
}

=head2 get_backend

Returns the backend object for this cache.

=cut

sub get_backend :PRIVATE() {
    my $self = shift;
    return $backend{ident $self};
}

=head2 dump

    # Be a good citizen
    $cache->lock;
    $cache->open;

    $cache->dump;

    # Be a good neighbor
    $cache->close;
    $cache->unlock;

Dump a human-readable version of the contents of the cache. Data is
printed in timestamp order.

The cache I<must> first be opened, and I<should> first be locked.

=cut

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

    for my $key ( sort { $hash->{$a} <=> $hash->{$b} } keys %$hash )
    {
        my $value = $hash->{$key};
        print "$value\t", scalar gmtime $value, "\t$key\n";
    }
}

=head2 open

    $cache->open or die;

Open the cache file, and tie it to a hash. This is delegated to the
backend.

=cut

sub open {
    my $self = shift;

    return $self->_delegate( "open", @_ );
}

=head2 close

  $cache->close;

Close the cache file and untie the hash.

=cut

sub close {
    my $self = shift;

    return $self->_delegate( "close", @_ );
}

=head2 lock

  $cache->lock or die;                  # returns immediately
  $cache->lock( block => 1 ) or die;    # Waits for a lock
  $cache->lock( %opts ) or die;         # Backend-specific options

Lock the DB file to guarantee exclusive access.

=cut

sub lock {
    my $self = shift;

    return $self->_delegate( "lock", @_ );
}

=head2 unlock