Index: /trunk/gsdl/perllib/plugins/RecPlug.pm
===================================================================
--- /trunk/gsdl/perllib/plugins/RecPlug.pm	(revision 2227)
+++ /trunk/gsdl/perllib/plugins/RecPlug.pm	(revision 2228)
@@ -24,6 +24,65 @@
 ###########################################################################
 
-# plugin which recurses through directories processing
-# each file it finds
+# RecPlug is a plugin which recurses through directories processing
+# each file it finds.
+
+# RecPlug has one option: use_metadata_files.  When this is set, it will
+# check each directory for an XML file called "metadata" that specifies
+# metadata for the files (and subdirectories) in the directory.  It will
+# also look in any file of the form *.metadata for metadata about the file
+# with the same prefix.
+#
+# Here's an example of a metadata file that cuses theree metadata structures
+# (ignore the # characters):
+
+#<metadata>
+#  <filename>nugget.*</filename>
+#  <Title>Nugget Point, The Catlins</Title>
+#  <Place mode=accumulate>Nugget Point</Place>
+#</metadata>
+#
+#<metadata>
+#  <filename>nugget-point-1.jpg</filename>
+#  <Title>Nugget Point Lighthouse, The Catlins</Title>
+#  <Subject>Lighthouse</Subject>
+#</metadata>
+#
+#<metadata>
+#  <filename>kaka-point-dir</filename>
+#  <Title>Kaka Point, The Catlins</Title>
+#</metadata>
+
+# Metadata elements are read and applied to files in the order they appear
+# in the file.  The directory's "metadata" file is erad first, and then any
+# other files of the form "*.metadata" are read in alphabetical order.
+#
+# The filename element describes the subfiles in the directory that the
+# metadata applies to as a perl regular expression, so
+# <filename>nugget.*</filename> indicates that the first metadata record
+# applies to every subfile that starts with "nugget".  For these files, a
+# Title metadata element is set, overriding any old value that the Title
+# might have had.
+#
+# Occasionally, we want to have multiple metadata values applied to a
+# document; in this case we use the "mode=accumulate" attribute of the
+# particular metadata item.  In the first metadata element above, the
+# "Place" metadata is accumulating, and is therefore given several values.
+# If we wanted to override these values and use a single metadata element
+# again, we could write <Place mode=override>New Zealand</Place> instead.
+# Remember: every element is assumed to be in override mode unless you
+# specify otherwise, so if you want to accumulate metadata for some field,
+# every occurance must have "mode=accumulate" specified.
+#
+# The second metadata element applies to a specific file, called
+# nugget-point-1.jpg.  This element overrides the Title set in the first
+# element above, and adds a "Subject" ,etadata field.
+#
+# The third and fional metadata element sets metadata for a subdirectory
+# rather than a file.  The metadata specified (a Title) will be passed into
+# the subdirectory and applied to every file that occurs in the
+# subdirectory (and to every subsubdirectory and its contents, and so on)
+# unless the metadata is explictly overridden later in the import.
+
+
 
 package RecPlug;
@@ -38,9 +97,27 @@
 }
 
+sub print_usage {
+    my ($plugin_name) = @_;
+
+    print STDERR "
+  usage: plugin RecPlug [options]
+
+   -use_metadata_files  Read metadata from metadata XML files.
+
+"
+}
+
 sub new {
-    my ($class) = @_;
-    my $self = new BasPlug ("RecPlug", @_);
-
-    $self->{'exclude_tail_dirs'} = []; # empty by default
+    my $class = shift (@_);
+    my $self = new BasPlug ($class, @_);
+
+    if (!parsargv::parse(\@_,
+			 q^use_metadata_files^, \$self->{'use_metadata_files'},
+			 "allow_extra_options")) {
+	print STDERR "\nRecPlug uses an incorrect option.\n";
+	print STDERR "Check your collect.cfg configuration file.\n\n";
+    	&print_usage("RecPlug");
+	die "\n";
+    }
 
     return bless $self, $class;
@@ -54,30 +131,40 @@
 }
 
+sub get_default_block_exp {
+    my $self = shift (@_);
+
+    return 'CVS';
+}
 
 # return number of files processed, undef if can't process
 # Note that $base_dir might be "" and that $file might 
 # include directories
