From 61edec54c59c6bd9d8bdbc1983dacdcaf4b02ed1 Mon Sep 17 00:00:00 2001
From: octo <octo>
Date: Tue, 12 Apr 2005 13:33:12 +0000
Subject: [PATCH] Added Onis::Data::Persistent::Gdbm, changed default
 storage-dir to 'var/'

---
 lib/Onis/Data/Persistent/Gdbm.pm     | 202 +++++++++++++++++++++++++++++++++++
 lib/Onis/Data/Persistent/Storable.pm |   2 +-
 2 files changed, 203 insertions(+), 1 deletion(-)
 create mode 100644 lib/Onis/Data/Persistent/Gdbm.pm

diff --git a/lib/Onis/Data/Persistent/Gdbm.pm b/lib/Onis/Data/Persistent/Gdbm.pm
new file mode 100644
index 0000000..99d574f
--- /dev/null
+++ b/lib/Onis/Data/Persistent/Gdbm.pm
@@ -0,0 +1,202 @@
+package Onis::Data::Persistent::Gdbm;
+
+use strict;
+use warnings;
+
+use Carp qw(carp confess);
+use GDBM_File;
+
+use Onis::Config (qw(get_config));
+
+=head1 NAME
+
+Onis::Data::Persistent::Gdbm - Storage backend using GDBM_File.
+
+=head1 DESCRIPTION
+
+Storage backend that uses GDBM files for storing data permanently.
+
+=head1 CONFIGURATION OPTIONS
+
+=over 4
+
+=item B<gdbm_directory>: I<E<lt>dirE<gt>>
+
+Directory in which the GDBM-files are kept.
+
+=back
+
+=cut
+
+our $Alarm = chr (7);
+
+our $GDBMDirectory = get_config ('gdbm_directory') || 'var';
+$GDBMDirectory =~ s#/$##g;
+
+if (!$GDBMDirectory or !-d $GDBMDirectory)
+{
+	print STDERR <<ERROR;
+The directory ``$GDBMDirectory'' does not exist or is not useable. Please
+create it before running onis.
+ERROR
+	exit (1);
+}
+
+our %Tables = ();
+
+if ($::DEBUG & 0x0200)
+{
+	require Data::Dumper;
+}
+
+return (1);
+
+sub new
+{
+	my $pkg    = shift;
+	my $name   = shift;
+	my $key    = shift;
+	my @fields = @_;
+	my $caller = caller ();
+	my $obj    = {};
+	my %hash;
+	my $i = 0;
+	my $filename;
+	
+	my $id = $caller . ':' . $name;
+
+	$filename = "$GDBMDirectory/$id.gdbm";
+	
+	if (exists ($Tables{$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);
+
+	$obj->{'data'} = $Tables{$id};
+	$obj->{'key'} = $key;
+	$obj->{'fields'} = [@fields];
+	$obj->{'num_fields'} = scalar (@fields);
+	$obj->{'field_index'} = {map { $_ => $i++ } (@fields)};
+	$obj->{'id'} = $id;
+
+	if ($::DEBUG & 0x0200)
+	{
+		my $prefix = __FILE__ . ': ';
+		my $dbg = Data::Dumper->Dump ([$obj], ['obj']);
+		$dbg =~ s/^/$prefix/mg; chomp ($dbg);
+		print STDOUT $/, $dbg;
+	}
+	
+	return (bless ($obj, $pkg));
+}
+
+sub put
+{
+	my $obj    = shift;
+	my $key    = shift;
+	my @fields = @_;
+
+	if ($obj->{'num_fields'} != scalar (@fields))
+	{
+		my $id = $obj->{'id'};
+		carp ("Number of fields do not match ($id).");
+		return;
+	}
+
+	if ($::DEBUG & 0x0200)
+	{
+		print STDOUT $/, __FILE__, ': PUT(', $obj->{'id'}, ', ', $key, ') = (' . join (', ', @fields) . ')';
+	}
+
+	$obj->{'data'}{$key} = join ($Alarm, @fields);
+}
+
+sub get
+{
+	my $obj = shift;
+	my $key = shift;
+	my @ret;
+
+	if (!exists ($obj->{'data'}{$key}))
+	{
+		return (qw());
+	}
+
+	@ret = split ($Alarm, $obj->{'data'}{$key});
+
+	if ($::DEBUG & 0x0200)
+	{
+		print STDOUT $/, __FILE__, ': GET(', $obj->{'id'}, ', ', $key, ') = (' . join (', ', @ret) . ')';
+	}
+
+	return (@ret);
+}
+
+sub keys
+{
+	my $obj = shift;
+	my @fields = @_;
+	my @field_indizes = ();
+	my @keys = keys %{$obj->{'data'}};
+	my $data = {};
+
+	if (!@fields)
+	{
+		return (@keys);
+	}
+
+	for (@keys)
+	{
+		$data->{$_} = [split ($Alarm, $obj->{'data'}{$_})];
+	}
+
+	for (@fields)
+	{
+		my $field = $_;
+		if (!defined ($obj->{'field_index'}{$field}))
+		{
+			my $id = $obj->{'id'};
+			print STDERR $/, __FILE__, ": $field is not a valid field ($id).";
+			next;
+		}
+		push (@field_indizes, $obj->{'field_index'}{$field});
+	}
+
+	return (sort
+	sub {
+		for (@field_indizes)
+		{
+			my $d = $data->{$a}[$_] cmp $data->{$b}[$_];
+			return ($d) if ($d);
+		}
+	}, @keys);
+}
+
+sub del
+{
+	my $obj = shift;
+	my $key = shift;
+
+	if (exists ($obj->{'data'}{$key}))
+	{
+		delete ($obj->{'data'}{$key});
+	}
+}
+
+END
+{
+	for (keys (%Tables))
+	{
+		my $key = $_;
+		untie (%{$Tables{$key}});
+	}
+}
+
+=head1 AUTHOR
+
+Florian octo Forster, L<octo at verplant.org>
+
+=cut
diff --git a/lib/Onis/Data/Persistent/Storable.pm b/lib/Onis/Data/Persistent/Storable.pm
index ae7840a..67597fe 100644
--- a/lib/Onis/Data/Persistent/Storable.pm
+++ b/lib/Onis/Data/Persistent/Storable.pm
@@ -34,7 +34,7 @@ Sets the file to use for storable.
 
 =cut
 
-our $StorableFile = get_config ('storable_file') || 'persistency.dat';
+our $StorableFile = get_config ('storable_file') || 'var/storable.dat';
 
 if (-f $StorableFile)
 {
-- 
2.11.0