Transactions Part I!!!

diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm
index d52c9c1..8480cea 100644 (file)
--- a/FS/FS/cust_bill.pm
+++ b/FS/FS/cust_bill.pm
@@ -85,9 +85,6 @@ L<Time::Local> and L<Date::Parse> for conversion functions.
 
 =item charged - amount of this invoice
 
 
 =item charged - amount of this invoice
 

-=item owed - amount still outstanding on this invoice, which is charged minus
-all payments (see L<FS::cust_pay>).
-

 =item printed - how many times this invoice has been printed automatically
 (see L<FS::cust_main/"collect">).
 
 =item printed - how many times this invoice has been printed automatically
 (see L<FS::cust_main/"collect">).
 


@@ -112,21 +109,6 @@ sub table { 'cust_bill'; }
 Adds this invoice to the database ("Posts" the invoice).  If there is an error,
 returns the error, otherwise returns false.
 
 Adds this invoice to the database ("Posts" the invoice).  If there is an error,
 returns the error, otherwise returns false.
 

-When adding new invoices, owed must be charged (or null, in which case it is
-automatically set to charged).
-
-=cut
-
-sub insert {
-  my $self = shift;
-
-  $self->owed( $self->charged ) if $self->owed eq '';
-  return "owed != charged!"
-    unless $self->owed == $self->charged;
-
-  $self->SUPER::insert;
-}
-

 =item delete
 
 Currently unimplemented.  I don't remove invoices because there would then be
 =item delete
 
 Currently unimplemented.  I don't remove invoices because there would then be


@@ -143,9 +125,8 @@ sub delete {
 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.
 

-Only owed and printed may be changed.  Owed is normally updated by creating and
-inserting a payment (see L<FS::cust_pay>).  Printed is normally updated by
-calling the collect method of a customer object (see L<FS::cust_main>).
+Only printed may be changed.  printed is normally updated by calling the
+collect method of a customer object (see L<FS::cust_main>).

 
 =cut
 
 
 =cut
 


@@ -155,7 +136,6 @@ sub replace {
   #return "Can't change _date!" unless $old->_date eq $new->_date;
   return "Can't change _date!" unless $old->_date == $new->_date;
   return "Can't change charged!" unless $old->charged == $new->charged;
   #return "Can't change _date!" unless $old->_date eq $new->_date;
   return "Can't change _date!" unless $old->_date == $new->_date;
   return "Can't change charged!" unless $old->charged == $new->charged;

-  return "(New) owed can't be > (new) charged!" if $new->owed > $new->charged;

 
   $new->SUPER::replace($old);
 }
 
   $new->SUPER::replace($old);
 }


@@ -176,7 +156,6 @@ sub check {
     || $self->ut_number('custnum')
     || $self->ut_numbern('_date')
     || $self->ut_money('charged')
     || $self->ut_number('custnum')
     || $self->ut_numbern('_date')
     || $self->ut_money('charged')

-    || $self->ut_money('owed')

     || $self->ut_numbern('printed')
   ;
   return $error if $error;
     || $self->ut_numbern('printed')
   ;
   return $error if $error;


@@ -252,6 +231,20 @@ sub cust_pay {
   ;
 }
 
   ;
 }
 

+=item owed
+
+Returns the amount owed (still outstanding) on this invoice, which is charged
+minus all payments (see L<FS::cust_pay>).
+
+=cut
+
+sub owed {
+  my $self = shift;
+  my $balance = $self->charged;
+  $balance -= $_->paid foreach ( $self->cust_pay );
+  $balance;
+}
+

 =item print_text [TIME];
 
 Returns an text invoice, as a list of lines.
 =item print_text [TIME];
 
 Returns an text invoice, as a list of lines.


