X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FMisc.pm;h=6799a24b873868ad5a5d6f506ba604703a3c4a53;hb=8d39836a37186ad0e3aa993e2cc659e0b986cd35;hp=e254b51fc0c03cd76f9eedc8db03379eecc93ebe;hpb=aa8d3305bddaca26d9222ebfa48af191d28f8230;p=freeside.git diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index e254b51fc..6799a24b8 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -7,6 +7,8 @@ use Carp; use Data::Dumper; use IPC::Run qw( run timeout ); # for _pslatex use IPC::Run3; # for do_print... should just use IPC::Run i guess +use File::Temp; +use Tie::IxHash; #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable #until on client machine) dependancy loops. put them in FS::Misc::Something #instead @@ -15,7 +17,9 @@ use IPC::Run3; # for do_print... should just use IPC::Run i guess @EXPORT_OK = qw( generate_email send_email send_fax states_hash counties state_label card_types + pkg_freqs generate_ps generate_pdf do_print + csv_from_fixed ); $DEBUG = 0; @@ -214,9 +218,10 @@ encoding which, if specified, overrides the default "7bit". use vars qw( $conf ); use Date::Format; -use Mail::Header; -use Mail::Internet 2.00; use MIME::Entity; +use Email::Sender::Simple qw(sendmail); +use Email::Sender::Transport::SMTP; +use Email::Sender::Transport::SMTP::TLS; use FS::UID; FS::UID->install_callback( sub { @@ -232,7 +237,6 @@ sub send_email { # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n" } - $ENV{MAILADDRESS} = $options{'from'}; my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to}; my @mimeargs = (); @@ -285,7 +289,7 @@ sub send_email { $domain = $1; } else { warn 'no domain found in invoice from address '. $options{'from'}. - '; constructing Message-ID @example.com'; + '; constructing Message-ID (and saying HELO) @example.com'; $domain = 'example.com'; } my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain"; @@ -331,101 +335,37 @@ sub send_email { } - my $smtpmachine = $conf->config('smtpmachine'); - $!=0; + #send the email - $message->mysmtpsend( 'Host' => $smtpmachine, - 'MailFrom' => $options{'from'}, - ); + my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), + 'helo' => $domain, + ); -} - -#this kludges a "mysmtpsend" method into Mail::Internet for send_email above -#now updated for MailTools v2! -package Mail::Internet; - -use Mail::Address; -use Net::SMTP; -use Net::Domain; - -sub Mail::Internet::mysmtpsend($@) { - my ($self, %opt) = @_; - - my $host = $opt{Host}; - my $envelope = $opt{MailFrom}; # || mailaddress(); - my $quit = 1; - - my ($smtp, @hello); - - push @hello, Hello => $opt{Hello} - if defined $opt{Hello}; - - push @hello, Port => $opt{Port} - if exists $opt{Port}; - - push @hello, Debug => $opt{Debug} - if exists $opt{Debug}; - -# if(!defined $host) -# { local $SIG{__DIE__}; -# my @hosts = qw(mailhost localhost); -# unshift @hosts, split /\:/, $ENV{SMTPHOSTS} -# if defined $ENV{SMTPHOSTS}; -# -# foreach $host (@hosts) -# { $smtp = eval { Net::SMTP->new($host, @hello) }; -# last if defined $smtp; -# } -# } -# elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) - if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) - { $smtp = $host; - $quit = 0; - } - else - { #local $SIG{__DIE__}; - #$smtp = eval { Net::SMTP->new($host, @hello) }; - $smtp = Net::SMTP->new($host, @hello); - } - - unless ( defined($smtp) ) { - my $err = $!; - $err =~ s/Invalid argument/Unknown host/; - return "can't connect to $host: $err" - } - - my $head = $self->cleaned_header_dup; - - $head->delete('Bcc'); - - # Who is it to - - my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'}; - @rcpt = map { $head->get($_) } qw(To Cc Bcc) - unless @rcpt; + my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') ); + $smtp_opt{'port'} = $port; - my @addr = map {$_->address} Mail::Address->parse(@rcpt); - #@addr or return (); - return 'No valid destination addresses found!' - unless(@addr); - - # Send it - - my $ok = $smtp->mail($envelope) - && $smtp->to(@addr) - && $smtp->data(join("", @{$head->header}, "\n", @{$self->body})); - - #$quit && $smtp->quit; - #$ok ? @addr : (); - if ( $ok ) { - $quit && $smtp->quit; - return ''; - } else { - return $smtp->code. ' '. $smtp->message; + my $transport; + if ( defined($enc) && $enc eq 'starttls' ) { + $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); + $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); + } else { + if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { + $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); } + $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; + $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); + } + + local $@; # just in case + eval { sendmail($message, { transport => $transport }) }; + + if(ref($@) and $@->isa('Email::Sender::Failure')) { + return ($@->code ? $@->code.' ' : '').$@->message + } + else { + return $@; + } } -package FS::Misc; -#eokludge =item send_fax OPTION => VALUE ... @@ -680,6 +620,39 @@ sub generate_ps { } +=item pkg_freqs + +Returns a hash reference of allowed package billing frequencies. + +=cut + +sub pkg_freqs { + tie my %freq, 'Tie::IxHash', ( + '0' => '(no recurring fee)', + '1h' => 'hourly', + '1d' => 'daily', + '2d' => 'every two days', + '3d' => 'every three days', + '1w' => 'weekly', + '2w' => 'biweekly (every 2 weeks)', + '1' => 'monthly', + '45d' => 'every 45 days', + '2' => 'bimonthly (every 2 months)', + '3' => 'quarterly (every 3 months)', + '4' => 'every 4 months', + '137d' => 'every 4 1/2 months (137 days)', + '6' => 'semiannually (every 6 months)', + '12' => 'annually', + '13' => 'every 13 months (annually +1 month)', + '24' => 'biannually (every 2 years)', + '36' => 'triannually (every 3 years)', + '48' => '(every 4 years)', + '60' => '(every 5 years)', + '120' => '(every 10 years)', + ) ; + \%freq; +} + =item generate_pdf FILENAME Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not @@ -774,6 +747,65 @@ sub do_print { } +=item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ] + +Converts the filehandle referenced by FILEREF from fixed length record +lines to a CSV file according to the lengths specified in LENGTH_LISTREF. +The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each +should return the value to be substituted in place of its single argument. + +Returns false on success or an error if one occurs. + +=cut + +sub csv_from_fixed { + my( $fhref, $countref, $lengths, $callbacks) = @_; + + eval { require Text::CSV_XS; }; + return $@ if $@; + + my $ofh = $$fhref; + my $unpacker = new Text::CSV_XS; + my $total = 0; + my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths; + + my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc"; + my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX", + DIR => $dir, + UNLINK => 0, + ) or return "can't open temp file: $!\n" + if $template; + + while ( defined(my $line=<$ofh>) ) { + $$countref++; + if ( $template ) { + my $column = 0; + + chomp $line; + return "unexpected input at line $$countref: $line". + " -- expected $total but received ". length($line) + unless length($line) == $total; + + $unpacker->combine( map { my $i = $column++; + defined( $callbacks->[$i] ) + ? &{ $callbacks->[$i] }( $_ ) + : $_ + } unpack( $template, $line ) + ) + or return "invalid data for CSV: ". $unpacker->error_input; + + print $fh $unpacker->string(), "\n" + or return "can't write temp file: $!\n"; + } + } + + if ( $template ) { close $$fhref; $$fhref = $fh } + + seek $$fhref, 0, 0; + ''; +} + + =back =head1 BUGS