Changeset 30356 for main/trunk


Ignore:
Timestamp:
2015-12-16T16:27:35+13:00 (8 years ago)
Author:
jmt12
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • main/trunk/greenstone2/perllib/dbutil.pm

    r23485 r30356  
    1 ###########################################################################
    2 #
    3 # dbutil.pm -- gateway to utilities for reading/writing to different 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;
Note: See TracChangeset for help on using the changeset viewer.