source: gs2-extensions/parallel-building/trunk/src/perllib/DBDrivers/TDBCLUSTER.pm@ 30350

###########################################################################
#
# TDBCLUSTER -- utility functions for writing to TDB databases. Should be
#               hauntingly similar to GDBM utility functions. However, allows
#               TDB to be run on a cluster where the locking mechanism for
#               multiple reader/writers only works on a per-computer node
#               basis. Essentially, each compute node gets its own data-
#               base to write to (possible with multiple writers) and then
#               the top-level caller merges these individual databases back
#               into a single database.
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the
# University of Waikato, New Zealand.
#
# Copyright (c) 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::TDBCLUSTER;

# Pragma
use strict;

sub BEGIN
{
    if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) {
        die("Error! Environment not prepared. Have you sourced setup.bash?\n");
    }
    if (!defined $ENV{'GEXTTDBEDIT_INSTALLED'}) {
        die("Error! Path to TDB binaries not found. Have you sourced setup.bash?\n");
    }
}

# Libraries/Modules
use Cwd;
use dbutil::gdbmtxtgz;
use dbutil::tdb;
use parent 'DBDrivers::70HyphenFormat';

##
#
sub new
{
    my $class = shift(@_);

    my $self = DBDrivers::70HyphenFormat->new(@_);

    # Default TDB file extension
    $self->{'default_file_extension'} = 'tdb';
    # Should the TDB used a specific affinity?
    $self->{'forced_affinity'} = -1; # zero upwards indicates the affinity
    # Ask TDB executables to display debugging information?
    $self->{'tdb_debug'} = 0; # 1 to enable

    # On a cluster, we need to know the hostname of the headnode
    $self->{'headnode'} = 'medusa';

    # note: file separator agnostic
    $self->{'executable_path'} = $ENV{GEXTTDBEDIT_INSTALLED} . '/bin/';
    $self->{'read_executable'} = 'tdb2txt';
    $self->{'keyread_executable'} = 'tdbkeys';
    $self->{'write_executable'} = 'txt2tdb';

    # Optional Support
    $self->{'supports_persistentconnection'} = 1;
    $self->{'supports_set'} = 1;

    bless($self, $class);
    return $self;
}

# -----------------------------------------------------------------------------
#   TDB IMPLEMENTATION
# -----------------------------------------------------------------------------

## @function get_tdb_executable(string)
#
sub get_tdb_executable
{
    my $self = shift(@_);
    my $program = shift(@_);
    my $program_exe = &util::filename_cat($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(string) => string ##

## @function
#
sub get_infodb_file_path
{
    my $self = shift(@_);
    my $collection_name = shift(@_);
    my $infodb_directory_path = shift(@_);
#    my $perform_firsttime_initialization = shift(@_);
    my $hostname = shift(@_);
#    if (!defined $perform_firsttime_initialization) {
#   $perform_firsttime_initialization = 0;
#    }
    if (!defined $hostname) {
    $hostname = `hostname -s`;
    $hostname =~ s/^\s*|\s*$//gi;
    # Special case: look up the head node (top of list) from mpi.conf and do
    # not add suffix if a match
    if ($hostname eq $self->{'headnode'}) {
        $hostname = '';
    }
    }
    my $infodb_file_extension = $self->{'default_file_extension'};
    $self->debugPrint('DBDrivers::TDBCLUSTER::get_infodb_file_path("' . $collection_name . '","' . $infodb_directory_path . '","' . $hostname . '")' . "\n");
    if ($hostname ne '') {
    $infodb_file_extension = '.' . $hostname . '.' . $infodb_file_extension;
    }
    my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
    my $path = &util::filename_cat($infodb_directory_path, $infodb_file_name);
    ###rint STDERR ' => ' . $path . "\n";
    return $path;
}
## get_infodb_file_path() => string ##


## @function mergeDatabases(string, string) => integer
#
sub mergeDatabases
{
    my $self = shift(@_);
    my $source_infodb_file_path = shift(@_);
    my $target_infodb_file_path = shift(@_);
    # path specific filenames
    my $tdb2txt_exe = &FileUtils::filenameConcatenate($self->{'executable_path'}, $self->{'read_executable'} . &util::get_os_exe());
    my $txt2tdb_exe = &FileUtils::filenameConcatenate($self->{'executable_path'}, $self->{'write_executable'} . &util::get_os_exe());
    my $cmd = $tdb2txt_exe . ' "' . $source_infodb_file_path . '" | ' . $txt2tdb_exe . ' -append "' . $target_infodb_file_path . '"';
    ###rint STDERR "[DEBUG] cmd: " . $cmd . "\n";
    my $status = system($cmd);
    ###rint STDERR "[DEBUG] status: $status\n";
    if ($status == 0) {
    &FileUtils::removeFiles($source_infodb_file_path);
    }
    return $status;
}
## mergeDatabases(string, string) => integer ##


1;