Mail::Action - base for building modules that act on incoming mail

Mail-Action documentation Contained in the Mail-Action distribution.

Index

Code Index:

NAME

Top

Mail::Action - base for building modules that act on incoming mail

SYNOPSIS

Top

    use base 'Mail::Action';

DESCRIPTION

Top

E-mail doesn't have to be boring. If you have server-side filters, a bit of disk space, some cleverness, and access to an outgoing SMTP server, you can do some very clever things. Want a temporary mailing list? Try Mail::SimpleList. Want a temporary, mostly-anonymous mailing address? Try Mail::TempAddress. Want to build your own similar program? Read on.

Mail::Action, Mail::Action::Address, Mail::Action::Request, and Mail::Action::Storage make it easy to create a other modules that receive, filter, and respond to incoming e-mails.

METHODS

Top

* new( $address_directory, [ Filehandle => $fh, Storage => $storage, Request => $request ] )

new() takes one mandatory argument and three optional arguments. $address_directory is the path to the directory where address data is stored. You can usually get by with just the mandatory argument.

$fh is a filehandle (or a reference to a glob) from which to read an incoming message. If not provided, M::TA will read from STDIN, as that is how mail filters work.

$storage should be a Mail::Action::Storage object (or workalike), which manages the storage of action data. If not provided, Mail::Action will use Mail::Action::Storage by default.

$request should be a Mail::Action::Request object (representing and encapsulating an incoming e-mail message) to the constructor. If not provided, M::TA will use Mail::Action::Request by default.

* process()

Processes one incoming message.

* find_command()

Looks in the Subject header of the incoming message for a command (a word contained within asterisks, such as *help*. If it finds this, it checks to see if the current object can perform a method named command_command, where command is the command found. If so, it returns the name of that method.

If not, it returns an empty string.

* copy_headers()

Copies, cleans, and returns a hash reference of headers from the incoming message.

* command_help( $pod, @headings )

Given $pod, POD documentation, and @headings, and list of headings within the POD, extracts the POD within those headings, turns it into plain text, and e-mails that text to the From address of the incoming message.

* process_body( $address )

Looks for lines of the form:

    Directive: arguments

at the start of the body of the incoming message. If the $address object (likely Mail::Action::Address or equivalent) understands the directive, this method calls the method with the name of the directive on the address object, passing the arguments.

This stops looking for directives when it encounters a blank line.

* reply( $headers, @body )

Given a hash reference of e-mail $headers and a list of lines of @body text, sends a message via Mail::Mailer. Be sure you've configured that correctly.

SUBCLASSING

Top

In addition to the methods described earlier, you may want to override any of the other methods:

fetch_address()

Attempts to retrieve the address for the associated alias, if it exists. In scalar context, returns just the address. In list context, returns the address and the alias. If the address does not exist, returns nothing.

message()

Returns the Email::MIME object associated with this request.

request()

Returns the request object for this object.

storage()

Returns the storage object for this object.

SEE ALSO

Top

Mail::SimpleList and Mail::TempAddress for example uses.

See Mail::Action::Address, Mail::Action::Request, Mail::Action::Storage, and Mail::Action::PodToHelp for related modules.

AUTHOR

Top

chromatic, <chromatic at wgz dot org<.

BUGS

Top

No known bugs.

COPYRIGHT

Top

Copyright (c) 2003 - 2009 chromatic. Some rights reserved. You may use, modify, and distribute this module under the same terms as Perl 5.10 itself.

Mail-Action documentation Contained in the Mail-Action distribution. 
package Mail::Action;

use strict;
use warnings;

use vars '$VERSION';
$VERSION = '0.46';

use Carp 'croak';

use Mail::Mailer;

use Mail::Action::Request;
use Mail::Action::PodToHelp;

sub new
{
    my ($class, $address_dir, @options, %options, $fh) = @_;
    croak "No address directory provided\n" unless $address_dir;

    if (@options == 1)
    {
        $fh      = $options[0];
    }
    else
    {
        %options = @options if @options;
        $fh      = $options{Filehandle} if exists $options{Filehandle};
    }

    my $storage  = $class->storage_class();

    unless ($options{Request})
    {
        $fh             ||= \*STDIN;
        $fh               = do { local $/; <$fh> } if defined( fileno( $fh ) );
        $options{Request} = Mail::Action::Request->new( $fh );
    }

    $options{Storage} ||= $options{Addresses};
    $options{Storage}   = $storage->new($address_dir) unless $options{Storage};

    bless \%options, $class;
}

sub storage
{
    my $self = shift;
       $self->{Storage};
}

sub request
{
    my $self = shift;
       $self->{Request};
}

# try to avoid this one from now on
sub message
{
    my $self    = shift;
    my $request = $self->request();
       $request->message();
}

sub fetch_address
{
    my $self      = shift;
    my $alias     = $self->parse_alias( $self->request->recipient() );
    my $addresses = $self->storage();

    return unless $addresses->exists( $alias );

    my $addy      = $addresses->fetch( $alias );

    return wantarray ? ( $addy, $alias ) : $addy;
}

sub command_help
{
    my ($self, $pod, @headings) = @_;
    my $request                 = $self->request();

    my $from   = $request->header( 'From' )->address();
    my $parser = Mail::Action::PodToHelp->new();

    $parser->show_headings( @headings );
    $parser->output_string( \( my $output ));
    $parser->parse_string_document( $pod );

    $output =~ s/(\A\s+|\s+\Z)//g;

    $self->reply({
        To      => $from,
        Subject => ref( $self ) . ' Help'
    }, $output );
}

sub process_body
{
    my ($self, $address) = @_;
    my $attributes       = $address->attributes();
    my $body             = $self->request->remove_sig();

    while (@$body and $body->[0] =~ /^(\w+):\s*(.*)$/)
    {
        my ($directive, $value) = (lc( $1 ), $2);
        $address->$directive( $value ) if exists $attributes->{ $directive };
        shift @$body;
    }

    return $body;
}

sub reply
{
    my ($self, $headers, @body) = @_;

    my $mailer = Mail::Mailer->new();
    $mailer->open( $headers );
    $mailer->print( @body );
    $mailer->close();
}

sub find_command
{
    my $self      = shift;
    my ($subject) = $self->request()->header( 'Subject' ) =~ /^\*(\w+)\*/;

    return unless $subject;

    my $command   = 'command_' . lc $subject;
    return $self->can( $command ) ? $command : '';
}

sub copy_headers
{
    my $self    = shift;
    my $headers = $self->request()->headers();

    my %copy;

    while (my ($header, $value) = each %$headers)
    {
        next if $header eq 'From ';
        $copy{ $header } = join(', ', @$value );
    }

    return \%copy;
}

1;
__END__