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

Revision 30347, 14.9 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...

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
28# Pragma
29use strict;
30
31# DEBUGGING: You can enable a DBDriver one at a time to ensure they don't have
32# compilation errors.
33BEGIN
34{
35    if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) {
36        die("Error! Environment not prepared. Have you sourced setup.bash?\n");
37    }
38    # Are we running standalone? In which case the INC won't be correct
39    my $perllib_path = $ENV{'GSDLHOME'} . '/perllib';
40    my $all_inc = join(':', @INC);
41    if ($all_inc !~ /$perllib_path/) {
42    unshift(@INC, $perllib_path);
43    }
44}
45
46# Libraries
47use Devel::Peek;
48use Time::HiRes qw ( gettimeofday tv_interval );
49use FileUtils;
50use gsprintf 'gsprintf';
51use util;
52
53# Modulino pattern
54__PACKAGE__->main unless caller;
55
56###############################################################################
57## Private
58###############################################################################
59
60## Display debug messages?
61my $debug = 0; # Set to 1 to display
62
63## Keep track of the driver objects we have initialised
64my $dbdriver_pool = {};
65
66# Testing globals
67my $test_count = 0;
68my $pass_count = 0;
69my $skip_count = 0;
70
71
72## @function _addPathsToINC(void) => void
73#
74# A hopefully unused function to ensure the INC path contains all the available
75# perllib directories (from main, collection, and extensions)
76#
77sub _addPathsToINC
78{
79    &_debugPrint('_addPathsToINC() => ', 0);
80    my @possible_paths;
81    #... the main perllib directory...
82    push(@possible_paths, &FileUtils::filenameConcatenate());
83    #... a collection specific perllib directory...
84    if (defined $ENV{'GSDLCOLLECTDIR'} && $ENV{'GSDLCOLLECTION'}) {
85    push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, 'collect', $ENV{'GSDLCOLLECTION'}, 'perllib'));
86    }
87    #... any registered extension may also have a perllib!
88    if (defined $ENV{'GSDLEXTS'} && defined $ENV{'GSDLHOME'}) {
89    foreach my $gs2_extension (split(/:/, $ENV{'GSDLEXTS'})) {
90        push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'ext', $gs2_extension, 'perllib'));
91    }
92    }
93    if (defined $ENV{'GSDL3EXTS'} && defined $ENV{'GSDL3SRCHOME'}) {
94    foreach my $gs3_extension (split(/:/, $ENV{'GSDL3EXTS'})) {
95        push(@possible_paths, &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, 'ext', $gs3_extension, 'perllib'));
96    }
97    }
98    my $path_counter = 0;
99    foreach my $possible_path (@possible_paths) {
100    # we only try adding paths that actually exist
101    if (-d $possible_path) {
102        my $did_add_path = &util::augmentINC($possible_path);
103        if ($did_add_path) {
104        $path_counter++;
105        }
106    }
107    }
108    &_debugPrint('Added ' . $path_counter . ' paths');
109}
110## _addPathsToINC(void) => void #
111
112
113## @function _debugPrint(string, boolean)
114#
115sub _debugPrint
116{
117    my ($message, $newline) = @_;
118    if ($debug) {
119        if (!defined($newline)) {
120            $newline = 1;
121        }
122        print STDERR '[DEBUG] dbutil::' . $message;
123        if ($newline) {
124            print STDERR "\n";
125        }
126    }
127}
128## _debugPrint(string, boolean) => void ##
129
130
131## @function _isDriverLoaded(string) => boolean
132#
133sub _isDriverLoaded
134{
135    my ($dbdriver_name) = @_;
136    (my $dbdriver_file = $dbdriver_name) =~ s/::/\//g;
137    $dbdriver_file .= '.pm';
138    my $result = defined($INC{$dbdriver_file});
139    &_debugPrint('_isDriverLoaded("' . $dbdriver_name . '") => ' . $result);
140    return $result;
141}
142## _isDriverLoaded(string) => boolean ##
143
144## @function _loadDBDriver(string, string)
145#
146sub _loadDBDriver
147{
148    my ($dbdriver_name, $db_filepath) = @_;
149    my $dbdriver;
150    # I've decided (arbitrarily) to use uppercase for driver names since they
151    # are mostly acronyms
152    $dbdriver_name = uc($dbdriver_name);
153    # Ensure the driver has the correct package prefix
154    if ($dbdriver_name !~ /^DBDrivers/) {
155        $dbdriver_name = 'DBDrivers::' . $dbdriver_name;
156    }
157    # We only need to create each driver once
158    if (defined($dbdriver_pool->{$dbdriver_name})) {
159        $dbdriver = $dbdriver_pool->{$dbdriver_name};
160    }
161    else {
162        &_debugPrint('_loadDBDriver() => ' . $dbdriver_name);
163        # Assuming the INC is correctly setup, then this should work nicely
164        # - make sure we have required this dbdriver package
165    eval "require $dbdriver_name";
166    if (&_isDriverLoaded($dbdriver_name)) {
167        $dbdriver_name->import();
168        }
169    # What should we do about drivers that aren't there?
170    else {
171        print STDERR "Error! Failed to load: " . $dbdriver_name . "\n";
172    }
173        # Then initialise and return a new one
174        $dbdriver = $dbdriver_name->new($debug);
175        # Store it for later use
176        $dbdriver_pool->{$dbdriver_name} = $dbdriver;
177    }
178    return $dbdriver;
179}
180## _loadDBDriver(string, string) => BaseDBDriver ##
181
182
183## @function _printTest(string, integer) => void
184#
185sub _printTest
186{
187    my $title = shift(@_);
188    my $result = shift(@_);
189    $test_count++;
190    print " - Test: " . $title . "... ";
191    if ($result) {
192    print "Passed\n";
193    $pass_count++;
194    }
195    else {
196    print "Failed\n";
197    }
198}
199## _printTest(string, integer) => void ##
200
201
202sub _compareHash
203{
204    my $hash1 = shift(@_);
205    my $hash2 = shift(@_);
206    my $str1 = &_hash2str($hash1);
207    my $str2 = &_hash2str($hash2);
208    return ($str1 eq $str2);
209}
210
211sub _hash2str
212{
213    my $hash = shift(@_);
214    my $str = '';
215    foreach my $key (sort keys %{$hash}) {
216    $str .= '{' . $key . '=>{{' . join('},{', @{$hash->{$key}}) . '}}}';
217    }
218    return $str;
219}
220
221
222###############################################################################
223## Public
224###############################################################################
225
226
227## @function main(void) => void
228#
229sub main
230{
231    my $t0 = [gettimeofday()];
232    my $data1 = {'doh' => ['a deer, a female deer'],
233        'ray' => ['a drop of golden sun'],
234        'me'  => ['a name I call myself'],
235        'far' => ['a long, long way to run']};
236    my $data2 = {'sew' => ['a needle pulling thread'],
237         'lah' => ['a note to follow doh'],
238         'tea' => ['a drink with jam and bread'],
239         'doh' => ['which brings us back to']};
240    $test_count = 0;
241    $pass_count = 0;
242    $skip_count = 0;
243    print "===== DBUtils Testing Suite =====\n";
244    print "For each driver specified, run a battery of tests\n";
245    my @drivers;
246    foreach my $arg (@ARGV) {
247    if ($arg =~ /^-+([a-z]+)(=.+)?$/) {
248        my $arg_name = $1;
249        my $arg_value = $2;
250        if ($arg_name eq 'debug') {
251        $debug = 1;
252        }
253    }
254    else {
255        push(@drivers, $arg);
256    }
257    }
258    if (scalar(@drivers)) {
259    # Ensure the Perl can load the drivers from all the typical places
260    &_addPathsToINC();
261    foreach my $driver_name (@drivers) {
262        my $t1 = [gettimeofday()];
263        print "=== Testing: " . $driver_name . " ===\n";
264        my $driver = _loadDBDriver($driver_name);
265        my $db_path = $driver->get_infodb_file_path('test','/tmp/');
266        print " - Path: " . $db_path . "\n";
267        # 1. Open handle
268        my $db_handle = $driver->open_infodb_write_handle($db_path);
269        &_printTest('opening handle', (defined $db_handle));
270        # 2a. Write entry
271        $driver->write_infodb_entry($db_handle, 'Alpha', $data1);
272        &_printTest('writing entry', 1);
273        # 2b. Write raw entry
274        my $raw_data = $driver->convert_infodb_hash_to_string($data1);
275        $driver->write_infodb_rawentry($db_handle, 'Beta', $raw_data);
276        &_printTest('writing raw entry', 1);
277        # 3. Close handle
278        $driver->close_infodb_write_handle($db_handle);
279        if ($driver->supportsPersistentConnection()) {
280        $test_count += 1;
281        $skip_count += 1;
282        print " - Skipping test as persistent drivers delay 'close'.\n";
283        }
284        else {
285        &_printTest('closing handle', (tell($db_handle) < 1));
286        }
287        # 4a. Read entry
288        my $data3 = $driver->read_infodb_entry($db_path, 'Alpha');
289        &_printTest('read entry', &_compareHash($data1, $data3));
290        # 4b. Read raw entry
291        my $raw_data4 = $driver->read_infodb_rawentry($db_path, 'Beta');
292        my $data4 = $driver->convert_infodb_string_to_hash($raw_data4);
293        &_printTest('read raw entry', &_compareHash($data1, $data4));
294        # 5. Read keys
295        my $keys1 = {};
296        $driver->read_infodb_keys($db_path, $keys1);
297        &_printTest('read keys', (defined $keys1->{'Alpha'} && defined $keys1->{'Beta'}));
298        # 6. Set entry
299        if ($driver->supportsSet()) {
300        my $status = $driver->set_infodb_entry($db_path, 'Alpha', $data2);
301        &_printTest('set entry (1)', ($status >= 0));
302        my $data5 = $driver->read_infodb_entry($db_path, 'Alpha');
303        &_printTest('set entry (2)', &_compareHash($data2, $data5));
304        }
305        else {
306        $test_count += 2;
307        $skip_count += 2;
308        print " - Skipping 2 tests as 'set' is not supported by this driver.\n";
309        }
310        # 7. Delete entry
311        my $db_handle2 = $driver->open_infodb_write_handle($db_path, 'append');
312        $driver->delete_infodb_entry($db_handle2, 'Alpha');
313        $driver->close_infodb_write_handle($db_handle2);
314        my $keys2 = {};
315        $driver->read_infodb_keys($db_path, $keys2);
316        &_printTest('delete entry', ((!defined $keys2->{'Alpha'}) && (defined $keys2->{'Beta'})));
317        # 8. Remove test db
318        #unlink($db_path);
319        my $t2 = [gettimeofday()];
320        my $elapsed1 = tv_interval($t1, $t2);
321        print " - Testing took " . $elapsed1 . " seconds\n";
322    }
323    print "===== Results =====\n";
324    print "Drivers Tested: " . scalar(@drivers) . "\n";
325    print "Tests Run:      " . $test_count . "\n";
326    print "Tests Passed:   " . $pass_count . "\n";
327    print "Tests Failed:   " . ($test_count - $pass_count - $skip_count) . "\n";
328    print "Tests Skipped:  " . $skip_count . "\n";
329    }
330    else
331    {
332    print "Warning! No drivers specified - expected as arguments to call\n";
333    }
334    my $t3 = [gettimeofday()];
335    my $elapsed2 = tv_interval($t0, $t3);
336    print "===== Complete in " . $elapsed2 . " seconds =====\n";
337    print "\n";
338    exit(0);
339}
340## main(void) => void
341
342
343## @function close_infodb_write_handle(string, *) => void
344#
345sub close_infodb_write_handle
346{
347  my $infodb_type = shift(@_);
348  my $driver = _loadDBDriver($infodb_type);
349  $driver->close_infodb_write_handle(@_);
350}
351## close_infodb_write_handle(string, *) => void ##
352
353
354## @function delete_infodb_entry(string, *) => void
355#
356sub delete_infodb_entry
357{
358    my $infodb_type = shift(@_);
359    my $driver = _loadDBDriver($infodb_type);
360    $driver->delete_infodb_entry(@_);
361}
362## delete_infodb_entry(string, *) => void ##
363
364
365## @function mergeDatabases(string, *) => integer
366#
367sub mergeDatabases
368{
369    my $infodb_type = shift(@_);
370    my $driver = _loadDBDriver($infodb_type);
371    my $status = $driver->mergeDatabases(@_);
372    return $status;
373}
374## mergeDatabases(string, *) => integer ##
375
376
377## @function get_default_infodb_type(void) => string
378#
379sub get_default_infodb_type
380{
381  # The default is GDBM so everything works the same for existing collections
382  # To use something else, specify the "infodbtype" in the collection's collect.cfg file
383  return 'gdbm';
384}
385## get_default_infodb_type(void) => string ##
386
387
388## @function get_infodb_file_path(string, *) => string
389#
390sub get_infodb_file_path
391{
392    my $infodb_type = shift(@_);
393    my $driver = _loadDBDriver($infodb_type);
394    my $infodb_file_path = $driver->get_infodb_file_path(@_);
395    return $infodb_file_path;
396}
397## get_infodb_file_path(string, *) => string ##
398
399
400## @function open_infodb_write_handle(string, *) => filehandle
401#
402sub open_infodb_write_handle
403{
404    my $infodb_type = shift(@_);
405    my $driver = _loadDBDriver($infodb_type);
406    my $infodb_handle = $driver->open_infodb_write_handle(@_);
407    return $infodb_handle;
408}
409## open_infodb_write_handle(string, *) => filehandle ##
410
411
412## @function read_infodb_file(string, *) => void
413#
414sub read_infodb_file
415{
416    my $infodb_type = shift(@_);
417    my $driver = _loadDBDriver($infodb_type);
418    $driver->read_infodb_file(@_);
419}
420## read_infodb_file(string, *) => void ##
421
422
423## @function read_infodb_keys(string, *) => void
424#
425sub read_infodb_keys
426{
427    my $infodb_type = shift(@_);
428    my $driver = _loadDBDriver($infodb_type);
429    $driver->read_infodb_keys(@_);
430}
431## read_infodb_keys(string, *) => void ##
432
433
434## @function read_infodb_entry(string, *) => hashmap
435#
436sub read_infodb_entry
437{
438    my $infodb_type = shift(@_);
439    my $driver = _loadDBDriver($infodb_type);
440    my $infodb_entry = $driver->read_infodb_entry(@_);
441    return $infodb_entry;
442}
443## read_infodb_entry(string, *) => hashmap ##
444
445
446## @function read_infodb_rawentry(string, *) => string
447#
448sub read_infodb_rawentry
449{
450    my $infodb_type = shift(@_);
451    my $driver = _loadDBDriver($infodb_type);
452    my $raw_infodb_entry = $driver->read_infodb_rawentry(@_);
453    return $raw_infodb_entry;
454}
455## read_infodb_rawentry(string, *) => string ##
456
457
458## @function set_infodb_entry(string, *) => integer
459#
460sub set_infodb_entry
461{
462    my $infodb_type = shift(@_);
463    my $driver = _loadDBDriver($infodb_type);
464    my $status = $driver->set_infodb_entry(@_);
465    return $status;
466}
467## set_infodb_entry(string, *) => integer ##
468
469
470## @function supportDatestamp(string) => boolean
471#
472sub supportsDatestamp
473{
474    my $infodb_type = shift(@_);
475    my $driver = _loadDBDriver($infodb_type);
476    my $supports_datestamp = $driver->supportsDatestamp();
477    return $supports_datestamp;
478}
479## supportsDatestamp(string) => boolean ##
480
481
482## @function supportMerge(string) => boolean
483#
484sub supportsMerge
485{
486    my $infodb_type = shift(@_);
487    my $driver = _loadDBDriver($infodb_type);
488    my $supports_merge = $driver->supportsMerge();
489    return $supports_merge;
490}
491## supportsMerge(string) => boolean ##
492
493
494## @function supportRSS(string) => boolean
495#
496sub supportsRSS
497{
498    my $infodb_type = shift(@_);
499    my $driver = _loadDBDriver($infodb_type);
500    my $supports_rss = $driver->supportsRSS();
501    return $supports_rss;
502}
503## supportsRSS(string) => boolean ##
504
505
506## @function write_infodb_entry(string, *) => void
507#
508sub write_infodb_entry
509{
510    my $infodb_type = shift(@_);
511    my $driver = _loadDBDriver($infodb_type);
512    $driver->write_infodb_entry(@_);
513}
514## write_infodb_entry(string, *) => void ##
515
516
517## @function write_infodb_rawentry(string, *) => void
518#
519sub write_infodb_rawentry
520{
521    my $infodb_type = shift(@_);
522    my $driver = _loadDBDriver($infodb_type);
523    $driver->write_infodb_rawentry(@_);
524}
525## write_infodb_rawentry(string, *) => void ##
526
5271;
Note: See TracBrowser for help on using the browser.