source: gs2-extensions/tdb-edit/trunk/src/perllib/dbutil.pm@ 28000

###########################################################################
#
# dbutil.pm -- gateway to utilities for reading/writing to different databases
#
# Copyright (C) 2008 DL Consulting Ltd
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the
# University of Waikato, New Zealand.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

package dbutil;

use strict;

use Symbol qw<qualify>;
use util;

# /** Dynamic class loading - for use in DBUtils to load various database
#  *  drivers, configured in the collect.cfg, at runtime.
#  *  @param $class - The class name (including any path) to load
#  *  @param rest - any function aliases you want exported
#  */
sub load_db_driver
{
  my $class = shift(@_);
  (my $file = "$class.pm") =~ s|::|/|g;
  # - ensure we haven't already loaded this class
  unless( $INC{$file} )
  {
    # - require is fine being assigned at runtime - no need for evil eval
    #eval
    #{
    require $file;
    #};
  }
  # - this is the magic that actually instantiates the class (rubberstamp?)
  # - we pass @_ to action any function aliases exports requested
  eval
  {
    $class->import(@_);
  };
  # - by now the driver file should have been loaded
  return (defined $INC{$file});
}
# /** load_db_driver() **/

# /** Make a function call to a dynamically loaded database driver.
#  *  @param $function_name
#  *  @param $driver_name
#  *  @param <rest> The parameters to be passed to the function called
#  */
sub call_dynamic_driver_function
{
  my $function_name = shift(@_);
  my $driver_name = shift(@_);
  my $package_name = 'dbutil::' . $driver_name;
  # - try to load the requested infodb type
  if (!&load_db_driver($package_name))
  {
    # - try loading the default GDBM driver
    print STDERR 'Warning! Using default database driver (GDBM) as failed to load configured database driver: ' . $driver_name . "\n";
    $package_name = 'dbutil::gdbm';
    if (!&load_db_driver($package_name))
    {
      die("Fatal Error! Failed to load default database driver: dbutil::gdbm\n");
    }
  }
  # - make call to the newly created package
  no strict;
  # - lets check that the function we are about to call
  my $symbol = qualify($function_name, $package_name);
  unless ( defined &{$symbol} )
  {
    die ('Error! Function not found: ' . $package_name . '::' . $function_name . "()\n");
  }
  return &{$symbol}(@_);
}
# /** call_dynamic_driver_function() **/


## @function test_dynamic_driver_function()
#
# Checks to see if a function in a dynamically loaded driver exists
#
sub test_dynamic_driver_function
{
  my $function_name = shift(@_);
  my $driver_name = shift(@_);
  my $package_name = 'dbutil::' . $driver_name;
  # - try to load the requested infodb type
  if (!&load_db_driver($package_name))
  {
    # - try loading the default GDBM driver
    print STDERR 'Warning! Using default database driver (GDBM) as failed to load configured database driver: ' . $driver_name . "\n";
    $package_name = 'dbutil::gdbm';
    if (!&load_db_driver($package_name))
    {
      die("Fatal Error! Failed to load default database driver: dbutil::gdbm\n");
    }
  }
  # - make call to the newly created package
  no strict;
  # - lets check that the function we are about to call
  my $symbol = qualify($function_name, $package_name);
  return defined &{$symbol};
}
## test_dynamic_driver_function() ##


## @function
#
sub open_infodb_write_handle
{
  my $infodb_type = shift(@_);
  my $infodb_file_path = shift(@_);
  # Make a call to the dynamically loaded driver to open the connection.
  return &dbutil::call_dynamic_driver_function('open_infodb_write_handle', $infodb_type, $infodb_file_path, @_);
}


sub close_infodb_write_handle
{
  my $infodb_type = shift(@_);
  my $infodb_handle = shift(@_);
  # Dynamic database driver call
  return &dbutil::call_dynamic_driver_function('close_infodb_write_handle', $infodb_type, $infodb_handle, @_);
}


sub get_default_infodb_type
{
  # The default is GDBM so everything works the same for existing collections
  # To use something else, specify the "infodbtype" in the collection's collect.cfg file
  return "gdbm";
}

# /** @function get_infodb_file_path()
#  * Warning! Black magic follows. The first time get_infodb_file_path is
#  * called (presumably from inexport::process_files()) for databases of type
#  * server will actually the Server to be run complete with an initial dummy
#  * listener. This is done so that, in parallel importing, the server will
#  * persist until the top level import.pl (which will be the first that calls
#  * this function) completes and removes the dummy listener. [jmt12]
sub get_infodb_file_path
{
  my $infodb_type = shift(@_);
  my $collection_name = shift(@_);
  my $infodb_directory_path = shift(@_);

  #=======================================MSSQL SUPPORT==============================================#
  # Updated by Jeffrey (2008/08/25 Monday)
  # After look into the run-time code, it seems we should still create a database file.
  # Since the run-time code is always try to read a database file, the easiest way here is not
  # to change the whole structure, but to give whatever the system is looking for.
  #==================================================================================================#
  # Added by Jeffrey (2008/08/15 Friday)
  # No file path required for MS SQL, it is a server-client connection.
  # At the moment the information is hard coded in dbutil::mssql::open_infodb_write_handle
  # the this might need some tidy up sometime.
  #==================================================================================================#

  return &dbutil::call_dynamic_driver_function('get_infodb_file_path', $infodb_type, $collection_name, $infodb_directory_path, @_);
}

