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

Revision 30340, 14.5 KB (checked in by jmt12, 4 years ago)

Minor changes to support drivers that don't support set_entry functionality

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