Embperl::Mail - Sends results from Embperl via E-Mail

 use Embperl::Mail ;

 Embperl::Mail::Execute ({inputfile => 'template.epl',
                                subject   => 'Test Embperl::Mail::Execute',
                                to        => 'email@foo.org'}) ;

###################################################################################
#
#   Embperl - Copyright (c) 1997-2010 Gerald Richter / ECOS
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
#   $Id: Mail.pm 344310 2005-11-15 05:22:19Z richter $
#
###################################################################################


package Embperl::Mail ;


require Embperl ;
require Embperl::Constant ;


use strict ;
use vars qw(
    @ISA
    $VERSION
    ) ;


@ISA = qw(Embperl);


$VERSION = '2.1.0';


sub _quote_hdr
    {
    my $chunk    = shift;
    my $encoding = shift ;

    return $chunk unless ($encoding && ($chunk =~ /[\x80-\xff]/)) ;

    $chunk =~ s{
				([^0-9A-Za-z])
	       	       }{
		   		   join("" => map {sprintf "=%02X", $_} unpack("C*", $1))
	       	       }egox;
    return "=?$encoding?Q?$chunk?=";
    }





sub Execute

    {
    my ($req) = @_ ;

    my $data ;
    my @errors ;

    $req -> {options} ||= &Embperl::Constant::optKeepSpaces      | &Embperl::Constant::optReturnError;
    
    $req -> {syntax}  ||= 'EmbperlBlocks' ; 
    $req -> {escmode} ||= 0 ;
    $req -> {output}   = \$data ;
    $req -> {errors} ||= \@errors ;

    if ($Embperl::req)
        {
        $Embperl::req -> execute_component ($req) ;
        }
    else
        {
        Embperl::Execute ($req) ;
        }

    die "@errors" if (@errors) ;

    eval
        {
        require Net::SMTP ;
        
        $req -> {mailhost} ||= $ENV{'EMBPERL_MAILHOST'} || 'localhost' ;

        my $helo = $req -> {mailhelo} || $ENV{'EMBPERL_MAILHELO'} ;

        my $smtp = Net::SMTP->new($req -> {mailhost},
                                  Debug => ($req -> {maildebug} || $ENV{'EMBPERL_MAILDEBUG'} || 0),
                                  ($helo?(Hello => $helo):()) 
                                  ) or die "Cannot connect to mailhost $req->{mailhost}" ;

        my $from =  $req -> {from} || $ENV{'EMBPERL_MAILFROM'} || 'WWW-Server\@' . ($ENV{SERVER_NAME} || 'localhost') ;
        $smtp->mail($from);

        my $to ;
        if (ref ($req -> {'to'}))
            {
            $to = $req -> {'to'} ;
            }
        else
            {
            $to = [] ;
            @$to = split (/\s*;\s*/, $req -> {'to'}) ;
            }

        my $cc ;
        if (ref ($req -> {'cc'}))
            {
            $cc = $req -> {'cc'} ;
            }
        else
            {
            $cc = [] ;
            @$cc = split (/\s*;\s*/, $req -> {'cc'}) if ($req -> {'cc'}) ;
            }

        my $bcc ;
        if (ref ($req -> {'bcc'}))
            {
            $bcc = $req -> {'bcc'} ;
            }
        else
            {
            $bcc = [] ;
            @$bcc = split (/\s*;\s*/, $req -> {'bcc'}) if ($req -> {'bcc'}) ;
            }

        my $enc     = $req->{headerencoding} || 'iso-8859-1';
        my $headers = $req->{mailheaders} ;        
        $smtp -> to (@$to, @$cc, @$bcc) ;

        $smtp->data() or die "smtp data failed" ;
        $smtp->datasend("Reply-To: " . _quote_hdr($req->{'reply-to'}, $enc) . "\n") or die "smtp data failed"  if ($req->{'reply-to'}) ;
        $smtp->datasend("From: " . _quote_hdr($from, $enc) . "\n") if ($from) ;
        $smtp->datasend("To: " . _quote_hdr(join (', ', @$to), $enc) . "\n")  or die "smtp datasend failed" ;
        $smtp->datasend("Cc: " . _quote_hdr(join (', ', @$cc), $enc) . "\n")  or die "smtp datasend failed" if ($req -> {'cc'}) ;
        $smtp->datasend("Subject: " . _quote_hdr($req->{subject}, $enc) . "\n") or die "smtp datasend failed" ;
        $smtp->datasend("Date: " . _quote_hdr(Embperl::get_date_time(), $enc) . "\n") or die "smtp datasend failed" ;
        if (ref ($headers) eq 'ARRAY')
            {
            foreach (@$headers)
                {
                next unless (/^(.*?):\s*(.*?)$/) ;
                $smtp->datasend("$1: " . _quote_hdr($2, $enc) . "\n") or die "smtp datasend failed" ;
                }
            }
        $smtp->datasend("\n")  or die "smtp datasend failed" ;
	# make sure we have only \n line endings (is made to \r\n by Net::SMTP)
        $data =~ s/\r//g ;
	$smtp->datasend($data)  or die "smtp datasend failed" ;
        $smtp->quit or die "smtp quit failed" ; 
        } ;

    if ($@)
        {
        die "$@" if (ref ($req -> {errors}) eq \@errors) ;

        push @{$req -> {errors}}, $@ ;
        }

    return ref ($req -> {errors})?@{$req -> {errors}}:0 ;
    }    


__END__