From: octo <octo>
Date: Tue, 12 Apr 2005 16:39:21 +0000 (+0000)
Subject: Work on Dbm stuff coninues.. Not done yet though..
X-Git-Tag: Release-0.8.0~20^2~12
X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=86bceb63ca7578aeae572168240dd6610cbf7fd4;p=onis.git

Work on Dbm stuff coninues.. Not done yet though..
---

diff --git a/lib/Onis/Data/Persistent/Dbm.pm b/lib/Onis/Data/Persistent/Dbm.pm
index ba3cb76..bc24550 100644
--- a/lib/Onis/Data/Persistent/Dbm.pm
+++ b/lib/Onis/Data/Persistent/Dbm.pm
@@ -3,7 +3,13 @@ package Onis::Data::Persistent::Dbm;
 use strict;
 use warnings;
 
+BEGIN
+{
+	@AnyDBM_File::ISA = (qw(GDBM_File DB_File GDBM_File SDBM_File NDBM_File ODBM_File));
+}
+
 use Carp qw(carp confess);
+use Fcntl (qw(O_RDWR O_CREAT));
 use AnyDBM_File;
 
 use Onis::Config (qw(get_config));
@@ -20,15 +26,15 @@ Storage backend that uses DBM files for storing data permanently.
 
 =over 4
 
-=item B<gdbm_directory>: I<E<lt>dirE<gt>>
+=item B<dbm_directory>: I<E<lt>dirE<gt>>
 
-Directory in which the GDBM-files are kept.
+Directory in which the DBM-files are kept.
 
 =back
 
 =cut
 
-our $DBMDirectory = get_config ('gdbm_directory') || 'var';
+our $DBMDirectory = get_config ('dbm_directory') || 'var';
 $DBMDirectory =~ s#/$##g;
 
 if (!$DBMDirectory or !-d $DBMDirectory)
@@ -65,7 +71,7 @@ sub new
 	my $id = $caller . ':' . $name;
 	$id =~ s#/##g;
 
-	$filename = "$GDBMDirectory/$id.gdbm";
+	$filename = "$DBMDirectory/$id.dbm";
 	
 	if (exists ($Objects{$id}))
 	{
@@ -73,9 +79,10 @@ sub new
 		return (undef);
 	}
 
-	$Objects{$id} = $obj;
+	no strict (qw(subs));
+	tie (%hash, 'AnyDBM_File', $filename, O_RDWR | O_CREAT, 0666) or die ("tie: $!");
 
-	$obj->{'data'} = tie (%hash, 'AnyDBM_File', $filename, O_CREAT|O_RDWR, 0664);
+	$obj->{'data'} = tied %hash;
 	$obj->{'key'} = $key;
 	$obj->{'fields'} = [@fields];
 	$obj->{'num_fields'} = scalar (@fields);
@@ -91,7 +98,8 @@ sub new
 		print STDOUT $/, $dbg;
 	}
 	
-	return (bless ($obj, $pkg));
+	$Objects{$id} = bless ($obj, $pkg);
+	return ($Objects{$id});
 }
 
 sub put
@@ -126,7 +134,8 @@ sub get
 
 	if (!exists ($obj->{'cache'}{$key}))
 	{
-		if ($db->get ($key, $val))
+		$val = $db->FETCH ($key);
+		if (!defined ($val))
 		{
 			$obj->{'cache'}{$key} = undef;
 		}
@@ -162,6 +171,7 @@ sub keys
 	my $key;
 	my $val;
 
+	no strict (qw(subs));
 	for ($db->seq ($key, $val, R_FIRST); $db->seq ($key, $val, R_NEXT) == 0;)
 	{
 		next if (defined ($obj->{'cache'}{$key}));
@@ -186,13 +196,13 @@ sub keys
 	}
 
 	return (sort
-	sub {
+	{
 		for (@field_indizes)
 		{
 			my $d = $obj->{'cache'}{$a}[$_] cmp $obj->{'cache'}{$b}[$_];
 			return ($d) if ($d);
 		}
-	}, @keys);
+	} (keys %{$obj->{'cache'}}));
 }
 
 sub del
@@ -222,9 +232,11 @@ sub sync
 	my $obj = shift;
 	my $db = $obj->{'data'};
 
-	for (keys %{$obj->{'cache'}})
+	for (CORE::keys %{$obj->{'cache'}})
 	{
 		my $key = $_;
+		next unless (defined ($obj->{'cache'}{$key}));
+
 		my $val = join ($Alarm, @{$obj->{'cache'}{$key}});
 
 		$db->put ($key, $val);
@@ -236,9 +248,10 @@ sub sync
 
 END
 {
-	for (keys (%Objects))
+	for (CORE::keys (%Objects))
 	{
-		my $obj = $_;
+		my $key = $_;
+		my $obj = $Objects{$key};
 		$obj->sync ();
 	}
 }
diff --git a/onis b/onis
index c34fc74..94bcc73 100755
--- a/onis
+++ b/onis
@@ -27,7 +27,7 @@ BEGIN
 	# 0x0400   Data::Core (dump incoming data to stderr)
 	# 0x0800   Data::Core (initializing)
 	# 0x1000   Onis::Users
-	$::DEBUG = 0x0000;
+	$::DEBUG = 0x0200;
 }
 
 use strict;