root/gs2-extensions/tdb/trunk/perllib/DBDrivers/BaseDBDriver.pm @ 30347

Revision 30347, 11.8 KB (checked in by jmt12, 4 years ago)

Continuing to refactor driver code to move shared code up to parent classes. Have all the basic drivers done...

  • Property svn:executable set to *
Line 
1###############################################################################
2#
3# BaseDBDriver.pm -- base class for all the database drivers
4# A component of the Greenstone digital library software from the New Zealand
5# Digital Library Project at the University of Waikato, New Zealand.
6#
7# Copyright (C) 1999-2015 New Zealand Digital Library Project
8#
9# This program is free software; you can redistribute it and/or modify it under
10# the terms of the GNU General Public License as published by the Free Software
11# Foundation; either version 2 of the License, or (at your option) any later
12# version.
13#
14# This program is distributed in the hope that it will be useful, but WITHOUT
15# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
17# more details.
18#
19# You should have received a copy of the GNU General Public License along with
20# this program; if not, write to the Free Software Foundation, Inc., 675 Mass
21# Ave, Cambridge, MA 02139, USA.
22#
23###############################################################################
24
25package DBDrivers::BaseDBDriver;
26
27# Pragma
28use strict;
29no strict 'subs';
30no strict 'refs'; # allow filehandles to be variables and viceversa
31
32# Libaries
33use Time::HiRes qw( gettimeofday );
34use gsprintf 'gsprintf';
35
36
37## @function constructor
38#
39sub new
40{
41    my $class = shift(@_);
42    my $debug = shift(@_);
43    my $self = {};
44    # Debug messages for this driver
45    $self->{'debug'} = $debug; # 1 to enable
46    # Keep track of all opened file handles, but only for drivers that support
47    # persistent connections
48    $self->{'handle_pool'} = {};
49    # Default file extension - in this case it is an error to create a DB from
50    # BaseDBDriver
51    $self->{'default_file_extension'} = 'err';
52    # Support
53    $self->{'supports_datestamp'} = 0;
54    $self->{'supports_merge'} = 0;
55    $self->{'supports_persistentconnection'} = 0;
56    $self->{'supports_rss'} = 0;
57    $self->{'supports_set'} = 0;
58    bless($self, $class);
59    return $self;
60}
61## new(void) => BaseDBDriver ##
62
63
64###############################################################################
65## Protected Functions
66###############################################################################
67
68
69## @function debugPrint(string) => void
70#
71sub debugPrint
72{
73    my $self = shift(@_);
74    my $message = shift(@_);
75    if ($self->{'debug'}) {
76    my ($seconds, $microseconds) = gettimeofday();
77    print STDERR '[DEBUG:' . $seconds . '.' . $microseconds . '] ' . (caller 1)[3] . '() ' . $message . "\n";
78    }
79}
80## debugPrint(string) => void ##
81
82
83## @function debugPrintFunctionHeader(*) => void
84#
85sub debugPrintFunctionHeader
86{
87    my $self = shift(@_);
88    if ($self->{'debug'}) {
89    my @arguments;
90    foreach my $argument (@_) {
91        if ($argument !~ /^-?\d+(\.?\d+)?$/) {
92        push(@arguments, '"' . $argument . '"');
93        }
94        else {
95        push(@arguments, $argument);
96        }
97    }
98    my $message = '(' . join(', ', @arguments) . ')';
99    # Would love to just call debugPrint() here, but then caller would be wrong
100    my ($seconds, $microseconds) = gettimeofday();
101    print STDERR '[DEBUG:' . $seconds . '.' . $microseconds . '] ' . (caller 1)[3] . $message . "\n";
102    }
103}
104## debugPrintFunctionHeader(*) => void
105
106
107## @function errorPrint(string, integer) => void
108#
109sub errorPrint
110{
111    my $self = shift(@_);
112    my $message = shift(@_);
113    my $is_fatal = shift(@_);
114    print STDERR 'Error in ' . (caller 1)[3] . '! ' . $message . "\n";
115    if ($is_fatal) {
116    exit();
117    }
118}
119## errorPrint(string, integer) => void ##
120
121
122## @function registerConnectionIfPersistent(filehandle, string, string) => void
123#
124sub registerConnectionIfPersistent
125{
126    my $self = shift(@_);
127    my $conn = shift(@_);
128    my $path = shift(@_);
129    my $append = shift(@_);
130    if ($self->{'supports_persistentconnection'}) {
131    $self->debugPrintFunctionHeader($conn, $path, $append);
132    my $fhid = $path;
133    if (defined $append && $append eq '-append') {
134        $fhid .= ' [APPEND]';
135    }
136    $self->debugPrint('Registering connection: "' . $fhid . '"');
137    $self->{'handle_pool'}->{$fhid} = $conn;
138    }
139    return;
140}
141## registerConnectionIfPersistent(filehandle, string, string) => void ##
142
143
144## @function removeConnectionIfPersistent(filehandle, string) => integer
145#
146sub removeConnectionIfPersistent
147{
148    my $self = shift(@_);
149    my $handle = shift(@_);
150    my $force_close = shift(@_);
151    my $continue_close = 1;
152    if ($self->{'supports_persistentconnection'}) {
153    $self->debugPrintFunctionHeader($handle, $force_close);
154    if (defined($force_close)) {
155        # We'll need the file path so we can locate and remove the entry
156        # in the handle pool (plus possibly the [APPEND] suffix for those
157        # connections in opened in append mode)
158        my $fhid = undef;
159        # Sometimes we can cheat, as the force_close variable will have the
160        # file_path in it thanks to the DESTROY block above. Doing a regex
161        # on force_close will treat it like a string no matter what it was,
162        # and we can search for the appropriate file extension that should
163        # be there for valid paths.
164        my $pattern = '\.' . $self->{'default_file_extension'} . '(\s\[APPEND\])?$';
165        if ($force_close =~ /$pattern/) {
166        $fhid = $force_close;
167        }
168        # If we can't cheat then we are stuck finding which connection in
169        # the handle_pool we are about to close. Need to compare objects
170        # using refaddr()
171        else {
172        foreach my $possible_fhid (keys %{$self->{'handle_pool'}}) {
173            my $possible_handle = $self->{'handle_pool'}->{$possible_fhid};
174            if (ref($handle) && ref($possible_handle) && refaddr($handle) == refaddr($possible_handle)) {
175            $fhid = $possible_fhid;
176            last;
177            }
178        }
179        }
180        # If we found the fhid we can proceed to close the connection
181        if (defined($fhid)) {
182        $self->debugPrint('Closing persistent connection: ' . $fhid);
183        delete($self->{'handle_pool'}->{$fhid});
184        $continue_close = 1;
185        }
186        else {
187        print STDERR "Warning! About to close persistent database handle, but couldn't locate in open handle pool.\n";
188        }
189    }
190    # Persistent connection don't close *unless* force close is set
191    else {
192        $continue_close = 0;
193    }
194    }
195    return $continue_close;
196}
197## removeConnectionIfPersistent(filehandle, string) => integer ##
198
199
200##
201#
202sub retrieveConnectionIfPersistent
203{
204    my $self = shift(@_);
205    my $path = shift(@_);
206    my $append = shift(@_); # -append support
207    my $conn; # This should be populated
208    if ($self->{'supports_persistentconnection'}) {
209    $self->debugPrintFunctionHeader($path, $append);
210    my $fhid = $path;
211    # special case: if the append mode has changed for a persistent
212    # connection, we need to close the old connection first or things
213    # will get wiggy.
214    if (defined $append && $append eq '-append') {
215        # see if there is a non-append mode connection already open
216        if (defined $self->{'handle_pool'}->{$path}) {
217        $self->debugPrint("Append mode added - closing existing non-append mode connection");
218        my $old_conn = $self->{'handle_pool'}->{$path};
219        $self->close_infodb_write_handle($old_conn, $path);
220        }
221        # Append -append so we know what happened.
222        $fhid .= ' [APPEND]';
223    }
224    else {
225        my $fhid_append = $path . ' [APPEND]';
226        if (defined $self->{'handle_pool'}->{$fhid_append}) {
227        $self->debugPrint("Append mode removed - closing existing append mode connection");
228        my $old_conn = $self->{'handle_pool'}->{$fhid_append};
229        $self->close_infodb_write_handle($old_conn, $fhid_append);
230        }
231    }
232    if (defined $self->{'handle_pool'}->{$fhid}) {
233        $self->debugPrint('Retrieving existing connection: ' . $fhid);
234        $conn = $self->{'handle_pool'}->{$fhid};
235    }
236    }
237    return $conn;
238}
239## ##
240
241
242
243
244
245
246
247###############################################################################
248## Public Functions
249###############################################################################
250
251
252## @function get_infodb_file_path(string, string) => string
253#
254sub get_infodb_file_path
255{
256    my $self = shift(@_);
257    my $collection_name = shift(@_);
258    my $infodb_directory_path = shift(@_);
259    my $infodb_file_name = &util::get_dirsep_tail($collection_name) . '.' . $self->{'default_file_extension'};
260    my $infodb_file_path = &FileUtils::filenameConcatenate($infodb_directory_path, $infodb_file_name);
261    # Correct the path separators to work in Cygwin
262    if ($^O eq "cygwin") {
263    $infodb_file_path = `cygpath -w "$infodb_file_path"`;
264    chomp($infodb_file_path);
265    $infodb_file_path =~ s%\\%\\\\%g;
266    }
267    return $infodb_file_path;
268}
269## get_infodb_file_path(string, string) => string ##
270
271
272## @function supportsDatestamp(void) => integer
273#
274sub supportsDatestamp
275{
276    my $self = shift(@_);
277    return $self->{'supports_datestamp'};
278}
279## supportsDatestamp(void) => integer ##
280
281
282## @function supportsMerge(void) => boolean
283#
284sub supportsMerge
285{
286    my $self = shift(@_);
287    return $self->{'supports_merge'};
288}
289## supportsMerge(void) => integer ##
290
291
292## @function supportsPersistentConnection(void) => integer
293#
294sub supportsPersistentConnection
295{
296    my $self = shift(@_);
297    return $self->{'supports_persistentconnection'};
298}
299## supportsPersistentConnection(void) => integer ##
300
301
302## @function supportsRSS(void) => integer
303#
304sub supportsRSS
305{
306    my $self = shift(@_);
307    return $self->{'supports_rss'};
308}
309## supportsRSS(void) => integer ##
310
311
312## @function supportsSet(void) => integer
313#
314#  Not all drivers support the notion of set
315#
316sub supportsSet
317{
318    my $self = shift(@_);
319    return $self->{'supports_set'};
320}
321## supportsSet(void) => integer ##
322
323
324###############################################################################
325## Virtual Functions
326###############################################################################
327
328
329## @function close_infodb_write_handle(*) => void
330#
331sub close_infodb_write_handle
332{
333    my $self = shift(@_);
334    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
335    die("\n");
336}
337## close_infodb_write_handle(*) => void ##
338
339
340## @function delete_infodb_entry(*) => void
341#
342sub delete_infodb_entry
343{
344    my $self = shift(@_);
345    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
346    die("\n");
347}
348## delete_infodb_entry(*) => void ##
349
350
351## @function mergeDatabases(*) => void
352#
353sub mergeDatabases
354{
355    my $self = shift(@_);
356    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
357    die("\n");
358}
359## mergeDatabases(*) => void ##
360
361
362## @function open_infodb_write_handle(*) => void
363#
364sub open_infodb_write_handle
365{
366    my $self = shift(@_);
367    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
368    die("\n");
369}
370## open_infodb_write_handle(*) => void ##
371
372
373## @function set_infodb_entry(*) => void
374#
375sub set_infodb_entry
376{
377    my $self = shift(@_);
378    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
379    die("\n");
380}
381## set_infodb_entry(*) => void ##
382
383
384## @function read_infodb_rawentry(*) => string
385#
386sub read_infodb_rawentry
387{
388    my $self = shift(@_);
389    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
390    die("\n");
391}
392## read_infodb_rawentry(*) => string ##
393
394
395## @function read_infodb_file(*) => void
396#
397sub read_infodb_file
398{
399    my $self = shift(@_);
400    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
401    die("\n");
402}
403## read_infodb_file(*) => void ##
404
405
406## @function read_infodb_keys(*) => void
407#
408sub read_infodb_keys
409{
410    my $self = shift(@_);
411    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
412    die("\n");
413}
414## read_infodb_keys(*) => void ##
415
416
417## @function write_infodb_entry(*) => void
418#
419sub write_infodb_entry
420{
421    my $self = shift(@_);
422    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
423    die("\n");
424}
425## write_infodb_entry(*) => void ##
426
427
428## @function write_infodb_rawentry(*) => void
429#
430sub write_infodb_rawentry
431{
432    my $self = shift(@_);
433    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
434    die("\n");
435}
436## write_infodb_rawentry(*) => void ##
437
438
4391;
Note: See TracBrowser for help on using the browser.