File Coverage

blib/lib/Mail/Action.pm

Criterion	Covered	Total	%
statement	84	84	100.0
branch	26	26	100.0
condition	8	8	100.0
subroutine	17	17	100.0
pod	10	10	100.0
total	145	145	100.0

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__