nuke native _smtplog but we given the pointer to smtplog() and _smtplog()

within FML::Process::*

3 files changed, 32 insertions, 14 deletions

diff --git a/fml/lib/Netlib/Messages.pm b/fml/lib/Netlib/Messages.pm
index ae82aa09..fbdfae6e 100644
--- a/fml/lib/Netlib/Messages.pm
+++ b/fml/lib/Netlib/Messages.pm
@@ -127,6 +127,7 @@ sub _print
     my $pp     = 0;
     my $maxlen = length($$r_body);
     my $logfp  = $self->{ _log_function };
+    $logfp     = ref($logfp) eq 'CODE' ? $logfp : undef;
 
     # write each line in buffer
     my ($p, $len, $buf, $pbuf);
@@ -141,7 +142,7 @@ sub _print
 	$buf =~ s/^\./../;
 
 	print $fd    $buf;
-	&$logfp($buf) if defined $logfp;
+	&$logfp($buf) if $logfp;
 
 	last SMTP_IO if $p < 0;
 	$pp = $p + 1;
@@ -173,10 +174,10 @@ sub is_empty
 }
 
 
-sub bind_log_function
+sub set_log_function
 {
-    my ($self, $ref_function) = @_;
-    $self->{ _log_function } = $ref_function;
+    my ($self, $fp) = @_;
+    $self->{ _log_function } = $fp; # log function pointer
 }
 
 
diff --git a/fml/lib/Netlib/SMTP.pm b/fml/lib/Netlib/SMTP.pm
index aa596436..523ee227 100644
--- a/fml/lib/Netlib/SMTP.pm
+++ b/fml/lib/Netlib/SMTP.pm
@@ -47,12 +47,14 @@ sub new
     #    _log_function: pointer to the log() function
     $me->{_recipient_limit} = $args->{recipient_limit} || 1000;
     $me->{_socket_timeout}  = $args->{socket_timeout}  || 10;
-    $me->{_log_function}    = $args->{log_function};
+    $me->{_log_function}      = $args->{log_function};
+    $me->{_smtp_log_function} = $args->{smtp_log_function};
 
     _initialize_delivery_session($me, $args);
 
     # define package global pointer to the log() function
     $LogFunctionPointer     = $args->{log_function};
+    $SmtpLogFunctionPointer = $args->{smtp_log_function};
 
     return bless $me, $type;
 }
@@ -70,7 +72,7 @@ sub _send_command
 
     $self->{_last_command} = $command;
     $self->{_error_action} = '';
-    $self->_smtplog($command);
+    $self->smtplog($command);
 
     if (defined $socket) {
 	$socket->print($command, "\r\n");
@@ -110,7 +112,7 @@ sub _read_reply
       SMTP_REPLY:
 	while (1) {
 	    $buf = $socket->getline;
-	    $self->_smtplog($buf);
+	    $self->smtplog($buf);
 
 	    # check smtp attributes
 	    if ($check_attributes) {
@@ -576,7 +578,7 @@ sub _send_header_to_mta
     my $h = $header->as_string($socket);
     $h =~ s/\n/\r\n/g;
     print $socket $h;
-    $self->_smtplog($h);
+    $self->smtplog($h);
 }
 
 
@@ -589,6 +591,7 @@ sub _send_body_to_mta
     my ($self, $socket, $msg) = @_;
 
     # XXX $msg is Netlib::Messages object.
+    $msg->set_log_function( $SmtpLogFunctionPointer );
     $msg->print($socket);
 }
 
@@ -622,7 +625,7 @@ sub _send_data_to_mta
 
 	# 2. separator between header and body
 	print $socket "\r\n";
-	$self->_smtplog("\r\n");
+	$self->smtplog("\r\n");
 
 	# 3. body; send(copy) body on memory to socket each line
 	$self->_send_body_to_mta($socket, $body);
diff --git a/fml/lib/Netlib/Utils.pm b/fml/lib/Netlib/Utils.pm
index c5c3c883..4bcc91dc 100644
--- a/fml/lib/Netlib/Utils.pm
+++ b/fml/lib/Netlib/Utils.pm
@@ -10,7 +10,7 @@
 
 package Netlib::Utils;
 use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK $LogFunctionPointer);
+use vars qw(@ISA @EXPORT @EXPORT_OK $LogFunctionPointer $SmtpLogFunctionPointer);
 use Carp;
 
 require Exporter;
@@ -19,8 +19,10 @@ require Exporter;
 @EXPORT = qw(
 	     Log
 	     _smtplog
+	     smtplog
 
 	     $LogFunctionPointer
+	     $SmtpLogFunctionPointer
 
 	     _error_why
 	     error 
@@ -56,13 +58,25 @@ sub Log
 }
 
 
-sub _smtplog
+sub smtplog
 {
     my ($self, $buf) = @_;
+    _smtplog($buf);
+}
+
+sub _smtplog
+{
+    my ($buf) = @_;
+
+    # function pointer to logging function
+    my $fp = $SmtpLogFunctionPointer;
 
-    if (defined $buf) {
-	print $buf;
-	print "\n" if $buf !~ /\n$/o;
+    if ($fp) {
+	eval &$fp($buf);
+	print STDERR $@, "\n" if $@;
+    }
+    else {
+	print STDERR @_, "\n";
     }
 }