# Vier Module in Einem: 
# SendMail, SendMail::Attach, SendMail::HTML, SendMail::SMTP


package SendMail::HTML;

use strict;
use warnings;
use Carp;
@SendMail::HTML::ISA = qw(SendMail);

my $HTML = <<'TOKEN~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~TOKEN';
From: %from%
To: %to%
Subject: %subject%
Date: %date%
MIME-Version: 1.0
Content-Type: multipart/alternative; boundary=%boundary%

--%boundary%
Content-Type: text/plain; charset=%charset%
Content-Transfer-Encoding: quoted-printable

%mesg% 

--%boundary%
Content-Type: text/html; Charset=%charset%
Content-Transfer-Encoding: quoted-printable

%html%

--%boundary%--
TOKEN~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~TOKEN

sub sendmail{
    my $self = shift;
    my %in =(
        from    => undef,
        to      => undef,
        subject => 'feedback',
        mesg    => undef,
        charset => $self->{CHARSET},
        html    => '',
    @_);
    my @requires = qw(from to mesg);
    $in{html} = $in{mesg} if ! length $in{html};
    return eval{
        foreach my $r(@requires){
            croak "Missing required field '$r'" if not defined $in{$r};
        }

        my $boundary = 'fischers_fritz_fischt_frische_fische';

        my $data = XR::xr($HTML, {
            boundary => $boundary,
            charset  => $in{charset},
            from     => $in{from},
            to       => $in{to},
            mesg     => $self->quotePrint($in{mesg}),
            html     => $self->quotePrint($in{html}),
            date     => Email::Date::Format::email_date(),
            subject  => sprintf("=?%s?Q?%s?=", $in{charset}, $self->quotePrint($in{subject})),
        });

        my $P = undef;
        open($P, "|$self->{MTA}") or die "IO-Error: $!";
        print $P $data;
        close $P;

        $data;
    }
}

###########################################################################
package SendMail::Attach;

use strict;
use warnings;
use MIME::Base64;
use Carp;
use IO::File;
use File::Basename;
@SendMail::Attach::ISA = qw(SendMail);

my $TA = <<'TOK----------------------------------------------------------------------------EN';
From: %from%
To: %to%
Subject: %subject%
Date: %date%
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary=%boundary%

--%boundary%
Content-Type: text/plain; charset=%charset%
Content-Transfer-Encoding: quoted-printable

%mesg% 
%loop_attach%
--%boundary%
Content-Type: %type%; filename="%filename%"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename="%filename%"

%base64%
%endloop%
--%boundary%--
TOK----------------------------------------------------------------------------EN


sub sendmail{
    my $self = shift;
    my %in =(
        from    => undef,
        to      => undef,
        subject => 'feedback',
        mesg    => undef,
        charset => $self->{CHARSET},
        attach  => [],
    @_);
    my @requires = qw(from to mesg);
    return eval{
        foreach my $r(@requires){
            croak "Missing required field '$r'" if not defined $in{$r};
        }
        croak q(attach must be a slice like [{path => '/foo/bar', type => 'image/gif'},{...}]) if ref $in{attach} ne 'ARRAY';    
        croak "No attach files" if ! scalar @{$in{attach}};

        my $boundary = 'fischers_fritz_fischt_frische_fische';
        # boundary muss in die Attachment Schleife
        # path, filename parsen
        my @attach = ();
        foreach my $r(@{$in{attach}}){
            my ($filename, $path, $suffix) = fileparse($r->{path});
            my $fh = IO::File->new;
            $fh->open($r->{path}, O_RDONLY|O_BINARY) or croak "IO-Error: $!";
            my $base64 = '';
            while(read($fh, my $buffer, 57)){
                $base64 .= encode_base64($buffer);
            }
            push @attach, {
                type     => $r->{type} ? $r->{type} : 'application/octet-stream',
                base64   => $base64,
                filename => $filename,
                boundary => $boundary, 
            };
            $fh->close;
        }
            
        my $data = XR::xr($TA, {
            boundary => $boundary,
            charset  => $in{charset},
            from     => $in{from},
            to       => $in{to},
            mesg     => $self->quotePrint($in{mesg}),
            date     => Email::Date::Format::email_date(),
            subject  => sprintf("=?%s?Q?%s?=", $in{charset}, $self->quotePrint($in{subject})),
            attach   => \@attach,        
        });

        my $P = undef;
        open($P, "|$self->{MTA}") or die "IO-Error: $!";
        print $P $data;
        close $P;


        $data;
    };
}

###########################################################################
package SendMail;

use strict;
use warnings;
use Email::Date::Format;
use Carp;
use XR;

# Mail-Template
our $TT = <<'TOK----------------------------------------------------------------------------EN';
From: %from%
To: %to%
cc: %cc%
Subject: %subject%
Date: %date%
Content-Transfer-Encoding: quoted-printable
Content-Type: text/plain; Charset=%charset%

%mesg%
TOK----------------------------------------------------------------------------EN


sub new{
    my $class = shift;
    my %cfg = (
        charset => 'UTF-8',
        mta => '/usr/sbin/sendmail -t',
    @_);
    return do{
        my $self = bless{
            MTA     => $cfg{mta},
            CHARSET => $cfg{charset},
        },$class;
    };
}

