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