root/main/trunk/greenstone2/perllib/dbutil/jdbm.pm @ 28126

Revision 28126, 7.6 KB (checked in by davidb, 6 years ago)

Print statement added to Perl to make better sense of the standard-output messages generated by Txt2Jdb. Better still is this (and the output from JDBM) was controlled by 'verbosity' ... but leaving that for now

Line 
1###########################################################################
2#
3# dbutil::jdbm -- utility functions for writing to jdbm databases
4#
5# A component of the Greenstone digital library software
6# from the New Zealand Digital Library Project at the
7# University of Waikato, New Zealand.
8#
9# Copyright (C) 2009
10#
11# This program is free software; you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation; either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19# GNU General Public License for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program; if not, write to the Free Software
23# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24#
25###########################################################################
26
27package dbutil::jdbm;
28
29use strict;
30
31
32# -----------------------------------------------------------------------------
33#   JDBM IMPLEMENTATION
34# -----------------------------------------------------------------------------
35
36# When DBUtil::* is properly structured with inheritence, then
37# much of this code (along with GDBM and GDBM-TXT-GZ) can be grouped into
38# a shared base class.  Really it is only the the command that needs to
39# be constructed that changes between much of the code that is used
40
41
42sub open_infodb_write_handle
43{
44  my $infodb_file_path = shift(@_);
45  my $opt_append = shift(@_);
46
47  my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
48  my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
49
50  my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
51
52  my $infodb_file_handle = undef;
53  my $txt2jdb_cmd = "java -cp \"$classpath\" Txt2Jdb";
54
55  if ((defined $opt_append) && ($opt_append eq "append")) {
56      $txt2jdb_cmd .= " -append";
57      print STDERR "Append operation to $infodb_file_path\n";
58  }
59  else {
60      print STDERR "Create database $infodb_file_path\n";
61  }
62 
63  # Lop off file extension, as JDBM does not expect this to be present
64  $infodb_file_path =~ s/\.jdb$//;
65
66  $txt2jdb_cmd .= " \"$infodb_file_path\"";
67
68##  print STDERR "**** txt2jdbm cmd = $txt2jdb_cmd\n\n";
69
70  if (!open($infodb_file_handle, "| $txt2jdb_cmd"))
71  {
72      print STDERR "Error: Failed to open pipe to $txt2jdb_cmd";
73      print STDERR "       $!\n";
74      return undef;
75  }
76 
77  binmode($infodb_file_handle,":utf8");
78  return $infodb_file_handle;
79}
80
81
82
83sub close_infodb_write_handle
84{
85  my $infodb_handle = shift(@_);
86
87  close($infodb_handle);
88}
89
90
91sub get_infodb_file_path
92{
93  my $collection_name = shift(@_);
94  my $infodb_directory_path = shift(@_);
95
96  my $infodb_file_extension = ".jdb";
97  my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
98  return &util::filename_cat($infodb_directory_path, $infodb_file_name);
99}
100
101
102sub read_infodb_file
103{
104  my $infodb_file_path = shift(@_);
105  my $infodb_map = shift(@_);
106
107  my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
108  my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
109
110  my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
111
112  my $jdb2txt_cmd = "java -cp \"$classpath\" Jdb2Txt";
113
114  open (PIPEIN, "$jdb2txt_cmd \"$infodb_file_path\" |") || die "couldn't open pipe from db2txt \$infodb_file_path\"\n";
115  binmode(PIPEIN,":utf8");
116  my $infodb_line = "";
117  my $infodb_key = "";
118  my $infodb_value = "";
119  while (defined ($infodb_line = <PIPEIN>))
120  {
121    if ($infodb_line =~ /^\[([^\]]+)\]$/)
122    {
123      $infodb_key = $1;
124    }
125    elsif ($infodb_line =~ /^-{70}$/)
126    {
127      $infodb_map->{$infodb_key} = $infodb_value;
128      $infodb_key = "";
129      $infodb_value = "";
130    }
131    else
132    {
133      $infodb_value .= $infodb_line;
134    }
135  }
136
137  close (PIPEIN);
138}
139
140sub read_infodb_keys
141{
142  my $infodb_file_path = shift(@_);
143  my $infodb_map = shift(@_);
144
145  my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
146  my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
147
148  my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
149
150  my $jdbkeys_cmd = "java -cp \"$classpath\" JdbKeys";
151
152  open (PIPEIN, "$jdbkeys_cmd \"$infodb_file_path\" |") || die "couldn't open pipe from jdbmkeys \$infodb_file_path\"\n";
153  binmode(PIPEIN,":utf8");
154  my $infodb_line = "";
155  my $infodb_key = "";
156  my $infodb_value = "";
157  while (defined ($infodb_line = <PIPEIN>))
158  {
159      chomp $infodb_line; # remove end of line
160
161      $infodb_map->{$infodb_line} = 1;
162  }
163
164  close (PIPEIN);
165}
166
167
168   
169sub write_infodb_entry
170{
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 (keys(%$infodb_map))
178  {
179    foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}})
180    {
181      if ($infodb_value =~ /-{70,}/)
182      {
183        # if value contains 70 or more hyphens in a row we need to escape them
184        # to prevent txt2db from treating them as a separator
185        $infodb_value =~ s/-/&\#045;/gi;
186      }
187      print $infodb_handle "<$infodb_value_key>" . $infodb_value . "\n";
188    }
189  }
190  print $infodb_handle '-' x 70, "\n";
191}
192
193
194sub write_infodb_rawentry
195{
196
197  my $infodb_handle = shift(@_);
198  my $infodb_key = shift(@_);
199  my $infodb_val = shift(@_);
200 
201  print $infodb_handle "[$infodb_key]\n";
202  print $infodb_handle "$infodb_val\n";
203  print $infodb_handle '-' x 70, "\n";
204}
205
206sub set_infodb_entry
207{
208    my $infodb_file_path = shift(@_);
209    my $infodb_key = shift(@_);
210    my $infodb_map = shift(@_);
211 
212    # HTML escape anything that is not part of the "contains" metadata value
213    foreach my $k (keys %$infodb_map) {
214      my @escaped_v = ();
215      foreach my $v (@{$infodb_map->{$k}}) {
216        if ($k eq "contains") {
217          push(@escaped_v, $v);
218        }
219        else {
220          my $ev = &ghtml::unescape_html($v);
221          push(@escaped_v, $ev);
222        }
223      }
224      $infodb_map->{$k} = \@escaped_v;
225    }
226   
227    # Generate the record string
228    my $serialized_infodb_map = &dbutil::convert_infodb_hash_to_string($infodb_map);
229###    print STDERR "**** ser dr\n$serialized_infodb_map\n\n\n";
230
231    # Store it into JDBM using 'Txt2Jdb .... -append' which despite its name
232    # actually replaces the record if it already exists
233
234    my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
235    my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
236   
237    my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
238
239    # Lop off file extension, as JDBM does not expect this to be present
240    $infodb_file_path =~ s/\.jdb$//;
241
242    my $cmd = "java -cp \"$classpath\" Txt2Jdb -append \"$infodb_file_path\"";
243
244    my $status = undef;
245    if(!open(GOUT, "| $cmd"))
246    {
247    print STDERR "Error: jdbm::set_infodb_entry() failed to open pipe to: $cmd\n";
248    print STDERR "       $!\n";
249    $status = -1;
250    }
251    else {
252    binmode(GOUT,":utf8");
253   
254    print GOUT "[$infodb_key]\n";
255    print GOUT "$serialized_infodb_map\n";
256
257    close(GOUT);
258    $status = 0; # as in exit status of cmd OK
259    }
260
261    return $status; 
262}
263
264
265
266
267sub delete_infodb_entry
268{
269  my $infodb_handle = shift(@_);
270  my $infodb_key = shift(@_);
271 
272  # A minus at the end of a key (after the ]) signifies 'delete'
273  print $infodb_handle "[$infodb_key]-\n";
274
275  # The 70 minus signs are also needed, to help make the parsing by db2txt simple
276  print $infodb_handle '-' x 70, "\n";
277}
278
279
280
281
282
2831;
Note: See TracBrowser for help on using the browser.