source: branches/New_Config_Format-branch/gsdl/perllib/plugins/RecPlug.pm@ 1279

Last change on this file since 1279 was 1279, checked in by sjboddie, 24 years ago

merged changes to trunk into New_Config_Format branch

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.7 KB
RevLine 
[537]1###########################################################################
2#
3# RecPlug.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
[4]26# plugin which recurses through directories processing
27# each file it finds
28
29package RecPlug;
30
31use BasPlug;
32use plugin;
[136]33use util;
[4]34
35
36BEGIN {
37 @ISA = ('BasPlug');
38}
39
[1279]40use strict;
41
[4]42sub new {
43 my ($class) = @_;
[1279]44 my $self = new BasPlug ("RecPlug", @_);
[4]45
[620]46 $self->{'exclude_tail_dirs'} = []; # empty by default
47
[4]48 return bless $self, $class;
49}
50
51# return 1 if this class might recurse using $pluginfo
52sub is_recursive {
53 my $self = shift (@_);
54
55 return 1;
56}
57
[317]58
59# return number of files processed, undef if can't process
[4]60# Note that $base_dir might be "" and that $file might
61# include directories
62sub read {
63 my $self = shift (@_);
[317]64 my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
[4]65
[1279]66 foreach my $etd ( @{$self->{'exclude_tail_dirs'}} )
[620]67 {
68 return 0 if ($file =~ m/$etd/);
69 }
70
[4]71 my (@dir, $subfile);
72
[317]73 my $count = 0;
74
[4]75 # see if this is a directory
[1279]76 my $dirname = &util::filename_cat ($base_dir, $file);
[136]77 if (-d $dirname) {
[4]78
79 # read all the files in the directory
[593]80 if (!opendir (DIR, $dirname))
81 {
82 print STDERR "RecPlug: WARNING - couldn't read directory $dirname\n";
83 return;
84 }
85
[4]86 @dir = readdir (DIR);
87 closedir (DIR);
88
[317]89 print STDERR "RecPlug: getting directory $dirname\n";
90
[4]91 # process each file
92 foreach $subfile (@dir) {
[809]93 last if ($maxdocs != -1 && $count >= $maxdocs);
[317]94
[4]95 if ($subfile !~ /^\.\.?$/) {
96 # note: metadata is not carried on to the next level
[317]97 $count += &plugin::read ($pluginfo, $base_dir, &util::filename_cat($file, $subfile),
98 {}, $processor, $maxdocs);
[4]99 }
100 }
[317]101 return $count;
[4]102 }
103
104 # wasn't a directory, someone else will have to process it
[317]105 return undef;
[4]106}
107
108
1091;
Note: See TracBrowser for help on using the repository browser.