1 | ###############################################################################
|
---|
2 | #
|
---|
3 | # DBDrivers/TDB.pm -- utility functions for writing to tdb databases. Should be
|
---|
4 | # hauntingly similar to GDBM utility functions.
|
---|
5 | #
|
---|
6 | # A component of the Greenstone digital library software from the New Zealand
|
---|
7 | # Digital Library Project at the University of Waikato, New Zealand.
|
---|
8 | #
|
---|
9 | # Copyright (C) 2011-2015 New Zealand Digital Library Project
|
---|
10 | #
|
---|
11 | # This program is free software; you can redistribute it and/or modify it under
|
---|
12 | # the terms of the GNU General Public License as published by the Free Software
|
---|
13 | # Foundation; either version 2 of the License, or (at your option) any later
|
---|
14 | # version.
|
---|
15 | #
|
---|
16 | # This program is distributed in the hope that it will be useful, but WITHOUT
|
---|
17 | # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
---|
18 | # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
---|
19 | # more details.
|
---|
20 | #
|
---|
21 | # You should have received a copy of the GNU General Public License along with
|
---|
22 | # this program; if not, write to the Free Software Foundation, Inc., 675 Mass
|
---|
23 | # Ave, Cambridge, MA 02139, USA.
|
---|
24 | #
|
---|
25 | ###############################################################################
|
---|
26 |
|
---|
27 | package DBDrivers::TDB;
|
---|
28 |
|
---|
29 | # Pragma
|
---|
30 | use strict;
|
---|
31 |
|
---|
32 | # Libraries
|
---|
33 | use Cwd;
|
---|
34 | use Devel::Peek;
|
---|
35 | use ghtml;
|
---|
36 | use Scalar::Util 'refaddr';
|
---|
37 | use util;
|
---|
38 | # - OO inheritence
|
---|
39 | use parent 'DBDrivers::GDBM';
|
---|
40 |
|
---|
41 | sub BEGIN
|
---|
42 | {
|
---|
43 | if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) {
|
---|
44 | die("Error! Environment not prepared. Have you sourced setup.bash?\n");
|
---|
45 | }
|
---|
46 | if (!defined $ENV{'GEXTTDBEDIT_INSTALLED'}) {
|
---|
47 | die("Error! Path to TDB binaries not found. Have you sourced setup.bash?\n");
|
---|
48 | }
|
---|
49 | }
|
---|
50 |
|
---|
51 | sub new
|
---|
52 | {
|
---|
53 | my $class = shift(@_);
|
---|
54 |
|
---|
55 | my $self = DBDrivers::GDBM->new(@_);
|
---|
56 |
|
---|
57 | # Default TDB file extension
|
---|
58 | $self->{'default_file_extension'} = 'tdb';
|
---|
59 | # Should the TDB used a specific affinity?
|
---|
60 | $self->{'forced_affinity'} = -1; # zero upwards indicates the affinity
|
---|
61 | # Ask TDB executables to display debugging information?
|
---|
62 | $self->{'tdb_debug'} = 1; # 1 to enable
|
---|
63 |
|
---|
64 | # note: file separator agnostic
|
---|
65 | $self->{'executable_path'} = $ENV{GEXTTDBEDIT_INSTALLED} . '/bin/';
|
---|
66 | $self->{'read_executable'} = 'tdb2txt';
|
---|
67 | $self->{'keyread_executable'} = 'tdbkeys';
|
---|
68 | $self->{'write_executable'} = 'txt2tdb';
|
---|
69 |
|
---|
70 | # Optional Support
|
---|
71 | $self->{'supports_persistentconnection'} = 1;
|
---|
72 | $self->{'supports_set'} = 1;
|
---|
73 |
|
---|
74 | bless($self, $class);
|
---|
75 | return $self;
|
---|
76 | }
|
---|
77 |
|
---|
78 |
|
---|
79 | ## @function DESTROY
|
---|
80 | #
|
---|
81 | # Built-in destructor block that, unlike END, gets passed a reference to self.
|
---|
82 | # Responsible for properly closing any open database handles.
|
---|
83 | #
|
---|
84 | sub DESTROY
|
---|
85 | {
|
---|
86 | my $self = shift(@_);
|
---|
87 | # Close all remaining filehandles
|
---|
88 | foreach my $infodb_file_path (keys(%{$self->{'handle_pool'}})) {
|
---|
89 | my $infodb_handle = $self->{'handle_pool'}->{$infodb_file_path};
|
---|
90 | # By passing the filepath as the second argument we instruct the driver
|
---|
91 | # that we actually want to close the connection by passing a non-zero
|
---|
92 | # value, but we sneakily optimize things a little as the close method
|
---|
93 | # can now check to see if it's been provided a file_path rather than
|
---|
94 | # having to search the handle pool for it. The file_path is needed to
|
---|
95 | # remove the closed handle from the pool anyway.
|
---|
96 | $self->close_infodb_write_handle($infodb_handle, $infodb_file_path);
|
---|
97 | }
|
---|
98 | }
|
---|
99 | ## DESTROY(void) => void ##
|
---|
100 |
|
---|
101 |
|
---|
102 | # -----------------------------------------------------------------------------
|
---|
103 | # TDB IMPLEMENTATION
|
---|
104 | # -----------------------------------------------------------------------------
|
---|
105 |
|
---|
106 | # Handled by BaseDBDriver
|
---|
107 | # sub debugPrint(string) => void
|
---|
108 | # sub debugPrintFunctionHeader(*) => void
|
---|
109 | # sub get_infodb_file_path(string, string) => string
|
---|
110 |
|
---|
111 | # Handled by 70HyphenFormat
|
---|
112 | # sub read_infodb_entry(string, string) => hashmap
|
---|
113 | # sub read_infodb_file(string, hashmap) => void
|
---|
114 | # sub read_infodb_keys(string, hashmap) => void
|
---|
115 | # sub read_infodb_rawentry(string, string) => string
|
---|
116 | # sub set_infodb_entry(string, string, hashmap) => integer
|
---|
117 | # sub write_infodb_entry(filehandle, string, hashmap) => void
|
---|
118 | # sub write_infodb_rawentry(filehandle, string, string) => void
|
---|
119 |
|
---|
120 |
|
---|
121 | ## @function close_infodb_write_handle(filehandle)
|
---|
122 | #
|
---|
123 | # Some slight-of-hand here due to the way Perl passes variables to methods.
|
---|
124 | # Most of the time (i.e. under all the existing calls in the Greenstone code)
|
---|
125 | # this does nothing, as TDB handles can be left open and reused by multiple
|
---|
126 | # writers/readers (the exception being complete file reads, but they are
|
---|
127 | # handled in their own function anyway).
|
---|
128 | #
|
---|
129 | # However TDB's version of this function will look for an extra variable and,
|
---|
130 | # if true (non-zero), will actually close the handle. Several methods below
|
---|
131 | # call close but also pass the infodb_file_path as the second argument, which
|
---|
132 | # is enough to have the connections properly closed.
|
---|
133 | #
|
---|
134 | # Note that when this class passes from scope all open handles will be
|
---|
135 | # properly closed by the DESTROY block.
|
---|
136 | #
|
---|
137 | sub close_infodb_write_handle {
|
---|
138 | my $self = shift(@_);
|
---|
139 | $self->debugPrintFunctionHeader(@_);
|
---|
140 | my $infodb_handle = shift(@_);
|
---|
141 | my $actually_close = shift(@_); # Undefined most of the time
|
---|
142 | if (defined($actually_close)) {
|
---|
143 | # We'll need the file path so we can locate and remove the entry in the
|
---|
144 | # handle pool
|
---|
145 | my $infodb_file_path = undef;
|
---|
146 | # Sometimes we can cheat, as the actually_close variable will have the
|
---|
147 | # file_path in it thanks to the DESTROY block above. Doing a regex on
|
---|
148 | # actually_close will treat it like a string no matter what it was, and
|
---|
149 | # we can search for the appropriate file extension that should be there
|
---|
150 | # for valid paths.
|
---|
151 | my $pattern = '\.' . $self->{'default_file_extension'} . '(\s\[APPEND\])?$';
|
---|
152 | if ($actually_close =~ /$pattern/) {
|
---|
153 | $infodb_file_path = $actually_close;
|
---|
154 | }
|
---|
155 | # If we can't cheat then we are stuck finding which connection in the
|
---|
156 | # handle_pool we are about to close. Need to compare objects using
|
---|
157 | # refaddr()
|
---|
158 | else {
|
---|
159 | foreach my $possible_file_path (values(%{$self->{'handle_pool'}})) {
|
---|
160 | my $possible_handle = $self->{'handle_pool'}->{$possible_file_path};
|
---|
161 | if (ref($infodb_handle) && ref($possible_handle) && refaddr($infodb_handle) == refaddr($possible_handle)) {
|
---|
162 | $infodb_file_path = $possible_file_path;
|
---|
163 | last;
|
---|
164 | }
|
---|
165 | }
|
---|
166 | }
|
---|
167 | if (defined($infodb_file_path)) {
|
---|
168 | $self->debugPrint('Closing connection: ' . $infodb_file_path);
|
---|
169 | delete($self->{'handle_pool'}->{$infodb_file_path});
|
---|
170 | }
|
---|
171 | else {
|
---|
172 | print STDERR "Warning! About to close TDB database handle, but couldn't locate in open handle pool.\n";
|
---|
173 | }
|
---|
174 | # Call GDBM's close to do the heavy-lifting
|
---|
175 | $self->SUPER::close_infodb_write_handle($infodb_handle);
|
---|
176 | }
|
---|
177 | else {
|
---|
178 | $self->debugPrint('Connection persists for later use.');
|
---|
179 | }
|
---|
180 | }
|
---|
181 | ## close_infodb_write_handle(filehandle) => void ##
|
---|
182 |
|
---|
183 | # sub delete_infodb_entry {}
|
---|
184 |
|
---|
185 |
|
---|
186 | ## @function open_infodb_write_handle(string, string)
|
---|
187 | #
|
---|
188 | sub open_infodb_write_handle
|
---|
189 | {
|
---|
190 | my $self = shift(@_);
|
---|
191 | if ($self->{'tdb_debug'}) {
|
---|
192 | push(@_, '-debug');
|
---|
193 | }
|
---|
194 | my $handle = $self->SUPER::open_infodb_write_handle(@_);
|
---|
195 | return $handle;
|
---|
196 | }
|
---|
197 | ## open_infodb_write_handle(string, string) => filehandle ##
|
---|
198 |
|
---|
199 | 1;
|
---|