[30319] | 1 | ###############################################################################
|
---|
| 2 | #
|
---|
| 3 | # dbutil.pm -- functions to handle using dbdrivers
|
---|
| 4 | #
|
---|
| 5 | # Copyright (C) 2015 New Zealand Digital Library Project
|
---|
| 6 | #
|
---|
| 7 | # A component of the Greenstone digital library software from the New Zealand
|
---|
| 8 | # Digital Library Project at the University of Waikato, New Zealand.
|
---|
| 9 | #
|
---|
| 10 | # This program is free software; you can redistribute it and/or modify it under
|
---|
| 11 | # the terms of the GNU General Public License as published by the Free Software
|
---|
| 12 | # Foundation; either version 2 of the License, or (at your option) any later
|
---|
| 13 | # version.
|
---|
| 14 | #
|
---|
| 15 | # This program is distributed in the hope that it will be useful, but WITHOUT
|
---|
| 16 | # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
---|
| 17 | # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
|
---|
| 18 | # details.
|
---|
| 19 | #
|
---|
| 20 | # You should have received a copy of the GNU General Public License along with
|
---|
| 21 | # this program; if not, write to the Free Software Foundation, Inc., 675 Mass
|
---|
| 22 | # Ave, Cambridge, MA 02139, USA.
|
---|
| 23 | #
|
---|
| 24 | ###############################################################################
|
---|
| 25 |
|
---|
| 26 | package dbutil;
|
---|
| 27 |
|
---|
| 28 | use strict;
|
---|
| 29 |
|
---|
| 30 | require util;
|
---|
| 31 | use FileUtils;
|
---|
| 32 | use gsprintf 'gsprintf';
|
---|
| 33 |
|
---|
| 34 | ## Private
|
---|
| 35 |
|
---|
| 36 | ## A hashmap tracking DBDriver objects by name
|
---|
| 37 | my %dbdriver_pool;
|
---|
| 38 |
|
---|
| 39 | my $debug = 1;
|
---|
| 40 |
|
---|
| 41 | my $init_inc = 1;
|
---|
| 42 |
|
---|
| 43 |
|
---|
| 44 | ## @function _debugPrint(string, boolean)
|
---|
| 45 | #
|
---|
| 46 | sub _debugPrint
|
---|
| 47 | {
|
---|
| 48 | my ($message, $newline) = @_;
|
---|
| 49 | if ($debug) {
|
---|
| 50 | if (!defined($newline)) {
|
---|
| 51 | $newline = 1;
|
---|
| 52 | }
|
---|
| 53 | print STDERR $message;
|
---|
| 54 | if ($newline) {
|
---|
| 55 | print STDERR "\n";
|
---|
| 56 | }
|
---|
| 57 | }
|
---|
| 58 | }
|
---|
| 59 | ## _debugPrint(string, boolean) => void ##
|
---|
| 60 |
|
---|
| 61 |
|
---|
| 62 | ## @function _loadDBDriver(string, string)
|
---|
| 63 | #
|
---|
| 64 | sub _loadDBDriver
|
---|
| 65 | {
|
---|
| 66 | my ($dbdriver_name, $db_filepath) = @_;
|
---|
| 67 | my $dbdriver;
|
---|
| 68 | # Ensure the driver has the correct package prefix
|
---|
| 69 | if ($dbdriver_name !~ /^DBDrivers/) {
|
---|
| 70 | $dbdriver_name = 'DBDrivers::';
|
---|
| 71 | }
|
---|
| 72 | # We only need to create each driver once
|
---|
| 73 | if (defined($dbdriver_pool->{$dbdriver_name})) {
|
---|
| 74 | &_debugPrint('Returning existing DBDriver: ' . $dbdriver_name);
|
---|
| 75 | $dbdriver = $dbdriver_pool->{$dbdriver_name};
|
---|
| 76 | }
|
---|
| 77 | else {
|
---|
| 78 | # If this is the first time this function is called, ensure that INC is
|
---|
| 79 | # populated with the various possible perllib paths (with later options
|
---|
| 80 | # overriding earlier ones) ...
|
---|
| 81 | if ($init_inc) {
|
---|
| 82 | &_debugPrint('Ensuring @INC contains perllib paths... ', 0);
|
---|
| 83 | my @possible_paths;
|
---|
| 84 | #... the main perllib directory...
|
---|
| 85 | push(@possible_paths, &FileUtils::filenameConcatenate());
|
---|
| 86 | #... a collection specific perllib directory...
|
---|
| 87 | push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, 'collect', $ENV{'GSDLCOLLECTION'}, 'perllib'));
|
---|
| 88 | #... any registered extension may also have a perllib!
|
---|
| 89 | foreach my $gs2_extension (split(/:/, $ENV{'GSDLEXTS'})) {
|
---|
| 90 | push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'ext', $gs2_extension, 'perllib'));
|
---|
| 91 | }
|
---|
| 92 | foreach my $gs3_extension (split(/:/, $ENV{'GSDL3EXTS'})) {
|
---|
| 93 | push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, 'ext', $gs3_extension, 'perllib'));
|
---|
| 94 | }
|
---|
| 95 | my $path_counter = 0;
|
---|
| 96 | foreach my $possible_path (@possible_paths) {
|
---|
| 97 | # we only try adding paths that actually exist
|
---|
| 98 | if (-d $possible_path) {
|
---|
| 99 | my $did_add_path = &util::augmentINC($perllib_dbdriver_path);
|
---|
| 100 | if ($did_add_path) {
|
---|
| 101 | $path_counter++;
|
---|
| 102 | }
|
---|
| 103 | }
|
---|
| 104 | }
|
---|
| 105 | $init_inc = 0;
|
---|
| 106 | &_debugPrint('Done! Added ' . $path_counter . ' paths');
|
---|
| 107 | }
|
---|
| 108 | &_debugPrint('Loading DBDriver: ' . $dbdriver_name);
|
---|
| 109 | # Assuming the INC is correctly setup, then this should work nicely
|
---|
| 110 | # - make sure we have required this dbdriver package
|
---|
| 111 | unless( $INC{$dbdriver_name} ) {
|
---|
| 112 | require $dbdriver_name;
|
---|
| 113 | }
|
---|
| 114 | # Then initialise and return a new one
|
---|
| 115 | $dbdriver = new $dbdriver_name();
|
---|
| 116 | # Store it for later use
|
---|
| 117 | $dbdriver_pool->{$dbdriver_name} = $dbdriver;
|
---|
| 118 | }
|
---|
| 119 | return $dbdriver;
|
---|
| 120 | }
|
---|
| 121 | ## _loadDBDriver(string, string) => BaseDBDriver ##
|
---|
| 122 |
|
---|
| 123 |
|
---|
| 124 | ################################################################################
|
---|
| 125 | ## Functions over the collection of database drivers ##
|
---|
| 126 | ################################################################################
|
---|
| 127 |
|
---|
| 128 | ## @function close_all(void)
|
---|
| 129 | #
|
---|
| 130 | sub close_all
|
---|
| 131 | {
|
---|
| 132 | foreach my $dbdriver (values %dbdriver_pool) {
|
---|
| 133 | $dbdriver->close_infodb_write_handle();
|
---|
| 134 | }
|
---|
| 135 | }
|
---|
| 136 | ## close_all(void) => void ##
|
---|
| 137 |
|
---|
| 138 | 1;
|
---|