From: octo <octo>
Date: Tue, 12 Apr 2005 15:33:14 +0000 (+0000)
Subject: Checking in before renaming to Dbm.pm
X-Git-Tag: Release-0.8.0~20^2~14
X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=a36e47c3fa4339b6ac8f66bebeb97f8b8a1c4c59;p=onis.git

Checking in before renaming to Dbm.pm
---

diff --git a/lib/Onis/Data/Persistent/Gdbm.pm b/lib/Onis/Data/Persistent/Gdbm.pm
index 99d574f..ba3cb76 100644
--- a/lib/Onis/Data/Persistent/Gdbm.pm
+++ b/lib/Onis/Data/Persistent/Gdbm.pm
@@ -1,20 +1,20 @@
-package Onis::Data::Persistent::Gdbm;
+package Onis::Data::Persistent::Dbm;
 
 use strict;
 use warnings;
 
 use Carp qw(carp confess);
-use GDBM_File;
+use AnyDBM_File;
 
 use Onis::Config (qw(get_config));
 
 =head1 NAME
 
-Onis::Data::Persistent::Gdbm - Storage backend using GDBM_File.
+Onis::Data::Persistent::Dbm - Storage backend using AnyDBM_File.
 
 =head1 DESCRIPTION
 
-Storage backend that uses GDBM files for storing data permanently.
+Storage backend that uses DBM files for storing data permanently.
 
 =head1 CONFIGURATION OPTIONS
 
@@ -28,21 +28,20 @@ Directory in which the GDBM-files are kept.
 
 =cut
 
-our $Alarm = chr (7);
-
-our $GDBMDirectory = get_config ('gdbm_directory') || 'var';
-$GDBMDirectory =~ s#/$##g;
+our $DBMDirectory = get_config ('gdbm_directory') || 'var';
+$DBMDirectory =~ s#/$##g;
 
-if (!$GDBMDirectory or !-d $GDBMDirectory)
+if (!$DBMDirectory or !-d $DBMDirectory)
 {
 	print STDERR <<ERROR;
-The directory ``$GDBMDirectory'' does not exist or is not useable. Please
+The directory ``$DBMDirectory'' does not exist or is not useable. Please
 create it before running onis.
 ERROR
 	exit (1);
 }
 
-our %Tables = ();
+our $Alarm = chr (7);
+our %Objects = ();
 
 if ($::DEBUG & 0x0200)
 {
@@ -64,23 +63,25 @@ sub new
 	my $filename;
 	
 	my $id = $caller . ':' . $name;
+	$id =~ s#/##g;
 
 	$filename = "$GDBMDirectory/$id.gdbm";
 	
-	if (exists ($Tables{$id}))
+	if (exists ($Objects{$id}))
 	{
 		print STDERR $/, __FILE__, ": Name $name has been used in context $caller before.";
 		return (undef);
 	}
 
-	$Tables{$id} = tie (%hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0664);
+	$Objects{$id} = $obj;
 
-	$obj->{'data'} = $Tables{$id};
+	$obj->{'data'} = tie (%hash, 'AnyDBM_File', $filename, O_CREAT|O_RDWR, 0664);
 	$obj->{'key'} = $key;
 	$obj->{'fields'} = [@fields];
 	$obj->{'num_fields'} = scalar (@fields);
 	$obj->{'field_index'} = {map { $_ => $i++ } (@fields)};
 	$obj->{'id'} = $id;
+	$obj->{'cache'} = {};
 
 	if ($::DEBUG & 0x0200)
 	{
@@ -98,6 +99,7 @@ sub put
 	my $obj    = shift;
 	my $key    = shift;
 	my @fields = @_;
+	my $db = $obj->{'data'};
 
 	if ($obj->{'num_fields'} != scalar (@fields))
 	{
@@ -111,21 +113,37 @@ sub put
 		print STDOUT $/, __FILE__, ': PUT(', $obj->{'id'}, ', ', $key, ') = (' . join (', ', @fields) . ')';
 	}
 
-	$obj->{'data'}{$key} = join ($Alarm, @fields);
+	$obj->{'cache'}{$key} = [@fields];
 }
 
 sub get
 {
 	my $obj = shift;
 	my $key = shift;
+	my $val;
 	my @ret;
+	my $db = $obj->{'data'};
 
-	if (!exists ($obj->{'data'}{$key}))
+	if (!exists ($obj->{'cache'}{$key}))
 	{
-		return (qw());
+		if ($db->get ($key, $val))
+		{
+			$obj->{'cache'}{$key} = undef;
+		}
+		else
+		{
+			$obj->{'cache'}{$key} = [split ($Alarm, $val)];
+		}
 	}
 
-	@ret = split ($Alarm, $obj->{'data'}{$key});
+	if (!defined ($obj->{'cache'}{$key}))
+	{
+		return (qw());
+	}
+	else
+	{
+		@ret = @{$obj->{'cache'}{$key}};
+	}
 
 	if ($::DEBUG & 0x0200)
 	{
@@ -140,17 +158,19 @@ sub keys
 	my $obj = shift;
 	my @fields = @_;
 	my @field_indizes = ();
-	my @keys = keys %{$obj->{'data'}};
-	my $data = {};
+	my $db = $obj->{'data'};
+	my $key;
+	my $val;
 
-	if (!@fields)
+	for ($db->seq ($key, $val, R_FIRST); $db->seq ($key, $val, R_NEXT) == 0;)
 	{
-		return (@keys);
+		next if (defined ($obj->{'cache'}{$key}));
+		$obj->{'cache'}{$key} = [split ($Alarm, $val)];
 	}
 
-	for (@keys)
+	if (!@fields)
 	{
-		$data->{$_} = [split ($Alarm, $obj->{'data'}{$_})];
+		return (keys %{$obj->{'cache'}});
 	}
 
 	for (@fields)
@@ -169,7 +189,7 @@ sub keys
 	sub {
 		for (@field_indizes)
 		{
-			my $d = $data->{$a}[$_] cmp $data->{$b}[$_];
+			my $d = $obj->{'cache'}{$a}[$_] cmp $obj->{'cache'}{$b}[$_];
 			return ($d) if ($d);
 		}
 	}, @keys);
@@ -179,19 +199,47 @@ sub del
 {
 	my $obj = shift;
 	my $key = shift;
+	my $db = $obj->{'data'};
 
-	if (exists ($obj->{'data'}{$key}))
+	if (exists ($obj->{'cache'}{$key}))
 	{
-		delete ($obj->{'data'}{$key});
+		if (defined ($obj->{'cache'}{$key}))
+		{
+			$db->del ($key);
+			$obj->{'cache'}{$key} = undef;
+		}
+		# It's known that the key doesn't exist..
+	}
+	else
+	{
+		$db->del ($key);
+		$obj->{'cache'}{$key} = undef;
 	}
 }
 
-END
+sub sync
 {
-	for (keys (%Tables))
+	my $obj = shift;
+	my $db = $obj->{'data'};
+
+	for (keys %{$obj->{'cache'}})
 	{
 		my $key = $_;
-		untie (%{$Tables{$key}});
+		my $val = join ($Alarm, @{$obj->{'cache'}{$key}});
+
+		$db->put ($key, $val);
+		delete ($obj->{'cache'}{$key});
+	}
+
+	$db->sync ();
+}
+
+END
+{
+	for (keys (%Objects))
+	{
+		my $obj = $_;
+		$obj->sync ();
 	}
 }