1 |
This is diff of changes for BerkeleyDB instead of DB_File. It didn't work |
2 |
well for me, so I reverted back to DB_File |
3 |
|
4 |
Index: cvs-head/lib/WAIT/Database.pm |
5 |
=================================================================== |
6 |
--- cvs-head/lib/WAIT/Database.pm (revision 84) |
7 |
+++ cvs-head/lib/WAIT/Database.pm (revision 85) |
8 |
@@ -4,7 +4,7 @@ |
9 |
# Author : Ulrich Pfeifer |
10 |
# Created On : Thu Aug 8 09:44:13 1996 |
11 |
# Last Modified By: Ulrich Pfeifer |
12 |
-# Last Modified On: Sat Apr 15 16:15:29 2000 |
13 |
+# Last Modified On: Sat Apr 27 16:48:24 2002 |
14 |
# Language : CPerl |
15 |
# |
16 |
# (C) Copyright 1996-2000, Ulrich Pfeifer |
17 |
|
18 |
Property changes on: cvs-head/lib/WAIT/Database.pm |
19 |
___________________________________________________________________ |
20 |
Name: cvs2svn:cvs-rev |
21 |
- 1.1.1.3 |
22 |
+ 1.2 |
23 |
|
24 |
Index: cvs-head/lib/WAIT/InvertedIndexOld.pm |
25 |
=================================================================== |
26 |
--- cvs-head/lib/WAIT/InvertedIndexOld.pm (revision 84) |
27 |
+++ cvs-head/lib/WAIT/InvertedIndexOld.pm (revision 85) |
28 |
@@ -1,10 +1,10 @@ |
29 |
# -*- Mode: Perl -*- |
30 |
# $Basename: InvertedIndex.pm $ |
31 |
-# $Revision: 1.1 $ |
32 |
+# $Revision: 1.2 $ |
33 |
# Author : Ulrich Pfeifer |
34 |
# Created On : Thu Aug 8 13:05:10 1996 |
35 |
# Last Modified By: Ulrich Pfeifer |
36 |
-# Last Modified On: Sat Nov 11 14:36:39 2000 |
37 |
+# Last Modified On: Sat Apr 27 18:39:21 2002 |
38 |
# Language : CPerl |
39 |
# |
40 |
# (C) Copyright 1996-2000, Ulrich Pfeifer |
41 |
@@ -605,7 +605,7 @@ |
42 |
sub set { |
43 |
my ($self, $attr, $value) = @_; |
44 |
|
45 |
- die "No such indexy attribute: '$attr'" unless $attr eq 'top'; |
46 |
+ die "No such index attribute: '$attr'" unless $attr eq 'top'; |
47 |
|
48 |
return delete $self->{reorg} if $value == 0; |
49 |
|
50 |
|
51 |
Property changes on: cvs-head/lib/WAIT/InvertedIndexOld.pm |
52 |
___________________________________________________________________ |
53 |
Name: cvs2svn:cvs-rev |
54 |
- 1.1 |
55 |
+ 1.2 |
56 |
|
57 |
Index: cvs-head/lib/WAIT/Index.pm |
58 |
=================================================================== |
59 |
--- cvs-head/lib/WAIT/Index.pm (revision 84) |
60 |
+++ cvs-head/lib/WAIT/Index.pm (revision 85) |
61 |
@@ -4,9 +4,9 @@ |
62 |
# Author : Ulrich Pfeifer |
63 |
# Created On : Thu Aug 8 13:05:10 1996 |
64 |
# Last Modified By: Ulrich Pfeifer |
65 |
-# Last Modified On: Sun Nov 22 18:44:43 1998 |
66 |
+# Last Modified On: Sat Apr 27 18:06:47 2002 |
67 |
# Language : CPerl |
68 |
-# Update Count : 107 |
69 |
+# Update Count : 128 |
70 |
# Status : Unknown, Use with caution! |
71 |
# |
72 |
# Copyright (c) 1996-1997, Ulrich Pfeifer |
73 |
@@ -15,7 +15,7 @@ |
74 |
package WAIT::Index; |
75 |
use WAIT::IndexScan; |
76 |
use strict; |
77 |
-use DB_File; |
78 |
+use BerkeleyDB; |
79 |
use Fcntl; |
80 |
use vars qw($VERSION); |
81 |
|
82 |
@@ -30,6 +30,10 @@ |
83 |
require Carp; |
84 |
Carp::croak("No file specified"); |
85 |
} |
86 |
+ unless ($self->{name} = $parm{name}) { |
87 |
+ require Carp; |
88 |
+ Carp::croak("No name specified"); |
89 |
+ } |
90 |
unless ($self->{attr} = $parm{attr}) { |
91 |
require Carp; |
92 |
Carp::croak("No attributes specified"); |
93 |
@@ -52,11 +56,15 @@ |
94 |
my $self = shift; |
95 |
my $file = $self->{file}; |
96 |
|
97 |
- if (exists $self->{dbh}) { |
98 |
+ if ($self->{dbh}) { |
99 |
$self->{dbh}; |
100 |
} else { |
101 |
- $self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file, |
102 |
- $self->{mode}, 0664, $DB_BTREE); |
103 |
+ my $dbmode = ($self->{mode} & O_CREAT) ? DB_CREATE : 0; |
104 |
+ $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree', |
105 |
+ -Filename => $self->{file}, |
106 |
+ -Subname => 'records', |
107 |
+ -Flags => $dbmode, |
108 |
+ -Mode => 0664); |
109 |
} |
110 |
} |
111 |
|
112 |
@@ -73,6 +81,7 @@ |
113 |
# duplicate entry |
114 |
return undef; |
115 |
} |
116 |
+ print STDERR "$tuple => $key\n"; |
117 |
$self->{db}->{$tuple} = $key; |
118 |
} |
119 |
|
120 |
@@ -84,6 +93,7 @@ |
121 |
|
122 |
my $tuple = join($;, map($parm{$_}, @{$self->{attr}})); |
123 |
|
124 |
+ print STDERR "$tuple <= ", $self->{db}->{$tuple}, "\n"; |
125 |
$self->{db}->{$tuple}; |
126 |
} |
127 |
|
128 |
@@ -112,7 +122,7 @@ |
129 |
|
130 |
sub sync { |
131 |
my $self = shift; |
132 |
- $self->{dbh}->sync if $self->{dbh}; |
133 |
+ $self->{dbh}->db_sync if $self->{dbh}; |
134 |
} |
135 |
|
136 |
sub close { |
137 |
@@ -122,8 +132,8 @@ |
138 |
|
139 |
if ($self->{dbh}) { |
140 |
delete $self->{dbh}; |
141 |
- untie %{$self->{db}}; |
142 |
delete $self->{db}; |
143 |
+ #untie %{$self->{db}}; |
144 |
} |
145 |
} |
146 |
|
147 |
|
148 |
Property changes on: cvs-head/lib/WAIT/Index.pm |
149 |
___________________________________________________________________ |
150 |
Name: cvs2svn:cvs-rev |
151 |
- 1.3 |
152 |
+ 1.4 |
153 |
|
154 |
Index: cvs-head/lib/WAIT/InvertedIndex.pm |
155 |
=================================================================== |
156 |
--- cvs-head/lib/WAIT/InvertedIndex.pm (revision 84) |
157 |
+++ cvs-head/lib/WAIT/InvertedIndex.pm (revision 85) |
158 |
@@ -4,7 +4,7 @@ |
159 |
# Author : Ulrich Pfeifer |
160 |
# Created On : Thu Aug 8 13:05:10 1996 |
161 |
# Last Modified By: Ulrich Pfeifer |
162 |
-# Last Modified On: Mon Apr 22 16:52:01 2002 |
163 |
+# Last Modified On: Sat Apr 27 16:13:55 2002 |
164 |
# Language : CPerl |
165 |
# |
166 |
# (C) Copyright 1996-2002, Ulrich Pfeifer |
167 |
@@ -12,7 +12,7 @@ |
168 |
|
169 |
package WAIT::InvertedIndex; |
170 |
use strict; |
171 |
-use DB_File; |
172 |
+use BerkeleyDB; |
173 |
use Fcntl; |
174 |
use WAIT::Filter; |
175 |
use Carp; |
176 |
@@ -160,7 +160,7 @@ |
177 |
|
178 |
my $O = pack('C', 0xff)."o"; |
179 |
my ($word, $value) = ($O.$;); # $word and $value are modified by seq! |
180 |
- if ( my $ret = $dbh->seq($word, $value, R_CURSOR) ) { |
181 |
+ if ( my $ret = $dbh->seq($word, $value, DB_CURSOR) ) { |
182 |
# warn "DEBUG: ret[$ret], not an old index, either empty or no \$^O"; |
183 |
return $self->{old_index} = 0; |
184 |
} |
185 |
@@ -169,7 +169,7 @@ |
186 |
# warn "DEBUG: word[$word]value[$value], not an old index"; |
187 |
return $self->{old_index} = 0; |
188 |
} |
189 |
- if (my $ret = $dbh->seq($word, $value, R_NEXT) or # no values left |
190 |
+ if (my $ret = $dbh->seq($word, $value, DB_NEXT) or # no values left |
191 |
$word !~ /^$O$;/o # no $O values left |
192 |
) { |
193 |
# we are not sure enough that this is an old index |
194 |
@@ -190,8 +190,10 @@ |
195 |
} else { |
196 |
$self->{func} = |
197 |
eval sprintf("sub {grep /./, %s}", _filtergen(@{$self->{filter}})); |
198 |
- $self->{dbh} = tie(%{$self->{db}}, 'DB_File', $file, |
199 |
- $self->{mode}, 0664, $DB_BTREE); |
200 |
+ $self->{dbh} = tie(%{$self->{db}}, 'BerkeleyDB::Btree', |
201 |
+ -Filename => $self->{file}, |
202 |
+ -Subname => $self->{name}, |
203 |
+ -Mode => $self->{mode}; |
204 |
$self->{cache} = {} |
205 |
if $self->{mode} & O_RDWR; |
206 |
$self->{cdict} = {} |
207 |
@@ -328,13 +330,13 @@ |
208 |
$last = (defined $last)?'p'.$last:'q'; |
209 |
|
210 |
# set the cursor to $first |
211 |
- $dbh->seq($first, $value, R_CURSOR); |
212 |
+ $dbh->seq($first, $value, DB_CURSOR); |
213 |
|
214 |
# $first would be after the last word |
215 |
return () if $first gt $last; |
216 |
|
217 |
push @result, substr($first,1); |
218 |
- while (!$dbh->seq($word, $value, R_NEXT)) { |
219 |
+ while (!$dbh->seq($word, $value, DB_NEXT)) { |
220 |
# We should limit this to a "resonable" number of words |
221 |
last if $word gt $last; |
222 |
push @result, substr($word,1); |
223 |
@@ -362,13 +364,13 @@ |
224 |
($prefix) = &{$self->{'pfunc'}}($prefix); |
225 |
} |
226 |
|
227 |
- if ($dbh->seq($word = 'p'.$prefix, $value, R_CURSOR)) { |
228 |
+ if ($dbh->seq($word = 'p'.$prefix, $value, DB_CURRENT)) { |
229 |
return (); |
230 |
} |
231 |
return () if $word !~ /^p$prefix/; |
232 |
push @result, substr($word,1); |
233 |
|
234 |
- while (!$dbh->seq($word, $value, R_NEXT)) { |
235 |
+ while (!$dbh->seq($word, $value, DB_NEXT)) { |
236 |
# We should limit this to a "resonable" number of words |
237 |
last if $word !~ /^p$prefix/; |
238 |
push @result, substr($word,1); |
239 |
|
240 |
Property changes on: cvs-head/lib/WAIT/InvertedIndex.pm |
241 |
___________________________________________________________________ |
242 |
Name: cvs2svn:cvs-rev |
243 |
- 1.11 |
244 |
+ 1.12 |
245 |
|
246 |
Index: cvs-head/lib/WAIT/IndexScan.pm |
247 |
=================================================================== |
248 |
--- cvs-head/lib/WAIT/IndexScan.pm (revision 84) |
249 |
+++ cvs-head/lib/WAIT/IndexScan.pm (revision 85) |
250 |
@@ -4,9 +4,9 @@ |
251 |
# Author : Ulrich Pfeifer |
252 |
# Created On : Mon Aug 12 14:05:14 1996 |
253 |
# Last Modified By: Ulrich Pfeifer |
254 |
-# Last Modified On: Sun Nov 22 18:44:43 1998 |
255 |
+# Last Modified On: Sat Apr 27 17:46:53 2002 |
256 |
# Language : CPerl |
257 |
-# Update Count : 65 |
258 |
+# Update Count : 92 |
259 |
# Status : Unknown, Use with caution! |
260 |
# |
261 |
# Copyright (c) 1996-1997, Ulrich Pfeifer |
262 |
@@ -15,71 +15,53 @@ |
263 |
package WAIT::IndexScan; |
264 |
|
265 |
use strict; |
266 |
-use DB_File; |
267 |
+use BerkeleyDB; |
268 |
use Fcntl; |
269 |
|
270 |
sub new { |
271 |
my $type = shift; |
272 |
my $index = shift; |
273 |
my $code = shift; |
274 |
- my ($first, $tid) = ('', ''); |
275 |
+ my $cursor; |
276 |
|
277 |
# find the first key |
278 |
- if ($index->{dbh}->seq($first, $tid, R_FIRST)) { |
279 |
+ unless ($cursor = $index->{dbh}->db_cursor()) { |
280 |
require Carp; |
281 |
Carp::croak("Could not open scan"); |
282 |
} |
283 |
- # Not sure about this. R_FIRST sets $tid to no-of-records? |
284 |
- # $index->{dbh}->seq($first, $tid, R_NEXT); |
285 |
+ # Not sure about this. DB_FIRST sets $tid to no-of-records? |
286 |
+ # $index->{dbh}->seq($first, $tid, DB_NEXT); |
287 |
# register to avoid unnecessary position calls |
288 |
- $index->{scans}++; |
289 |
|
290 |
- bless {Index => $index, code => $code, |
291 |
- nextk => $first, tid => $tid}, $type or ref($type); |
292 |
+ bless {code => $code, cursor => $cursor, Index => $index}, |
293 |
+ $type or ref($type); |
294 |
} |
295 |
|
296 |
sub next { |
297 |
my $self = shift; |
298 |
- my $dbh = $self->{Index}->{dbh}; |
299 |
- my ($key, $tid, $ntid); |
300 |
+ my $cursor = $self->{cursor}; |
301 |
+ my ($key, $tid) = ('', ''); |
302 |
|
303 |
- if (defined $self->{nextk}) { |
304 |
- unless ($dbh){ |
305 |
- require Carp; |
306 |
- Carp::croak("Cannot scan closed index"); |
307 |
- } |
308 |
- $key = $self->{nextk}; |
309 |
+ $cursor->c_get($key, $tid, DB_NEXT) == 0 or return; |
310 |
|
311 |
- if ($self->{Index}->{scans} > 1) { |
312 |
- # Another scan is open. Reset the cursor |
313 |
- $dbh->seq($key, $tid, R_CURSOR); |
314 |
- } else { |
315 |
- $tid = $self->{tid}; |
316 |
- } |
317 |
- if ($dbh->seq($self->{nextk}, $self->{tid}, R_NEXT)) { |
318 |
- # current tuple is last one |
319 |
- delete $self->{nextk}; |
320 |
- } |
321 |
+ my @tuple = split /$;/, $key; |
322 |
|
323 |
- my @tuple = split /$;/, $key; |
324 |
- my %tuple = (_id => $tid); |
325 |
- for (@{$self->{Index}->{attr}}) { |
326 |
- $tuple{$_} = shift @tuple; |
327 |
- } |
328 |
+ my %tuple = (_id => $tid); |
329 |
+ for (@{$self->{Index}->{attr}}) { |
330 |
+ $tuple{$_} = shift @tuple; |
331 |
+ } |
332 |
|
333 |
- if ($self->{code}) { # test condition |
334 |
- &{$self->{code}}(\%tuple)? %tuple : $self->next; |
335 |
- } else { |
336 |
- %tuple; |
337 |
- } |
338 |
+ |
339 |
+ if ($self->{code}) { # test condition |
340 |
+ &{$self->{code}}(\%tuple)? %tuple : $self->next; |
341 |
} else { |
342 |
- return; |
343 |
+ %tuple; |
344 |
} |
345 |
} |
346 |
|
347 |
-sub close { undef $_[0]} # force DESTROY |
348 |
-sub DESTROY { |
349 |
- shift->{Index}->{scans}--; |
350 |
+sub close { |
351 |
+ my $self = shift; |
352 |
+ delete $self->{cursor}; |
353 |
} |
354 |
|
355 |
1; |
356 |
|
357 |
Property changes on: cvs-head/lib/WAIT/IndexScan.pm |
358 |
___________________________________________________________________ |
359 |
Name: cvs2svn:cvs-rev |
360 |
- 1.1.1.2 |
361 |
+ 1.2 |
362 |
|
363 |
Index: cvs-head/lib/WAIT/Table.pm |
364 |
=================================================================== |
365 |
--- cvs-head/lib/WAIT/Table.pm (revision 84) |
366 |
+++ cvs-head/lib/WAIT/Table.pm (revision 85) |
367 |
@@ -4,9 +4,9 @@ |
368 |
# Author : Ulrich Pfeifer |
369 |
# Created On : Thu Aug 8 13:05:10 1996 |
370 |
# Last Modified By: Ulrich Pfeifer |
371 |
-# Last Modified On: Wed Jan 23 14:15:15 2002 |
372 |
+# Last Modified On: Sat Apr 27 17:20:31 2002 |
373 |
# Language : CPerl |
374 |
-# Update Count : 152 |
375 |
+# Update Count : 172 |
376 |
# Status : Unknown, Use with caution! |
377 |
# |
378 |
# Copyright (c) 1996-1997, Ulrich Pfeifer |
379 |
@@ -32,7 +32,7 @@ |
380 |
use strict; |
381 |
use Carp; |
382 |
# use autouse Carp => qw( croak($) ); |
383 |
-use DB_File; |
384 |
+use BerkeleyDB; |
385 |
use Fcntl; |
386 |
use LockFile::Simple (); |
387 |
|
388 |
@@ -159,10 +159,8 @@ |
389 |
} |
390 |
|
391 |
$self->{file} = $parm{file} or croak "No file specified"; |
392 |
- if (-d $self->{file}){ |
393 |
- warn "Warning: Directory '$self->{file}' already exists\n"; |
394 |
- } elsif (!mkdir($self->{file}, 0775)) { |
395 |
- croak "Could not 'mkdir $self->{file}': $!\n"; |
396 |
+ if (-e $self->{file}){ |
397 |
+ warn "Warning: file '$self->{file}' already exists\n"; |
398 |
} |
399 |
|
400 |
$self->{djk} = $parm{djk} if defined $parm{djk}; |
401 |
@@ -223,7 +221,7 @@ |
402 |
|
403 |
my $name = join '-', @_; |
404 |
$self->{indexes}->{$name} = |
405 |
- new WAIT::Index file => $self->{file}.'/'.$name, attr => $_; |
406 |
+ new WAIT::Index file => $self->{file}, name => $name, attr => $_; |
407 |
} |
408 |
|
409 |
=head2 Creating an inverted index |
410 |
@@ -337,11 +335,9 @@ |
411 |
for (values %{$self->{indexes}}) { |
412 |
$_->drop; |
413 |
} |
414 |
- unlink "$file/records"; |
415 |
- rmdir "$file/read" or warn "Could not rmdir '$file/read'"; |
416 |
- |
417 |
- # $self->unlock; |
418 |
- ! (!-e $file or rmdir $file); |
419 |
+ rmdir "$file.read" or warn "Could not rmdir '$file/read'"; |
420 |
+ unlink "$file"; |
421 |
+ |
422 |
} else { |
423 |
croak ref($self)."::drop called directly"; |
424 |
} |
425 |
@@ -384,14 +380,20 @@ |
426 |
|
427 |
$self->getlock($self->{mode}); |
428 |
|
429 |
+ my $dbmode = ($self->{mode} & O_CREAT) ? DB_CREATE : 0; |
430 |
unless (defined $self->{dbh}) { |
431 |
if ($USE_RECNO) { |
432 |
- $self->{dbh} = tie(@{$self->{db}}, 'DB_File', $file, |
433 |
- $self->{mode}, 0664, $DB_RECNO); |
434 |
+ tie(%{$self->{db}}, 'BerkeleyDB::Recno', |
435 |
+ -Filename => $self->{file}, |
436 |
+ -Subname => 'records', |
437 |
+ -Flags => $dbmode); |
438 |
} else { |
439 |
$self->{dbh} = |
440 |
- tie(%{$self->{db}}, 'DB_File', $file, |
441 |
- $self->{mode}, 0664, $DB_BTREE); |
442 |
+ tie(%{$self->{db}}, 'BerkeleyDB::Btree', |
443 |
+ -Filename => $self->{file}, |
444 |
+ -Subname => 'records', |
445 |
+ -Mode => 0664, |
446 |
+ -Flags => $dbmode); |
447 |
} |
448 |
} |
449 |
|
450 |
@@ -675,8 +677,8 @@ |
451 |
# autoclean cleans on DESTROY, stale sends SIGZERO to the owner |
452 |
# |
453 |
my $lockmgr = LockFile::Simple->make(-autoclean => 1, -stale => 1); |
454 |
- my $file = $self->{file} . '/records'; |
455 |
- my $lockdir = $self->{file} . '/read'; |
456 |
+ my $file = $self->{file}; |
457 |
+ my $lockdir = $self->{file} . '.read'; |
458 |
|
459 |
unless (-d $lockdir) { |
460 |
mkdir $lockdir, 0755 or die "Could not mkdir $lockdir: $!"; |
461 |
@@ -697,8 +699,8 @@ |
462 |
} |
463 |
|
464 |
# Get the preliminary write lock |
465 |
- $self->{write_lock} = $lockmgr->lock($self->{file} . '/write') |
466 |
- or die "Can't lock '$self->{file}/write'"; |
467 |
+ $self->{write_lock} = $lockmgr->lock($self->{file} . '.write') |
468 |
+ or die "Can't lock '$self->{file}.write'"; |
469 |
|
470 |
# If we actually want to write we must check if there are any |
471 |
# readers. The write lock is confirmed if wen cannot find any |
472 |
@@ -727,8 +729,8 @@ |
473 |
# Get the preliminary write lock to protect the directory |
474 |
# operations. |
475 |
|
476 |
- my $write_lock = $lockmgr->lock($self->{file} . '/read/write') |
477 |
- or die "Can't lock '$self->{file}/read/write'"; |
478 |
+ my $write_lock = $lockmgr->lock($self->{file} . '.read/write') |
479 |
+ or die "Can't lock '$self->{file}.read/write'"; |
480 |
|
481 |
# Find a new read slot. Maybe the plain file would be better? |
482 |
my $id = time; |
483 |
|
484 |
Property changes on: cvs-head/lib/WAIT/Table.pm |
485 |
___________________________________________________________________ |
486 |
Name: cvs2svn:cvs-rev |
487 |
- 1.9 |
488 |
+ 1.10 |
489 |
|