########################################################################### # # dbutil::tdb -- utility functions for writing to tdb databases. Should be # hauntingly similar to GDBM utility functions. # # A component of the Greenstone digital library software # from the New Zealand Digital Library Project at the # University of Waikato, New Zealand. # # Copyright (C) 2011 # # 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::tdb; # Pragma use strict; # Libraries/Modules use Cwd; use dbutil::gdbmtxtgz; # ----------------------------------------------------------------------------- # TDB IMPLEMENTATION # ----------------------------------------------------------------------------- our %handle_pool; END { # Close any handles left open in the pool foreach my $pool_key (keys %handle_pool) { my $infodb_file_handle = $handle_pool{$pool_key}; close_infodb_write_handle($infodb_file_handle, 1); } } # /** # */ sub get_tdb_executable { my $program = shift(@_); if (!defined $ENV{GEXTTDBEDIT_INSTALLED} || !-d $ENV{GEXTTDBEDIT_INSTALLED}) { die('Fatal Error! Path to TDB binaries not found. Have you sourced setup.bash?'); } my $program_exe = &util::filename_cat($ENV{GEXTTDBEDIT_INSTALLED} . '/bin/' . $program . &util::get_os_exe()); if (!-x $program_exe) { die('Fatal Error! File doesn\'t exist or isn\'t executable: ' . $program_exe); } return $program_exe; } # /** get_tdb_executable() **/ # /** # */ sub open_infodb_write_handle { my $infodb_file_path = shift(@_); my $opt_append = shift(@_); my $txt2tdb_exe = &dbutil::tdb::get_tdb_executable('txt2tdb'); my $pool_key = $infodb_file_path; #my $cmd = "taskset -c 5 \"$txt2tdb_exe\""; my $cmd = "\"$txt2tdb_exe\""; if ((defined $opt_append) && ($opt_append eq "append")) { $cmd .= " -append"; $pool_key .= '-append'; } $cmd .= " \"$infodb_file_path\""; #$cmd .= " -debug"; # Uncomment to enable debug timing # we're going to pipe the key value pairs, in the appropriate format, from # within the buildproc, so we create a piped handle here my $infodb_file_handle = undef; if (defined $handle_pool{$pool_key}) { $infodb_file_handle = $handle_pool{$pool_key}; } else { print STDERR "tdb::open_infodb_write_handle(" . $infodb_file_path . ")\n"; 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"); $handle_pool{$pool_key} = $infodb_file_handle; } return $infodb_file_handle; } # /** open_infodb_write_handle() **/ # /** # */ sub close_infodb_write_handle { my $infodb_handle = shift(@_); my ($empty_pool) = @_; if (defined $empty_pool && $empty_pool == 1) { print STDERR "tdb::close_infodb_write_handle()\n"; close($infodb_handle); } } # /** close_infodb_write_handle() **/ # /** # */ sub get_infodb_file_path { my $collection_name = shift(@_); my $infodb_directory_path = shift(@_); my $infodb_file_extension = ".tdb"; my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension; return &util::filename_cat($infodb_directory_path, $infodb_file_name); } # /** get_infodb_file_path() **/ # /** # */ sub read_infodb_file { my $infodb_file_path = shift(@_); my $infodb_map = shift(@_); my $tdb2txt_exe = &dbutil::tdb::get_tdb_executable('tdb2txt'); if (!open (PIPEIN, "\"$tdb2txt_exe\" \"$infodb_file_path\" |")) { print STDERR 'Error: Failed to open pipe to ' . $tdb2txt_exe . "\n"; print STDERR " $!\n"; return undef; } binmode(PIPEIN,":utf8"); my $infodb_line = ""; my $infodb_key = ""; my $infodb_value = ""; while (defined ($infodb_line = )) { 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() **/ # /** # */ sub read_infodb_keys { my $infodb_file_path = shift(@_); my $infodb_map = shift(@_); my $tdbkeys_exe = &dbutil::tdb::get_tdb_executable('tdbkeys'); if (!open (PIPEIN, "\"tdbkeys_exe\" \"$infodb_file_path\" |")) { die "couldn't open pipe from gdbmkeys \$infodb_file_path\"\n$!\n"; } binmode(PIPEIN,":utf8"); my $infodb_line = ""; my $infodb_key = ""; my $infodb_value = ""; while (defined ($infodb_line = )) { # remove end of line chomp $infodb_line; $infodb_map->{$infodb_line} = 1; } close (PIPEIN); } # /** read_infodb_keys() **/ # /** # */ sub write_infodb_entry { # With infodb_handle already set up, works the same as gdbm and gdbm_txtgz # versions &dbutil::gdbmtxtgz::write_infodb_entry(@_); } # /** write_infodb_entry() **/ # /** # */ sub write_infodb_rawentry { # With infodb_handle already set up, works the same as gdbm and gdbm_txtgz # versions &dbutil::gdbmtxtgz::write_infodb_rawentry(@_); } # /** write_infodb_rawentry() **/ # /** # */ sub set_infodb_entry { my $infodb_file_path = shift(@_); my $infodb_key = shift(@_); my $infodb_map = shift(@_); # Protect metadata values that go inside quotes for tdbset foreach my $k (keys %$infodb_map) { my @escaped_v = (); foreach my $v (@{$infodb_map->{$k}}) { if ($k eq "contains") { # protect quotes in ".2;".3 etc $v =~ s/\"/\\\"/g; push(@escaped_v, $v); } else { my $ev = &ghtml::unescape_html($v); $ev =~ s/\"/\\\"/g; 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); ## print STDERR "**** ser dr\n$serialized_infodb_map\n\n\n"; # Store it into GDBM my $tdbset_exe = &dbutil::tdb::get_tdb_executable('tdbset'); my $cmd = "\"tdbset_exe\" \"$infodb_file_path\" \"$infodb_key\" \"$serialized_infodb_map\""; my $status = system($cmd); return $status; } # /** set_infodb_entry() **/ # /** # */ sub delete_infodb_entry { # With infodb_handle already set up, works the same as gdbm and gdbm_txtgz # versions &dbutil::gdbmtxtgz::delete_infodb_entry(@_); } # /** delete_infodb_entry() **/ 1;