Changeset 30356

Show
Ignore:
Timestamp:
16.12.2015 16:27:35 (4 years ago)
Author:
jmt12
Message:

Complete rewrite of dbutil.pm to (rather than have databases hardcoded) use a dynamic object-oriented loading system.

Files:
1 modified

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 databases 
    4 # Copyright (C) 2008  DL Consulting Ltd 
    5 # 
    6 # A component of the Greenstone digital library software 
    7 # from the New Zealand Digital Library Project at the  
    8 # 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 by 
    12 # the Free Software Foundation; either version 2 of the License, or 
    13 # (at your option) any later version. 
    14 # 
    15 # This program is distributed in the hope that it will be useful, 
    16 # but WITHOUT ANY WARRANTY; without even the implied warranty of 
    17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
    18 # GNU General Public License for more details. 
    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 Software 
    22 # Foundation, Inc., 675 Mass Ave, 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############################################################################### 
    2525 
    2626package dbutil; 
    2727 
     28# Pragma 
    2829use strict; 
    2930 
    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. 
     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    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 
     52use Devel::Peek; 
     53use Time::HiRes qw ( gettimeofday tv_interval ); 
     54use FileUtils; 
     55use gsprintf 'gsprintf'; 
     56use util; 
     57 
     58# Modulino pattern 
     59__PACKAGE__->main unless caller; 
     60 
     61############################################################################### 
     62## Private 
     63############################################################################### 
     64 
     65## Display debug messages? 
     66my $debug = 0; # Set to 1 to display 
     67 
     68## Keep track of the driver objects we have initialised 
     69my $dbdriver_pool = {}; 
     70 
     71# Testing globals 
     72my $test_count = 0; 
     73my $pass_count = 0; 
     74my $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# 
     82sub _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# 
     120sub _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# 
     138sub _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# 
     151sub _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# 
     190sub _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 
     207sub _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 
     216sub _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# 
     234sub 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# 
     358sub close_infodb_write_handle 
    32359{ 
    33360  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# 
     369sub 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# 
     380sub 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# 
    95392sub get_default_infodb_type 
    96393{ 
    97394  # The default is GDBM so everything works the same for existing collections 
    98395  # 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# 
    103403sub get_infodb_file_path 
    104404{ 
    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# 
     415sub 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# 
    152427sub read_infodb_file 
    153428{ 
    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# 
    184438sub read_infodb_keys 
    185439{ 
    186440    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# 
     449sub 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# 
    217461sub read_infodb_rawentry 
    218462{ 
    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# 
     473sub 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# 
     485sub 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# 
     497sub 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# 
     509sub 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# 
    274521sub write_infodb_entry 
    275522{ 
    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# 
    308532sub write_infodb_rawentry 
    309533{ 
    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 ## 
    457539 
    4585401;