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

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

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