# This function, conceptually, would be better structured if it didn't
# use return statements, as the database methods it calls do not
# themselves return anything.
# Note: if doing this, then the GDBM lines of code should be moved into
# an 'else' clause
sub read_infodb_file
{
  my $infodb_type = shift(@_);
  my $infodb_file_path = shift(@_);
  my $infodb_map = shift(@_);

  return &dbutil::call_dynamic_driver_function('read_infodb_file', $infodb_type, $infodb_file_path, $infodb_map, @_);
}

sub read_infodb_keys
{
    my $infodb_type = shift(@_);
    my $infodb_file_path = shift(@_);
    my $infodb_map = shift(@_);

    return &dbutil::call_dynamic_driver_function('read_infodb_keys', $infodb_type, $infodb_file_path, $infodb_map, @_);
}


## @function supportDatestamp
#
sub supportsDatestamp
{
  my $infodb_type = shift(@_);
  return &dbutil::test_dynamic_driver_function('supportsDatestamp', $infodb_type);
}
## supportsDatestamp() ##


## @function supportRSS
#
sub supportsRSS
{
  my $infodb_type = shift(@_);
  return &dbutil::test_dynamic_driver_function('supportsRSS', $infodb_type);
}
## supportsRSS() ##


sub write_infodb_entry
{
  my $infodb_type = shift(@_);
  my $infodb_handle = shift(@_);
  my $infodb_key = shift(@_);
  my $infodb_map = shift(@_);

  return &dbutil::call_dynamic_driver_function('write_infodb_entry', $infodb_type, $infodb_handle, $infodb_key, $infodb_map, @_);
}


sub write_infodb_rawentry
{
  my $infodb_type = shift(@_);
  my $infodb_handle = shift(@_);
  my $infodb_key = shift(@_);
  my $infodb_val = shift(@_);

  return &dbutil::call_dynamic_driver_function('write_infodb_rawentry', $infodb_type, $infodb_handle, $infodb_key, $infodb_val, @_);
}


sub set_infodb_entry
{
  my $infodb_type = shift(@_);
  my $infodb_file_path = shift(@_);
  my $infodb_key = shift(@_);
  my $infodb_map = shift(@_);

  return &dbutil::call_dynamic_driver_function('set_infodb_entry', $infodb_type, $infodb_file_path, $infodb_key, $infodb_map, @_);
}



sub delete_infodb_entry
{
  my $infodb_type = shift(@_);
  my $infodb_handle = shift(@_);
  my $infodb_key = shift(@_);

  return &dbutil::call_dynamic_driver_function('delete_infodb_entry', $infodb_type, $infodb_handle, $infodb_key, @_);
}

sub read_infodb_rawentry
{
  my $infodb_type = shift(@_);
  my $infodb_file_path = shift(@_);
  my $infodb_key = shift(@_);

  # !! TEMPORARY: Slow and naive implementation that just reads the entire file and picks out the one value
  # !! This will one day be replaced with database-specific versions that will use dbget etc.
  my $infodb_map = {};
  &read_infodb_file($infodb_type, $infodb_file_path, $infodb_map);

  return $infodb_map->{$infodb_key};
}


sub read_infodb_entry
{
  my $infodb_type = shift(@_);
  my $infodb_file_path = shift(@_);
  my $infodb_key = shift(@_);

  if ($infodb_type eq "sqlite")
  {
    require dbutil::sqlite;
    return &dbutil::sqlite::read_infodb_entry($infodb_file_path, $infodb_key, @_);
  }
#  elsif ($infodb_type eq "gdbm-txtgz")
#  {
#    require dbutil::gdbmtxtgz;
#    return &dbutil::gdbmtxtgz::read_infodb_entry($infodb_file_path, $infodb_key, @_);
#  }
#  elsif ($infodb_type eq "jdbm")
#  {
#    require dbutil::jdbm;
#    return &dbutil::jdbm::read_infodb_entry($infodb_file_path, $infodb_key, @_);
#  }
#  elsif ($infodb_type eq "mssql")
#  {
#    require dbutil::mssql;
#    return &dbutil::mssql::read_infodb_entry($infodb_file_path, $infodb_key, @_);
#  }
  
#  # Use GDBM if the infodb type is empty or not one of the values above
#  require dbutil::gdbm;
#  return &dbutil::gdbm::read_infodb_entry($infodb_file_path, $infodb_key, @_);
  
  
  # rawentry above is currently naive implementation
  my $raw_string = read_infodb_rawentry($infodb_type, $infodb_file_path, $infodb_key);
  my $infodb_rec = &dbutil::convert_infodb_string_to_hash($raw_string); 
  
  return $infodb_rec;
}


# ---- GENERAL FUNCTIONS --------

sub convert_infodb_hash_to_string
{
  my $infodb_map = shift(@_);

  my $infodb_entry_value = "";
  foreach my $infodb_value_key (keys(%$infodb_map))
  {
    foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}})
    {
      $infodb_entry_value .= "<$infodb_value_key>" . $infodb_value . "\n";
    }
  }

  return $infodb_entry_value;
}


sub convert_infodb_string_to_hash
{
  my $infodb_entry_value = shift(@_);
  my $infodb_map = ();
  
  if (!defined $infodb_entry_value) {
    print STDERR "Warning: No value to convert into a infodb hashtable\n";
  }
  else {
    while ($infodb_entry_value =~ /^<(.*?)>(.*)$/mg)
    {
        my $infodb_value_key = $1;
        my $infodb_value = $2;

        if (!defined($infodb_map->{$infodb_value_key}))
        {
          $infodb_map->{$infodb_value_key} = [ $infodb_value ];
        }
        else
        {
          push(@{$infodb_map->{$infodb_value_key}}, $infodb_value);
        }
    }
  }

  return $infodb_map;
}


1;