The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
# Copyright (c) 2009 George Nistorica
# All rights reserved.
# This file is part of POE::Component::Client::SMTP
# POE::Component::Client::SMTP is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.  See the LICENSE
# file that comes with this distribution for more details.

# The program tests whethet the PoCo correctly escapes a single dot
# found on a line in a message body when sending the email.

use strict;
use warnings;

use lib q{lib};

use Data::Dumper;
use Test::More tests => 1;

use POE;
use POE::Component::Server::TCP;
use POE::Component::Client::SMTP;

# print verbose messages
my $debug = 0;

# assume that test is successful
my $test_success = 1;

# Server didn't encountered the command "second line" which triggers
# the test
my $trigger = 0;

my $EOL            = qq{\015\012};
my @smtp_responses = (
    q{220 localhost ESMTP POE::Component::Client::SMTP Test Server},
    qq{250-localhost$EOL}
      . qq{250-PIPELINING$EOL}
      . qq{250-SIZE 250000000$EOL}
      . qq{250-VRFY$EOL}
      . qq{250-ETRN$EOL}
      . q{250 8BITMIME},
    q{250 Ok},                                 # mail from
    q{250 Ok},                                 # rcpt to:
    q{354 End data with <CR><LF>.<CR><LF>},    # data
    q{250 Ok: queued as 549B14484F},           # end data
    q{221 Bye},                                # quit

);

POE::Session->create(
    q{package_states} => [
        q{main} => [
            q{_start},            q{_stop},
            q{start_smtp_server}, q{start_smtp_client},
            q{success_event},     q{failure_event}
        ],
    ],
    q{heap} => {
        q{smtp_listen_port}    => q{31337},
        q{smtp_listen_address} => q{localhost},
        q{message_file}        => q{t/email_message_dot_test.txt},
    },
);

diag (q{Using POE::Component::Client::SMTP version: } . $POE::Component::Client::SMTP::VERSION );

POE::Kernel->run();
is( $test_success, 1, q{Single dot has been escaped from email file} );
exit 0;

sub _start {
    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    $kernel->alias_set(q{Main_Session});
    $kernel->yield(q{start_smtp_server});
    return 0;
}

sub _stop {
    return 0;
}

sub start_smtp_server {
    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    POE::Component::Server::TCP->new(
        q{Port}                  => $heap->{'smtp_listen_port'},
        q{Address}               => $heap->{'smtp_listen_address'},
        q{Alias}                 => q{SMTP_Server},
        q{Error}                 => \&error_handler,
        q{ClientInput}           => \&handle_client_input,
        q{ClientConnected}       => \&handle_client_connect,
        q{ClientDisconnected}    => \&handle_client_disconnect,
        q{ClientError}           => \&handle_client_error,
        q{ClientFlushed}         => \&handle_client_flush,
        q{ClientInputFilter}     => POE::Filter::Line->new(),
        q{ClientOutputFilter}    => POE::Filter::Line->new(),
        q{ClientShutdownOnError} => 1,
    );

    $kernel->yield(q{start_smtp_client});
    return 0;
}

# SMTP Server handlers

sub accept_handler {
    my ( $socket, $remote_address, $remote_port ) = @_[ ARG0, ARG1, ARG2 ];
    if ($debug) {
        diag(qq{$remote_address:$remote_port connected});
    }
}

sub error_handler {
    my ( $syscall_name, $error_number, $error_string ) = @_[ ARG0, ARG1, ARG2 ];
    diag(   q{Got an error: }
          . $syscall_name . q{:}
          . $error_number . q{:}
          . $error_string );
}

sub handle_client_input {
    my $heap         = $_[HEAP];
    my $input_record = $_[ARG0];
    if ($debug) {
        diag(qq{FROM CLIENT: "$input_record"});
    }
    if ( $input_record =~ /second\sline/io ) {
        $trigger = 1;
	diag ( q{Triggered, waiting for esacepd dot} ) if $debug;
    }
    else {
        if ( $trigger and $input_record =~ /^\.$/ ) {
            $test_success = 0;
        }
        if ($trigger) {
            $trigger = 0;
        }
    }

    # decide response to send back

    if (   $input_record =~ /^(helo|ehlo|mail from:|rcpt to:|data|quit)/io
        or $input_record =~ /^\.$/io )
    {
        my $response = shift @smtp_responses;
        if ($debug) {
            diag(qq{GOING TO SEND: "$response"});
        }
        $heap->{'client'}->put($response);
    }
    if ( $input_record =~ /quit/io ) {
        if ($debug) {
            diag( q{Shutting down status: } . $heap->{'shutdown'} );
        }
	# not really necessary
        $heap->{'shutdown'} = 1;
    }
}

sub handle_client_error {
    my ( $syscall_name, $error_number, $error_string ) = @_[ ARG0, ARG1, ARG2 ];
}

sub handle_client_connect {
    my $heap = $_[HEAP];
    $heap->{'client'}->put( shift @smtp_responses );
    return 0;
}

sub handle_client_disconnect {
}

sub handle_client_flush {
}

sub start_smtp_client {
    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    POE::Component::Client::SMTP->send(
        q{From}         => q{charlie@localhost},
        q{To}           => q{root@localhost},
        q{Server}       => $heap->{'smtp_listen_address'},
        q{Port}         => $heap->{'smtp_listen_port'},
        q{Timeout}      => 100,
        q{SMTP_Success} => q{success_event},
        q{SMTP_Failure} => q{failure_event},
        q{MessageFile}  => $heap->{'message_file'},
	q{TransactionLog} => 1,
    );
    return 0;
}

sub success_event {
    my ( $kernel, $arg0, $arg1 ) = @_[ KERNEL, ARG0, ARG1 ];
    diag ( q{Success event!}) if $debug;
    print Dumper($arg0) if $debug;
    print Dumper($arg1) if $debug;
    $kernel->post( q{SMTP_Server}, q{shutdown} );
    return 0;
}

sub failure_event {
    my ( $kernel, $arg0, $arg1 ) = @_[ KERNEL, ARG0, ARG1 ];
    diag( q{Failure event!} ) if $debug;
    print Dumper($arg0) if $debug;
    print Dumper($arg1) if $debug;
    $kernel->post( q{SMTP_Server}, q{shutdown} );
    return 0;
}

__END__