############################################################################### # # GDBM.pm -- utility functions for writing to gdbm databases # # A component of the Greenstone digital library software from the New Zealand # Digital Library Project at the University of Waikato, New Zealand. # # Copyright (C) 1999-2015 New Zealand Digital Library Project # # 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 DBDrivers::GDBM; # Pragma use strict; # Libraries use util; use FileUtils; use DBDrivers::BaseDBDriver; sub BEGIN { @DBDrivers::GDBM::ISA = ( 'DBDrivers::BaseDBDriver' ); } sub new { my $class = shift(@_); return bless ($self, $class); } # ----------------------------------------------------------------------------- # GDBM IMPLEMENTATION # ----------------------------------------------------------------------------- ## @function open_infodb_write_handle(string, string) # sub open_infodb_write_handle { my $infodb_file_path = shift(@_); my $opt_append = shift(@_); my $txt2db_exe = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"bin",$ENV{'GSDLOS'}, "txt2db" . &util::get_os_exe()); my $infodb_file_handle = undef; my $cmd = "\"$txt2db_exe\""; if ((defined $opt_append) && ($opt_append eq "append")) { $cmd .= " -append"; } $cmd .= " \"$infodb_file_path\""; if (!-e "$txt2db_exe") { print STDERR "Error: Unable to find $txt2db_exe\n"; return undef; } if(!open($infodb_file_handle, "| $cmd")) { print STDERR "Error: Failed to open pipe to $cmd\n"; print STDERR " $!\n"; return undef; } binmode($infodb_file_handle,":utf8"); return $infodb_file_handle; } ## open_infodb_write_handle(string, string) => filehandle ## ## @function close_infodb_write_handle(filehandle) # sub close_infodb_write_handle { my $infodb_handle = shift(@_); close($infodb_handle); } ## close_infodb_write_handle(filehandle) => void ## ## @function get_infodb_file_path() # sub get_infodb_file_path { my $collection_name = shift(@_); my $infodb_directory_path = shift(@_); my $infodb_file_extension = ".gdb"; my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension; return &FileUtils::filenameConcatenate($infodb_directory_path, $infodb_file_name); } ## get_infodb_file_path() => string ## ## @function read_infodb_file(string, hashmap) # sub read_infodb_file { my $infodb_file_path = shift(@_); my $infodb_map = shift(@_); open (PIPEIN, "db2txt \"$infodb_file_path\" |") || die "couldn't open pipe from db2txt \$infodb_file_path\"\n"; binmode(PIPEIN,":utf8"); my $infodb_line = ""; my $infodb_key = ""; my $infodb_value = ""; while (defined ($infodb_line = )) { $infodb_line =~ s/(\r\n)+$//; # more general than chomp if ($infodb_line =~ /^\[([^\]]+)\]$/) { $infodb_key = $1; } elsif ($infodb_line =~ /^-{70}$/) { $infodb_map->{$infodb_key} = $infodb_value; $infodb_key = ""; $infodb_value = ""; } else { $infodb_value .= $infodb_line; } } close (PIPEIN); } ## read_infodb_file(string, hashmap) => void ## ## @function read_infodb_keys(string, hashmap) # sub read_infodb_keys { my $infodb_file_path = shift(@_); my $infodb_map = shift(@_); open (PIPEIN, "gdbmkeys \"$infodb_file_path\" |") || die "couldn't open pipe from gdbmkeys \$infodb_file_path\"\n"; binmode(PIPEIN,":utf8"); my $infodb_line = ""; my $infodb_key = ""; my $infodb_value = ""; while (defined ($infodb_line = )) { # chomp $infodb_line; # remove end of line $infodb_line =~ s/(\r\n)+$//; # more general than chomp $infodb_map->{$infodb_line} = 1; } close (PIPEIN); } ## read_infodb_keys(string, hashmap) => void ## ## @function write_infodb_entry(filehandle, string, hashmap) # sub write_infodb_entry { my $infodb_handle = shift(@_); my $infodb_key = shift(@_); my $infodb_map = shift(@_); print $infodb_handle "[$infodb_key]\n"; foreach my $infodb_value_key (sort keys(%$infodb_map)) { foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}}) { if ($infodb_value =~ /-{70,}/) { # if value contains 70 or more hyphens in a row we need to escape them # to prevent txt2db from treating them as a separator $infodb_value =~ s/-/&\#045;/gi; } print $infodb_handle "<$infodb_value_key>" . $infodb_value . "\n"; } } print $infodb_handle '-' x 70, "\n"; } ## write_infodb_entry(filehandle, string, hashmap) => void ## ## @function write_infodb_rawentry(filehandle, string, string) # sub write_infodb_rawentry { my $infodb_handle = shift(@_); my $infodb_key = shift(@_); my $infodb_val = shift(@_); print $infodb_handle "[$infodb_key]\n"; print $infodb_handle "$infodb_val\n"; print $infodb_handle '-' x 70, "\n"; } ## write_infodb_rawentry(filehandle, string, string) ## ## @function set_infodb_entry(string, string, hashmap) # sub set_infodb_entry { my $infodb_file_path = shift(@_); my $infodb_key = shift(@_); my $infodb_map = shift(@_); # HTML escape anything that is not part of the "contains" metadata value foreach my $k (keys %$infodb_map) { my @escaped_v = (); foreach my $v (@{$infodb_map->{$k}}) { if ($k eq "contains") { push(@escaped_v, $v); } else { my $ev = &ghtml::unescape_html($v); push(@escaped_v, $ev); } } $infodb_map->{$k} = \@escaped_v; } # Generate the record string my $serialized_infodb_map = &dbutil::convert_infodb_hash_to_string($infodb_map); # Store it into GDBM using 'txt2db -append' which despite its name # actually replaces the record if it already exists my $cmd = "txt2db -append \"$infodb_file_path\""; my $status = undef; if(!open(GOUT, "| $cmd")) { print STDERR "Error: gdbm::set_infodb_entry() failed to open pipe to: $cmd\n"; print STDERR " $!\n"; $status = -1; } else { binmode(GOUT,":utf8"); print GOUT "[$infodb_key]\n"; print GOUT "$serialized_infodb_map\n"; close(GOUT); $status = 0; # as in exit status of cmd OK } return $status; } ## set_infodb_entry(string, string, hashmap) => integer ## ## @function delete_infodb_entry(filehandle, string) # sub delete_infodb_entry { my $infodb_handle = shift(@_); my $infodb_key = shift(@_); # A minus at the end of a key (after the ]) signifies 'delete' print $infodb_handle "[$infodb_key]-\n"; # The 70 minus signs are also needed, to help make the parsing by db2txt simple print $infodb_handle '-' x 70, "\n"; } ## delete_infodb_entry(filehandle, string) => void ## 1;