package Email::Filter;
use Email::LocalDelivery;
use Email::Simple;

use Class::Trigger;
use IPC::Run qw(run);

use strict;

use constant DELIVERED => 0;
use constant TEMPFAIL  => 75;
use constant REJECTED  => 100;

$Email::Filter::VERSION = "1.01";

=head1 NAME

Email::Filter - Library for creating easy email filters

=head1 SYNOPSIS

    use Email::Filter;
    my $mail = Email::Filter->new(emergency => "~/emergency_mbox");
    $mail->pipe("listgate p5p")            if $mail->from =~ /perl5-porters/;
    $mail->accept("perl")                  if $mail->from =~ /perl/;
    $mail->reject("We do not accept spam") if $mail->rblcheck();
    $mail->ignore                          if $mail->subject =~ /boring/i;
    ...
    $mail->exit(0);
    $mail->accept("~/Mail/Archive/backup");
    $mail->exit(1);
    $mail->accept()

=head1 DESCRIPTION

This is another module produced by the "Perl Email Project", a reaction
against the complexity and increasing bugginess of the "Mail::*"
modules. It replaces C<Mail::Audit>, and allows you to write programs
describing how your mail should be filtered.

=head1 TRIGGERS

Users of C<Mail::Audit> will note that this class is much leaner than
the one it replaces. For instance, it has no logging; the concept of
"local options" has gone away, and so on. This is a deliberate design
decision to make the class as simple and maintainable as possible.

To make up for this, however, C<Email::Filter> contains a trigger
mechanism provided by L<Class::Trigger>, to allow you to add your own
functionality. You do this by calling the C<add_trigger> method:

    Email::Audit->add_trigger( after_accept => \&log_accept );

Hopefully this will also help subclassers.

The methods below will list which triggers they provide.

=head1 ERROR RECOVERY

If something bad happens during the C<accept> or C<pipe> method, or
the C<Email::Filter> object gets destroyed without being properly
handled, then a fail-safe error recovery process is called. This first
checks for the existence of the C<emergency> setting, and tries to
deliver to that mailbox. If there is no emergency mailbox or that
delivery failed, then the program will either exit with a temporary
failure error code, queuing the mail for redelivery later, or produce a
warning to standard error, depending on the status of the C<exit>
setting.

=cut

sub done_ok {
    my $self = shift;
    $self->{delivered} = 1;
    exit DELIVERED unless $self->{noexit};
}

sub fail_badly {
    my $self = shift;
    $self->{giveup} = 1; # Don't get caught by DESTROY
    exit TEMPFAIL unless $self->{noexit};
    warn "Message ".$self->simple->header("Message-ID").
          "was never handled properly\n";
}

sub fail_gracefully {
    my $self = shift;
    if ($self->{emergency} and $self->accept($self->{emergency})) {
        $self->done_ok; # That worked.
    }
    $self->fail_badly;
}

sub DESTROY {
    my $self = shift;
    return if $self->{delivered}   # All OK.
           or $self->{giveup}      # Tried emergency, didn't work.
           or !$self->{emergency}; # Not much we can do.
    $self->fail_gracefully();
}

=head1 METHODS

=head2 new

    Email::Filter->new();                # Read from STDIN
    Email::Filter->new(data => $string); # Read from string

    Email::Filter->new(emergency => "~simon/urgh");
    # Deliver here in case of error

This takes an email either from standard input, the usual case when
called as a mail filter, or from a string.

You may also provide an "emergency" option, which is a filename to
deliver the mail to if it couldn't, for some reason, be handled
properly.

=over 3

=item Hint

If you put your constructor in a C<BEGIN> block, like so:

    use Email::Filter;
    BEGIN { $item = Email::Filter->new(emergency => "~simon/urgh"); }

right at the top of your mail filter script, you'll even be protected
from losing mail even in the case of syntax errors in your script. How
neat is that?

=back

This method provides the C<new> trigger, called once an object is
instantiated.

=cut

sub new {
    my $class = shift;
    my %stuff = @_;
    my $data;

    {
    local $/;
    $data = exists $stuff{data} ? $stuff{data} : scalar <STDIN>;
    # shave any leading From_ line
    $data =~ s/^From .*?[\x0a\x0d]//
    }

    my $obj = bless {
        mail       => Email::Simple->new($data),
        emergency  => $stuff{emergency},
        noexit     => ($stuff{noexit} || 0)
    }, $class;
    $obj->call_trigger("new");
    return $obj;
}

