projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
add cust_credit_bill relating multiple invoices to credits
[freeside.git] / FS / FS / cust_main.pm
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 59ec41b..382cc49 100644 (file)
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -6,17 +6,18 @@ package FS::cust_main;
 
 use strict;
 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
 
 use strict;
 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
-             $smtpmachine $Debug );
+             $smtpmachine $Debug $bop_processor $bop_login $bop_password
+             $bop_action @bop_options);
 use Safe;
 use Carp;
 use Time::Local;
 use Date::Format;
 use Safe;
 use Carp;
 use Time::Local;
 use Date::Format;
-use Date::Manip;
+#use Date::Manip;
 use Mail::Internet;
 use Mail::Header;
 use Business::CreditCard;
 use Mail::Internet;
 use Mail::Header;
 use Business::CreditCard;
-use FS::UID qw( getotaker );
-use FS::Record qw( qsearchs qsearch );
+use FS::UID qw( getotaker dbh );
+use FS::Record qw( qsearchs qsearch dbdef );
 use FS::cust_pkg;
 use FS::cust_bill;
 use FS::cust_bill_pkg;
 use FS::cust_pkg;
 use FS::cust_bill;
 use FS::cust_bill_pkg;
@@ -27,6 +28,7 @@ use FS::part_referral;
 use FS::cust_main_county;
 use FS::agent;
 use FS::cust_main_invoice;
 use FS::cust_main_county;
 use FS::agent;
 use FS::cust_main_invoice;
+use FS::cust_credit_bill;
 use FS::prepay_credit;
 
 @ISA = qw( FS::Record );
 use FS::prepay_credit;
 
 @ISA = qw( FS::Record );
@@ -71,6 +73,16 @@ $FS::UID::callback{'FS::cust_main'} = sub {
       $xaction,
     ) = $conf->config('cybercash2');
     $processor='cybercash2';
       $xaction,
     ) = $conf->config('cybercash2');
     $processor='cybercash2';
+  } elsif ( $conf->exists('business-onlinepayment') ) {
+    ( $bop_processor,
+      $bop_login,
+      $bop_password,
+      $bop_action,
+      @bop_options
+    ) = $conf->config('business-onlinepayment');
+    $bop_action ||= 'normal authorization';
+    eval "use Business::OnlinePayment";  
+    $processor="Business::OnlinePayment::$bop_processor";
   }
 };
 
   }
 };
 
@@ -149,6 +161,32 @@ FS::Record.  The following fields are currently supported:
 
 =item fax - phone (optional)
 
 
 =item fax - phone (optional)
 
+=item ship_first - name
+
+=item ship_last - name
+
+=item ship_company - (optional)
+
+=item ship_address1
+
+=item ship_address2 - (optional)
+
+=item ship_city
+
+=item ship_county - (optional, see L<FS::cust_main_county>)
+
+=item ship_state - (see L<FS::cust_main_county>)
+
+=item ship_zip
+
+=item ship_country - (see L<FS::cust_main_county>)
+
+=item ship_daytime - phone (optional)
+
+=item ship_night - phone (optional)
+
+=item ship_fax - phone (optional)
+
 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 
 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 
 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
@@ -161,6 +199,8 @@ FS::Record.  The following fields are currently supported:
 
 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 
 
 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 
+=item comments - comments (optional)
+
 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS
@@ -178,21 +218,40 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'cust_main'; }
 
 
 sub table { 'cust_main'; }
 
-=item insert
+=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
 
 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.
 
+CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
+method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
+are inserted atomicly, or the transaction is rolled back (this requries a 
+transactional database).  Passing an empty hash reference is equivalent to
+not supplying this parameter.  There should be a better explanation of this,
+but until then, here's an example:
+
+  use Tie::RefHash;
+  tie %hash, 'Tie::RefHash'; #this part is important
+  %hash = (
+    $cust_pkg => [ $svc_acct ],
+    ...
+  );
+  $cust_main->insert( \%hash );
+
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">).  Errors return as
+expected and rollback the entire transaction; it is not necessary to call 
+check_invoicing_list first.  The invoicing_list is set after the records in the
+CUST_PKG_HASHREF above are inserted, so it is now possible set set an
+invoicing_list destination to the newly-created svc_acct.  Here's an example:
+
+  $cust_main->insert( {}, [ $email, 'POST' ] );
+
 =cut
 
 sub insert {
   my $self = shift;
 =cut
 
 sub insert {
   my $self = shift;
-
-  my $flag = 0;
-  if ( $self->payby eq 'PREPAY' ) {
-    $self->payby('BILL');
-    $flag = 1;
-  }
+  my @param = @_;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -201,30 +260,89 @@ sub insert {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
-  my $error = $self->SUPER::insert;
-  return $error if $error;
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
 
 
-  if ( $flag ) {
-    my $prepay_credit =
-      qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
+  my $amount = 0;
+  my $seconds = 0;
+  if ( $self->payby eq 'PREPAY' ) {
+    $self->payby('BILL');
+    my $prepay_credit = qsearchs(
+      'prepay_credit',
+      { 'identifier' => $self->payinfo },
+      '',
+      'FOR UPDATE'
+    );
     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
       unless $prepay_credit;
     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
       unless $prepay_credit;
-    my $amount = $prepay_credit->amount;
+    $amount = $prepay_credit->amount;
+    $seconds = $prepay_credit->seconds;
     my $error = $prepay_credit->delete;
     if ( $error ) {
     my $error = $prepay_credit->delete;
     if ( $error ) {
-      warn "WARNING: can't delete prepay_credit: ". $self->payinfo;
-    } else {
-      my $cust_credit = new FS::cust_credit {
-        'custnum' => $self->custnum,
-        'amount'  => $amount,
-      };
-      my $error = $cust_credit->insert;
-      warn "WARNING: error inserting cust_credit for prepay_credit: $error"
-        if $error;
+      $dbh->rollback if $oldAutoCommit;
+      return "removing prepay_credit (transaction rolled back): $error";
     }
     }
+  }
 
 
+  my $error = $self->SUPER::insert;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "inserting cust_main record (transaction rolled back): $error";
   }
 
   }
 
+  if ( @param ) { # CUST_PKG_HASHREF
+    my $cust_pkgs = shift @param;
+    foreach my $cust_pkg ( keys %$cust_pkgs ) {
+      $cust_pkg->custnum( $self->custnum );
+      $error = $cust_pkg->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "inserting cust_pkg (transaction rolled back): $error";
+      }
+      foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
+        $svc_something->pkgnum( $cust_pkg->pkgnum );
+        if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
+          $svc_something->seconds( $svc_something->seconds + $seconds );
+          $seconds = 0;
+        }
+        $error = $svc_something->insert;
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return "inserting svc_ (transaction rolled back): $error";
+        }
+      }
+    }
+  }
+
+  if ( $seconds ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "No svc_acct record to apply pre-paid time";
+  }
+
+  if ( @param ) { # INVOICING_LIST_ARYREF
+    my $invoicing_list = shift @param;
+    $error = $self->check_invoicing_list( $invoicing_list );
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "checking invoicing_list (transaction rolled back): $error";
+    }
+    $self->invoicing_list( $invoicing_list );
+  }
+
+  if ( $amount ) {
+    my $cust_credit = new FS::cust_credit {
+      'custnum' => $self->custnum,
+      'amount'  => $amount,
+    };
+    $error = $cust_credit->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "inserting credit (transaction rolled back): $error";
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 
 }
   '';
 
 }
@@ -249,13 +367,6 @@ or credits (see L<FS::cust_credit>).
 sub delete {
   my $self = shift;
 
 sub delete {
   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{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
@@ -263,34 +374,110 @@ sub delete {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "Can't delete a customer with invoices";
+  }
+  if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "Can't delete a customer with credits";
+  }
+
   my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
   if ( @cust_pkg ) {
     my $new_custnum = shift;
   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 } );
+    unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Invalid new customer number: $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);
     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;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
     }
   }
   foreach my $cust_main_invoice (
     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
   ) {
     my $error = $cust_main_invoice->delete;
     }
   }
   foreach my $cust_main_invoice (
     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
   ) {
     my $error = $cust_main_invoice->delete;
-    return $error if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  my $error = $self->SUPER::delete;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
   }
 
   }
 
-  $self->SUPER::delete;
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
 }
 
 }
 
