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 send_fax );
   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 =item send_fax OPTION => VALUE ...
 115
 116 Options:
 117
 118 I<dialstring> - (required) 10-digit phone number w/ area code
 119
 120 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
 121
 122 -or-
 123
 124 I<docfile> - (required) Filename of PostScript TIFF Class F document
 125
 126 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
 127
 128
 129 =cut
 130
 131 sub send_fax {
 132
 133   my %options = @_;
 134
 135   die 'HylaFAX support has not been configured.'
 136     unless $conf->exists('hylafax');
 137
 138   eval {
 139     require Fax::Hylafax::Client;
 140   };
 141
 142   if ($@) {
 143     if ($@ =~ /^Can't locate Fax.*/) {
 144       die "You must have Fax::Hylafax::Client installed to use invoice faxing."
 145     } else {
 146       die $@;
 147     }
 148   }
 149
 150   my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
 151
 152   die 'Called send_fax without a \'dialstring\'.'
 153     unless exists($options{'dialstring'});
 154
 155   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
 156       my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
 157       my $fh = new File::Temp(
 158         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
 159         DIR      => $dir,
 160         UNLINK   => 0,
 161       ) or die "can't open temp file: $!\n";
 162
 163       $options{docfile} = $fh->filename;
 164
 165       print $fh @{$options{'docdata'}};
 166       close $fh;
 167
 168       delete $options{'docdata'};
 169   }
 170
 171   die 'Called send_fax without a \'docfile\' or \'docdata\'.'
 172     unless exists($options{'docfile'});
 173
 174   #FIXME: Need to send canonical dialstring to HylaFAX, but this only
 175   #       works in the US.
 176
 177   $options{'dialstring'} =~ s/[^\d\+]//g;
 178   if ($options{'dialstring'} =~ /^\d{10}$/) {
 179     $options{dialstring} = '+1' . $options{'dialstring'};
 180   } else {
 181     return 'Invalid dialstring ' . $options{'dialstring'} . '.';
 182   }
 183
 184   my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
 185
 186   if ($faxjob->success) {
 187     warn "Successfully queued fax to '$options{dialstring}' with jobid " .
 188             $faxjob->jobid;
 189   } else {
 190     return 'Error while sending FAX: ' . $faxjob->trace;
 191   }
 192
 193   return '';
 194
 195 }
 196
 197 package Mail::Internet;
 198
 199 use Mail::Address;
 200 use Net::SMTP;
 201
 202 sub Mail::Internet::mysmtpsend {
 203     my $src  = shift;
 204     my %opt = @_;
 205     my $host = $opt{Host};
 206     my $envelope = $opt{MailFrom};
 207     my $noquit = 0;
 208     my $smtp;
 209     my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
 210
 211     push(@hello, 'Port', $opt{'Port'})
 212         if exists $opt{'Port'};
 213
 214     push(@hello, 'Debug', $opt{'Debug'})
 215         if exists $opt{'Debug'};
 216
 217     if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
 218         $smtp = $host;
 219         $noquit = 1;
 220     }
 221     else {
 222         #local $SIG{__DIE__};
 223         #$smtp = eval { Net::SMTP->new($host, @hello) };
 224         $smtp = new Net::SMTP $host, @hello;
 225     }
 226
 227     unless ( defined($smtp) ) {
 228       my $err = $!;
 229       $err =~ s/Invalid argument/Unknown host/;
 230       return "can't connect to $host: $err"
 231     }
 232
 233     my $hdr = $src->head->dup;
 234
 235     _prephdr($hdr);
 236
 237     # Who is it to
 238
 239     my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
 240     @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
 241         unless @rcpt;
 242     my @addr = map($_->address, Mail::Address->parse(@rcpt));
 243
 244     return 'No valid destination addresses found!'
 245         unless(@addr);
 246
 247     $hdr->delete('Bcc'); # Remove blind Cc's
 248
 249     # Send it
 250
 251     #warn "Headers: \n" . join('',@{$hdr->header});
 252     #warn "Body: \n" . join('',@{$src->body});
 253
 254     my $ok = $smtp->mail( $envelope ) &&
 255                 $smtp->to(@addr) &&
 256                 $smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
 257
 258     if ( $ok ) {
 259       $smtp->quit
 260           unless $noquit;
 261       return '';
 262     } else {
 263       return $smtp->code. ' '. $smtp->message;
 264     }
 265
 266 }
 267 package FS::Misc;
 268
 269 =head1 BUGS
 270
 271 This package exists.
 272
 273 =head1 SEE ALSO
 274
 275 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 276
 277 L<Fax::Hylafax::Client>
 278
 279 =cut
 280
 281 1;