source: gs2-extensions/tdb/trunk/perllib/dbutil.pm@ 30340

Last change on this file since 30340 was 30340, checked in by jmt12, 8 years ago

Minor changes to support drivers that don't support set_entry functionality
File size: 14.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 #if (!caller) {
40 # Ensure the INC includes the path to FileUtils.pm
41 unshift(@INC, $ENV{'GSDLHOME'} . '/perllib');
42
43 #}
44 require DBDrivers::GDBM;
45 my $driver = DBDrivers::GDBM->new(1);
46}
47
48# Libraries
49use Devel::Peek;
50use Time::HiRes qw ( gettimeofday tv_interval );
51use FileUtils;
52use gsprintf 'gsprintf';
53use util;
54
55# Modulino pattern
56__PACKAGE__->main unless caller;
57
58###############################################################################
59## Private
60###############################################################################
61
62## Display debug messages?
63my $debug = 0; # Set to 1 to display
64
65## Keep track of the driver objects we have initialised
66my $dbdriver_pool = {};
67
68# Testing globals
69my $test_count = 0;
70my $pass_count = 0;
71my $skip_count = 0;
72
73
74## @function _addPathsToINC(void) => void
75#
76# A hopefully unused function to ensure the INC path contains all the available
77# perllib directories (from main, collection, and extensions)
78#
79sub _addPathsToINC
80{
81 &_debugPrint('_addPathsToINC() => ', 0);
82 my @possible_paths;
83 #... the main perllib directory...
84 push(@possible_paths, &FileUtils::filenameConcatenate());
85 #... a collection specific perllib directory...
86 if (defined $ENV{'GSDLCOLLECTDIR'} && $ENV{'GSDLCOLLECTION'}) {
87 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, 'collect', $ENV{'GSDLCOLLECTION'}, 'perllib'));
88 }
89 #... any registered extension may also have a perllib!
90 if (defined $ENV{'GSDLEXTS'} && defined $ENV{'GSDLHOME'}) {
91 foreach my $gs2_extension (split(/:/, $ENV{'GSDLEXTS'})) {
92 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'ext', $gs2_extension, 'perllib'));
93 }
94 }
95 if (defined $ENV{'GSDL3EXTS'} && defined $ENV{'GSDL3SRCHOME'}) {
96 foreach my $gs3_extension (split(/:/, $ENV{'GSDL3EXTS'})) {
97 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, 'ext', $gs3_extension, 'perllib'));
98 }
99 }
100 my $path_counter = 0;
101 foreach my $possible_path (@possible_paths) {
102 # we only try adding paths that actually exist
103 if (-d $possible_path) {
104 my $did_add_path = &util::augmentINC($possible_path);
105 if ($did_add_path) {
106 $path_counter++;
107 }
108 }
109 }
110 &_debugPrint('Added ' . $path_counter . ' paths');
111}
112## _addPathsToINC(void) => void #
113
114
115## @function _debugPrint(string, boolean)
116#
117sub _debugPrint
118{
119 my ($message, $newline) = @_;
120 if ($debug) {
121 if (!defined($newline)) {
122 $newline = 1;
123 }
124 print STDERR '[DEBUG] dbutil::' . $message;
125 if ($newline) {
126 print STDERR "\n";
127 }
128 }
129}
130## _debugPrint(string, boolean) => void ##
131
132
133## @function _isDriverLoaded(string) => boolean
134#
135sub _isDriverLoaded
136{
137 my ($dbdriver_name) = @_;
138 (my $dbdriver_file = $dbdriver_name) =~ s/::/\//g;
139 $dbdriver_file .= '.pm';
140 my $result = defined($INC{$dbdriver_file});
141 &_debugPrint('_isDriverLoaded("' . $dbdriver_name . '") => ' . $result);
142 return $result;
143}
144## _isDriverLoaded(string) => boolean ##
145
146## @function _loadDBDriver(string, string)
147#
148sub _loadDBDriver
149{
150 my ($dbdriver_name, $db_filepath) = @_;
151 my $dbdriver;
152 # I've decided (arbitrarily) to use uppercase for driver names since they
153 # are mostly acronyms
154 $dbdriver_name = uc($dbdriver_name);
155 # Ensure the driver has the correct package prefix
156 if ($dbdriver_name !~ /^DBDrivers/) {
157 $dbdriver_name = 'DBDrivers::' . $dbdriver_name;
158 }
159 # We only need to create each driver once
160 if (defined($dbdriver_pool->{$dbdriver_name})) {
161 $dbdriver = $dbdriver_pool->{$dbdriver_name};
162 }
163 else {
164 &_debugPrint('_loadDBDriver() => ' . $dbdriver_name);
165 # Assuming the INC is correctly setup, then this should work nicely
166 # - make sure we have required this dbdriver package
167 eval "require $dbdriver_name";
168 if (&_isDriverLoaded($dbdriver_name)) {
169 $dbdriver_name->import();
170 }
171 # What should we do about drivers that aren't there?
172 else {
173 print STDERR "Error! Failed to load: " . $dbdriver_name . "\n";
174 }
175 # Then initialise and return a new one
176 $dbdriver = $dbdriver_name->new($debug);
177 # Store it for later use
178 $dbdriver_pool->{$dbdriver_name} = $dbdriver;
179 }
180 return $dbdriver;
181}
182## _loadDBDriver(string, string) => BaseDBDriver ##
183
184
185## @function _printTest(string, integer) => void
186#
187sub _printTest
188{
189 my $title = shift(@_);
190 my $result = shift(@_);
191 $test_count++;
192 print " - Test: " . $title . "... ";
193 if ($result) {
194 print "Passed\n";
195 $pass_count++;
196 }
197 else {
198 print "Failed\n";
199 }
200}
201## _printTest(string, integer) => void ##
202
203
204sub _compareHash
205{
206 my $hash1 = shift(@_);
207 my $hash2 = shift(@_);
208 my $str1 = &_hash2str($hash1);
209 my $str2 = &_hash2str($hash2);
210 return ($str1 eq $str2);
211}
212
213sub _hash2str
214{
215 my $hash = shift(@_);
216 my $str = '';
217 foreach my $key (sort keys %{$hash}) {
218 $str .= '{' . $key . '=>{{' . join('},{', @{$hash->{$key}}) . '}}}';
219 }
220 return $str;
221}
222
223
224###############################################################################
225## Public
226###############################################################################
227
228
229## @function main(void) => void
230#
231sub main
232{
233 my $t0 = [gettimeofday()];
234 my $data1 = {'doh' => ['a deer, a female deer'],
235 'ray' => ['a drop of golden sun'],
236 'me' => ['a name I call myself'],
237 'far' => ['a long, long way to run']};
238 my $data2 = {'sew' => ['a needle pulling thread'],
239 'lah' => ['a note to follow doh'],
240 'tea' => ['a drink with jam and bread'],
241 'doh' => ['which brings us back to']};
242 print "===== DBUtils Testing Suite =====\n";
243 print "For each driver specified, run a battery of tests\n";
244 my @drivers;
245 foreach my $arg (@ARGV) {
246 if ($arg =~ /^-+([a-z]+)(=.+)?$/) {
247 my $arg_name = $1;
248 my $arg_value = $2;
249 if ($arg_name eq 'debug') {
250 $debug = 1;
251 }
252 }
253 else {
254 push(@drivers, $arg);
255 }
256 }
257 if (scalar(@drivers)) {
258 # Ensure the Perl can load the drivers from all the typical places
259 &_addPathsToINC();
260 foreach my $driver_name (@drivers) {
261 print "* Testing: " . $driver_name . "\n";
262 my $driver = _loadDBDriver($driver_name);
263 my $db_path = $driver->get_infodb_file_path('test','/tmp/');
264 print " - Path: " . $db_path . "\n";
265 # 1. Open handle
266 my $db_handle = $driver->open_infodb_write_handle($db_path);
267 &_printTest('opening handle', (defined $db_handle));
268 # 2a. Write entry
269 $driver->write_infodb_entry($db_handle, 'Alpha', $data1);
270 &_printTest('writing entry', 1);
271 # 2b. Write raw entry
272 my $raw_data = $driver->convert_infodb_hash_to_string($data1);
273 $driver->write_infodb_rawentry($db_handle, 'Beta', $raw_data);
274 &_printTest('writing raw entry', 1);
275 # 3. Close handle
276 $driver->close_infodb_handle($db_handle);
277 &_printTest('closing handle', (tell($db_handle) < 1));
278 # 4a. Read entry
279 my $data3 = $driver->read_infodb_entry($db_path, 'Alpha');
280 &_printTest('read entry', &_compareHash($data1, $data3));
281 # 4b. Read raw entry
282 my $raw_data4 = $driver->read_infodb_rawentry($db_path, 'Beta');
283 my $data4 = $driver->convert_infodb_string_to_hash($raw_data4);
284 &_printTest('read raw entry', &_compareHash($data1, $data4));
285 # 5. Read keys
286 my $keys1 = {};
287 $driver->read_infodb_keys($db_path, $keys1);
288 &_printTest('read keys', (defined $keys1->{'Alpha'} && defined $keys1->{'Beta'}));
289 # 6. Set entry
290 if ($driver->supportsSet()) {
291 my $status = $driver->set_infodb_entry($db_path, 'Alpha', $data2);
292 &_printTest('set entry (1)', ($status >= 0));
293 my $data5 = $driver->read_infodb_entry($db_path, 'Alpha');
294 &_printTest('set entry (2)', &_compareHash($data2, $data5));
295 }
296 else {
297 $test_count += 2;
298 $skip_count += 2;
299 print " - Skipping 2 tests as 'set' is not supported by this driver.\n";
300 }
301 # 7. Delete entry
302 my $db_handle2 = $driver->open_infodb_write_handle($db_path, 'append');
303 $driver->delete_infodb_entry($db_handle2, 'Alpha');
304 $driver->close_infodb_handle($db_handle2);
305 my $keys2 = {};
306 $driver->read_infodb_keys($db_path, $keys2);
307 &_printTest('delete entry', ((!defined $keys2->{'Alpha'}) && (defined $keys2->{'Beta'})));
308 # 8. Remove test db
309 #unlink($db_path);
310 }
311 print "===== Results =====\n";
312 print "Drivers Tested: " . scalar(@drivers) . "\n";
313 print "Tests Run: " . $test_count . "\n";
314 print "Tests Passed: " . $pass_count . "\n";
315 print "Tests Failed: " . ($test_count - $pass_count - $skip_count) . "\n";
316 print "Tests Skipped: " . $skip_count . "\n";
317 }
318 else
319 {
320 print "Warning! No drivers specified - expected as arguments to call\n";
321 }
322 my $t1 = [gettimeofday()];
323 my $elapsed = tv_interval($t0, $t1);
324 print "===== Complete in " . $elapsed . " seconds =====\n";
325 print "\n";
326 exit(0);
327}
328## main(void) => void
329
330
331## @function close_infodb_write_handle(string, *) => void
332#
333sub close_infodb_write_handle
334{
335 my $infodb_type = shift(@_);
336 my $driver = _loadDBDriver($infodb_type);
337 $driver->close_infodb_write_handle(@_);
338}
339## close_infodb_write_handle(string, *) => void ##
340
341
342## @function delete_infodb_entry(string, *) => void
343#
344sub delete_infodb_entry
345{
346 my $infodb_type = shift(@_);
347 my $driver = _loadDBDriver($infodb_type);
348 $driver->delete_infodb_entry(@_);
349}
350## delete_infodb_entry(string, *) => void ##
351
352
353## @function mergeDatabases(string, *) => integer
354#
355sub mergeDatabases
356{
357 my $infodb_type = shift(@_);
358 my $driver = _loadDBDriver($infodb_type);
359 my $status = $driver->mergeDatabases(@_);
360 return $status;
361}
362## mergeDatabases(string, *) => integer ##
363
364
365## @function get_default_infodb_type(void) => string
366#
367sub get_default_infodb_type
368{
369 # The default is GDBM so everything works the same for existing collections
370 # To use something else, specify the "infodbtype" in the collection's collect.cfg file
371 return 'gdbm';
372}
373## get_default_infodb_type(void) => string ##
374
375
376## @function get_infodb_file_path(string, *) => string
377#
378sub get_infodb_file_path
379{
380 my $infodb_type = shift(@_);
381 my $driver = _loadDBDriver($infodb_type);
382 my $infodb_file_path = $driver->get_infodb_file_path(@_);
383 return $infodb_file_path;
384}
385## get_infodb_file_path(string, *) => string ##
386
387
388## @function open_infodb_write_handle(string, *) => filehandle
389#
390sub open_infodb_write_handle
391{
392 my $infodb_type = shift(@_);
393 my $driver = _loadDBDriver($infodb_type);
394 my $infodb_handle = $driver->open_infodb_write_handle(@_);
395 return $infodb_handle;
396}
397## open_infodb_write_handle(string, *) => filehandle ##
398
399
400## @function read_infodb_file(string, *) => void
401#
402sub read_infodb_file
403{
404 my $infodb_type = shift(@_);
405 my $driver = _loadDBDriver($infodb_type);
406 $driver->read_infodb_file(@_);
407}
408## read_infodb_file(string, *) => void ##
409
410
411## @function read_infodb_keys(string, *) => void
412#
413sub read_infodb_keys
414{
415 my $infodb_type = shift(@_);
416 my $driver = _loadDBDriver($infodb_type);
417 $driver->read_infodb_keys(@_);
418}
419## read_infodb_keys(string, *) => void ##
420
421
422## @function read_infodb_entry(string, *) => hashmap
423#
424sub read_infodb_entry
425{
426 my $infodb_type = shift(@_);
427 my $driver = _loadDBDriver($infodb_type);
428 my $infodb_entry = $driver->read_infodb_entry(@_);
429 return $infodb_entry;
430}
431## read_infodb_entry(string, *) => hashmap ##
432
433
434## @function read_infodb_rawentry(string, *) => string
435#
436sub read_infodb_rawentry
437{
438 my $infodb_type = shift(@_);
439 my $driver = _loadDBDriver($infodb_type);
440 my $raw_infodb_entry = $driver->read_infodb_rawentry(@_);
441 return $raw_infodb_entry;
442}
443## read_infodb_rawentry(string, *) => string ##
444
445
446## @function set_infodb_entry(string, *) => integer
447#
448sub set_infodb_entry
449{
450 my $infodb_type = shift(@_);
451 my $driver = _loadDBDriver($infodb_type);
452 my $status = $driver->set_infodb_entry(@_);
453 return $status;
454}
455## set_infodb_entry(string, *) => integer ##
456
457
458## @function supportDatestamp(string) => boolean
459#
460sub supportsDatestamp
461{
462 my $infodb_type = shift(@_);
463 my $driver = _loadDBDriver($infodb_type);
464 my $supports_datestamp = $driver->supportsDatestamp();
465 return $supports_datestamp;
466}
467## supportsDatestamp(string) => boolean ##
468
469
470## @function supportMerge(string) => boolean
471#
472sub supportsMerge
473{
474 my $infodb_type = shift(@_);
475 my $driver = _loadDBDriver($infodb_type);
476 my $supports_merge = $driver->supportsMerge();
477 return $supports_merge;
478}
479## supportsMerge(string) => boolean ##
480
481
482## @function supportRSS(string) => boolean
483#
484sub supportsRSS
485{
486 my $infodb_type = shift(@_);
487 my $driver = _loadDBDriver($infodb_type);
488 my $supports_rss = $driver->supportsRSS();
489 return $supports_rss;
490}
491## supportsRSS(string) => boolean ##
492
493
494## @function write_infodb_entry(string, *) => void
495#
496sub write_infodb_entry
497{
498 my $infodb_type = shift(@_);
499 my $driver = _loadDBDriver($infodb_type);
500 $driver->write_infodb_entry(@_);
501}
502## write_infodb_entry(string, *) => void ##
503
504
505## @function write_infodb_rawentry(string, *) => void
506#
507sub write_infodb_rawentry
508{
509 my $infodb_type = shift(@_);
510 my $driver = _loadDBDriver($infodb_type);
511 $driver->write_infodb_rawentry(@_);
512}
513## write_infodb_rawentry(string, *) => void ##
514
5151;
Note: See TracBrowser for help on using the repository browser.