Email::Fingerprint::App::EliminateDups - Implements eliminate-dups functionality

  $app = new Email::Fingerprint::App::EliminateDups;

  $app->run(@ARGV);

    perldoc Email::Fingerprint

package Email::Fingerprint::App::EliminateDups;

use warnings;
use strict;

use Class::Std;

use Carp qw( croak );
use File::Basename;
use Getopt::Long;

use Email::Fingerprint;
use Email::Fingerprint::Cache;

our $VERSION = '0.26';

# Attributes

my %dbname      : ATTR( :get<dbname> );                 # Fingerprint DB name
my %cache       : ATTR( :get<cache> );                  # Actual fingerprint DB

my %dump        : ATTR( :get<dump>,     :default<0> );  # Dump cache contents
my %help        : ATTR( :get<help>,     :default<0> );  # Print usage
my %no_check    : ATTR( :get<no_check>, :default<0> );  # Only purge
my %no_purge    : ATTR( :get<no_purge>, :default<0> );  # Only check
my %strict      : ATTR( :get<strict>,   :default<0> );  # Include body

sub BUILD {
    my ($self, $obj_ID, $arg_ref) = @_;

    $self->_init;
}

sub run {
    my $self = shift;

    $self->_process_options(@_);
    $self->open_cache;
    $self->dump_cache;              # No-op if --dump wasn't specified
    $self->check_fingerprint;       # No-op if --no-check option was specified
    $self->purge_cache;             # No-op if --no-purge option was specified
    $self->close_cache;

    # Success
    exit 0;
}

sub open_cache {
    my $self   = shift;
    my $cache  = $self->get_cache;
    my $dbname = $self->get_dbname || '';

    return $cache if $cache;

    # Initialize the cache
    $cache    = new Email::Fingerprint::Cache({
        file     => $dbname,
    });

    # Validate
    if ( not $cache ) {
        $self->_exit_retry( "Couldn't initialize cache \"$dbname\"" );
    }

    # Lock it
    if ( not $cache->lock( block => 1 ) ) {
        $self->_exit_retry( "Couldn't lock \"$dbname\": $!" );
    }

    # Open it
    if ( not $cache->open ) {
        $cache->unlock;
        $self->_exit_retry( "Couldn't open \"$dbname\": $!" );
    }

    $cache{ ident $self } = $cache;
    return $cache;
}

sub close_cache {
    my $self  = shift;
    my $cache = delete $cache{ ident $self };

    if ($cache) {
        $cache->unlock;
        $cache->close;
    }

    1;
}

sub dump_cache {
    my $self = shift;

    return unless $self->get_dump;
    return unless $self->get_cache;

    # Dump the contents of the hashfile in a human readable format
    $self->get_cache->dump;

    $self->close_cache;
    exit 0;
}

sub check_fingerprint {
    my $self = shift;

    return if $self->get_no_check;

    my $checksum =  new Email::Fingerprint({
        input           => \*STDIN,
        checksum        => "Digest::MD5",
        strict_checking => $self->get_strict,
    });

    my $fingerprint = $checksum->checksum;

    # If there's a match, suppress it with exit code 99.
    if (defined $self->get_cache->get_hash->{$fingerprint})
    {
        # Fingerprint matches. Tell qmail to stop current delivery.
        $self->close_cache;
        exit 99;
    }

    # Record the fingerprint
    $self->get_cache->get_hash->{$fingerprint} = time;
}

sub purge_cache {
    my $self = shift;
    
    return if $self->get_no_purge;

    $self->get_cache->purge;
}

sub _process_options :PRIVATE {
    my ( $self, @args ) = @_;

    # Fool Getopt::Long. Sigh.
    local @ARGV = @args;

    $self->_init;

    $self->_die_usage if not GetOptions(
        "dump"      => \$dump{ident $self},
        "no-purge"  => \$no_purge{ident $self},
        "no-check"  => \$no_check{ident $self},
        "strict"    => \$strict{ident $self},
        "help"      => \$help{ident $self},
    );

    # Respond to calls for help
    $self->_die_usage if $self->get_help;

    # Set the filename. If omitted, a default is used.
    $dbname{ident $self} = shift @ARGV if @ARGV;
}

sub _init :PRIVATE {
    my $self   = shift;
    my $obj_ID = ident $self;

    $dbname{$obj_ID}   = '.maildups';
    $self->close_cache; # A no-op if we don't have a cache yet

    $dump{$obj_ID}     = 0;
    $help{$obj_ID}     = 0;
    $no_purge{$obj_ID} = 0;
    $no_check{$obj_ID} = 0;
    $strict{$obj_ID}   = 0;
}

sub _die_usage :PRIVATE {
    my $self     = shift;
    my $progname = basename $0;

    $self->_exit_retry(
         "usage:\t$progname [--strict] [--no-purge] [hashfile]\n"
       . "\t$progname [--dump] [hashfile]\n"
       . "\t$progname [--no-check] [hashfile]"
    );
}

sub _exit_retry :PRIVATE {
    my ( $self, $message ) = @_;

    warn "$message\n";
    exit 111;
}

1; # End of Email::Fingerprint