source: main/trunk/greenstone2/perllib/dbutil.pm@ 32303

Last change on this file since 32303 was 31188, checked in by ak19, 7 years ago

This commit is related to but not specific to the upcoming commit to do with the new oaiinfo db and its directly affected files. This commit: New remove and rename (move) methods in DB package to clean up main db file and any additional db files created by any specific infodbtype. The new methods in dbutil/jdbm.pm are not called, for some reason. Requires more investigation, but committing for now.
File size: 16.5 KB
Line 
1###############################################################################
2#
3# dbutil.pm -- functions to handle using dbdrivers
4#
5# Copyright (c) 2015 New Zealand Digital Library Project
6#
7# A component of the Greenstone digital library software from the New Zealand
8# Digital Library Project at the University of Waikato, New Zealand.
9#
10# This program is free software; you can redistribute it and/or modify it under
11# the terms of the GNU General Public License as published by the Free Software
12# Foundation; either version 2 of the License, or (at your option) any later
13# version.
14#
15# This program is distributed in the hope that it will be useful, but WITHOUT
16# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
17# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
18# details.
19#
20# You should have received a copy of the GNU General Public License along with
21# this program; if not, write to the Free Software Foundation, Inc., 675 Mass
22# Ave, Cambridge, MA 02139, USA.
23#
24###############################################################################
25
26package dbutil;
27
28# Pragma
29use strict;
30
31# DEBUGGING: You can enable a DBDriver one at a time to ensure they don't have
32# compilation errors.
33BEGIN
34{
35 if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) {
36 die("Error! Environment not prepared. Have you sourced setup.bash?\n");
37 }
38 # Are we running standalone? In which case the INC won't be correct
39 # - derp. Linux only sorry
40 if ($^O !~ /cygwin|MSWin32/) {
41 my $perllib_path = $ENV{'GSDLHOME'} . '/perllib';
42 my $all_inc = join(':', @INC);
43 if ($all_inc !~ /$perllib_path/) {
44 unshift(@INC, $perllib_path);
45 unshift(@INC, $ENV{'GSDLHOME'} . '/ext/parallel-building/perllib');
46 unshift(@INC, $ENV{'GSDLHOME'} . '/ext/tdb/perllib');
47 }
48 }
49 ## You can uncomment and name a Driver here to test it compiles
50 #require DBDrivers::TDBCLUSTER;
51 #my $driver = DBDrivers::TDBCLUSTER->new(1);
52}
53
54# Libraries
55use Devel::Peek;
56use Time::HiRes qw ( gettimeofday tv_interval );
57use FileUtils;
58use gsprintf 'gsprintf';
59use util;
60
61# Modulino pattern
62__PACKAGE__->main unless caller;
63
64###############################################################################
65## Private
66###############################################################################
67
68## Display debug messages?
69my $debug = 0; # Set to 1 to display
70
71## Keep track of the driver objects we have initialised
72my $dbdriver_pool = {};
73
74# Testing globals
75my $test_count = 0;
76my $pass_count = 0;
77my $skip_count = 0;
78
79
80## @function _addPathsToINC(void) => void
81#
82# A hopefully unused function to ensure the INC path contains all the available
83# perllib directories (from main, collection, and extensions)
84#
85sub _addPathsToINC
86{
87 &_debugPrint('_addPathsToINC() => ', 0);
88 my @possible_paths;
89 #... the main perllib directory...
90 push(@possible_paths, &FileUtils::filenameConcatenate());
91 #... a collection specific perllib directory...
92 if (defined $ENV{'GSDLCOLLECTDIR'} && $ENV{'GSDLCOLLECTION'}) {
93 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, 'collect', $ENV{'GSDLCOLLECTION'}, 'perllib'));
94 }
95 #... any registered extension may also have a perllib!
96 if (defined $ENV{'GSDLEXTS'} && defined $ENV{'GSDLHOME'}) {
97 foreach my $gs2_extension (split(/:/, $ENV{'GSDLEXTS'})) {
98 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'ext', $gs2_extension, 'perllib'));
99 }
100 }
101 if (defined $ENV{'GSDL3EXTS'} && defined $ENV{'GSDL3SRCHOME'}) {
102 foreach my $gs3_extension (split(/:/, $ENV{'GSDL3EXTS'})) {
103 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, 'ext', $gs3_extension, 'perllib'));
104 }
105 }
106 my $path_counter = 0;
107 foreach my $possible_path (@possible_paths) {
108 # we only try adding paths that actually exist
109 if (-d $possible_path) {
110 my $did_add_path = &util::augmentINC($possible_path);
111 if ($did_add_path) {
112 $path_counter++;
113 }
114 }
115 }
116 &_debugPrint('Added ' . $path_counter . ' paths');
117}
118## _addPathsToINC(void) => void #
119
120
121## @function _debugPrint(string, boolean)
122#
123sub _debugPrint
124{
125 my ($message, $newline) = @_;
126 if ($debug) {
127 if (!defined($newline)) {
128 $newline = 1;
129 }
130 print STDERR '[DEBUG] dbutil::' . $message;
131 if ($newline) {
132 print STDERR "\n";
133 }
134 }
135}
136## _debugPrint(string, boolean) => void ##
137
138
139## @function _isDriverLoaded(string) => boolean
140#
141sub _isDriverLoaded
142{
143 my ($dbdriver_name) = @_;
144 (my $dbdriver_file = $dbdriver_name) =~ s/::/\//g;
145 $dbdriver_file .= '.pm';
146 my $result = defined($INC{$dbdriver_file});
147 &_debugPrint('_isDriverLoaded("' . $dbdriver_name . '") => ' . $result);
148 return $result;
149}
150## _isDriverLoaded(string) => boolean ##
151
152## @function _loadDBDriver(string, string)
153#
154sub _loadDBDriver
155{
156 my ($dbdriver_name, $db_filepath) = @_;
157 my $dbdriver;
158 # I've decided (arbitrarily) to use uppercase for driver names since they
159 # are mostly acronyms
160 $dbdriver_name = uc($dbdriver_name);
161 # Ensure the driver has the correct package prefix
162 if ($dbdriver_name !~ /^DBDrivers/) {
163 $dbdriver_name = 'DBDrivers::' . $dbdriver_name;
164 }
165 # We only need to create each driver once
166 if (defined($dbdriver_pool->{$dbdriver_name})) {
167 $dbdriver = $dbdriver_pool->{$dbdriver_name};
168 }
169 else {
170 &_debugPrint('_loadDBDriver() => ' . $dbdriver_name);
171 # Assuming the INC is correctly setup, then this should work nicely
172 # - make sure we have required this dbdriver package
173 eval "require $dbdriver_name";
174 if (&_isDriverLoaded($dbdriver_name)) {
175 $dbdriver_name->import();
176 }
177 # What should we do about drivers that aren't there?
178 else {
179 print STDERR "Error! Failed to load: " . $dbdriver_name . "\n";
180 }
181 # Then initialise and return a new one
182 $dbdriver = $dbdriver_name->new($debug);
183 # Store it for later use
184 $dbdriver_pool->{$dbdriver_name} = $dbdriver;
185 }
186 return $dbdriver;
187}
188## _loadDBDriver(string, string) => BaseDBDriver ##
189
190
191## @function _printTest(string, integer) => void
192#
193sub _printTest
194{
195 my $title = shift(@_);
196 my $result = shift(@_);
197 $test_count++;
198 print " - Test: " . $title . "... ";
199 if ($result) {
200 print "Passed\n";
201 $pass_count++;
202 }
203 else {
204 print "Failed\n";
205 }
206}
207## _printTest(string, integer) => void ##
208
209
210sub _compareHash
211{
212 my $hash1 = shift(@_);
213 my $hash2 = shift(@_);
214 my $str1 = &_hash2str($hash1);
215 my $str2 = &_hash2str($hash2);
216 return ($str1 eq $str2);
217}
218
219sub _hash2str
220{
221 my $hash = shift(@_);
222 my $str = '';
223 foreach my $key (sort keys %{$hash}) {
224 $str .= '{' . $key . '=>{{' . join('},{', @{$hash->{$key}}) . '}}}';
225 }
226 return $str;
227}
228
229
230###############################################################################
231## Public
232###############################################################################
233
234
235## @function main(void) => void
236#
237sub main
238{
239 my $t0 = [gettimeofday()];
240 my $data1 = {'doh' => ['a deer, a female deer'],
241 'ray' => ['a drop of golden sun'],
242 'me' => ['a name I call myself'],
243 'far' => ['a long, long way to run']};
244 my $data2 = {'sew' => ['a needle pulling thread'],
245 'lah' => ['a note to follow doh'],
246 'tea' => ['a drink with jam and bread'],
247 'doh' => ['which brings us back to']};
248 $test_count = 0;
249 $pass_count = 0;
250 $skip_count = 0;
251 print "===== DBUtils Testing Suite =====\n";
252 print "For each driver specified, run a battery of tests\n";
253 my @drivers;
254 foreach my $arg (@ARGV) {
255 if ($arg =~ /^-+([a-z]+)(=.+)?$/) {
256 my $arg_name = $1;
257 my $arg_value = $2;
258 if ($arg_name eq 'debug') {
259 $debug = 1;
260 }
261 }
262 else {
263 push(@drivers, $arg);
264 }
265 }
266 if (scalar(@drivers)) {
267 # Ensure the Perl can load the drivers from all the typical places
268 &_addPathsToINC();
269 foreach my $driver_name (@drivers) {
270 my $t1 = [gettimeofday()];
271 print "=== Testing: " . $driver_name . " ===\n";
272 my $driver = _loadDBDriver($driver_name);
273 my $db_path = $driver->get_infodb_file_path('test-doc','/tmp/');
274 print " - Path: " . $db_path . "\n";
275 # 1. Open handle
276 my $db_handle = $driver->open_infodb_write_handle($db_path);
277 &_printTest('opening handle', (defined $db_handle));
278 # 2a. Write entry
279 $driver->write_infodb_entry($db_handle, 'Alpha', $data1);
280 &_printTest('writing entry', 1);
281 # 2b. Write raw entry
282 my $raw_data = $driver->convert_infodb_hash_to_string($data1);
283 $driver->write_infodb_rawentry($db_handle, 'Beta', $raw_data);
284 &_printTest('writing raw entry', 1);
285 # 3. Close handle
286 $driver->close_infodb_write_handle($db_handle);
287 if ($driver->supportsPersistentConnection()) {
288 $test_count += 1;
289 $skip_count += 1;
290 print " - Skipping test as persistent drivers delay 'close'.\n";
291 }
292 else {
293 &_printTest('closing handle', (tell($db_handle) < 1));
294 }
295 if (!$driver->writeOnly()) {
296 # 4a. Read entry
297 my $data3 = $driver->read_infodb_entry($db_path, 'Alpha');
298 &_printTest('read entry', &_compareHash($data1, $data3));
299 # 4b. Read raw entry
300 my $raw_data4 = $driver->read_infodb_rawentry($db_path, 'Beta');
301 my $data4 = $driver->convert_infodb_string_to_hash($raw_data4);
302 &_printTest('read raw entry', &_compareHash($data1, $data4));
303 # 5. Read keys
304 my $keys1 = {};
305 $driver->read_infodb_keys($db_path, $keys1);
306 &_printTest('read keys', (defined $keys1->{'Alpha'} && defined $keys1->{'Beta'}));
307 # 6. Set entry
308 if ($driver->supportsSet()) {
309 my $status = $driver->set_infodb_entry($db_path, 'Alpha', $data2);
310 &_printTest('set entry (1)', ($status >= 0));
311 my $data5 = $driver->read_infodb_entry($db_path, 'Alpha');
312 &_printTest('set entry (2)', &_compareHash($data2, $data5));
313 }
314 else {
315 $test_count += 2;
316 $skip_count += 2;
317 print " - Skipping 2 tests as 'set' is not supported by this driver.\n";
318 }
319 # 7. Delete entry
320 my $db_handle2 = $driver->open_infodb_write_handle($db_path, 'append');
321 $driver->delete_infodb_entry($db_handle2, 'Alpha');
322 $driver->close_infodb_write_handle($db_handle2);
323 my $keys2 = {};
324 $driver->read_infodb_keys($db_path, $keys2);
325 &_printTest('delete entry', ((!defined $keys2->{'Alpha'}) && (defined $keys2->{'Beta'})));
326 }
327 else
328 {
329 $test_count += 6;
330 $skip_count += 6;
331 print " - Skipping 6 tests as driver is write-only.\n";
332 }
333 # 8. Remove test db
334 unlink($db_path);
335 my $t2 = [gettimeofday()];
336 my $elapsed1 = tv_interval($t1, $t2);
337 print " - Testing took " . $elapsed1 . " seconds\n";
338 }
339 print "===== Results =====\n";
340 print "Drivers Tested: " . scalar(@drivers) . "\n";
341 print "Tests Run: " . $test_count . "\n";
342 print "Tests Passed: " . $pass_count . "\n";
343 print "Tests Failed: " . ($test_count - $pass_count - $skip_count) . "\n";
344 print "Tests Skipped: " . $skip_count . "\n";
345 }
346 else
347 {
348 print "Warning! No drivers specified - expected as arguments to call\n";
349 }
350 my $t3 = [gettimeofday()];
351 my $elapsed2 = tv_interval($t0, $t3);
352 print "===== Complete in " . $elapsed2 . " seconds =====\n";
353 print "\n";
354 exit(0);
355}
356## main(void) => void
357
358
359## @function close_infodb_write_handle(string, *) => void
360#
361sub close_infodb_write_handle
362{
363 my $infodb_type = shift(@_);
364 my $driver = _loadDBDriver($infodb_type);
365 $driver->close_infodb_write_handle(@_);
366}
367## close_infodb_write_handle(string, *) => void ##
368
369
370## @function delete_infodb_entry(string, *) => void
371#
372sub delete_infodb_entry
373{
374 my $infodb_type = shift(@_);
375 my $driver = _loadDBDriver($infodb_type);
376 $driver->delete_infodb_entry(@_);
377}
378## delete_infodb_entry(string, *) => void ##
379
380
381## @function mergeDatabases(string, *) => integer
382#
383sub mergeDatabases
384{
385 my $infodb_type = shift(@_);
386 my $driver = _loadDBDriver($infodb_type);
387 my $status = $driver->mergeDatabases(@_);
388 return $status;
389}
390## mergeDatabases(string, *) => integer ##
391
392
393## @function get_default_infodb_type(void) => string
394#
395sub get_default_infodb_type
396{
397 # The default is GDBM so everything works the same for existing collections
398 # To use something else, specify the "infodbtype" in the collection's collect.cfg file
399 return 'gdbm';
400}
401## get_default_infodb_type(void) => string ##
402
403
404## @function get_infodb_file_path(string, *) => string
405#
406sub get_infodb_file_path
407{
408 my $infodb_type = shift(@_);
409 my $driver = _loadDBDriver($infodb_type);
410 my $infodb_file_path = $driver->get_infodb_file_path(@_);
411 return $infodb_file_path;
412}
413## get_infodb_file_path(string, *) => string ##
414
415
416## @function convert_infodb_string_to_hash(string,hashmap) => string
417#
418sub convert_infodb_string_to_hash
419{
420 my $infodb_type = shift(@_);
421 my $driver = _loadDBDriver($infodb_type);
422 my $infodb_handle = $driver->convert_infodb_string_to_hash(@_);
423 return $infodb_handle;
424}
425## open_infodb_write_handle(string,hashmap) => string ##
426
427
428## @function open_infodb_write_handle(string, *) => filehandle
429#
430sub open_infodb_write_handle
431{
432 my $infodb_type = shift(@_);
433 my $driver = _loadDBDriver($infodb_type);
434 my $infodb_handle = $driver->open_infodb_write_handle(@_);
435 return $infodb_handle;
436}
437## open_infodb_write_handle(string, *) => filehandle ##
438
439
440## @function read_infodb_file(string, *) => void
441#
442sub read_infodb_file
443{
444 my $infodb_type = shift(@_);
445 my $driver = _loadDBDriver($infodb_type);
446 $driver->read_infodb_file(@_);
447}
448## read_infodb_file(string, *) => void ##
449
450
451## @function read_infodb_keys(string, *) => void
452#
453sub read_infodb_keys
454{
455 my $infodb_type = shift(@_);
456 my $driver = _loadDBDriver($infodb_type);
457 $driver->read_infodb_keys(@_);
458}
459## read_infodb_keys(string, *) => void ##
460
461
462## @function read_infodb_entry(string, *) => hashmap
463#
464sub read_infodb_entry
465{
466 my $infodb_type = shift(@_);
467 my $driver = _loadDBDriver($infodb_type);
468 my $infodb_entry = $driver->read_infodb_entry(@_);
469 return $infodb_entry;
470}
471## read_infodb_entry(string, *) => hashmap ##
472
473
474## @function read_infodb_rawentry(string, *) => string
475#
476sub read_infodb_rawentry
477{
478 my $infodb_type = shift(@_);
479 my $driver = _loadDBDriver($infodb_type);
480 my $raw_infodb_entry = $driver->read_infodb_rawentry(@_);
481 return $raw_infodb_entry;
482}
483## read_infodb_rawentry(string, *) => string ##
484
485
486## @function set_infodb_entry(string, *) => integer
487#
488sub set_infodb_entry
489{
490 my $infodb_type = shift(@_);
491 my $driver = _loadDBDriver($infodb_type);
492 my $status = $driver->set_infodb_entry(@_);
493 return $status;
494}
495## set_infodb_entry(string, *) => integer ##
496
497
498## @function supportDatestamp(string) => boolean
499#
500sub supportsDatestamp
501{
502 my $infodb_type = shift(@_);
503 my $driver = _loadDBDriver($infodb_type);
504 my $supports_datestamp = $driver->supportsDatestamp();
505 return $supports_datestamp;
506}
507## supportsDatestamp(string) => boolean ##
508
509
510## @function supportMerge(string) => boolean
511#
512sub supportsMerge
513{
514 my $infodb_type = shift(@_);
515 my $driver = _loadDBDriver($infodb_type);
516 my $supports_merge = $driver->supportsMerge();
517 return $supports_merge;
518}
519## supportsMerge(string) => boolean ##
520
521
522## @function supportRSS(string) => boolean
523#
524sub supportsRSS
525{
526 my $infodb_type = shift(@_);
527 my $driver = _loadDBDriver($infodb_type);
528 my $supports_rss = $driver->supportsRSS();
529 return $supports_rss;
530}
531## supportsRSS(string) => boolean ##
532
533
534## @function supportsConcurrentReadAndWrite(string) => boolean
535#
536sub supportsConcurrentReadAndWrite
537{
538 my $infodb_type = shift(@_);
539 my $driver = _loadDBDriver($infodb_type);
540 return $driver->supportsConcurrentReadAndWrite();
541}
542## supportsConcurrentReadAndWrite(string) => boolean ##
543
544
545## @function write_infodb_entry(string, *) => void
546#
547sub write_infodb_entry
548{
549 my $infodb_type = shift(@_);
550 my $driver = _loadDBDriver($infodb_type);
551 $driver->write_infodb_entry(@_);
552}
553## write_infodb_entry(string, *) => void ##
554
555
556## @function write_infodb_rawentry(string, *) => void
557#
558sub write_infodb_rawentry
559{
560 my $infodb_type = shift(@_);
561 my $driver = _loadDBDriver($infodb_type);
562 $driver->write_infodb_rawentry(@_);
563}
564## write_infodb_rawentry(string, *) => void ##
565
566## @function rename_db_file_to(string, string) => void
567#
568sub rename_db_file_to {
569 my $infodb_type = shift(@_);
570 my $driver = _loadDBDriver($infodb_type);
571 $driver->rename_db_file_to(@_);
572}
573## rename_db_file_to(string, string) => void ##
574
575## @function remove_db_file(string) => void
576#
577sub remove_db_file {
578 my $infodb_type = shift(@_);
579 my $driver = _loadDBDriver($infodb_type);
580 $driver->remove_db_file(@_);
581}
582## remove_db_file(string, string) => void ##
583
5841;
Note: See TracBrowser for help on using the repository browser.