Changeset 30335
- Timestamp:
- 2015-12-03T15:41:56+13:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
gs2-extensions/tdb/trunk/perllib/dbutil.pm
r29316 r30335 1 ########################################################################### 2 # 3 # dbutil.pm -- gateway to utilities for reading/writing to different databases 4 # 5 # Copyright (C) 2008 DL Consulting Ltd 6 # 7 # A component of the Greenstone digital library software 8 # from the New Zealand Digital Library Project at the 9 # University of Waikato, New Zealand. 10 # 11 # This program is free software; you can redistribute it and/or modify 12 # it under the terms of the GNU General Public License as published by 13 # the Free Software Foundation; either version 2 of the License, or 14 # (at your option) any later version. 15 # 16 # This program is distributed in the hope that it will be useful, 17 # but WITHOUT ANY WARRANTY; without even the implied warranty of 18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 # GNU General Public License for more details. 20 # 21 # You should have received a copy of the GNU General Public License 22 # along with this program; if not, write to the Free Software 23 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 24 # 25 ########################################################################### 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 ############################################################################### 26 25 27 26 package dbutil; 28 27 28 # Pragma 29 29 use strict; 30 30 31 use Symbol qw<qualify>; 31 # DEBUGGING: You can enable a DBDriver one at a time to ensure they don't have 32 # compilation errors. 33 BEGIN 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 49 use Devel::Peek; 50 use Time::HiRes qw ( gettimeofday tv_interval ); 51 use FileUtils; 52 use gsprintf 'gsprintf'; 32 53 use util; 33 54 34 # /** Dynamic class loading - for use in DBUtils to load various database 35 # * drivers, configured in the collect.cfg, at runtime. 36 # * @param $class - The class name (including any path) to load 37 # * @param rest - any function aliases you want exported 38 # */ 39 sub load_db_driver 40 { 41 my $class = shift(@_); 42 (my $file = "$class.pm") =~ s|::|/|g; 43 # - ensure we haven't already loaded this class 44 unless( $INC{$file} ) 45 { 46 # - require is fine being assigned at runtime - no need for evil eval 47 #eval 48 #{ 49 require $file; 50 #}; 51 } 52 # - this is the magic that actually instantiates the class (rubberstamp?) 53 # - we pass @_ to action any function aliases exports requested 54 eval 55 { 56 $class->import(@_); 57 }; 58 # - by now the driver file should have been loaded 59 return (defined $INC{$file}); 60 } 61 # /** load_db_driver() **/ 62 63 # /** Make a function call to a dynamically loaded database driver. 64 # * @param $function_name 65 # * @param $driver_name 66 # * @param <rest> The parameters to be passed to the function called 67 # */ 68 sub call_dynamic_driver_function 69 { 70 my $function_name = shift(@_); 71 my $driver_name = shift(@_); 72 my $package_name = 'dbutil::' . $driver_name; 73 # - try to load the requested infodb type 74 if (!&load_db_driver($package_name)) 75 { 76 # - try loading the default GDBM driver 77 print STDERR 'Warning! Using default database driver (GDBM) as failed to load configured database driver: ' . $driver_name . "\n"; 78 $package_name = 'dbutil::gdbm'; 79 if (!&load_db_driver($package_name)) 55 # Modulino pattern 56 __PACKAGE__->main unless caller; 57 58 ############################################################################### 59 ## Private 60 ############################################################################### 61 62 ## Display debug messages? 63 my $debug = 0; # Set to 1 to display 64 65 ## Keep track of the driver objects we have initialised 66 my $dbdriver_pool = {}; 67 68 # Testing globals 69 my $test_count = 0; 70 my $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 # 78 sub _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 # 116 sub _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 # 134 sub _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 # 147 sub _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 # 186 sub _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 203 sub _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 212 sub _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 # 230 sub 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 80 310 { 81 die("Fatal Error! Failed to load default database driver: dbutil::gdbm\n"); 82 } 83 } 84 # - make call to the newly created package 85 no strict; 86 # - lets check that the function we are about to call 87 my $symbol = qualify($function_name, $package_name); 88 unless ( defined &{$symbol} ) 89 { 90 die ('Error! Function not found: ' . $package_name . '::' . $function_name . "()\n"); 91 } 92 return &{$symbol}(@_); 93 } 94 # /** call_dynamic_driver_function() **/ 95 96 97 ## @function test_dynamic_driver_function() 98 # 99 # Checks to see if a function in a dynamically loaded driver exists 100 # 101 sub test_dynamic_driver_function 102 { 103 my $function_name = shift(@_); 104 my $driver_name = shift(@_); 105 my $package_name = 'dbutil::' . $driver_name; 106 # - try to load the requested infodb type 107 if (!&load_db_driver($package_name)) 108 { 109 # - try loading the default GDBM driver 110 print STDERR 'Warning! Using default database driver (GDBM) as failed to load configured database driver: ' . $driver_name . "\n"; 111 $package_name = 'dbutil::gdbm'; 112 if (!&load_db_driver($package_name)) 113 { 114 die("Fatal Error! Failed to load default database driver: dbutil::gdbm\n"); 115 } 116 } 117 # - make call to the newly created package 118 no strict; 119 # - lets check that the function we are about to call 120 my $symbol = qualify($function_name, $package_name); 121 return defined &{$symbol}; 122 } 123 ## test_dynamic_driver_function() ## 124 125 126 ## @function 127 # 128 sub open_infodb_write_handle 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 # 324 sub close_infodb_write_handle 129 325 { 130 326 my $infodb_type = shift(@_); 131 my $infodb_file_path = shift(@_); 132 # Make a call to the dynamically loaded driver to open the connection. 133 return &dbutil::call_dynamic_driver_function('open_infodb_write_handle', $infodb_type, $infodb_file_path, @_); 134 } 135 136 137 sub close_infodb_write_handle 138 { 139 my $infodb_type = shift(@_); 140 my $infodb_handle = shift(@_); 141 # Dynamic database driver call 142 return &dbutil::call_dynamic_driver_function('close_infodb_write_handle', $infodb_type, $infodb_handle, @_); 143 } 144 145 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 # 335 sub 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 # 346 sub 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 # 146 358 sub get_default_infodb_type 147 359 { 148 360 # The default is GDBM so everything works the same for existing collections 149 361 # To use something else, specify the "infodbtype" in the collection's collect.cfg file 150 return "gdbm"; 151 } 152 153 # /** @function get_infodb_file_path() 154 # * Warning! Black magic follows. The first time get_infodb_file_path is 155 # * called (presumably from inexport::process_files()) for databases of type 156 # * server will actually the Server to be run complete with an initial dummy 157 # * listener. This is done so that, in parallel importing, the server will 158 # * persist until the top level import.pl (which will be the first that calls 159 # * this function) completes and removes the dummy listener. [jmt12] 362 return 'gdbm'; 363 } 364 ## get_default_infodb_type(void) => string ## 365 366 367 ## @function get_infodb_file_path(string, *) => string 368 # 160 369 sub get_infodb_file_path 161 370 { 162 my $infodb_type = shift(@_); 163 my $collection_name = shift(@_); 164 my $infodb_directory_path = shift(@_); 165 166 #=======================================MSSQL SUPPORT==============================================# 167 # Updated by Jeffrey (2008/08/25 Monday) 168 # After look into the run-time code, it seems we should still create a database file. 169 # Since the run-time code is always try to read a database file, the easiest way here is not 170 # to change the whole structure, but to give whatever the system is looking for. 171 #==================================================================================================# 172 # Added by Jeffrey (2008/08/15 Friday) 173 # No file path required for MS SQL, it is a server-client connection. 174 # At the moment the information is hard coded in dbutil::mssql::open_infodb_write_handle 175 # the this might need some tidy up sometime. 176 #==================================================================================================# 177 178 return &dbutil::call_dynamic_driver_function('get_infodb_file_path', $infodb_type, $collection_name, $infodb_directory_path, @_); 179 } 180 181 # This function, conceptually, would be better structured if it didn't 182 # use return statements, as the database methods it calls do not 183 # themselves return anything. 184 # Note: if doing this, then the GDBM lines of code should be moved into 185 # an 'else' clause 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 # 381 sub 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 # 186 393 sub read_infodb_file 187 394 { 188 my $infodb_type = shift(@_); 189 my $infodb_file_path = shift(@_); 190 my $infodb_map = shift(@_); 191 192 return &dbutil::call_dynamic_driver_function('read_infodb_file', $infodb_type, $infodb_file_path, $infodb_map, @_); 193 } 194 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 # 195 404 sub read_infodb_keys 196 405 { 197 406 my $infodb_type = shift(@_); 198 my $infodb_file_path = shift(@_); 199 my $infodb_map = shift(@_); 200 201 return &dbutil::call_dynamic_driver_function('read_infodb_keys', $infodb_type, $infodb_file_path, $infodb_map, @_); 202 } 203 204 205 ## @function supportDatestamp 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 # 415 sub 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 # 427 sub 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 # 439 sub 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 206 450 # 207 451 sub supportsDatestamp 208 452 { 209 my $infodb_type = shift(@_); 210 return &dbutil::test_dynamic_driver_function('supportsDatestamp', $infodb_type); 211 } 212 ## supportsDatestamp() ## 213 214 215 ## @function supportsMerge 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 216 462 # 217 463 sub supportsMerge 218 464 { 219 my $infodb_type = shift(@_); 220 return &dbutil::test_dynamic_driver_function('merge_databases', $infodb_type); 221 } 222 ## supportsMerge() ## 223 224 225 ## @function supportRSS 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 226 474 # 227 475 sub supportsRSS 228 476 { 229 my $infodb_type = shift(@_); 230 return &dbutil::test_dynamic_driver_function('supportsRSS', $infodb_type); 231 } 232 ## supportsRSS() ## 233 234 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 # 235 487 sub write_infodb_entry 236 488 { 237 my $infodb_type = shift(@_);238 my $infodb_handle = shift(@_);239 my $infodb_key = shift(@_);240 my $infodb_map = shift(@_); 241 242 return &dbutil::call_dynamic_driver_function('write_infodb_entry', $infodb_type, $infodb_handle, $infodb_key, $infodb_map, @_); 243 } 244 245 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 # 246 498 sub write_infodb_rawentry 247 499 { 248 my $infodb_type = shift(@_); 249 my $infodb_handle = shift(@_); 250 my $infodb_key = shift(@_); 251 my $infodb_val = shift(@_); 252 253 return &dbutil::call_dynamic_driver_function('write_infodb_rawentry', $infodb_type, $infodb_handle, $infodb_key, $infodb_val, @_); 254 } 255 256 257 sub set_infodb_entry 258 { 259 my $infodb_type = shift(@_); 260 my $infodb_file_path = shift(@_); 261 my $infodb_key = shift(@_); 262 my $infodb_map = shift(@_); 263 264 return &dbutil::call_dynamic_driver_function('set_infodb_entry', $infodb_type, $infodb_file_path, $infodb_key, $infodb_map, @_); 265 } 266 267 268 269 sub delete_infodb_entry 270 { 271 my $infodb_type = shift(@_); 272 my $infodb_handle = shift(@_); 273 my $infodb_key = shift(@_); 274 275 return &dbutil::call_dynamic_driver_function('delete_infodb_entry', $infodb_type, $infodb_handle, $infodb_key, @_); 276 } 277 278 sub read_infodb_rawentry 279 { 280 my $infodb_type = shift(@_); 281 my $infodb_file_path = shift(@_); 282 my $infodb_key = shift(@_); 283 284 # !! TEMPORARY: Slow and naive implementation that just reads the entire file and picks out the one value 285 # !! This will one day be replaced with database-specific versions that will use dbget etc. 286 my $infodb_map = {}; 287 &read_infodb_file($infodb_type, $infodb_file_path, $infodb_map); 288 289 return $infodb_map->{$infodb_key}; 290 } 291 292 293 sub read_infodb_entry 294 { 295 my $infodb_type = shift(@_); 296 my $infodb_file_path = shift(@_); 297 my $infodb_key = shift(@_); 298 299 if ($infodb_type eq "sqlite") 300 { 301 require dbutil::sqlite; 302 return &dbutil::sqlite::read_infodb_entry($infodb_file_path, $infodb_key, @_); 303 } 304 # elsif ($infodb_type eq "gdbm-txtgz") 305 # { 306 # require dbutil::gdbmtxtgz; 307 # return &dbutil::gdbmtxtgz::read_infodb_entry($infodb_file_path, $infodb_key, @_); 308 # } 309 # elsif ($infodb_type eq "jdbm") 310 # { 311 # require dbutil::jdbm; 312 # return &dbutil::jdbm::read_infodb_entry($infodb_file_path, $infodb_key, @_); 313 # } 314 # elsif ($infodb_type eq "mssql") 315 # { 316 # require dbutil::mssql; 317 # return &dbutil::mssql::read_infodb_entry($infodb_file_path, $infodb_key, @_); 318 # } 319 320 # # Use GDBM if the infodb type is empty or not one of the values above 321 # require dbutil::gdbm; 322 # return &dbutil::gdbm::read_infodb_entry($infodb_file_path, $infodb_key, @_); 323 324 325 # rawentry above is currently naive implementation 326 my $raw_string = read_infodb_rawentry($infodb_type, $infodb_file_path, $infodb_key); 327 my $infodb_rec = &dbutil::convert_infodb_string_to_hash($raw_string); 328 329 return $infodb_rec; 330 } 331 332 333 ## @function 334 # 335 sub merge_databases 336 { 337 my $infodb_type = shift(@_); 338 # Make a call to the dynamically loaded driver to open the connection. 339 return &dbutil::call_dynamic_driver_function('merge_databases', $infodb_type, @_); 340 } 341 ## 342 343 344 # ---- GENERAL FUNCTIONS -------- 345 346 sub convert_infodb_hash_to_string 347 { 348 my $infodb_map = shift(@_); 349 350 my $infodb_entry_value = ""; 351 foreach my $infodb_value_key (keys(%$infodb_map)) 352 { 353 foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}}) 354 { 355 $infodb_entry_value .= "<$infodb_value_key>" . $infodb_value . "\n"; 356 } 357 } 358 359 return $infodb_entry_value; 360 } 361 362 363 sub convert_infodb_string_to_hash 364 { 365 my $infodb_entry_value = shift(@_); 366 my $infodb_map = (); 367 368 if (!defined $infodb_entry_value) { 369 print STDERR "Warning: No value to convert into a infodb hashtable\n"; 370 } 371 else { 372 while ($infodb_entry_value =~ /^<(.*?)>(.*)$/mg) 373 { 374 my $infodb_value_key = $1; 375 my $infodb_value = $2; 376 377 if (!defined($infodb_map->{$infodb_value_key})) 378 { 379 $infodb_map->{$infodb_value_key} = [ $infodb_value ]; 380 } 381 else 382 { 383 push(@{$infodb_map->{$infodb_value_key}}, $infodb_value); 384 } 385 } 386 } 387 388 return $infodb_map; 389 } 390 500 my $infodb_type = shift(@_); 501 my $driver = _loadDBDriver($infodb_type); 502 $driver->write_infodb_rawentry(@_); 503 } 504 ## write_infodb_rawentry(string, *) => void ## 391 505 392 506 1;
Note:
See TracChangeset
for help on using the changeset viewer.