The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Mail::Decency::Core::POEFilterSMTP;

use strict;
use warnings;

use version 0.74; our $VERSION = qv( "v0.1.4" );

use Data::Dumper;

use base qw/ POE::Filter::Line /;

=head1 NAME

Mail::Decency::Core::POEFilterSMTP

=head1 DESCRIPTION

Filters incoming data, based on POE::Filter::Line

Each incoming line will be splitted into a trippled, where the first value contains the first word in uppercase, the second value the rest of the line (original case) and the last value the whole original line

The first and second values are made for handling the SMTP protocol, whereas the last value has to assure the correct (upper/lower)case of the send DATA.

This is based on: L<POE::Component::Server::SimpleSMTP> .. yes, it is reinventing the wheel, but somehow i have to understand this!

=cut

use constant CRLF => qq/\x0D\x0A/; # RFC 2821, 2.3.7

=head1 METHODS

=head2 new

Create new filter, derived from POE::Filter::Line

=cut

sub new {
    my ($class) = @_;
    return $class->SUPER::new( Literal => CRLF );
}


=head2 get_one

Handle incoming lines

=cut

sub get_one {
    my ($self) = shift;
    my $lines = $self->SUPER::get_one( @_ );
    
    foreach my $line ( @$lines ) {
        my ($command, $data) = split( /\s+/, $line, 2 );
        $data =~ s/\s+$// if $data;
        #print "IN> $line\n";
        $line = [ uc( $command ), $data, $line. CRLF ];
    }
    
    return $lines;
}


=head2 put

Handle output content

=cut

sub put {
    my ($self, $lines) = @_;
    
    my $code = shift @{$lines};
    
    # return
    #   250 OK
    if ( $#$lines == 0 ) {
        return $self->SUPER::put( [ "$code @{$lines}" ] );
    }
    
    # return
    #   250-something
    #   250 OK
    my @output;
    push @output, "$code-$lines->[$_]" for 0 .. $#$lines - 1;
    push @output, "$code $lines->[-1]";
    
    return $self->SUPER::put( \@output );
}


=head1 AUTHOR

Ulrich Kautz <uk@fortrabbit.de>

=head1 COPYRIGHT

Copyright (c) 2010 the L</AUTHOR> as listed above

=head1 LICENCSE

This library is free software and may be distributed under the same terms as perl itself.

=cut

1;