############################################################
# LimitMail.pm
############################################################
package LimitMail;

our $VERSION    = "1.01";
our $CVSVERSION = '$Revision: 1.3 $';

use Fcntl;
use NDBM_File;
use Log::Log4perl qw(:easy);
use File::Basename;
use Mail::Mailer;
use strict;
use warnings;

############################################################
sub new {
############################################################
    my($class, %options) = @_;
    
    my $self = { tracker_db     => "/tmp/limitmail",
                 send_interval  => 3600 * 24,
                 mailer_options => ['sendmail'],
                 %options,
               };

    DEBUG "Tying hash";

    tie my %tracker, "NDBM_File", $self->{tracker_db}, 
        O_RDWR|O_CREAT, 0644 or
       die "Cannot tie $self->{tracker_db}";

    $self->{tracker_hash} = \%tracker;

    return bless $self, $class;
}

############################################################
sub DESTROY {
############################################################
    my($self) = @_;

    DEBUG "Untying hash";
    untie %{$self->{tracker_hash}};
}

############################################################
sub mail {
############################################################
    my($self, $mailheaders, $body) = @_;

    my $to = $mailheaders->{To};

    if( $self->{tracker_hash}->{$to} and
          time() - $self->{tracker_hash}->{$to} <=
          $self->{send_interval} ) {
        INFO "*Not* mailing to $to\n";
        return;
    }

    INFO "Mailing to $to";
    my $m = Mail::Mailer->new(@{$self->{mailer_options}});
    $m->open($mailheaders) or die "$@";
    print $m $body;
    $m->close;

    $self->{tracker_hash}->{$to} = time();
}

############################################################
sub nuke_db {
############################################################
    my($self) = @_;
    
    %{$self->{tracker_hash}} = ();
}

1;

__END__

=head1 NAME

    LimitMail -- Send mail, but limit the amount per user

=head1 DOWNLOAD

_SRC_HERE_

=head1 SYNOPSIS

    use LimitMail;

    my $m = LimitMail->new();

    $m->mail({From    => 'from@from.com',
              To      => 'to@to.com',
              Subject => 'test mail',
             }, "Hey, there!");

=head1 DESCRIPTION

C<LimitMail> sends out mail, but keeps track of the recipients
and limits the number of mails they're getting.

Typical uses of LimitMail are applications sending out
automatic notification emails. If a system goes berserk and keeps sending
out emails, we don't want to fill up the user's mailbox. Instead, the 
first message should be sent and subsequent mail requests should be 
discarded until a selectable time period is over.

=over 4

=item my $m = LimitMail-E<gt>new()

This function takes a couple of optional parameters. If they're all omitted,
they default to the following values:

    my $m = LimitMail->new(
        tracker_db     => "/tmp/limitmail",
        send_interval  => 3600 * 24,
        mailer_options => ['sendmail'],
    );

C<tracker_db> specifies 
the base of the C<NDBM> file which LimitMail uses internally
as a persistent store for who got mail and when.
It defaults to C</tmp/limitmail>, resulting in two NDBM files
C</tmp/limitmail.dir> and C</tmp/limitmail.pag>.

C<send_interval> specifies the time interval in which Limitmail will
discard messages instead of sending them after a message has been submitted.
It defaults to 3600 * 24 (one day).

C<mailer_options> is a reference to an array, containing parameters which
will be used by Limitmail internally to construct a C<Mail::Mailer> 
object. Check the C<Mail::Mailer> documentation for details. It defaults to
C<['sendmail']>.

=item $m->mail($mailoptions, $body)

C<mail()> triggers email to be sent out -- if the restrictions allow it.
In C<$mailoptions>, it takes a reference to a hash to the mail headers as
Mail::Mailer expects them. Typical values are:

    { From    => 'from@from.com',
      To      => 'to@to.com',
      Cc      => 'cc@cc.com',
      Bcc     => 'bcc@bcc.com',
      Subject => 'my subject mail',
    }

C<$body> holds the message of the mail to be sent out as a string, lines
are devided by newlines.

=item $m->nuke_db()

Nukes the tracker DB. It won't delete the file(s), but will assign an
empty list to the persistent hash.

=back

=head1 LEGALESE

Copyright 2002 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

2002, Mike Schilli <m@perlmeister.com>