[interchange-cvs] interchange - heins modified lib/Vend/Table/SDBM.pm

interchange-core@icdevgroup.org interchange-core@icdevgroup.org
Mon Jan 13 18:07:00 2003


User:      heins
Date:      2003-01-13 23:06:28 GMT
Modified:  lib/Vend/Table SDBM.pm
Log:
* Incorporate settable retry level into SDBM as well.

Revision  Changes    Path
2.5       +17 -5     interchange/lib/Vend/Table/SDBM.pm


rev 2.5, prev_rev 2.4
Index: SDBM.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/SDBM.pm,v
retrieving revision 2.4
retrieving revision 2.5
diff -u -r2.4 -r2.5
--- SDBM.pm	10 Sep 2002 17:29:09 -0000	2.4
+++ SDBM.pm	13 Jan 2003 23:06:28 -0000	2.5
@@ -1,6 +1,6 @@
 # Vend::Table::SDBM - Access an Interchange table stored in Perl's internal SDBM
 #
-# $Id: SDBM.pm,v 2.4 2002/09/10 17:29:09 mheins Exp $
+# $Id: SDBM.pm,v 2.5 2003/01/13 23:06:28 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -23,7 +23,7 @@
 # MA  02111-1307  USA.
 
 package Vend::Table::SDBM;
-$VERSION = substr(q$Revision: 2.4 $, 10);
+$VERSION = substr(q$Revision: 2.5 $, 10);
 use strict;
 use Fcntl;
 use SDBM_File;
@@ -31,7 +31,7 @@
 use Vend::Table::Common;
 
 @ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.4 $, 10);
+$VERSION = substr(q$Revision: 2.5 $, 10);
 
 sub create {
 	my ($class, $config, $columns, $filename) = @_;
@@ -55,8 +55,20 @@
 	my $tie = {};
 	my $flags = O_RDWR | O_CREAT;
 
-	my $dbm = tie(%$tie, 'SDBM_File', $filename, $flags, $File_permission_mode)
-		or die "Could not create '$filename': $!";
+	my $dbm;
+	my $failed = 0;
+
+	my $retry = $Vend::Cfg->{Limit}{dbm_open_retries} || 10;
+
+	while( $failed < $retry ) {
+		$dbm = tie(%$tie, 'SDBM_File', $filename, $flags, $File_permission_mode)
+			and undef($failed), last;
+		$failed++;
+		select(undef,undef,undef,$failed * .100);
+	}
+
+	die ::errmsg("%s could not tie to '%s': %s", 'SDBM', $filename, $!)
+		unless $dbm;
 
 #::logDebug("created dbm, hash=" . ::uneval($dbm));
 	$tie->{'c'} = join("\t", @$columns);