root/main/trunk/greenstone2/perllib/dbutil/gdbm.pm @ 28395

Revision 28395, 6.3 KB (checked in by davidb, 6 years ago)

Support for running under Cygwin added

Line 
1###########################################################################
2#
3# dbutil::gdbm -- utility functions for writing to gdbm 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::gdbm;
28
29use strict;
30
31use util;
32use FileUtils;
33use dbutil::gdbmtxtgz;
34
35# -----------------------------------------------------------------------------
36#   GDBM IMPLEMENTATION
37# -----------------------------------------------------------------------------
38
39sub open_infodb_write_handle
40{
41  my $infodb_file_path = shift(@_);
42  my $opt_append = shift(@_);
43
44  my $txt2db_exe = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"bin",$ENV{'GSDLOS'}, "txt2db" . &util::get_os_exe());
45  my $infodb_file_handle = undef;
46  my $cmd = "\"$txt2db_exe\"";
47  if ((defined $opt_append) && ($opt_append eq "append")) {
48      $cmd .= " -append";
49  }
50  $cmd .= " \"$infodb_file_path\"";
51
52  if (!-e "$txt2db_exe")
53  {
54      print STDERR "Error: Unable to find $txt2db_exe\n";
55      return undef;
56  }
57
58  if(!open($infodb_file_handle, "| $cmd"))
59  {
60
61      print STDERR "Error: Failed to open pipe to $cmd\n";
62      print STDERR "       $!\n";
63      return undef;
64  }
65
66  binmode($infodb_file_handle,":utf8");
67
68  return $infodb_file_handle;
69}
70
71
72
73sub close_infodb_write_handle
74{
75  my $infodb_handle = shift(@_);
76
77  close($infodb_handle);
78}
79
80
81sub get_infodb_file_path
82{
83  my $collection_name = shift(@_);
84  my $infodb_directory_path = shift(@_);
85
86  my $infodb_file_extension = ".gdb";
87  my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;
88  return &FileUtils::filenameConcatenate($infodb_directory_path, $infodb_file_name);
89}
90
91
92sub read_infodb_file
93{
94  my $infodb_file_path = shift(@_);
95  my $infodb_map = shift(@_);
96
97  open (PIPEIN, "db2txt \"$infodb_file_path\" |")
98      || die "couldn't open pipe from db2txt \$infodb_file_path\"\n";
99
100  binmode(PIPEIN,":utf8");
101
102  my $infodb_line = "";
103  my $infodb_key = "";
104  my $infodb_value = "";
105  while (defined ($infodb_line = <PIPEIN>))
106  {
107    $infodb_line =~ s/(\r\n)+$//; # more general than chomp
108
109    if ($infodb_line =~ /^\[([^\]]+)\]$/)
110    {
111      $infodb_key = $1;
112    }
113    elsif ($infodb_line =~ /^-{70}$/)
114    {
115      $infodb_map->{$infodb_key} = $infodb_value;
116      $infodb_key = "";
117      $infodb_value = "";
118    }
119    else
120    {
121      $infodb_value .= $infodb_line;
122    }
123  }
124
125  close (PIPEIN);
126}
127
128sub read_infodb_keys
129{
130  my $infodb_file_path = shift(@_);
131  my $infodb_map = shift(@_);
132
133  open (PIPEIN, "gdbmkeys \"$infodb_file_path\" |")
134      || die "couldn't open pipe from gdbmkeys \$infodb_file_path\"\n";
135
136  binmode(PIPEIN,":utf8");
137
138  my $infodb_line = "";
139  my $infodb_key = "";
140  my $infodb_value = "";
141  while (defined ($infodb_line = <PIPEIN>))
142  {
143      # chomp $infodb_line; # remove end of line
144      $infodb_line =~ s/(\r\n)+$//; # more general than chomp
145
146      $infodb_map->{$infodb_line} = 1;
147  }
148
149  close (PIPEIN);
150}
151
152sub write_infodb_entry
153{
154  # With infodb_handle already set up, works the same as _gdbm_txtgz version
155  &dbutil::gdbmtxtgz::write_infodb_entry(@_);
156}
157
158sub write_infodb_rawentry
159{
160  # With infodb_handle already set up, works the same as _gdbm_txtgz version
161  &dbutil::gdbmtxtgz::write_infodb_rawentry(@_);
162}
163
164
165sub set_infodb_entry_OLD
166{
167    my $infodb_file_path = shift(@_);
168    my $infodb_key = shift(@_);
169    my $infodb_map = shift(@_);
170 
171    # Protect metadata values that go inside quotes for gdbmset
172    foreach my $k (keys %$infodb_map) {
173      my @escaped_v = ();
174      foreach my $v (@{$infodb_map->{$k}}) {
175        if ($k eq "contains") {
176          # protect quotes in ".2;".3 etc
177          $v =~ s/\"/\\\"/g;
178          push(@escaped_v, $v);
179        }
180        else {
181          my $ev = &ghtml::unescape_html($v);
182          $ev =~ s/\"/\\\"/g;
183          push(@escaped_v, $ev);
184        }
185      }
186      $infodb_map->{$k} = \@escaped_v;
187    }
188   
189    # Generate the record string
190    my $serialized_infodb_map = &dbutil::convert_infodb_hash_to_string($infodb_map);
191##    print STDERR "**** ser dr\n$serialized_infodb_map\n\n\n";
192
193    # Store it into GDBM
194    my $cmd = "gdbmset \"$infodb_file_path\" \"$infodb_key\" \"$serialized_infodb_map\"";
195    my $status = system($cmd);
196
197    return $status;
198 
199}
200
201
202
203sub set_infodb_entry
204{
205    my $infodb_file_path = shift(@_);
206    my $infodb_key = shift(@_);
207    my $infodb_map = shift(@_);
208 
209    # HTML escape anything that is not part of the "contains" metadata value
210    foreach my $k (keys %$infodb_map) {
211      my @escaped_v = ();
212      foreach my $v (@{$infodb_map->{$k}}) {
213        if ($k eq "contains") {
214          push(@escaped_v, $v);
215        }
216        else {
217          my $ev = &ghtml::unescape_html($v);
218          push(@escaped_v, $ev);
219        }
220      }
221      $infodb_map->{$k} = \@escaped_v;
222    }
223   
224    # Generate the record string
225    my $serialized_infodb_map = &dbutil::convert_infodb_hash_to_string($infodb_map);
226###    print STDERR "**** ser dr\n$serialized_infodb_map\n\n\n";
227
228    # Store it into GDBM using 'txt2db -append' which despite its name
229    # actually replaces the record if it already exists
230
231    my $cmd = "txt2db -append \"$infodb_file_path\"";
232
233    my $status = undef;
234    if(!open(GOUT, "| $cmd"))
235    {
236    print STDERR "Error: gdbm::set_infodb_entry() failed to open pipe to: $cmd\n";
237    print STDERR "       $!\n";
238    $status = -1;
239    }
240    else {
241    binmode(GOUT,":utf8");
242   
243    print GOUT "[$infodb_key]\n";
244    print GOUT "$serialized_infodb_map\n";
245
246    close(GOUT);
247    $status = 0; # as in exit status of cmd OK
248    }
249
250    return $status; 
251}
252
253
254sub delete_infodb_entry
255{
256  # With infodb_handle already set up, works the same as _gdbm_txtgz version
257  &dbutil::gdbmtxtgz::delete_infodb_entry(@_);
258}
259
260
261
2621;
Note: See TracBrowser for help on using the browser.