sub sendmail{
    my $self = shift;
    my %in =(
        from    => undef,
        to      => undef,
        subject => 'feedback',
        mesg    => undef,
        charset => $self->{CHARSET},
    @_);
    my @requires = qw(from to mesg);
    return eval{
        foreach my $r(@requires){
            croak "Missing required field '$r'" if not defined $in{$r};
        }
        croak "Use SendMail::Attach" if exists $in{attach};
        croak "Use SendMail::HTML" if exists $in{html};
        
        # Maildatei zusammenbauen
        $in{subject} = sprintf("=?%s?Q?%s?=", $in{charset}, $self->quotePrint($in{subject}));
        my $data =  XR::xr($TT, {
            from    => $in{from},
            to      => $in{to},
            subject => $in{subject},
            charset => $in{charset},
            mesg    => $self->quotePrint($in{mesg}),
            date    => Email::Date::Format::email_date(),
        });
        my $P = undef;
        open($P, "|$self->{MTA}") or die "IO-Error: $!";
        print $P $data;
        close $P;
        $data;
    };
}

# always return the octets
sub utf8tidy{
    my $self = shift;
    my $s = shift;
    use bytes;
    return pack("C*", unpack("C*", $s));
}


# other way for quoted-printable
# full compatible to SvUTF8 AND any charset
sub quotePrint{
    my $self = shift;
    my $s = shift;
    use bytes;
    $s =~ s/=/=3D/g;
    my @qp = map{ $_ > 127 || $_ == 46 ? sprintf("=%X", $_) : pack("C", $_)  } unpack "C*", $s;
    return join '', @qp;
}
###########################################################################
# Send Mail via Socket SMTP Auth
package SendMail::SMTP;

use strict;
use warnings;
use IO::Socket;
use MIME::Base64 qw(encode_base64);
@SendMail::SMTP::ISA = qw(SendMail);
use constant CRLF => "\r\n";
use constant DATAEND => "\r\n.\r\n";
use Config::Tiny;

sub new{
    my $class = shift;
    my %in = (
        auth => '', # Sektion in ini File
        dev => 0,
        charset => 'utf-8',
        ssl => 0,
        inipath => '',
    @_);

    return eval{
        my $ini = Config::Tiny->read($in{inipath}) || die "INIFile not found!\n";
        my $auth = $ini->{$in{auth}};
        my $self = bless{
            auth => $auth
        }, $class;
        $self->{dev} = $in{dev};
        $self->{CHARSET} = $in{charset};

        if( $in{ssl} ){
            require IO::Socket::SSL;
            my %ca = $^O eq 'MSWin32' ? do{
                require Mozilla::CA;
                my $r = {
                    SSL_verify_mode => 0x02,
                    SSL_ca_file => Mozilla::CA::SSL_ca_file()
                };
                %$r;
            } : ();

            $self->{IO} = IO::Socket::SSL->new(
                PeerAddr => "$auth->{host}:$auth->{sslport}", %ca
            ) || die "Keine SSL Verbindung zum SMTP Host\n";
        }
        else{
            $self->{IO} = IO::Socket::INET->new(
                PeerAddr => "$auth->{host}:$auth->{port}"
            ) || die "Keine Verbindung zum SMTP Host\n";
        }
        
        $self->getline;
        
        $self->{IO}->print("HELO $auth->{host}".CRLF);
        $self->getline;
        $self->{IO}->print("AUTH LOGIN".CRLF);
        $self->getline;
        $self->{IO}->print(encode_base64($auth->{user}, CRLF));
        $self->getline;
        $self->{IO}->print(encode_base64($auth->{pass}, CRLF));
        $self->getline;
    
        $self;
    };
}

# Wirft Excption
sub getline{
    my $self = shift;
    my $in = $self->{IO}->getline;
    print $in if $self->{dev}; 
    die $in if $in =~ /^5/;    
    return $in;
}

sub sendmail{
    my $self = shift;
    my %in = (
        cc   => '',
        from => '',
        to   => $self->{auth}{user},
        subject => '',
        mesg    => '',
        charset => $self->{CHARSET},
    @_);

    my $data = XR::xr($SendMail::TT, {
        mesg => $self->quotePrint($in{mesg}),
        subject => sprintf("=?%s?Q?%s?=", $in{charset}, $self->quotePrint($in{subject})),
        charset => $self->{CHARSET},
        date => Email::Date::Format::email_date(),
        from => $in{from},
        to   => $in{to},
        cc   => $in{cc}
    });
        
    return eval{
        $self->{IO}->print("Mail From:<$in{from}>".CRLF);
        $self->getline;
        $self->{IO}->print("Rcpt To:<$in{to}>".CRLF);
        $self->getline;
        $self->{IO}->print("DATA".CRLF);
        $self->getline;
        $self->{IO}->print($data, DATAEND);
        my $ID = $self->getline();

        $ID; # 250 2.0.0 Ok: queued as 3A61420D594F
    }
}

sub bye{
    my $self = shift;
    return unless $self->{IO};
    $self->{IO}->print('Quit', CRLF);
    my $in = $self->getline;
}

sub DESTROY{
    my $self = shift;
    $self->bye;
}

1;#########################################################################