4 use vars qw ( @ISA @EXPORT_OK $DEBUG );
7 use FS::Record qw(dbh qsearch);
8 use FS::cust_credit_refund;
9 #use FS::cust_credit_bill;
10 #use FS::cust_bill_pay;
11 #use FS::cust_pay_refund;
14 @ISA = qw( Exporter );
15 @EXPORT_OK = qw( send_email send_fax
16 states_hash counties state_label
17 card_types prune_applications
24 FS::Misc - Miscellaneous subroutines
28 use FS::Misc qw(send_email);
34 Miscellaneous subroutines. This module contains miscellaneous subroutines
35 called from multiple other modules. These are not OO or necessarily related,
36 but are collected here to elimiate code duplication.
42 =item send_email OPTION => VALUE ...
48 I<to> - (required) comma-separated scalar or arrayref of recipients
50 I<subject> - (required)
52 I<content-type> - (optional) MIME type for the body
54 I<body> - (required unless I<nobody> is true) arrayref of body text lines
56 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().
58 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,
59 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
61 I<content-encoding> - (optional) when using nobody, optional top-level MIME
62 encoding which, if specified, overrides the default "7bit".
64 I<type> - (optional) type parameter for multipart/related messages
71 use Mail::Internet 1.44;
75 FS::UID->install_callback( sub {
82 my %doptions = %options;
83 $doptions{'body'} = '(full body not shown in debug)';
84 warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
85 # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
88 $ENV{MAILADDRESS} = $options{'from'};
89 my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
93 if ( $options{'nobody'} ) {
95 croak "'mimeparts' option required when 'nobody' option given\n"
96 unless $options{'mimeparts'};
98 @mimeparts = @{$options{'mimeparts'}};
101 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
102 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
107 @mimeparts = @{$options{'mimeparts'}}
108 if ref($options{'mimeparts'}) eq 'ARRAY';
110 if (scalar(@mimeparts)) {
113 'Type' => 'multipart/mixed',
114 'Encoding' => '7bit',
117 unshift @mimeparts, {
118 'Type' => ( $options{'content-type'} || 'text/plain' ),
119 'Data' => $options{'body'},
120 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
121 'Disposition' => 'inline',
127 'Type' => ( $options{'content-type'} || 'text/plain' ),
128 'Data' => $options{'body'},
129 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
137 if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
140 warn 'no domain found in invoice from address '. $options{'from'}.
141 '; constructing Message-ID @example.com';
142 $domain = 'example.com';
144 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
146 my $message = MIME::Entity->build(
147 'From' => $options{'from'},
149 'Sender' => $options{'from'},
150 'Reply-To' => $options{'from'},
151 'Date' => time2str("%a, %d %b %Y %X %z", time),
152 'Subject' => $options{'subject'},
153 'Message-ID' => "<$message_id>",
157 if ( $options{'type'} ) {
158 #false laziness w/cust_bill::generate_email
159 $message->head->replace('Content-type',
161 '; boundary="'. $message->head->multipart_boundary. '"'.
162 '; type='. $options{'type'}
166 foreach my $part (@mimeparts) {
168 if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
170 warn "attaching MIME part from MIME::Entity object\n"
172 $message->add_part($part);
174 } elsif ( ref($part) eq 'HASH' ) {
176 warn "attaching MIME part from hashref:\n".
177 join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
179 $message->attach(%$part);
182 croak "mimepart $part isn't a hashref or MIME::Entity object!";
187 my $smtpmachine = $conf->config('smtpmachine');
190 $message->mysmtpsend( 'Host' => $smtpmachine,
191 'MailFrom' => $options{'from'},
196 #this kludges a "mysmtpsend" method into Mail::Internet for send_email above
197 package Mail::Internet;
202 sub Mail::Internet::mysmtpsend {
205 my $host = $opt{Host};
206 my $envelope = $opt{MailFrom};
209 my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
211 push(@hello, 'Port', $opt{'Port'})
212 if exists $opt{'Port'};
214 push(@hello, 'Debug', $opt{'Debug'})
215 if exists $opt{'Debug'};
217 if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
222 #local $SIG{__DIE__};
223 #$smtp = eval { Net::SMTP->new($host, @hello) };
224 $smtp = new Net::SMTP $host, @hello;
227 unless ( defined($smtp) ) {
229 $err =~ s/Invalid argument/Unknown host/;
230 return "can't connect to $host: $err"
233 my $hdr = $src->head->dup;
239 my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
240 @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
242 my @addr = map($_->address, Mail::Address->parse(@rcpt));
244 return 'No valid destination addresses found!'
247 $hdr->delete('Bcc'); # Remove blind Cc's
251 #warn "Headers: \n" . join('',@{$hdr->header});
252 #warn "Body: \n" . join('',@{$src->body});
254 my $ok = $smtp->mail( $envelope ) &&
256 $smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
263 return $smtp->code. ' '. $smtp->message;
270 =item send_fax OPTION => VALUE ...
274 I<dialstring> - (required) 10-digit phone number w/ area code
276 I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
280 I<docfile> - (required) Filename of PostScript TIFF Class F document
282 ...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
291 die 'HylaFAX support has not been configured.'
292 unless $conf->exists('hylafax');
295 require Fax::Hylafax::Client;
299 if ($@ =~ /^Can't locate Fax.*/) {
300 die "You must have Fax::Hylafax::Client installed to use invoice faxing."
306 my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
308 die 'Called send_fax without a \'dialstring\'.'
309 unless exists($options{'dialstring'});
311 if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
312 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
313 my $fh = new File::Temp(
314 TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
317 ) or die "can't open temp file: $!\n";
319 $options{docfile} = $fh->filename;
321 print $fh @{$options{'docdata'}};
324 delete $options{'docdata'};
327 die 'Called send_fax without a \'docfile\' or \'docdata\'.'
328 unless exists($options{'docfile'});
330 #FIXME: Need to send canonical dialstring to HylaFAX, but this only
333 $options{'dialstring'} =~ s/[^\d\+]//g;
334 if ($options{'dialstring'} =~ /^\d{10}$/) {
335 $options{dialstring} = '+1' . $options{'dialstring'};
337 return 'Invalid dialstring ' . $options{'dialstring'} . '.';
340 my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
342 if ($faxjob->success) {
343 warn "Successfully queued fax to '$options{dialstring}' with jobid " .
348 return 'Error while sending FAX: ' . $faxjob->trace;
353 =item states_hash COUNTRY
355 Returns a list of key/value pairs containing state (or other sub-country
356 division) abbriviations and names.
360 use FS::Record qw(qsearch);
361 use Locale::SubCountry;
368 map { s/[\n\r]//g; $_; }
372 'table' => 'cust_main_county',
373 'hashref' => { 'country' => $country },
374 'extra_sql' => 'GROUP BY state',
377 #it could throw a fatal "Invalid country code" error (for example "AX")
378 my $subcountry = eval { new Locale::SubCountry($country) }
379 or return ( '', '(n/a)' );
381 #"i see your schwartz is as big as mine!"
382 map { ( $_->[0] => $_->[1] ) }
383 sort { $a->[1] cmp $b->[1] }
384 map { [ $_ => state_label($_, $subcountry) ] }
388 =item counties STATE COUNTRY
390 Returns a list of counties for this state and country.
395 my( $state, $country ) = @_;
397 sort map { s/[\n\r]//g; $_; }
400 'select' => 'DISTINCT county',
401 'table' => 'cust_main_county',
402 'hashref' => { 'state' => $state,
403 'country' => $country,
408 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
413 my( $state, $country ) = @_;
415 unless ( ref($country) ) {
416 $country = eval { new Locale::SubCountry($country) }
421 # US kludge to avoid changing existing behaviour
422 # also we actually *use* the abbriviations...
423 my $full_name = $country->country_code eq 'US'
425 : $country->full_name($state);
427 $full_name = '' if $full_name eq 'unknown';
428 $full_name =~ s/\(see also.*\)\s*$//;
429 $full_name .= " ($state)" if $full_name;
431 $full_name || $state || '(n/a)';
437 Returns a hash reference of the accepted credit card types. Keys are shorter
438 identifiers and values are the longer strings used by the system (see
439 L<Business::CreditCard>).
446 my $conf = new FS::Conf;
449 #displayname #value (Business::CreditCard)
450 "VISA" => "VISA card",
451 "MasterCard" => "MasterCard",
452 "Discover" => "Discover card",
453 "American Express" => "American Express card",
454 "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
455 "enRoute" => "enRoute",
457 "BankCard" => "BankCard",
458 "Switch" => "Switch",
461 my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
462 if ( @conf_card_types ) {
463 #perhaps the hash is backwards for this, but this way works better for
464 #usage in selfservice
465 %card_types = map { $_ => $card_types{$_} }
468 grep { $card_types{$d} eq $_ } @conf_card_types
476 =item prune_applications OPTION_HASH
478 Removes applications of credits to refunds in the event that the database
479 is corrupt and either the credits or refunds are missing (see
480 L<FS::cust_credit>, L<FS::cust_refund>, and L<FS::cust_credit_refund>).
481 If the OPTION_HASH contains the element 'dry_run' then a report of
482 affected records is returned rather than actually deleting the records.
486 sub prune_applications {
490 local $DEBUG = 1 if exists($options->{debug});
493 0 = (select count(*) from cust_credit
494 where cust_credit_refund.crednum = cust_credit.crednum)
496 0 = (select count(*) from cust_refund
497 where cust_credit_refund.refundnum = cust_refund.refundnum)
501 0 = (select count(*) from cust_credit
502 where cust_credit_bill.crednum = cust_credit.crednum)
504 0 = (select count(*) from cust_bill
505 where cust_credit_bill.invnum = cust_bill.invnum)
509 0 = (select count(*) from cust_bill
510 where cust_bill_pay.invnum = cust_bill.invnum)
512 0 = (select count(*) from cust_pay
513 where cust_bill_pay.paynum = cust_pay.paynum)
517 0 = (select count(*) from cust_pay
518 where cust_pay_refund.paynum = cust_pay.paynum)
520 0 = (select count(*) from cust_refund
521 where cust_pay_refund.refundnum = cust_refund.refundnum)
525 'cust_credit_refund' => { clause => $ccr,
527 link2 => 'refundnum',
529 # 'cust_credit_bill' => { clause => $ccb,
530 # link1 => 'crednum',
531 # link2 => 'refundnum',
533 # 'cust_bill_pay' => { clause => $cbp,
534 # link1 => 'crednum',
535 # link2 => 'refundnum',
537 # 'cust_pay_refund' => { clause => $cpr,
538 # link1 => 'crednum',
539 # link2 => 'refundnum',
543 if ( exists($options->{dry_run}) ) {
545 foreach my $table (keys %strays) {
546 my $clause = $strays{$table}->{clause};
547 my $link1 = $strays{$table}->{link1};
548 my $link2 = $strays{$table}->{link2};
549 my @rec = qsearch($table, {}, '', $clause);
550 my $keyname = $rec[0]->primary_key if $rec[0];
552 push @response, "$table " .$_->$keyname . " claims attachment to ".
553 "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n";
558 foreach (keys %strays) {
559 my $statement = "DELETE FROM $_ " . $strays{$_}->{clause};
560 warn $statement if $DEBUG;
561 my $sth = $dbh->prepare($statement)
578 L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
580 L<Fax::Hylafax::Client>