source: main/trunk/greenstone2/perllib/dbutil/gdbmtxtgz.pm@ 22485

Last change on this file since 22485 was 22485, checked in by ak19, 14 years ago
  1. Dr Bainbridge fixed the database perl modules to all have the method read_info_keys (which reads the keys from the database into a map), so that dbutil.pm can have the same as a generic method. 2. buildConfigxml.pm only writes out the defaultIndex if it is set (to prevent an Uninitialised Variable warning message from Perl).
File size: 4.9 KB
Line 
1###########################################################################
2#
3# dbutil::gdbmtxtgz -- utility functions for writing to gdbm-txtgz 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::gdbmtxtgz;
28
29use strict;
30
31
32
33# -----------------------------------------------------------------------------
34# GDBM TXT-GZ IMPLEMENTATION
35# -----------------------------------------------------------------------------
36
37sub open_infodb_write_handle
38{
39 # Keep infodb in GDBM neutral form => save data as compressed text file,
40 # read for txt2db to be run on it later (i.e. by the runtime system,
41 # first time the collection is ever accessed). This makes it easier
42 # distribute pre-built collections to various architectures.
43 #
44 # NB: even if two architectures are little endian (e.g. Intel and
45 # ARM procesors) GDBM does *not* guarantee that the database generated on
46 # one will work on the other
47
48 my $infodb_file_path = shift(@_);
49
50 # Greenstone ships with gzip for windows, on $PATH
51
52 my $infodb_file_handle = undef;
53 if (!open($infodb_file_handle, "| gzip - > \"$infodb_file_path\""))
54 {
55 print STDERR "Error: Failed to open pipe to gzip - > \"$infodb_file_path\"\n";
56 print STDERR " $!\n";
57 return undef;
58 }
59
60 return $infodb_file_handle;
61}
62
63
64sub close_infodb_write_handle
65{
66 my $infodb_handle = shift(@_);
67
68 close($infodb_handle);
69}
70
71
72sub get_infodb_file_path
73{
74 my $collection_name = shift(@_);
75 my $infodb_directory_path = shift(@_);
76
77 my $infodb_file_name = &util::get_dirsep_tail($collection_name).".txt.gz";
78 return &util::filename_cat($infodb_directory_path, $infodb_file_name);
79}
80
81
82sub read_infodb_file
83{
84 my $infodb_file_path = shift(@_);
85 my $infodb_map = shift(@_);
86
87 my $cmd = "gzip --decompress \"$infodb_file_path\"";
88
89 open (PIPEIN, "$cmd |")
90 || die "Error: Couldn't open pipe from gzip: $!\n $cmd\n";
91
92 my $infodb_line = "";
93 my $infodb_key = "";
94 my $infodb_value = "";
95 while (defined ($infodb_line = <PIPEIN>))
96 {
97 if ($infodb_line =~ /^\[([^\]]+)\]$/)
98 {
99 $infodb_key = $1;
100 }
101 elsif ($infodb_line =~ /^-{70}$/)
102 {
103 $infodb_map->{$infodb_key} = $infodb_value;
104 $infodb_key = "";
105 $infodb_value = "";
106 }
107 else
108 {
109 $infodb_value .= $infodb_line;
110 }
111 }
112
113 close (PIPEIN);
114}
115
116
117sub read_infodb_keys
118{
119 my $infodb_file_path = shift(@_);
120 my $infodb_map = shift(@_);
121
122 my $cmd = "gzip --decompress \"$infodb_file_path\"";
123
124 open (PIPEIN, "$cmd |")
125 || die "Error: Couldn't open pipe from gzip: $!\n $cmd\n";
126
127 my $infodb_line = "";
128 my $infodb_key = "";
129 while (defined ($infodb_line = <PIPEIN>))
130 {
131 if ($infodb_line =~ /^\[([^\]]+)\]$/)
132 {
133 $infodb_key = $1;
134 }
135 elsif ($infodb_line =~ /^-{70}$/)
136 {
137 $infodb_map->{$infodb_key} = 1;
138 $infodb_key = "";
139 }
140 }
141
142 close (PIPEIN);
143}
144
145
146sub write_infodb_entry
147{
148
149 my $infodb_handle = shift(@_);
150 my $infodb_key = shift(@_);
151 my $infodb_map = shift(@_);
152
153 print $infodb_handle "[$infodb_key]\n";
154 foreach my $infodb_value_key (keys(%$infodb_map))
155 {
156 foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}})
157 {
158 if ($infodb_value =~ /-{70,}/)
159 {
160 # if value contains 70 or more hyphens in a row we need to escape them
161 # to prevent txt2db from treating them as a separator
162 $infodb_value =~ s/-/&\#045;/gi;
163 }
164 print $infodb_handle "<$infodb_value_key>" . $infodb_value . "\n";
165 }
166 }
167 print $infodb_handle '-' x 70, "\n";
168}
169
170
171
172sub write_infodb_rawentry
173{
174
175 my $infodb_handle = shift(@_);
176 my $infodb_key = shift(@_);
177 my $infodb_val = shift(@_);
178
179 print $infodb_handle "[$infodb_key]\n";
180 print $infodb_handle "$infodb_val\n";
181 print $infodb_handle '-' x 70, "\n";
182}
183
184
185
186sub delete_infodb_entry
187{
188
189 my $infodb_handle = shift(@_);
190 my $infodb_key = shift(@_);
191
192
193 # A minus at the end of a key (after the ]) signifies 'delete'
194 print $infodb_handle "[$infodb_key]-\n";
195
196 # The 70 minus signs are also needed, to help make the parsing by db2txt simple
197 print $infodb_handle '-' x 70, "\n";
198}
199
200
201
2021;
Note: See TracBrowser for help on using the repository browser.