diff options
author | ivan <ivan> | 2001-04-09 23:05:16 +0000 |
---|---|---|
committer | ivan <ivan> | 2001-04-09 23:05:16 +0000 |
commit | 15f65a0c56cbce6951d9cb4f71119725a2009f79 (patch) | |
tree | a167652e2d03e0da125dffb880f1542fb98e4e60 | |
parent | 0281069f3cd7f8caab7768cd818b088991b62117 (diff) |
Transactions Part I!!!
-rw-r--r-- | FS/FS/cust_bill.pm | 41 | ||||
-rw-r--r-- | FS/FS/cust_credit.pm | 72 | ||||
-rw-r--r-- | FS/FS/cust_main.pm | 140 | ||||
-rw-r--r-- | FS/FS/cust_pay.pm | 19 | ||||
-rw-r--r-- | FS/FS/cust_pkg.pm | 113 | ||||
-rw-r--r-- | FS/FS/cust_refund.pm | 19 | ||||
-rw-r--r-- | FS/FS/session.pm | 39 | ||||
-rw-r--r-- | FS/FS/svc_Common.pm | 4 | ||||
-rw-r--r-- | TODO | 5 | ||||
-rwxr-xr-x | bin/fs-setup | 9 | ||||
-rw-r--r-- | htdocs/docs/index.html | 2 | ||||
-rw-r--r-- | htdocs/docs/install.html | 2 | ||||
-rw-r--r-- | htdocs/docs/schema.html | 2 | ||||
-rw-r--r-- | htdocs/docs/upgrade6.html | 16 | ||||
-rwxr-xr-x | htdocs/edit/process/part_pkg.cgi | 33 | ||||
-rwxr-xr-x | htdocs/misc/cancel-unaudited.cgi | 26 |
16 files changed, 347 insertions, 195 deletions
diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index d52c9c110..8480ceadc 100644 --- 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 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">). @@ -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. -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 @@ -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. -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 @@ -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 "(New) owed can't be > (new) charged!" if $new->owed > $new->charged; $new->SUPER::replace($old); } @@ -176,7 +156,6 @@ sub check { || $self->ut_number('custnum') || $self->ut_numbern('_date') || $self->ut_money('charged') - || $self->ut_money('owed') || $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. @@ -431,7 +424,7 @@ sub print_text { =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 diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index e86853799..5888d07ef 100644 --- 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::cust_refund; @ISA = qw( FS::Record ); @@ -41,9 +42,6 @@ FS::Record. The following fields are currently supported: =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. @@ -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. -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. @@ -102,25 +80,13 @@ sub delete { =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 { - 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 @@ -139,7 +105,6 @@ sub check { || $self->ut_number('custnum') || $self->ut_numbern('_date') || $self->ut_money('amount') - || $self->ut_money('credited') || $self->ut_textn('reason'); ; return $error if $error; @@ -154,11 +119,38 @@ sub check { ''; #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 -$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 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7b75bea1e..4a254e06c 100644 --- 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'; + my $oldAutoCommit = $FS::UID::AutoCommit; 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 ) { - $dbh->rollback; + $dbh->rollback if $oldAutoCommit; return $error; } } my $error = $self->SUPER::insert; if ( $error ) { - $dbh->rollback; + $dbh->rollback if $oldAutoCommit; return $error; } @@ -244,7 +245,7 @@ sub insert { $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}} ) { @@ -255,7 +256,7 @@ sub insert { } $error = $svc_something->insert; if ( $error ) { - $dbh->rollback; + $dbh->rollback if $oldAutoCommit; return $error; } } @@ -263,7 +264,7 @@ sub insert { } if ( $seconds ) { - $dbh->rollback; + $dbh->rollback if $oldAutoCommit; return "No svc_acct record to apply pre-paid time"; } @@ -274,12 +275,12 @@ sub insert { }; $error = $cust_credit->insert; if ( $error ) { - $dbh->rollback; + $dbh->rollback if $oldAutoCommit; 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; - 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'; @@ -318,27 +312,56 @@ sub delete { 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; - 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); - 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; - 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 @@ -549,6 +572,10 @@ sub bill { 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. @@ -648,7 +675,10 @@ sub bill { 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' @@ -679,11 +709,10 @@ sub bill { '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; @@ -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? - 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 } @@ -728,10 +759,6 @@ sub collect { 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'; @@ -740,6 +767,17 @@ sub collect { 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, } ) ) { @@ -813,14 +851,20 @@ sub collect { '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' ) { - 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/ ) { @@ -861,7 +905,8 @@ sub collect { } 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 @@ -876,17 +921,27 @@ sub collect { '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'} ) { + $dbh->commit if $oldAutoCommit; return 'Cybercash error, invnum #' . $cust_bill->invnum. ':'. $result{'MErrMsg'}; } else { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; } } else { + $dbh->rollback if $oldAutoCommit; return "Unknown real-time processor $processor\n"; } @@ -910,15 +965,20 @@ sub collect { '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 { + $dbh->rollback if $oldAutoCommit; return "Unknown payment type ". $self->payby; } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -1054,7 +1114,7 @@ sub check_invoicing_list { =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 diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 728981a9b..f0d945060 100644 --- 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; - 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; - 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; } @@ -173,7 +158,7 @@ sub check { =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 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 08be4e4e0..9705827e7 100644 --- 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 FS::UID qw( getotaker ); +use FS::UID qw( getotaker dbh ); 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'; + 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 } ); - $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; - return "Error cancelling service: $error" if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error cancelling service: $error" + } $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; - 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); - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no errors } @@ -272,20 +292,29 @@ sub suspend { 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 } ); - $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; - 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); - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no errors } @@ -321,20 +355,29 @@ sub unsuspend { 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 } ); - $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; - 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); - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no errors } @@ -398,6 +446,10 @@ L<FS::pkg_svc>). 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 # @@ -425,8 +477,10 @@ sub order { # @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{$_} } : (); @@ -437,6 +491,7 @@ sub order { #check for leftover services foreach (keys %svcnum) { next unless @{ $svcnum{$_} }; + $dbh->rollback if $oldAutoCommit; 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}); - 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); - 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 @@ -471,7 +532,10 @@ sub order { '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); @@ -480,10 +544,15 @@ sub order { $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 } @@ -491,7 +560,7 @@ sub order { =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 diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 742c9bb8d..729dc02b0 100644 --- 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; - 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; - 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; } @@ -172,7 +157,7 @@ sub check { =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 diff --git a/FS/FS/session.pm b/FS/FS/session.pm index 30d21d931..55bb678a7 100644 --- 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 FS::UID qw( dbh ); 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; - 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; - 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 @@ -117,7 +128,8 @@ sub insert { #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'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + $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); - 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 @@ -167,6 +190,8 @@ sub replace { 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 -$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 diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 5bea5b0ce..8bcdf4f56 100644 --- 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 ( { - 'svcnum' => $svcnum, + #hua?# 'svcnum' => $svcnum, 'pkgnum' => $self->pkgnum, 'svcpart' => $self->svcpart, } ); @@ -184,7 +184,7 @@ sub cancel { ''; } =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 @@ -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 @@ -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) diff --git a/bin/fs-setup b/bin/fs-setup index 1df46d342..2a37fb8d7 100755 --- a/bin/fs-setup +++ b/bin/fs-setup @@ -1,6 +1,6 @@ #!/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 # @@ -32,7 +32,10 @@ # 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 @@ -392,7 +395,6 @@ sub tables_hash_hack { 'custnum', 'int', '', '', '_date', @date_type, 'charged', @money_type, - 'owed', @money_type, 'printed', 'int', '', '', ], 'primary_key' => 'invnum', @@ -420,7 +422,6 @@ sub tables_hash_hack { 'custnum', 'int', '', '', '_date', @date_type, 'amount', @money_type, - 'credited', @money_type, 'otaker', 'varchar', '', 8, 'reason', 'varchar', '', 255, ], diff --git a/htdocs/docs/index.html b/htdocs/docs/index.html index 82410902a..ab2f84c1b 100644 --- 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="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> <!-- diff --git a/htdocs/docs/install.html b/htdocs/docs/install.html index 09c681172..61eec08d8 100644 --- 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 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> diff --git a/htdocs/docs/schema.html b/htdocs/docs/schema.html index 45c98ab38..95929ead8 100644 --- 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>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 @@ -40,7 +39,6 @@ <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 diff --git a/htdocs/docs/upgrade6.html b/htdocs/docs/upgrade6.html index 8e70b5586..807146f89 100644 --- a/htdocs/docs/upgrade6.html +++ b/htdocs/docs/upgrade6.html @@ -1,8 +1,8 @@ <head> - <title>Upgrading to 1.2.4</title> + <title>Upgrading to 1.3.0</title> </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. @@ -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>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: @@ -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> + <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 diff --git a/htdocs/edit/process/part_pkg.cgi b/htdocs/edit/process/part_pkg.cgi index adf4672bd..5af9055d6 100755 --- a/htdocs/edit/process/part_pkg.cgi +++ b/htdocs/edit/process/part_pkg.cgi @@ -1,6 +1,6 @@ #!/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) # @@ -17,7 +17,10 @@ # 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 @@ -41,7 +44,7 @@ # 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); @@ -52,7 +55,7 @@ use FS::pkg_svc; use FS::cust_pkg; $cgi = new CGI; -&cgisuidsetup($cgi); +$dbh = &cgisuidsetup($cgi); $pkgpart = $cgi->param('pkgpart'); @@ -82,6 +85,8 @@ local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; +local $FS::UID::AutoCommit = 0; + if ( $pkgpart ) { $error = $new->replace($old); } else { @@ -89,6 +94,7 @@ if ( $pkgpart ) { $pkgpart=$new->pkgpart; } if ( $error ) { + $dbh->rollback; $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); - die $myerror if $myerror; + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } } 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+)$/ ) { + $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 } ); @@ -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); - 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); } - diff --git a/htdocs/misc/cancel-unaudited.cgi b/htdocs/misc/cancel-unaudited.cgi index b7eb7fede..319ac5526 100755 --- a/htdocs/misc/cancel-unaudited.cgi +++ b/htdocs/misc/cancel-unaudited.cgi @@ -1,6 +1,6 @@ #!/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 @@ -16,7 +16,10 @@ # 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 @@ -37,7 +40,7 @@ # 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); @@ -47,7 +50,7 @@ use FS::cust_svc; use FS::svc_acct; $cgi = new CGI; -&cgisuidsetup($cgi); +$dbh = &cgisuidsetup($cgi); #untaint svcnum ($query) = $cgi->keywords; @@ -69,13 +72,22 @@ local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; +local $FS::UID::AutoCommit = 0; + $error = $svc_acct->cancel; -&eidiot($error) if $error; +&myeidiot($error) if $error; $error = $svc_acct->delete; -&eidiot($error) if $error; +&myeidiot($error) if $error; $error = $cust_svc->delete; -&eidiot($error) if $error; +&myeidiot($error) if $error; + +$dbh->commit or die $dbh->errstr; print $cgi->redirect(popurl(2)); +sub myeidiot { + $dbh->rollback; + &eidiot(@_); +} + |