FS/FS/Misc.pm

   1 package FS::Misc;
   2
   3 use strict;
   4 use vars qw ( @ISA @EXPORT_OK );
   5 use Exporter;
   6
   7 @ISA = qw( Exporter );
   8 @EXPORT_OK = qw( send_email );
   9
  10 =head1 NAME
  11
  12 FS::Misc - Miscellaneous subroutines
  13
  14 =head1 SYNOPSIS
  15
  16   use FS::Misc qw(send_email);
  17
  18   send_email();
  19
  20 =head1 DESCRIPTION
  21
  22 Miscellaneous subroutines.  This module contains miscellaneous subroutines
  23 called from multiple other modules.  These are not OO or necessarily related,
  24 but are collected here to elimiate code duplication.
  25
  26 =head1 SUBROUTINES
  27
  28 =over 4
  29
  30 =item send_email OPTION => VALUE ...
  31
  32 Options:
  33
  34 I<from> - (required)
  35
  36 I<to> - (required) comma-separated scalar or arrayref of recipients
  37
  38 I<subject> - (required)
  39
  40 I<content-type> - (optional) MIME type
  41
  42 I<body> - (required) arrayref of body text lines
  43
  44 I<mimeparts> - (optional) arrayref of MIME::Entity->build PARAMHASH refs, not MIME::Entity objects.  These will be passed as arguments to MIME::Entity->attach().
  45
  46 =cut
  47
  48 use vars qw( $conf );
  49 use Date::Format;
  50 use Mail::Header;
  51 use Mail::Internet 1.44;
  52 use MIME::Entity;
  53 use FS::UID;
  54
  55 FS::UID->install_callback( sub {
  56   $conf = new FS::Conf;
  57 } );
  58
  59 sub send_email {
  60   my(%options) = @_;
  61
  62   $ENV{MAILADDRESS} = $options{'from'};
  63   my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
  64
  65   my @mimeparts = (ref($options{'mimeparts'}) eq 'ARRAY')
  66                   ? @{$options{'mimeparts'}} : ();
  67   my $mimetype = (scalar(@mimeparts)) ? 'multipart/mixed' : 'text/plain';
  68
  69   my @mimeargs;
  70   if (scalar(@mimeparts)) {
  71     @mimeargs = (
  72       'Type'  => 'multipart/mixed',
  73     );
  74
  75     push @mimeparts,
  76       {
  77         'Data'        => $options{'body'},
  78         'Disposition' => 'inline',
  79         'Type'        => (($options{'content-type'} ne '')
  80                           ? $options{'content-type'} : 'text/plain'),
  81       };
  82   } else {
  83     @mimeargs = (
  84       'Type'  => (($options{'content-type'} ne '')
  85                   ? $options{'content-type'} : 'text/plain'),
  86       'Data'  => $options{'body'},
  87     );
  88   }
  89
  90   my $message = MIME::Entity->build(
  91     'From'      =>    $options{'from'},
  92     'To'        =>    $to,
  93     'Sender'    =>    $options{'from'},
  94     'Reply-To'  =>    $options{'from'},
  95     'Date'      =>    time2str("%a, %d %b %Y %X %z", time),
  96     'Subject'   =>    $options{'subject'},
  97     @mimeargs,
  98   );
  99
 100   foreach my $part (@mimeparts) {
 101     next unless ref($part) eq 'HASH'; #warn?
 102     $message->attach(%$part);
 103   }
 104
 105   my $smtpmachine = $conf->config('smtpmachine');
 106   $!=0;
 107
 108   $message->mysmtpsend( 'Host'     => $smtpmachine,
 109                         'MailFrom' => $options{'from'},
 110                       );
 111
 112 }
 113
 114 package Mail::Internet;
 115
 116 use Mail::Address;
 117 use Net::SMTP;
 118
 119 sub Mail::Internet::mysmtpsend {
 120     my $src  = shift;
 121     my %opt = @_;
 122     my $host = $opt{Host};
 123     my $envelope = $opt{MailFrom};
 124     my $noquit = 0;
 125     my $smtp;
 126     my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
 127
 128     push(@hello, 'Port', $opt{'Port'})
 129         if exists $opt{'Port'};
 130
 131     push(@hello, 'Debug', $opt{'Debug'})
 132         if exists $opt{'Debug'};
 133
 134     if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
 135         $smtp = $host;
 136         $noquit = 1;
 137     }
 138     else {
 139         #local $SIG{__DIE__};
 140         #$smtp = eval { Net::SMTP->new($host, @hello) };
 141         $smtp = new Net::SMTP $host, @hello;
 142     }
 143
 144     unless ( defined($smtp) ) {
 145       my $err = $!;
 146       $err =~ s/Invalid argument/Unknown host/;
 147       return "can't connect to $host: $err"
 148     }
 149
 150     my $hdr = $src->head->dup;
 151
 152     _prephdr($hdr);
 153
 154     # Who is it to
 155
 156     my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
 157     @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
 158         unless @rcpt;
 159     my @addr = map($_->address, Mail::Address->parse(@rcpt));
 160
 161     return 'No valid destination addresses found!'
 162         unless(@addr);
 163
 164     $hdr->delete('Bcc'); # Remove blind Cc's
 165
 166     # Send it
 167
 168     #warn "Headers: \n" . join('',@{$hdr->header});
 169     #warn "Body: \n" . join('',@{$src->body});
 170
 171     my $ok = $smtp->mail( $envelope ) &&
 172                 $smtp->to(@addr) &&
 173                 $smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
 174
 175     if ( $ok ) {
 176       $smtp->quit
 177           unless $noquit;
 178       return '';
 179     } else {
 180       return $smtp->code. ' '. $smtp->message;
 181     }
 182
 183 }
 184 package FS::Misc;
 185
 186 =head1 BUGS
 187
 188 This package exists.
 189
 190 =head1 SEE ALSO
 191
 192 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 193
 194 =cut
 195
 196 1;