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

Revision 21308, 8.5 KB (checked in by kjdon, 10 years ago)

removeold renamed to remove_all, added remove_one for deleting a single doc

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