@@ -431,7 +424,7 @@ sub print_text {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_bill.pm,v 1.6 2001-03-30 17:33:52 ivan Exp $
+$Id: cust_bill.pm,v 1.7 2001-04-09 23:05:15 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index e868537..5888d07 100644 (file)
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -5,6 +5,7 @@ use vars qw( @ISA );
 use FS::UID qw( getotaker );
 use FS::Record qw( qsearchs );
 use FS::cust_main;
 use FS::UID qw( getotaker );
 use FS::Record qw( qsearchs );
 use FS::cust_main;

+use FS::cust_refund;

 
 @ISA = qw( FS::Record );
 
 
 @ISA = qw( FS::Record );
 


@@ -41,9 +42,6 @@ FS::Record.  The following fields are currently supported:
 
 =item amount - amount of the credit
 
 
 =item amount - amount of the credit
 

-=item credited - how much of this credit that is still outstanding, which is
-amount minus all refunds (see L<FS::cust_refund>).
-

 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 L<Time::Local> and L<Date::Parse> for conversion functions.
 
 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 L<Time::Local> and L<Date::Parse> for conversion functions.
 


@@ -70,26 +68,6 @@ sub table { 'cust_credit'; }
 Adds this credit to the database ("Posts" the credit).  If there is an error,
 returns the error, otherwise returns false.
 
 Adds this credit to the database ("Posts" the credit).  If there is an error,
 returns the error, otherwise returns false.
 

-When adding new invoices, credited must be amount (or null, in which case it is
-automatically set to amount).
-
-=cut
-
-sub insert {
-  my $self = shift;
-
-  my $error;
-  return $error if $error = $self->ut_money('credited')
-                         || $self->ut_money('amount');
-
-  $self->credited($self->amount) if $self->credited == 0
-                                 || $self->credited eq '';
-  return "credited != amount!"
-    unless $self->credited == $self->amount;
-
-  $self->SUPER::insert;
-}
-

 =item delete
 
 Currently unimplemented.
 =item delete
 
 Currently unimplemented.


@@ -102,25 +80,13 @@ sub delete {
 
 =item replace OLD_RECORD
 
 
 =item replace OLD_RECORD
 

-Replaces the OLD_RECORD with this one in the database.  If there is an error,
-returns the error, otherwise returns false.
-
-Only credited may be changed.  Credited is normally updated by creating and
-inserting a refund (see L<FS::cust_refund>).
+Credits may not be modified; there would then be no record the credit was ever
+posted.

 
 =cut
 
 sub replace {
 
 =cut
 
 sub replace {

-  my ( $new, $old ) = ( shift, shift );
-
-  return "Can't change custnum!" unless $old->custnum == $new->custnum;
-  #return "Can't change date!" unless $old->_date eq $new->_date;
-  return "Can't change date!" unless $old->_date == $new->_date;
-  return "Can't change amount!" unless $old->amount == $new->amount;
-  return "(New) credited can't be > (new) amount!"
-    if $new->credited > $new->amount;
-
-  $new->SUPER::replace($old);
+  return "Can't modify credit!"

 }
 
 =item check
 }
 
 =item check


@@ -139,7 +105,6 @@ sub check {
     || $self->ut_number('custnum')
     || $self->ut_numbern('_date')
     || $self->ut_money('amount')
     || $self->ut_number('custnum')
     || $self->ut_numbern('_date')
     || $self->ut_money('amount')

-    || $self->ut_money('credited')

     || $self->ut_textn('reason');
   ;
   return $error if $error;
     || $self->ut_textn('reason');
   ;
   return $error if $error;


@@ -154,11 +119,38 @@ sub check {
   ''; #no error
 }
 
   ''; #no error
 }
 

+=item cust_refund
+
+Returns all refunds (see L<FS::cust_refund>) for this credit.
+
+=cut
+
+sub cust_refund {
+  my $self = shift;
+  sort { $a->_date <=> $b->_date }
+    qsearch( 'cust_refund', { 'crednum' => $self->crednum } )
+  ;
+}
+
+=item credited
+
+Returns the amount of this credit that is still outstanding; which is
+amount minus all refunds (see L<FS::cust_refund>).
+
+=cut
+
+sub credited {
+  my $self = shift;
+  my $amount = $self->amount;
+  $amount -= $_->refund foreach ( $self->cust_refund );
+  $amount;
+}
+

 =back
 
 =head1 VERSION
 
 =back
 
 =head1 VERSION
 

-$Id: cust_credit.pm,v 1.2 2001-02-11 17:17:39 ivan Exp $
+$Id: cust_credit.pm,v 1.3 2001-04-09 23:05:15 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 7b75bea..4a254e0 100644 (file)
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -208,6 +208,7 @@ sub insert {
   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;
 
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 


@@ -227,14 +228,14 @@ sub insert {
     $seconds = $prepay_credit->seconds;
     my $error = $prepay_credit->delete;
     if ( $error ) {
     $seconds = $prepay_credit->seconds;
     my $error = $prepay_credit->delete;
     if ( $error ) {

-      $dbh->rollback;
+      $dbh->rollback if $oldAutoCommit;

       return $error;
     }
   }
 
   my $error = $self->SUPER::insert;
   if ( $error ) {
       return $error;
     }
   }
 
   my $error = $self->SUPER::insert;
   if ( $error ) {

-    $dbh->rollback;
+    $dbh->rollback if $oldAutoCommit;

     return $error;
   }
 
     return $error;
   }
 


@@ -244,7 +245,7 @@ sub insert {
       $cust_pkg->custnum( $self->custnum );
       $error = $cust_pkg->insert;
       if ( $error ) {
       $cust_pkg->custnum( $self->custnum );
       $error = $cust_pkg->insert;
       if ( $error ) {

-        $dbh->rollback;
+        $dbh->rollback if $oldAutoCommit;

         return $error;
       }
       foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
         return $error;
       }
       foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {


@@ -255,7 +256,7 @@ sub insert {
         }
         $error = $svc_something->insert;
         if ( $error ) {
         }
         $error = $svc_something->insert;
         if ( $error ) {

-          $dbh->rollback;
+          $dbh->rollback if $oldAutoCommit;

           return $error;
         }
       }
           return $error;
         }
       }


@@ -263,7 +264,7 @@ sub insert {
   }
 
   if ( $seconds ) {
   }
 
   if ( $seconds ) {

-    $dbh->rollback;
+    $dbh->rollback if $oldAutoCommit;

     return "No svc_acct record to apply pre-paid time";
   }
 
     return "No svc_acct record to apply pre-paid time";
   }
 


@@ -274,12 +275,12 @@ sub insert {
     };
     $error = $cust_credit->insert;
     if ( $error ) {
     };
     $error = $cust_credit->insert;
     if ( $error ) {

-      $dbh->rollback;
+      $dbh->rollback if $oldAutoCommit;

       return $error;
     }
   }
 
       return $error;
     }
   }
 

-  $dbh->commit or die $dbh->errstr;
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;

   '';
 
 }
   '';
 
 }


@@ -304,13 +305,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';


@@ -318,27 +312,56 @@ 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;
+    }

   }
 
   }
 

-  $self->SUPER::delete;
+  my $error = $self->SUPER::delete;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+

 }
 
 =item replace OLD_RECORD
 }
 
 =item replace OLD_RECORD


@@ -549,6 +572,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.
  


@@ -648,7 +675,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'


@@ -679,11 +709,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;


@@ -691,11 +720,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
 }
 


@@ -728,10 +759,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';


@@ -740,6 +767,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, } )
   ) {


@@ -813,14 +851,20 @@ 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!";
+        }

 
         if ( $processor =~ /^cybercash/ ) {
 
 
         if ( $processor =~ /^cybercash/ ) {
 


@@ -861,7 +905,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 "Unknown 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


@@ -876,17 +921,27 @@ 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 '';
           }
 
         } else {
             return '';
           }
 
         } else {

+          $dbh->rollback if $oldAutoCommit;

           return "Unknown real-time processor $processor\n";
         }
 
           return "Unknown real-time processor $processor\n";
         }
 