+
+# This function passes around metadata hash structures.  Metadata hash
+# structures are hashes that map from a (scalar) key (the metadata element
+# name) to either a scalar metadata value or a reference to an array of
+# such values.
+
 sub read {
     my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
+    my ($pluginfo, $base_dir, $file, $in_metadata, $processor, $maxdocs) = @_;
+
     my $outhandle = $self->{'outhandle'};
-
-    foreach my $etd ( @{$self->{'exclude_tail_dirs'}} )
-    {
-	return 0 if ($file =~ m/$etd/);
-    }	
-
-    my (@dir, $subfile);
-    my $count = 0;
-
-    # see if this is a directory
+    my $verbosity = $self->{'verbosity'};
+    my $read_metadata_files = $self->{'use_metadata_files'};
+
+    # Calculate the directory name and ensure it is a directory and
+    # that it is not explicitly blocked.
+    $file =~ s/^[\/\\]+//; 
     my $dirname = &util::filename_cat ($base_dir, $file);
-
-    # check to make sure we're not reading our own archives 
-    # or index directory
-    my $gsdlhome = quotemeta ($ENV{'GSDLHOME'});
+    return undef unless (-d $dirname);
+    return 0 if ($self->{'block_exp'} ne "" && $dirname =~ /$self->{'block_exp'}/);
+
+
+    # check to make sure we're not reading the archives or index directory
+    my $gsdlhome = quotemeta($ENV{'GSDLHOME'});
     if ($dirname =~ m%^${gsdlhome}/.*?/import.*?/(archives|index)$%) {
-	print $outhandle "RecPlug: $dirname appears to be a reference to a Greenstone collection, skipping.\n";
-	return 1;
+        print $outhandle "RecPlug: $dirname appears to be a reference to a Greenstone collection, skipping.\n";
+        return 0;
     }
 
@@ -85,49 +172,272 @@
     if ($dirname =~ m%(/.*){,41}%) {
 	print $outhandle "RecPlug: $dirname is 40 directories deep, is this a recursive path? if not increase constant in RecPlug.pm.\n";
-	return 1;
+	return 0;
     }
 
     # check to see we haven't got a cyclic path...
     if ($dirname =~ m%.*?import/(.+?)/import/\1.*%) {
-	print $outhandle "RecPlug: $dirname appears to a recursive loop ...\n";
-	return 1;
-    }
-
-
-    if (-d $dirname) {
-
-	if ($dirname =~ m|/CVS$|) {
-	    print $outhandle "RecPlug: $dirname is a CVS directory, skipping.\n";
-	    return 1;
-	}
-	# read all the files in the directory
-        if (!opendir (DIR, $dirname))
-        {
-            print $outhandle "RecPlug: WARNING - couldn't read directory $dirname\n";
-            return;
-        }
-
-	@dir = readdir (DIR);
-	closedir (DIR);
-
-	print $outhandle "RecPlug: getting directory $dirname\n";
-
-	# process each file
-	foreach $subfile (@dir) {
-	    last if ($maxdocs != -1 && $count >= $maxdocs);
-
-	    if ($subfile !~ /^\.\.?$/) {
-		# note: metadata is not carried on to the next level
-		$count += &plugin::read ($pluginfo, $base_dir, &util::filename_cat($file, $subfile),
-					 {}, $processor, $maxdocs);
+	print $outhandle "RecPlug: $dirname appears to be in a recursive loop...\n";
+	return 0;
+    }
+
+    if (($verbosity > 2) && ((scalar keys %$in_metadata) > 0)) {
+        print $outhandle "RecPlug: metadata passed in: ", 
+	                 join(", ", keys %$in_metadata), "\n";
+    }
+
+    # Recur over directory contents.
+    my (@dir, $subfile);
+    my $count = 0;
+    print $outhandle "RecPlug: getting directory $dirname\n" if ($verbosity);
+
+    # find all the files in the directory
+    if (!opendir (DIR, $dirname)) {
+	print $outhandle "RecPlug: WARNING - couldn't read directory $dirname\n";
+	return undef;
+    }
+    @dir = readdir (DIR);
+    closedir (DIR);
+
+    # read XML metadata files (if supplied)
+    my $additionalmetadata = 0;      # is there extra metadata available?
+    my %extrametadata;               # maps from filespec to extra metadata keys
+    my @extrametakeys;               # keys of %extrametadata in order read
+
+    if ($read_metadata_files) {
+
+	# first read the directory "metadata" file
+	my $metadatafile = &util::filename_cat ($dirname, 'metadata');
+	if (-e $metadatafile) {
+	    print $outhandle "RecPlug: found metadata in $metadatafile\n" 
+		if ($verbosity);
+	    &read_metadata_file($metadatafile, \%extrametadata, \@extrametakeys);
+	    $additionalmetadata = 1;
+	}
+
+	# then read any files with names of the form *.metadata
+	foreach $subfile (sort @dir) {
+	    next unless ($subfile =~ /^.*\.metadata$/);
+	    $metadatafile = &util::filename_cat ($dirname, $subfile);
+	    print $outhandle "RecPlug: found metadata in $metadatafile\n" 
+		if ($verbosity);
+	    &read_metadata_file($metadatafile, \%extrametadata, \@extrametakeys);
+	    $additionalmetadata = 1;
+	}
+    }
+
+    # import each of the files in the directory
+    my $out_metadata; 
+    foreach $subfile (@dir) {
+	    
+	last if ($maxdocs != -1 && $count >= $maxdocs);
+	next if ($subfile =~ /^\.\.?$/);
+	next if ($read_metadata_files && $subfile =~ /metadata$/);
+	print "RecPlug: preparing metadata for $subfile\n" if ($verbosity > 2);
+
+	# Make a copy of $in_metadata to pass to $subfile
+	$out_metadata = {};
+	&combine_metadata_structures($out_metadata, $in_metadata);
+
+	# Next add metadata read in XML files (if it is supplied)
+	if ($additionalmetadata == 1) {
+
+	    my ($filespec, $mdref);
+	    foreach $filespec (@extrametakeys) {
+		if ($subfile =~ /$filespec/) {
+		    print $outhandle "File \"$subfile\" matches filespec \"$filespec\"\n" 
+			if ($verbosity > 2);
+		    $mdref = $extrametadata{$filespec};
+		    &combine_metadata_structures($out_metadata, $mdref);
+		}
 	    }
 	}
-	return $count;
-    }
-
-    # wasn't a directory, someone else will have to process it
-    return undef;
+	
+	# Recursively read each $subfile
+	print $outhandle "RecPlug recurring: $subfile\n" if ($verbosity > 2);
+	$count += &plugin::read ($pluginfo, $base_dir, 
+				 &util::filename_cat($file, $subfile),
+				 $out_metadata, $processor, $maxdocs);
+    }
+    return $count;
+    
+}
+
+
+
+# Read a manually-constructed metadata file and store the data
+# it contains in the $metadataerf structure.
+#
+# (metadataref is a reference to a hash whose keys are filenames
+# and whose values are metadata hash structures.)  
+
+sub read_metadata_file {
+    my ($filename, $metadataref, $metakeysref) = @_;
+    
+    my ($metadatafiletext, $metatext);
+    my ($target, $targetdataref, $default_target, $tag, $key, $value);
+
+    # Read the file
+    open(MTDT, "<$filename");
+    $metadatafiletext = join(' ', <MTDT>);
+    $metadatafiletext =~ s/\s+/ /go;
+    close MTDT;
+	
+    # set default filespec for *.metadata files
+    if ($filename =~ /\.metadata$/) {
+	$default_target = $filename;
+	$default_target =~ s/.*\///o;
+	$default_target =~ s/\.metadata$//;
+    } else {
+	$default_target = '';
+    }
+
+    # split the file into sections on "metadata" tag
+    foreach $metatext (split(/\<metadata\>/, $metadatafiletext)) {
+	# print "metadata text: $metatext\n";
+	
+	# split the metadata set into sections on each field tag
+	$target = $default_target;
+	$targetdataref = {};
+	foreach $tag (split(/</, $metatext)) {
+	    next if ($tag =~ m"^/");
+	    next if ($tag !~ m/>/);
+	    
+	    ($key, $value) = split(/>/, $tag);
+	    # print "$key -> $value\n";
+
+	    if ($key eq 'filename') {
+		$target = $value;
+	    } else {
+
+		# a metadata field can be flagged as accumulated or overridden
+		my $accumulateflag = 0;
+		my $overrideflag = 0;
+		if ($key =~ / mode=a.*/io) {
+		    $accumulateflag = 1;
+		} elsif ($key =~ / mode=o.*/io) {
+		    $overrideflag = 1;
+		}
+		$key =~ s/ mode=.*$//io;
+
+		# set the metadata value, using an array for accumulating fields
+		# and a scalar for override fields
+		if ($accumulateflag) {
+		    # the accumulate flag directs us to accumulate metadata values
+		    if (!defined $targetdataref->{$key}) {
+			# there is no existing value for this field
+			$targetdataref->{$key} = [$value];
+		    } elsif (ref ($targetdataref->{$key}) eq "ARRAY") {
+			# we already have an array of values for this field
+			my $aref = $targetdataref->{$key};
+			push @$aref, $value;
+		    } else {
+			# we have a scalar for this field - convert to array
+			$targetdataref->{$key} = [$targetdataref->{$key}, $value];
+		    }
+		} elsif ($overrideflag) {
+		    # the override flag directs us to override exising values
+		    $targetdataref->{$key} = $value;
+		} elsif (!defined $targetdataref->{$key}) {
+		    # there is no flag, and no existing value: default to override mode
+		    # In the future, I should let the user specify the default mode.
+		    $targetdataref->{$key} = $value;
+		} elsif (ref ($targetdataref->{$key}) eq "ARRAY") {
+		    # there is no flag, and we're already in accumulate mode
+		    my $aref = $targetdataref->{$key};
+		    push @$aref, $value;
+		} else {
+		    # there is no flag, and we're already in override mode
+		    $targetdataref->{$key} = $value;
+		}
+	    }
+	}
+
+	# store this metadata information in the metadata ref
+	if ($target) {
+	    push @$metakeysref, $target;
+	    $metadataref->{$target} = $targetdataref;
+	}
+    }
+}
+
+
+# Combine two metadata structures.  Given two references to metadata
+# element structures, add every field of the second ($mdref2) to the first
+# ($mdref1).  
+#
+# Afterwards $mdref1 will be updated, and $mdref2 will be unchanged.
+#
+# We have to be acreful about the way we merge metadata when one metadata
+# structure is in "override" mode and one is in "merge" mode.  In fact, we
+# use the mode from the second structure, $mdref2, because it is generally
+# defined later (lower in the directory structure) and is therefore more
+# "local" to the document concerned.
+#
+# Another issue is the use of references to pass metadata around.  If we
+# simply copy one metadata structure reference to another, then we're
+# effectively justr copyinga pointer, and changes to the new referene
+# will affect the old (copied) one also.  This also applies to ARRAY
+# references used as metadata element values (hence the "clonedata"
+# function below).
+
+sub combine_metadata_structures { 
+    my ($mdref1, $mdref2) = @_;
+    my ($key, $value1, $value2);
+
+    foreach $key (keys %$mdref2) {
+
+	$value1 = $mdref1->{$key};
+	$value2 = $mdref2->{$key};
+	
+	# If there is no existing value for this metadata field in 
+	# $mdref1, so we simply copy the value from $mdref2 over.
+	if (!defined $value1) {
+	    $mdref1->{$key} = &clonedata($value2);
+	} 
+	# Otherwise we have to add the new values to the existing ones.
+	# If the second structure is accumulated, then acculate all the
+	# values into the first structure
+	elsif ((ref $value2) eq "ARRAY") {
+	    # If the first metadata element is a scalar we have to 
+	    # convert it into an array before we add anything more.
+	    if ((ref $value1) ne 'ARRAY') {
+		$mdref1->{$key} = [$value1];
+		$value1 = $mdref1->{$key};
+	    }
+	    # Now add the value(s) from the second array to the first
+	    $value2 = &clonedata($value2);
+	    push @$value1, @$value2;
+	} 
+	# Finally, If the second structure is not an array erference, we
+	# know it is in override mode, so override the first structure.
+	else {
+	    $mdref1->{$key} = &clonedata($value2);
+	}
+    }
+}
+
+
+# Make a "cloned" copy of a metadata value.  
+# This is trivial for a simple scalar value,
+# but not for an array reference.
+
+sub clonedata {
+    my ($value) = @_;
+    my $result;
+
+    if ((ref $value) eq 'ARRAY') {
+	$result = [];
+	foreach my $item (@$value) {
+	    push @$result, $item;
+	}
+    } else {
+	$result = $value;
+    }
+    return $result;
 }
 
 
 1;
+
+
+
