Changeset 30335


Ignore:
Timestamp:
2015-12-03T15:41:56+13:00 (8 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.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • gs2-extensions/tdb/trunk/perllib/dbutil.pm

    r29316 r30335  
    1 ###########################################################################
    2 #
    3 # dbutil.pm -- gateway to utilities for reading/writing to different databases
    4 #
    5 # Copyright (C) 2008 DL Consulting Ltd
    6 #
    7 # A component of the Greenstone digital library software
    8 # from the New Zealand Digital Library Project at the
    9 # University of Waikato, New Zealand.
    10 #
    11 # This program is free software; you can redistribute it and/or modify
    12 # it under the terms of the GNU General Public License as published by
    13 # the Free Software Foundation; either version 2 of the License, or
    14 # (at your option) any later version.
    15 #
    16 # This program is distributed in the hope that it will be useful,
    17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
    18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    19 # GNU General Public License for more details.
    20 #
    21 # You should have received a copy of the GNU General Public License
    22 # along with this program; if not, write to the Free Software
    23 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    24 #
    25 ###########################################################################
     1###############################################################################
     2#
     3# dbutil.pm -- functions to handle using dbdrivers
     4#
     5# Copyright (C) 2015 New Zealand Digital Library Project
     6#
     7# A component of the Greenstone digital library software from the New Zealand
     8# Digital Library Project at the University of Waikato, New Zealand.
     9#
     10# This program is free software; you can redistribute it and/or modify it under
     11# the terms of the GNU General Public License as published by the Free Software
     12# Foundation; either version 2 of the License, or (at your option) any later
     13# version.
     14#
     15# This program is distributed in the hope that it will be useful, but WITHOUT
     16# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
     17# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
     18# details.
     19#
     20# You should have received a copy of the GNU General Public License along with
     21# this program; if not, write to the Free Software Foundation, Inc., 675 Mass
     22# Ave, Cambridge, MA 02139, USA.
     23#
     24###############################################################################
    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;
Note: See TracChangeset for help on using the changeset viewer.