Index: /gs2-extensions/tdb-edit/trunk/src/perllib/dbutil.pm
===================================================================
--- /gs2-extensions/tdb-edit/trunk/src/perllib/dbutil.pm	(revision 24068)
+++ /gs2-extensions/tdb-edit/trunk/src/perllib/dbutil.pm	(revision 24068)
@@ -0,0 +1,313 @@
+###########################################################################
+#
+# 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() **/
+
+
+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";
+}
+
+
+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, @_);
+}
+
+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;
