SL/Mailer/SMTP.pm

   1 package SL::Mailer::SMTP;
   2
   3 use strict;
   4
   5 use parent qw(Rose::Object);
   6
   7 use Rose::Object::MakeMethods::Generic
   8 (
   9   scalar => [ qw(myconfig mailer form) ]
  10 );
  11
  12 my %security_config = (
  13   none => { require_module => 'Net::SMTP',          package => 'Net::SMTP',      port =>  25 },
  14   tls  => { require_module => 'Net::SSLGlue::SMTP', package => 'Net::SMTP',      port =>  25 },
  15   ssl  => { require_module => 'Net::SMTP::SSL',     package => 'Net::SMTP::SSL', port => 465 },
  16 );
  17
  18 sub init {
  19   my ($self) = @_;
  20
  21   Rose::Object::init(@_);
  22
  23   my $cfg           = $::lx_office_conf{mail_delivery} || {};
  24   $self->{security} = exists $security_config{lc $cfg->{security}} ? lc $cfg->{security} : 'none';
  25   my $sec_cfg       = $security_config{ $self->{security} };
  26
  27   eval "require $sec_cfg->{require_module}" or die "$@";
  28
  29   $self->{smtp} = $sec_cfg->{package}->new($cfg->{host} || 'localhost', Port => $cfg->{port} || $sec_cfg->{port});
  30   die unless $self->{smtp};
  31
  32   $self->{smtp}->starttls(SSL_verify_mode => 0) || die if $self->{security} eq 'tls';
  33
  34   return 1 unless $cfg->{login};
  35
  36   $self->{smtp}->auth($cfg->{user}, $cfg->{password}) or die;
  37 }
  38
  39 sub start_mail {
  40   my ($self, %params) = @_;
  41
  42   $self->{smtp}->mail($params{from});
  43   $self->{smtp}->recipient(@{ $params{to} });
  44   $self->{smtp}->data;
  45 }
  46
  47 sub print {
  48   my $self = shift;
  49
  50   # SMTP requires at most 1000 characters per line. Each line must be
  51   # terminated with <CRLF>, meaning \r\n in Perl.
  52
  53   # First, normalize the string by removing all \r in order to fix
  54   # possible wrong combinations like \n\r.
  55   my $str = join '', @_;
  56   $str    =~ s/\r//g;
  57
  58   # Now remove the very last newline so that we don't create a
  59   # superfluous empty line at the very end.
  60   $str =~ s/\n$//;
  61
  62   # Split the string on newlines keeping trailing empty parts. This is
  63   # requires so that input like "Content-Disposition: ..... \n\n" is
  64   # treated correctly. That's also why we had to remove the very last
  65   # \n in the prior step.
  66   my @lines = split /\n/, $str, -1;
  67
  68   # Send each line terminating it with \r\n.
  69   $self->{smtp}->datasend("$_\r\n") for @lines;
  70 }
  71
  72 sub send {
  73   my ($self) = @_;
  74
  75   $self->{smtp}->dataend;
  76   $self->{smtp}->quit;
  77   delete $self->{smtp};
  78 }
  79
  80 sub keep_from_header {
  81   my ($self, $item) = @_;
  82   return lc($item) eq 'bcc';
  83 }
  84
  85 1;