source: gsdl/trunk/perllib/plugins/ArchivesInfPlugin.pm@ 18508

Last change on this file since 18508 was 18508, checked in by davidb, 15 years ago

Had to move location of where deletion of archive files was done

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 8.0 KB
RevLine 
[537]1###########################################################################
2#
[16013]3# ArchivesInfPlugin.pm --
[537]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
[18441]26# plugin which reads through an archives.inf (or GDBM equivalent,
27# archiveinf-doc.{ldb,bdb} file (i.e. the file generated in the
28# archives directory when an import is done), processing each file it
29# finds
[4]30
[15870]31package ArchivesInfPlugin;
[4]32
33use util;
[17738]34use PrintInfo;
[4]35use plugin;
36use arcinfo;
[5680]37use gsprintf;
[4]38
[10254]39use strict;
40no strict 'refs'; # allow filehandles to be variables and viceversa
41
[4]42BEGIN {
[17738]43 @ArchivesInfPlugin::ISA = ('PrintInfo');
[4]44}
45
[10254]46my $arguments = [
47 ];
48
[15870]49my $options = { 'name' => "ArchivesInfPlugin",
50 'desc' => "{ArchivesInfPlugin.desc}",
[6408]51 'abstract' => "no",
52 'inherits' => "yes" };
[10254]53
[5680]54sub gsprintf
55{
56 return &gsprintf::gsprintf(@_);
57}
58
[4]59sub new {
[10218]60 my ($class) = shift (@_);
61 my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
62 push(@$pluginlist, $class);
[4]63
[15870]64 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
65 push(@{$hashArgOptLists->{"OptList"}},$options);
[10218]66
[17738]67 my $self = new PrintInfo($pluginlist, $inputargs, $hashArgOptLists);
[10218]68
[4]69 return bless $self, $class;
70}
71
[17738]72# called once, at the start of processing
73sub init {
74 my $self = shift (@_);
75 my ($verbosity, $outhandle, $failhandle) = @_;
76
77 # verbosity is passed through from the processor
78 $self->{'verbosity'} = $verbosity;
79
80 # as are the outhandle and failhandle
81 $self->{'outhandle'} = $outhandle if defined $outhandle;
82 $self->{'failhandle'} = $failhandle;
83
84}
85
[10156]86sub deinit {
87 my ($self) = @_;
88
89 my $archive_info = $self->{'archive_info'};
[18508]90 my $verbosity = $self->{'verbosity'};
91 my $outhandle = $self->{'outhandle'};
[10156]92
93 if (defined $archive_info) {
94 my $archive_info_filename = $self->{'archive_info_filename'};
95
96 my $file_list = $archive_info->get_file_list();
97
[18456]98 foreach my $subfile (@$file_list) {
[10156]99 my $doc_oid = $subfile->[1];
[18441]100
[10254]101 my $index_status = $archive_info->get_status_info($doc_oid);
[18456]102
[18441]103 if ($index_status eq "D") {
104 # delete
105 $archive_info->delete_info($doc_oid);
[18469]106 &GDBMUtils::gdbmDatabaseRemove($archive_info_filename,$doc_oid);
[18508]107
108 my $doc_file = $subfile->[0];
109 my $base_dir =$self->{'base_dir'};
110
111 my $doc_filename = &util::filename_cat($base_dir,$doc_file);
112
113 my ($doc_tailname, $doc_dirname, $suffix)
114 = File::Basename::fileparse($doc_filename, "\\.[^\\.]+\$");
115
116 print STDERR "Removing $doc_dirname\n" if ($verbosity>2);
117
118 &util::rm_r($doc_dirname);
119
120
[18441]121 }
122 elsif ($index_status =~ m/^(I|R)$/) {
123 # mark as "been indexed"
124 $archive_info->set_status_info($doc_oid,"B");
125 }
[10156]126 }
127
128 $archive_info->save_info($archive_info_filename);
129 }
130}
131
[17738]132# called at the beginning of each plugin pass (import has one, buildin has many)
133sub begin {
134 my $self = shift (@_);
135 my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
136
[18508]137 $self->{'base_dir'} = $base_dir;
[17738]138}
139
140# called at the end of each plugin pass
141sub end {
142 my ($self) = shift (@_);
143
144}
145
146# called if we are doing incremental building
147sub set_incremental {
148 my $self = shift(@_);
149 my ($incremental) = @_;
150
151 $self->{'incremental'} = $incremental;
152}
153
[4]154# return 1 if this class might recurse using $pluginfo
155sub is_recursive {
156 my $self = shift (@_);
157
158 return 1;
159}
160
[10156]161
[17738]162sub compile_stats {
163 my $self = shift(@_);
164 my ($stats) = @_;
165}
[10156]166
[17738]167# We don't do metadata_read
168sub metadata_read {
169 my $self = shift (@_);
170 my ($pluginfo, $base_dir, $file, $block_hash, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
[10156]171
[17738]172 return undef;
173}
174
175# we don't do any file blocking
176sub file_block_read {
177
178 my $self = shift (@_);
179 my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $gli) = @_;
180
181 return undef;
182}
183
184
[317]185# return number of files processed, undef if can't process
[4]186# Note that $base_dir might be "" and that $file might
187# include directories
188sub read {
189 my $self = shift (@_);
[16392]190 my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $processor, $maxdocs,$total_count, $gli) = @_;
[1424]191 my $outhandle = $self->{'outhandle'};
[4]192
[317]193 my $count = 0;
194
[4]195 # see if this has a archives information file within it
[18441]196## my $archive_info_filename = &util::filename_cat($base_dir,$file,"archives.inf");
197 my $db_ext = &util::is_little_endian() ? ".ldb" : ".bdb";
198 my $doc_db = "archiveinf-doc$db_ext";
199 my $archive_info_filename = &util::filename_cat($base_dir,$file,$doc_db);
[4]200
201 if (-e $archive_info_filename) {
202
[317]203 # found an archives.inf file
[15870]204 &gsprintf($outhandle, "ArchivesInfPlugin: {common.processing} $archive_info_filename\n") if $self->{'verbosity'} > 1;
[317]205
[4]206 # read in the archives information file
207 my $archive_info = new arcinfo ();
[10156]208 $self->{'archive_info'} = $archive_info;
[12397]209 $self->{'archive_info_filename'} = $archive_info_filename;
[10156]210
[4]211 $archive_info->load_info ($archive_info_filename);
212
[230]213 my $file_list = $archive_info->get_file_list();
[4]214
215 # process each file
[1244]216 foreach my $subfile (@$file_list) {
[18441]217
[9853]218 last if ($maxdocs != -1 && ($total_count + $count) >= $maxdocs);
[317]219
[4]220 my $tmp = &util::filename_cat ($file, $subfile->[0]);
221 next if $tmp eq $file;
[18456]222
223 my $doc_oid = $subfile->[1];
224 my $index_status = $archive_info->get_status_info($doc_oid);
225
226 my $curr_mode = $processor->get_mode();
227 my $new_mode = $curr_mode;
228
229 # Start by assuming we want to process the file...
[16257]230 my $process_file = 1;
[10156]231
[18469]232 # ...unless the build processor is incremental capable and -incremental was specified, in which case we need to check its index_status flag
[16257]233 if ($processor->is_incremental_capable() && $self->{'incremental'})
234 {
[18441]235 # Check to see if the file needs indexing
[16257]236 if ($index_status eq "B")
237 {
[18441]238 # Don't process this file as it has already been indexed
[16257]239 $process_file = 0;
[10305]240 }
[18456]241 elsif ($index_status eq "D") {
242 # Need to be delete it from the index.
243 $new_mode = $curr_mode."delete";
244 $process_file = 1;
245 }
246 elsif ($index_status eq "R") {
[18469]247 # Need to be reindexed/replaced
[18456]248 $new_mode = $curr_mode."reindex";
[18469]249
[18456]250 $process_file = 1;
251 }
[10305]252 }
[18456]253 # ... or we're being asked to delete it (in which case skip it)
254 elsif ($index_status eq "D") {
[18469]255 # Non-incremental Delete
256 # It's already been deleted from the archives directory
257 # (done during import.pl)
258 # => All we need to do here is not process it
[10305]259
[18456]260 $process_file = 0;
261 }
262
[18469]263 if (!$processor->is_incremental_capable() && $self->{'incremental'}) {
264 # Nag feature
265 if (!defined $self->{'incremental-warning'}) {
266 print $outhandle "\n";
267 print $outhandle "Warning: command-line option '-incremental' used with *non-incremental*\n";
268 print $outhandle " processor '", ref $processor, "'. Some conflicts may arise.\n";
269 print $outhandle "\n";
270 sleep 10;
271 $self->{'incremental-warning'} = 1;
272 }
273 }
274
[10305]275 if ($process_file) {
[10156]276 # note: metadata is not carried on to the next level
[18456]277
278 $processor->set_mode($new_mode) if ($new_mode ne $curr_mode);
279
[16392]280 $count += &plugin::read ($pluginfo, $base_dir, $tmp, $block_hash, {}, $processor, $maxdocs, ($total_count+$count), $gli);
[18456]281
282 $processor->set_mode($curr_mode) if ($new_mode ne $curr_mode);
[10156]283 }
[4]284 }
285
[317]286 return $count;
[4]287 }
288
289 # wasn't an archives directory, someone else will have to process it
[317]290 return undef;
[4]291}
292
2931;
Note: See TracBrowser for help on using the repository browser.