@@ -910,15 +965,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;

   '';
 
 }
   '';
 
 }


@@ -1054,7 +1114,7 @@ sub check_invoicing_list {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_main.pm,v 1.10 2001-02-03 14:03:50 ivan Exp $
+$Id: cust_main.pm,v 1.11 2001-04-09 23:05:15 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm
index 728981a..f0d9450 100644 (file)
--- a/FS/FS/cust_pay.pm
+++ b/FS/FS/cust_pay.pm
@@ -74,26 +74,11 @@ L<FS::cust_bill>).
 sub insert {
   my $self = shift;
 
 sub insert {
   my $self = shift;
 

-  my $error;
-
-  $error = $self->check;
+  my $error = $self->check;

   return $error if $error;
 
   my $old_cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
   return "Unknown invnum" unless $old_cust_bill;
   return $error if $error;
 
   my $old_cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
   return "Unknown invnum" unless $old_cust_bill;

-  my %hash = $old_cust_bill->hash;
-  $hash{'owed'} = sprintf("%.2f", $hash{owed} - $self->paid );
-  my $new_cust_bill = new FS::cust_bill ( \%hash );
-
-  local $SIG{HUP} = 'IGNORE';
-  local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE';
-  local $SIG{TERM} = 'IGNORE';
-  local $SIG{TSTP} = 'IGNORE';
-  local $SIG{PIPE} = 'IGNORE';
-
-  $error = $new_cust_bill->replace($old_cust_bill);
-  return "Error modifying cust_bill: $error" if $error;

 
   $self->SUPER::insert;
 }
 
   $self->SUPER::insert;
 }


@@ -173,7 +158,7 @@ sub check {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_pay.pm,v 1.2 2001-02-11 17:17:39 ivan Exp $
+$Id: cust_pay.pm,v 1.3 2001-04-09 23:05:15 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 08be4e4..9705827 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -2,7 +2,7 @@ package FS::cust_pkg;
 
 use strict;
 use vars qw(@ISA);
 
 use strict;
 use vars qw(@ISA);

-use FS::UID qw( getotaker );
+use FS::UID qw( getotaker dbh );

 use FS::Record qw( qsearch qsearchs );
 use FS::cust_svc;
 use FS::part_pkg;
 use FS::Record qw( qsearch qsearchs );
 use FS::cust_svc;
 use FS::part_pkg;


@@ -218,26 +218,41 @@ sub cancel {
   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;
+

   foreach my $cust_svc (
     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 
   foreach my $cust_svc (
     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 

-    $part_svc->svcdb =~ /^([\w\-]+)$/
-      or return "Illegal svcdb value in part_svc!";
+    $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "Illegal svcdb value in part_svc!";
+    };

     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->cancel;
     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->cancel;

-      return "Error cancelling service: $error" if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Error cancelling service: $error" 
+      }

       $error = $svc->delete;
       $error = $svc->delete;

-      return "Error deleting service: $error" if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Error deleting service: $error";
+      }

     }
 
     $error = $cust_svc->delete;
     }
 
     $error = $cust_svc->delete;

-    return "Error deleting cust_svc: $error" if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error deleting cust_svc: $error";
+    }

 
   }
 
 
   }
 


@@ -246,9 +261,14 @@ sub cancel {
     $hash{'cancel'} = time;
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     $hash{'cancel'} = time;
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);

-    return $error if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }

   }
 
   }
 

+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+

   ''; #no errors
 }
 
   ''; #no errors
 }
 


@@ -272,20 +292,29 @@ sub suspend {
   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;
+

   foreach my $cust_svc (
     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 
   foreach my $cust_svc (
     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 

-    $part_svc->svcdb =~ /^([\w\-]+)$/
-      or return "Illegal svcdb value in part_svc!";
+    $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "Illegal svcdb value in part_svc!";
+    };

     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->suspend;
     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->suspend;

-      return $error if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }

     }
 
   }
     }
 
   }


@@ -295,9 +324,14 @@ sub suspend {
     $hash{'susp'} = time;
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     $hash{'susp'} = time;
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);

-    return $error if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }

   }
 
   }
 

+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+

   ''; #no errors
 }
 
   ''; #no errors
 }
 


@@ -321,20 +355,29 @@ sub unsuspend {
   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;
+

   foreach my $cust_svc (
     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 
   foreach my $cust_svc (
     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
   ) {
     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
 

-    $part_svc->svcdb =~ /^([\w\-]+)$/
-      or return "Illegal svcdb value in part_svc!";
+    $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "Illegal svcdb value in part_svc!";
+    };

     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->unsuspend;
     my $svcdb = $1;
     require "FS/$svcdb.pm";
 
     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
     if ($svc) {
       $error = $svc->unsuspend;

-      return $error if $error;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }

     }
 
   }
     }
 
   }


@@ -344,9 +387,14 @@ sub unsuspend {
     $hash{'susp'} = '';
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);
     $hash{'susp'} = '';
     my $new = new FS::cust_pkg ( \%hash );
     $error = $new->replace($self);

-    return $error if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }

   }
 
   }
 

+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+

   ''; #no errors
 }
 
   ''; #no errors
 }
 


