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 Fax::Hylafax::Client;
  54 use FS::UID;
  55
  56 FS::UID->install_callback( sub {
  57   $conf = new FS::Conf;
  58 } );
  59
  60 sub send_email {
  61   my(%options) = @_;
  62
  63   $ENV{MAILADDRESS} = $options{'from'};
  64   my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
  65
  66   my @mimeparts = (ref($options{'mimeparts'}) eq 'ARRAY')
  67                   ? @{$options{'mimeparts'}} : ();
  68   my $mimetype = (scalar(@mimeparts)) ? 'multipart/mixed' : 'text/plain';
  69
  70   my @mimeargs;
  71   if (scalar(@mimeparts)) {
  72     @mimeargs = (
  73       'Type'  => 'multipart/mixed',
  74     );
  75
  76     push @mimeparts,
  77       {
  78         'Data'        => $options{'body'},
  79         'Disposition' => 'inline',
  80         'Type'        => (($options{'content-type'} ne '')
  81                           ? $options{'content-type'} : 'text/plain'),
  82       };
  83   } else {
  84     @mimeargs = (
  85       'Type'  => (($options{'content-type'} ne '')
  86                   ? $options{'content-type'} : 'text/plain'),
  87       'Data'  => $options{'body'},
  88     );
  89   }
  90
  91   my $message = MIME::Entity->build(
  92     'From'      =>    $options{'from'},
  93     'To'        =>    $to,
  94     'Sender'    =>    $options{'from'},
  95     'Reply-To'  =>    $options{'from'},
  96     'Date'      =>    time2str("%a, %d %b %Y %X %z", time),
  97     'Subject'   =>    $options{'subject'},
  98     @mimeargs,
  99   );
 100
 101   foreach my $part (@mimeparts) {
 102     next unless ref($part) eq 'HASH'; #warn?
 103     $message->attach(%$part);
 104   }
 105
 106   my $smtpmachine = $conf->config('smtpmachine');
 107   $!=0;
 108
 109   $message->mysmtpsend( 'Host'     => $smtpmachine,
 110                         'MailFrom' => $options{'from'},
 111                       );
 112
 113 }
 114
 115 =item send_fax OPTION => VALUE ...
 116
 117 Options:
 118
 119 I<dialstring> - (required) 10-digit phone number w/ area code
 120
 121 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
 122
 123 -or-
 124
 125 I<docfile> - (required) Filename of PostScript TIFF Class F document
 126
 127 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
 128
 129
 130 =cut
 131
 132 sub send_fax {
 133
 134   my %options = @_;
 135
 136   die 'HylaFAX support has not been configured.'
 137     unless $conf->exists('hylafax');
 138
 139   my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
 140
 141   die 'Called send_fax without a \'dialstring\'.'
 142     unless exists($options{'dialstring'});
 143
 144   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
 145       my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
 146       my $fh = new File::Temp(
 147         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
 148         DIR      => $dir,
 149         UNLINK   => 0,
 150       ) or die "can't open temp file: $!\n";
 151
 152       $options{docfile} = $fh->filename;
 153
 154       print $fh @{$options{'docdata'}};
 155       close $fh;
 156
 157       delete $options{'docdata'};
 158   }
 159
 160   die 'Called send_fax without a \'docfile\' or \'docdata\'.'
 161     unless exists($options{'docfile'});
 162
 163   #FIXME: Need to send canonical dialstring to HylaFAX, but this only
 164   #       works in the US.
 165
 166   $options{'dialstring'} =~ s/[^\d\+]//g;
 167   if ($options{'dialstring'} =~ /^\d{10}$/) {
 168     $options{dialstring} = '+1' . $options{'dialstring'};
 169   } else {
 170     return 'Invalid dialstring ' . $options{'dialstring'} . '.';
 171   }
 172
 173   my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
 174
 175   if ($faxjob->success) {
 176     warn "Successfully queued fax to '$options{dialstring}' with jobid " .
 177             $faxjob->jobid;
 178   } else {
 179     return 'Error while sending FAX: ' . $faxjob->trace;
 180   }
 181
 182   return '';
 183
 184 }
 185
 186 package Mail::Internet;
 187
 188 use Mail::Address;
 189 use Net::SMTP;
 190
 191 sub Mail::Internet::mysmtpsend {
 192     my $src  = shift;
 193     my %opt = @_;
 194     my $host = $opt{Host};
 195     my $envelope = $opt{MailFrom};
 196     my $noquit = 0;
 197     my $smtp;
 198     my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
 199
 200     push(@hello, 'Port', $opt{'Port'})
 201         if exists $opt{'Port'};
 202
 203     push(@hello, 'Debug', $opt{'Debug'})
 204         if exists $opt{'Debug'};
 205
 206     if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
 207         $smtp = $host;
 208         $noquit = 1;
 209     }
 210     else {
 211         #local $SIG{__DIE__};
 212         #$smtp = eval { Net::SMTP->new($host, @hello) };
 213         $smtp = new Net::SMTP $host, @hello;
 214     }
 215
 216     unless ( defined($smtp) ) {
 217       my $err = $!;
 218       $err =~ s/Invalid argument/Unknown host/;
 219       return "can't connect to $host: $err"
 220     }
 221
 222     my $hdr = $src->head->dup;
 223
 224     _prephdr($hdr);
 225
 226     # Who is it to
 227
 228     my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
 229     @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
 230         unless @rcpt;
 231     my @addr = map($_->address, Mail::Address->parse(@rcpt));
 232
 233     return 'No valid destination addresses found!'
 234         unless(@addr);
 235
 236     $hdr->delete('Bcc'); # Remove blind Cc's
 237
 238     # Send it
 239
 240     #warn "Headers: \n" . join('',@{$hdr->header});
 241     #warn "Body: \n" . join('',@{$src->body});
 242
 243     my $ok = $smtp->mail( $envelope ) &&
 244                 $smtp->to(@addr) &&
 245                 $smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
 246
 247     if ( $ok ) {
 248       $smtp->quit
 249           unless $noquit;
 250       return '';
 251     } else {
 252       return $smtp->code. ' '. $smtp->message;
 253     }
 254
 255 }
 256 package FS::Misc;
 257
 258 =head1 BUGS
 259
 260 This package exists.
 261
 262 =head1 SEE ALSO
 263
 264 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
 265
 266 L<Fax::Hylafax::Client>
 267
 268 =cut
 269
 270 1;