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

Last change on this file was 37194, checked in by davidb, 15 months ago

Tested version of file-level document-version history (fldv-history) using the newer mv archives to archives_keepold and then hardlink-copy back to archiaves. Uses the newer technique of storing the timestamp in archives-timestamp.out, rather than rely on the timestamp of the file (which now changes due to the copy step
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 17.1 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 constant INFO_GROUPPOS_INDEX => 3;
43use strict;
44
45use dbutil;
46
47
48# File format read in: OID <tab> Filename <tab> Optional-Index-Status
49
50# Index status can be:
51# I = Index for the first time
52# R = Reindex
53# D = Delete
54# B = Been indexed
55
56sub new {
57 my $class = shift(@_);
58 my $infodbtype = shift(@_);
59
60 # If the infodbtype wasn't passed in, use the default from dbutil
61 if (!defined($infodbtype))
62 {
63 $infodbtype = &dbutil::get_default_infodb_type();
64 }
65
66 my $self = {'infodbtype' => $infodbtype,
67 'timestamp_file' => "archiveinf-timestamp.out",
68 'info' => {},
69 'reverse-info'=> {},
70 'order' => [],
71 'reverse_sort'=> 0,
72 'sort' => 0};
73
74 return bless $self, $class;
75}
76
77sub _load_info_txt
78{
79 my $self = shift (@_);
80 my ($filename) = @_;
81
82 if (defined $filename && &FileUtils::fileExists($filename)) {
83 open (INFILE, $filename) ||
84 die "arcinfo::load_info couldn't read $filename\n";
85
86 my ($line, @line);
87 while (defined ($line = <INFILE>)) {
88 $line =~ s/\cM|\cJ//g; # remove end-of-line characters
89 @line = split ("\t", $line); # filename,
90 if (scalar(@line) >= 2) {
91 $self->add_info (@line);
92 }
93 }
94 close (INFILE);
95 }
96}
97
98sub _load_info_db
99{
100 my $self = shift (@_);
101 my ($filename) = @_;
102
103 my $infodb_map = {};
104
105 &dbutil::read_infodb_file($self->{'infodbtype'}, $filename, $infodb_map);
106
107 foreach my $oid ( keys %$infodb_map ) {
108 my $vals = $infodb_map->{$oid};
109 # interested in doc-file and index-status
110
111 my ($doc_file) = ($vals=~/^<doc-file>(.*)$/m);
112 my ($index_status) = ($vals=~/^<index-status>(.*)$/m);
113 my ($sortmeta) = ($vals=~/^<sort-meta>(.*)$/m);
114 my ($group_position) = ($vals=~/^<group-position>(.*)$/m);
115 $self->add_info ($oid,$doc_file,$index_status,$sortmeta, $group_position);
116 }
117}
118
119
120sub load_info {
121 my $self = shift (@_);
122 my ($filename) = @_;
123
124 my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(1);
125
126 $self->{'info'} = {};
127
128 if (defined $filename) {
129
130 my $timestamp_filename = $self->get_timestamp_filename($filename);
131 if (&FileUtils::fileExists($timestamp_filename)) {
132 my ($prev_infodbtype,$unused_timestamp) = $self->load_timestamp($filename);
133 $self->{'prev-infodbtype'} = $prev_infodbtype;
134 }
135
136 if (!&FileUtils::fileExists($filename)) {
137 # Typically a sign of a first-time, or -removeold build
138
139 # ... but could be because the value of infodbtype has changed since the last build
140 # => Check
141
142 my $prev_infodbtype = $self->{'prev-infodbtype'};
143 my $infodbtype = $self->{'infodbtype'};
144
145 if (defined $prev_infodbtype && ($prev_infodbtype ne $infodbtype)) {
146 print STDERR "arcinfo::load_info() detected change in infodbtype from previous build: $prev_infodbtype -> $infodbtype\n";
147 print STDERR "=> adjusting archiveinf filename accordingly.\n";
148
149 $filename =~ s/\.$infodbtype$/.$prev_infodbtype/;
150 }
151 }
152
153 # $filename might have changed if infodbtypes don't match
154 if (&FileUtils::fileExists($filename)) {
155 if ($filename =~ m/\.inf$/) {
156 $self->_load_info_txt($filename);
157 }
158 else {
159 $self->_load_info_db($filename);
160 }
161 }
162 }
163}
164
165sub _load_filelist_db
166{
167 my $self = shift (@_);
168 my ($filename) = @_;
169
170 my $infodb_map = {};
171
172 &dbutil::read_infodb_file($self->{'infodbtype'}, $filename, $infodb_map);
173
174 foreach my $file ( keys %$infodb_map ) {
175 # turn placeholders in the file keys of archiveinf-src file back to absolute paths
176 $file = &util::placeholders_to_abspath($file);
177 $self->{'prev_import_filelist'}->{$file} = 1;
178 }
179}
180
181
182sub load_prev_import_filelist {
183 my $self = shift (@_);
184 my ($filename) = @_;
185
186 $self->{'import-filelist'} = {};
187
188 if ((defined $filename) && &FileUtils::fileExists($filename)) {
189
190 if ($filename =~ m/\.inf$/) {
191 # e.g. 'archives-src.inf' (which includes complete list of file
192 # from last time import.pl was run)
193 $self->_load_info_txt($filename);
194 }
195 else {
196 $self->_load_filelist_db($filename);
197 }
198 }
199}
200
201# Loads in reverse-lookup info:
202# Key = a file in import
203# Value = all the the doc ids that file is used in
204#
205sub load_rev_info
206{
207 my $self = shift (@_);
208 my ($rev_filename) = @_;
209
210 my $rev_infodb_map = {};
211
212 if ((defined $rev_filename) && &FileUtils::fileExists($rev_filename)) {
213 &dbutil::read_infodb_file($self->{'infodbtype'}, $rev_filename, $rev_infodb_map);
214
215 foreach my $srcfile ( keys %$rev_infodb_map ) {
216
217 my $vals = $rev_infodb_map->{$srcfile};
218
219 $srcfile = &util::placeholders_to_abspath($srcfile);
220 foreach my $OID ($vals =~ m/^<oid>(.*)$/gm) {
221 $self->add_reverseinfo($srcfile,$OID);
222 }
223 }
224 }
225}
226
227
228sub _save_info_txt {
229 my $self = shift (@_);
230 my ($filename) = @_;
231
232 my ($OID, $info);
233
234 open (OUTFILE, ">$filename") ||
235 die "arcinfo::save_info couldn't write $filename\n";
236
237 foreach $info (@{$self->get_OID_list()}) {
238 if (defined $info) {
239 print OUTFILE join("\t", @$info), "\n";
240 }
241 }
242 close (OUTFILE);
243}
244
245sub _save_info_db {
246 my $self = shift (@_);
247 my ($filename) = @_;
248
249 my $infodbtype = $self->{'infodbtype'};
250
251 # Not the most efficient operation, but will do for now
252
253 # read it in
254 my $infodb_map = {};
255 &dbutil::read_infodb_file($infodbtype, $filename, $infodb_map);
256
257 # change index-status values
258 foreach my $info (@{$self->get_OID_list()}) {
259 if (defined $info) {
260 my ($oid,$doc_file,$index_status) = @$info;
261 if (defined $infodb_map->{$oid}) {
262 my $vals_ref = \$infodb_map->{$oid};
263 $$vals_ref =~ s/^<index-status>(.*)$/<index-status>$index_status/m;
264 }
265 else {
266 print STDERR "Warning: $filename does not have key $oid\n";
267 }
268 }
269 }
270
271
272 # write out again
273 my $infodb_handle = &dbutil::open_infodb_write_handle($infodbtype, $filename);
274 foreach my $oid ( keys %$infodb_map ) {
275 my $vals = $infodb_map->{$oid};
276 &dbutil::write_infodb_rawentry($infodbtype,$infodb_handle,$oid,$vals);
277 }
278 &dbutil::close_infodb_write_handle($infodbtype, $infodb_handle);
279
280}
281
282sub save_revinfo_db {
283 my $self = shift (@_);
284 my ($rev_filename) = @_;
285 # Output reverse lookup database
286
287 my $rev_infodb_map = $self->{'reverse-info'};
288 my $rev_infodb_handle
289 = &dbutil::open_infodb_write_handle($self->{'infodbtype'}, $rev_filename);
290# = &dbutil::open_infodb_write_handle($self->{'infodbtype'}, $rev_filename, "append");
291
292 foreach my $key ( keys %$rev_infodb_map ) {
293 my $val_hash = $rev_infodb_map->{$key};
294 $key = &util::abspath_to_placeholders($key);
295
296 &dbutil::write_infodb_entry($self->{'infodbtype'}, $rev_infodb_handle, $key, $val_hash);
297 }
298 &dbutil::close_infodb_write_handle($self->{'infodbtype'}, $rev_infodb_handle);
299
300}
301
302sub save_info {
303 my $self = shift (@_);
304 my ($arcinfo_filename) = @_;
305
306
307 if ($arcinfo_filename =~ m/(contents)|(\.inf)$/) {
308 $self->_save_info_txt($arcinfo_filename);
309 }
310 else {
311 $self->_save_info_db($arcinfo_filename);
312 }
313}
314
315
316
317sub get_timestamp_filename
318{
319 my $self = shift (@_);
320 my ($arcinfo_doc_filename) = @_;
321
322 my $arcinfo_dirname = &File::Basename::dirname($arcinfo_doc_filename);
323
324 my $timestamp_filename = &FileUtils::filenameConcatenate($arcinfo_dirname, $self->{'timestamp_file'});
325
326 return $timestamp_filename;
327}
328
329
330sub load_timestamp
331{
332 my $self = shift (@_);
333 my ($arcinfo_doc_filename) = @_;
334
335 my $arcinfo_timestamp_filename = $self->get_timestamp_filename($arcinfo_doc_filename);
336
337 my $timestamp_infodbtype = undef;
338 my $arcinfo_timestamp = undef;
339
340 if (-f $arcinfo_timestamp_filename) {
341 if (open(ARCINFTS_IN,"<$arcinfo_timestamp_filename")) {
342 my $line = <ARCINFTS_IN>;
343 chomp $line;
344 close(ARCINFTS_IN);
345
346 ($timestamp_infodbtype,$arcinfo_timestamp) = ($line =~ m/^\s*(\w+)\s*:\s*(\d+)\s*$/)
347 }
348 else {
349 print STDERR "Error - failed to read:\n";
350 print STDERR " $arcinfo_timestamp_filename\n";
351 }
352 }
353
354 return ($timestamp_infodbtype,$arcinfo_timestamp);
355}
356
357
358sub save_arcinfo_doc_timestamp
359{
360 my $self = shift (@_);
361 my ($arcinfo_doc_filename) = @_;
362
363 my $arcinfo_timestamp_filename = $self->get_timestamp_filename($arcinfo_doc_filename);
364
365 my $infodbtype = $self->{'infodbtype'};
366
367 # Before recording the current infodbtype type and timestamp
368 # handle the case of prev_infodbtype being different to infodbyte
369 # => mothball the prev_infodbtype as a backup file
370
371 my $prev_infodbtype = $self->{'prev-infodbtype'};
372 if ((defined $prev_infodbtype) && ($prev_infodbtype ne $infodbtype)) {
373 my ($arcinfo_tailname, $arcinfo_dirname, $arcinfo_suffix)
374 = &File::Basename::fileparse($arcinfo_doc_filename, "\\.[^\\.]+\$");
375
376 my $prev_arcinfo_filename = &dbutil::get_infodb_file_path($prev_infodbtype,$arcinfo_tailname,$arcinfo_dirname);
377 my $backup_arcinfo_filename = $prev_arcinfo_filename;
378 $backup_arcinfo_filename =~ s/\.$prev_infodbtype$/.bak.$prev_infodbtype/;
379
380 print STDERR "As a result of infodbtype changing from $prev_infodbtype -> $infodbtype\n";
381 print STDERR "=> Making a backup copy of $prev_arcinfo_filename\n";
382 &dbutil::rename_db_file_to($prev_infodbtype,$prev_arcinfo_filename,$backup_arcinfo_filename);
383
384 }
385
386 # Could consider taking the the timestamp of the file itself ???
387 # e.g. $arcinfo_timestamp = -M $arcinfo_filename;
388 # But for now base this on a 'live' reading
389 my $arcinfo_timestamp = time();
390
391 if (open(ARCINFTS_OUT,">$arcinfo_timestamp_filename")) {
392 print ARCINFTS_OUT "$infodbtype:$arcinfo_timestamp\n";
393
394 close(ARCINFTS_OUT);
395 }
396 else {
397 print STDERR "Error - failed to write:\n";
398 print STDERR " $arcinfo_timestamp_filename\n";
399 }
400}
401
402
403sub delete_info {
404 my $self = shift (@_);
405 my ($OID) = @_;
406
407 if (defined $self->{'info'}->{$OID}) {
408 delete $self->{'info'}->{$OID};
409
410 my $i = 0;
411 while ($i < scalar (@{$self->{'order'}})) {
412 if ($self->{'order'}->[$i]->[ORDER_OID_INDEX] eq $OID) {
413 splice (@{$self->{'order'}}, $i, 1);
414 last;
415 }
416
417 $i ++;
418 }
419 }
420}
421
422sub add_info {
423 my $self = shift (@_);
424 my ($OID, $doc_file, $index_status, $sortmeta, $group_position) = @_;
425 $sortmeta = "" unless defined $sortmeta;
426 $index_status = "I" unless defined $index_status; # I = needs indexing
427 if (! defined($OID)) {
428 # only happens when no files can be processed?
429 return undef;
430 }
431
432 if (defined $self->{'info'}->{$OID}) {
433 # test to see if we are in a reindex situation
434
435 my $existing_status_info = $self->get_status_info($OID);
436
437 if ($existing_status_info eq "D") {
438 # yes, we're in a reindexing situation
439 $self->delete_info ($OID);
440
441
442 # force setting to "reindex"
443 $index_status = "R";
444
445 }
446 else {
447 # some other, possibly erroneous, situation has arisen
448 # where the document already seems to exist
449 print STDERR "Warning: $OID already exists with index status $existing_status_info\n";
450 print STDERR " Deleting previous version stored in archiveinfo\n";
451
452 $self->delete_info ($OID);
453 }
454 }
455
456 $self->{'info'}->{$OID} = [$doc_file,$index_status,$sortmeta, $group_position];
457 push (@{$self->{'order'}}, [$OID, $sortmeta]); # ORDER_OID_INDEX and ORDER_SORT_INDEX
458
459
460}
461
462sub set_status_info {
463 my $self = shift (@_);
464 my ($OID, $index_status) = @_;
465
466 my $OID_info = $self->{'info'}->{$OID};
467 $OID_info->[INFO_STATUS_INDEX] = $index_status;
468}
469
470
471sub get_status_info {
472 my $self = shift (@_);
473 my ($OID) = @_;
474
475 my $index_status = undef;
476
477 my $OID_info = $self->{'info'}->{$OID};
478 if (defined $OID_info) {
479 $index_status = $OID_info->[INFO_STATUS_INDEX];
480 }
481 else {
482 die "Unable to find document id $OID\n";
483 }
484
485 return $index_status;
486
487}
488
489sub get_group_position {
490 my $self = shift (@_);
491 my ($OID) = @_;
492
493 my $group_position = undef;
494 my $OID_info = $self->{'info'}->{$OID};
495 if (defined $OID_info) {
496 $group_position = $OID_info->[INFO_GROUPPOS_INDEX];
497 }
498 else {
499 die "Unable to find document id $OID\n";
500 }
501 return $group_position;
502
503}
504sub add_reverseinfo {
505 my $self = shift (@_);
506 my ($key, $OID) = @_;
507
508 my $existing_key = $self->{'reverse-info'}->{$key};
509 if (!defined $existing_key) {
510 $existing_key = {};
511 $self->{'reverse-info'}->{$key} = $existing_key;
512 }
513
514 my $existing_oid = $existing_key->{'oid'};
515 if (!defined $existing_oid) {
516 $existing_oid = [];
517 $existing_key->{'oid'} = $existing_oid;
518 }
519
520 for (@$existing_oid) {
521 if ($_ eq $OID) {
522 return; # already in the list
523 }
524 }
525 push(@$existing_oid,$OID);
526
527}
528
529sub remove_reverseinfo {
530 my $self = shift (@_);
531 my ($key, $OID) = @_;
532
533 my $existing_key = $self->{'reverse-info'}->{$key};
534 if (!defined $existing_key) {
535 ###print STDERR "trying to remove entry for $key, but its not there!\n";
536 return;
537 }
538 if (!defined $OID) {
539 ###print STDERR "no oid defined, removing whole entry\n";
540 delete $self->{'reverse-info'}->{$key};
541 return;
542 }
543 my $existing_oid = $existing_key->{'oid'};
544 if (!defined $existing_oid) {
545 ###print STDERR "trying to remove entry for $key, but it has no oid field!\n";
546 return;
547 }
548 for my $i (0..scalar(@$existing_oid)) {
549 if (@$existing_oid[$i] eq $OID) {
550 splice @$existing_oid, $i, 1;
551 if (scalar (@$existing_oid) ==0) {
552 ###print STDERRQ "have removed all oids, delete the main key\n";
553 delete $self->{'reverse-info'}->{$key};
554 }
555 return;
556 }
557 }
558}
559sub get_reverseinfo {
560 my $self = shift (@_);
561 my ($key) = @_;
562
563 if ($self->{'reverse-info'}->{$key}) {
564 return $self->{'reverse-info'}->{$key}->{'oid'};
565 }
566 return undef;
567}
568
569sub set_meta_file_flag {
570 my $self = shift (@_);
571 my ($key) = @_;
572
573 my $existing_key = $self->{'reverse-info'}->{$key};
574 if (!defined $existing_key) {
575 $existing_key = {};
576 $self->{'reverse-info'}->{$key} = $existing_key;
577 }
578
579 $existing_key->{'meta-file'} = ["1"];
580
581}
582sub reverse_sort
583{
584 my $self = shift(@_);
585 $self->{'reverse_sort'} = 1;
586}
587sub sort
588{
589 my $self = shift(@_);
590 $self->{'sort'} = 1;
591}
592
593
594# returns a list of the form [[OID, doc_file, index_status], ...]
595sub get_OID_list
596{
597 my $self = shift (@_);
598
599 my $order = $self->{'order'};
600
601 my @sorted_order;
602 if ($self->{'reverse_sort'}) {
603 @sorted_order = sort {$b->[ORDER_SORT_INDEX] cmp $a->[ORDER_SORT_INDEX]} @$order;
604 } elsif ($self->{'sort'}) {
605 @sorted_order = sort {$a->[ORDER_SORT_INDEX] cmp $b->[ORDER_SORT_INDEX]} @$order;
606 } else { # not sorting, don't bother
607 @sorted_order = @$order;
608 }
609
610 my @list = ();
611
612 foreach my $OID_order (@sorted_order) {
613 my $OID = $OID_order->[ORDER_OID_INDEX];
614 my $OID_info = $self->{'info'}->{$OID};
615
616 push (@list, [$OID, $OID_info->[INFO_FILE_INDEX],
617 $OID_info->[INFO_STATUS_INDEX]]);
618 }
619
620 return \@list;
621}
622
623# returns a list of the form [[doc_file, OID], ...]
624sub get_file_list {
625 my $self = shift (@_);
626
627 my $order = $self->{'order'};
628
629 my @sorted_order;
630 if ($self->{'reverse_sort'}) {
631 @sorted_order = sort {$b->[ORDER_SORT_INDEX] cmp $a->[ORDER_SORT_INDEX]} @$order;
632 } elsif ($self->{'sort'}) {
633 @sorted_order = sort {$a->[ORDER_SORT_INDEX] cmp $b->[ORDER_SORT_INDEX]} @$order;
634 } else { # not sorting, don't bother
635 @sorted_order = @$order;
636 }
637
638 my @list = ();
639
640 foreach my $OID_order (@sorted_order) {
641 my $OID = $OID_order->[ORDER_OID_INDEX];
642 my $OID_info = $self->{'info'}->{$OID};
643
644 push (@list, [$OID_info->[INFO_FILE_INDEX], $OID]);
645 }
646
647 return \@list;
648}
649
650
651# returns a list of the form [doc_file,index_status,$sort_meta, $group_position]
652sub get_info {
653 my $self = shift (@_);
654 my ($OID) = @_;
655
656 if (defined $self->{'info'}->{$OID}) {
657 return $self->{'info'}->{$OID};
658 }
659
660 return undef;
661}
662
663
664
665# returns the number of documents so far
666sub size {
667 my $self = shift (@_);
668 return (scalar(@{$self->{'order'}}));
669}
670
6711;
672
Note: See TracBrowser for help on using the repository browser.