Changeset 2228

Timestamp:

2001-03-27T14:49:14+12:00 (23 years ago)

Author:

paynter

Message:

The -use_metadata_files option tells RecPlug to read any metadata XML files
it finds in the import directories and to add their metadata to the files
they describe. A few other changes: metadata is passed recursively down
the directory tree, collect.cfg-line arguments are parsed correctly, and
block expressions are inherited from BasPlug and blocked appropriately
(default block_exp: CVS).

File:

• trunk/gsdl/perllib/plugins/RecPlug.pm (modified) (4 diffs)

trunk/gsdl/perllib/plugins/RecPlug.pm

@@ -24 +24 @@
 ###########################################################################
 
-# 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 +97 @@
 }
 
+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 +131 @@
 }
 
+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 +172 @@
     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;
+
+
+