File Coverage

lib/Mail/TempAddress.pm

Criterion	Covered	Total	%
statement	104	106	98.1
branch	25	28	89.2
condition	5	5	100.0
subroutine	17	18	94.4
pod	4	11	36.3
total	155	168	92.2

package Mail::TempAddress;

use strict;
my $pod = do { local $/;  };

use base 'Mail::Action';
use Carp 'croak';

use Mail::Mailer;
use Email::Address;

use Mail::TempAddress::Addresses;

use vars '$VERSION';
$VERSION = '0.62';

sub storage_class
{
    'Mail::TempAddress::Addresses'
}

sub process
{
    my $self    = shift;

    return if $self->request()->message()->header( 'X-MTA-Seen' );

    my $command = $self->find_command();
    return $self->$command() if $command;

    my ($address, $key) = $self->fetch_address();

    my $result = eval
    {
        die    "No address found\n"             unless $address;
        return $self->respond( $address, $key ) if     $key;
        return $self->deliver( $address )       if     $address;
    };

    return $result unless $@;
    $self->reject( $@ );
}

sub command_help
{
    my $self = shift;
    $self->SUPER::command_help( $pod, 'USING ADDRESSES', 'DIRECTIVES' );
}

sub deliver
{
    my ($self, $address) = @_;

    my $expires = $address->expires();
    $self->reject() if $expires and $expires < time();

    my $request = $self->request();
    my $from    = $request->header( 'From' )->address();
    my $key     = $address->add_sender( $from );
    my $desc    = $address->description();
    my $to      = $request->recipient();
    my $user    = $to->user();
    my $host    = $to->host();

    my @all_to  =
        map  { $self->build_address( $_, $address, $user, $host  ) }
        grep { $_->address() ne $to->address() }
        $request->header( 'To' );

    my @all_cc  =
        map  { $self->build_address( $_, $address, $user, $host  ) }
        grep { $_->address() ne $to->address() }
        $request->header( 'Cc' );

    my $headers = $request->copy_headers();

    $headers->{From}                = $from;
    $headers->{To}                  = [ $address->owner(), @all_to ];
    $headers->{Cc}                  = \@all_cc if @all_cc;
    $headers->{'Reply-To'}          = "$user+$key\@$host";
    $headers->{'X-MTA-Description'} = $desc if $desc;

    $self->storage->save( $address, $address->name() );

    $self->reply( $headers, $request->message->body_raw() );
}

sub build_address
{
    my ($self, $addy, $address, $user, $host) = @_;

    my $real_addy = $addy->address();
    my $comment   = '(' . $real_addy . ')';
    my $key       = $address->add_sender( $real_addy );
    my $keyed     = '<' . $user . '+' . $key . '@' . $host . '>';

    return $comment . ' ' . $keyed;
}

sub respond
{
    my ($self, $address, $key) = @_;

    my $request      = $self->request();
    my $to           = $address->get_sender( $key )
        or die "No sender for '$key'\n";

    my $message      = $self->message();

    my $addy         = $request->recipient();
    my $host         = $addy->host();
    my $from         = $address->name() . "\@$host";

    my $headers      = $request->copy_headers();
    $headers->{To}   = $to;
    $headers->{From} = $from;
    delete $headers->{Cc};

    $self->reply( $headers, join("\n", @{ $request->remove_sig() } ));
}

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

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

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

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

sub parse_alias
{
    my ($self, $address)  = @_;
    my ($add)             = Email::Address->parse( $address );
    my $user              = $add->user();
    my $expansion_pattern = $self->expansion_pattern();
    my $key               = ( $user =~ s/$expansion_pattern// ? $1 : undef );
    return wantarray ? ( $user, $key ) : $user;
}

sub expansion_pattern
{
    return qr/\+([^+]+)$/;
}

sub command_new
{
    my $self      = shift;
    my $request   = $self->request();
    my $from      = $request->header( 'From' )->address();
    my $to        = $request->recipient();
    my $domain    = $to->host();

    my $addresses = $self->storage();
    my $address   = $addresses->create( $from );
    my $tempaddy  = $addresses->generate_address();

    $self->process_body( $address );
    $addresses->save( $address, $tempaddy );

    $self->reply({
        To      => $from,
        From    => $to->address(),
        Subject => 'Temporary address created' },
    "A new temporary address has been created for $from: $tempaddy\@$domain" );
}

sub reject
{
    my ($self, $error) = @_;
    $error ||= "Invalid address";
    $!       = 100;
    die "$error\n";
}

1;
__DATA__