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   my $rv = $message->smtpsend( 'Host' => $smtpmachine )
  82     or $message->smtpsend( Host => $smtpmachine, Debug => 1 );
  83
  84   if ($rv) { #smtpsend returns a list of addresses, not true/false
  85     return '';
  86   } else {
  87     return "can't send email to $to via server $smtpmachine with SMTP: $!";
  88   }
  89
  90 }
  91
  92 =head1 BUGS
  93
  94 This package exists.
  95
  96 =head1 SEE ALSO
  97
  98 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
  99
 100 =cut
 101
 102 1;