@@ -398,6 +446,10 @@ L<FS::pkg_svc>).
 sub order {
   my($custnum,$pkgparts,$remove_pkgnums)=@_;
 
 sub order {
   my($custnum,$pkgparts,$remove_pkgnums)=@_;
 

+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+

   # generate %part_pkg
   # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
   #
   # generate %part_pkg
   # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
   #


@@ -425,8 +477,10 @@ sub order {
   # @cust_svc is a corresponding list of lists of FS::Record objects
   my($pkgpart);
   foreach $pkgpart ( @{$pkgparts} ) {
   # @cust_svc is a corresponding list of lists of FS::Record objects
   my($pkgpart);
   foreach $pkgpart ( @{$pkgparts} ) {

-    return "Customer not permitted to purchase pkgpart $pkgpart!"
-      unless $part_pkg{$pkgpart};
+    unless ( $part_pkg{$pkgpart} ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Customer not permitted to purchase pkgpart $pkgpart!";
+    }

     push @cust_svc, [
       map {
         ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
     push @cust_svc, [
       map {
         ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();


@@ -437,6 +491,7 @@ sub order {
   #check for leftover services
   foreach (keys %svcnum) {
     next unless @{ $svcnum{$_} };
   #check for leftover services
   foreach (keys %svcnum) {
     next unless @{ $svcnum{$_} };

+    $dbh->rollback if $oldAutoCommit;

     return "Leftover services, svcpart $_: svcnum ".
            join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
   }
     return "Leftover services, svcpart $_: svcnum ".
            join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
   }


@@ -454,12 +509,18 @@ sub order {
 #  my($pkgnum);
   foreach $pkgnum ( @{$remove_pkgnums} ) {
     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
 #  my($pkgnum);
   foreach $pkgnum ( @{$remove_pkgnums} ) {
     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});

-    die "Package $pkgnum not found to remove!" unless $old;
+    unless ( $old ) {
+      $dbh->rollback if $oldAutoCommit;
+      die "Package $pkgnum not found to remove!";
+    }

     my(%hash) = $old->hash;
     $hash{'cancel'}=time;   
     my($new) = new FS::cust_pkg ( \%hash );
     my($error)=$new->replace($old);
     my(%hash) = $old->hash;
     $hash{'cancel'}=time;   
     my($new) = new FS::cust_pkg ( \%hash );
     my($error)=$new->replace($old);

-    die "Couldn't update package $pkgnum: $error" if $error;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      die "Couldn't update package $pkgnum: $error";
+    }

   }
 
   #now add new packages, changing cust_svc records if necessary
   }
 
   #now add new packages, changing cust_svc records if necessary


@@ -471,7 +532,10 @@ sub order {
                                        'pkgpart' => $pkgpart,
                                     } );
     my($error) = $new->insert;
                                        'pkgpart' => $pkgpart,
                                     } );
     my($error) = $new->insert;

-    die "Couldn't insert new cust_pkg record: $error" if $error; 
+   if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      die "Couldn't insert new cust_pkg record: $error";
+    }

     my($pkgnum)=$new->getfield('pkgnum');
  
     my($cust_svc);
     my($pkgnum)=$new->getfield('pkgnum');
  
     my($cust_svc);


@@ -480,10 +544,15 @@ sub order {
       $hash{'pkgnum'}=$pkgnum;
       my($new) = new FS::cust_svc ( \%hash );
       my($error)=$new->replace($cust_svc);
       $hash{'pkgnum'}=$pkgnum;
       my($new) = new FS::cust_svc ( \%hash );
       my($error)=$new->replace($cust_svc);

-      die "Couldn't link old service to new package: $error" if $error;
+     if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        die "Couldn't link old service to new package: $error";
+      }

     }
   }  
 
     }
   }  
 

+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+

   ''; #no errors
 }
 
   ''; #no errors
 }
 


@@ -491,7 +560,7 @@ sub order {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_pkg.pm,v 1.4 2000-02-03 05:16:52 ivan Exp $
+$Id: cust_pkg.pm,v 1.5 2001-04-09 23:05:15 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm
index 742c9bb..729dc02 100644 (file)
--- a/FS/FS/cust_refund.pm
+++ b/FS/FS/cust_refund.pm
@@ -75,27 +75,12 @@ L<FS::cust_credit>).
 sub insert {
   my $self = shift;
 
 sub insert {
   my $self = shift;
 

-  my $error;
-
-  $error=$self->check;
+  my $error = $self->check;

   return $error if $error;
 
   my $old_cust_credit =
     qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
   return "Unknown crednum" unless $old_cust_credit;
   return $error if $error;
 
   my $old_cust_credit =
     qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
   return "Unknown crednum" unless $old_cust_credit;

-  my %hash = $old_cust_credit->hash;
-  $hash{credited} = sprintf("%.2f", $hash{credited} - $self->refund );
-  my($new_cust_credit) = new FS::cust_credit ( \%hash );
-
-  local $SIG{HUP} = 'IGNORE';
-  local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE';
-  local $SIG{TERM} = 'IGNORE';
-  local $SIG{TSTP} = 'IGNORE';
-  local $SIG{PIPE} = 'IGNORE';
-
-  $error = $new_cust_credit->replace($old_cust_credit);
-  return "Error modifying cust_credit: $error" if $error;

 
   $self->SUPER::insert;
 }
 
   $self->SUPER::insert;
 }


@@ -172,7 +157,7 @@ sub check {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: cust_refund.pm,v 1.2 2001-02-11 17:17:39 ivan Exp $
+$Id: cust_refund.pm,v 1.3 2001-04-09 23:05:15 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/FS/FS/session.pm b/FS/FS/session.pm
index 30d21d9..55bb678 100644 (file)
--- a/FS/FS/session.pm
+++ b/FS/FS/session.pm
@@ -2,6 +2,7 @@ package FS::session;
 
 use strict;
 use vars qw( @ISA $conf $start $stop );
 
 use strict;
 use vars qw( @ISA $conf $start $stop );

+use FS::UID qw( dbh );

 use FS::Record qw( qsearchs );
 use FS::svc_acct;
 use FS::port;
 use FS::Record qw( qsearchs );
 use FS::svc_acct;
 use FS::port;


@@ -100,14 +101,24 @@ sub insert {
   $error = $self->check;
   return $error if $error;
 
   $error = $self->check;
   return $error if $error;
 

-  return "a session on that port is already open!"
-    if qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } );
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  if ( qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } ) ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "a session on that port is already open!";
+  }

 
   $self->setfield('login', time()) unless $self->getfield('login');
 
   $error = $self->SUPER::insert;
 
   $self->setfield('login', time()) unless $self->getfield('login');
 
   $error = $self->SUPER::insert;

