=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">).
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
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
#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);
}
|| $self->ut_number('custnum')
|| $self->ut_numbern('_date')
|| $self->ut_money('charged')
- || $self->ut_money('owed')
|| $self->ut_numbern('printed')
;
return $error if $error;
;
}
+=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.
=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
use FS::UID qw( getotaker );
use FS::Record qw( qsearchs );
use FS::cust_main;
+use FS::cust_refund;
@ISA = qw( FS::Record );
=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.
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 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
|| $self->ut_number('custnum')
|| $self->ut_numbern('_date')
|| $self->ut_money('amount')
- || $self->ut_money('credited')
|| $self->ut_textn('reason');
;
return $error if $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
-$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
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
+ my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
$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;
}
$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}} ) {
}
$error = $svc_something->insert;
if ( $error ) {
- $dbh->rollback;
+ $dbh->rollback if $oldAutoCommit;
return $error;
}
}
}
if ( $seconds ) {
- $dbh->rollback;
+ $dbh->rollback if $oldAutoCommit;
return "No svc_acct record to apply pre-paid time";
}
};
$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;
'';
}
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{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
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.
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'
'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;
$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
}
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';
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, } )
) {
'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/ ) {
} 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
'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";
}
'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;
'';
}
=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
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;
}
=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
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;
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";
+ }
}
$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
}
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;
+ }
}
}
$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
}
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;
+ }
}
}
$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
}
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
#
# @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{$_} } : ();
#check for leftover services
foreach (keys %svcnum) {
next unless @{ $svcnum{$_} };
+ $dbh->rollback if $oldAutoCommit;
return "Leftover services, svcpart $_: svcnum ".
join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
}
# 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
'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);
$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
}
=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
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;
}
=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
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;
$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
#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;
'';
}
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
my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
system( eval qq("$stop") ) if $stop;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
'';
}
=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
my $cust_svc;
unless ( $svcnum ) {
$cust_svc = new FS::cust_svc ( {
- 'svcnum' => $svcnum,
+ #hua?# 'svcnum' => $svcnum,
'pkgnum' => $self->pkgnum,
'svcpart' => $self->svcpart,
} );
=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
-$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
---
+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)
#!/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
#
# 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
'custnum', 'int', '', '',
'_date', @date_type,
'charged', @money_type,
- 'owed', @money_type,
'printed', 'int', '', '',
],
'primary_key' => 'invnum',
'custnum', 'int', '', '',
'_date', @date_type,
'amount', @money_type,
- 'credited', @money_type,
'otaker', 'varchar', '', 8,
'reason', 'varchar', '', 255,
],
<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 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>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>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
<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.
<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:
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
#!/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)
#
# 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
#
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 FS::cust_pkg;
$cgi = new CGI;
-&cgisuidsetup($cgi);
+$dbh = &cgisuidsetup($cgi);
$pkgpart = $cgi->param('pkgpart');
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
+local $FS::UID::AutoCommit = 0;
+
if ( $pkgpart ) {
$error = $new->replace($old);
} else {
$pkgpart=$new->pkgpart;
}
if ( $error ) {
+ $dbh->rollback;
$cgi->param('error', $error );
print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
exit;
} );
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 } );
$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);
}
-
#!/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
# 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
#
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 FS::svc_acct;
$cgi = new CGI;
-&cgisuidsetup($cgi);
+$dbh = &cgisuidsetup($cgi);
#untaint svcnum
($query) = $cgi->keywords;
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(@_);
+}
+
projects / freeside.git / commitdiff