projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
import torrus 1.0.9
[freeside.git] / FS / FS / Misc.pm
diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm
index 5231350..fe8ac60 100644 (file)
--- a/FS/FS/Misc.pm
+++ b/FS/FS/Misc.pm
@@ -8,16 +8,19 @@ 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 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
 
 @ISA = qw( Exporter );
 #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
 
 @ISA = qw( Exporter );
-@EXPORT_OK = qw( generate_email send_email send_fax
-                 states_hash counties state_label
+@EXPORT_OK = qw( send_email generate_email send_fax
+                 states_hash counties cities state_label
                  card_types
                  card_types
+                 pkg_freqs
                  generate_ps generate_pdf do_print
                  csv_from_fixed
                  generate_ps generate_pdf do_print
                  csv_from_fixed
+                 ocr_image
                );
 
 $DEBUG = 0;
                );
 
 $DEBUG = 0;
@@ -36,136 +39,12 @@ FS::Misc - Miscellaneous subroutines
 
 Miscellaneous subroutines.  This module contains miscellaneous subroutines
 called from multiple other modules.  These are not OO or necessarily related,
 
 Miscellaneous subroutines.  This module contains miscellaneous subroutines
 called from multiple other modules.  These are not OO or necessarily related,
-but are collected here to elimiate code duplication.
+but are collected here to eliminate code duplication.
 
 =head1 SUBROUTINES
 
 =over 4
 
 
 =head1 SUBROUTINES
 
 =over 4
 
-=item generate_email OPTION => VALUE ...
-
-Options:
-
-=over 4
-
-=item from
-
-Sender address, required
-
-=item to
-
-Recipient address, required
-
-=item subject
-
-email subject, required
-
-=item html_body
-
-Email body (HTML alternative).  Arrayref of lines, or scalar.
-
-Will be placed inside an HTML <BODY> tag.
-
-=item text_body
-
-Email body (Text alternative).  Arrayref of lines, or scalar.
-
-=back
-
-Returns an argument list to be passsed to L<send_email>.
-
-=cut
-
-#false laziness w/FS::cust_bill::generate_email
-
-use MIME::Entity;
-use HTML::Entities;
-
-sub generate_email {
-  my %args = @_;
-
-  my $me = '[FS::Misc::generate_email]';
-
-  my %return = (
-    'from'    => $args{'from'},
-    'to'      => $args{'to'},
-    'subject' => $args{'subject'},
-  );
-
-  #if (ref($args{'to'}) eq 'ARRAY') {
-  #  $return{'to'} = $args{'to'};
-  #} else {
-  #  $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
-  #                         $self->cust_main->invoicing_list
-  #                  ];
-  #}
-
-  warn "$me creating HTML/text multipart message"
-    if $DEBUG;
-
-  $return{'nobody'} = 1;
-
-  my $alternative = build MIME::Entity
-    'Type'        => 'multipart/alternative',
-    'Encoding'    => '7bit',
-    'Disposition' => 'inline'
-  ;
-
-  my $data;
-  if ( ref($args{'text_body'}) eq 'ARRAY' ) {
-    $data = $args{'text_body'};
-  } else {
-    $data = [ split(/\n/, $args{'text_body'}) ];
-  }
-
-  $alternative->attach(
-    'Type'        => 'text/plain',
-    #'Encoding'    => 'quoted-printable',
-    'Encoding'    => '7bit',
-    'Data'        => $data,
-    'Disposition' => 'inline',
-  );
-
-  my @html_data;
-  if ( ref($args{'html_body'}) eq 'ARRAY' ) {
-    @html_data = @{ $args{'html_body'} };
-  } else {
-    @html_data = split(/\n/, $args{'html_body'});
-  }
-
-  $alternative->attach(
-    'Type'        => 'text/html',
-    'Encoding'    => 'quoted-printable',
-    'Data'        => [ '<html>',
-                       '  <head>',
-                       '    <title>',
-                       '      '. encode_entities($return{'subject'}), 
-                       '    </title>',
-                       '  </head>',
-                       '  <body bgcolor="#e8e8e8">',
-                       @html_data,
-                       '  </body>',
-                       '</html>',
-                     ],
-    'Disposition' => 'inline',
-    #'Filename'    => 'invoice.pdf',
-  );
-
-  #no other attachment:
-  # multipart/related
-  #   multipart/alternative
-  #     text/plain
-  #     text/html
-
-  $return{'content-type'} = 'multipart/related';
-  $return{'mimeparts'} = [ $alternative ];
-  $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
-  #$return{'disposition'} = 'inline';
-
-  %return;
-
-}
-
 =item send_email OPTION => VALUE ...
 
 Options:
 =item send_email OPTION => VALUE ...
 
 Options:
@@ -216,9 +95,10 @@ encoding which, if specified, overrides the default "7bit".
 
 use vars qw( $conf );
 use Date::Format;
 
 use vars qw( $conf );
 use Date::Format;
-use Mail::Header;
-use Mail::Internet 2.00;
 use MIME::Entity;
 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 {
 use FS::UID;
 
 FS::UID->install_callback( sub {
@@ -234,8 +114,7 @@ sub send_email {
 #         join("\n", map { "  $_: ". $options{$_} } keys %options ). "\n"
   }
 
 #         join("\n", map { "  $_: ". $options{$_} } keys %options ). "\n"
   }
 
-  $ENV{MAILADDRESS} = $options{'from'};
-  my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to};
+  my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
 
   my @mimeargs = ();
   my @mimeparts = ();
 
   my @mimeargs = ();
   my @mimeparts = ();
@@ -287,14 +166,14 @@ sub send_email {
     $domain = $1;
   } else {
     warn 'no domain found in invoice from address '. $options{'from'}.
     $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";
 
   my $message = MIME::Entity->build(
     'From'       => $options{'from'},
     $domain = 'example.com';
   }
   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
 
   my $message = MIME::Entity->build(
     'From'       => $options{'from'},
-    'To'         => $to,
+    'To'         => join(', ', @to),
     'Sender'     => $options{'from'},
     'Reply-To'   => $options{'from'},
     'Date'       => time2str("%a, %d %b %Y %X %z", time),
     'Sender'     => $options{'from'},
     'Reply-To'   => $options{'from'},
     'Date'       => time2str("%a, %d %b %Y %X %z", time),
@@ -333,101 +212,183 @@ 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,
+                 );
 
 
-}
+  my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
+  $smtp_opt{'port'} = $port;
 
 
-#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);
+  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 );
+  }
+  
+  push @to, $options{bcc} if defined($options{bcc});
+  local $@; # just in case
+  eval { sendmail($message, { transport => $transport,
+                              from      => $options{from},
+                              to        => \@to }) };
+ 
+  if(ref($@) and $@->isa('Email::Sender::Failure')) {
+    return ($@->code ? $@->code.' ' : '').$@->message
+  }
+  else {
+    return $@;
+  }
+}
 
 
-    unless ( defined($smtp) ) {
-      my $err = $!;
-      $err =~ s/Invalid argument/Unknown host/;
-      return "can't connect to $host: $err"
-    }
+=item generate_email OPTION => VALUE ...
+
+Options:
+
+=over 4
 
 
-    my $head = $self->cleaned_header_dup;
+=item from
 
 
-    $head->delete('Bcc');
+Sender address, required
 
 
-    # Who is it to
+=item to
 
 
-    my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
-    @rcpt    = map { $head->get($_) } qw(To Cc Bcc)
-        unless @rcpt;
+Recipient address, required
 
 
-    my @addr = map {$_->address} Mail::Address->parse(@rcpt);
-    #@addr or return ();
-    return 'No valid destination addresses found!'
-       unless(@addr);
+=item bcc
 
 
-    # Send it
+Blind copy address, optional
 
 
-    my $ok = $smtp->mail($envelope)
-          && $smtp->to(@addr)
-          && $smtp->data(join("", @{$head->header}, "\n", @{$self->body}));
+=item subject
+
+email subject, required
+
+=item html_body
+
+Email body (HTML alternative).  Arrayref of lines, or scalar.
+
+Will be placed inside an HTML <BODY> tag.
+
+=item text_body
+
+Email body (Text alternative).  Arrayref of lines, or scalar.
+
+=back
+
+Constructs a multipart message from text_body and html_body.
+
+=cut
+
+#false laziness w/FS::cust_bill::generate_email
+
+use MIME::Entity;
+use HTML::Entities;
+
+sub generate_email {
+  my %args = @_;
+
+  my $me = '[FS::Misc::generate_email]';
+
+  my %return = (
+    'from'    => $args{'from'},
+    'to'      => $args{'to'},
+    'bcc'     => $args{'bcc'},
+    'subject' => $args{'subject'},
+  );
+
+  #if (ref($args{'to'}) eq 'ARRAY') {
+  #  $return{'to'} = $args{'to'};
+  #} else {
+  #  $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
+  #                         $self->cust_main->invoicing_list
+  #                  ];
+  #}
+
+  warn "$me creating HTML/text multipart message"
+    if $DEBUG;
+
+  $return{'nobody'} = 1;
+
+  my $alternative = build MIME::Entity
+    'Type'        => 'multipart/alternative',
+    'Encoding'    => '7bit',
+    'Disposition' => 'inline'
+  ;
+
+  my $data;
+  if ( ref($args{'text_body'}) eq 'ARRAY' ) {
+    $data = $args{'text_body'};
+  } else {
+    $data = [ split(/\n/, $args{'text_body'}) ];
+  }
+
+  $alternative->attach(
+    'Type'        => 'text/plain',
+    #'Encoding'    => 'quoted-printable',
+    'Encoding'    => '7bit',
+    'Data'        => $data,
+    'Disposition' => 'inline',
+  );
+
+  my @html_data;
+  if ( ref($args{'html_body'}) eq 'ARRAY' ) {
+    @html_data = @{ $args{'html_body'} };
+  } else {
+    @html_data = split(/\n/, $args{'html_body'});
+  }
+
+  $alternative->attach(
+    'Type'        => 'text/html',
+    'Encoding'    => 'quoted-printable',
+    'Data'        => [ '<html>',
+                       '  <head>',
+                       '    <title>',
+                       '      '. encode_entities($return{'subject'}), 
+                       '    </title>',
+                       '  </head>',
+                       '  <body bgcolor="#e8e8e8">',
+                       @html_data,
+                       '  </body>',
+                       '</html>',
+                     ],
+    'Disposition' => 'inline',
+    #'Filename'    => 'invoice.pdf',
+  );
+
+  #no other attachment:
+  # multipart/related
+  #   multipart/alternative
+  #     text/plain
+  #     text/html
+
+  $return{'content-type'} = 'multipart/related';
+  $return{'mimeparts'} = [ $alternative ];
+  $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
+  #$return{'disposition'} = 'inline';
+
+  %return;
 
 
-    #$quit && $smtp->quit;
-    #$ok ? @addr : ();
-    if ( $ok ) {
-      $quit && $smtp->quit;
-      return '';
-    } else {
-      return $smtp->code. ' '. $smtp->message;
-    }
 }
 }