-  return $error if $error;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }

 
 

+  #transactional accuracy not essential; just an indication of data freshness

   $self->nas_heartbeat($self->getfield('login'));
 
   #session-starting callback
   $self->nas_heartbeat($self->getfield('login'));
 
   #session-starting callback


@@ -117,7 +128,8 @@ sub insert {
     #kcuy
   my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
   system( eval qq("$start") ) if $start;
     #kcuy
   my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
   system( eval qq("$start") ) if $start;

-
+  
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;

   '';
 
 }
   '';
 
 }


@@ -149,14 +161,25 @@ sub replace {
   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;
+

   $error = $self->check;
   $error = $self->check;

-  return $error if $error;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }

 
   $self->setfield('logout', time()) unless $self->getfield('logout');
 
   $error = $self->SUPER::replace($old);
 
   $self->setfield('logout', time()) unless $self->getfield('logout');
 
   $error = $self->SUPER::replace($old);

-  return $error if $error;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }

 
 

+  #transactional accuracy not essential; just an indication of data freshness

   $self->nas_heartbeat($self->getfield('logout'));
 
   #session-ending callback
   $self->nas_heartbeat($self->getfield('logout'));
 
   #session-ending callback


@@ -167,6 +190,8 @@ sub replace {
   my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
   system( eval qq("$stop") ) if $stop;
 
   my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
   system( eval qq("$stop") ) if $stop;
 

+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+

   '';
 }
 
   '';
 }
 