=head2 exit

    $mail->exit(1|0);

Sets or clears the 'exit' flag which determines whether or not the
following methods exit after successful completion.

The sense-inverted 'noexit' method is also provided for backwards
compatibility with C<Mail::Audit>, but setting "noexit" to "yes" got a
bit mind-bending after a while.

=cut

sub exit { $_[0]->{noexit} = !$_[1]; }
sub noexit { $_[0]->{noexit} = $_[1]; }

=head2 simple

    $mail->simple();

Gets and sets the underlying C<Email::Simple> object for this filter;
see L<Email::Simple> for more details.

=cut

sub simple {
    my ($filter, $mail) = @_;
    if ($mail) { $filter->{mail} = $mail; }
    return $filter->{mail};
}

=head2 header

    $mail->header("X-Something")

Returns the specified mail headers. In scalar context, returns the
first such header; in list context, returns them all.

=cut

sub header { my ($mail, $head) = @_; $mail->simple->header($head); }

=head2 body

    $mail->body()

Returns the body text of the email

=cut

sub body { $_[0]->simple->body }

=head2 from

=head2 to

=head2 cc

=head2 bcc

=head2 subject

=head2 received

    $mail-><header>()

Convenience accessors for C<header($header)>

=cut

{ no strict 'refs';
for my $head (qw(From To CC Bcc Subject Received)) {
    *{lc $head} = sub { $_[0]->header($head) }
}
}

=head2 ignore

Ignores this mail, exiting unconditionally unless C<exit> has been set
to false.

This method provides the "ignore" trigger.

=cut

sub ignore {
    $_[0]->call_trigger("ignore");
    $_[0]->done_ok;
}

=head2 accept

    $mail->accept();
    $mail->accept(@where);

Accepts the mail into a given mailbox or mailboxes.
Unix C<~/> and C<~user/> prefices are resolved. If no mailbox is given,
the default is determined according to L<Email::LocalDelivery>:
C<$ENV{MAIL}>, F</var/spool/mail/you>, F</var/mail/you>, or
F<~you/Maildir/>.

This provides the C<before_accept> and C<after_accept> triggers, and
exits unless C<exit> has been set to false.

=cut

sub accept {
    my ($self, @boxes) = @_;
    $self->call_trigger("before_accept");
    # Unparsing and reparsing is so fast we prefer to do that in order
    # to keep to LocalDelivery's clean interface.
    if (Email::LocalDelivery->deliver($self->simple->as_string, @boxes)) {
        $self->call_trigger("after_accept");
        $self->done_ok;
    } else {
        $self->fail_gracefully();
    }
}

=head2 reject

    $mail->reject("Go away!");

This rejects the email; if called in a pipe from a mail transport agent, (such
as in a F<~/.forward> file) the mail will be bounced back to the sender as
undeliverable. If a reason is given, this will be included in the bounce.

This calls the C<reject> trigger. C<exit> has no effect here.

=cut

sub reject {
    my $self = shift;
    $self->call_trigger("reject");
    $self->{delivered} = 1;
    $! = REJECTED; die @_,"\n";
}

=head2 pipe

    $mail->pipe('sendmail foo@bar.com');

Pipes the mail to an external program, returning the standard output from
that program if C<exit> has been set to false. This allows you to do things like

    $mail->exit(0);
    $mail->simple(Email::Simple->new($mail->pipe("spamassassin")));
    $mail->exit(1);

in the absence of decent C<Mail::SpamAssassin> support. (Coming soon...)

If the program returns a non-zero exit code, the behaviour is dependent
on the status of the C<exit> flag. If this flag is set to true (the
default), then C<Email::Filter> tries to recover. (See L</Error Recovery>)
If not, nothing is returned.

=cut

sub pipe {
    my ($self, @program) = @_;
    my $stdout;
    my $string = $self->simple->as_string;
    $self->call_trigger("pipe");
    if (run(\@program, \$string, \$stdout)) {
        $self->done_ok;
        return $stdout;
    }
    $self->fail_gracefully() unless $self->{noexit};
    return;
}

=head1 COPYRIGHT

    Copyright 2003, Simon Cozens <simon@cpan.org>

=head1 LICENSE

You may use this module under the terms of the BSD, Artistic, or GPL licenses,
any version.

=head1 AUTHOR

Simon Cozens, C<simon@cpan.org>

=cut

1;