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

Revision 30319, 4.7 KB (checked in by jmt12, 5 years ago)

Working on a drop-in replacement for dbutil.pm that is aware of the new object oriented database drivers

  • Property svn:executable set to *
Line 
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
26package dbutil;
27
28use strict;
29
30require util;
31use FileUtils;
32use gsprintf 'gsprintf';
33
34## Private
35
36## A hashmap tracking DBDriver objects by name
37my %dbdriver_pool;
38
39my $debug = 1;
40
41my $init_inc = 1;
42
43
44## @function _debugPrint(string, boolean)
45#
46sub _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#
64sub _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#
130sub close_all
131{
132    foreach my $dbdriver (values %dbdriver_pool) {
133        $dbdriver->close_infodb_write_handle();
134    }
135}
136## close_all(void) => void ##
137
1381;
Note: See TracBrowser for help on using the browser.