@@ -224,7 +249,7 @@ sub svc_acct {
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: session.pm,v 1.5 2001-02-27 00:59:36 ivan Exp $
+$Id: session.pm,v 1.6 2001-04-09 23:05:15 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm
index 5bea5b0..8bcdf4f 100644 (file)
--- a/FS/FS/svc_Common.pm
+++ b/FS/FS/svc_Common.pm
@@ -55,7 +55,7 @@ sub insert {
   my $cust_svc;
   unless ( $svcnum ) {
     $cust_svc = new FS::cust_svc ( {
   my $cust_svc;
   unless ( $svcnum ) {
     $cust_svc = new FS::cust_svc ( {

-      'svcnum'  => $svcnum,
+      #hua?# 'svcnum'  => $svcnum,

       'pkgnum'  => $self->pkgnum,
       'svcpart' => $self->svcpart,
     } );
       'pkgnum'  => $self->pkgnum,
       'svcpart' => $self->svcpart,
     } );


@@ -184,7 +184,7 @@ sub cancel { ''; }
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-$Id: svc_Common.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+$Id: svc_Common.pm,v 1.2 2001-04-09 23:05:15 ivan Exp $

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/TODO b/TODO
index 081c481..a9b3f64 100644 (file)
--- a/TODO
+++ b/TODO
@@ -1,4 +1,4 @@
-$Id: TODO,v 1.58 2001-04-09 15:50:50 ivan Exp $
+$Id: TODO,v 1.59 2001-04-09 23:05:15 ivan Exp $

 
 If you are interested in helping with any of these, please join the
 *development* mailing list (send a blank message to
 
 If you are interested in helping with any of these, please join the
 *development* mailing list (send a blank message to


@@ -6,6 +6,9 @@ ivan-freeside-devel-subscribe@sisd.com) to avoid duplication of effort.
 
 ---
 
 
 ---
 

+anything doing transactions in the web interface should likely move into *.pm.
+(transactions are here woo!)
+

 write some sample billing expressions with libcflow-perl :)
 
 (future templating)
 write some sample billing expressions with libcflow-perl :)
 
 (future templating)

diff --git a/bin/fs-setup b/bin/fs-setup
index 1df46d3..2a37fb8 100755 (executable)
--- a/bin/fs-setup
+++ b/bin/fs-setup
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -Tw
 #
 #!/usr/bin/perl -Tw
 #

-# $Id: fs-setup,v 1.33 2001-02-03 14:03:50 ivan Exp $
+# $Id: fs-setup,v 1.34 2001-04-09 23:05:16 ivan Exp $

 #
 # ivan@sisd.com 97-nov-8,9
 #
 #
 # ivan@sisd.com 97-nov-8,9
 #


@@ -32,7 +32,10 @@
 # fix radius attributes ivan@sisd.com 98-sep-27
 #
 # $Log: fs-setup,v $
 # fix radius attributes ivan@sisd.com 98-sep-27
 #
 # $Log: fs-setup,v $

-# Revision 1.33  2001-02-03 14:03:50  ivan
+# Revision 1.34  2001-04-09 23:05:16  ivan
+# Transactions Part I!!!
+#
+# Revision 1.33  2001/02/03 14:03:50  ivan

 # time-based prepaid cards, session monitor.  woop!
 #
 # Revision 1.32  2000/12/04 00:13:02  ivan
 # time-based prepaid cards, session monitor.  woop!
 #
 # Revision 1.32  2000/12/04 00:13:02  ivan


@@ -392,7 +395,6 @@ sub tables_hash_hack {
         'custnum',   'int',  '', '',
         '_date',     @date_type,
         'charged',   @money_type,
         'custnum',   'int',  '', '',
         '_date',     @date_type,
         'charged',   @money_type,

-        'owed',      @money_type,

         'printed',   'int',  '', '',
       ],
       'primary_key' => 'invnum',
         'printed',   'int',  '', '',
       ],
       'primary_key' => 'invnum',


@@ -420,7 +422,6 @@ sub tables_hash_hack {
         'custnum',  'int', '', '',
         '_date',    @date_type,
         'amount',   @money_type,
         'custnum',  'int', '', '',
         '_date',    @date_type,
         'amount',   @money_type,

-        'credited', @money_type,

         'otaker',   'varchar', '', 8,
         'reason',   'varchar', '', 255,
       ],
         'otaker',   'varchar', '', 8,
         'reason',   'varchar', '', 255,
       ],

diff --git a/htdocs/docs/index.html b/htdocs/docs/index.html
index 8241090..ab2f84c 100644 (file)
--- a/htdocs/docs/index.html
+++ b/htdocs/docs/index.html
@@ -11,7 +11,7 @@
   <li><a href="upgrade3.html">Upgrading from 1.1.x to 1.2.x</a>
   <li><a href="upgrade4.html">Upgrading from 1.2.x to 1.2.2</a>
   <li><a href="upgrade5.html">Upgrading from 1.2.2 to 1.2.3</a>
   <li><a href="upgrade3.html">Upgrading from 1.1.x to 1.2.x</a>
   <li><a href="upgrade4.html">Upgrading from 1.2.x to 1.2.2</a>
   <li><a href="upgrade5.html">Upgrading from 1.2.2 to 1.2.3</a>

-  <li><a href="upgrade6.html">Upgrading from 1.2.3 to 1.2.4</a>
+  <li><a href="upgrade6.html">Upgrading from 1.2.3 to 1.3.0</a>

   <li><a href="config.html">Configuration files</a>
   <li><a href="admin.html">Administration</a>
 <!--
   <li><a href="config.html">Configuration files</a>
   <li><a href="admin.html">Administration</a>
 <!--

diff --git a/htdocs/docs/install.html b/htdocs/docs/install.html
index 09c6811..61eec08 100644 (file)
--- a/htdocs/docs/install.html
+++ b/htdocs/docs/install.html
@@ -8,7 +8,7 @@ Before installing, you need:
   <li>A web server, such as <a href="http://www.apache-ssl.org">Apache-SSL</a> or <a href="http://www.apache.org">Apache</a>
   <li><a href="http://www.openssh.com//">SSH</a>
   <li><a href="http://www.perl.com/CPAN/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_05 for the 5.004 series or 5.005_03 for the 5.005 series.  Don't enable experimental features like threads or the PerlIO abstraction layer.)
   <li>A web server, such as <a href="http://www.apache-ssl.org">Apache-SSL</a> or <a href="http://www.apache.org">Apache</a>
   <li><a href="http://www.openssh.com//">SSH</a>
   <li><a href="http://www.perl.com/CPAN/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_05 for the 5.004 series or 5.005_03 for the 5.005 series.  Don't enable experimental features like threads or the PerlIO abstraction layer.)

-  <li>A database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>, such as <a href="http://www.tcx.se/">MySQL</a> or <a href="http://www.postgresql.org/">PostgreSQL</a> (verstion 6.5 or higher) (see the <a href="postgresql.html">PostgreSQL notes</a>)
+  <li>A <b>transactional</b> database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>.  <a href="http://www.postgresql.org/">PostgreSQL</a> is recommended.  (see the <a href="postgresql.html">PostgreSQL notes</a>)  <b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">MyISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are not supported</b>.  If you really want to use MySQL, you need to use one of the new <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>.

   <li>Perl modules (<a href="http://www.perl.com/CPAN/doc/manual/html/lib/CPAN.html">CPAN</a> will query, download and build perl modules automatically)
     <ul>
       <li><a href="http://www.perl.com/CPAN/modules/by-module/Array/">Array-PrintCols</a>
   <li>Perl modules (<a href="http://www.perl.com/CPAN/doc/manual/html/lib/CPAN.html">CPAN</a> will query, download and build perl modules automatically)
     <ul>
       <li><a href="http://www.perl.com/CPAN/modules/by-module/Array/">Array-PrintCols</a>

diff --git a/htdocs/docs/schema.html b/htdocs/docs/schema.html
index 45c98ab..95929ea 100644 (file)
--- a/htdocs/docs/schema.html
+++ b/htdocs/docs/schema.html
@@ -23,7 +23,6 @@
         <li>custnum - <a href="#cust_main">customer</a>
         <li>_date
         <li>charged - amount of this invoice
         <li>custnum - <a href="#cust_main">customer</a>
         <li>_date
         <li>charged - amount of this invoice

-        <li>owed - amount still outstanding on this invoice

         <li>printed - how many times this invoice has been printed automatically
       </ul>
     <li><a name="cust_bill_pkg">cust_bill_pkg</a> - Invoice line items
         <li>printed - how many times this invoice has been printed automatically
       </ul>
     <li><a name="cust_bill_pkg">cust_bill_pkg</a> - Invoice line items


@@ -40,7 +39,6 @@
         <li>crednum - primary key
         <li>custnum - <a href="#cust_main">customer</a>
         <li>amount - amount credited
         <li>crednum - primary key
         <li>custnum - <a href="#cust_main">customer</a>
         <li>amount - amount credited

-        <li>credited - amount still outstanding (not yet refunded) on this credit

         <li>_date
         <li>otaker - order taker
         <li>reason
         <li>_date
         <li>otaker - order taker
         <li>reason

diff --git a/htdocs/docs/upgrade6.html b/htdocs/docs/upgrade6.html
index 8e70b55..807146f 100644 (file)
--- a/htdocs/docs/upgrade6.html
+++ b/htdocs/docs/upgrade6.html
@@ -1,8 +1,8 @@
 <head>
 <head>

-  <title>Upgrading to 1.2.4</title>
+  <title>Upgrading to 1.3.0</title>

 </head>
 <body>
 </head>
 <body>

-<h1>Upgrading to 1.2.4 from 1.2.3</h1>
+<h1>Upgrading to 1.3.0 from 1.2.3</h1>

 <ul>
   <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
   <li>If migrating from less than 1.1.4, see these <a href="upgrade2.html">instructions</a> first.
 <ul>
   <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
   <li>If migrating from less than 1.1.4, see these <a href="upgrade2.html">instructions</a> first.


@@ -10,6 +10,7 @@
   <li>If migrating from less than 1.2.2, see these <a href="upgrade4.html">instructions</a> first.
   <li>If migrating from less than 1.2.3, see these <a href="upgrade5.html">instructions</a> first.
   <li>Back up your data and current Freeside installation.
   <li>If migrating from less than 1.2.2, see these <a href="upgrade4.html">instructions</a> first.
   <li>If migrating from less than 1.2.3, see these <a href="upgrade5.html">instructions</a> first.
   <li>Back up your data and current Freeside installation.

+  <li>As 1.3.0 requires transactions, <b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">MyISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are no longer supported</b>.  Converting to <a href="http://www.postgresql.org/">PostgreSQL</a> is recommended.  If you really want to use MySQL, convert your tables to one of the <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>.

   <li>Copy the <i>invoice_template</i> file from the <i>conf/</i> directory in the distribution to your <a href="config.html">configuration directory</a>.
   <li>Install the <a href="http://www.perl.com/CPAN/modules/by-module/Text/">Text-Template</a> Perl module.
   <li>Apply the following changes to your database:
   <li>Copy the <i>invoice_template</i> file from the <i>conf/</i> directory in the distribution to your <a href="config.html">configuration directory</a>.
   <li>Install the <a href="http://www.perl.com/CPAN/modules/by-module/Text/">Text-Template</a> Perl module.
   <li>Apply the following changes to your database:


@@ -40,6 +41,17 @@ ALTER TABLE part_svc ADD svc_acct__seconds_flag char(1) NULL;
 ALTER TABLE prepay_credit ADD seconds integer NULL;
 
 </pre>
 ALTER TABLE prepay_credit ADD seconds integer NULL;
 
 </pre>

+  <li>If your database supports dropping columns:
+<pre>
+ALTER TABLE cust_bill DROP owed;
+ALTER TABLE cust_credit DROP credited;
+</pre>
+     Or, if your database does not support dropping columns, you can do this:
+<pre>
+ALTER TABLE cust_bill CHANGE owed depriciated decimal(10,2);
+ALTER TABLE cust_credit CHANGE credited depriciated2 decimal(10,2);
+</pre>
+

   <li>Copy or symlink htdocs to the new copy.
   <li>Remove the symlink or directory <i>(your_site_perl_directory)</i>/FS.
   <li>Change to the FS directory in the new tarball, and build and install the
   <li>Copy or symlink htdocs to the new copy.
   <li>Remove the symlink or directory <i>(your_site_perl_directory)</i>/FS.
   <li>Change to the FS directory in the new tarball, and build and install the

diff --git a/htdocs/edit/process/part_pkg.cgi b/htdocs/edit/process/part_pkg.cgi
index adf4672..5af9055 100755 (executable)
--- a/htdocs/edit/process/part_pkg.cgi
+++ b/htdocs/edit/process/part_pkg.cgi
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -Tw
 #
 #!/usr/bin/perl -Tw
 #

-# $Id: part_pkg.cgi,v 1.8 1999-02-07 09:59:27 ivan Exp $
+# $Id: part_pkg.cgi,v 1.9 2001-04-09 23:05:16 ivan Exp $

 #
 # process/part_pkg.cgi: Edit package definitions (process form)
 #
 #
 # process/part_pkg.cgi: Edit package definitions (process form)
 #


@@ -17,7 +17,10 @@
 # lose background, FS::CGI ivan@sisd.com 98-sep-2
 #
 # $Log: part_pkg.cgi,v $
 # lose background, FS::CGI ivan@sisd.com 98-sep-2
 #
 # $Log: part_pkg.cgi,v $

-# Revision 1.8  1999-02-07 09:59:27  ivan
+# Revision 1.9  2001-04-09 23:05:16  ivan
+# Transactions Part I!!!
+#
+# Revision 1.8  1999/02/07 09:59:27  ivan

 # more mod_perl fixes, and bugfixes Peter Wemm sent via email
 #
 # Revision 1.7  1999/01/19 05:13:55  ivan
 # more mod_perl fixes, and bugfixes Peter Wemm sent via email
 #
 # Revision 1.7  1999/01/19 05:13:55  ivan


@@ -41,7 +44,7 @@
 #
 
 use strict;
 #
 
 use strict;

-use vars qw( $cgi $pkgpart $old $new $part_svc $error );
+use vars qw( $cgi $pkgpart $old $new $part_svc $error $dbh );

 use CGI;
 use CGI::Carp qw(fatalsToBrowser);
 use FS::UID qw(cgisuidsetup);
 use CGI;
 use CGI::Carp qw(fatalsToBrowser);
 use FS::UID qw(cgisuidsetup);


@@ -52,7 +55,7 @@ use FS::pkg_svc;
 use FS::cust_pkg;
 
 $cgi = new CGI;
 use FS::cust_pkg;
 
 $cgi = new CGI;

-&cgisuidsetup($cgi);
+$dbh = &cgisuidsetup($cgi);

 
 $pkgpart = $cgi->param('pkgpart');
 
 
 $pkgpart = $cgi->param('pkgpart');
 


@@ -82,6 +85,8 @@ local $SIG{TERM} = 'IGNORE';
 local $SIG{TSTP} = 'IGNORE';
 local $SIG{PIPE} = 'IGNORE';
 
 local $SIG{TSTP} = 'IGNORE';
 local $SIG{PIPE} = 'IGNORE';
 

+local $FS::UID::AutoCommit = 0;
+

 if ( $pkgpart ) {
   $error = $new->replace($old);
 } else {
 if ( $pkgpart ) {
   $error = $new->replace($old);
 } else {


@@ -89,6 +94,7 @@ if ( $pkgpart ) {
   $pkgpart=$new->pkgpart;
 }
 if ( $error ) {
   $pkgpart=$new->pkgpart;
 }
 if ( $error ) {

+  $dbh->rollback;

   $cgi->param('error', $error );
   print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
   exit;
   $cgi->param('error', $error );
   print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
   exit;


@@ -109,14 +115,21 @@ foreach $part_svc (qsearch('part_svc',{})) {
   } );
   if ( $old_pkg_svc ) {
     my $myerror = $new_pkg_svc->replace($old_pkg_svc);
   } );
   if ( $old_pkg_svc ) {
     my $myerror = $new_pkg_svc->replace($old_pkg_svc);

-    die $myerror if $myerror;
+    if ( $myerror ) {
+      $dbh->rollback;
+      die $myerror;
+    }

   } else {
     my $myerror = $new_pkg_svc->insert;
   } else {
     my $myerror = $new_pkg_svc->insert;

-    die $myerror if $myerror;
+    if ( $myerror ) {
+      $dbh->rollback;
+      die $myerror;
+    }

   }
 }
 
 unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
   }
 }
 
 unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {

+  $dbh->commit or die $dbh->errstr;

   print $cgi->redirect(popurl(3). "browse/part_pkg.cgi");
 } else {
   my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } );
   print $cgi->redirect(popurl(3). "browse/part_pkg.cgi");
 } else {
   my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } );


@@ -124,8 +137,12 @@ unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
   $hash{'pkgpart'} = $pkgpart;
   my($new_cust_pkg) = new FS::cust_pkg \%hash;
   my $myerror = $new_cust_pkg->replace($old_cust_pkg);
   $hash{'pkgpart'} = $pkgpart;
   my($new_cust_pkg) = new FS::cust_pkg \%hash;
   my $myerror = $new_cust_pkg->replace($old_cust_pkg);

-  die "Error modifying cust_pkg record: $myerror\n" if $myerror;
+  if ( $myerror ) {
+    $dbh->rollback;
+    die "Error modifying cust_pkg record: $myerror\n";
+  }
+
+  $dbh->commit or die $dbh->errstr;

   print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum);
 }
 
   print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum);
 }
 

-

diff --git a/htdocs/misc/cancel-unaudited.cgi b/htdocs/misc/cancel-unaudited.cgi
index b7eb7fe..319ac55 100755 (executable)
--- a/htdocs/misc/cancel-unaudited.cgi
+++ b/htdocs/misc/cancel-unaudited.cgi
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -Tw
 #
 #!/usr/bin/perl -Tw
 #

-# $Id: cancel-unaudited.cgi,v 1.7 2000-06-15 12:30:37 ivan Exp $
+# $Id: cancel-unaudited.cgi,v 1.8 2001-04-09 23:05:16 ivan Exp $

 #
 # Usage: cancel-unaudited.cgi svcnum
 #        http://server.name/path/cancel-unaudited.cgi pkgnum
 #
 # Usage: cancel-unaudited.cgi svcnum
 #        http://server.name/path/cancel-unaudited.cgi pkgnum


