source: main/trunk/greenstone2/perllib/arcinfo.pm@ 21857

Last change on this file since 21857 was 21857, checked in by davidb, 12 years ago

Removal of GDBM specific code in favour of write_infodb_rawentry() which is database backend agnostic

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 10.7 KB
Line 
1###########################################################################
2#
3# arcinfo.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26
27# This module stores information about the archives. At the moment
28# this information just consists of the file name (relative to the
29# directory the archives information file is in) and its OID.
30
31# This module assumes there is a one to one correspondance between
32# a file in the archives directory and an OID.
33
34package arcinfo;
35
36use constant ORDER_OID_INDEX => 0;
37use constant ORDER_SORT_INDEX => 1;
38
39use constant INFO_FILE_INDEX => 0;
40use constant INFO_STATUS_INDEX => 1;
41
42use strict;
43
44use dbutil;
45
46
47# File format read in: OID <tab> Filename <tab> Optional-Index-Status
48
49# Index status can be:
50# I = Index for the first time
51# R = Reindex
52# D = Delete
53# B = Been indexed
54
55sub new {
56 my $class = shift(@_);
57 my $infodbtype = shift(@_);
58
59 # If the infodbtype wasn't passed in, use the default from dbutil
60 if (!defined($infodbtype))
61 {
62 $infodbtype = &dbutil::get_default_infodb_type();
63 }
64
65 my $self = {'infodbtype' => $infodbtype,
66 'info'=>{},
67 'reverse-info'=>{},
68 'order'=>[],
69 'reverse_sort'=>0};
70
71 return bless $self, $class;
72}
73
74sub _load_info_txt
75{
76 my $self = shift (@_);
77 my ($filename) = @_;
78
79 if (defined $filename && -e $filename) {
80 open (INFILE, $filename) ||
81 die "arcinfo::load_info couldn't read $filename\n";
82
83 my ($line, @line);
84 while (defined ($line = <INFILE>)) {
85 $line =~ s/\cM|\cJ//g; # remove end-of-line characters
86 @line = split ("\t", $line); # filename,
87 if (scalar(@line) >= 2) {
88 $self->add_info (@line);
89 }
90 }
91 close (INFILE);
92 }
93
94
95}
96
97sub _load_info_db
98{
99 my $self = shift (@_);
100 my ($filename) = @_;
101
102 my $infodb_map = {};
103
104 &dbutil::read_infodb_file($self->{'infodbtype'}, $filename, $infodb_map);
105
106 foreach my $oid ( keys %$infodb_map ) {
107 my $vals = $infodb_map->{$oid};
108 # interested in doc-file and index-status
109
110 my ($doc_file) = ($vals=~/^<doc-file>(.*)$/m);
111 my ($index_status) = ($vals=~/^<index-status>(.*)$/m);
112 my ($sortmeta) = ($vals=~/^<sort-meta>(.*)$/m);
113 $self->add_info ($oid,$doc_file,$index_status,$sortmeta);
114 }
115}
116
117
118sub load_info {
119 my $self = shift (@_);
120 my ($filename) = @_;
121
122 $self->{'info'} = {};
123
124 if ((defined $filename) && (-e $filename)) {
125 if ($filename =~ m/\.inf$/) {
126 $self->_load_info_txt($filename);
127 }
128 else {
129 $self->_load_info_db($filename);
130 }
131 }
132}
133
134sub _load_filelist_db
135{
136 my $self = shift (@_);
137 my ($filename) = @_;
138
139 my $infodb_map = {};
140
141 &dbutil::read_infodb_file($self->{'infodbtype'}, $filename, $infodb_map);
142
143 foreach my $file ( keys %$infodb_map ) {
144 $self->{'prev_import_filelist'}->{$file} = 1;
145 }
146}
147
148
149sub load_prev_import_filelist {
150 my $self = shift (@_);
151 my ($filename) = @_;
152
153 $self->{'import-filelist'} = {};
154
155 if ((defined $filename) && (-e $filename)) {
156 if ($filename =~ m/\.inf$/) {
157 # e.g. 'archives-src.inf' (which includes complete list of file
158 # from last time import.pl was run)
159 $self->_load_info_txt($filename);
160 }
161 else {
162 $self->_load_filelist_db($filename);
163 }
164 }
165}
166
167sub load_revinfo_UNTESTED
168{
169 my $self = shift (@_);
170 my ($rev_filename) = @_;
171
172 my $rev_infodb_map = {};
173
174 &dbutil::read_infodb_file($self->{'infodbtype'}, $rev_filename, $rev_infodb_map);
175
176 foreach my $srcfile ( keys %$rev_infodb_map ) {
177 my $vals = $rev_infodb_map->{$srcfile};
178
179 foreach my $OID ($vals =~ m/^<oid>(.*)$/gm) {
180 $self->add_revinfo($srcfile,$OID);
181 }
182 }
183}
184
185
186sub _save_info_txt {
187 my $self = shift (@_);
188 my ($filename) = @_;
189
190 my ($OID, $info);
191
192 open (OUTFILE, ">$filename") ||
193 die "arcinfo::save_info couldn't write $filename\n";
194
195 foreach $info (@{$self->get_OID_list()}) {
196 if (defined $info) {
197 print OUTFILE join("\t", @$info), "\n";
198 }
199 }
200 close (OUTFILE);
201}
202
203sub _save_info_db {
204 my $self = shift (@_);
205 my ($filename) = @_;
206
207 my $infodbtype = $self->{'infodbtype'};
208
209 # Not the most efficient operation, but will do for now
210
211 # read it in
212 my $infodb_map = {};
213 &dbutil::read_infodb_file($infodbtype, $filename, $infodb_map);
214
215 # change index-status values
216 foreach my $info (@{$self->get_OID_list()}) {
217 if (defined $info) {
218 my ($oid,$doc_file,$index_status) = @$info;
219 if (defined $infodb_map->{$oid}) {
220 my $vals_ref = \$infodb_map->{$oid};
221 $$vals_ref =~ s/^<index-status>(.*)$/<index-status>$index_status/m;
222 }
223 else {
224 print STDERR "Warning: $filename does not have key $oid\n";
225 }
226 }
227 }
228
229
230 # write out again
231 my $infodb_handle = &dbutil::open_infodb_write_handle($infodbtype, $filename);
232 foreach my $oid ( keys %$infodb_map ) {
233 my $vals = $infodb_map->{$oid};
234 &dbutil::write_infodb_rawentry($infodbtype,$infodb_handle,$oid,$vals);
235 }
236 &dbutil::close_infodb_write_handle($infodbtype, $infodb_handle);
237
238}
239
240sub save_revinfo_db {
241 my $self = shift (@_);
242 my ($rev_filename) = @_;
243
244 # Output reverse lookup database
245
246 my $rev_infodb_map = $self->{'reverse-info'};
247 my $rev_infodb_handle
248 = &dbutil::open_infodb_write_handle($self->{'infodbtype'}, $rev_filename, "append");
249
250 foreach my $key ( keys %$rev_infodb_map ) {
251 my $val_hash = $rev_infodb_map->{$key};
252 &dbutil::write_infodb_entry($self->{'infodbtype'}, $rev_infodb_handle, $key, $val_hash);
253 }
254 &dbutil::close_infodb_write_handle($self->{'infodbtype'}, $rev_infodb_handle);
255
256}
257
258sub save_info {
259 my $self = shift (@_);
260 my ($filename) = @_;
261
262 if ($filename =~ m/(contents)|(\.inf)$/) {
263 $self->_save_info_txt($filename);
264 }
265 else {
266 $self->_save_info_db($filename);
267 }
268}
269
270sub delete_info {
271 my $self = shift (@_);
272 my ($OID) = @_;
273
274 if (defined $self->{'info'}->{$OID}) {
275 delete $self->{'info'}->{$OID};
276
277 my $i = 0;
278 while ($i < scalar (@{$self->{'order'}})) {
279 if ($self->{'order'}->[$i]->[ORDER_OID_INDEX] eq $OID) {
280 splice (@{$self->{'order'}}, $i, 1);
281 last;
282 }
283
284 $i ++;
285 }
286 }
287}
288
289sub add_info {
290 my $self = shift (@_);
291 my ($OID, $doc_file, $index_status, $sortmeta) = @_;
292 $sortmeta = "" unless defined $sortmeta;
293 $index_status = "I" unless defined $index_status; # I = needs indexing
294
295 if (! defined($OID)) {
296 # only happens when no files can be processed?
297 return undef;
298 }
299
300 if (defined $self->{'info'}->{$OID}) {
301 # test to see if we are in a reindex situation
302
303 my $existing_status_info = $self->get_status_info($OID);
304
305 if ($existing_status_info eq "D") {
306 # yes, we're in a reindexing situation
307 $self->delete_info ($OID);
308
309
310 # force setting to "reindex"
311 $index_status = "R";
312
313 }
314 else {
315 # some other, possibly erroneous, situation has arisen
316 # where the document already seems to exist
317 print STDERR "Warning: $OID already exists with index status $existing_status_info\n";
318 print STDERR " Deleting previous version\n";
319
320 $self->delete_info ($OID);
321 }
322 }
323
324 $self->{'info'}->{$OID} = [$doc_file,$index_status,$sortmeta];
325 push (@{$self->{'order'}}, [$OID, $sortmeta]);
326
327
328}
329
330sub set_status_info {
331 my $self = shift (@_);
332 my ($OID, $index_status) = @_;
333
334 my $OID_info = $self->{'info'}->{$OID};
335 $OID_info->[INFO_STATUS_INDEX] = $index_status;
336}
337
338
339sub get_status_info {
340 my $self = shift (@_);
341 my ($OID) = @_;
342
343 my $index_status = undef;
344
345 my $OID_info = $self->{'info'}->{$OID};
346 if (defined $OID_info) {
347 $index_status = $OID_info->[INFO_STATUS_INDEX];
348 }
349 else {
350 die "Unable to find document id $OID\n";
351 }
352
353 return $index_status;
354
355}
356
357
358sub add_reverseinfo {
359 my $self = shift (@_);
360 my ($key, $OID) = @_;
361
362 my $existing_key = $self->{'reverse-info'}->{$key};
363 if (!defined $existing_key) {
364 $existing_key = {};
365 $self->{'reverse-info'}->{$key} = $existing_key;
366 }
367
368 my $existing_oid = $existing_key->{'oid'};
369 if (!defined $existing_oid) {
370 $existing_oid = [];
371 $existing_key->{'oid'} = $existing_oid;
372 }
373
374 push(@$existing_oid,$OID);
375}
376
377sub set_meta_file_flag {
378 my $self = shift (@_);
379 my ($key) = @_;
380
381 my $existing_key = $self->{'reverse-info'}->{$key};
382 if (!defined $existing_key) {
383 $existing_key = {};
384 $self->{'reverse-info'}->{$key} = $existing_key;
385 }
386
387 $existing_key->{'meta-file'} = ["1"];
388
389}
390sub reverse_sort
391{
392 my $self = shift(@_);
393 $self->{'reverse_sort'} = 1;
394}
395
396# returns a list of the form [[OID, doc_file, index_status], ...]
397sub get_OID_list
398{
399 my $self = shift (@_);
400
401 my $order = $self->{'order'};
402
403 my @sorted_order;
404 if ($self->{'reverse_sort'}) {
405 @sorted_order = sort {$b->[ORDER_SORT_INDEX] cmp $a->[ORDER_SORT_INDEX]} @$order;
406 } else {
407 @sorted_order = sort {$a->[ORDER_SORT_INDEX] cmp $b->[ORDER_SORT_INDEX]} @$order;
408 }
409
410 my @list = ();
411
412 foreach my $OID_order (@sorted_order) {
413 my $OID = $OID_order->[ORDER_OID_INDEX];
414 my $OID_info = $self->{'info'}->{$OID};
415
416 push (@list, [$OID, $OID_info->[INFO_FILE_INDEX],
417 $OID_info->[INFO_STATUS_INDEX]]);
418 }
419
420 return \@list;
421}
422
423# returns a list of the form [[doc_file, OID], ...]
424sub get_file_list {
425 my $self = shift (@_);
426
427 my $order = $self->{'order'};
428
429 my @sorted_order;
430 if ($self->{'reverse_sort'}) {
431 @sorted_order = sort {$b->[ORDER_SORT_INDEX] cmp $a->[ORDER_SORT_INDEX]} @$order;
432 } else {
433 @sorted_order = sort {$a->[ORDER_SORT_INDEX] cmp $b->[ORDER_SORT_INDEX]} @$order;
434 }
435
436 my @list = ();
437
438 foreach my $OID_order (@sorted_order) {
439 my $OID = $OID_order->[ORDER_OID_INDEX];
440 my $OID_info = $self->{'info'}->{$OID};
441
442 push (@list, [$OID_info->[INFO_FILE_INDEX], $OID]);
443 }
444
445 return \@list;
446}
447
448
449# returns a list of the form [doc_file,index_status,$sort_meta]
450sub get_info {
451 my $self = shift (@_);
452 my ($OID) = @_;
453
454 if (defined $self->{'info'}->{$OID}) {
455 return $self->{'info'}->{$OID};
456 }
457
458 return undef;
459}
460
461
462
463# returns the number of documents so far
464sub size {
465 my $self = shift (@_);
466 return (scalar(@{$self->{'order'}}));
467}
468
4691;
470
Note: See TracBrowser for help on using the repository browser.