source: gs2-extensions/tdb/trunk/perllib/dbutil2.pm@ 30319

###############################################################################
#
# dbutil.pm -- functions to handle using dbdrivers
#
# Copyright (C) 2015 New Zealand Digital Library Project
#
# A component of the Greenstone digital library software from the New Zealand
# Digital Library Project at the University of Waikato, New Zealand.
#
# 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;

use strict;

require util;
use FileUtils;
use gsprintf 'gsprintf';

## Private

## A hashmap tracking DBDriver objects by name
my %dbdriver_pool;

my $debug = 1;

my $init_inc = 1;


## @function _debugPrint(string, boolean)
#
sub _debugPrint
{
    my ($message, $newline) = @_;
    if ($debug) {
        if (!defined($newline)) {
            $newline = 1;
        }
        print STDERR $message;
        if ($newline) {
            print STDERR "\n";
        }
    }
}
## _debugPrint(string, boolean) => void ##


## @function _loadDBDriver(string, string)
#
sub _loadDBDriver
{
    my ($dbdriver_name, $db_filepath) = @_;
    my $dbdriver;
    # Ensure the driver has the correct package prefix
    if ($dbdriver_name !~ /^DBDrivers/) {
        $dbdriver_name = 'DBDrivers::';
    }
    # We only need to create each driver once
    if (defined($dbdriver_pool->{$dbdriver_name})) {
        &_debugPrint('Returning existing DBDriver: ' . $dbdriver_name);
        $dbdriver = $dbdriver_pool->{$dbdriver_name};
    }
    else {
        # If this is the first time this function is called, ensure that INC is
        # populated with the various possible perllib paths (with later options
        # overriding earlier ones) ...
        if ($init_inc) {
            &_debugPrint('Ensuring @INC contains perllib paths... ', 0);
            my @possible_paths;
            #... the main perllib directory...
            push(@possible_paths, &FileUtils::filenameConcatenate());
            #... a collection specific perllib directory...
            push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, 'collect', $ENV{'GSDLCOLLECTION'}, 'perllib'));
            #... any registered extension may also have a perllib!
            foreach my $gs2_extension (split(/:/, $ENV{'GSDLEXTS'})) {
                push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'ext', $gs2_extension, 'perllib'));
            }
            foreach my $gs3_extension (split(/:/, $ENV{'GSDL3EXTS'})) {
                push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, 'ext', $gs3_extension, 'perllib'));
            }
            my $path_counter = 0;
            foreach my $possible_path (@possible_paths) {
                # we only try adding paths that actually exist
                if (-d $possible_path) {
                    my $did_add_path = &util::augmentINC($perllib_dbdriver_path);
                    if ($did_add_path) {
                        $path_counter++;
                    }
                }
            }
            $init_inc = 0;
            &_debugPrint('Done! Added ' . $path_counter . ' paths');
        }
        &_debugPrint('Loading DBDriver: ' . $dbdriver_name);
        # Assuming the INC is correctly setup, then this should work nicely
        # - make sure we have required this dbdriver package
        unless( $INC{$dbdriver_name} ) {
            require $dbdriver_name;
        }
        # Then initialise and return a new one
        $dbdriver = new $dbdriver_name();
        # Store it for later use
        $dbdriver_pool->{$dbdriver_name} = $dbdriver;
    }
    return $dbdriver;
}
## _loadDBDriver(string, string) => BaseDBDriver ##


################################################################################
## Functions over the collection of database drivers                          ##
################################################################################

## @function close_all(void)
#
sub close_all
{
    foreach my $dbdriver (values %dbdriver_pool) {
        $dbdriver->close_infodb_write_handle();
    }
}
## close_all(void) => void ##

1;