Changeset 30356 for main/trunk/greenstone2
- Timestamp:
- 2015-12-16T16:27:35+13:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
main/trunk/greenstone2/perllib/dbutil.pm
r23485 r30356 1 ########################################################################### 2 # 3 # dbutil.pm -- gateway to utilities for reading/writing to different databases4 # Copyright (C) 2008 DL Consulting Ltd5 # 6 # A component of the Greenstone digital library software7 # from the New Zealand Digital Library Project at the8 # University of Waikato, New Zealand.9 # 10 # This program is free software; you can redistribute it and/or modify 11 # it under the terms of the GNU General Public License as published by12 # the Free Software Foundation; either version 2 of the License, or13 # (at your option) any laterversion.14 # 15 # This program is distributed in the hope that it will be useful, 16 # but WITHOUT ANY WARRANTY; without even the implied warranty of17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the18 # GNU General Public License for moredetails.19 # 20 # You should have received a copy of the GNU General Public License 21 # along with this program; if not, write to the Free Software22 # Foundation, Inc., 675 MassAve, Cambridge, MA 02139, USA.23 # 24 ########################################################################### 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 25 26 26 package dbutil; 27 27 28 # Pragma 28 29 use strict; 29 30 30 31 sub open_infodb_write_handle 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 my $perllib_path = $ENV{'GSDLHOME'} . '/perllib'; 40 my $all_inc = join(':', @INC); 41 if ($all_inc !~ /$perllib_path/) { 42 unshift(@INC, $perllib_path); 43 unshift(@INC, $ENV{'GSDLHOME'} . '/ext/parallel-building/perllib'); 44 unshift(@INC, $ENV{'GSDLHOME'} . '/ext/tdb/perllib'); 45 } 46 ## You can uncomment and name a Driver here to test it compiles 47 #require DBDrivers::TDBCLUSTER; 48 #my $driver = DBDrivers::TDBCLUSTER->new(1); 49 } 50 51 # Libraries 52 use Devel::Peek; 53 use Time::HiRes qw ( gettimeofday tv_interval ); 54 use FileUtils; 55 use gsprintf 'gsprintf'; 56 use util; 57 58 # Modulino pattern 59 __PACKAGE__->main unless caller; 60 61 ############################################################################### 62 ## Private 63 ############################################################################### 64 65 ## Display debug messages? 66 my $debug = 0; # Set to 1 to display 67 68 ## Keep track of the driver objects we have initialised 69 my $dbdriver_pool = {}; 70 71 # Testing globals 72 my $test_count = 0; 73 my $pass_count = 0; 74 my $skip_count = 0; 75 76 77 ## @function _addPathsToINC(void) => void 78 # 79 # A hopefully unused function to ensure the INC path contains all the available 80 # perllib directories (from main, collection, and extensions) 81 # 82 sub _addPathsToINC 83 { 84 &_debugPrint('_addPathsToINC() => ', 0); 85 my @possible_paths; 86 #... the main perllib directory... 87 push(@possible_paths, &FileUtils::filenameConcatenate()); 88 #... a collection specific perllib directory... 89 if (defined $ENV{'GSDLCOLLECTDIR'} && $ENV{'GSDLCOLLECTION'}) { 90 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, 'collect', $ENV{'GSDLCOLLECTION'}, 'perllib')); 91 } 92 #... any registered extension may also have a perllib! 93 if (defined $ENV{'GSDLEXTS'} && defined $ENV{'GSDLHOME'}) { 94 foreach my $gs2_extension (split(/:/, $ENV{'GSDLEXTS'})) { 95 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'ext', $gs2_extension, 'perllib')); 96 } 97 } 98 if (defined $ENV{'GSDL3EXTS'} && defined $ENV{'GSDL3SRCHOME'}) { 99 foreach my $gs3_extension (split(/:/, $ENV{'GSDL3EXTS'})) { 100 push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, 'ext', $gs3_extension, 'perllib')); 101 } 102 } 103 my $path_counter = 0; 104 foreach my $possible_path (@possible_paths) { 105 # we only try adding paths that actually exist 106 if (-d $possible_path) { 107 my $did_add_path = &util::augmentINC($possible_path); 108 if ($did_add_path) { 109 $path_counter++; 110 } 111 } 112 } 113 &_debugPrint('Added ' . $path_counter . ' paths'); 114 } 115 ## _addPathsToINC(void) => void # 116 117 118 ## @function _debugPrint(string, boolean) 119 # 120 sub _debugPrint 121 { 122 my ($message, $newline) = @_; 123 if ($debug) { 124 if (!defined($newline)) { 125 $newline = 1; 126 } 127 print STDERR '[DEBUG] dbutil::' . $message; 128 if ($newline) { 129 print STDERR "\n"; 130 } 131 } 132 } 133 ## _debugPrint(string, boolean) => void ## 134 135 136 ## @function _isDriverLoaded(string) => boolean 137 # 138 sub _isDriverLoaded 139 { 140 my ($dbdriver_name) = @_; 141 (my $dbdriver_file = $dbdriver_name) =~ s/::/\//g; 142 $dbdriver_file .= '.pm'; 143 my $result = defined($INC{$dbdriver_file}); 144 &_debugPrint('_isDriverLoaded("' . $dbdriver_name . '") => ' . $result); 145 return $result; 146 } 147 ## _isDriverLoaded(string) => boolean ## 148 149 ## @function _loadDBDriver(string, string) 150 # 151 sub _loadDBDriver 152 { 153 my ($dbdriver_name, $db_filepath) = @_; 154 my $dbdriver; 155 # I've decided (arbitrarily) to use uppercase for driver names since they 156 # are mostly acronyms 157 $dbdriver_name = uc($dbdriver_name); 158 # Ensure the driver has the correct package prefix 159 if ($dbdriver_name !~ /^DBDrivers/) { 160 $dbdriver_name = 'DBDrivers::' . $dbdriver_name; 161 } 162 # We only need to create each driver once 163 if (defined($dbdriver_pool->{$dbdriver_name})) { 164 $dbdriver = $dbdriver_pool->{$dbdriver_name}; 165 } 166 else { 167 &_debugPrint('_loadDBDriver() => ' . $dbdriver_name); 168 # Assuming the INC is correctly setup, then this should work nicely 169 # - make sure we have required this dbdriver package 170 eval "require $dbdriver_name"; 171 if (&_isDriverLoaded($dbdriver_name)) { 172 $dbdriver_name->import(); 173 } 174 # What should we do about drivers that aren't there? 175 else { 176 print STDERR "Error! Failed to load: " . $dbdriver_name . "\n"; 177 } 178 # Then initialise and return a new one 179 $dbdriver = $dbdriver_name->new($debug); 180 # Store it for later use 181 $dbdriver_pool->{$dbdriver_name} = $dbdriver; 182 } 183 return $dbdriver; 184 } 185 ## _loadDBDriver(string, string) => BaseDBDriver ## 186 187 188 ## @function _printTest(string, integer) => void 189 # 190 sub _printTest 191 { 192 my $title = shift(@_); 193 my $result = shift(@_); 194 $test_count++; 195 print " - Test: " . $title . "... "; 196 if ($result) { 197 print "Passed\n"; 198 $pass_count++; 199 } 200 else { 201 print "Failed\n"; 202 } 203 } 204 ## _printTest(string, integer) => void ## 205 206 207 sub _compareHash 208 { 209 my $hash1 = shift(@_); 210 my $hash2 = shift(@_); 211 my $str1 = &_hash2str($hash1); 212 my $str2 = &_hash2str($hash2); 213 return ($str1 eq $str2); 214 } 215 216 sub _hash2str 217 { 218 my $hash = shift(@_); 219 my $str = ''; 220 foreach my $key (sort keys %{$hash}) { 221 $str .= '{' . $key . '=>{{' . join('},{', @{$hash->{$key}}) . '}}}'; 222 } 223 return $str; 224 } 225 226 227 ############################################################################### 228 ## Public 229 ############################################################################### 230 231 232 ## @function main(void) => void 233 # 234 sub main 235 { 236 my $t0 = [gettimeofday()]; 237 my $data1 = {'doh' => ['a deer, a female deer'], 238 'ray' => ['a drop of golden sun'], 239 'me' => ['a name I call myself'], 240 'far' => ['a long, long way to run']}; 241 my $data2 = {'sew' => ['a needle pulling thread'], 242 'lah' => ['a note to follow doh'], 243 'tea' => ['a drink with jam and bread'], 244 'doh' => ['which brings us back to']}; 245 $test_count = 0; 246 $pass_count = 0; 247 $skip_count = 0; 248 print "===== DBUtils Testing Suite =====\n"; 249 print "For each driver specified, run a battery of tests\n"; 250 my @drivers; 251 foreach my $arg (@ARGV) { 252 if ($arg =~ /^-+([a-z]+)(=.+)?$/) { 253 my $arg_name = $1; 254 my $arg_value = $2; 255 if ($arg_name eq 'debug') { 256 $debug = 1; 257 } 258 } 259 else { 260 push(@drivers, $arg); 261 } 262 } 263 if (scalar(@drivers)) { 264 # Ensure the Perl can load the drivers from all the typical places 265 &_addPathsToINC(); 266 foreach my $driver_name (@drivers) { 267 my $t1 = [gettimeofday()]; 268 print "=== Testing: " . $driver_name . " ===\n"; 269 my $driver = _loadDBDriver($driver_name); 270 my $db_path = $driver->get_infodb_file_path('test-doc','/tmp/'); 271 print " - Path: " . $db_path . "\n"; 272 # 1. Open handle 273 my $db_handle = $driver->open_infodb_write_handle($db_path); 274 &_printTest('opening handle', (defined $db_handle)); 275 # 2a. Write entry 276 $driver->write_infodb_entry($db_handle, 'Alpha', $data1); 277 &_printTest('writing entry', 1); 278 # 2b. Write raw entry 279 my $raw_data = $driver->convert_infodb_hash_to_string($data1); 280 $driver->write_infodb_rawentry($db_handle, 'Beta', $raw_data); 281 &_printTest('writing raw entry', 1); 282 # 3. Close handle 283 $driver->close_infodb_write_handle($db_handle); 284 if ($driver->supportsPersistentConnection()) { 285 $test_count += 1; 286 $skip_count += 1; 287 print " - Skipping test as persistent drivers delay 'close'.\n"; 288 } 289 else { 290 &_printTest('closing handle', (tell($db_handle) < 1)); 291 } 292 if (!$driver->writeOnly()) { 293 # 4a. Read entry 294 my $data3 = $driver->read_infodb_entry($db_path, 'Alpha'); 295 &_printTest('read entry', &_compareHash($data1, $data3)); 296 # 4b. Read raw entry 297 my $raw_data4 = $driver->read_infodb_rawentry($db_path, 'Beta'); 298 my $data4 = $driver->convert_infodb_string_to_hash($raw_data4); 299 &_printTest('read raw entry', &_compareHash($data1, $data4)); 300 # 5. Read keys 301 my $keys1 = {}; 302 $driver->read_infodb_keys($db_path, $keys1); 303 &_printTest('read keys', (defined $keys1->{'Alpha'} && defined $keys1->{'Beta'})); 304 # 6. Set entry 305 if ($driver->supportsSet()) { 306 my $status = $driver->set_infodb_entry($db_path, 'Alpha', $data2); 307 &_printTest('set entry (1)', ($status >= 0)); 308 my $data5 = $driver->read_infodb_entry($db_path, 'Alpha'); 309 &_printTest('set entry (2)', &_compareHash($data2, $data5)); 310 } 311 else { 312 $test_count += 2; 313 $skip_count += 2; 314 print " - Skipping 2 tests as 'set' is not supported by this driver.\n"; 315 } 316 # 7. Delete entry 317 my $db_handle2 = $driver->open_infodb_write_handle($db_path, 'append'); 318 $driver->delete_infodb_entry($db_handle2, 'Alpha'); 319 $driver->close_infodb_write_handle($db_handle2); 320 my $keys2 = {}; 321 $driver->read_infodb_keys($db_path, $keys2); 322 &_printTest('delete entry', ((!defined $keys2->{'Alpha'}) && (defined $keys2->{'Beta'}))); 323 } 324 else 325 { 326 $test_count += 6; 327 $skip_count += 6; 328 print " - Skipping 6 tests as driver is write-only.\n"; 329 } 330 # 8. Remove test db 331 unlink($db_path); 332 my $t2 = [gettimeofday()]; 333 my $elapsed1 = tv_interval($t1, $t2); 334 print " - Testing took " . $elapsed1 . " seconds\n"; 335 } 336 print "===== Results =====\n"; 337 print "Drivers Tested: " . scalar(@drivers) . "\n"; 338 print "Tests Run: " . $test_count . "\n"; 339 print "Tests Passed: " . $pass_count . "\n"; 340 print "Tests Failed: " . ($test_count - $pass_count - $skip_count) . "\n"; 341 print "Tests Skipped: " . $skip_count . "\n"; 342 } 343 else 344 { 345 print "Warning! No drivers specified - expected as arguments to call\n"; 346 } 347 my $t3 = [gettimeofday()]; 348 my $elapsed2 = tv_interval($t0, $t3); 349 print "===== Complete in " . $elapsed2 . " seconds =====\n"; 350 print "\n"; 351 exit(0); 352 } 353 ## main(void) => void 354 355 356 ## @function close_infodb_write_handle(string, *) => void 357 # 358 sub close_infodb_write_handle 32 359 { 33 360 my $infodb_type = shift(@_); 34 my $infodb_file_path = shift(@_); 35 36 if ($infodb_type eq "sqlite") 37 { 38 require dbutil::sqlite; 39 return &dbutil::sqlite::open_infodb_write_handle($infodb_file_path, @_); 40 } 41 elsif ($infodb_type eq "gdbm-txtgz") 42 { 43 require dbutil::gdbmtxtgz; 44 return &dbutil::gdbmtxtgz::open_infodb_write_handle($infodb_file_path, @_); 45 } 46 elsif ($infodb_type eq "jdbm") 47 { 48 require dbutil::jdbm; 49 return &dbutil::jdbm::open_infodb_write_handle($infodb_file_path, @_); 50 } 51 elsif ($infodb_type eq "mssql") 52 { 53 require dbutil::mssql; 54 return &dbutil::mssql::open_infodb_write_handle($infodb_file_path, @_); 55 } 56 57 # Use GDBM if the infodb type is empty or not one of the values above 58 require dbutil::gdbm; 59 return &dbutil::gdbm::open_infodb_write_handle($infodb_file_path, @_); 60 } 61 62 63 sub close_infodb_write_handle 64 { 65 my $infodb_type = shift(@_); 66 my $infodb_handle = shift(@_); 67 68 if ($infodb_type eq "sqlite") 69 { 70 require dbutil::sqlite; 71 return &dbutil::sqlite::close_infodb_write_handle($infodb_handle, @_); 72 } 73 elsif ($infodb_type eq "gdbm-txtgz") 74 { 75 require dbutil::gdbmtxtgz; 76 return &dbutil::gdbmtxtgz::close_infodb_write_handle($infodb_handle, @_); 77 } 78 elsif ($infodb_type eq "jdbm") 79 { 80 require dbutil::jdbm; 81 return &dbutil::jdbm::close_infodb_write_handle($infodb_handle, @_); 82 } 83 elsif ($infodb_type eq "mssql") 84 { 85 require dbutil::mssql; 86 return &dbutil::mssql::close_infodb_write_handle($infodb_handle, @_); 87 } 88 89 # Use GDBM if the infodb type is empty or not one of the values above 90 require dbutil::gdbm; 91 return &dbutil::gdbm::close_infodb_write_handle($infodb_handle, @_); 92 } 93 94 361 my $driver = _loadDBDriver($infodb_type); 362 $driver->close_infodb_write_handle(@_); 363 } 364 ## close_infodb_write_handle(string, *) => void ## 365 366 367 ## @function delete_infodb_entry(string, *) => void 368 # 369 sub delete_infodb_entry 370 { 371 my $infodb_type = shift(@_); 372 my $driver = _loadDBDriver($infodb_type); 373 $driver->delete_infodb_entry(@_); 374 } 375 ## delete_infodb_entry(string, *) => void ## 376 377 378 ## @function mergeDatabases(string, *) => integer 379 # 380 sub mergeDatabases 381 { 382 my $infodb_type = shift(@_); 383 my $driver = _loadDBDriver($infodb_type); 384 my $status = $driver->mergeDatabases(@_); 385 return $status; 386 } 387 ## mergeDatabases(string, *) => integer ## 388 389 390 ## @function get_default_infodb_type(void) => string 391 # 95 392 sub get_default_infodb_type 96 393 { 97 394 # The default is GDBM so everything works the same for existing collections 98 395 # To use something else, specify the "infodbtype" in the collection's collect.cfg file 99 return "gdbm"; 100 } 101 102 396 return 'gdbm'; 397 } 398 ## get_default_infodb_type(void) => string ## 399 400 401 ## @function get_infodb_file_path(string, *) => string 402 # 103 403 sub get_infodb_file_path 104 404 { 105 my $infodb_type = shift(@_); 106 my $collection_name = shift(@_); 107 my $infodb_directory_path = shift(@_); 108 109 if ($infodb_type eq "sqlite") 110 { 111 require dbutil::sqlite; 112 return &dbutil::sqlite::get_infodb_file_path($collection_name, $infodb_directory_path, @_); 113 } 114 elsif ($infodb_type eq "gdbm-txtgz") 115 { 116 require dbutil::gdbmtxtgz; 117 return &dbutil::gdbmtxtgz::get_infodb_file_path($collection_name, $infodb_directory_path, @_); 118 } 119 elsif ($infodb_type eq "jdbm") 120 { 121 require dbutil::jdbm; 122 return &dbutil::jdbm::get_infodb_file_path($collection_name, $infodb_directory_path, @_); 123 } 124 elsif ($infodb_type eq "mssql") 125 { 126 #==================================================================================================# 127 # Updated by Jeffrey (2008/08/25 Monday) 128 # After look into the run-time code, it seems we should still create a database file. 129 # Since the run-time code is always try to read a database file, the easiest way here is not 130 # to change the whole structure, but to give whatever the system is looking for. 131 #==================================================================================================# 132 # Added by Jeffrey (2008/08/15 Friday) 133 # No file path required for MS SQL, it is a server-client connection. 134 # At the moment the information is hard coded in dbutil::mssql::open_infodb_write_handle 135 # the this might need some tidy up sometime. 136 #==================================================================================================# 137 require dbutil::mssql; 138 return &dbutil::mssql::get_infodb_file_path($collection_name, $infodb_directory_path, @_); 139 } 140 141 # Use GDBM if the infodb type is empty or not one of the values above 142 require dbutil::gdbm; 143 return &dbutil::gdbm::get_infodb_file_path($collection_name, $infodb_directory_path, @_); 144 } 145 146 # This function, conceptually, would be better structured if it didn't 147 # use return statements, as the database methods it calls do not 148 # themselves return anything. 149 # Note: if doing this, then the GDBM lines of code should be moved into 150 # an 'else' clause 151 405 my $infodb_type = shift(@_); 406 my $driver = _loadDBDriver($infodb_type); 407 my $infodb_file_path = $driver->get_infodb_file_path(@_); 408 return $infodb_file_path; 409 } 410 ## get_infodb_file_path(string, *) => string ## 411 412 413 ## @function open_infodb_write_handle(string, *) => filehandle 414 # 415 sub open_infodb_write_handle 416 { 417 my $infodb_type = shift(@_); 418 my $driver = _loadDBDriver($infodb_type); 419 my $infodb_handle = $driver->open_infodb_write_handle(@_); 420 return $infodb_handle; 421 } 422 ## open_infodb_write_handle(string, *) => filehandle ## 423 424 425 ## @function read_infodb_file(string, *) => void 426 # 152 427 sub read_infodb_file 153 428 { 154 my $infodb_type = shift(@_); 155 my $infodb_file_path = shift(@_); 156 my $infodb_map = shift(@_); 157 158 if ($infodb_type eq "sqlite") 159 { 160 require dbutil::sqlite; 161 return &dbutil::sqlite::read_infodb_file($infodb_file_path, $infodb_map, @_); 162 } 163 elsif ($infodb_type eq "gdbm-txtgz") 164 { 165 require dbutil::gdbmtxtgz; 166 return &dbutil::gdbmtxtgz::read_infodb_file($infodb_file_path, $infodb_map, @_); 167 } 168 elsif ($infodb_type eq "jdbm") 169 { 170 require dbutil::jdbm; 171 return &dbutil::jdbm::read_infodb_file($infodb_file_path, $infodb_map, @_); 172 } 173 elsif ($infodb_type eq "mssql") 174 { 175 require dbutil::mssql; 176 return &dbutil::mssql::read_infodb_file($infodb_file_path, $infodb_map, @_); 177 } 178 179 # Use GDBM if the infodb type is empty or not one of the values above 180 require dbutil::gdbm; 181 return &dbutil::gdbm::read_infodb_file($infodb_file_path, $infodb_map, @_); 182 } 183 429 my $infodb_type = shift(@_); 430 my $driver = _loadDBDriver($infodb_type); 431 $driver->read_infodb_file(@_); 432 } 433 ## read_infodb_file(string, *) => void ## 434 435 436 ## @function read_infodb_keys(string, *) => void 437 # 184 438 sub read_infodb_keys 185 439 { 186 440 my $infodb_type = shift(@_); 187 my $infodb_file_path = shift(@_); 188 my $infodb_map = shift(@_); 189 190 if ($infodb_type eq "sqlite") 191 { 192 require dbutil::sqlite; 193 &dbutil::sqlite::read_infodb_keys($infodb_file_path, $infodb_map, @_); 194 } 195 elsif ($infodb_type eq "gdbm-txtgz") 196 { 197 require dbutil::gdbmtxtgz; 198 &dbutil::gdbmtxtgz::read_infodb_keys($infodb_file_path, $infodb_map, @_); 199 } 200 elsif ($infodb_type eq "jdbm") 201 { 202 require dbutil::jdbm; 203 &dbutil::jdbm::read_infodb_keys($infodb_file_path, $infodb_map, @_); 204 } 205 elsif ($infodb_type eq "mssql") 206 { 207 require dbutil::mssql; 208 &dbutil::mssql::read_infodb_keys($infodb_file_path, $infodb_map, @_); 209 } 210 else { 211 # Use GDBM if the infodb type is empty or not one of the values above 212 require dbutil::gdbm; 213 &dbutil::gdbm::read_infodb_keys($infodb_file_path, $infodb_map, @_); 214 } 215 } 216 441 my $driver = _loadDBDriver($infodb_type); 442 $driver->read_infodb_keys(@_); 443 } 444 ## read_infodb_keys(string, *) => void ## 445 446 447 ## @function read_infodb_entry(string, *) => hashmap 448 # 449 sub read_infodb_entry 450 { 451 my $infodb_type = shift(@_); 452 my $driver = _loadDBDriver($infodb_type); 453 my $infodb_entry = $driver->read_infodb_entry(@_); 454 return $infodb_entry; 455 } 456 ## read_infodb_entry(string, *) => hashmap ## 457 458 459 ## @function read_infodb_rawentry(string, *) => string 460 # 217 461 sub read_infodb_rawentry 218 462 { 219 my $infodb_type = shift(@_); 220 my $infodb_file_path = shift(@_); 221 my $infodb_key = shift(@_); 222 223 224 # !! TEMPORARY: Slow and naive implementation that just reads the entire file and picks out the one value 225 # !! This will soon be replaced with database-specific versions that will use dbget etc. 226 my $infodb_map = {}; 227 &read_infodb_file($infodb_type, $infodb_file_path, $infodb_map); 228 229 return $infodb_map->{$infodb_key}; 230 } 231 232 233 sub read_infodb_entry 234 { 235 my $infodb_type = shift(@_); 236 my $infodb_file_path = shift(@_); 237 my $infodb_key = shift(@_); 238 239 240 if ($infodb_type eq "sqlite") 241 { 242 require dbutil::sqlite; 243 return &dbutil::sqlite::read_infodb_entry($infodb_file_path, $infodb_key, @_); 244 } 245 # elsif ($infodb_type eq "gdbm-txtgz") 246 # { 247 # require dbutil::gdbmtxtgz; 248 # return &dbutil::gdbmtxtgz::read_infodb_entry($infodb_file_path, $infodb_key, @_); 249 # } 250 # elsif ($infodb_type eq "jdbm") 251 # { 252 # require dbutil::jdbm; 253 # return &dbutil::jdbm::read_infodb_entry($infodb_file_path, $infodb_key, @_); 254 # } 255 # elsif ($infodb_type eq "mssql") 256 # { 257 # require dbutil::mssql; 258 # return &dbutil::mssql::read_infodb_entry($infodb_file_path, $infodb_key, @_); 259 # } 260 261 # # Use GDBM if the infodb type is empty or not one of the values above 262 # require dbutil::gdbm; 263 # return &dbutil::gdbm::read_infodb_entry($infodb_file_path, $infodb_key, @_); 264 265 266 # rawentry above is currently naive implementation 267 my $raw_string = read_infodb_rawentry($infodb_type, $infodb_file_path, $infodb_key); 268 my $infodb_rec = &dbutil::convert_infodb_string_to_hash($raw_string); 269 270 return $infodb_rec; 271 } 272 273 463 my $infodb_type = shift(@_); 464 my $driver = _loadDBDriver($infodb_type); 465 my $raw_infodb_entry = $driver->read_infodb_rawentry(@_); 466 return $raw_infodb_entry; 467 } 468 ## read_infodb_rawentry(string, *) => string ## 469 470 471 ## @function set_infodb_entry(string, *) => integer 472 # 473 sub set_infodb_entry 474 { 475 my $infodb_type = shift(@_); 476 my $driver = _loadDBDriver($infodb_type); 477 my $status = $driver->set_infodb_entry(@_); 478 return $status; 479 } 480 ## set_infodb_entry(string, *) => integer ## 481 482 483 ## @function supportDatestamp(string) => boolean 484 # 485 sub supportsDatestamp 486 { 487 my $infodb_type = shift(@_); 488 my $driver = _loadDBDriver($infodb_type); 489 my $supports_datestamp = $driver->supportsDatestamp(); 490 return $supports_datestamp; 491 } 492 ## supportsDatestamp(string) => boolean ## 493 494 495 ## @function supportMerge(string) => boolean 496 # 497 sub supportsMerge 498 { 499 my $infodb_type = shift(@_); 500 my $driver = _loadDBDriver($infodb_type); 501 my $supports_merge = $driver->supportsMerge(); 502 return $supports_merge; 503 } 504 ## supportsMerge(string) => boolean ## 505 506 507 ## @function supportRSS(string) => boolean 508 # 509 sub supportsRSS 510 { 511 my $infodb_type = shift(@_); 512 my $driver = _loadDBDriver($infodb_type); 513 my $supports_rss = $driver->supportsRSS(); 514 return $supports_rss; 515 } 516 ## supportsRSS(string) => boolean ## 517 518 519 ## @function write_infodb_entry(string, *) => void 520 # 274 521 sub write_infodb_entry 275 522 { 276 my $infodb_type = shift(@_); 277 my $infodb_handle = shift(@_); 278 my $infodb_key = shift(@_); 279 my $infodb_map = shift(@_); 280 281 if ($infodb_type eq "sqlite") 282 { 283 require dbutil::sqlite; 284 return &dbutil::sqlite::write_infodb_entry($infodb_handle, $infodb_key, $infodb_map, @_); 285 } 286 elsif ($infodb_type eq "gdbm-txtgz") 287 { 288 require dbutil::gdbmtxtgz; 289 return &dbutil::gdbmtxtgz::write_infodb_entry($infodb_handle, $infodb_key, $infodb_map, @_); 290 } 291 elsif ($infodb_type eq "jdbm") 292 { 293 require dbutil::jdbm; 294 return &dbutil::jdbm::write_infodb_entry($infodb_handle, $infodb_key, $infodb_map, @_); 295 } 296 elsif ($infodb_type eq "mssql") 297 { 298 require dbutil::mssql; 299 return &dbutil::mssql::write_infodb_entry($infodb_handle, $infodb_key, $infodb_map, @_); 300 } 301 302 # Use GDBM if the infodb type is empty or not one of the values above 303 require dbutil::gdbm; 304 return &dbutil::gdbm::write_infodb_entry($infodb_handle, $infodb_key, $infodb_map, @_); 305 } 306 307 523 my $infodb_type = shift(@_); 524 my $driver = _loadDBDriver($infodb_type); 525 $driver->write_infodb_entry(@_); 526 } 527 ## write_infodb_entry(string, *) => void ## 528 529 530 ## @function write_infodb_rawentry(string, *) => void 531 # 308 532 sub write_infodb_rawentry 309 533 { 310 my $infodb_type = shift(@_); 311 my $infodb_handle = shift(@_); 312 my $infodb_key = shift(@_); 313 my $infodb_val = shift(@_); 314 315 if ($infodb_type eq "sqlite") 316 { 317 require dbutil::sqlite; 318 return &dbutil::sqlite::write_infodb_rawentry($infodb_handle, $infodb_key, $infodb_val, @_); 319 } 320 elsif ($infodb_type eq "gdbm-txtgz") 321 { 322 require dbutil::gdbmtxtgz; 323 return &dbutil::gdbmtxtgz::write_infodb_rawentry($infodb_handle, $infodb_key, $infodb_val, @_); 324 } 325 elsif ($infodb_type eq "jdbm") 326 { 327 require dbutil::jdbm; 328 return &dbutil::jdbm::write_infodb_rawentry($infodb_handle, $infodb_key, $infodb_val, @_); 329 } 330 elsif ($infodb_type eq "mssql") 331 { 332 require dbutil::mssql; 333 return &dbutil::mssql::write_infodb_rawentry($infodb_handle, $infodb_key, $infodb_val, @_); 334 } 335 336 # Use GDBM if the infodb type is empty or not one of the values above 337 require dbutil::gdbm; 338 return &dbutil::gdbm::write_infodb_rawentry($infodb_handle, $infodb_key, $infodb_val, @_); 339 } 340 341 342 sub set_infodb_entry 343 { 344 my $infodb_type = shift(@_); 345 my $infodb_file_path = shift(@_); 346 my $infodb_key = shift(@_); 347 my $infodb_map = shift(@_); 348 349 if ($infodb_type eq "sqlite") 350 { 351 require dbutil::sqlite; 352 return &dbutil::sqlite::set_infodb_entry($infodb_file_path, $infodb_key, $infodb_map, @_); 353 } 354 elsif ($infodb_type eq "gdbm-txtgz") 355 { 356 require dbutil::gdbmtxtgz; 357 return &dbutil::gdbmtxtgz::set_infodb_entry($infodb_file_path, $infodb_key, $infodb_map, @_); 358 } 359 elsif ($infodb_type eq "jdbm") 360 { 361 require dbutil::jdbm; 362 return &dbutil::jdbm::set_infodb_entry($infodb_file_path, $infodb_key, $infodb_map, @_); 363 } 364 elsif ($infodb_type eq "mssql") 365 { 366 require dbutil::mssql; 367 return &dbutil::mssql::set_infodb_entry($infodb_file_path, $infodb_key, $infodb_map, @_); 368 } 369 370 # Use GDBM if the infodb type is empty or not one of the values above 371 require dbutil::gdbm; 372 return &dbutil::gdbm::set_infodb_entry($infodb_file_path, $infodb_key, $infodb_map, @_); 373 } 374 375 376 377 sub delete_infodb_entry 378 { 379 my $infodb_type = shift(@_); 380 my $infodb_handle = shift(@_); 381 my $infodb_key = shift(@_); 382 383 if ($infodb_type eq "sqlite") 384 { 385 require dbutil::sqlite; 386 return &dbutil::sqlite::delete_infodb_entry($infodb_handle, $infodb_key, @_); 387 } 388 elsif ($infodb_type eq "gdbm-txtgz") 389 { 390 require dbutil::gdbmtxtgz; 391 return &dbutil::gdbmtxtgz::delete_infodb_entry($infodb_handle, $infodb_key, @_); 392 } 393 elsif ($infodb_type eq "jdbm") 394 { 395 require dbutil::jdbm; 396 return &dbutil::jdbm::delete_infodb_entry($infodb_handle, $infodb_key, @_); 397 } 398 elsif ($infodb_type eq "mssql") 399 { 400 require dbutil::mssql; 401 return &dbutil::mssql::delete_infodb_entry($infodb_handle, $infodb_key, @_); 402 } 403 404 # Use GDBM if the infodb type is empty or not one of the values above 405 require dbutil::gdbm; 406 return &dbutil::gdbm::delete_infodb_entry($infodb_handle, $infodb_key, @_); 407 } 408 409 410 # ---- GENERAL FUNCTIONS -------- 411 412 sub convert_infodb_hash_to_string 413 { 414 my $infodb_map = shift(@_); 415 416 my $infodb_entry_value = ""; 417 foreach my $infodb_value_key (keys(%$infodb_map)) 418 { 419 foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}}) 420 { 421 $infodb_entry_value .= "<$infodb_value_key>" . $infodb_value . "\n"; 422 } 423 } 424 425 return $infodb_entry_value; 426 } 427 428 429 sub convert_infodb_string_to_hash 430 { 431 my $infodb_entry_value = shift(@_); 432 my $infodb_map = (); 433 434 if (!defined $infodb_entry_value) { 435 print STDERR "Warning: No value to convert into a infodb hashtable\n"; 436 } 437 else { 438 while ($infodb_entry_value =~ /^<(.*?)>(.*)$/mg) 439 { 440 my $infodb_value_key = $1; 441 my $infodb_value = $2; 442 443 if (!defined($infodb_map->{$infodb_value_key})) 444 { 445 $infodb_map->{$infodb_value_key} = [ $infodb_value ]; 446 } 447 else 448 { 449 push(@{$infodb_map->{$infodb_value_key}}, $infodb_value); 450 } 451 } 452 } 453 454 return $infodb_map; 455 } 456 534 my $infodb_type = shift(@_); 535 my $driver = _loadDBDriver($infodb_type); 536 $driver->write_infodb_rawentry(@_); 537 } 538 ## write_infodb_rawentry(string, *) => void ## 457 539 458 540 1;
Note:
See TracChangeset
for help on using the changeset viewer.