package Mail::Audit::Bounce;
use Mail::Audit;
use vars qw(@VERSION);
$VERSION = '0.01';
1;

=head 1

Mail::Audit::Bounce - Recognize a mail as a bounce mail

=cut

package Mail::Audit;
use strict;

my $content_type = qr(report-type=delivery-status);
my $sender       = qr(Mail Delivery Subsystem <MAILER-DAEMON\@);

my @headers = (
  'X-Virus-Found'		=> [ qr/./, "Virus found"],		# header must be present
  'X-Tnz-Problem-Type'		=> [ qr/^40$/, "Virus found"],
  'X-Failed-Recipients'		=> [ qr/./, undef],
  'Auto-Submitted'		=> [ qr<auto-generated \(failure\)>,undef],
  'Content-Type'		=> [ qr<multipart/report; report-type=delivery-status;>ism,undef],
  'Content-Type'		=> [ qr<multipart/report; report-type=(["'])delivery-status\1;>ism,undef],
  'Received'			=> [ qr<\(qmail \d+ invoked for bounce\);>sm, undef],
);

sub __scan_delivery_report {
  my ($self) = @_;
  my @result;

  my @body;
  for my $line (@{$self->body}) {
    push @body, split /\n/, $line;
  };

  my $i = 0;
  while ($i < @headers) {
    my ($header,$r) = (@headers[$i,$i+1]);
    my ($content,$reason) = @$r;
    my @h = ($self->head->get($header), map { /^$header: (.*)$/ ? $1 : () } @body);
    for my $line (@h) {
      push @result, $reason
        if ($line =~ $content);
    };
    $i += 2;
  };

  @result;
};

sub __mime_parts {
  my ($self,$content_type) = @_;
  grep { ($_->head->get('Content-Type')||"") =~ /$content_type/i } ($self->parts)
};

sub is_bounce {
  my ($self) = @_;
  my @parts;
  my @reasons;

  push @reasons, "mailer daemon"
    if $self->from =~ $sender;
  my $i = 0;
  while ($i < @headers) {
    my ($header,$r) = (@headers[$i,$i+1]);
    my ($content,$reason) = @$r;
    my @h = $self->head->get($header);
    for my $line (@h) {
      push @reasons, $reason
        if ($line =~ $content);
    };
    $i += 2;
  };

  if ($self->is_mime) {
    @parts = $self->parts;
    foreach my $part ($self->__mime_parts('message/delivery-status')) {
      push @reasons, __scan_delivery_report($part)
    };
  };

  if (@reasons) {
    @reasons = grep { defined $_ } @reasons;
    @reasons = "unknown" unless @reasons;
  };

  @reasons;
};

=head2 C<< $message->original_message_id >>

This tries to find the original message id for a bounced
message. C<< is_bounce >> should be true before you ask
for the original message id.

It returns a list of candidates for the original message id.

=cut

sub original_message_id {
  my ($self) = @_;
  my %result;

  if ($self->is_mime) {
    # let's hope for the original message in
    # the 'message/rfc822' part
    foreach my $part ($self->__mime_parts('message/rfc822'),$self->__mime_parts('text/rfc822-headers')) {
      for (map { /^Message-Id: (.*)$/i ? $1 : () } @{ $part->body }) {
        $result{$_} = 1
      };
    };
  } else {
    for (map { /^Message-Id: (.*)$/i ? $1 : () } @{ $self->body }) {
      $result{$_} = 1
    };
  };

  keys %result;
};