File Coverage

blib/lib/Siesta/Message.pm

Criterion	Covered	Total	%
statement	65	70	92.8
branch	5	6	83.3
condition	12	20	60.0
subroutine	17	18	94.4
pod	7	9	77.7
total	106	123	86.1

use strict;
package Siesta::Message;
use Siesta;
use Siesta::Deferred;
use Mail::Address;
use Carp qw( carp croak );
use Storable qw(dclone);
use base qw( Email::Simple Class::Accessor::Fast );
__PACKAGE__->mk_accessors(qw( plugins ));

=head1 NAME

Siesta::Message - a message in the system

=head1 METHODS

=cut

# make a bunch of header-based accessors
for (qw( to_raw from_raw subject )) {
    my $header = $_;
    my $sub_name = $header;
    $header   =~ s/_raw$//;
    my $sub = sub {
        my $self = shift;
        if (@_) {
            $self->header_set( $header, shift );
        }
        return $self->header( $header );
    };
    no strict 'refs';
    *{ $sub_name } = $sub;
}

sub new {
    my $referent = shift;
    my $class = ref $referent || $referent;
    my $data  = shift || "";

    if (ref $data eq 'GLOB') {
        $data = join '', <$data>;
    }
    # chomp out From_ lines from naughty MTAs
    $data =~ s/^From .+$//m;

    my $self = $class->SUPER::new( $data );
    $self->plugins( [] );
    return $self;
}


=head2 to

a list of addresses that the message was to

=cut

sub to {
    my $self = shift;
    map { $_->address } Mail::Address->parse( $self->header('To') );
}

=head2 from

the email address that the message was from

=cut

sub from {
    my $self = shift;

    ( map { $_->address } Mail::Address->parse( $self->header('From') ) )[0];
}

=head2 subject

=head2 reply

=cut

sub reply {
    my $self  = shift;
    my %args  = @_;

    my $new = Siesta::Message->new;
    $new->body_set( $args{body} || $self->body );
    $new->header_set( 'To',          $args{to}      || $self->from );
    $new->header_set( 'From',        $args{from}    || ( $self->to )[0] );
    $new->header_set( 'Subject',     $args{subject} ||
                        "Re: " . ( $self->subject || "Your mail" ) );
    $new->header_set( 'In-Reply-To', $self->header( 'Message-Id' ) );

    $new->send;
    Siesta->log("Message->reply sending" . $new->as_string, 10);
}

=head2 send

=cut

sub send {
    my $self = shift;
    return Siesta->sender->send( $self, @_ );
}

=head2 clone

=cut

sub clone {
    my $self = shift;

    return dclone $self;
}

=head2 defer

=cut

sub defer {
    my $self = shift;

    Siesta::Deferred->create({
        @_,
        plugins => join(',', @{ $self->plugins } ),
        message => $self,
    });
}


# XXX compatibility shim, excise soonest
sub resume {
    my $self = shift;
    my $id   = shift;

    carp "Siesta::Message->resume is deprected, use resume on a Siesta::Deferred object instead";
    my $deferred = Siesta::Deferred->retrieve( $id );
    $deferred->resume;
}

sub process {
    my $self = shift;

    while ( my $plugin = shift @{ $self->plugins } ) {
        # SIESTA_NON_STOP is used by 20fullsend.t to ensure
        # excercising of everything. it means "run the next plugin,
        # even if the last one said to stop"
        Siesta->log("... doing " . $plugin->name, 1);
        return if $plugin->process($self) && !$ENV{SIESTA_NON_STOP};
    }
}

1;