From: ivan Date: Sun, 15 Apr 2001 13:35:12 +0000 (+0000) Subject: transactions part deux X-Git-Tag: freeside_1_3_0~15 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=fb13e429f8499f6eadad09c1452489ca0f4f7031 transactions part deux --- diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm index 13d0fb830..cb0c1b901 100644 --- a/FS/FS/nas.pm +++ b/FS/FS/nas.pm @@ -3,7 +3,7 @@ package FS::nas; use strict; use vars qw( @ISA ); use FS::Record qw(qsearchs); #qsearch); -use FS::UID qw( dbh ); #to lock the tables for heartbeat; ugh, MySQL-specific +use FS::UID qw( dbh ); @ISA = qw(FS::Record); @@ -126,31 +126,20 @@ Updates the timestamp for this nas sub heartbeat { my($self, $timestamp) = @_; my $dbh = dbh; - my $sth = $dbh->prepare("LOCK TABLES nas WRITE"); - $sth->execute or die $sth->errstr; #die? - my $lock_self = qsearchs('nas', { 'nasnum' => $self->nasnum } ) - or die "can't find own record for $self nasnum ". $self->nasnum; - if ( $timestamp > $lock_self->last ) { - my $new_self = new FS::nas ( { $lock_self->hash } ); - $new_self->last($timestamp); - #is there a reason to? #$self->last($timestamp); - $new_self->replace($lock_self); - }; - $sth = $dbh->prepare("UNLOCK TABLES"); - $sth->execute or die $sth->errstr; #die? + my $sth = + $dbh->prepare("UPDATE nas SET last = ? WHERE nasnum = ? AND last < ?"); + $sth->execute($timestamp, $self->nasnum, $timestamp) or die $sth->errstr; + $self->last($timestamp); } =back =head1 VERSION -$Id: nas.pm,v 1.4 2001-02-21 01:45:37 ivan Exp $ +$Id: nas.pm,v 1.5 2001-04-15 13:35:12 ivan Exp $ =head1 BUGS -The B method is MySQL-specific. Yuck. It's also not quite -perfectly subclassable, which is much less yuck. - =head1 SEE ALSO L, schema.html from the base documentation. diff --git a/FS/FS/session.pm b/FS/FS/session.pm index 55bb678a7..de0f2a76a 100644 --- a/FS/FS/session.pm +++ b/FS/FS/session.pm @@ -118,7 +118,6 @@ sub insert { return $error; } - #transactional accuracy not essential; just an indication of data freshness $self->nas_heartbeat($self->getfield('login')); #session-starting callback @@ -179,7 +178,6 @@ sub replace { return $error; } - #transactional accuracy not essential; just an indication of data freshness $self->nas_heartbeat($self->getfield('logout')); #session-ending callback @@ -249,7 +247,7 @@ sub svc_acct { =head1 VERSION -$Id: session.pm,v 1.6 2001-04-09 23:05:15 ivan Exp $ +$Id: session.pm,v 1.7 2001-04-15 13:35:12 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 8bcdf4f56..ac7cab72f 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -48,6 +48,10 @@ sub insert { 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; @@ -60,16 +64,21 @@ sub insert { 'svcpart' => $self->svcpart, } ); $error = $cust_svc->insert; - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } $svcnum = $self->svcnum($cust_svc->svcnum); } $error = $self->SUPER::insert; if ( $error ) { - $cust_svc->delete if $cust_svc; + $dbh->rollback if $oldAutoCommit; return $error; } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } @@ -184,7 +193,7 @@ sub cancel { ''; } =head1 VERSION -$Id: svc_Common.pm,v 1.2 2001-04-09 23:05:15 ivan Exp $ +$Id: svc_Common.pm,v 1.3 2001-04-15 13:35:12 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 5cfe69081..3d011af2c 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -152,6 +152,10 @@ sub insert { 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; @@ -159,13 +163,20 @@ sub insert { if qsearchs( 'svc_domain', { 'domain' => $self->domain } ); my $whois = $self->whois; - return "Domain in use (see whois)" - if ( $self->action eq "N" && ! $whois_hack && $whois ); - return "Domain not found (see whois)" - if ( $self->action eq "M" && ! $whois ); + if ( $self->action eq "N" && ! $whois_hack && $whois ) { + $dbh->rollback if $oldAutoCommit; + return "Domain in use (see whois)"; + } + if ( $self->action eq "M" && ! $whois ) { + $dbh->rollback if $oldAutoCommit; + return "Domain not found (see whois)"; + } $error = $self->SUPER::insert; - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } $self->submit_internic unless $whois_hack; @@ -179,7 +190,10 @@ sub insert { "$soarefresh $soaretry $soaexpire $soadefaultttl )" }; $error = $soa->insert; - warn "WARNING: couldn't insert SOA record for new domain: $error" if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "couldn't insert SOA record for new domain: $error"; + } foreach my $nsmachine ( @nsmachines ) { my $ns = new FS::domain_record { @@ -190,8 +204,10 @@ sub insert { 'recdata' => $nsmachine, }; my $error = $ns->insert; - warn "WARNING: couldn't insert NS record for new domain: $error" - if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "couldn't insert NS record for new domain: $error"; + } } foreach my $mxmachine ( @mxmachines ) { @@ -203,12 +219,15 @@ sub insert { 'recdata' => $mxmachine, }; my $error = $mx->insert; - warn "WARNING: couldn't insert MX record for new domain: $error" - if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "couldn't insert MX record for new domain: $error"; + } } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -459,7 +478,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.7 2000-06-29 11:12:20 ivan Exp $ +$Id: svc_domain.pm,v 1.8 2001-04-15 13:35:12 ivan Exp $ =head1 BUGS