@@ -16,7 +16,10 @@
 #       bmccane@maxbaud.net     98-apr-3
 #
 # $Log: cancel-unaudited.cgi,v $
 #       bmccane@maxbaud.net     98-apr-3
 #
 # $Log: cancel-unaudited.cgi,v $

-# Revision 1.7  2000-06-15 12:30:37  ivan
+# Revision 1.8  2001-04-09 23:05:16  ivan
+# Transactions Part I!!!
+#
+# Revision 1.7  2000/06/15 12:30:37  ivan

 # bugfix from Jeff Finucane, thanks!
 #
 # Revision 1.6  1999/02/28 00:03:48  ivan
 # bugfix from Jeff Finucane, thanks!
 #
 # Revision 1.6  1999/02/28 00:03:48  ivan


@@ -37,7 +40,7 @@
 #
 
 use strict;
 #
 
 use strict;

-use vars qw( $cgi $query $svcnum $svc_acct $cust_svc $error );
+use vars qw( $cgi $query $svcnum $svc_acct $cust_svc $error $dbh );

 use CGI;
 use CGI::Carp qw(fatalsToBrowser);
 use FS::UID qw(cgisuidsetup);
 use CGI;
 use CGI::Carp qw(fatalsToBrowser);
 use FS::UID qw(cgisuidsetup);


@@ -47,7 +50,7 @@ use FS::cust_svc;
 use FS::svc_acct;
 
 $cgi = new CGI;
 use FS::svc_acct;
 
 $cgi = new CGI;

-&cgisuidsetup($cgi);
+$dbh = &cgisuidsetup($cgi);

  
 #untaint svcnum
 ($query) = $cgi->keywords;
  
 #untaint svcnum
 ($query) = $cgi->keywords;


@@ -69,13 +72,22 @@ local $SIG{QUIT} = 'IGNORE';
 local $SIG{TERM} = 'IGNORE';
 local $SIG{TSTP} = 'IGNORE';
 
 local $SIG{TERM} = 'IGNORE';
 local $SIG{TSTP} = 'IGNORE';
 

+local $FS::UID::AutoCommit = 0;
+

 $error = $svc_acct->cancel;
 $error = $svc_acct->cancel;

-&eidiot($error) if $error;
+&myeidiot($error) if $error;

 $error = $svc_acct->delete;
 $error = $svc_acct->delete;

-&eidiot($error) if $error;
+&myeidiot($error) if $error;

 
 $error = $cust_svc->delete;
 
 $error = $cust_svc->delete;

-&eidiot($error) if $error;
+&myeidiot($error) if $error;
+
+$dbh->commit or die $dbh->errstr;

 
 print $cgi->redirect(popurl(2));
 
 
 print $cgi->redirect(popurl(2));
 

+sub myeidiot {
+  $dbh->rollback;
+  &eidiot(@_);
+}
+