[interchange-cvs] interchange - heins modified 2 files

interchange-cvs at icdevgroup.org interchange-cvs at icdevgroup.org
Sun Oct 19 14:01:47 EDT 2003


User:      heins
Date:      2003-10-19 17:01:47 GMT
Modified:  lib/Vend/Table Common.pm GDBM.pm
Log:
* Add internal Interchange locking routines and support for GDBM. (Should
  work on others as well but is not tested.)

  To set internal locking, just put in the config:

  	Database access IC_LOCKING 1

  On GDBM, employs the GDBM_NOLOCK parameter.

  It should prevent the errors in access.gdbm when multiple admins are
  logged in. It might also serve to make userdb in GDBM somewhat usable.

Revision  Changes    Path
2.33      +43 -2     interchange/lib/Vend/Table/Common.pm


rev 2.33, prev_rev 2.32
Index: Common.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/Common.pm,v
retrieving revision 2.32
retrieving revision 2.33
diff -u -r2.32 -r2.33
--- Common.pm	4 Aug 2003 05:11:20 -0000	2.32
+++ Common.pm	19 Oct 2003 17:01:47 -0000	2.33
@@ -1,6 +1,6 @@
 # Vend::Table::Common - Common access methods for Interchange databases
 #
-# $Id: Common.pm,v 2.32 2003/08/04 05:11:20 mheins Exp $
+# $Id: Common.pm,v 2.33 2003/10/19 17:01:47 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -23,13 +23,14 @@
 # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
 # MA  02111-1307  USA.
 
-$VERSION = substr(q$Revision: 2.32 $, 10);
+$VERSION = substr(q$Revision: 2.33 $, 10);
 use strict;
 
 package Vend::Table::Common;
 require Vend::DbSearch;
 require Vend::TextSearch;
 require Vend::CounterFile;
+use Symbol;
 use Vend::Util;
 
 use Exporter;
@@ -126,6 +127,37 @@
 	return;
 }
 
+sub clear_lock {
+	my $s = shift;
+	return unless $s->[$CONFIG]{IC_LOCKING};
+	if($s->[$CONFIG]{_lock_handle}) {
+		close $s->[$CONFIG]{_lock_handle};
+		delete $s->[$CONFIG]{_lock_handle};
+	}
+}
+
+sub lock_table {
+	my $s = shift;
+	return unless $s->[$CONFIG]{IC_LOCKING};
+	my $lockhandle;
+	if(not $lockhandle = $s->[$CONFIG]{_lock_handle}) {
+		my $lf = $s->[$CONFIG]{file} . '.lock';
+		$lockhandle = gensym;
+		$s->[$CONFIG]{_lock_file} = $lf;
+		$s->[$CONFIG]{_lock_handle} = $lockhandle;
+		open $lockhandle, ">> $lf"
+			or die errmsg("Cannot lock table %s: %s", $s->[$CONFIG]{name}, $!);
+	}
+#::logDebug("lock handle=$lockhandle");
+	Vend::Util::lockfile($lockhandle);
+}
+
+sub unlock_table {
+	my $s = shift;
+	return unless $s->[$CONFIG]{IC_LOCKING};
+	Vend::Util::unlockfile($s->[$CONFIG]{_lock_handle});
+}
+
 sub stuff {
     my ($val) = @_;
     $val =~ s,([\t\%]),$Hex_string[ord($1)],eg;
@@ -203,6 +235,7 @@
 	return 1 if ! defined $s->[$TIE_HASH];
 #::logDebug("closing table $s->[$FILENAME]");
 	undef $s->[$DBM];
+	$s->clear_lock();
     untie %{$s->[$TIE_HASH]}
 		or $s->log_error("%s %s: %s", errmsg("untie"), $s->[$FILENAME], $!);
 	undef $s->[$TIE_HASH];
@@ -276,7 +309,9 @@
 
 sub unstuff_row {
     my ($s, $key) = @_;
+	$s->lock_table() if $s->[$CONFIG]{IC_LOCKING};
     my $line = $s->[$TIE_HASH]{"k$key"};
+	$s->unlock_table() if $s->[$CONFIG]{IC_LOCKING};
     die $s->log_error(
 					"There is no row with index '%s' in database %s",
 					$key,
@@ -291,7 +326,9 @@
 
 sub thaw_row {
     my ($s, $key) = @_;
+	$s->lock_table() if $s->[$CONFIG]{IC_LOCKING};
     my $line = $s->[$TIE_HASH]{"k$key"};
+	$s->unlock_table() if $s->[$CONFIG]{IC_LOCKING};
     die $s->log_error( "There is no row with index '%s'", $key,)
 		unless defined $line;
     return (@{ Storable::thaw($line) })
@@ -444,7 +481,9 @@
 		if ! length($key);
 	$s->filter(\@fields, $s->[$COLUMN_INDEX], $s->[$CONFIG]{FILTER_TO})
 		if $s->[$CONFIG]{FILTER_TO};
+	$s->lock_table();
     $s->[$TIE_HASH]{"k$key"} = join("\t", map(stuff($_), @fields));
+	$s->unlock_table();
 	return $key;
 }
 
@@ -456,7 +495,9 @@
 		if ! length($key);
 	$s->filter(\@fields, $s->[$COLUMN_INDEX], $s->[$CONFIG]{FILTER_TO})
 		if $s->[$CONFIG]{FILTER_TO};
+	$s->lock_table();
 	$s->[$TIE_HASH]{"k$key"} = Storable::freeze(\@fields);
+	$s->unlock_table();
 	return $key;
 }
 



2.11      +3 -2      interchange/lib/Vend/Table/GDBM.pm


rev 2.11, prev_rev 2.10
Index: GDBM.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/GDBM.pm,v
retrieving revision 2.10
retrieving revision 2.11
diff -u -r2.10 -r2.11
--- GDBM.pm	4 Aug 2003 05:11:20 -0000	2.10
+++ GDBM.pm	19 Oct 2003 17:01:47 -0000	2.11
@@ -1,6 +1,6 @@
 # Vend::Table::GDBM - Access an Interchange table stored in a GDBM file
 #
-# $Id: GDBM.pm,v 2.10 2003/08/04 05:11:20 mheins Exp $
+# $Id: GDBM.pm,v 2.11 2003/10/19 17:01:47 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -30,7 +30,7 @@
 use Vend::Table::Common;
 
 @ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.10 $, 10);
+$VERSION = substr(q$Revision: 2.11 $, 10);
 
 sub new {
 	my ($class, $obj) = @_;
@@ -83,6 +83,7 @@
 		undef $config->{Transactions};
 		$config->{_Auto_number} = 1 if $config->{AUTO_NUMBER};
 		$flags = GDBM_WRITER;
+		$flags |= GDBM_NOLOCK if $config->{IC_LOCKING};
 		if(! defined $config->{AutoNumberCounter}) {
 			eval {
 				my $dot = $config->{HIDE_AUTO_FILES} ? '.' : '';








More information about the interchange-cvs mailing list