source: main/trunk/greenstone2/perllib/DBDrivers/BaseDBDriver.pm@ 31188

Last change on this file since 31188 was 31188, checked in by ak19, 7 years ago

This commit is related to but not specific to the upcoming commit to do with the new oaiinfo db and its directly affected files. This commit: New remove and rename (move) methods in DB package to clean up main db file and any additional db files created by any specific infodbtype. The new methods in dbutil/jdbm.pm are not called, for some reason. Requires more investigation, but committing for now.
File size: 15.4 KB
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 rename_db_file_to(string, string) => void
347#
348sub rename_db_file_to {
349 my $self = shift(@_);
350 my ($srcpath, $destpath) = @_;
351
352 # rename basic db file
353 &FileUtils::moveFiles($srcpath, $destpath);
354
355 # subclass should rename any additional files that the specific dbtype creates
356}
357## rename_db_file_to(string, string) => void ##
358
359## @function remove_db_file(string) => void
360#
361sub remove_db_file {
362 my $self = shift(@_);
363 my ($db_filepath) = @_;
364
365 # remove basic db file
366 &FileUtils::removeFiles($db_filepath);
367
368 # subclass must rename any additional files that the specific dbtype creates (e.g. transaction log files)
369}
370## remove_db_file(string, string) => void ##
371
372
373## @function supportsDatestamp(void) => integer
374#
375sub supportsDatestamp
376{
377 my $self = shift(@_);
378 return $self->{'supports_datestamp'};
379}
380## supportsDatestamp(void) => integer ##
381
382
383## @function supportsMerge(void) => boolean
384#
385sub supportsMerge
386{
387 my $self = shift(@_);
388 return $self->{'supports_merge'};
389}
390## supportsMerge(void) => integer ##
391
392
393## @function supportsPersistentConnection(void) => integer
394#
395sub supportsPersistentConnection
396{
397 my $self = shift(@_);
398 return $self->{'supports_persistentconnection'};
399}
400## supportsPersistentConnection(void) => integer ##
401
402
403## @function supportsRSS(void) => integer
404#
405sub supportsRSS
406{
407 my $self = shift(@_);
408 return $self->{'supports_rss'};
409}
410## supportsRSS(void) => integer ##
411
412
413## @function supportsConcurrentReadAndWrite(void) => integer
414#
415sub supportsConcurrentReadAndWrite
416{
417 my $self = shift(@_);
418 return $self->{'supports_concurrent_read_and_write'};
419}
420## supportsConcurrentReadAndWrite(void) => integer ##
421
422
423## @function supportsSet(void) => integer
424#
425# Not all drivers support the notion of set
426#
427sub supportsSet
428{
429 my $self = shift(@_);
430 return $self->{'supports_set'};
431}
432## supportsSet(void) => integer ##
433
434
435sub writeOnly
436{
437 my $self = shift(@_);
438 return $self->{'write_only'};
439}
440## writeOnly() ##
441
442###############################################################################
443## Virtual Functions
444###############################################################################
445
446
447## @function close_infodb_write_handle(*) => void
448#
449sub close_infodb_write_handle
450{
451 my $self = shift(@_);
452 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
453 die("\n");
454}
455## close_infodb_write_handle(*) => void ##
456
457
458## @function delete_infodb_entry(*) => void
459#
460sub delete_infodb_entry
461{
462 my $self = shift(@_);
463 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
464 die("\n");
465}
466## delete_infodb_entry(*) => void ##
467
468
469## @function mergeDatabases(*) => void
470#
471sub mergeDatabases
472{
473 my $self = shift(@_);
474 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
475 die("\n");
476}
477## mergeDatabases(*) => void ##
478
479
480## @function open_infodb_write_handle(*) => void
481#
482sub open_infodb_write_handle
483{
484 my $self = shift(@_);
485 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
486 die("\n");
487}
488## open_infodb_write_handle(*) => void ##
489
490
491## @function set_infodb_entry(*) => void
492#
493sub set_infodb_entry
494{
495 my $self = shift(@_);
496 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
497 die("\n");
498}
499## set_infodb_entry(*) => void ##
500
501
502## @function read_infodb_entry(*) => void
503#
504sub read_infodb_entry
505{
506 my $self = shift(@_);
507 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
508 die("\n");
509}
510## read_infodb_entry(*) => void ##
511
512
513## @function read_infodb_rawentry(*) => string
514#
515sub read_infodb_rawentry
516{
517 my $self = shift(@_);
518 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
519 die("\n");
520}
521## read_infodb_rawentry(*) => string ##
522
523
524## @function read_infodb_file(*) => void
525#
526sub read_infodb_file
527{
528 my $self = shift(@_);
529 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
530 die("\n");
531}
532## read_infodb_file(*) => void ##
533
534
535## @function read_infodb_keys(*) => void
536#
537sub read_infodb_keys
538{
539 my $self = shift(@_);
540 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
541 die("\n");
542}
543## read_infodb_keys(*) => void ##
544
545
546## @function write_infodb_entry(*) => void
547#
548sub write_infodb_entry
549{
550 my $self = shift(@_);
551 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
552 die("\n");
553}
554## write_infodb_entry(*) => void ##
555
556
557## @function write_infodb_rawentry(*) => void
558#
559sub write_infodb_rawentry
560{
561 my $self = shift(@_);
562 gsprintf(STDERR, (caller(0))[3] . " {common.must_be_implemented}\n");
563 die("\n");
564}
565## write_infodb_rawentry(*) => void ##
566
567
5681;
Note: See TracBrowser for help on using the repository browser.