From: octo <octo>
Date: Tue, 12 Apr 2005 15:33:29 +0000 (+0000)
Subject: Gdbm renamed to Dbm
X-Git-Tag: Release-0.8.0~20^2~13
X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=8aeddb3f4c112523a7215da8cacdf9af83576ecf;p=onis.git

Gdbm renamed to Dbm
---

diff --git a/lib/Onis/Data/Persistent/Dbm.pm b/lib/Onis/Data/Persistent/Dbm.pm
new file mode 100644
index 0000000..ba3cb76
--- /dev/null
+++ b/lib/Onis/Data/Persistent/Dbm.pm
@@ -0,0 +1,250 @@
+package Onis::Data::Persistent::Dbm;
+
+use strict;
+use warnings;
+
+use Carp qw(carp confess);
+use AnyDBM_File;
+
+use Onis::Config (qw(get_config));
+
+=head1 NAME
+
+Onis::Data::Persistent::Dbm - Storage backend using AnyDBM_File.
+
+=head1 DESCRIPTION
+
+Storage backend that uses DBM 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 $DBMDirectory = get_config ('gdbm_directory') || 'var';
+$DBMDirectory =~ s#/$##g;
+
+if (!$DBMDirectory or !-d $DBMDirectory)
+{
+	print STDERR <<ERROR;
+The directory ``$DBMDirectory'' does not exist or is not useable. Please
+create it before running onis.
+ERROR
+	exit (1);
+}
+
+our $Alarm = chr (7);
+our %Objects = ();
+
+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;
+	$id =~ s#/##g;
+
+	$filename = "$GDBMDirectory/$id.gdbm";
+	
+	if (exists ($Objects{$id}))
+	{
+		print STDERR $/, __FILE__, ": Name $name has been used in context $caller before.";
+		return (undef);
+	}
+
+	$Objects{$id} = $obj;
+
+	$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)
+	{
+		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 = @_;
+	my $db = $obj->{'data'};
+
+	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->{'cache'}{$key} = [@fields];
+}
+
+sub get
+{
+	my $obj = shift;
+	my $key = shift;
+	my $val;
+	my @ret;
+	my $db = $obj->{'data'};
+
+	if (!exists ($obj->{'cache'}{$key}))
+	{
+		if ($db->get ($key, $val))
+		{
+			$obj->{'cache'}{$key} = undef;
+		}
+		else
+		{
+			$obj->{'cache'}{$key} = [split ($Alarm, $val)];
+		}
+	}
+
+	if (!defined ($obj->{'cache'}{$key}))
+	{
+		return (qw());
+	}
+	else
+	{
+		@ret = @{$obj->{'cache'}{$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 $db = $obj->{'data'};
+	my $key;
+	my $val;
+
+	for ($db->seq ($key, $val, R_FIRST); $db->seq ($key, $val, R_NEXT) == 0;)
+	{
+		next if (defined ($obj->{'cache'}{$key}));
+		$obj->{'cache'}{$key} = [split ($Alarm, $val)];
+	}
+
+	if (!@fields)
+	{
+		return (keys %{$obj->{'cache'}});
+	}
+
+	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 = $obj->{'cache'}{$a}[$_] cmp $obj->{'cache'}{$b}[$_];
+			return ($d) if ($d);
+		}
+	}, @keys);
+}
+
+sub del
+{
+	my $obj = shift;
+	my $key = shift;
+	my $db = $obj->{'data'};
+
+	if (exists ($obj->{'cache'}{$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;
+	}
+}
+
+sub sync
+{
+	my $obj = shift;
+	my $db = $obj->{'data'};
+
+	for (keys %{$obj->{'cache'}})
+	{
+		my $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 ();
+	}
+}
+
+=head1 AUTHOR
+
+Florian octo Forster, L<octo at verplant.org>
+
+=cut
diff --git a/lib/Onis/Data/Persistent/Gdbm.pm b/lib/Onis/Data/Persistent/Gdbm.pm
deleted file mode 100644
index ba3cb76..0000000
--- a/lib/Onis/Data/Persistent/Gdbm.pm
+++ /dev/null
@@ -1,250 +0,0 @@
-package Onis::Data::Persistent::Dbm;
-
-use strict;
-use warnings;
-
-use Carp qw(carp confess);
-use AnyDBM_File;
-
-use Onis::Config (qw(get_config));
-
-=head1 NAME
-
-Onis::Data::Persistent::Dbm - Storage backend using AnyDBM_File.
-
-=head1 DESCRIPTION
-
-Storage backend that uses DBM 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 $DBMDirectory = get_config ('gdbm_directory') || 'var';
-$DBMDirectory =~ s#/$##g;
-
-if (!$DBMDirectory or !-d $DBMDirectory)
-{
-	print STDERR <<ERROR;
-The directory ``$DBMDirectory'' does not exist or is not useable. Please
-create it before running onis.
-ERROR
-	exit (1);
-}
-
-our $Alarm = chr (7);
-our %Objects = ();
-
-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;
-	$id =~ s#/##g;
-
-	$filename = "$GDBMDirectory/$id.gdbm";
-	
-	if (exists ($Objects{$id}))
-	{
-		print STDERR $/, __FILE__, ": Name $name has been used in context $caller before.";
-		return (undef);
-	}
-
-	$Objects{$id} = $obj;
-
-	$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)
-	{
-		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 = @_;
-	my $db = $obj->{'data'};
-
-	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->{'cache'}{$key} = [@fields];
-}
-
-sub get
-{
-	my $obj = shift;
-	my $key = shift;
-	my $val;
-	my @ret;
-	my $db = $obj->{'data'};
-
-	if (!exists ($obj->{'cache'}{$key}))
-	{
-		if ($db->get ($key, $val))
-		{
-			$obj->{'cache'}{$key} = undef;
-		}
-		else
-		{
-			$obj->{'cache'}{$key} = [split ($Alarm, $val)];
-		}
-	}
-
-	if (!defined ($obj->{'cache'}{$key}))
-	{
-		return (qw());
-	}
-	else
-	{
-		@ret = @{$obj->{'cache'}{$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 $db = $obj->{'data'};
-	my $key;
-	my $val;
-
-	for ($db->seq ($key, $val, R_FIRST); $db->seq ($key, $val, R_NEXT) == 0;)
-	{
-		next if (defined ($obj->{'cache'}{$key}));
-		$obj->{'cache'}{$key} = [split ($Alarm, $val)];
-	}
-
-	if (!@fields)
-	{
-		return (keys %{$obj->{'cache'}});
-	}
-
-	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 = $obj->{'cache'}{$a}[$_] cmp $obj->{'cache'}{$b}[$_];
-			return ($d) if ($d);
-		}
-	}, @keys);
-}
-
-sub del
-{
-	my $obj = shift;
-	my $key = shift;
-	my $db = $obj->{'data'};
-
-	if (exists ($obj->{'cache'}{$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;
-	}
-}
-
-sub sync
-{
-	my $obj = shift;
-	my $db = $obj->{'data'};
-
-	for (keys %{$obj->{'cache'}})
-	{
-		my $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 ();
-	}
-}
-
-=head1 AUTHOR
-
-Florian octo Forster, L<octo at verplant.org>
-
-=cut