root/gs2-extensions/tdb/trunk/perllib/DBDrivers/GDBM.pm @ 30318

Revision 30318, 7.4 KB (checked in by jmt12, 4 years ago)

Initial checkin of object-oriented rewrite of the dbutils stuff to bring it more into line with plugins and classifiers.

  • Property svn:executable set to *
Line 
1###############################################################################
2#
3# GDBM.pm -- utility functions for writing to gdbm databases
4#
5# A component of the Greenstone digital library software from the New Zealand
6# Digital Library Project at the University of Waikato, New Zealand.
7#
8# Copyright (C) 1999-2015 New Zealand Digital Library Project
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
17# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
18# more 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 DBDrivers::GDBM;
27
28# Pragma
29use strict;
30
31# Libraries
32use util;
33use FileUtils;
34use DBDrivers::BaseDBDriver;
35
36sub BEGIN
37{
38    @DBDrivers::GDBM::ISA = ( 'DBDrivers::BaseDBDriver' );
39}
40
41sub new
42{
43    my $class = shift(@_);
44    return bless ($self, $class);
45}
46
47# -----------------------------------------------------------------------------
48#   GDBM IMPLEMENTATION
49# -----------------------------------------------------------------------------
50
51
52## @function open_infodb_write_handle(string, string)
53#
54sub open_infodb_write_handle
55{
56    my $infodb_file_path = shift(@_);
57    my $opt_append = shift(@_);
58
59    my $txt2db_exe = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"bin",$ENV{'GSDLOS'}, "txt2db" . &util::get_os_exe());
60    my $infodb_file_handle = undef;
61    my $cmd = "\"$txt2db_exe\"";
62    if ((defined $opt_append) && ($opt_append eq "append")) {
63        $cmd .= " -append";
64    }
65    $cmd .= " \"$infodb_file_path\"";
66
67    if (!-e "$txt2db_exe") {
68        print STDERR "Error: Unable to find $txt2db_exe\n";
69        return undef;
70    }
71
72    if(!open($infodb_file_handle, "| $cmd")) {
73        print STDERR "Error: Failed to open pipe to $cmd\n";
74        print STDERR "       $!\n";
75        return undef;
76    }
77
78    binmode($infodb_file_handle,":utf8");
79
80    return $infodb_file_handle;
81}
82## open_infodb_write_handle(string, string) => filehandle ##
83
84
85## @function close_infodb_write_handle(filehandle)
86#
87sub close_infodb_write_handle
88{
89    my $infodb_handle = shift(@_);
90    close($infodb_handle);
91}
92## close_infodb_write_handle(filehandle) => void ##
93
94
95## @function get_infodb_file_path()
96#
97sub get_infodb_file_path
98{
99    my $collection_name = shift(@_);
100    my $infodb_directory_path = shift(@_);
101    my $infodb_file_extension = ".gdb";
102    my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
103    return &FileUtils::filenameConcatenate($infodb_directory_path, $infodb_file_name);
104}
105## get_infodb_file_path() => string ##
106
107
108## @function read_infodb_file(string, hashmap)
109#
110sub read_infodb_file
111{
112    my $infodb_file_path = shift(@_);
113    my $infodb_map = shift(@_);
114
115    open (PIPEIN, "db2txt \"$infodb_file_path\" |") || die "couldn't open pipe from db2txt \$infodb_file_path\"\n";
116
117    binmode(PIPEIN,":utf8");
118
119    my $infodb_line = "";
120    my $infodb_key = "";
121    my $infodb_value = "";
122    while (defined ($infodb_line = <PIPEIN>)) {
123        $infodb_line =~ s/(\r\n)+$//; # more general than chomp
124
125        if ($infodb_line =~ /^\[([^\]]+)\]$/) {
126            $infodb_key = $1;
127        }
128        elsif ($infodb_line =~ /^-{70}$/) {
129            $infodb_map->{$infodb_key} = $infodb_value;
130            $infodb_key = "";
131            $infodb_value = "";
132        }
133        else {
134            $infodb_value .= $infodb_line;
135        }
136    }
137  close (PIPEIN);
138}
139## read_infodb_file(string, hashmap) => void ##
140
141
142## @function read_infodb_keys(string, hashmap)
143#
144sub read_infodb_keys
145{
146    my $infodb_file_path = shift(@_);
147    my $infodb_map = shift(@_);
148
149    open (PIPEIN, "gdbmkeys \"$infodb_file_path\" |") || die "couldn't open pipe from gdbmkeys \$infodb_file_path\"\n";
150
151    binmode(PIPEIN,":utf8");
152
153    my $infodb_line = "";
154    my $infodb_key = "";
155    my $infodb_value = "";
156    while (defined ($infodb_line = <PIPEIN>)) {
157        # chomp $infodb_line; # remove end of line
158        $infodb_line =~ s/(\r\n)+$//; # more general than chomp
159
160        $infodb_map->{$infodb_line} = 1;
161    }
162
163  close (PIPEIN);
164}
165## read_infodb_keys(string, hashmap) => void ##
166
167
168## @function write_infodb_entry(filehandle, string, hashmap)
169#
170sub write_infodb_entry
171{
172    my $infodb_handle = shift(@_);
173    my $infodb_key = shift(@_);
174    my $infodb_map = shift(@_);
175
176    print $infodb_handle "[$infodb_key]\n";
177    foreach my $infodb_value_key (sort keys(%$infodb_map)) {
178        foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}}) {
179            if ($infodb_value =~ /-{70,}/) {
180                # if value contains 70 or more hyphens in a row we need to escape them
181                # to prevent txt2db from treating them as a separator
182                $infodb_value =~ s/-/&\#045;/gi;
183            }
184            print $infodb_handle "<$infodb_value_key>" . $infodb_value . "\n";
185        }
186    }
187    print $infodb_handle '-' x 70, "\n";
188}
189## write_infodb_entry(filehandle, string, hashmap) => void ##
190
191
192## @function write_infodb_rawentry(filehandle, string, string)
193#
194sub write_infodb_rawentry
195{
196    my $infodb_handle = shift(@_);
197    my $infodb_key = shift(@_);
198    my $infodb_val = shift(@_);
199
200    print $infodb_handle "[$infodb_key]\n";
201    print $infodb_handle "$infodb_val\n";
202    print $infodb_handle '-' x 70, "\n";
203}
204## write_infodb_rawentry(filehandle, string, string) ##
205
206
207## @function set_infodb_entry(string, string, hashmap)
208#
209sub set_infodb_entry
210{
211    my $infodb_file_path = shift(@_);
212    my $infodb_key = shift(@_);
213    my $infodb_map = shift(@_);
214
215    # HTML escape anything that is not part of the "contains" metadata value
216    foreach my $k (keys %$infodb_map) {
217      my @escaped_v = ();
218      foreach my $v (@{$infodb_map->{$k}}) {
219        if ($k eq "contains") {
220          push(@escaped_v, $v);
221        }
222        else {
223          my $ev = &ghtml::unescape_html($v);
224          push(@escaped_v, $ev);
225        }
226      }
227      $infodb_map->{$k} = \@escaped_v;
228    }
229
230    # Generate the record string
231    my $serialized_infodb_map = &dbutil::convert_infodb_hash_to_string($infodb_map);
232
233    # Store it into GDBM using 'txt2db -append' which despite its name
234    # actually replaces the record if it already exists
235    my $cmd = "txt2db -append \"$infodb_file_path\"";
236
237    my $status = undef;
238    if(!open(GOUT, "| $cmd")) {
239    print STDERR "Error: gdbm::set_infodb_entry() failed to open pipe to: $cmd\n";
240    print STDERR "       $!\n";
241    $status = -1;
242    }
243    else {
244    binmode(GOUT,":utf8");
245
246    print GOUT "[$infodb_key]\n";
247    print GOUT "$serialized_infodb_map\n";
248
249    close(GOUT);
250    $status = 0; # as in exit status of cmd OK
251    }
252    return $status;
253}
254## set_infodb_entry(string, string, hashmap) => integer ##
255
256
257## @function delete_infodb_entry(filehandle, string)
258#
259sub delete_infodb_entry
260{
261  my $infodb_handle = shift(@_);
262  my $infodb_key = shift(@_);
263
264  # A minus at the end of a key (after the ]) signifies 'delete'
265  print $infodb_handle "[$infodb_key]-\n";
266
267  # The 70 minus signs are also needed, to help make the parsing by db2txt simple
268  print $infodb_handle '-' x 70, "\n";
269}
270## delete_infodb_entry(filehandle, string) => void ##
271
2721;
Note: See TracBrowser for help on using the browser.