path: root/LedgerSMB/Mailer.pm

=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 LedgerSMB::Sysconfig;

our $VERSION = '0.13';

=head2 LedgerSMB::Mailer->new(...)

Create a new Mailer object.  If any arguments are passed in, a message
that uses them will be automatically prepared but not sent.

=cut

sub new {
    my $type = shift;
    my $self = {};
    bless $self, $type;

    $self->prepare_message(@_) if @_;

    $self;
}

=head2 $mail->prepare_message(to => $to, from => $from, ...)

Prepares and encodes base message for sending or adding attachments.

=head3 Arguments

=over

=item to, from, cc, bcc

Address fields for the email.

=item subject

The subject for the email.

=item message

The message body for the email.

=item contenttype

The conttent type for the body of the message, not for any attachments.

=item notify

Sets the Disposition-Notification-To header (read receipt request) for the
message.  This header will only be added if a from address is set.

=back

=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(data => $data, filename => $name, strip => $strip)

Add an attachment to the prepared message.  If $data is specified, use the
value of that variable as the attachment value, otherwise attach the file
given by $name.  If both a filename and data are given, the data is attached
and given the name from filename.

$strip is an optional string to remove from the filename send with the
attachment.

=cut

sub attach {
    my $self = shift;
    my %args = @_;

    carp "Message not prepared" unless ref $self->{_message};
    if (defined $args{filename}) {
        if (!$args{filename}){
            carp "Invalid filename provided";
        } elsif (!defined $args{data} and !(-f $args{filename} and -r $args{filename})){
            carp "Cannot access file: $args{filename}";
        }
    } else {
        carp "No attachement supplied" unless defined $args{data};
    }

    # strip path from output name
    my $file;
    if ($args{filename}) {
        my $strip = quotemeta $args{strip};
        $file = $args{filename};
        $file =~ s/(.*\/|$strip)//g;
        }

    # handle both string and file types of input
    my @data;
    if (defined $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};

    # SC: Set the X-Mailer header here so that it will be the last
    #     header set.  This ensures that MIME::Lite will not rewrite
    #     it during the preparation of the 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;