-=item replace OLD_RECORD
+=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">).  Errors return as
+expected and rollback the entire transaction; it is not necessary to call 
+check_invoicing_list first.  Here's an example:
+
+  $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
+
+=cut
+
+sub replace {
+  my $self = shift;
+  my $old = shift;
+  my @param = @_;
+
+  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 $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error = $self->SUPER::replace($old);
+
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  if ( @param ) { # INVOICING_LIST_ARYREF
+    my $invoicing_list = shift @param;
+    $error = $self->check_invoicing_list( $invoicing_list );
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+    $self->invoicing_list( $invoicing_list );
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item check
 
 Checks all fields to make sure this is a valid customer record.  If there is
 =item check
 
 Checks all fields to make sure this is a valid customer record.  If there is
@@ -306,16 +493,21 @@ sub check {
     $self->ut_numbern('custnum')
     || $self->ut_number('agentnum')
     || $self->ut_number('refnum')
     $self->ut_numbern('custnum')
     || $self->ut_number('agentnum')
     || $self->ut_number('refnum')
+    || $self->ut_name('last')
+    || $self->ut_name('first')
     || $self->ut_textn('company')
     || $self->ut_text('address1')
     || $self->ut_textn('address2')
     || $self->ut_text('city')
     || $self->ut_textn('county')
     || $self->ut_textn('state')
     || $self->ut_textn('company')
     || $self->ut_text('address1')
     || $self->ut_textn('address2')
     || $self->ut_text('city')
     || $self->ut_textn('county')
     || $self->ut_textn('state')
-    || $self->ut_phonen('daytime')
-    || $self->ut_phonen('night')
-    || $self->ut_phonen('fax')
+    || $self->ut_country('country')
+    || $self->ut_anything('comments')
+    || $self->ut_numbern('referral_custnum')
   ;
   ;
+  #barf.  need message catalogs.  i18n.  etc.
+  $error .= "Please select a referral."
+    if $error =~ /^Illegal or empty \(numeric\) refnum: /;
   return $error if $error;
 
   return "Unknown agent"
   return $error if $error;
 
   return "Unknown agent"
@@ -324,13 +516,9 @@ 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');
-  $self->setfield('last',$1);
-
-  $self->first =~ /^([\w \,\.\-\']+)$/
-    or return "Illegal first name: ". $self->first;
-  $self->first($1);
+  return "Unknown referring custnum ". $self->referral_custnum
+    unless ! $self->referral_custnum 
+           || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 
   if ( $self->ss eq '' ) {
     $self->ss('');
 
   if ( $self->ss eq '' ) {
     $self->ss('');
@@ -342,8 +530,6 @@ sub check {
     $self->ss("$1-$2-$3");
   }
 
     $self->ss("$1-$2-$3");
   }
 
-  $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
-  $self->country($1);
   unless ( qsearchs('cust_main_county', {
     'country' => $self->country,
     'state'   => '',
   unless ( qsearchs('cust_main_county', {
     'country' => $self->country,
     'state'   => '',
@@ -357,9 +543,66 @@ sub check {
       } );
   }
 
       } );
   }
 
-  $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/
-    or return "Illegal zip: ". $self->zip;
-  $self->zip($1);
+  $error =
+    $self->ut_phonen('daytime', $self->country)
+    || $self->ut_phonen('night', $self->country)
+    || $self->ut_phonen('fax', $self->country)
+    || $self->ut_zip('zip', $self->country)
+  ;
+  return $error if $error;
+
+  my @addfields = qw(
+    last first company address1 address2 city county state zip
+    country daytime night fax
+  );
+
+  if ( defined $self->dbdef_table->column('ship_last') ) {
+    if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
+         && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
+       )
+    {
+      my $error =
+        $self->ut_name('ship_last')
+        || $self->ut_name('ship_first')
+        || $self->ut_textn('ship_company')
+        || $self->ut_text('ship_address1')
+        || $self->ut_textn('ship_address2')
+        || $self->ut_text('ship_city')
+        || $self->ut_textn('ship_county')
+        || $self->ut_textn('ship_state')
+        || $self->ut_country('ship_country')
+      ;
+      return $error if $error;
+
+      #false laziness with above
+      unless ( qsearchs('cust_main_county', {
+        'country' => $self->ship_country,
+        'state'   => '',
+       } ) ) {
+        return "Unknown ship_state/ship_county/ship_country: ".
+          $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
+          unless qsearchs('cust_main_county',{
+            'state'   => $self->ship_state,
+            'county'  => $self->ship_county,
+            'country' => $self->ship_country,
+          } );
+      }
+      #eofalse
+
+      $error =
+        $self->ut_phonen('ship_daytime', $self->ship_country)
+        || $self->ut_phonen('ship_night', $self->ship_country)
+        || $self->ut_phonen('ship_fax', $self->ship_country)
+        || $self->ut_zip('ship_zip', $self->ship_country)
+      ;
+      return $error if $error;
+
+    } else { # ship_ info eq billing info, so don't store dup info in database
+      $self->setfield("ship_$_", '')
+        foreach qw( last first company address1 address2 city county state zip
+                    country daytime night fax );
+    }
+  }
 
   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
     or return "Illegal payby: ". $self->payby;
 
   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
     or return "Illegal payby: ". $self->payby;
@@ -399,7 +642,7 @@ sub check {
 
   }
 
 
   }
 
-  if ( $self->paydate eq '' ) {
+  if ( $self->paydate eq '' || $self->paydate eq '-' ) {
     return "Expriation date required"
       unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
     $self->paydate('');
     return "Expriation date required"
       unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
     $self->paydate('');
@@ -408,8 +651,6 @@ sub check {
       or return "Illegal expiration date: ". $self->paydate;
     if ( length($2) == 4 ) {
       $self->paydate("$2-$1-01");
       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"
-      $self->paydate("19$2-$1-01");
     } else {
       $self->paydate("20$2-$1-01");
     }
     } else {
       $self->paydate("20$2-$1-01");
     }
@@ -450,15 +691,16 @@ Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 
 sub ncancelled_pkgs {
   my $self = shift;
 
 sub ncancelled_pkgs {
   my $self = shift;
-  qsearch( 'cust_pkg', {
-    'custnum' => $self->custnum,
-    'cancel'  => '',
-  }),
-  qsearch( 'cust_pkg', {
-    'custnum' => $self->custnum,
-    'cancel'  => 0,
-  }),
-  ;
+  @{ [ # force list context
+    qsearch( 'cust_pkg', {
+      'custnum' => $self->custnum,
+      'cancel'  => '',
+    }),
+    qsearch( 'cust_pkg', {
+      'custnum' => $self->custnum,
+      'cancel'  => 0,
+    }),
+  ] };
 }
 
 =item bill OPTIONS
 }
 
 =item bill OPTIONS
@@ -489,6 +731,10 @@ sub bill {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
   # 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.
  
@@ -516,6 +762,9 @@ sub bill {
     my $setup = 0;
     unless ( $cust_pkg->setup ) {
       my $setup_prog = $part_pkg->getfield('setup');
     my $setup = 0;
     unless ( $cust_pkg->setup ) {
       my $setup_prog = $part_pkg->getfield('setup');
+      $setup_prog =~ /^(.*)$/ #presumably trusted
+        or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
+      $setup_prog = $1;
       my $cpt = new Safe;
       #$cpt->permit(); #what is necessary?
       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
       my $cpt = new Safe;
       #$cpt->permit(); #what is necessary?
       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
@@ -537,6 +786,9 @@ sub bill {
          ( $cust_pkg->getfield('bill') || 0 ) < $time
     ) {
       my $recur_prog = $part_pkg->getfield('recur');
          ( $cust_pkg->getfield('bill') || 0 ) < $time
     ) {
       my $recur_prog = $part_pkg->getfield('recur');
+      $recur_prog =~ /^(.*)$/ #presumably trusted
+        or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
+      $recur_prog = $1;
       my $cpt = new Safe;
       #$cpt->permit(); #what is necessary?
       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
       my $cpt = new Safe;
       #$cpt->permit(); #what is necessary?
       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
@@ -545,7 +797,8 @@ sub bill {
         warn "Error reval-ing part_pkg->recur pkgpart ",
              $part_pkg->pkgpart, ": $@";
       } else {
         warn "Error reval-ing part_pkg->recur pkgpart ",
              $part_pkg->pkgpart, ": $@";
       } else {
-        #change this bit to use Date::Manip?
+        #change this bit to use Date::Manip? CAREFUL with timezones (see
+        # mailing list archive)
         #$sdate=$cust_pkg->bill || time;
         #$sdate=$cust_pkg->bill || $time;
         $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
         #$sdate=$cust_pkg->bill || time;
         #$sdate=$cust_pkg->bill || $time;
         $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
@@ -559,9 +812,9 @@ sub bill {
       }
     }
 
       }
     }
 
-    warn "setup is undefinded" unless defined($setup);
-    warn "recur is undefinded" unless defined($recur);
-    warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill);
+    warn "setup is undefined" unless defined($setup);
+    warn "recur is undefined" unless defined($recur);
+    warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
 
     if ( $cust_pkg_mod_flag ) {
       $error=$cust_pkg->replace($old_cust_pkg);
 
     if ( $cust_pkg_mod_flag ) {
       $error=$cust_pkg->replace($old_cust_pkg);
@@ -587,7 +840,10 @@ sub bill {
 
   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 
 
   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 
-  return '' if scalar(@cust_bill_pkg) == 0;
+  unless ( @cust_bill_pkg ) {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    return '';
+  }
 
   unless ( $self->getfield('tax') =~ /Y/i
            || $self->getfield('payby') eq 'COMP'
 
   unless ( $self->getfield('tax') =~ /Y/i
            || $self->getfield('payby') eq 'COMP'
@@ -618,11 +874,10 @@ sub bill {
     'charged' => $charged,
   } );
   $error = $cust_bill->insert;
     'charged' => $charged,
   } );
   $error = $cust_bill->insert;
-  #shouldn't happen, but how else to handle this? (wrap me in eval, to catch 
-  # fatal errors)
-  die "Error creating cust_bill record: $error!\n",
-      "Check updated but unbilled packages for customer", $self->custnum, "\n"
-    if $error;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "$error for customer #". $self->custnum;
+  }
 
   my $invnum = $cust_bill->invnum;
   my $cust_bill_pkg;
 
   my $invnum = $cust_bill->invnum;
   my $cust_bill_pkg;
@@ -630,11 +885,13 @@ sub bill {
     $cust_bill_pkg->setfield( 'invnum', $invnum );
     $error = $cust_bill_pkg->insert;
     #shouldn't happen, but how else tohandle this?
     $cust_bill_pkg->setfield( 'invnum', $invnum );
     $error = $cust_bill_pkg->insert;
     #shouldn't happen, but how else tohandle this?
-    die "Error creating cust_bill_pkg record: $error!\n",
-        "Check incomplete invoice ", $invnum, "\n"
-      if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "$error for customer #". $self->custnum;
+    }
   }
   
   }
   
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   ''; #no error
 }
 
   ''; #no error
 }
 
@@ -667,10 +924,6 @@ sub collect {
   my( $self, %options ) = @_;
   my $invoice_time = $options{'invoice_time'} || time;
 
   my( $self, %options ) = @_;
   my $invoice_time = $options{'invoice_time'} || time;
 
-  my $total_owed = $self->balance;
-  warn "collect: total owed $total_owed " if $Debug;
-  return '' unless $total_owed > 0; #redundant?????
-
   #put below somehow?
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   #put below somehow?
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -679,6 +932,17 @@ sub collect {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $total_owed = $self->balance;
+  warn "collect: total owed $total_owed " if $Debug;
+  unless ( $total_owed > 0 ) { #redundant?????
+    $dbh->rollback if $oldAutoCommit;
+    return '';
+  }
+
   foreach my $cust_bill (
     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
   ) {
   foreach my $cust_bill (
     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
   ) {
@@ -752,14 +1016,28 @@ sub collect {
          'paybatch' => ''
       } );
       my $error = $cust_pay->insert;
          'paybatch' => ''
       } );
       my $error = $cust_pay->insert;
-      return 'Error COMPing invnum #' . $cust_bill->invnum .
-             ':' . $error if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
+      }
+
 
     } elsif ( $self->payby eq 'CARD' ) {
 
       if ( $options{'batch_card'} ne 'yes' ) {
 
 
     } elsif ( $self->payby eq 'CARD' ) {
 
       if ( $options{'batch_card'} ne 'yes' ) {
 
-        return "Real time card processing not enabled!" unless $processor;
+        unless ( $processor ) {
+          $dbh->rollback if $oldAutoCommit;
+          return "Real time card processing not enabled!";
+        }
+
+        my $address = $self->address1;
+        $address .= ", ". $self->address2 if $self->address2;
+
+        #fix exp. date
+        #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+        $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+        my $exp = "$2/$1";
 
         if ( $processor =~ /^cybercash/ ) {
 
 
         if ( $processor =~ /^cybercash/ ) {
 
@@ -774,10 +1052,8 @@ sub collect {
           my $payname = $self->payname ||
                         $self->getfield('first'). ' '. $self->getfield('last');
 
           my $payname = $self->payname ||
                         $self->getfield('first'). ' '. $self->getfield('last');
 
-          my $address = $self->address1;
-          $address .= ", ". $self->address2 if $self->address2;
 
 
-          my $country = 'USA' if $self->country eq 'US';
+          my $country = $self->country eq 'US' ? 'USA' : $self->country;
 
           my @full_xaction = ( $xaction,
             'Order-ID'     => $paybatch,
 
           my @full_xaction = ( $xaction,
             'Order-ID'     => $paybatch,
@@ -800,7 +1076,8 @@ sub collect {
           } elsif ( $processor eq 'cybercash3.2' ) {
             %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
           } else {
           } elsif ( $processor eq 'cybercash3.2' ) {
             %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
           } else {
-            return "Unkonwn real-time processor $processor\n";
+            $dbh->rollback if $oldAutoCommit;
+            return "Unknown real-time processor $processor";
           }
          
           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
           }
          
           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
@@ -815,18 +1092,95 @@ sub collect {
                'paybatch' => "$processor:$paybatch",
             } );
             my $error = $cust_pay->insert;
                'paybatch' => "$processor:$paybatch",
             } );
             my $error = $cust_pay->insert;
-            return 'Error applying payment, invnum #' . 
-              $cust_bill->invnum. ':'. $error if $error;
+            if ( $error ) {
+              # gah, even with transactions.
+              $dbh->commit if $oldAutoCommit; #well.
+              my $e = 'WARNING: Card debited but database not updated - '.
+                      'error applying payment, invnum #' . $cust_bill->invnum.
+                      " (CyberCash Order-ID $paybatch): $error";
+              warn $e;
+              return $e;
+            }
           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
                  || $options{'report_badcard'} ) {
           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
                  || $options{'report_badcard'} ) {
+             $dbh->commit if $oldAutoCommit;
              return 'Cybercash error, invnum #' . 
                $cust_bill->invnum. ':'. $result{'MErrMsg'};
           } else {
              return 'Cybercash error, invnum #' . 
                $cust_bill->invnum. ':'. $result{'MErrMsg'};
           } else {
+            $dbh->commit or die $dbh->errstr if $oldAutoCommit;
             return '';
           }
 
             return '';
           }
 
+        } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
+
+          my($payname, $payfirst, $paylast);
+          if ( $self->payname ) {
+            $payname = $self->payname;
+            $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
+              or do {
+                      $dbh->rollback if $oldAutoCommit;
+                      return "Illegal payname $payname";
+                    };
+            ($payfirst, $paylast) = ($1, $2);
+          } else {
+            $payfirst = $self->getfield('first');
+            $paylast = $self->getfield('first');
+            $payname =  "$payfirst $paylast";
+          }
+        
+          my $transaction = new Business::OnlinePayment( $1, @bop_options );
+          $transaction->content(
+            'type'           => 'CC',
+            'login'          => $bop_login,
+            'password'       => $bop_password,
+            'action'         => $bop_action,
+            'amount'         => $amount,
+            'invoice_number' => $cust_bill->invnum,
+            'customer_id'    => $self->custnum,
+            'last_name'      => $paylast,
+            'first_name'     => $payfirst,
+            'name'           => $payname,
+            'address'        => $address,
+            'city'           => $self->city,
+            'state'          => $self->state,
+            'zip'            => $self->zip,
+            'country'        => $self->country,
+            'card_number'    => $self->payinfo,
+            'expiration'     => $exp,
+          );
+          $transaction->submit();
+
+          if ( $transaction->is_success()) {
+            my $cust_pay = new FS::cust_pay ( {
+               'invnum'   => $cust_bill->invnum,
+               'paid'     => $amount,
+               '_date'     => '',
+               'payby'    => 'CARD',
+               'payinfo'  => $self->payinfo,
+               'paybatch' => "$processor:". $transaction->authorization,
+            } );
+            my $error = $cust_pay->insert;
+            if ( $error ) {
+              # gah, even with transactions.
+              $dbh->commit if $oldAutoCommit; #well.
+              my $e = 'WARNING: Card debited but database not updated - '.
+                      'error applying payment, invnum #' . $cust_bill->invnum.
+                      " ($processor): $error";
+              warn $e;
+              return $e;
+            }
+          } elsif ( $options{'report_badcard'} ) {
+            $dbh->commit if $oldAutoCommit;
+            return "$processor error, invnum #". $cust_bill->invnum. ': '.
+                   $transaction->result_code. ": ". $transaction->error_message;
+          } else {
+            $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+            return ''
+          }
+
         } else {
         } else {
-          return "Unkonwn real-time processor $processor\n";
+          $dbh->rollback if $oldAutoCommit;
+          return "Unknown real-time processor $processor\n";
         }
 
       } else { #batch card
         }
 
       } else { #batch card
@@ -849,15 +1203,20 @@ sub collect {
          'amount'   => $amount,
        } );
        my $error = $cust_pay_batch->insert;
          'amount'   => $amount,
        } );
        my $error = $cust_pay_batch->insert;
-       return "Error adding to cust_pay_batch: $error" if $error;
+       if ( $error ) {
+         $dbh->rollback if $oldAutoCommit;
+         return "Error adding to cust_pay_batch: $error";
+       }
 
       }
 
     } else {
 
       }
 
     } else {
+      $dbh->rollback if $oldAutoCommit;
       return "Unknown payment type ". $self->payby;
     }
 
   }
       return "Unknown payment type ". $self->payby;
     }
 
   }
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 
 }
   '';
 
 }
