Changeset 30335 for gs2-extensions/tdb

Show
Ignore:
Timestamp:
03.12.2015 15:41:56 (4 years ago)
Author:
jmt12
Message:

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.

Files:
1 modified

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############################################################################### 
    2625 
    2726package dbutil; 
    2827 
     28# Pragma 
    2929use strict; 
    3030 
    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. 
     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'; 
    3253use util; 
    3354 
    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? 
     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 
    80310    { 
    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# 
     324sub close_infodb_write_handle 
    129325{ 
    130326  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# 
     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# 
    146358sub get_default_infodb_type 
    147359{ 
    148360  # The default is GDBM so everything works the same for existing collections 
    149361  # 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# 
    160369sub get_infodb_file_path 
    161370{ 
    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# 
     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# 
    186393sub read_infodb_file 
    187394{ 
    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# 
    195404sub read_infodb_keys 
    196405{ 
    197406    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# 
     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 
    206450# 
    207451sub supportsDatestamp 
    208452{ 
    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 
    216462# 
    217463sub supportsMerge 
    218464{ 
    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 
    226474# 
    227475sub supportsRSS 
    228476{ 
    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# 
    235487sub write_infodb_entry 
    236488{ 
    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# 
    246498sub write_infodb_rawentry 
    247499{ 
    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 ## 
    391505 
    3925061;