FS/FS/Misc.pm

   1 package FS::Misc;
   2
   3 use strict;
   4 use vars qw ( @ISA @EXPORT_OK $DEBUG );
   5 use Exporter;
   6 use Carp;
   7
   8 @ISA = qw( Exporter );
   9 @EXPORT_OK = qw( send_email send_fax );
  10
  11 $DEBUG = 0;
  12
  13 =head1 NAME
  14
  15 FS::Misc - Miscellaneous subroutines
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::Misc qw(send_email);
  20
  21   send_email();
  22
  23 =head1 DESCRIPTION
  24
  25 Miscellaneous subroutines.  This module contains miscellaneous subroutines
  26 called from multiple other modules.  These are not OO or necessarily related,
  27 but are collected here to elimiate code duplication.
  28
  29 =head1 SUBROUTINES
  30
  31 =over 4
  32
  33 =item send_email OPTION => VALUE ...
  34
  35 Options:
  36
  37 I<from> - (required)
  38
  39 I<to> - (required) comma-separated scalar or arrayref of recipients
  40
  41 I<subject> - (required)
  42
  43 I<content-type> - (optional) MIME type for the body
  44
  45 I<body> - (required unless I<nobody> is true) arrayref of body text lines
  46
  47 I<mimeparts> - (optional, but required if I<nobody> is true) arrayref of MIME::Entity->build PARAMHASH refs or MIME::Entity objects.  These will be passed as arguments to MIME::Entity->attach().
  48
  49 I<nobody> - (optional) when set true, send_email will ignore the I<body> option and simply construct a message with the given I<mimeparts>.  In this case,
  50 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
  51
  52 I<content-encoding> - (optional) when using nobody, optional top-level MIME
  53 encoding which, if specified, overrides the default "7bit".
  54
  55 I<type> - (optional) type parameter for multipart/related messages
  56
  57 =cut
  58
  59 use vars qw( $conf );
  60 use Date::Format;
  61 use Mail::Header;
  62 use Mail::Internet 1.44;
  63 use MIME::Entity;
  64 use FS::UID;
  65
  66 FS::UID->install_callback( sub {
  67   $conf = new FS::Conf;
  68 } );
  69
  70 sub send_email {
  71   my(%options) = @_;
  72
  73   $ENV{MAILADDRESS} = $options{'from'};
  74   my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
  75
  76   my @mimeargs = ();
  77   my @mimeparts = ();
  78   if ( $options{'nobody'} ) {
  79
  80     croak "'mimeparts' option required when 'nobody' option given\n"
  81       unless $options{'mimeparts'};
  82
  83     @mimeparts = @{$options{'mimeparts'}};
  84
  85     @mimeargs = (
  86       'Type'         => ( $options{'content-type'} || 'multipart/mixed' ),
  87       'Encoding'     => ( $options{'content-encoding'} || '7bit' ),
  88     );
  89
  90   } else {
  91
  92     @mimeparts = @{$options{'mimeparts'}}
  93       if ref($options{'mimeparts'}) eq 'ARRAY';
  94
  95     if (scalar(@mimeparts)) {
  96
  97       @mimeargs = (
  98         'Type'     => 'multipart/mixed',
  99         'Encoding' => '7bit',
 100       );
 101
 102       unshift @mimeparts, {
 103         'Type'        => ( $options{'content-type'} || 'text/plain' ),
 104         'Data'        => $options{'body'},
 105         'Encoding'    => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
 106         'Disposition' => 'inline',
 107       };
 108
 109     } else {
 110
 111       @mimeargs = (
 112         'Type'     => ( $options{'content-type'} || 'text/plain' ),
 113         'Data'     => $options{'body'},
 114         'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
 115       );
 116
 117     }
 118
 119   }
 120
 121   my $domain;
 122   if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
 123     $domain = $1;
 124   } else {
 125     $domain = 'example.com';
 126   }
 127   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
 128
 129   my $message = MIME::Entity->build(
 130     'From'       => $options{'from'},
 131     'To'         => $to,
 132     'Sender'     => $options{'from'},
 133     'Reply-To'   => $options{'from'},
 134     'Date'       => time2str("%a, %d %b %Y %X %z", time),
 135     'Subject'    => $options{'subject'},
 136     'Message-ID' => "<$message_id>",
 137     @mimeargs,
 138   );
 139
 140   if ( $options{'type'} ) {
 141     #false laziness w/cust_bill::generate_email
 142     $message->head->replace('Content-type',
 143       $message->mime_type.
 144       '; boundary="'. $message->head->multipart_boundary. '"'.
 145       '; type='. $options{'type'}
 146     );
 147   }
 148
 149   foreach my $part (@mimeparts) {
 150
 151     if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
 152
 153       warn "attaching MIME part from MIME::Entity object\n"
 154         if $DEBUG;
 155       $message->add_part($part);
 156
 157     } elsif ( ref($part) eq 'HASH' ) {
 158
 159       warn "attaching MIME part from hashref:\n".
 160            join("\n", map "  $_: ".$part->{$_}, keys %$part ). "\n"
 161         if $DEBUG;
 162       $message->attach(%$part);
 163
 164     } else {
 165       croak "mimepart $part isn't a hashref or MIME::Entity object!";
 166     }
 167
 168   }
 169
 170   my $smtpmachine = $conf->config('smtpmachine');
 171   $!=0;
 172
 173   $message->mysmtpsend( 'Host'     => $smtpmachine,
 174                         'MailFrom' => $options{'from'},
 175                       );
 176
 177 }
 178
 179 =item send_fax OPTION => VALUE ...
 180
 181 Options:
 182
 183 I<dialstring> - (required) 10-digit phone number w/ area code
 184
 185 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
 186
 187 -or-
 188
 189 I<docfile> - (required) Filename of PostScript TIFF Class F document
 190
 191 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
 192
 193
 194 =cut
 195
 196 sub send_fax {
 197
 198   my %options = @_;
 199
 200   die 'HylaFAX support has not been configured.'
 201     unless $conf->exists('hylafax');
 202
 203   eval {
 204     require Fax::Hylafax::Client;
 205   };
 206
 207   if ($@) {
 208     if ($@ =~ /^Can't locate Fax.*/) {
 209       die "You must have Fax::Hylafax::Client installed to use invoice faxing."
 210     } else {
 211       die $@;
 212     }
 213   }
 214
 215   my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
 216
 217   die 'Called send_fax without a \'dialstring\'.'
 218     unless exists($options{'dialstring'});
 219
 220   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
 221       my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
 222       my $fh = new File::Temp(
 223         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
 224         DIR      => $dir,
 225         UNLINK   => 0,
 226       ) or die "can't open temp file: $!\n";
 227
 228       $options{docfile} = $fh->filename;
 229
 230       print $fh @{$options{'docdata'}};
 231       close $fh;
 232
 233       delete $options{'docdata'};
 234   }
 235
 236   die 'Called send_fax without a \'docfile\' or \'docdata\'.'
 237     unless exists($options{'docfile'});
 238
 239   #FIXME: Need to send canonical dialstring to HylaFAX, but this only
 240   #       works in the US.
 241
 242   $options{'dialstring'} =~ s/[^\d\+]//g;
 243   if ($options{'dialstring'} =~ /^\d{10}$/) {
 244     $options{dialstring} = '+1' . $options{'dialstring'};
 245   } else {
 246     return 'Invalid dialstring ' . $options{'dialstring'} . '.';
 247   }
 248
 249   my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
 250
 251   if ($faxjob->success) {
 252     warn "Successfully queued fax to '$options{dialstring}' with jobid " .
 253            $faxjob->jobid
 254       if $DEBUG;
 255     return '';
 256   } else {
 257     return 'Error while sending FAX: ' . $faxjob->trace;
 258   }
 259
 260 }
 261
 262 package Mail::Internet;
 263
 264 use Mail::Address;
 265 use Net::SMTP;
 266
 267 sub Mail::Internet::mysmtpsend {
 268     my $src  = shift;
 269     my %opt = @_;
 270     my $host = $opt{Host};
 271     my $envelope = $opt{MailFrom};
 272     my $noquit = 0;
 273     my $smtp;
 274     my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
 275
 276     push(@hello, 'Port', $opt{'Port'})
 277         if exists $opt{'Port'};
 278
 279     push(@hello, 'Debug', $opt{'Debug'})
 280         if exists $opt{'Debug'};
 281
 282     if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
 283         $smtp = $host;
 284         $noquit = 1;
 285     }
 286     else {
 287         #local $SIG{__DIE__};
 288         #$smtp = eval { Net::SMTP->new($host, @hello) };
 289         $smtp = new Net::SMTP $host, @hello;
 290     }
 291
 292     unless ( defined($smtp) ) {
 293       my $err = $!;
 294       $err =~ s/Invalid argument/Unknown host/;
 295       return "can't connect to $host: $err"
 296     }
 297
 298     my $hdr = $src->head->dup;
 299
 300     _prephdr($hdr);
 301
 302     # Who is it to
 303
 304     my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
 305     @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
 306         unless @rcpt;
 307     my @addr = map($_->address, Mail::Address->parse(@rcpt));
 308
 309     return 'No valid destination addresses found!'
 310         unless(@addr);
 311
 312     $hdr->delete('Bcc'); # Remove blind Cc's
 313
 314     # Send it
 315
 316     #warn "Headers: \n" . join('',@{$hdr->header});
 317     #warn "Body: \n" . join('',@{$src->body});
 318
 319     my $ok = $smtp->mail( $envelope ) &&
 320                 $smtp->to(@addr) &&
 321                 $smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
 322
 323     if ( $ok ) {
 324       $smtp->quit
 325           unless $noquit;
 326       return '';
 327     } else {
 328       return $smtp->code. ' '. $smtp->message;
 329     }
 330
 331 }
 332 package FS::Misc;
 333
 334 =head1 BUGS
 335
 336 This package exists.
 337
 338 =head1 SEE ALSO
 339
 340 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 341
 342 L<Fax::Hylafax::Client>
 343
 344 =cut
 345
 346 1;