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

Last change on this file since 30347 was 30347, checked in by jmt12, 5 years ago

Continuing to refactor driver code to move shared code up to parent classes. Have all the basic drivers done...

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