############################################################################### # # dbutil.pm -- functions to handle using dbdrivers # # Copyright (C) 2015 New Zealand Digital Library Project # # A component of the Greenstone digital library software from the New Zealand # Digital Library Project at the University of Waikato, New Zealand. # # This program is free software; you can redistribute it and/or modify it under # the terms of the GNU General Public License as published by the Free Software # Foundation; either version 2 of the License, or (at your option) any later # version. # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more # details. # # You should have received a copy of the GNU General Public License along with # this program; if not, write to the Free Software Foundation, Inc., 675 Mass # Ave, Cambridge, MA 02139, USA. # ############################################################################### package dbutil; # Pragma use strict; # DEBUGGING: You can enable a DBDriver one at a time to ensure they don't have # compilation errors. BEGIN { if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) { die("Error! Environment not prepared. Have you sourced setup.bash?\n"); } # Are we running standalone? In which case the INC won't be correct #if (!caller) { # Ensure the INC includes the path to FileUtils.pm unshift(@INC, $ENV{'GSDLHOME'} . '/perllib'); #} require DBDrivers::GDBM; my $driver = DBDrivers::GDBM->new(1); } # Libraries use Devel::Peek; use Time::HiRes qw ( gettimeofday tv_interval ); use FileUtils; use gsprintf 'gsprintf'; use util; # Modulino pattern __PACKAGE__->main unless caller; ############################################################################### ## Private ############################################################################### ## Display debug messages? my $debug = 0; # Set to 1 to display ## Keep track of the driver objects we have initialised my $dbdriver_pool = {}; # Testing globals my $test_count = 0; my $pass_count = 0; my $skip_count = 0; ## @function _addPathsToINC(void) => void # # A hopefully unused function to ensure the INC path contains all the available # perllib directories (from main, collection, and extensions) # sub _addPathsToINC { &_debugPrint('_addPathsToINC() => ', 0); my @possible_paths; #... the main perllib directory... push(@possible_paths, &FileUtils::filenameConcatenate()); #... a collection specific perllib directory... if (defined $ENV{'GSDLCOLLECTDIR'} && $ENV{'GSDLCOLLECTION'}) { push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, 'collect', $ENV{'GSDLCOLLECTION'}, 'perllib')); } #... any registered extension may also have a perllib! if (defined $ENV{'GSDLEXTS'} && defined $ENV{'GSDLHOME'}) { foreach my $gs2_extension (split(/:/, $ENV{'GSDLEXTS'})) { push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'ext', $gs2_extension, 'perllib')); } } if (defined $ENV{'GSDL3EXTS'} && defined $ENV{'GSDL3SRCHOME'}) { foreach my $gs3_extension (split(/:/, $ENV{'GSDL3EXTS'})) { push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, 'ext', $gs3_extension, 'perllib')); } } my $path_counter = 0; foreach my $possible_path (@possible_paths) { # we only try adding paths that actually exist if (-d $possible_path) { my $did_add_path = &util::augmentINC($possible_path); if ($did_add_path) { $path_counter++; } } } &_debugPrint('Added ' . $path_counter . ' paths'); } ## _addPathsToINC(void) => void # ## @function _debugPrint(string, boolean) # sub _debugPrint { my ($message, $newline) = @_; if ($debug) { if (!defined($newline)) { $newline = 1; } print STDERR '[DEBUG] dbutil::' . $message; if ($newline) { print STDERR "\n"; } } } ## _debugPrint(string, boolean) => void ## ## @function _isDriverLoaded(string) => boolean # sub _isDriverLoaded { my ($dbdriver_name) = @_; (my $dbdriver_file = $dbdriver_name) =~ s/::/\//g; $dbdriver_file .= '.pm'; my $result = defined($INC{$dbdriver_file}); &_debugPrint('_isDriverLoaded("' . $dbdriver_name . '") => ' . $result); return $result; } ## _isDriverLoaded(string) => boolean ## ## @function _loadDBDriver(string, string) # sub _loadDBDriver { my ($dbdriver_name, $db_filepath) = @_; my $dbdriver; # I've decided (arbitrarily) to use uppercase for driver names since they # are mostly acronyms $dbdriver_name = uc($dbdriver_name); # Ensure the driver has the correct package prefix if ($dbdriver_name !~ /^DBDrivers/) { $dbdriver_name = 'DBDrivers::' . $dbdriver_name; } # We only need to create each driver once if (defined($dbdriver_pool->{$dbdriver_name})) { $dbdriver = $dbdriver_pool->{$dbdriver_name}; } else { &_debugPrint('_loadDBDriver() => ' . $dbdriver_name); # Assuming the INC is correctly setup, then this should work nicely # - make sure we have required this dbdriver package eval "require $dbdriver_name"; if (&_isDriverLoaded($dbdriver_name)) { $dbdriver_name->import(); } # What should we do about drivers that aren't there? else { print STDERR "Error! Failed to load: " . $dbdriver_name . "\n"; } # Then initialise and return a new one $dbdriver = $dbdriver_name->new($debug); # Store it for later use $dbdriver_pool->{$dbdriver_name} = $dbdriver; } return $dbdriver; } ## _loadDBDriver(string, string) => BaseDBDriver ## ## @function _printTest(string, integer) => void # sub _printTest { my $title = shift(@_); my $result = shift(@_); $test_count++; print " - Test: " . $title . "... "; if ($result) { print "Passed\n"; $pass_count++; } else { print "Failed\n"; } } ## _printTest(string, integer) => void ## sub _compareHash { my $hash1 = shift(@_); my $hash2 = shift(@_); my $str1 = &_hash2str($hash1); my $str2 = &_hash2str($hash2); return ($str1 eq $str2); } sub _hash2str { my $hash = shift(@_); my $str = ''; foreach my $key (sort keys %{$hash}) { $str .= '{' . $key . '=>{{' . join('},{', @{$hash->{$key}}) . '}}}'; } return $str; } ############################################################################### ## Public ############################################################################### ## @function main(void) => void # sub main { my $t0 = [gettimeofday()]; my $data1 = {'doh' => ['a deer, a female deer'], 'ray' => ['a drop of golden sun'], 'me' => ['a name I call myself'], 'far' => ['a long, long way to run']}; my $data2 = {'sew' => ['a needle pulling thread'], 'lah' => ['a note to follow doh'], 'tea' => ['a drink with jam and bread'], 'doh' => ['which brings us back to']}; print "===== DBUtils Testing Suite =====\n"; print "For each driver specified, run a battery of tests\n"; my @drivers; foreach my $arg (@ARGV) { if ($arg =~ /^-+([a-z]+)(=.+)?$/) { my $arg_name = $1; my $arg_value = $2; if ($arg_name eq 'debug') { $debug = 1; } } else { push(@drivers, $arg); } } if (scalar(@drivers)) { # Ensure the Perl can load the drivers from all the typical places &_addPathsToINC(); foreach my $driver_name (@drivers) { print "* Testing: " . $driver_name . "\n"; my $driver = _loadDBDriver($driver_name); my $db_path = $driver->get_infodb_file_path('test','/tmp/'); print " - Path: " . $db_path . "\n"; # 1. Open handle my $db_handle = $driver->open_infodb_write_handle($db_path); &_printTest('opening handle', (defined $db_handle)); # 2a. Write entry $driver->write_infodb_entry($db_handle, 'Alpha', $data1); &_printTest('writing entry', 1); # 2b. Write raw entry my $raw_data = $driver->convert_infodb_hash_to_string($data1); $driver->write_infodb_rawentry($db_handle, 'Beta', $raw_data); &_printTest('writing raw entry', 1); # 3. Close handle $driver->close_infodb_handle($db_handle); &_printTest('closing handle', (tell($db_handle) < 1)); # 4a. Read entry my $data3 = $driver->read_infodb_entry($db_path, 'Alpha'); &_printTest('read entry', &_compareHash($data1, $data3)); # 4b. Read raw entry my $raw_data4 = $driver->read_infodb_rawentry($db_path, 'Beta'); my $data4 = $driver->convert_infodb_string_to_hash($raw_data4); &_printTest('read raw entry', &_compareHash($data1, $data4)); # 5. Read keys my $keys1 = {}; $driver->read_infodb_keys($db_path, $keys1); &_printTest('read keys', (defined $keys1->{'Alpha'} && defined $keys1->{'Beta'})); # 6. Set entry if ($driver->supportsSet()) { my $status = $driver->set_infodb_entry($db_path, 'Alpha', $data2); &_printTest('set entry (1)', ($status >= 0)); my $data5 = $driver->read_infodb_entry($db_path, 'Alpha'); &_printTest('set entry (2)', &_compareHash($data2, $data5)); } else { $test_count += 2; $skip_count += 2; print " - Skipping 2 tests as 'set' is not supported by this driver.\n"; } # 7. Delete entry my $db_handle2 = $driver->open_infodb_write_handle($db_path, 'append'); $driver->delete_infodb_entry($db_handle2, 'Alpha'); $driver->close_infodb_handle($db_handle2); my $keys2 = {}; $driver->read_infodb_keys($db_path, $keys2); &_printTest('delete entry', ((!defined $keys2->{'Alpha'}) && (defined $keys2->{'Beta'}))); # 8. Remove test db #unlink($db_path); } print "===== Results =====\n"; print "Drivers Tested: " . scalar(@drivers) . "\n"; print "Tests Run: " . $test_count . "\n"; print "Tests Passed: " . $pass_count . "\n"; print "Tests Failed: " . ($test_count - $pass_count - $skip_count) . "\n"; print "Tests Skipped: " . $skip_count . "\n"; } else { print "Warning! No drivers specified - expected as arguments to call\n"; } my $t1 = [gettimeofday()]; my $elapsed = tv_interval($t0, $t1); print "===== Complete in " . $elapsed . " seconds =====\n"; print "\n"; exit(0); } ## main(void) => void ## @function close_infodb_write_handle(string, *) => void # sub close_infodb_write_handle { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); $driver->close_infodb_write_handle(@_); } ## close_infodb_write_handle(string, *) => void ## ## @function delete_infodb_entry(string, *) => void # sub delete_infodb_entry { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); $driver->delete_infodb_entry(@_); } ## delete_infodb_entry(string, *) => void ## ## @function mergeDatabases(string, *) => integer # sub mergeDatabases { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $status = $driver->mergeDatabases(@_); return $status; } ## mergeDatabases(string, *) => integer ## ## @function get_default_infodb_type(void) => string # sub get_default_infodb_type { # The default is GDBM so everything works the same for existing collections # To use something else, specify the "infodbtype" in the collection's collect.cfg file return 'gdbm'; } ## get_default_infodb_type(void) => string ## ## @function get_infodb_file_path(string, *) => string # sub get_infodb_file_path { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $infodb_file_path = $driver->get_infodb_file_path(@_); return $infodb_file_path; } ## get_infodb_file_path(string, *) => string ## ## @function open_infodb_write_handle(string, *) => filehandle # sub open_infodb_write_handle { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $infodb_handle = $driver->open_infodb_write_handle(@_); return $infodb_handle; } ## open_infodb_write_handle(string, *) => filehandle ## ## @function read_infodb_file(string, *) => void # sub read_infodb_file { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); $driver->read_infodb_file(@_); } ## read_infodb_file(string, *) => void ## ## @function read_infodb_keys(string, *) => void # sub read_infodb_keys { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); $driver->read_infodb_keys(@_); } ## read_infodb_keys(string, *) => void ## ## @function read_infodb_entry(string, *) => hashmap # sub read_infodb_entry { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $infodb_entry = $driver->read_infodb_entry(@_); return $infodb_entry; } ## read_infodb_entry(string, *) => hashmap ## ## @function read_infodb_rawentry(string, *) => string # sub read_infodb_rawentry { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $raw_infodb_entry = $driver->read_infodb_rawentry(@_); return $raw_infodb_entry; } ## read_infodb_rawentry(string, *) => string ## ## @function set_infodb_entry(string, *) => integer # sub set_infodb_entry { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $status = $driver->set_infodb_entry(@_); return $status; } ## set_infodb_entry(string, *) => integer ## ## @function supportDatestamp(string) => boolean # sub supportsDatestamp { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $supports_datestamp = $driver->supportsDatestamp(); return $supports_datestamp; } ## supportsDatestamp(string) => boolean ## ## @function supportMerge(string) => boolean # sub supportsMerge { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $supports_merge = $driver->supportsMerge(); return $supports_merge; } ## supportsMerge(string) => boolean ## ## @function supportRSS(string) => boolean # sub supportsRSS { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); my $supports_rss = $driver->supportsRSS(); return $supports_rss; } ## supportsRSS(string) => boolean ## ## @function write_infodb_entry(string, *) => void # sub write_infodb_entry { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); $driver->write_infodb_entry(@_); } ## write_infodb_entry(string, *) => void ## ## @function write_infodb_rawentry(string, *) => void # sub write_infodb_rawentry { my $infodb_type = shift(@_); my $driver = _loadDBDriver($infodb_type); $driver->write_infodb_rawentry(@_); } ## write_infodb_rawentry(string, *) => void ## 1;