package GDBMUtils; use strict; use util; my $debug = 0; # /** Global variables to hold a strings containing: # * the last collection, oid and value # * a gdbmCachedCollectionGet() was performed on. # */ my $gdbmget_previous_collection = ""; my $gdbmget_previous_oid = ""; my $gdbmget_previous_value = ""; sub gdbmDatabaseGet { my ($database, $oid) = @_; # Are we in windows? Do we need .exe? my $exe = &util::get_os_exe(); # Retrieve the raw document content print STDERR "#Get document\ncmd: gdbmget$exe \"$database\" \"$oid\"\n" if $debug; my $value = `gdbmget$exe "$database" "$oid"`; # Done return $value; } sub gdbmRecordToHash { my ($database, $oid) = @_; my $val = gdbmDatabaseGet($database,$oid); my $rec = {}; while ($val =~ m/^<(.*?)>(.*)$/mg) { my $metaname = $1; my $metavalue = $2; if (!defined $rec->{$metaname}) { $rec->{$metaname} = [ $metavalue ]; } else { push(@{$rec->{$metaname}},$metavalue); } } return $rec; } sub gdbmDatabaseAppend { my ($database, $oid, $value) = @_; # Are we in windows? Do we need .exe? my $exe = &util::get_os_exe(); # Escape any speech marks in the value $value =~ s/\"/\\\"/g; # Set the document content print STDERR "#Set document\ncmd: gdbmset$exe \"$database\" \"$oid\" \"$value\" append\n" if $debug; `gdbmset$exe "$database" "$oid" "$value" append`; } sub gdbmDatabaseSet { my ($database, $oid, $value) = @_; # Are we in windows? Do we need .exe? my $exe = &util::get_os_exe(); # 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"`; } sub gdbmDatabaseRemove { my ($database, $oid) = @_; # Are we in windows? Do we need .exe? my $exe = &util::get_os_exe(); # Remove the document from the database print STDERR "#Set document\ncmd: gdbmset$exe \"$database\" \"$oid\"\n" if $debug; `gdbmdel$exe "$database" "$oid"`; } # /** 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 gdbmCachedCollectionGet { 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); my $value = gdbmDatabaseGet($database,$oid); # Tidy up the ever growing number of newlines at the end of the value $value =~ s/(\r?\n)+/$1/g; # Why do we need the above line? At the very least it would seem # better that the data going in to the database through 'set' is # monitored for superfluous \r\n which are then removed before being # saved in GDBM # Cache this result $gdbmget_previous_collection = $collection; $gdbmget_previous_oid = $oid; $gdbmget_previous_value = $value; # Done return $value; } # /** gdbmCachedCollectionGet **/ # /** 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 gdbmCachedCollectionSet { my ($collection, $oid, $value) = @_; # Where's the database? my $database = _getDatabasePath($collection); # Check whether value is set if (defined($value)) { gdbmDatabaseSet($database,$oid,$value); } else { gdbmDatabaseRemove($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; } # /** gdbmCollectionSet **/ # /** 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 = &util::is_little_endian() ? ".ldb" : ".bdb"; # Now return the full filename of the database return &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection, "index", "text", $collection.$ext); } # /** getDatabasePath **/ 1;