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   $options{'from'} =~ /\@([\w\.\-]+)/ or $1 = 'example.com';
 122   my $message_id = join('.', rand()*(2**32), $$, time). "\@$1";
 123
 124   my $message = MIME::Entity->build(
 125     'From'       => $options{'from'},
 126     'To'         => $to,
 127     'Sender'     => $options{'from'},
 128     'Reply-To'   => $options{'from'},
 129     'Date'       => time2str("%a, %d %b %Y %X %z", time),
 130     'Subject'    => $options{'subject'},
 131     'Message-ID' => "<$message_id>",
 132     @mimeargs,
 133   );
 134
 135   if ( $options{'type'} ) {
 136     #false laziness w/cust_bill::generate_email
 137     $message->head->replace('Content-type',
 138       $message->mime_type.
 139       '; boundary="'. $message->head->multipart_boundary. '"'.
 140       '; type='. $options{'type'}
 141     );
 142   }
 143
 144   foreach my $part (@mimeparts) {
 145
 146     if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
 147
 148       warn "attaching MIME part from MIME::Entity object\n"
 149         if $DEBUG;
 150       $message->add_part($part);
 151
 152     } elsif ( ref($part) eq 'HASH' ) {
 153
 154       warn "attaching MIME part from hashref:\n".
 155            join("\n", map "  $_: ".$part->{$_}, keys %$part ). "\n"
 156         if $DEBUG;
 157       $message->attach(%$part);
 158
 159     } else {
 160       croak "mimepart $part isn't a hashref or MIME::Entity object!";
 161     }
 162
 163   }
 164
 165   my $smtpmachine = $conf->config('smtpmachine');
 166   $!=0;
 167
 168   $message->mysmtpsend( 'Host'     => $smtpmachine,
 169                         'MailFrom' => $options{'from'},
 170                       );
 171
 172 }
 173
 174 =item send_fax OPTION => VALUE ...
 175
 176 Options:
 177
 178 I<dialstring> - (required) 10-digit phone number w/ area code
 179
 180 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
 181
 182 -or-
 183
 184 I<docfile> - (required) Filename of PostScript TIFF Class F document
 185
 186 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
 187
 188
 189 =cut
 190
 191 sub send_fax {
 192
 193   my %options = @_;
 194
 195   die 'HylaFAX support has not been configured.'
 196     unless $conf->exists('hylafax');
 197
 198   eval {
 199     require Fax::Hylafax::Client;
 200   };
 201
 202   if ($@) {
 203     if ($@ =~ /^Can't locate Fax.*/) {
 204       die "You must have Fax::Hylafax::Client installed to use invoice faxing."
 205     } else {
 206       die $@;
 207     }
 208   }
 209
 210   my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
 211
 212   die 'Called send_fax without a \'dialstring\'.'
 213     unless exists($options{'dialstring'});
 214
 215   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
 216       my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
 217       my $fh = new File::Temp(
 218         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
 219         DIR      => $dir,
 220         UNLINK   => 0,
 221       ) or die "can't open temp file: $!\n";
 222
 223       $options{docfile} = $fh->filename;
 224
 225       print $fh @{$options{'docdata'}};
 226       close $fh;
 227
 228       delete $options{'docdata'};
 229   }
 230
 231   die 'Called send_fax without a \'docfile\' or \'docdata\'.'
 232     unless exists($options{'docfile'});
 233
 234   #FIXME: Need to send canonical dialstring to HylaFAX, but this only
 235   #       works in the US.
 236
 237   $options{'dialstring'} =~ s/[^\d\+]//g;
 238   if ($options{'dialstring'} =~ /^\d{10}$/) {
 239     $options{dialstring} = '+1' . $options{'dialstring'};
 240   } else {
 241     return 'Invalid dialstring ' . $options{'dialstring'} . '.';
 242   }
 243
 244   my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
 245
 246   if ($faxjob->success) {
 247     warn "Successfully queued fax to '$options{dialstring}' with jobid " .
 248            $faxjob->jobid
 249       if $DEBUG;
 250     return '';
 251   } else {
 252     return 'Error while sending FAX: ' . $faxjob->trace;
 253   }
 254
 255 }
 256
 257 package Mail::Internet;
 258
 259 use Mail::Address;
 260 use Net::SMTP;
 261
 262 sub Mail::Internet::mysmtpsend {
 263     my $src  = shift;
 264     my %opt = @_;
 265     my $host = $opt{Host};
 266     my $envelope = $opt{MailFrom};
 267     my $noquit = 0;
 268     my $smtp;
 269     my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
 270
 271     push(@hello, 'Port', $opt{'Port'})
 272         if exists $opt{'Port'};
 273
 274     push(@hello, 'Debug', $opt{'Debug'})
 275         if exists $opt{'Debug'};
 276
 277     if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
 278         $smtp = $host;
 279         $noquit = 1;
 280     }
 281     else {
 282         #local $SIG{__DIE__};
 283         #$smtp = eval { Net::SMTP->new($host, @hello) };
 284         $smtp = new Net::SMTP $host, @hello;
 285     }
 286
 287     unless ( defined($smtp) ) {
 288       my $err = $!;
 289       $err =~ s/Invalid argument/Unknown host/;
 290       return "can't connect to $host: $err"
 291     }
 292
 293     my $hdr = $src->head->dup;
 294
 295     _prephdr($hdr);
 296
 297     # Who is it to
 298
 299     my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
 300     @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
 301         unless @rcpt;
 302     my @addr = map($_->address, Mail::Address->parse(@rcpt));
 303
 304     return 'No valid destination addresses found!'
 305         unless(@addr);
 306
 307     $hdr->delete('Bcc'); # Remove blind Cc's
 308
 309     # Send it
 310
 311     #warn "Headers: \n" . join('',@{$hdr->header});
 312     #warn "Body: \n" . join('',@{$src->body});
 313
 314     my $ok = $smtp->mail( $envelope ) &&
 315                 $smtp->to(@addr) &&
 316                 $smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
 317
 318     if ( $ok ) {
 319       $smtp->quit
 320           unless $noquit;
 321       return '';
 322     } else {
 323       return $smtp->code. ' '. $smtp->message;
 324     }
 325
 326 }
 327 package FS::Misc;
 328
 329 =head1 BUGS
 330
 331 This package exists.
 332
 333 =head1 SEE ALSO
 334
 335 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 336
 337 L<Fax::Hylafax::Client>
 338
 339 =cut
 340
 341 1;