initial h2xs

[freeside.git] / site_perl / cust_main.pm

diff --git a/site_perl/cust_main.pm b/site_perl/cust_main.pm
index 979b6f4..6140dcc 100644 (file)
--- a/site_perl/cust_main.pm
+++ b/site_perl/cust_main.pm
@@ -5,12 +5,15 @@ use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
 package FS::cust_main;
 
 use strict;
 package FS::cust_main;
 
 use strict;

-use vars qw(@ISA $conf $lpr $processor $xaction $E_NoErr);
+use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
+             $smtpmachine );

 use Safe;
 use Carp;
 use Time::Local;
 use Date::Format;
 use Date::Manip;
 use Safe;
 use Carp;
 use Time::Local;
 use Date::Format;
 use Date::Manip;

+use Mail::Internet;
+use Mail::Header;

 use Business::CreditCard;
 use FS::UID qw( getotaker );
 use FS::Record qw( qsearchs qsearch );
 use Business::CreditCard;
 use FS::UID qw( getotaker );
 use FS::Record qw( qsearchs qsearch );


@@ -31,6 +34,8 @@ use FS::cust_main_invoice;
 $FS::UID::callback{'FS::cust_main'} = sub { 
   $conf = new FS::Conf;
   $lpr = $conf->config('lpr');
 $FS::UID::callback{'FS::cust_main'} = sub { 
   $conf = new FS::Conf;
   $lpr = $conf->config('lpr');

+  $invoice_from = $conf->config('invoice_from');
+  $smtpmachine = $conf->config('smtpmachine');

 
   if ( $conf->exists('cybercash3.2') ) {
     require CCMckLib3_2;
 
   if ( $conf->exists('cybercash3.2') ) {
     require CCMckLib3_2;


@@ -138,6 +143,8 @@ FS::Record.  The following fields are currently supported:
 
 =item night - phone (optional)
 
 
 =item night - phone (optional)
 

+=item fax - phone (optional)
+

 =item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
 
 =item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
 =item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
 
 =item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)


@@ -172,18 +179,61 @@ sub table { 'cust_main'; }
 Adds this customer to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 Adds this customer to the database.  If there is an error, returns the error,
 otherwise returns false.
 

-=item delete
+=item delete NEW_CUSTNUM
+
+This deletes the customer.  If there is an error, returns the error, otherwise
+returns false.

 
 

-Currently unimplemented.  Maybe cancel all of this customer's
-packages (cust_pkg)?
+This will completely remove all traces of the customer record.  This is not
+what you want when a customer cancels service; for that, cancel all of the
+customer's packages (see L<FS::cust_pkg/cancel>).

 
 

-I don't remove the customer record in the database because there would then
-be no record the customer ever existed (which is bad, no?)
+If the customer has any packages, you need to pass a new (valid) customer
+number for those packages to be transferred to.
+
+You can't delete a customer with invoices (see L<FS::cust_bill>),
+or credits (see L<FS::cust_credit>).

 
 =cut
 
 sub delete {
 
 =cut
 
 sub delete {

-   return "Can't (yet?) delete customers.";
+  my $self = shift;
+
+  if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
+    return "Can't delete a customer with invoices";
+  }
+  if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
+    return "Can't delete a customer with credits";
+  }
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
+  if ( @cust_pkg ) {
+    my $new_custnum = shift;
+    return "Invalid new customer number: $new_custnum"
+      unless qsearchs( 'cust_main', { 'custnum' => $new_custnum } );
+    foreach my $cust_pkg ( @cust_pkg ) {
+      my %hash = $cust_pkg->hash;
+      $hash{'custnum'} = $new_custnum;
+      my $new_cust_pkg = new FS::cust_pkg ( \%hash );
+      my $error = $new_cust_pkg->replace($cust_pkg);
+      return $error if $error;
+    }
+  }
+  foreach my $cust_main_invoice (
+    qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
+  ) {
+    my $error = $cust_main_invoice->delete;
+    return $error if $error;
+  }
+
+  $self->SUPER::delete;

 }
 
 =item replace OLD_RECORD
 }
 
 =item replace OLD_RECORD


@@ -211,7 +261,7 @@ sub check {
     || $self->ut_textn('address2')
     || $self->ut_text('city')
     || $self->ut_textn('county')
     || $self->ut_textn('address2')
     || $self->ut_text('city')
     || $self->ut_textn('county')

-    || $self->ut_text('state')
+    || $self->ut_textn('state')

     || $self->ut_phonen('daytime')
     || $self->ut_phonen('night')
     || $self->ut_phonen('fax')
     || $self->ut_phonen('daytime')
     || $self->ut_phonen('night')
     || $self->ut_phonen('fax')


@@ -224,10 +274,12 @@ sub check {
   return "Unknown referral"
     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 
   return "Unknown referral"
     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 

-  $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
+  $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
+    or return "Illegal last name: ". $self->getfield('last');

   $self->setfield('last',$1);
 
   $self->setfield('last',$1);
 

-  $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
+  $self->first =~ /^([\w \,\.\-\']+)$/
+    or return "Illegal first name: ". $self->first;

   $self->first($1);
 
   if ( $self->ss eq '' ) {
   $self->first($1);
 
   if ( $self->ss eq '' ) {


@@ -236,18 +288,18 @@ sub check {
     my $ss = $self->ss;
     $ss =~ s/\D//g;
     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
     my $ss = $self->ss;
     $ss =~ s/\D//g;
     $ss =~ /^(\d{3})(\d{2})(\d{4})$/

-      or return "Illegal social security number";
+      or return "Illegal social security number: ". $self->ss;

     $self->ss("$1-$2-$3");
   }
 
     $self->ss("$1-$2-$3");
   }
 

-  $self->country =~ /^(\w\w)$/ or return "Illegal country";
+  $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;

   $self->country($1);
   unless ( qsearchs('cust_main_county', {
     'country' => $self->country,
     'state'   => '',
    } ) ) {
   $self->country($1);
   unless ( qsearchs('cust_main_county', {
     'country' => $self->country,
     'state'   => '',
    } ) ) {

-    return "Unknown state/county/country"
-      #" state ". $self->state. " county ". $self->county. " country ". $self->country
+    return "Unknown state/county/country: ".
+      $self->state. "/". $self->county. "/". $self->country

       unless qsearchs('cust_main_county',{
         'state'   => $self->state,
         'county'  => $self->county,
       unless qsearchs('cust_main_county',{
         'state'   => $self->state,
         'county'  => $self->county,


@@ -255,10 +307,12 @@ sub check {
       } );
   }
 
       } );
   }
 

-  $self->zip =~ /^([\w\-]{5,10})$/ or return "Illegal zip";
+  $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/
+    or return "Illegal zip: ". $self->zip;

   $self->zip($1);
 
   $self->zip($1);
 

-  $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+  $self->payby =~ /^(CARD|BILL|COMP)$/
+    or return "Illegal payby: ". $self->payby;

   $self->payby($1);
 
   if ( $self->payby eq 'CARD' ) {
   $self->payby($1);
 
   if ( $self->payby eq 'CARD' ) {


@@ -266,21 +320,22 @@ sub check {
     my $payinfo = $self->payinfo;
     $payinfo =~ s/\D//g;
     $payinfo =~ /^(\d{13,16})$/
     my $payinfo = $self->payinfo;
     $payinfo =~ s/\D//g;
     $payinfo =~ /^(\d{13,16})$/

-      or return "Illegal credit card number";
+      or return "Illegal credit card number: ". $self->payinfo;

     $payinfo = $1;
     $self->payinfo($payinfo);
     $payinfo = $1;
     $self->payinfo($payinfo);

-    validate($payinfo) or return "Illegal credit card number";
+    validate($payinfo)
+      or return "Illegal credit card number: ". $self->payinfo;

     return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 
   } elsif ( $self->payby eq 'BILL' ) {
 
     $error = $self->ut_textn('payinfo');
     return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 
   } elsif ( $self->payby eq 'BILL' ) {
 
     $error = $self->ut_textn('payinfo');

-    return "Illegal P.O. number" if $error;
+    return "Illegal P.O. number: ". $self->payinfo if $error;

 
   } elsif ( $self->payby eq 'COMP' ) {
 
     $error = $self->ut_textn('payinfo');
 
   } elsif ( $self->payby eq 'COMP' ) {
 
     $error = $self->ut_textn('payinfo');

-    return "Illegal comp account issuer" if $error;
+    return "Illegal comp account issuer: ". $self->payinfo if $error;

 
   }
 
 
   }
 


@@ -289,7 +344,7 @@ sub check {
     $self->paydate('');
   } else {
     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
     $self->paydate('');
   } else {
     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/

-      or return "Illegal expiration date";
+      or return "Illegal expiration date: ". $self->paydate;

     if ( length($2) == 4 ) {
       $self->paydate("$2-$1-01");
     } elsif ( $2 > 97 ) { #should pry change to check for "this year"
     if ( length($2) == 4 ) {
       $self->paydate("$2-$1-01");
     } elsif ( $2 > 97 ) { #should pry change to check for "this year"


@@ -303,11 +358,11 @@ sub check {
     $self->payname( $self->first. " ". $self->getfield('last') );
   } else {
     $self->payname =~ /^([\w \,\.\-\']+)$/
     $self->payname( $self->first. " ". $self->getfield('last') );
   } else {
     $self->payname =~ /^([\w \,\.\-\']+)$/

-      or return "Illegal billing name";
+      or return "Illegal billing name: ". $self->payname;

     $self->payname($1);
   }
 
     $self->payname($1);
   }
 

-  $self->tax =~ /^(Y?)$/ or return "Illegal tax";
+  $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;

   $self->tax($1);
 
   $self->otaker(getotaker);
   $self->tax($1);
 
   $self->otaker(getotaker);


@@ -356,7 +411,7 @@ If there is an error, returns the error, otherwise returns false.
 
 sub bill {
   my( $self, %options ) = @_;
 
 sub bill {
   my( $self, %options ) = @_;

-  my $time = $options{'time'} || $^T;
+  my $time = $options{'time'} || time;

 
   my $error;
 
 
   my $error;
 


@@ -366,6 +421,7 @@ sub bill {
   local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';

+  local $SIG{PIPE} = 'IGNORE';

 
   # find the packages which are due for billing, find out how much they are
   # & generate invoice database.
 
   # find the packages which are due for billing, find out how much they are
   # & generate invoice database.


@@ -543,7 +599,7 @@ return an error.  By default, they don't.
 
 sub collect {
   my( $self, %options ) = @_;
 
 sub collect {
   my( $self, %options ) = @_;

-  my $invoice_time = $options{'invoice_time'} || $^T;
+  my $invoice_time = $options{'invoice_time'} || time;

 
   my $total_owed = $self->balance;
   return '' unless $total_owed > 0; #redundant?????
 
   my $total_owed = $self->balance;
   return '' unless $total_owed > 0; #redundant?????


@@ -554,6 +610,7 @@ sub collect {
   local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';

+  local $SIG{PIPE} = 'IGNORE';

 
   foreach my $cust_bill (
     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
 
   foreach my $cust_bill (
     qsearch('cust_bill', { 'custnum' => $self->custnum, } )


@@ -583,11 +640,32 @@ sub collect {
            && ( $cust_bill->printed * 2592000 ) <= $since
       ) {
 
            && ( $cust_bill->printed * 2592000 ) <= $since
       ) {
 

-        open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
-        print LPR $cust_bill->print_text; #( date )
-        close LPR
-          or die $! ? "Error closing $lpr: $!"
-                       : "Exit status $? from $lpr";
+        #my @print_text = $cust_bill->print_text; #( date )
+        my @invoicing_list = $self->invoicing_list;
+        if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
+          $ENV{SMTPHOSTS} = $smtpmachine;
+          $ENV{MAILADDRESS} = $invoice_from;
+          my $header = new Mail::Header ( [
+            "From: $invoice_from",
+            "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+            "Sender: $invoice_from",
+            "Reply-To: $invoice_from",
+            "Date: ". time2str("%a, %d %b %Y %X %z", time),
+            "Subject: Invoice",
+          ] );
+          my $message = new Mail::Internet (
+            'Header' => $header,
+            'Body' => [ $cust_bill->print_text ], #( date)
+          );
+          $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
+
+        } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
+          open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
+          print LPR $cust_bill->print_text; #( date )
+          close LPR
+            or die $! ? "Error closing $lpr: $!"
+                         : "Exit status $? from $lpr";
+        }

 
         my %hash = $cust_bill->hash;
         $hash{'printed'}++;
 
         my %hash = $cust_bill->hash;
         $hash{'printed'}++;


@@ -609,6 +687,7 @@ sub collect {
       my $error = $cust_pay->insert;
       return 'Error COMPing invnum #' . $cust_bill->invnum .
              ':' . $error if $error;
       my $error = $cust_pay->insert;
       return 'Error COMPing invnum #' . $cust_bill->invnum .
              ':' . $error if $error;

+

     } elsif ( $self->payby eq 'CARD' ) {
 
       if ( $options{'batch_card'} ne 'yes' ) {
     } elsif ( $self->payby eq 'CARD' ) {
 
       if ( $options{'batch_card'} ne 'yes' ) {


@@ -618,8 +697,9 @@ sub collect {
         if ( $processor =~ /^cybercash/ ) {
 
           #fix exp. date for cybercash
         if ( $processor =~ /^cybercash/ ) {
 
           #fix exp. date for cybercash

-          $self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
-          my $exp = "$1/$2";
+          #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+          $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+          my $exp = "$2/$1";

 
           my $paybatch = $cust_bill->invnum. 
                          '-' . time2str("%y%m%d%H%M%S", time);
 
           my $paybatch = $cust_bill->invnum. 
                          '-' . time2str("%y%m%d%H%M%S", time);


@@ -684,7 +764,7 @@ sub collect {
 
       } else { #batch card
 
 
       } else { #batch card
 

-       my $cust_pay_batch = new FS::Record ('cust_pay_batch', {
+       my $cust_pay_batch = new FS::cust_pay_batch ( {

          'invnum'   => $cust_bill->getfield('invnum'),
          'custnum'  => $self->getfield('custnum'),
          'last'     => $self->getfield('last'),
          'invnum'   => $cust_bill->getfield('invnum'),
          'custnum'  => $self->getfield('custnum'),
          'last'     => $self->getfield('last'),


@@ -710,6 +790,10 @@ sub collect {
       return "Unknown payment type ". $self->payby;
     }
 
       return "Unknown payment type ". $self->payby;
     }
 

+
+
+
+

   }
   '';
 
   }
   '';
 


@@ -779,8 +863,13 @@ This interface may change in the future.
 sub invoicing_list {
   my( $self, $arrayref ) = @_;
   if ( $arrayref ) {
 sub invoicing_list {
   my( $self, $arrayref ) = @_;
   if ( $arrayref ) {

-    my @cust_main_invoice = 
-      qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+    my @cust_main_invoice;
+    if ( $self->custnum ) {
+      @cust_main_invoice = 
+        qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+    } else {
+      @cust_main_invoice = ();
+    }

     foreach my $cust_main_invoice ( @cust_main_invoice ) {
       #warn $cust_main_invoice->destnum;
       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
     foreach my $cust_main_invoice ( @cust_main_invoice ) {
       #warn $cust_main_invoice->destnum;
       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {


@@ -789,8 +878,12 @@ sub invoicing_list {
         warn $error if $error;
       }
     }
         warn $error if $error;
       }
     }

-    @cust_main_invoice =
-      qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+    if ( $self->custnum ) {
+      @cust_main_invoice = 
+        qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+    } else {
+      @cust_main_invoice = ();
+    }

     foreach my $address ( @{$arrayref} ) {
       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
         my $cust_main_invoice = new FS::cust_main_invoice ( {
     foreach my $address ( @{$arrayref} ) {
       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
         my $cust_main_invoice = new FS::cust_main_invoice ( {


@@ -802,8 +895,12 @@ sub invoicing_list {
       } 
     }
   }
       } 
     }
   }

-  map { $_->address }
-    qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+  if ( $self->custnum ) {
+    map { $_->address }
+      qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+  } else {
+    ();
+  }

 }
 
 =item check_invoicing_list ARRAYREF
 }
 
 =item check_invoicing_list ARRAYREF


@@ -820,7 +917,10 @@ sub check_invoicing_list {
       'custnum' => $self->custnum,
       'dest'    => $address,
     } );
       'custnum' => $self->custnum,
       'dest'    => $address,
     } );

-    my $error = $cust_main_invoice->check;
+    my $error = $self->custnum
+                ? $cust_main_invoice->check
+                : $cust_main_invoice->checkdest
+    ;

     return $error if $error;
   }
   '';
     return $error if $error;
   }
   '';


@@ -830,12 +930,15 @@ sub check_invoicing_list {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_main.pm,v 1.9 1999-01-18 09:22:41 ivan Exp $
+$Id: cust_main.pm,v 1.24 1999-07-20 10:37:05 ivan Exp $

 
 =head1 BUGS
 
 The delete method.
 
 
 =head1 BUGS
 
 The delete method.
 

+The delete method should possibly take an FS::cust_main object reference
+instead of a scalar customer number.
+

 Bill and collect options should probably be passed as references instead of a
 list.
 
 Bill and collect options should probably be passed as references instead of a
 list.
 


@@ -886,7 +989,54 @@ enable cybercash, cybercash v3 support, don't need to import
 FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
 
 $Log: cust_main.pm,v $
 FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
 
 $Log: cust_main.pm,v $

-Revision 1.9  1999-01-18 09:22:41  ivan
+Revision 1.24  1999-07-20 10:37:05  ivan
+cleaned up the new one-screen signup bits in htdocs/edit/cust_main.cgi to
+prepare for a signup server
+
+Revision 1.23  1999/07/17 02:24:14  ivan
+bug noticed by Steve Gertz <sglist@hollywood.mwis.net>
+
+Revision 1.22  1999/04/15 16:44:36  ivan
+delete customers
+
+Revision 1.21  1999/04/14 07:47:53  ivan
+i18n fixes
+
+Revision 1.20  1999/04/10 08:35:14  ivan
+say what the unknown state/county/country are!
+
+Revision 1.19  1999/04/10 07:38:06  ivan
+_all_ check stuff with illegal data return the bad data too, to help debugging
+
+Revision 1.18  1999/04/10 06:54:11  ivan
+ditto
+
+Revision 1.17  1999/04/10 05:27:38  ivan
+display an illegal payby, to assist importing
+
+Revision 1.16  1999/04/07 14:32:19  ivan
+more &invoicing_list logic to skip searches when there is no custnum
+
+Revision 1.15  1999/04/07 13:41:54  ivan
+in &invoicing_list, don't search if there's no custnum yet
+
+Revision 1.14  1999/03/29 12:06:15  ivan
+buglet in email invoices fixed
+
+Revision 1.13  1999/02/28 20:09:03  ivan
+allow spaces in zip codes, for (at least) canada.  pointed out by
+Clayton Gray <clgray@bcgroup.net>
+
+Revision 1.12  1999/02/27 21:24:22  ivan
+parse paydate correctly for cybercash
+
+Revision 1.11  1999/02/23 08:09:27  ivan
+beginnings of one-screen new customer entry and some other miscellania
+
+Revision 1.10  1999/01/25 12:26:09  ivan
+yet more mod_perl stuff
+
+Revision 1.9  1999/01/18 09:22:41  ivan

 changes to track email addresses for email invoicing
 
 Revision 1.8  1998/12/29 11:59:39  ivan
 changes to track email addresses for email invoicing
 
 Revision 1.8  1998/12/29 11:59:39  ivan