###########################################################################
#
# RecPlug.pm --
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

# 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;

use BasPlug;
use plugin;
use util;


BEGIN {
    @ISA = ('BasPlug');
}

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 = 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;
}

# return 1 if this class might recurse using $pluginfo
sub is_recursive {
    my $self = shift (@_);

    return 1;
}

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, $in_metadata, $processor, $maxdocs) = @_;

    my $outhandle = $self->{'outhandle'};
    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);
    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 0;
    }

    # check to see we haven't got a cyclic path...
    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 0;
    }

    # check to see we haven't got a cyclic path...
    if ($dirname =~ m%.*?import/(.+?)/import/\1.*%) {
	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);
		}
	    }
	}
	
	# 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;



