root/main/trunk/greenstone2/perllib/DBDrivers/BaseDBDriver.pm @ 30517

Revision 30517, 14.7 KB (checked in by ak19, 4 years ago)

Fixing incremental-rebuild when the database is gdbm. At this point (see buildcolutils.pm), the code needs to deactivate the collection before calling make_infodatabase(), since otherwise there's a lock on the gdbm database which prevents successful incremental-rebuild and activation.

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) 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    # We'll use this in places other than 70HyphenFormat
47    $self->{'70hyphen'} = '-' x 70;
48    # Keep track of all opened file handles, but only for drivers that support
49    # persistent connections
50    $self->{'handle_pool'} = {};
51    # Default file extension - in this case it is an error to create a DB from
52    # BaseDBDriver
53    $self->{'default_file_extension'} = 'err';
54    # Support
55    $self->{'supports_datestamp'} = 0;
56    $self->{'supports_merge'} = 0;
57    $self->{'supports_persistentconnection'} = 0;
58    $self->{'supports_rss'} = 0;
59    $self->{'supports_concurrent_read_and_write'} = 0;
60    $self->{'supports_set'} = 0;
61    $self->{'write_only'} = 0; # Some drivers are one way - i.e. STDOUTXML
62    bless($self, $class);
63    return $self;
64}
65## new(void) => BaseDBDriver ##
66
67
68## @function DESTROY
69#
70# Built-in destructor block that, unlike END, gets passed a reference to self.
71# Responsible for properly closing any open database handles.
72#
73sub DESTROY
74{
75    my $self = shift(@_);
76    # Close all remaining filehandles
77    foreach my $infodb_file_path (keys(%{$self->{'handle_pool'}})) {
78    my $infodb_handle = $self->{'handle_pool'}->{$infodb_file_path};
79    # By passing the filepath as the second argument we instruct the driver
80    # that we actually want to close the connection by passing a non-zero
81    # value, but we sneakily optimize things a little as the close method
82    # can now check to see if it's been provided a file_path rather than
83    # having to search the handle pool for it. The file_path is needed to
84    # remove the closed handle from the pool anyway.
85    $self->close_infodb_write_handle($infodb_handle, $infodb_file_path);
86    }
87}
88## DESTROY(void) => void ##
89
90
91###############################################################################
92## Protected Functions
93###############################################################################
94
95
96## @function debugPrint(string) => void
97#
98sub debugPrint
99{
100    my $self = shift(@_);
101    my $message = shift(@_);
102    if ($self->{'debug'}) {
103    my ($seconds, $microseconds) = gettimeofday();
104    print STDERR '[DEBUG:' . $seconds . '.' . $microseconds . '] ' . (caller 1)[3] . '() ' . $message . "\n";
105    }
106}
107## debugPrint(string) => void ##
108
109
110## @function debugPrintFunctionHeader(*) => void
111#
112sub debugPrintFunctionHeader
113{
114    my $self = shift(@_);
115    if ($self->{'debug'}) {
116    my @arguments;
117    foreach my $argument (@_) {
118        if ($argument !~ /^-?\d+(\.?\d+)?$/) {
119        push(@arguments, '"' . $argument . '"');
120        }
121        else {
122        push(@arguments, $argument);
123        }
124    }
125    my $message = '(' . join(', ', @arguments) . ')';
126    # Would love to just call debugPrint() here, but then caller would be wrong
127    my ($seconds, $microseconds) = gettimeofday();
128    print STDERR '[DEBUG:' . $seconds . '.' . $microseconds . '] ' . (caller 1)[3] . $message . "\n";
129    }
130}
131## debugPrintFunctionHeader(*) => void
132
133
134## @function errorPrint(string, integer) => void
135#
136sub errorPrint
137{
138    my $self = shift(@_);
139    my $message = shift(@_);
140    my $is_fatal = shift(@_);
141    print STDERR 'Error in ' . (caller 1)[3] . '! ' . $message . "\n";
142    if ($is_fatal) {
143    exit();
144    }
145}
146## errorPrint(string, integer) => void ##
147
148
149## @function registerConnectionIfPersistent(filehandle, string, string) => void
150#
151sub registerConnectionIfPersistent
152{
153    my $self = shift(@_);
154    my $conn = shift(@_);
155    my $path = shift(@_);
156    my $append = shift(@_);
157    if ($self->{'supports_persistentconnection'}) {
158    $self->debugPrintFunctionHeader($conn, $path, $append);
159    my $fhid = $path;
160    if (defined $append && $append eq '-append') {
161        $fhid .= ' [APPEND]';
162    }
163    $self->debugPrint('Registering connection: "' . $fhid . '"');
164    $self->{'handle_pool'}->{$fhid} = $conn;
165    }
166    return;
167}
168## registerConnectionIfPersistent(filehandle, string, string) => void ##
169
170
171## @function removeConnectionIfPersistent(filehandle, string) => integer
172#
173sub removeConnectionIfPersistent
174{
175    my $self = shift(@_);
176    my $handle = shift(@_);
177    my $force_close = shift(@_);
178    my $continue_close = 1;
179    if ($self->{'supports_persistentconnection'}) {
180    $self->debugPrintFunctionHeader($handle, $force_close);
181    if (defined($force_close)) {
182        # We'll need the file path so we can locate and remove the entry
183        # in the handle pool (plus possibly the [APPEND] suffix for those
184        # connections in opened in append mode)
185        my $fhid = undef;
186        # Sometimes we can cheat, as the force_close variable will have the
187        # file_path in it thanks to the DESTROY block above. Doing a regex
188        # on force_close will treat it like a string no matter what it was,
189        # and we can search for the appropriate file extension that should
190        # be there for valid paths.
191        my $pattern = '\.' . $self->{'default_file_extension'} . '(\s\[APPEND\])?$';
192        if ($force_close =~ /$pattern/) {
193        $fhid = $force_close;
194        }
195        # If we can't cheat then we are stuck finding which connection in
196        # the handle_pool we are about to close. Need to compare objects
197        # using refaddr()
198        else {
199        foreach my $possible_fhid (keys %{$self->{'handle_pool'}}) {
200            my $possible_handle = $self->{'handle_pool'}->{$possible_fhid};
201            if (ref($handle) && ref($possible_handle) && refaddr($handle) == refaddr($possible_handle)) {
202            $fhid = $possible_fhid;
203            last;
204            }
205        }
206        }
207        # If we found the fhid we can proceed to close the connection
208        if (defined($fhid)) {
209        $self->debugPrint('Closing persistent connection: ' . $fhid);
210        delete($self->{'handle_pool'}->{$fhid});
211        $continue_close = 1;
212        }
213        else {
214        print STDERR "Warning! About to close persistent database handle, but couldn't locate in open handle pool.\n";
215        }
216    }
217    # Persistent connection don't close *unless* force close is set
218    else {
219        $continue_close = 0;
220    }
221    }
222    return $continue_close;
223}
224## removeConnectionIfPersistent(filehandle, string) => integer ##
225
226
227##
228#
229sub retrieveConnectionIfPersistent
230{
231    my $self = shift(@_);
232    my $path = shift(@_);
233    my $append = shift(@_); # -append support
234    my $conn; # This should be populated
235    if ($self->{'supports_persistentconnection'}) {
236    $self->debugPrintFunctionHeader($path, $append);
237    my $fhid = $path;
238    # special case: if the append mode has changed for a persistent
239    # connection, we need to close the old connection first or things
240    # will get wiggy.
241    if (defined $append && $append eq '-append') {
242        # see if there is a non-append mode connection already open
243        if (defined $self->{'handle_pool'}->{$path}) {
244        $self->debugPrint("Append mode added - closing existing non-append mode connection");
245        my $old_conn = $self->{'handle_pool'}->{$path};
246        $self->close_infodb_write_handle($old_conn, $path);
247        }
248        # Append -append so we know what happened.
249        $fhid .= ' [APPEND]';
250    }
251    else {
252        my $fhid_append = $path . ' [APPEND]';
253        if (defined $self->{'handle_pool'}->{$fhid_append}) {
254        $self->debugPrint("Append mode removed - closing existing append mode connection");
255        my $old_conn = $self->{'handle_pool'}->{$fhid_append};
256        $self->close_infodb_write_handle($old_conn, $fhid_append);
257        }
258    }
259    if (defined $self->{'handle_pool'}->{$fhid}) {
260        $self->debugPrint('Retrieving existing connection: ' . $fhid);
261        $conn = $self->{'handle_pool'}->{$fhid};
262    }
263    }
264    return $conn;
265}
266## ##
267
268
269
270
271
272
273
274###############################################################################
275## Public Functions
276###############################################################################
277
278
279## @function convert_infodb_hash_to_string(hashmap) => string
280#
281sub convert_infodb_hash_to_string
282{
283    my $self = shift(@_);
284    my $infodb_map = shift(@_);
285    my $infodb_entry_value = "";
286    foreach my $infodb_value_key (keys(%$infodb_map)) {
287        foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}}) {
288            $infodb_entry_value .= "<$infodb_value_key>" . $infodb_value . "\n";
289        }
290    }
291    return $infodb_entry_value;
292}
293## convert_infodb_hash_to_string(hashmap) => string ##
294
295
296## @function convert_infodb_string_to_hash(string) => hashmap
297#
298sub convert_infodb_string_to_hash
299{
300    my $self = shift(@_);
301    my $infodb_entry_value = shift(@_);
302    my $infodb_map = ();
303
304    if (!defined $infodb_entry_value) {
305    print STDERR "Warning: No value to convert into a infodb hashtable\n";
306    }
307    else {
308        while ($infodb_entry_value =~ /^<(.*?)>(.*)$/mg) {
309            my $infodb_value_key = $1;
310            my $infodb_value = $2;
311
312            if (!defined($infodb_map->{$infodb_value_key})) {
313                $infodb_map->{$infodb_value_key} = [ $infodb_value ];
314            }
315            else {
316                push(@{$infodb_map->{$infodb_value_key}}, $infodb_value);
317            }
318    }
319    }
320
321    return $infodb_map;
322}
323## convert_infodb_string_to_hash(string) => hashmap ##
324
325
326## @function get_infodb_file_path(string, string) => string
327#
328sub get_infodb_file_path
329{
330    my $self = shift(@_);
331    my $collection_name = shift(@_);
332    my $infodb_directory_path = shift(@_);
333    my $infodb_file_name = &util::get_dirsep_tail($collection_name) . '.' . $self->{'default_file_extension'};
334    my $infodb_file_path = &FileUtils::filenameConcatenate($infodb_directory_path, $infodb_file_name);
335    # Correct the path separators to work in Cygwin
336    if ($^O eq "cygwin") {
337    $infodb_file_path = `cygpath -w "$infodb_file_path"`;
338    chomp($infodb_file_path);
339    $infodb_file_path =~ s%\\%\\\\%g;
340    }
341    return $infodb_file_path;
342}
343## get_infodb_file_path(string, string) => string ##
344
345
346## @function supportsDatestamp(void) => integer
347#
348sub supportsDatestamp
349{
350    my $self = shift(@_);
351    return $self->{'supports_datestamp'};
352}
353## supportsDatestamp(void) => integer ##
354
355
356## @function supportsMerge(void) => boolean
357#
358sub supportsMerge
359{
360    my $self = shift(@_);
361    return $self->{'supports_merge'};
362}
363## supportsMerge(void) => integer ##
364
365
366## @function supportsPersistentConnection(void) => integer
367#
368sub supportsPersistentConnection
369{
370    my $self = shift(@_);
371    return $self->{'supports_persistentconnection'};
372}
373## supportsPersistentConnection(void) => integer ##
374
375
376## @function supportsRSS(void) => integer
377#
378sub supportsRSS
379{
380    my $self = shift(@_);
381    return $self->{'supports_rss'};
382}
383## supportsRSS(void) => integer ##
384
385
386## @function supportsConcurrentReadAndWrite(void)  => integer
387#
388sub supportsConcurrentReadAndWrite
389{
390    my $self = shift(@_);
391    return $self->{'supports_concurrent_read_and_write'};
392}
393## supportsConcurrentReadAndWrite(void) => integer ##
394
395
396## @function supportsSet(void) => integer
397#
398#  Not all drivers support the notion of set
399#
400sub supportsSet
401{
402    my $self = shift(@_);
403    return $self->{'supports_set'};
404}
405## supportsSet(void) => integer ##
406
407
408sub writeOnly
409{
410    my $self = shift(@_);
411    return $self->{'write_only'};
412}
413## writeOnly() ##
414
415###############################################################################
416## Virtual Functions
417###############################################################################
418
419
420## @function close_infodb_write_handle(*) => void
421#
422sub close_infodb_write_handle
423{
424    my $self = shift(@_);
425    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
426    die("\n");
427}
428## close_infodb_write_handle(*) => void ##
429
430
431## @function delete_infodb_entry(*) => void
432#
433sub delete_infodb_entry
434{
435    my $self = shift(@_);
436    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
437    die("\n");
438}
439## delete_infodb_entry(*) => void ##
440
441
442## @function mergeDatabases(*) => void
443#
444sub mergeDatabases
445{
446    my $self = shift(@_);
447    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
448    die("\n");
449}
450## mergeDatabases(*) => void ##
451
452
453## @function open_infodb_write_handle(*) => void
454#
455sub open_infodb_write_handle
456{
457    my $self = shift(@_);
458    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
459    die("\n");
460}
461## open_infodb_write_handle(*) => void ##
462
463
464## @function set_infodb_entry(*) => void
465#
466sub set_infodb_entry
467{
468    my $self = shift(@_);
469    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
470    die("\n");
471}
472## set_infodb_entry(*) => void ##
473
474
475## @function read_infodb_entry(*) => void
476#
477sub read_infodb_entry
478{
479    my $self = shift(@_);
480    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
481    die("\n");
482}
483## read_infodb_entry(*) => void ##
484
485
486## @function read_infodb_rawentry(*) => string
487#
488sub read_infodb_rawentry
489{
490    my $self = shift(@_);
491    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
492    die("\n");
493}
494## read_infodb_rawentry(*) => string ##
495
496
497## @function read_infodb_file(*) => void
498#
499sub read_infodb_file
500{
501    my $self = shift(@_);
502    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
503    die("\n");
504}
505## read_infodb_file(*) => void ##
506
507
508## @function read_infodb_keys(*) => void
509#
510sub read_infodb_keys
511{
512    my $self = shift(@_);
513    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
514    die("\n");
515}
516## read_infodb_keys(*) => void ##
517
518
519## @function write_infodb_entry(*) => void
520#
521sub write_infodb_entry
522{
523    my $self = shift(@_);
524    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
525    die("\n");
526}
527## write_infodb_entry(*) => void ##
528
529
530## @function write_infodb_rawentry(*) => void
531#
532sub write_infodb_rawentry
533{
534    my $self = shift(@_);
535    gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
536    die("\n");
537}
538## write_infodb_rawentry(*) => void ##
539
540
5411;
Note: See TracBrowser for help on using the browser.