source: gsdl/trunk/perllib/GDBMUtils.pm@ 15890

package GDBMUtils;

use strict;
use util;

my $debug = 0;

# /** Global variable to hold a string containing the last collection a gdbmGet 
#  *  was performed on.
#  */
my $gdbmget_previous_collection = "";
# /** Global variable to hold a string containing the last oid a gdbmGet was 
#  *  performed on.
#  */
my $gdbmget_previous_oid = "";
# /** Global variable to hold a string containing the resulting value of the
#  *  last gdbmGet request.
#  */
my $gdbmget_previous_value = "";

# /** This wraps John T's gdbmget executable to get the gdbm database entry for
#  *  a particular OID.
#  *
#  *  @param $collection is the collection name.
#  *  @param $oid is the internal document id.
#  *
#  *
#  *  @author John Rowe, DL Consulting Ltd.
#  *  @author John Thompson, DL Consulting Ltd.
#  */
sub gdbmGet()
  {
    my ($collection, $oid) = @_;
    # Start by checking if this request is the same as the previous one, and if
    # so return the cache version instead. This is an optimization to improve
    # performance when checking if a certain GDBM document exists before 
    # creating a new node object
    if($collection eq $gdbmget_previous_collection 
       && $oid eq $gdbmget_previous_oid)
      {
        print STDERR "#Get document - using cached value\n" if $debug;
        return $gdbmget_previous_value;
      }
    # Where's the database?
    my $database = &getDatabasePath($collection);
    # Are we in windows? Do we need .exe?
    my $exe = "";
    $exe = ".exe" if $ENV{'GSDLOS'} =~ /^windows$/i;
    # Retrieve the raw document content
    print STDERR "#Get document\ncmd: gdbmget$exe \"$database\" \"$oid\"\n" if $debug;
    my $value = `gdbmget$exe "$database" "$oid"`;
    # Tidy up the ever growing number of newlines at the end of the value
    $value =~ s/(\r?\n)+/$1/g;
    # Cache this result
    $gdbmget_previous_collection = $collection;
    $gdbmget_previous_oid = $oid;
    $gdbmget_previous_value = $value;
    # Done
    return $value;
  }
# /** gdbmGet() **/

# /** This wraps John T's gdbmset executable to set the gdbm database entry for
#  *  a particular OID. This does not yet report errors.
#  *
#  *  @param $collection is the collection name.
#  *  @param $oid is the internal document id.
#  *  @param $value is the new value to set for the oid.
#  *
#  *  @author John Rowe, DL Consulting Ltd.
#  */
sub gdbmSet()
  {
    my ($collection, $oid, $value) = @_;
    # Where's the database?
    my $database = &getDatabasePath($collection);
    # Are we in windows? Do we need .exe?
    my $exe = &util::get_os_exe();
    # Check whether value is set
    if (defined($value))
      {
        # Escape any speech marks in the value
        $value =~ s/\"/\\\"/g;
        # Set the document content
        print STDERR "#Set document\ncmd: gdbmset$exe \"$database\" \"$oid\" \"$value\"\n" if $debug;
        `gdbmset$exe "$database" "$oid" "$value"`;
      }
    else
      {
        # Remove the document from the database
        print STDERR "#Set document\ncmd: gdbmset$exe \"$database\" \"$oid\"\n" if $debug;
        `gdbmset$exe "$database" "$oid"`;
      }
    # Empty any cached values, as they may now be invalid
    # Cache this result
    $gdbmget_previous_collection = "";
    $gdbmget_previous_oid = "";
    $gdbmget_previous_value = 0;
  }
# /** gdbmSet() **/

# /** This works out the database path and returns it to the calling
#  *  calling function.
#  *
#  *  @param $collection The current collection name
#  *
#  *  @author John Rowe, DL Consulting Ltd.
#  */
sub getDatabasePath()
  {
    my $collection = shift(@_);
    # Find out the database extension
    my $ext = ".bdb";
    $ext = ".ldb" if &util::is_little_endian();
    # Now return the full filename of the database
    return &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection, "index", "text", $collection.$ext);
  }
# /** getDatabasePath() **/

1;