-package FS::Misc;
-#eokludge
+
+=item process_send_email OPTION => VALUE ...
+
+Takes arguments as per generate_email() and sends the message.  This 
+will die on any error and can be used in the job queue.
+
+=cut
+
+sub process_send_email {
+  my %message = @_;
+  my $error = send_email(generate_email(%message));
+  die "$error\n" if $error;
+  '';
+}
 
 =item send_fax OPTION => VALUE ...
 
 
 =item send_fax OPTION => VALUE ...
 
@@ -556,6 +517,7 @@ Returns a list of counties for this state and country.
 sub counties {
   my( $state, $country ) = @_;
 
 sub counties {
   my( $state, $country ) = @_;
 
+  map { $_ } #return num_counties($state, $country) unless wantarray;
   sort map { s/[\n\r]//g; $_; }
        map { $_->county }
            qsearch({
   sort map { s/[\n\r]//g; $_; }
        map { $_->county }
            qsearch({
@@ -567,6 +529,28 @@ sub counties {
            });
 }
 
            });
 }
 
+=item cities COUNTY STATE COUNTRY
+
+Returns a list of cities for this county, state and country.
+
+=cut
+
+sub cities {
+  my( $county, $state, $country ) = @_;
+
+  map { $_ } #return num_cities($county, $state, $country) unless wantarray;
+  sort map { s/[\n\r]//g; $_; }
+       map { $_->city }
+           qsearch({
+             'select'  => 'DISTINCT city',
+             'table'   => 'cust_main_county',
+             'hashref' => { 'county'  => $county,
+                            'state'   => $state,
+                            'country' => $country,
+                          },
+           });
+}
+
 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
 
 =cut
 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
 
 =cut
@@ -635,6 +619,39 @@ sub card_types {
   \%card_types;
 }
 
   \%card_types;
 }
 
+=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_ps FILENAME
 
 Returns an postscript rendition of the LaTex file, as a scalar.
 =item generate_ps FILENAME
 
 Returns an postscript rendition of the LaTex file, as a scalar.
@@ -834,6 +851,41 @@ sub csv_from_fixed {
   '';
 }
 
   '';
 }
 
+=item ocr_image IMAGE_SCALAR
+
+Runs OCR on the provided image data and returns a list of text lines.
+
+=cut
+
+sub ocr_image {
+  my $logo_data = shift;
+
+  #XXX use conf dir location from Makefile
+  my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
+  my $fh = new File::Temp(
+    TEMPLATE => 'bizcard.XXXXXXXX',
+    SUFFIX   => '.png', #XXX assuming, but should handle jpg, gif, etc. too
+    DIR      => $dir,
+    UNLINK   => 0,
+  ) or die "can't open temp file: $!\n";
+
+  my $filename = $fh->filename;
+
+  print $fh $logo_data;
+  close $fh;
+
+  run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
+    or die "ocroscript recognize failed\n";
+
+  run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
+    or die "ocroscript hocr-to-text failed\n";
+
+  my @lines = split(/\n/, <OUT> );
+
+  foreach (@lines) { s/\.c0m\s*$/.com/; }
+
+  @lines;
+}
 
 =back
 
 
 =back
 
Freeside billing, trouble ticketing, network monitoring and provisioning