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 =cut
  45
  46 use vars qw( $conf );
  47 use Date::Format;
  48 use Mail::Header;
  49 use Mail::Internet 1.44;
  50 use FS::UID;
  51
  52 FS::UID->install_callback( sub {
  53   $conf = new FS::Conf;
  54 } );
  55
  56 sub send_email {
  57   my(%options) = @_;
  58
  59   $ENV{MAILADDRESS} = $options{'from'};
  60   my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
  61   my @header = (
  62     'From: '.     $options{'from'},
  63     'To: '.       $to,
  64     'Sender: '.   $options{'from'},
  65     'Reply-To: '. $options{'from'},
  66     'Date: '.     time2str("%a, %d %b %Y %X %z", time),
  67     'Subject: '.  $options{'subject'},
  68   );
  69   push @header, 'Content-Type: '. $options{'content-type'}
  70     if exists($options{'content-type'});
  71   my $header = new Mail::Header ( \@header );
  72
  73   my $message = new Mail::Internet (
  74     'Header' => $header,
  75     'Body'   => $options{'body'},
  76   );
  77
  78   my $smtpmachine = $conf->config('smtpmachine');
  79   $!=0;
  80
  81   $message->mysmtpsend( 'Host'     => $smtpmachine,
  82                         'MailFrom' => $options{'from'},
  83                       );
  84
  85 }
  86
  87 package Mail::Internet;
  88
  89 use Mail::Address;
  90 use Net::SMTP;
  91
  92 sub Mail::Internet::mysmtpsend {
  93     my $src  = shift;
  94     my %opt = @_;
  95     my $host = $opt{Host};
  96     my $envelope = $opt{MailFrom};
  97     my $noquit = 0;
  98     my $smtp;
  99     my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
 100
 101     push(@hello, 'Port', $opt{'Port'})
 102         if exists $opt{'Port'};
 103
 104     push(@hello, 'Debug', $opt{'Debug'})
 105         if exists $opt{'Debug'};
 106
 107     if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
 108         $smtp = $host;
 109         $noquit = 1;
 110     }
 111     else {
 112         #local $SIG{__DIE__};
 113         #$smtp = eval { Net::SMTP->new($host, @hello) };
 114         $smtp = new Net::SMTP $host, @hello;
 115     }
 116
 117     unless ( defined($smtp) ) {
 118       my $err = $!;
 119       $err =~ s/Invalid argument/Unknown host/;
 120       return "can't connect to $host: $err"
 121     }
 122
 123     my $hdr = $src->head->dup;
 124
 125     _prephdr($hdr);
 126
 127     # Who is it to
 128
 129     my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
 130     @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
 131         unless @rcpt;
 132     my @addr = map($_->address, Mail::Address->parse(@rcpt));
 133
 134     return 'No valid destination addresses found!'
 135         unless(@addr);
 136
 137     $hdr->delete('Bcc'); # Remove blind Cc's
 138
 139     # Send it
 140
 141     my $ok = $smtp->mail( $envelope ) &&
 142                 $smtp->to(@addr) &&
 143                 $smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
 144
 145     if ( $ok ) {
 146       $smtp->quit
 147           unless $noquit;
 148       return '';
 149     } else {
 150       return $smtp->code. ' '. $smtp->message;
 151     }
 152
 153 }
 154 package FS::Misc;
 155
 156 =head1 BUGS
 157
 158 This package exists.
 159
 160 =head1 SEE ALSO
 161
 162 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 163
 164 =cut
 165
 166 1;