summaryrefslogtreecommitdiff
path: root/LedgerSMB/Mailer.pm
blob: a650d4e11101129592c2c2eb384d355bae4237ba (plain)
  1. =head1 NAME
  2. LedgerSMB::Mailer Mail output for LedgerSMB
  3. =head1 SYNOPSIS
  4. =head1 COPYRIGHT
  5. #====================================================================
  6. # LedgerSMB
  7. # Small Medium Business Accounting software
  8. # http://www.ledgersmb.org/
  9. #
  10. # Copyright (C) 2006
  11. # This work contains copyrighted information from a number of sources
  12. # all used with permission.
  13. #
  14. # This file contains source code included with or based on SQL-Ledger
  15. # which # is Copyright Dieter Simader and DWS Systems Inc. 2000-2005
  16. # and licensed under the GNU General Public License version 2 or, at
  17. # your option, any later version. For a full list including contact
  18. # information of contributors, maintainers, and copyright holders,
  19. # see the CONTRIBUTORS file.
  20. #
  21. # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
  22. # Copyright (C) 2002
  23. #
  24. # Author: DWS Systems Inc.
  25. # Web: http://www.sql-ledger.org
  26. #
  27. # Contributors:
  28. #
  29. # Original Author and copyright holder:
  30. # Dieter Simader dsmimader@sql-ledger.com
  31. #====================================================================
  32. =head1 METHODS
  33. =cut
  34. package LedgerSMB::Mailer;
  35. use warnings;
  36. use strict;
  37. use Carp;
  38. use Encode;
  39. use MIME::Lite;
  40. use LedgerSMB::Sysconfig;
  41. our $VERSION = '0.13';
  42. =head2 LedgerSMB::Mailer->new([%args])
  43. Create a new Mailer object. If any arguments are passed in, a message
  44. that uses them will be automatically prepared.
  45. =cut
  46. sub new {
  47. my $type = shift;
  48. my $self = {};
  49. bless $self, $type;
  50. $self->prepare_message(@_) if @_;
  51. $self;
  52. }
  53. =head2 $mail->prepare_message
  54. =cut
  55. sub prepare_message {
  56. my $self = shift;
  57. my %args = @_;
  58. # Populate message fields
  59. for my $key (keys %args) {
  60. $self->{$key} = $args{$key};
  61. }
  62. my $domain = $self->{from};
  63. $domain =~ s/(.*?\@|>)//g;
  64. my $boundary = time;
  65. $boundary = "LSMB-$boundary";
  66. my $msg_id = "$boundary\@$domain";
  67. $self->{contenttype} = "text/plain" unless $self->{contenttype};
  68. for (qw(from to cc bcc subject)) {
  69. next unless $self->{$_};
  70. $self->{$_} =~ s/(\/|\\|\$)//g;
  71. $self->{$_} =~ s/([\n\r\f])/$1 /g;
  72. }
  73. $self->{_message} = MIME::Lite->new(
  74. 'From' => $self->{from},
  75. 'To' => $self->{to},
  76. 'Cc' => $self->{cc},
  77. 'Bcc' => $self->{bcc},
  78. 'Subject' => Encode::encode('MIME-Header', $self->{subject}),
  79. 'Type' => 'TEXT',
  80. 'Data' => Encode::encode_utf8($self->{message}),
  81. 'Encoding' => '8bit',
  82. 'Message-ID' => $msg_id,
  83. );
  84. $self->{_message}->attr( 'Content-Type' => $self->{contenttype} );
  85. $self->{_message}->attr( 'Content-Type.charset' => 'UTF-8' ) if
  86. $self->{contenttype} =~ m#^text/#;
  87. # Annoy people with read receipt requests
  88. $self->{_message}->add( 'Disposition-Notification-To' => $self->{from} )
  89. if $self->{notify};
  90. $self->{_message}->binmode(':utf8');
  91. }
  92. =head2 $mail->attach
  93. =cut
  94. sub attach {
  95. my $self = shift;
  96. my %args = @_;
  97. carp "Message not prepared" unless ref $self->{_message};
  98. # strip path from output name
  99. my $file;
  100. if ($args{filename}) {
  101. my $strip = quotemeta $args{strip};
  102. $file = $args{filename};
  103. $file =~ s/(.*\/|$strip)//g;
  104. }
  105. # handle both string and file types of input
  106. my @data;
  107. if ($args{data}) {
  108. @data = ('Data', $args{data});
  109. } else {
  110. @data = ('Path', $args{filename});
  111. }
  112. $self->{_message}->attach(
  113. 'Type' => $args{mimetype},
  114. 'Filename' => $file,
  115. 'Disposition' => 'attachment',
  116. @data,
  117. );
  118. }
  119. =head2 $mail->send
  120. Sends a prepared message using the method configured in ledgersmb.conf.
  121. =cut
  122. sub send {
  123. my $self = shift;
  124. carp "Message not prepared" unless ref $self->{_message};
  125. $self->{_message}->replace( 'X-Mailer' => "LedgerSMB::Mailer $VERSION" );
  126. if ( ${LedgerSMB::Sysconfig::smtphost} ) {
  127. $self->{_message}->send(
  128. 'smtp',
  129. ${LedgerSMB::Sysconfig::smtphost},
  130. Timeout => ${LedgerSMB::Sysconfig::smtptimeout}
  131. ) || return $!;
  132. } else {
  133. $self->{_message}->send(
  134. 'sendmail',
  135. ${LedgerSMB::Sysconfig::sendmail}
  136. ) || return $!;
  137. }
  138. }
  139. 1;