summaryrefslogtreecommitdiff
path: root/LedgerSMB/Mailer.pm
blob: 473fa7cb83cf5ab712d9f8830db6ba9d3b9a9691 (plain)
  1. #=====================================================================
  2. # LedgerSMB
  3. # Small Medium Business Accounting software
  4. # http://www.ledgersmb.org/
  5. #
  6. # Copyright (C) 2006
  7. # This work contains copyrighted information from a number of sources all used
  8. # with permission.
  9. #
  10. # This file contains source code included with or based on SQL-Ledger which
  11. # is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed
  12. # under the GNU General Public License version 2 or, at your option, any later
  13. # version. For a full list including contact information of contributors,
  14. # maintainers, and copyright holders, see the CONTRIBUTORS file.
  15. #
  16. # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
  17. # Copyright (C) 2002
  18. #
  19. # Author: DWS Systems Inc.
  20. # Web: http://www.sql-ledger.org
  21. #
  22. # Contributors:
  23. #
  24. # Original Author and copyright holder:
  25. # Dieter Simader dsmimader@sql-ledger.com
  26. #======================================================================
  27. #
  28. # This file has undergone whitespace cleanup.
  29. #
  30. #======================================================================
  31. #
  32. # mailer package
  33. #
  34. #======================================================================
  35. package LedgerSMB::Mailer;
  36. use Encode;
  37. use MIME::Lite;
  38. use MIME::Base64;
  39. use LedgerSMB::Sysconfig;
  40. sub new {
  41. my ($type) = @_;
  42. my $self = {};
  43. bless $self, $type;
  44. }
  45. sub send {
  46. my ($self) = @_;
  47. my $domain = $self->{from};
  48. my $boundary = time;
  49. $boundary = "LSMB-$boundary";
  50. $domain =~ s/(.*?\@|>)//g;
  51. my $msg_id = "$boundary\@$domain";
  52. $self->{contenttype} = "text/plain" unless $self->{contenttype};
  53. for (qw(from to cc bcc)) {
  54. $self->{$_} =~ s/\&lt;/</g;
  55. $self->{$_} =~ s/\&gt;/>/g;
  56. $self->{$_} =~ s/(\/|\\|\$)//g;
  57. }
  58. my $msg = MIME::Lite->new(
  59. 'From' => $self->{from},
  60. 'To' => $self->{to},
  61. 'Cc' => $self->{cc},
  62. 'Bcc' => $self->{bcc},
  63. 'Subject' => Encode::encode('MIME-Header', $self->{subject}),
  64. 'Type' => 'TEXT',
  65. 'Data' => Encode::encode_utf8($self->{message}),
  66. 'Encoding' => '8bit',
  67. 'Message-ID' => $msg_id,
  68. );
  69. $msg->attr( 'Content-Type' => $self->{contenttype} );
  70. $msg->attr( 'Content-Type.charset' => 'UTF-8' ) if
  71. $self->{contenttype} =~ m#^text/#;
  72. $msg->add( 'Disposition-Notification-To' => $self->{from} )
  73. if $self->{notify};
  74. $msg->replace( 'X-Mailer' => "LedgerSMB $self->{version}" );
  75. $msg->binmode(':utf8');
  76. if ( @{ $self->{attachments} } ) {
  77. foreach my $attachment ( @{ $self->{attachments} } ) {
  78. my $application =
  79. ( $attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/ )
  80. ? "text"
  81. : "application";
  82. my $type = "$attachment/$self->{format}";
  83. $type .= '; charset="UTF-8"' if $attachment eq 'text';
  84. my $filename = $attachment;
  85. # strip path
  86. $filename =~ s/(.*\/|$self->{fileid})//g;
  87. $msg->attach(
  88. 'Type' => $type,
  89. 'Path' => $attachment,
  90. 'Filename' => $filename,
  91. 'Disposition' => 'attachment',
  92. );
  93. }
  94. }
  95. if ( ${LedgerSMB::Sysconfig::smtphost} ) {
  96. $msg->send(
  97. 'smtp',
  98. ${LedgerSMB::Sysconfig::smtphost},
  99. Timeout => ${LedgerSMB::Sysconfig::smtptimeout}
  100. ) || return $!;
  101. }
  102. else {
  103. $msg->send( 'sendmail', ${LedgerSMB::Sysconfig::sendmail} )
  104. || return $!;
  105. }
  106. return "";
  107. }
  108. 1;