File Coverage

blib/lib/MailX/Qmail/Queue/Message.pm

Criterion	Covered	Total	%
statement	14	30	46.6
branch	0	10	0.0
condition	0	3	0.0
subroutine	5	10	50.0
pod	4	4	100.0
total	23	57	40.3

use 5.014;
use warnings;

package MailX::Qmail::Queue::Message;

our $VERSION = '0.11';

use base 'Mail::Qmail::Queue::Message';

use Mail::Address;
use Mail::Header;

# Use inside-out attributes to avoid interference with base class:
my %header;

sub header {
    my $self = shift;
    return $header{$self} if exists $header{$self};
    open my $fh, '<', $self->body_ref or die 'Cannot read message';
    $header{$self} = Mail::Header->new($fh);
}

sub header_from {
    my $from = shift->header->get('From') or return;
    ($from) = Mail::Address->parse($from);
    $from;
}

sub helo {
    my $header = shift->header;
    my $received = $header->get('Received') or return;
    $received =~ /^from .*? \(HELO (.*?)\) /
      or $received =~ /^from (\S+) \(/
      or return;
    $1;
}

sub add_header {
    my $self = shift;
    ${$self->body_ref} = join "\n", @_, $self->body;
}

sub DESTROY {
    my $self = shift;
    delete $header{$self};
}

1;

__END__