Rearrange LSMB::Mailer a bit to make templating simpler

Adjust backup function to work with LSMB::M rearrangement


git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@1790 4979c152-3d1c-0410-bac9-87ea11338e46

2 files changed, 184 insertions, 125 deletions

diff --git a/LedgerSMB/AM.pm b/LedgerSMB/AM.pm
index 4f063c56..34e22615 100644
--- a/LedgerSMB/AM.pm
+++ b/LedgerSMB/AM.pm
@@ -1656,6 +1656,7 @@ sub load_template {
 
     my ( $self, $myconfig, $form ) = @_;
 
+    $form->{file} ||= lc "$myconfig->{templates}/$form->{template}.$form->{format}";
     $self->check_template_name( \%$myconfig, \%$form );
     open( TEMPLATE, '<', "$form->{file}" )
       or $form->error("$form->{file} : $!");
@@ -1679,6 +1680,7 @@ sub save_template {
 
     my ( $self, $myconfig, $form ) = @_;
 
+    $form->{file} ||= lc "$myconfig->{templates}/$form->{template}.$form->{format}";
     $self->check_template_name( \%$myconfig, \%$form );
     open( TEMPLATE, '>', "$form->{file}" )
       or $form->error("$form->{file} : $!");
@@ -2093,25 +2095,36 @@ sub backup {
     # compress backup if gzip defined
     my $suffix = "c";
 
+	##SC: START Testing changes
+	$myconfig->{name} = "test";
+	$myconfig->{email} = 'seneca@localhost';
+	$myconfig->{dbport} = 5432;
+	$myconfig->{dbuser} = 'seneca';
+	$myconfig->{dbhost} = 'localhost';
+	$myconfig->{dbname} = 'ledgersmb-taxtest';
+	##SC: END Testing changes
     if ( $form->{media} eq 'email' ) {
         print OUT
 qx(PGPASSWORD="$myconfig->{dbpasswd}" pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} -Fc -p $myconfig->{dbport} $myconfig->{dbname});
         close OUT;
         use LedgerSMB::Mailer;
-        $mail = new LedgerSMB::Mailer;
-
-        $mail->{to}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
-        $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
-        $mail->{subject} =
-"LedgerSMB Backup / $globalDBname-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix";
-        @{ $mail->{attachments} } = ($tmpfile);
-        $mail->{version} = $form->{version};
-        $mail->{fileid}  = "$boundary.";
-        $mail->{format}  = "plain";
-        $mail->{format}  = "octet-stream";
-
-        $myconfig->{signature} =~ s/\\n/\n/g;
-        $mail->{message} = "-- \n$myconfig->{signature}";
+        $mail = new LedgerSMB::Mailer(
+            to => qq|"$myconfig->{name}" <$myconfig->{email}>|,
+            from => qq|"$myconfig->{name}" <$myconfig->{email}>|,
+            subject => "LedgerSMB Backup / $globalDBname-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix",
+            message => qq|
+This PostgreSQL backup can be restored using the pg_restore command.
+
+-- 
+LedgerSMB|,
+            );
+
+        $mail->attach(
+            'file' => $tmpfile,
+            'filename' => $tmpfile,
+            'strip' => "$boundary.",
+            'mimetype' => 'application/octet-stream',
+            );
 
         $err = $mail->send;
     }
diff --git a/LedgerSMB/Mailer.pm b/LedgerSMB/Mailer.pm
index 473fa7cb..6ff22c62 100644
--- a/LedgerSMB/Mailer.pm
+++ b/LedgerSMB/Mailer.pm
@@ -1,126 +1,172 @@
-#=====================================================================
-# LedgerSMB
-# Small Medium Business Accounting software
-# http://www.ledgersmb.org/
-#
-# Copyright (C) 2006
-# This work contains copyrighted information from a number of sources all used
-# with permission.
-#
-# This file contains source code included with or based on SQL-Ledger which
-# is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed
-# under the GNU General Public License version 2 or, at your option, any later
-# version.  For a full list including contact information of contributors,
-# maintainers, and copyright holders, see the CONTRIBUTORS file.
-#
-# Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
-# Copyright (C) 2002
-#
-#  Author: DWS Systems Inc.
-#     Web: http://www.sql-ledger.org
-#
-#  Contributors:
-#
-# Original Author and copyright holder:
-# Dieter Simader dsmimader@sql-ledger.com
-#======================================================================
-#
-# This file has undergone whitespace cleanup.
-#
-#======================================================================
-#
-# mailer package
-#
-#======================================================================
+=head1 NAME
+
+LedgerSMB::Mailer   Mail output for LedgerSMB
+
+=head1 SYNOPSIS
+
+=head1 COPYRIGHT
+
+ #====================================================================
+ # LedgerSMB
+ # Small Medium Business Accounting software
+ # http://www.ledgersmb.org/
+ #
+ # Copyright (C) 2006
+ # This work contains copyrighted information from a number of sources
+ # all used with permission.
+ #
+ # This file contains source code included with or based on SQL-Ledger
+ # which # is Copyright Dieter Simader and DWS Systems Inc. 2000-2005
+ # and licensed under the GNU General Public License version 2 or, at
+ # your option, any later version.  For a full list including contact
+ # information of contributors, maintainers, and copyright holders,
+ # see the CONTRIBUTORS file.
+ #
+ # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
+ # Copyright (C) 2002
+ #
+ #  Author: DWS Systems Inc.
+ #	 Web: http://www.sql-ledger.org
+ #
+ #  Contributors:
+ #
+ # Original Author and copyright holder:
+ # Dieter Simader dsmimader@sql-ledger.com
+ #====================================================================
+
+=head1 METHODS
+
+=cut
 
 package LedgerSMB::Mailer;
 
+use warnings;
+use strict;
+use Carp;
+
 use Encode;
 use MIME::Lite;
-use MIME::Base64;
 use LedgerSMB::Sysconfig;
 
+our $VERSION = '0.13';
+
+=head2 LedgerSMB::Mailer->new([%args])
+
+Create a new Mailer object.  If any arguments are passed in, a message
+that uses them will be automatically prepared.
+
+=cut
+
 sub new {
-    my ($type) = @_;
-    my $self = {};
+	my $type = shift;
+	my $self = {};
+	bless $self, $type;
 
-    bless $self, $type;
+	$self->prepare_message(@_) if @_;
+
+	$self;
 }
 
-sub send {
-    my ($self) = @_;
-
-    my $domain = $self->{from};
-    my $boundary = time;
-    $boundary = "LSMB-$boundary";
-    $domain =~ s/(.*?\@|>)//g;
-    my $msg_id = "$boundary\@$domain";
-
-    $self->{contenttype} = "text/plain" unless $self->{contenttype};
-
-    for (qw(from to cc bcc)) {
-        $self->{$_} =~ s/\&lt;/</g;
-        $self->{$_} =~ s/\&gt;/>/g;
-        $self->{$_} =~ s/(\/|\\|\$)//g;
-    }
-
-    my $msg = MIME::Lite->new(
-        'From'    => $self->{from},
-        'To'      => $self->{to},
-        'Cc'      => $self->{cc},
-        'Bcc'     => $self->{bcc},
-        'Subject' => Encode::encode('MIME-Header', $self->{subject}),
-        'Type'    => 'TEXT',
-        'Data'    => Encode::encode_utf8($self->{message}),
-        'Encoding'    => '8bit',
-        'Message-ID'    => $msg_id,
-    );
-    $msg->attr( 'Content-Type' => $self->{contenttype} );
-    $msg->attr( 'Content-Type.charset' => 'UTF-8' ) if
-        $self->{contenttype} =~ m#^text/#;
-    $msg->add( 'Disposition-Notification-To' => $self->{from} )
-      if $self->{notify};
-    $msg->replace( 'X-Mailer' => "LedgerSMB $self->{version}" );
-    $msg->binmode(':utf8');
-
-    if ( @{ $self->{attachments} } ) {
-        foreach my $attachment ( @{ $self->{attachments} } ) {
-
-            my $application =
-              ( $attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/ )
-              ? "text"
-              : "application";
-            my $type = "$attachment/$self->{format}";
-            $type .= '; charset="UTF-8"' if $attachment eq 'text';
-
-            my $filename = $attachment;
-
-            # strip path
-            $filename =~ s/(.*\/|$self->{fileid})//g;
-            $msg->attach(
-                'Type'        => $type,
-                'Path'        => $attachment,
-                'Filename'    => $filename,
-                'Disposition' => 'attachment',
-            );
-        }
-
-    }
-
-    if ( ${LedgerSMB::Sysconfig::smtphost} ) {
-        $msg->send(
-            'smtp',
-            ${LedgerSMB::Sysconfig::smtphost},
-            Timeout => ${LedgerSMB::Sysconfig::smtptimeout}
-        ) || return $!;
-    }
-    else {
-        $msg->send( 'sendmail', ${LedgerSMB::Sysconfig::sendmail} )
-          || return $!;
-    }
-
-    return "";
+=head2 $mail->prepare_message
+
+=cut
+
+sub prepare_message {
+	my $self = shift;
+	my %args = @_;
+
+	# Populate message fields
+	for my $key (keys %args) {
+		$self->{$key} = $args{$key};
+	}
+
+	my $domain = $self->{from};
+	$domain =~ s/(.*?\@|>)//g;
+	my $boundary = time;
+	$boundary = "LSMB-$boundary";
+	my $msg_id = "$boundary\@$domain";
+
+	$self->{contenttype} = "text/plain" unless $self->{contenttype};
+
+	for (qw(from to cc bcc subject)) {
+		next unless $self->{$_};
+		$self->{$_} =~ s/(\/|\\|\$)//g;
+		$self->{$_} =~ s/([\n\r\f])/$1 /g;
+	}
+
+	$self->{_message} = MIME::Lite->new(
+		'From' => $self->{from},
+		'To' => $self->{to},
+		'Cc'  => $self->{cc},
+		'Bcc'  => $self->{bcc},
+		'Subject' => Encode::encode('MIME-Header', $self->{subject}),
+		'Type' => 'TEXT',
+		'Data' => Encode::encode_utf8($self->{message}),
+		'Encoding' => '8bit',
+		'Message-ID' => $msg_id,
+	);
+	$self->{_message}->attr( 'Content-Type' => $self->{contenttype} );
+	$self->{_message}->attr( 'Content-Type.charset' => 'UTF-8' ) if
+		$self->{contenttype} =~ m#^text/#;
+	# Annoy people with read receipt requests
+	$self->{_message}->add( 'Disposition-Notification-To' => $self->{from} )
+	  if $self->{notify};
+	$self->{_message}->binmode(':utf8');
+}
+
+=head2 $mail->attach
+
+=cut
 
+sub attach {
+	my $self = shift;
+	my %args = @_;
+
+	carp "Message not prepared" unless ref $self->{_message};
+
+	# strip path from output name
+	my $file = $args{filename};
+	my $strip = quotemeta $args{strip};
+	$file =~ s/(.*\/|$strip)//g;
+
+	my @data;
+	if ($args{data}) {
+		@data = ('Data', $args{data});
+	} else {
+		@data = ('Path', $args{filename});
+	}
+
+	$self->{_message}->attach(
+		'Type' => $args{mimetype},
+		'Filename' => $file,
+		'Disposition' => 'attachment',
+		@data,
+		);
+}
+
+=head2 $mail->send
+
+Sends a prepared message using the method configured in ledgersmb.conf.
+
+=cut
+
+sub send {
+	my $self = shift;
+	carp "Message not prepared" unless ref $self->{_message};
+
+	$self->{_message}->replace( 'X-Mailer' => "LedgerSMB::Mailer $VERSION" );
+	if ( ${LedgerSMB::Sysconfig::smtphost} ) {
+		$self->{_message}->send(
+			'smtp',
+			${LedgerSMB::Sysconfig::smtphost},
+			Timeout => ${LedgerSMB::Sysconfig::smtptimeout}
+			) || return $!;
+	} else {
+		$self->{_message}->send(
+			'sendmail',
+			${LedgerSMB::Sysconfig::sendmail}
+			) || return $!;
+	}
 }
 
 1;