@@ -989,11 +1348,58 @@ sub check_invoicing_list {
   '';
 }
 
   '';
 }
 
+=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
+
+Returns an array of customers referred by this customer (referral_custnum set
+to this custnum).  If DEPTH is given, recurses up to the given depth, returning
+customers referred by customers referred by this customer and so on, inclusive.
+The default behavior is DEPTH 1 (no recursion).
+
+=cut
+
+sub referral_cust_main {
+  my $self = shift;
+  my $depth = @_ ? shift : 1;
+  my $exclude = @_ ? shift : {};
+
+  my @cust_main =
+    map { $exclude->{$_->custnum}++; $_; }
+      grep { ! $exclude->{ $_->custnum } }
+        qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
+
+  if ( $depth > 1 ) {
+    push @cust_main,
+      map { $_->referral_cust_main($depth-1, $exclude) }
+        @cust_main;
+  }
+
+  @cust_main;
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item rebuild_fuzzyfile
+
+=cut
+
+sub rebuild_fuzzyfiles {
+  my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
+  push @all_last,
+                 grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
+      if defined dbdef->table('cust_main')->column('ship_last');
+#  open(
+
+}
+
 =back
 
 =head1 VERSION
 
 =back
 
 =head1 VERSION
 
-$Id: cust_main.pm,v 1.3 2000-01-31 05:22:23 ivan Exp $
+$Id: cust_main.pm,v 1.24 2001-09-01 21:52:20 jeff Exp $
 
 =head1 BUGS
 
 
 =head1 BUGS
 
@@ -1010,8 +1416,6 @@ CyberCash v2 forces us to define some variables in package main.
 There should probably be a configuration file with a list of allowed credit
 card types.
 
 There should probably be a configuration file with a list of allowed credit
 card types.
 
-CyberCash is the only processor.
-
 No multiple currency support (probably a larger project than just this module).
 
 =head1 SEE ALSO
 No multiple currency support (probably a larger project than just this module).
 
 =head1 SEE ALSO
Freeside billing, trouble ticketing, network monitoring and provisioning