#-*- perl -*-
#
#  Copyright (C) 2001,2002,2003,2004,2005,2006 Ken'ichi Fukamachi
#   All rights reserved. This program is free software; you can
#   redistribute it and/or modify it under the same terms as Perl itself.
#
# $FML: Qmail.pm,v 1.13 2005/08/19 12:17:11 fukachan Exp $
#


package Mail::Bounce::Qmail;

use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Carp;

@ISA = qw(Mail::Bounce);

=head1 NAME

Mail::Bounce::Qmail - Qmail error message format parser.

=head1 SYNOPSIS

=head1 DESCRIPTION

Parse bounce messages generated by qmail.

Qmail actually has a standard, called QSBMF (qmail-send bounce message
format), as describbed in

    http://cr.yp.to/proto/qsbmf.txt

=cut


# Descriptions: parse qmail error message.
#    Arguments: OBJ($self) OBJ($msg) HASH_REF($result)
# Side Effects: update $result
# Return Value: none
sub analyze
{
    my ($self, $msg, $result) = @_;
    my $state       = 0;
    my $pattern     = 'Hi. This is the';
    my $end_pattern = '--- Undelivered message follows ---';

    # search data
    my ($addr, $reason);
    my $m = $msg->{ next };
    do {
	if (defined $m) {
	    my $total = $m->paragraph_total;
	    for ( my $i = 0; $i < $total ; $i++ ) {
		my $data = $m->nth_paragraph( $i + 1 );

		if ($data =~ /$pattern/o)     { $state = 1;}
		if ($data =~ /$end_pattern/o) { $state = 0;}

		if ($state == 1) {
		    $data =~ s/\n/ /go;
		    if ($data =~ /\<(\S+\@\S+)\>:\s*(.*)/) {
			($addr, $reason) = ($1, $2);
			$addr = $self->address_cleanup($addr, $addr);

			my $status = '5.x.y';
			if ($data =~ /\#(\d+\.\d+\.\d+)/) {
			    $status = $1;
			}
			elsif ($data =~ /\s+(\d{3})\s+/) {
			    my $code = $1;
			    $status  = '5.x.y' if $code =~ /^5/o;
			    $status  = '4.x.y' if $code =~ /^4/o;
			}

			$result->{ $addr }->{ 'Diagnostic-Code' } = $reason;
			$result->{ $addr }->{ 'Status' }          = $status;
			$result->{ $addr }->{ 'hints' }           = 'qmail';
		    }
		}
	    }
	}

	$m = $m->{ next };
    } while (defined $m);

    $result;
}


=head1 CODING STYLE

See C<http://www.fml.org/software/FNF/> on fml coding style guide.

=head1 AUTHOR

Ken'ichi Fukamachi

=head1 COPYRIGHT

Copyright (C) 2001,2002,2003,2004,2005,2006 Ken'ichi Fukamachi

All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.

=head1 HISTORY

Mail::Bounce::Qmail first appeared in fml8 mailing list driver package.
See C<http://www.fml.org/> for more details.

=cut


1;