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