]> git.p6c8.net - dumbdbm.git/blob - DumbDBM_File.pm
ef9458402ab3a3adc7b8d3601267796cadcaf642
[dumbdbm.git] / DumbDBM_File.pm
1 package DumbDBM_File;
2
3 # DumbDBM_File - Portable DBM implementation
4 #
5 # Based on Python's dumbdbm / dbm.dumb
6 #
7 # Author: Patrick Canterino <patrick@patshaping.de>
8
9 use strict;
10
11 use Carp qw(carp croak);
12 use Fcntl;
13
14 our $VERSION = '0.1';
15
16 our $_BLOCKSIZE = 512;
17
18 sub _update {
19 my $self = shift;
20 local *FILE;
21
22 $self->{'_index'} = { };
23
24 open(FILE,'<'.$self->{'_dirfile'}) or carp $!;
25
26 while(<FILE>) {
27 my $line = $_;
28 $line =~ s/\s+$//g;
29
30 my ($key,@pos_and_siz_pair) = eval($line);
31 $self->{'_index'}->{$key} = \@pos_and_siz_pair;
32 }
33 }
34
35 sub _commit {
36 my $self = shift;
37
38 unlink($self->{'_bakfile'});
39 rename($self->{'_dirfile'},$self->{'_bakfile'});
40
41 open(FILE,'>'.$self->{'_dirfile'}) or carp $!;
42
43 while(my($key,$pos_and_siz_pair) = each(%{$self->{'_index'}})) {
44 print FILE "'$key', ($pos_and_siz_pair->[0], $pos_and_siz_pair->[1])\n";
45 }
46
47 close(FILE);
48 }
49
50 sub _addval {
51 my ($self,$val) = @_;
52 local *FILE;
53
54 open(FILE,'+<'.$self->{'_datfile'}) or carp $!;
55 binmode(FILE);
56 seek(FILE,0,2);
57
58 my $pos = tell(FILE);
59 my $npos = int(($pos + $_BLOCKSIZE - 1) / $_BLOCKSIZE) * $_BLOCKSIZE;
60
61 print FILE "\0" x ($npos-$pos);
62
63 $pos = $npos;
64
65 print FILE $val;
66
67 close(FILE);
68
69 return ($pos,length($val));
70 }
71
72 sub _setval {
73 my ($self,$pos,$val) = @_;
74 local *FILE;
75
76 open(FILE,'+<'.$self->{'_datfile'}) or carp $!;
77 binmode(FILE);
78 seek(FILE,$pos,0);
79 print FILE $val;
80 close(FILE);
81
82 return ($pos,length($val));
83 }
84
85 sub _addkey {
86 my ($self,$key,@pos_and_siz_pair) = @_;
87 local *FILE;
88
89 $self->{'_index'}->{$key} = \@pos_and_siz_pair;
90
91 open(FILE,'>>'.$self->{'_dirfile'}) or carp $!;
92 print FILE "'$key', ($pos_and_siz_pair[0], $pos_and_siz_pair[1])\n";
93 close(FILE);
94 }
95
96 sub TIEHASH {
97 my ($class,$file) = @_;
98 local *FILE;
99
100 my $hash = { };
101
102 $hash->{'_dirfile'} = $file.'.dir';
103 $hash->{'_datfile'} = $file.'.dat';
104 $hash->{'_bakfile'} = $file.'.bak';
105
106 $hash->{'_index'} = { };
107
108 sysopen(FILE,$hash->{'_datfile'},O_RDONLY | O_CREAT) or carp $!;
109 close(FILE);
110
111 my $self = bless($hash,$class);
112 $self->_update;
113
114 return $self;
115 }
116
117 sub EXISTS {
118 my ($self,$key) = @_;
119 return exists($self->{'_index'}->{$key});
120 }
121
122 sub FETCH {
123 my ($self,$key) = @_;
124 local *FILE;
125
126 my $pos = $self->{'_index'}->{$key}->[0];
127 my $siz = $self->{'_index'}->{$key}->[1];
128
129 open(FILE,'<'.$self->{'_datfile'}) or carp $!;
130 binmode(FILE);
131 seek(FILE,$pos,0);
132 read(FILE, my $dat, $siz);
133 close(FILE);
134
135 return $dat;
136 }
137
138 sub STORE {
139 my ($self,$key,$val) = @_;
140
141 if(not exists($self->{'_index'}->{$key})) {
142 $self->_addkey($key,$self->_addval($val));
143 }
144 else {
145 my $pos = $self->{'_index'}->{$key}->[0];
146 my $siz = $self->{'_index'}->{$key}->[1];
147
148 my $oldblocks = int(($siz + $_BLOCKSIZE -1) / $_BLOCKSIZE);
149 my $newblocks = int((length($val) + $_BLOCKSIZE -1) / $_BLOCKSIZE);
150
151 if($newblocks <= $oldblocks) {
152 my @pos_and_siz_pair = $self->_setval($pos,$val);
153 $self->{'_index'}->{$key} = \@pos_and_siz_pair;
154 }
155 else {
156 my @pos_and_siz_pair = $self->_addval($val);
157 $self->{'_index'}->{$key} = \@pos_and_siz_pair;
158 }
159 }
160 }
161
162 sub FIRSTKEY {
163 my $self = shift;
164 my $a = keys(%{$self->{'_index'}});
165 each %{$self->{'_index'}};
166 }
167
168 sub DELETE {
169 my ($self,$key) = @_;
170 delete($self->{'_index'}->{$key});
171 $self->_commit;
172 }
173
174 sub NEXTKEY {
175 my $self = shift;
176 each %{$self->{'_index'}};
177 }
178
179 sub UNTIE {
180 my $self = shift;
181 $self->_commit;
182
183 $self->{'_dirfile'} = undef;
184 $self->{'_datfile'} = undef;
185 $self->{'_bakfile'} = undef;
186 }
187
188 # it's true, baby ;-)
189
190 1;
191
192 # Documentation
193
194 =pod
195
196 =head1 NAME
197
198 DumbDBM_File - Portable DBM implementation
199
200 =head1 SYNOPSIS
201
202 use DumbDBM_File;
203
204 # Opening a database file called "homer.db"
205 # Creating it if necessary
206
207 my %db;
208 tie(%db,'DumbDBM_File','homer.db');
209
210 # Assigning some values
211
212 $db{'name'} = 'Homer';
213 $db{'wife'} = 'Marge';
214 $db{'child'} = 'Bart';
215 $db{'neighbor'} = 'Flanders';
216
217 # Print value of "name": Homer
218
219 print $db{'name'};
220
221 # Overwriting a value
222
223 $db{'child'} = 'Lisa';
224
225 # Remove a value
226 # The value remains in the database file, just the index entry gets removed,
227 # meaning you can't retrieve the value from the database file any more
228
229 delete($db{'neighbor'});
230
231 # Close the database file
232
233 untie %db;
234
235 =head1 DESCRIPTION
236
237 This is a Perl implementation of Python's C<dumbdbm> / C<dbm.dumb> module. It
238 provides a simple DBM style database written entirely in Perl, requiring no
239 external library.
240
241 Beware that this module is slow and should only be used as a last resort
242 fallback when no more robust module like L<DB_File> is available.
243
244 This Perl implementation is fully compatible to the original Python one.
245
246 =head1 FILES
247
248 Consider having a database called example, you have up to three files:
249
250 =over 2
251
252 =item example.dir
253
254 This is an index file containing information for retrieving the values out of
255 the database. It is a text file containing the key, the file offset and the
256 size of each value.
257
258 =item example.dir.bak
259
260 This file B<may> containg a backup of the index file.
261
262 =item example.dat
263
264 This is the database file containing the values separated by zeros.
265
266 =back
267
268 =head1 BUGS AND PROBLEMS
269
270 This module is a direct port of the Python module containing the same bugs and
271 problems.
272
273 - Seems to contain a bug when updating (this information was directly taken
274 from a comment in C<dumbdbm>'s source code)
275
276 - Free space is not reclaimed
277
278 - No concurrent access is supported (if two processes access the database, they
279 may mess up the index)
280
281 - This module always reads the whole index file and some updates the whole
282 index
283
284 - No read-only mode
285
286 =head1 COPYRIGHT
287
288 =head1 AUTHOR
289
290 DumbDBM_File was written by Patrick Canterino
291 L<patrick@patshaping.de|mailto:patrick@patshaping.de>.
292
293 L<http://www.patshaping.de/>
294
295 If you wonder why I wrote this: I felt boring ;)
296
297 =cut
298
299 #
300 ### End ###

patrick-canterino.de