Siesta::Message - a message in the system


Siesta documentation Contained in the Siesta distribution.

Index


Code Index:

NAME

Top

Siesta::Message - a message in the system

METHODS

Top

to

a list of addresses that the message was to

from

the email address that the message was from

subject

reply

send

clone

defer


Siesta documentation Contained in the Siesta distribution.
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 ));

# 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;
}


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

sub from {
    my $self = shift;

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

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);
}

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

sub clone {
    my $self = shift;

    return dclone $self;
}

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;