root/main/trunk/greenstone2/perllib/plugins/ArchivesInfPlugin.pm @ 21566

Revision 21566, 8.8 KB (checked in by mdewsnip, 10 years ago)

Changed all places explicitly using "archiveinf-doc.gdb" or "archiveinf-src.gdb" to use the dbutil::get_infodb_file_path() function... you know, the one that should have been used originally? In preparation for making it possible to use something other than GDBM, and part of making the code less GDBM-specific.

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