From: 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 <{'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 (); } }