Changeset 12844

Timestamp:

2006-09-25T14:17:10+12:00 (18 years ago)

Author:

mdewsnip

Message:

Incremental building and dynamic GDBM updating code, many thanks to John Rowe and John Thompson at DL Consulting Ltd.

Location:

trunk/gsdl

Files:

• bin/script/buildcol.pl (modified) (11 diffs)
• bin/script/getdocument.pl (added)
• bin/script/lucene_passes.pl (modified) (7 diffs)
• bin/script/removedocument.pl (added)
• bin/script/set_metadata.pl (added)
• perllib/ClassifyTreeModel.pm (added)
• perllib/ClassifyTreeNode.pm (added)
• perllib/ClassifyTreePath.pm (added)
• perllib/GDBMUtils.pm (added)
• perllib/IncrementalBuildUtils.pm (added)
• perllib/IncrementalDocument.pm (added)
• perllib/basebuilder.pm (modified) (3 diffs)
• perllib/basebuildproc.pm (modified) (7 diffs)
• perllib/classify.pm (modified) (4 diffs)
• perllib/incremental_build.pm (added)
• perllib/lucenebuilder.pm (modified) (17 diffs)
• perllib/lucenebuildproc.pm (modified) (11 diffs)
• perllib/plugins/GAPlug.pm (modified) (5 diffs)
• perllib/plugins/XMLPlug.pm (modified) (1 diff)
• src/gdbmget (added)
• src/gdbmget/Makefile.in (added)
• src/gdbmget/config.h.in (added)
• src/gdbmget/configtest.pl (added)
• src/gdbmget/configure (added)
• src/gdbmget/gdbmget.cpp (added)
• src/gdbmget/install-sh (added)
• src/gdbmget/win32.mak (added)
• src/gdbmset (added)
• src/gdbmset/Makefile.in (added)
• src/gdbmset/config.h.in (added)
• src/gdbmset/configtest.pl (added)
• src/gdbmset/configure (added)
• src/gdbmset/gdbmset.cpp (added)
• src/gdbmset/install-sh (added)
• src/gdbmset/win32.mak (added)

trunk/gsdl/bin/script/buildcol.pl

@@ -1 +1 @@
 #!/usr/bin/perl -w
 
-###########################################################################
-#
-# buildcol.pl -- This program will build a particular collection
+## @file buildcol.pl
+# This program will build a particular collection.
 # 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
@@ -24 +21 @@
 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #
-###########################################################################
-
-# 11/04/03 Added usage datastructure - John Thompson
-
+# @note 11/04/03 Added usage datastructure - John Thompson
+#
+# @author New Zealand Digital Library Project unless otherwise stated
+# @copy 1999 New Zealand Digital Library Project
+#
 package buildcol;
 
@@ -194 +192 @@
     'type' => "flag",
     'reqd' => "no",
-    'hiddengli' => "yes" } ];
+    'hiddengli' => "yes" },
+      { 'name' => "incremental",
+    'desc' => "{buildcol.incremental}",
+    'type' => "flag",
+    'reqd' => "no",
+        'modegli' => "3" } ];
 
 my $options = { 'name' => "buildcol.pl",
@@ -206 +209 @@
 my $out;
 
-sub gsprintf
+## @method gsprintf()
+#  Print a string to the screen after looking it up from a locale dependant
+#  strings file. This function is losely based on the idea of resource
+#  bundles as used in Java.
+#
+#  @param  $error The STDERR stream.
+#  @param  $text The string containing GS keys that should be replaced with
+#                their locale dependant equivilents.
+#  @param  $out The output stream.
+#  @return The locale-based string to output.
+#
+sub gsprintf()
 {
     return &gsprintf::gsprintf(@_);
 }
-
-
+## gsprintf() ##
 
 &main();
 
+## @method main()
+#
+#  [Parses up and validates the arguments to the build process before creating
+#  the appropriate build process to do the actual work - John]
+#
+#  @note Added true incremental support - John Thompson, DL Consulting Ltd.
+#  @note There were several bugs regarding using directories other than 
+#        "import" or "archives" during import and build quashed. - John 
+#        Thompson, DL Consulting Ltd.
+#
+#  @param  $incremental If true indicates this build should not regenerate all
+#                       the index and metadata files, and should instead just
+#                       append the information found in the archives directory
+#                       to the existing files. If this requires some complex
+#                       work so as to correctly insert into a classifier so be
+#                       it. Of course none of this is done here - instead the
+#                       incremental argument is passed to the document
+#                       processor.
+#
 sub main
 {
@@ -222 +254 @@
     $create_images, $collectdir, $build, $type, $textindex,
     $no_strip_html, $no_text, $faillog, $gli, $index, $language,
-    $sections_index_document_metadata, $maxnumeric);
+    $sections_index_document_metadata, $maxnumeric, $incremental);
 
     my $xml = 0;
@@ -296 +328 @@
 
     unshift (@INC, "$ENV{'GSDLCOLLECTDIR'}/perllib");
+    # Don't know why this didn't already happen, but now collection specific
+    # classify and plugins directory also added to include path
+    unshift (@INC, "$ENV{'GSDLCOLLECTDIR'}/perllib/classify");
+    unshift (@INC, "$ENV{'GSDLCOLLECTDIR'}/perllib/plugins");
 
     # read the configuration file
@@ -398 +434 @@
     $gli = 0 unless defined $gli;
 
+    # New argument to track whether build is incremental
+    $incremental = 0 unless defined $incremental;
+
     print STDERR "<Build>\n" if $gli;
 
@@ -421 +460 @@
     # were supplied, turn all \ into / and remove trailing /
 
-    my ($realarchivedir, $realbuilddir);  
-    $archivedir = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "archives") if $archivedir eq "";
+    my ($realarchivedir, $realbuilddir);
+    # Modified so that the archivedir, if provided as an argument, is made
+    # absolute if it isn't already
+    if ($archivedir eq "")
+      {
+        $archivedir = &util::filename_cat ($ENV{'GSDLCOLLECTDIR'}, "archives");
+      }
+    else
+      {
+        $archivedir = &make_absolute($ENV{'GSDLCOLLECTDIR'}, $archivedir);
+      }
+    # End Mod
     $archivedir =~ s/[\\\/]+/\//g;
     $archivedir =~ s/\/$//;
@@ -476 +525 @@
      "\$realarchivedir, \$realbuilddir, \$verbosity, " .
      "\$maxdocs, \$debug, \$keepold, \$remove_empty_classifications, " .
-     "\$out, \$no_text, \$faillog, \$gli)");
+     "\$out, \$no_text, \$faillog, \$gli, \$incremental)");
     die "$@" if $@;
 
@@ -519 +568 @@
     print STDERR "</Build>\n" if $gli;
 }
-
+## main() ##
+
+## @method create_images()
+#
+#  [Used to create default cover images... from what I'm not quite sure - John]
+#
 sub create_images {
     my ($collection_name) = @_;
@@ -571 +625 @@
     close CFGFILE;
 }
+## create_images() ##
+
+## @method make_absolute()
+#
+#  Ensure the given file path is absolute in respect to the given base path.
+#
+#  @param  $base_dir A string denoting the base path the given dir must be
+#                    abolsute to.
+#  @param  $dir The directory to be made absolute as a string. Note that the
+#               dir may already be absolute, in which case it will remain
+#               unchanged.
+#  @return The now absolute form of the directory as a string.
+#
+#  @author John Thompson, DL Consulting Ltd.
+#  @copy 2006 DL Consulting Ltd.
+#
+sub make_absolute()
+  {
+    my ($base_dir, $dir) = @_;
+    $dir = $base_dir . "/$dir" if ($dir =~ m#^[^/]#);
+    $dir =~ s|^/tmp_mnt||;
+    1 while($dir =~ s|/[^/]*/\.\./|/|g);
+    $dir =~ s|/[.][.]?/|/|g;
+    $dir =~ tr|/|/|s;
+    return $dir;
+  }
+## make_absolute() ##

trunk/gsdl/bin/script/lucene_passes.pl

@@ -5 +5 @@
 # lucene_passes.pl -- perl wrapper, akin to mgpp_passes, for Lucene
 # A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
+# from the New Zealand Digital Library Project at the
 # University of Waikato, New Zealand.
 #
@@ -39 +39 @@
 use ghtml;
 
-
 sub open_java_lucene
 {
-    my ($doc_tag_level,$full_builddir,$indexdir,$create,$verbosity) = @_;
-
-    my $bin_java = &util::filename_cat($ENV{'GSDLHOME'},"bin","java");
-    my $classpath = &util::filename_cat($bin_java,"LuceneWrap.jar");
-
-    my $java_lucene = "java -classpath \"$classpath\" org.nzdl.gsdl.LuceneWrap.GS2LuceneIndexer";
-    my $cmd_options = "$create -verbosity $verbosity";
-    my $java_cmd = "$java_lucene $cmd_options $doc_tag_level \"$full_builddir\" $indexdir";
-
-    if (!open (PIPEOUT, "| $java_cmd")) {
-    die "$PROGNAME - couldn't run $java_cmd\n";
-    }
+  my ($doc_tag_level,$full_builddir,$indexdir,$create,$verbosity) = @_;
+
+  my $bin_java = &util::filename_cat($ENV{'GSDLHOME'},"bin","java");
+  my $classpath = &util::filename_cat($bin_java,"LuceneWrap.jar");
+
+  my $java_lucene = "java -classpath \"$classpath\" org.nzdl.gsdl.LuceneWrap.GS2LuceneIndexer";
+  my $cmd_options = "$create -verbosity $verbosity";
+  my $java_cmd = "$java_lucene $cmd_options $doc_tag_level \"$full_builddir\" $indexdir";
+
+  open (PIPEOUT, "| $java_cmd") or die "$PROGNAME - couldn't run $java_cmd\n";
 }
 
 sub close_java_lucene
 {
-    close(PIPEOUT);
+  close(PIPEOUT);
 }
 
@@ -66 +63 @@
     $dir_sep = &util::get_os_dirsep();
 
-    my $full_output_filename 
-    = &util::filename_cat($full_textdir,$output_filename);
+    my $full_output_filename = &util::filename_cat($full_textdir,$output_filename);
     my ($full_output_dir) = ($full_output_filename =~ m/^(.*$dir_sep)/x);
     &util::mk_all_dir($full_output_dir);
-    
-    open(DOCOUT,">$full_output_filename") 
+
+    open(DOCOUT,">$full_output_filename")
     || die "Unable to open $full_output_filename";
 
@@ -78 +74 @@
 
     my @secs =  ($doc_xml =~ m/<Sec\s+gs2:id="\d+"\s*>.*?<\/Sec>/sg);
-
-
-# Currently not used, but consult with DB before removing
-#    foreach my $sec (@secs) {
-#   my ($docnum,$sec_text) = ($sec =~ m/<Sec\s+gs2:id="(\d+)"\s*>(.*?)<\/Sec>/s);
-#   my $docnum_filename 
-#       = &util::filename_cat($full_textdir,"$docnum.xml");
-
-#    
-#   open(SECOUT,">$docnum_filename") 
-#       || die "Unable to open $docnum_filename";
-
-#   print SECOUT &ghtml::unescape_html($sec_text);
-#   close(SECOUT);
-#    }
-
 }
 
@@ -100 +80 @@
     my ($full_textdir,$output_filename) = @_;
 
-    my $full_output_filename 
+    my $full_output_filename
     = &util::filename_cat($full_textdir,$output_filename);
 
@@ -106 +86 @@
 }
 
+# This appears to be the callback that gets the xml stream during the
+# build process, so I need to intercept it here and call my XML RPC
+# to insert into the Lucene database.
 sub monitor_xml_stream
 {
@@ -150 +133 @@
 }
 
+
+# /** This checks the arguments on the command line, filters the
+#  *  unknown command line arguments and then calls the open_java_lucene
+#  *  function to begin processing. Most of the arguments are passed on
+#  *  the command line of the java wrapper.
+#  *
+#  *  Do not set -create and -remove at the same time, although -create is
+#  *  required for -remove, -remove will set it it's self, if you set -create
+#  *  after -remove the create will be ignored.
+#  *
+#  *  @version 2.0 Added support for removing documents from the index by John Rowe
+#  *
+#  *  @author John Rowe, DL Consulting
+#  */
 sub main
 {
-    my (@argv) = @_;
-    my $argc = scalar(@argv);
-
-    my $create = "";
-    my $verbosity = 1;
-
-    my @filtered_argv = ();
-
-    my $i = 0;
-    while ($i<$argc) {
-    if ($argv[$i] =~ m/^-(.*)$/) {
-
-        my $option = $1;
-
-        # -create causes build to be incremental
-        if ($option eq ("create")) {
-        $create = "-create";
-        }
-
-        # -verbosity num
-        elsif ($option eq "verbosity") {
-        $i++;
-        if ($i<$argc) {
-            $verbosity = $argv[$i];
-        }
-        }
-        else {
-        print STDERR "Unrecognised minus option: -$option\n";
-        }
-    }
-    else {
-        push(@filtered_argv,$argv[$i]);
-    }
-    $i++;
+  my (@argv) = @_;
+  my $argc = scalar(@argv);
+
+  my $create = "";
+  my $verbosity = 1;
+
+  my @filtered_argv = ();
+
+  my $i = 0;
+  while ($i<$argc) {
+    if ($argv[$i] =~ m/^\-(.*)$/) {
+
+      my $option = $1;
+
+      # -create causes build to be incremental
+      if ($option eq ("create")) {
+        print STDERR "\n\n-create set\n";
+        $create = "-create";
+      }
+      # In a blinding flash of unintuitiveness -remove causes
+      # -create to be set (we don't want to remove the old indexes)
+      elsif($option eq "remove")
+      {
+        # Look at the next arg for the oid and if that doesn't exist then
+        $i++;
+        if(!defined $argv[$i])
+        {
+          print STDERR "Remove was specified but the OID was not specified";
+          die "\n\nCannot continue";
+        }
+        $removeoid = $argv[$i];
+        print STDERR "\n\nWe're removing the document with id: '$removeoid'\n";
+
+        # Now, to make sure this gets through to the Java executable
+        $create = "-create -remove '$removeoid'";
+      }
+
+      # -verbosity num
+      elsif ($option eq "verbosity") {
+        $i++;
+        if ($i<$argc) {
+          $verbosity = $argv[$i];
+        }
+      }
+      else {
+        print STDERR "Unrecognised minus option: -$option\n";
+      }
     }
-
-    my $filtered_argc = scalar(@filtered_argv);
-
-    if ($filtered_argc < 4) {
-    print STDERR "Usage: $PROGNAME [-create|-verbosity num] \"text\"|\"index\" doc-tag-level build-dir index-name\n";
-    exit 1;
+    else {
+        push(@filtered_argv,$argv[$i]);
     }
-
-    my $mode = $filtered_argv[0];
-    my $doc_tag_level = $filtered_argv[1];
-    my $full_builddir = $filtered_argv[2];
-    my $indexdir      = $filtered_argv[3];
+    $i++;
+  }
+
+  my $filtered_argc = scalar(@filtered_argv);
+
+  if ($filtered_argc < 4) {
+    print STDERR "Usage: $PROGNAME [-create|-verbosity num] \"text\"|\"index\" doc-tag-level build-dir index-name\n";
+    exit 1;
+  }
+
+  my $mode = $filtered_argv[0];
+  my $doc_tag_level = $filtered_argv[1];
+  my $full_builddir = $filtered_argv[2];
+  my $indexdir      = $filtered_argv[3];
 ###    print STDERR "**** ARGS = ", join(" ", @argv), "\n";
 
-    my $full_textdir = &util::filename_cat($full_builddir,"text");
-
-    if ($mode eq "index") {
-    # don't need the lucene stuff if we are just storing the docs
-    open_java_lucene($doc_tag_level,$full_builddir,$indexdir,$create,$verbosity);
-    }
-    monitor_xml_stream($mode, $full_textdir);
-    if ($mode eq "index") {
-    close_java_lucene();
-    }
+  my $full_textdir = &util::filename_cat($full_builddir,"text");
+
+  if ($mode eq "index") {
+# don't need the lucene stuff if we are just storing the docs
+    open_java_lucene($doc_tag_level,$full_builddir,$indexdir,$create,$verbosity);
+  }
+  print STDERR "Monitoring for input!\n";
+  monitor_xml_stream($mode, $full_textdir);
+  if ($mode eq "index") {
+    close_java_lucene();
+  }
 }
 

trunk/gsdl/perllib/basebuilder.pm

@@ -287 +287 @@
     my $outhandle = $self->{'outhandle'};
 
+    print STDERR "BuildDir: $self->{'build_dir'}\n";
+
     my $textdir = &util::filename_cat($self->{'build_dir'}, "text");
     my $assocdir = &util::filename_cat($self->{'build_dir'}, "assoc");
@@ -361 +363 @@
                      $self->{'gli'});
 
+    # Output classifier reverse lookup, used in incremental deletion
+    #&classify::print_reverse_lookup($handle);
 
     #output doclist
@@ -401 +405 @@
     # store the number of documents and number of bytes
     $build_cfg->{'numdocs'} = $self->{'buildproc'}->get_num_docs();
+    $build_cfg->{'numsections'} = $self->{'buildproc'}->get_num_sections();
     $build_cfg->{'numbytes'} = $self->{'buildproc'}->get_num_bytes();
-
     
     # store the mapping between the index names and the directory names

trunk/gsdl/perllib/basebuildproc.pm

@@ -40 +40 @@
 }
 
-sub new {
-    my ($class, $collection, $source_dir, $build_dir, $keepold,
-    $verbosity, $outhandle) = @_; 
+sub new()
+  {
+    my ($class, $collection, $source_dir, $build_dir, $keepold, $verbosity, $outhandle) = @_;
     my $self = new docproc ();
 
@@ -71 +71 @@
     # For incremental building need to seed num_docs etc from values
     # stored in build.cfg (if present)
-
+      print STDERR "Keepold!\n";
     $buildconfigfile = &util::filename_cat($build_dir, "build.cfg");
-
+      print STDERR "Build cfg: $buildconfigfile\n";
     if (-e $buildconfigfile) {
         $found_num_data = 1;
@@ -81 +81 @@
         $buildconfigfile = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, 
                            "index", "build.cfg");
+            print STDERR "Index cfg: $buildconfigfile\n";
         if (-e $buildconfigfile) {
         $found_num_data = 1;
@@ -86 +87 @@
     }
 
-    } 
-
-    if ($found_num_data) {
+    }
+    #else
+    #  {
+    #    print STDERR "Removeold!\n";
+    #  }
+
+    if ($found_num_data)
+      {
+        #print STDERR "Found_Num_Data!\n";
     my $buildcfg = &colcfg::read_build_cfg($buildconfigfile);
-    
     $self->{'starting_num_docs'}     = $buildcfg->{'numdocs'};
+        #print STDERR "- num_docs:     $self->{'starting_num_docs'}\n";
     $self->{'starting_num_sections'} = $buildcfg->{'numsections'};
+        #print STDERR "- num_sections: $self->{'starting_num_sections'}\n";
     $self->{'starting_num_bytes'}    = $buildcfg->{'numbytes'};
-    }
-    else {
-    $self->{'starting_num_docs'}     = 0;
+        #print STDERR "- num_bytes:    $self->{'starting_num_bytes'}\n";
+    }
+    else
+      {
+        #print STDERR "NOT Found_Num_Data!\n";
+        $self->{'starting_num_docs'}     = 0;
     $self->{'starting_num_sections'} = 0;
     $self->{'starting_num_bytes'}    = 0;
-    }
+      }
 
     $self->{'output_handle'} = "STDOUT";
@@ -428 +439 @@
         # output the matching document number
         print $handle "<docnum>$self->{'num_docs'}\n";
+            
     } else {
         # output a list of children
@@ -612 +624 @@
 }
 
-sub assoc_files {
+sub assoc_files() {
     my $self = shift (@_);
     my ($doc_obj, $archivedir) = @_;
@@ -618 +630 @@
     
     foreach my $assoc_file (@{$doc_obj->get_assoc_files()}) {
+      #rint STDERR "Processing associated file - copy " . $assoc_file->[0] . " to " . $assoc_file->[1] . "\n";
     # if assoc file starts with a slash, we put it relative to the assoc
     # dir, otherwise it is relative to the HASH... directory
     if ($assoc_file->[1] =~ m@^[/\\]@) {
-        $afile = &util::filename_cat($self->{'assocdir'},$assoc_file->[1]);
+        $afile = &util::filename_cat($self->{'assocdir'}, $assoc_file->[1]);
     } else {
         $afile = &util::filename_cat($self->{'assocdir'}, $archivedir, $assoc_file->[1]);

trunk/gsdl/perllib/classify.pm

@@ -43 +43 @@
 
 $next_classify_num = 1;
+$oid_to_clids = {};
+
 sub load_classifier_for_info {
     my ($classifier) = shift @_;
@@ -302 +304 @@
     $tempinfo->{'classifyOID'} = "CL$next_classify_num" unless defined($tempinfo->{'classifyOID'});
     $next_classify_num++;
+
+        print STDERR "*** outputting information for classifier: $tempinfo->{'classifyOID'}\n";
+
     push (@{$classifyinfo->{'contains'}}, $tempinfo);
     }
@@ -357 +362 @@
         $contains_text .= $tempinfo->{'classifyOID'};
         }
+
+            # Extra code for incremental building.
+            # We need to store a listing of the classifiers each DOI is in
+            my $clids = [];
+            #rint STDERR "==1. Recording reverse lookup for " . $tempinfo->{'classifyOID'} . "==\n";
+            if(defined($oid_to_clids->{$tempinfo->{'classifyOID'}})) {
+              #rint STDERR "Found existing array!\n";
+              $clids = $oid_to_clids->{$tempinfo->{'classifyOID'}};
+            }
+            #rint STDERR "Appended $OID to \"" . join(";", @{$clids}) . "\"\n";
+            push(@{$clids}, $OID);
+            $oid_to_clids->{$tempinfo->{'classifyOID'}} = $clids;
+            #rint STDERR "Result: \"" . join(";", @{$clids}) . "\"\n";
+            
         &print_classify_info ($handle, $tempinfo, $tempinfo->{'classifyOID'},
                   $remove_empty_classifications);
     } elsif (defined ($tempinfo->{'OID'})) {
         $contains_text .= $tempinfo->{'OID'};
-        $mdoffset_text .= $tempinfo->{'offset'}
-        if (defined ($tempinfo->{'offset'}))
-        # note: we don't want to print the contents of the books
+        $mdoffset_text .= $tempinfo->{'offset'} if (defined ($tempinfo->{'offset'}));
+
+            
+              # note: we don't want to print the contents of the books
+              # Extra code for incremental building.
+              # We need to store a listing of the classifiers each DOI is in
+              my $clids = [];
+              #rint STDERR "==2. Recording reverse lookup for " . $tempinfo->{'OID'} . "==\n";
+              if(defined($oid_to_clids->{$tempinfo->{'OID'}})) {
+                #rint STDERR "Found existing array!\n";
+                $clids = $oid_to_clids->{$tempinfo->{'OID'}};
+              }
+              #rint STDERR "Appended $OID to \"" . join(";", @{$clids}) . "\"\n";
+              push(@{$clids}, $OID);
+              $oid_to_clids->{$tempinfo->{'OID'}} = $clids;
+              #rint STDERR "Result: \"" . join(";", @{$clids}) . "\"\n";
+
+
         } else {
         
@@ -373 +407 @@
             $contains_text .= "\".$next_subOID"; 
         }
+
+                # Extra code for incremental building.
+                # We need to store a listing of the classifiers each DOI is in
+                my $clids = [];
+                #rint STDERR "==3. Recording reverse lookup for $OID.$next_subOID==\n";
+                if(defined($oid_to_clids->{$OID . "." . $next_subOID})) {
+                  #rint STDERR "Found existing array!\n";
+                  $clids = $oid_to_clids->{$OID . "." . $next_subOID};
+                }
+                #rint STDERR "Appended $OID to \"" . join(";", @{$clids}) . "\"\n";
+                push(@{$clids}, $OID);
+                $oid_to_clids->{$OID . "." . $next_subOID} = $clids;
+                #rint STDERR "Result: \"" . join(";", @{$clids}) . "\"\n";
         
         &print_classify_info ($handle, $tempinfo, "$OID.$next_subOID",

trunk/gsdl/perllib/lucenebuilder.pm

@@ -3 +3 @@
 # lucenebuilder.pm -- perl wrapper for building index with Lucene
 # A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
+# from the New Zealand Digital Library Project at the
 # University of Waikato, New Zealand.
 #
@@ -24 +24 @@
 ###########################################################################
 
+###########################################################################
+# /*
+#  *  @version 1.0 ?
+#  *  @version 2.0 Incremental building assistance added, including
+#  *               remove_document_from_database which implements the granddad's
+#  *               empty function to call the lucene_passes.pl and full_lucene_passes_exe
+#  *               so there is one place in the code that works out where the
+#  *               perl script is. John Rowe
+#  *
+#  *  @author John Rowe, DL Consulting Ltd.
+#  */
+###########################################################################
+
 package lucenebuilder;
 
 # Use same basic XML structure setup by mgppbuilder/mgppbuildproc
 
-use mgppbuilder; 
+use mgppbuilder;
+
+use IncrementalBuildUtils;
 
 sub BEGIN {
@@ -34 +49 @@
 }
 
-
+# /**
+#  *  @author  John Thompson, DL Consulting Ltd.
+#  */
 sub new {
     my $class = shift(@_);
-    my ($collection, $source_dir, $build_dir, $verbosity, 
-    $maxdocs, $debug, $keepold, $allclassifications, 
-    $outhandle, $no_text, $gli) = @_;
+    my ($collection, $source_dir, $build_dir, $verbosity, $maxdocs, $debug, $keepold, $allclassifications, $outhandle, $no_text, $faillog, $gli, $incremental) = @_;
 
     my $self = new mgppbuilder (@_);
@@ -46 +61 @@
     $self->{'buildtype'} = "lucene";
 
+    # Do we need to put exe on the end?
+    my $exe = &util::get_os_exe ();
+    my $scriptdir = "$ENV{'GSDLHOME'}/bin/script";
+
+    # So where is lucene_passes.pl anyway?
+    my $lucene_passes_script = &util::filename_cat($scriptdir, "lucene_passes.pl");
+
+    # So tack perl on the beginning to ensure execution
+    $self->{'full_lucene_passes'} = "$lucene_passes_script";
+    if ($exe eq ".exe")
+    {
+      $self->{'full_lucene_passes_exe'} = "perl$exe \"$lucene_passes_script\"";
+    }
+    else
+    {
+      $self->{'full_lucene_passes_exe'} = "perl -S \"$lucene_passes_script\"";
+    }
+
+    # We must also record whether we have been asked to do just an incremental
+    # build (which makes no difference to the Lucene indexing bit, just the
+    # building of the classifiers in the GDBM).
+    $self->{'incremental'} = $incremental;
+
     return $self;
 }
+# /** new() **/
 
 sub default_buildproc {
@@ -56 +95 @@
 
 # this writes a nice version of the text docs
-sub compress_text {
-
+sub compress_text
+  {
     my $self = shift (@_);
-    
     # we don't do anything if we don't want compressed text
     return if $self->{'no_text'};
@@ -72 +110 @@
 
     my $osextra = "";
-    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-    $text_dir =~ s@/@\\@g;
-    } else {
-    if ($outhandle ne "STDERR") {
-        # so lucene_passes doesn't print to stderr if we redirect output
-        $osextra .= " 2>/dev/null";
-    }
-    }
-    
+    if ($ENV{'GSDLOS'} =~ /^windows$/i)
+      {
+    $text_dir =~ s@/@\\@g;
+      }
+    else
+      {
+    if ($outhandle ne "STDERR")
+          {
+        # so lucene_passes doesn't print to stderr if we redirect output
+        $osextra .= " 2>/dev/null";
+          }
+      }
 
     # get any os specific stuff
     my $scriptdir = "$ENV{'GSDLHOME'}/bin/script";
 
-    my $lucene_passes_exe = &util::filename_cat($scriptdir, "lucene_passes.pl");
-    my $full_lucene_passes_exe = "\"$lucene_passes_exe\"";
-    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-    $full_lucene_passes_exe = "perl.exe -S \"$lucene_passes_exe\"";
-    }
+    # Find the perl script to call to run lucene
+    my $full_lucene_passes = $self->{'full_lucene_passes'};
+    my $full_lucene_passes_exe = $self->{'full_lucene_passes_exe'};
+
     my $lucene_passes_sections = "Doc";
 
     my ($handle);
 
-    if ($self->{'debug'}) {
-    $handle = STDOUT;
-    } else {
-    if (!-e "$lucene_passes_exe" || 
-        !open (PIPEOUT, "| $full_lucene_passes_exe text $lucene_passes_sections \"$build_dir\" \"dummy\"   $osextra")) {
-        print STDERR "<FatalError name='NoRunLucenePasses'/>\n</Stage>\n" if $self->{'gli'};
-        die "lucenebuilder::build_index - couldn't run $lucene_passes_exe\n";
-    }
-    $handle = lucenebuilder::PIPEOUT;
-    }
+    if ($self->{'debug'})
+      {
+    $handle = STDOUT;
+      }
+    else
+      {
+        print STDERR "Full Path:     $full_lucene_passes\n";
+        print STDERR "Executable:    $full_lucene_passes_exe\n";
+        print STDERR "Sections:      $lucene_passes_sections\n";
+        print STDERR "Build Dir:     $build_dir\n";
+        print STDERR "Cmd:           $full_lucene_passes_exe text $lucene_passes_sections \"$build_dir\" \"dummy\"   $osextra\n";
+    if (!-e "$full_lucene_passes" ||
+        !open (PIPEOUT, "| $full_lucene_passes_exe text $lucene_passes_sections \"$build_dir\" \"dummy\"   $osextra"))
+          {
+        print STDERR "<FatalError name='NoRunLucenePasses'/>\n</Stage>\n" if $self->{'gli'};
+        die "lucenebuilder::build_index - couldn't run $full_lucene_passes_exe\n";
+          }
+    $handle = lucenebuilder::PIPEOUT;
+      }
     my $levels = $self->{'levels'};
     my $gdbm_level = "document";
-    if ($levels->{'section'}) {
-    $gdbm_level = "section";
-    }
+    if ($levels->{'section'})
+      {
+    $gdbm_level = "section";
+      }
 
     undef $levels->{'paragraph'}; # get rid of para if we had it.
@@ -117 +167 @@
     $self->{'buildproc'}->set_indexing_text (0);
     $self->{'buildproc'}->set_indexfieldmap ($self->{'indexfieldmap'});
-    $self->{'buildproc'}->set_levels ($levels);                       
-    $self->{'buildproc'}->set_gdbm_level ($gdbm_level);                       
+    $self->{'buildproc'}->set_levels ($levels);
+    $self->{'buildproc'}->set_gdbm_level ($gdbm_level);
     $self->{'buildproc'}->reset();
-    &plugin::begin($self->{'pluginfo'}, $self->{'source_dir'}, 
-           $self->{'buildproc'}, $self->{'maxdocs'});    
-    &plugin::read ($self->{'pluginfo'}, $self->{'source_dir'}, 
-           "", {}, $self->{'buildproc'}, $self->{'maxdocs'}, 0, $self->{'gli'});
+    &plugin::begin($self->{'pluginfo'}, $self->{'source_dir'},
+           $self->{'buildproc'}, $self->{'maxdocs'});
+    &plugin::read ($self->{'pluginfo'}, $self->{'source_dir'},
+           "", {}, $self->{'buildproc'}, $self->{'maxdocs'}, 0, $self->{'gli'});
     &plugin::end($self->{'pluginfo'});
     close ($handle) unless $self->{'debug'};
@@ -130 +180 @@
 
     print STDERR "</Stage>\n" if $self->{'gli'};
-
-}
+  }
 
 sub build_indexes {
@@ -140 +189 @@
     my $indexes = [];
     if (defined $indexname && $indexname =~ /\w/) {
-    push @$indexes, $indexname;
+    push @$indexes, $indexname;
     } else {
-    $indexes = $self->{'collect_cfg'}->{'indexes'};
-    }
-
-    # create the mapping between the index descriptions 
+    $indexes = $self->{'collect_cfg'}->{'indexes'};
+    }
+
+    # create the mapping between the index descriptions
     # and their directory names (includes subcolls and langs)
     $self->{'index_mapping'} = $self->create_index_mapping ($indexes);
@@ -151 +200 @@
     # build each of the indexes
     foreach $index (@$indexes) {
-    if ($self->want_built($index)) {
-
-        my $idx = $self->{'index_mapping'}->{$index};
-        foreach my $level (keys %{$self->{'levels'}}) {
-        next if $level =~ /paragraph/; # we don't do para indexing
-        my ($pindex) = $level =~ /^(.)/;
-        # should probably check that new name with level 
-        # is unique ... but currently (with doc sec and para)
-        # each has unique first letter.
-        $self->{'index_mapping'}->{$index} = $pindex.$idx;
-
-        my $llevel = $mgppbuilder::level_map{$level};
-        print $outhandle "\n*** building index $index at level $llevel in subdirectory " . 
-            "$self->{'index_mapping'}->{$index}\n" if ($self->{'verbosity'} >= 1);
-        print STDERR "<Stage name='Index' source='$index' level=$llevel>\n" if $self->{'gli'};
-
-        $self->build_index($index,$llevel);
-        }
-        $self->{'index_mapping'}->{$index} = $idx;
-
-    } else {
-        print $outhandle "\n*** ignoring index $index\n" if ($self->{'verbosity'} >= 1);
-    }
+    if ($self->want_built($index)) {
+
+        my $idx = $self->{'index_mapping'}->{$index};
+        foreach my $level (keys %{$self->{'levels'}}) {
+        next if $level =~ /paragraph/; # we don't do para indexing
+        my ($pindex) = $level =~ /^(.)/;
+        # should probably check that new name with level
+        # is unique ... but currently (with doc sec and para)
+        # each has unique first letter.
+        $self->{'index_mapping'}->{$index} = $pindex.$idx;
+
+        my $llevel = $mgppbuilder::level_map{$level};
+        print $outhandle "\n*** building index $index at level $llevel in subdirectory " .
+            "$self->{'index_mapping'}->{$index}\n" if ($self->{'verbosity'} >= 1);
+        print STDERR "<Stage name='Index' source='$index' level=$llevel>\n" if $self->{'gli'};
+
+        $self->build_index($index,$llevel);
+        }
+        $self->{'index_mapping'}->{$index} = $idx;
+
+    } else {
+        print $outhandle "\n*** ignoring index $index\n" if ($self->{'verbosity'} >= 1);
+    }
     }
 
@@ -179 +228 @@
     $self->make_final_field_list();
 }
+
+# /** Lucene specific document removal function. This works by calling lucene_passes.pl with
+#  *  -remove and the document id on the command line.
+#  *
+#  *  @param oid is the document identifier to be removed.
+#  *
+#  *  @author John Rowe, DL Consulting Ltd.
+#  */
+sub remove_document_from_database
+  {
+    my ($self, $oid) = @_;
+    # Find the perl script to call to run lucene
+    my $full_lucene_passes_exe = $self->{'full_lucene_passes_exe'};
+    # Call lucene_passes.pl with -remove and the document ID on the command line
+    `$full_lucene_passes_exe -remove "$oid"`;
+  }
+# /** remove_document_from_database **/
 
 sub build_index {
@@ -194 +260 @@
     my $scriptdir = "$ENV{'GSDLHOME'}/bin/script";
 
-    my $exe = &util::get_os_exe ();
-    my $lucene_passes_exe = &util::filename_cat($scriptdir, "lucene_passes.pl");
-    my $full_lucene_passes_exe = "\"$lucene_passes_exe\"";
-    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-    $full_lucene_passes_exe = "perl.exe -S \"$lucene_passes_exe\"";
-    }
+    # Find the perl script to call to run lucene
+    my $full_lucene_passes = $self->{'full_lucene_passes'};
+    my $full_lucene_passes_exe = $self->{'full_lucene_passes_exe'};
 
     # define the section names for lucenepasses
@@ -209 +272 @@
     my $osextra = "";
     if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-    $build_dir =~ s@/@\\@g;
+    $build_dir =~ s@/@\\@g;
     } else {
-    if ($outhandle ne "STDERR") {
-        # so lucene_passes doesn't print to stderr if we redirect output
-        $osextra .= " 2>/dev/null";
-    }
-    }
- 
+    if ($outhandle ne "STDERR") {
+        # so lucene_passes doesn't print to stderr if we redirect output
+        $osextra .= " 2>/dev/null";
+    }
+    }
+
     # get the index expression if this index belongs
     # to a subcollection
@@ -222 +285 @@
     my $langarr = [];
 
-    # there may be subcollection info, and language info. 
+    # there may be subcollection info, and language info.
     my ($fields, $subcollection, $language) = split (":", $index);
     my @subcollections = ();
@@ -228 +291 @@
 
     foreach $subcollection (@subcollections) {
-    if (defined ($self->{'collect_cfg'}->{'subcollection'}->{$subcollection})) {
-        push (@$indexexparr, $self->{'collect_cfg'}->{'subcollection'}->{$subcollection});
-    } 
-    }
-    
+    if (defined ($self->{'collect_cfg'}->{'subcollection'}->{$subcollection})) {
+        push (@$indexexparr, $self->{'collect_cfg'}->{'subcollection'}->{$subcollection});
+    }
+    }
+
     # add expressions for languages if this index belongs to
-    # a language subcollection - only put languages expressions for the 
+    # a language subcollection - only put languages expressions for the
     # ones we want in the index
-    
     my @languages = ();
     my $language_metadata = "Language";
     if (defined ($self->{'collect_cfg'}->{'language_metadata'})) {
-    $language_metadata = $self->{'collect_cfg'}->{'language_metadata'};
+    $language_metadata = $self->{'collect_cfg'}->{'language_metadata'};
     }
     @languages = split /,/, $language if (defined $language);
     foreach my $language (@languages) {
-    my $not=0;
-    if ($language =~ s/^\!//) {
-        $not = 1;
-    }
-    if($not) {
-        push (@$langarr, "!$language");
-    } else {
-        push (@$langarr, "$language");
-    }
+    my $not=0;
+    if ($language =~ s/^\!//) {
+        $not = 1;
+    }
+    if($not) {
+        push (@$langarr, "!$language");
+    } else {
+        push (@$langarr, "$language");
+    }
     }
 
@@ -261 +323 @@
 
     if ($self->{'debug'}) {
-    $handle = STDOUT;
+    $handle = STDOUT;
     } else {
-    if (!-e "$lucene_passes_exe" || 
-        !open (PIPEOUT, "| $full_lucene_passes_exe $opt_create_index index $lucene_passes_sections \"$build_dir\" \"$indexdir\"   $osextra")) {
-        print STDERR "<FatalError name='NoRunLucenePasses'/>\n</Stage>\n" if $self->{'gli'};
-        die "lucenebuilder::build_index - couldn't run $lucene_passes_exe\n";
-    }
-    $handle = lucenebuilder::PIPEOUT;
-    }
-    
+      print STDERR "Cmd: $full_lucene_passes_exe $opt_create_index index $lucene_passes_sections \"$build_dir\" \"$indexdir\"   $osextra\n";
+    if (!-e "$full_lucene_passes" ||
+        !open (PIPEOUT, "| $full_lucene_passes_exe $opt_create_index index $lucene_passes_sections \"$build_dir\" \"$indexdir\"   $osextra")) {
+        print STDERR "<FatalError name='NoRunLucenePasses'/>\n</Stage>\n" if $self->{'gli'};
+        die "lucenebuilder::build_index - couldn't run $lucene_passes_exe\n";
+    }
+    $handle = lucenebuilder::PIPEOUT;
+    }
+
     my $store_levels = $self->{'levels'};
     my $gdbm_level = "document";
     if ($store_levels->{'section'}) {
-    $gdbm_level = "section";
-    }
-    
+    $gdbm_level = "section";
+    }
+
     my $dom_level = "";
     foreach my $key (keys %$store_levels) {
-    if ($mgppbuilder::level_map{$key} eq $llevel) {
-        $dom_level = $key;
-    }
+    if ($mgppbuilder::level_map{$key} eq $llevel) {
+        $dom_level = $key;
+    }
     }
     if ($dom_level eq "") {
-    print STDERR "Warning: unrecognized tag level $llevel\n";
-    $dom_level = "document";
+    print STDERR "Warning: unrecognized tag level $llevel\n";
+    $dom_level = "document";
     }
 
@@ -297 +360 @@
     $self->{'buildproc'}->set_indexing_text (1);
     $self->{'buildproc'}->set_indexfieldmap ($self->{'indexfieldmap'});
-    $self->{'buildproc'}->set_levels ($local_levels);                       
+    $self->{'buildproc'}->set_levels ($local_levels);
     $self->{'buildproc'}->set_gdbm_level($gdbm_level);
     $self->{'buildproc'}->reset();
-    &plugin::read ($self->{'pluginfo'}, $self->{'source_dir'}, 
-           "", {}, $self->{'buildproc'}, $self->{'maxdocs'}, 0, $self->{'gli'});
+    &plugin::read ($self->{'pluginfo'}, $self->{'source_dir'},
+           "", {}, $self->{'buildproc'}, $self->{'maxdocs'}, 0, $self->{'gli'});
     close ($handle) unless $self->{'debug'};
 
     $self->print_stats();
 
-    $self->{'buildproc'}->set_levels ($store_levels);                       
+    $self->{'buildproc'}->set_levels ($store_levels);
     print STDERR "</Stage>\n" if $self->{'gli'};
-}   
+}
+
+# /** A modified version of the basebuilder.pm's function that generates the
+#  *  information database (GDBM) from the GA documents. We need to change this
+#  *  so that if we've been asked to do an incremental build we only add
+#  *  metadata to autohierarchy classifiers via the IncrementalBuildUtils
+#  *  module. All other classifiers and metadata will be ignored.
+#  */
+sub make_infodatabase
+  {
+    my $self = shift (@_);
+    my $outhandle = $self->{'outhandle'};
+
+    my $dbext = ".bdb";
+    $dbext = ".ldb" if &util::is_little_endian();
+    my $infodb_file = &util::filename_cat($self->{'build_dir'}, "text", $self->{'collection'} . $dbext);
+
+    # If we aren't doing an incremental addition, then we just call the super-
+    # classes version
+    # Note: Incremental addition can only occur if a text/<collection>.ldb
+    #       already exists. If it doesn't, let the super classes function be
+    #       called once to generate it.
+    if (!$self->{'incremental'} || !(-e $infodb_file))
+      {
+        # basebuilder::make_infodatabase(@_);
+        # Note: this doesn't work as the direct reference means all the $self
+        #       data is lost.
+        $self->basebuilder::make_infodatabase(@_);
+        return;
+      }
+
+    # Carry on with an incremental addition
+    print $outhandle "\n*** performing an incremental addition to the info database\n" if ($self->{'verbosity'} >= 1);
+    print STDERR "<Stage name='CreateInfoData'>\n" if $self->{'gli'};
+
+    # 1. Init all the classifiers
+    &classify::init_classifiers ($self->{'classifiers'});
+    # 2. Init the buildproc settings.
+    #    Note: we still need this to process any associated files - but we
+    #    don't expect to pipe anything to txt2db so we can do away with the
+    #    complex output handle.
+    my $assocdir = &util::filename_cat($self->{'build_dir'}, "assoc");
+    &util::mk_all_dir ($assocdir);
+    $self->{'buildproc'}->set_mode ('incinfodb'); # Very Important
+    $self->{'buildproc'}->set_assocdir ($assocdir);
+    # 3. Read in all the metadata from the files in the archives directory using
+    #    the GAPlug and using ourselves as the document processor!
+    &plugin::read ($self->{'pluginfo'}, $self->{'source_dir'}, "", {}, $self->{'buildproc'}, $self->{'maxdocs'},0, $self->{'gli'});
+
+    print STDERR "</Stage>\n" if $self->{'gli'};
+}
 
 1;

trunk/gsdl/perllib/lucenebuildproc.pm

@@ -31 +31 @@
 # Use same basic XML structure setup by mgppbuilder/mgppbuildproc
 
-use mgppbuildproc; 
+use mgppbuildproc;
 use ghtml;
 use strict;
@@ -37 +37 @@
 
 
+use IncrementalBuildUtils;
+
 sub BEGIN {
     @lucenebuildproc::ISA = ('mgppbuildproc');
@@ -45 +47 @@
     my $class = shift @_;
     my $self = new mgppbuildproc (@_);
+
+    $self->{'numincdocs'} = 0;
 
     return bless $self, $class;
@@ -86 +90 @@
 
     my $docid="";
-    if ($ldoc_level) {
-    if ($self->{'gdbm_level'} eq 'document') {
-        my $doc_sec_num = $self->{'num_docs'};  
+    if ($ldoc_level)
+      {
+    if ($self->{'gdbm_level'} eq 'document')
+          {
+        my $doc_sec_num = $self->{'num_docs'};
         $docid = "gs2:id=\"$doc_sec_num\"";
-    } else  {
+          }
+        else
+          {
         # default is section level
-        my $doc_sec_num = $self->{'num_sections'}+1;    
+        my $doc_sec_num = $self->{'num_sections'} + 1;
         $docid = "gs2:id=\"$doc_sec_num\"";
-    }
-    }
+          }
+      }
     my $documenttag = "<$doc_level $gs2ns file=\"$file\" $docid >\n";
     my $documentendtag = "\n</$doc_level>\n";
-    
-    my ($sectiontag) = "";    
-    if ($lsec_level) {
+
+    my ($sectiontag) = "";
+    if ($lsec_level)
+      {
     $sectiontag = $mgppbuildproc::level_map{'section'};
-    }
+      }
     my ($parastarttag) = "";
     my ($paraendtag) = "";
-    if ($self->{'levels'}->{'paragraph'}) {
-    if ($self->{'strip_html'}) {
+    if ($self->{'levels'}->{'paragraph'})
+      {
+    if ($self->{'strip_html'})
+          {
         $parastarttag = "<".$mgppbuildproc::level_map{'paragraph'}.">";
         $paraendtag = "</".$mgppbuildproc::level_map{'paragraph'}.">";
-    } else {
+          }
+        else
+          {
         print $outhandle "Paragraph level can not be used with no_strip_html!. Not indexing Paragraphs.\n";
-    }
-    }
-    
+          }
+      }
+
     my $doc_section = 0; # just for this document
 
@@ -120 +133 @@
     # get the text for this document
     my $section = $doc_obj->get_top_section();
-    while (defined $section) {
+    while (defined $section)
+      {
     # update a few statistics
     $doc_section++;
-    $self->{'num_sections'} += 1;
- 
-    if ($sectiontag ne "") {
-        my $secid = "gs2:id=\"".$self->{'num_sections'}."\"";       
+    $self->{'num_sections'}++;
+
+    if ($sectiontag ne "")
+          {
+        my $secid = "gs2:id=\"".$self->{'num_sections'}."\"";
         $text .= "\n<$sectiontag $secid >\n";
-    }
+          }
 
     # if we are doing subcollections, then some docs shouldn't be indexed.
-    # but we need to put the section tag placeholders in there so the 
+    # but we need to put the section tag placeholders in there so the
     # sections match up with gdbm db
     my $indexed_section = $doc_obj->get_metadata_element($section, "gsdldoctype") || "indexed_section";
     if (!$indexed_doc || ($indexed_section ne "indexed_section" && $indexed_section ne "indexed_doc")) {
         $text .= "\n</$sectiontag>\n" if ($sectiontag ne "");
-        $section = $doc_obj->get_next_section($section);
+            $section = $doc_obj->get_next_section($section);
         next;
-    }
-    
+          }
+
     $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
-    foreach my $field (split (/;/, $fields)) {
+    foreach my $field (split (/;/, $fields))
+          {
         # only deal with this field if it doesn't start with top or
         # this is the first section
@@ -147 +163 @@
         next if (($real_field =~ s/^top//) && ($doc_section != 1));
 
-        my $new_text = ""; 
-
-        # we get allfields by default - do nothing
-        if ($real_field eq "allfields") { 
-
-        }   
+        my $new_text = "";
+        my $tmp_text = "";
+
+        # If allfields is requested add all metadata fields and text as
+            # belonging to the ZZ field
+        if ($real_field eq "allfields") {
+              # Text first - no html nor paragraph tags
+              $new_text .= "$parastarttag<ZZ index=\"1\">\n";
+              $tmp_text = $self->preprocess_text($doc_obj->get_text ($section), 1, "");
+              &ghtml::htmlsafe($tmp_text);
+              $new_text .= "$tmp_text</ZZ>$paraendtag\n";
+              # Then Metadata
+              my $metadata = $doc_obj->get_all_metadata ($section);
+              foreach my $pair (@$metadata) {
+                my ($mfield, $mvalue) = (@$pair);
+                &ghtml::htmlsafe($mvalue);
+                # check fields here, maybe others dont want - change to use dontindex!!
+                if ($mfield ne "Identifier"
+                    && $mfield !~ /^gsdl/
+                    && $mfield ne "classifytype"
+                    && $mfield ne "assocfilepath"
+                    && defined $mvalue && $mvalue ne "") {
+                  $new_text .= "$parastarttag<ZZ index=\"1\">$mvalue</ZZ>$paraendtag\n";
+                }
+                if (!defined $self->{'indexfields'}->{$mfield}) {
+                  $self->{'indexfields'}->{$mfield} = 1;
+                }
+              }
+        }
         # metadata - output all metadata we know about except gsdl stuff
-        elsif ($real_field eq "metadata") { 
+        elsif ($real_field eq "metadata" || $real_field eq "allfields") {
         my $shortname = "";
         my $metadata = $doc_obj->get_all_metadata ($section);
         foreach my $pair (@$metadata) {
             my ($mfield, $mvalue) = (@$pair);
+                    &ghtml::htmlsafe($mvalue);
             # check fields here, maybe others dont want - change to use dontindex!!
             if ($mfield ne "Identifier" 
@@ -165 +205 @@
             && $mfield ne "assocfilepath"
             && defined $mvalue && $mvalue ne "") {
-            
+
             if (defined $self->{'indexfieldmap'}->{$mfield}) {
                 $shortname = $self->{'indexfieldmap'}->{$mfield};
@@ -173 +213 @@
                 $self->{'indexfieldmap'}->{$mfield} = $shortname;
                 $self->{'indexfieldmap'}->{$shortname} = 1;
-            }      
+            }
             $new_text .= "$parastarttag<$shortname index=\"1\">$mvalue</$shortname>$paraendtag\n";
             if (!defined $self->{'indexfields'}->{$mfield}) {
                 $self->{'indexfields'}->{$mfield} = 1;
-            }                   
+            }
             }
         }
         }
-        else { 
+        else {
         #individual metadata and or text specified - could be a comma separated list
         my $shortname="";
@@ -192 +232 @@
             $self->{'indexfieldmap'}->{$shortname} = 1;
         }
-        
+
         my @metadata_list = ();
         foreach my $submeta (split /,/, $real_field) {
@@ -209 +249 @@
                 $new_text .= "$section_text</$shortname>$paraendtag\n";
             }
-            else {
-                            # leave html stuff in, but escape the tags, and don't add Paragraph tags - never retrieve paras at the moment
-                &ghtml::htmlsafe($section_text);
-                $new_text .= $section_text;
+            else { # leave html stuff in, but escape the tags, and dont add Paragraph tags - never retrieve paras at the moment
+                $tmp_text .= $doc_obj->get_text ($section);
+                &ghtml::htmlsafe($tmp_text);
+                $new_text .= $tmp_text;
             }
             }
@@ -229 +269 @@
         }
         }
-        
         # filter the text
         $self->filter_text ($field, $new_text);
         $self->{'num_processed_bytes'} += length ($new_text);
+
         $text .= "$new_text";
     } # foreach field
-        
+
     $text .= "\n</$sectiontag>\n" if ($sectiontag ne "");
 
-    $section = $doc_obj->get_next_section($section);
+        $section = $doc_obj->get_next_section($section);
     } #while defined section
-    print $handle "$text\n$documentendtag"; 
+    print $handle "$text\n$documentendtag";
     #print STDOUT "$text\n$documentendtag";
 }
 
+# /** We make this builder pretend to be a document processor so we can get
+#  *  information back from the plugins.
+#  *
+#  *  @param  $self    A reference to this Lucene builder
+#  *  @param  $doc_obj A reference to a document object representing what was
+#  *                   parsed by the GAPlug
+#  *  @param  $file    The name of the file parsed as a string
+#  *
+#  *  @author John Thompson, DL Consulting Ltd
+#  */
+sub process()
+  {
+    my $self = shift (@_);
+    my ($doc_obj, $file) = @_;
+
+    # If this is called from any stage other than an incremental infodb we want
+    # to pass through to the superclass of build
+    if ($self->get_mode() eq "incinfodb")
+      {
+        print STDERR "*** Processing a document added using INCINFODB ***\n";
+        my ($archivedir) = $file =~ /^(.*?)(?:\/|\\)[^\/\\]*$/;
+        $archivedir = "" unless defined $archivedir;
+        $archivedir =~ s/\\/\//g;
+        $archivedir =~ s/^\/+//;
+        $archivedir =~ s/\/+$//;
+
+        # Number of files
+        print STDERR "There are " . scalar($doc_obj->get_assoc_files()) . " associated documents...\n";
+
+        # resolve the final filenames of the files associated with this document
+        $self->assoc_files ($doc_obj, $archivedir);
+
+        # is this a paged or a hierarchical document
+        my ($thistype, $childtype) = $self->get_document_type ($doc_obj);
+
+        # Determine the actual docnum by checking if we've processed any
+        # previous incrementally added documents. If so, carry on from there.
+        # Otherwise we set the counter to be the same as the number of
+        # sections encountered during the previous build
+        if ($self->{'numincdocs'} == 0)
+          {
+            $self->{'numincdocs'} = $self->{'starting_num_sections'} + 1;
+          }
+
+        my $section = $doc_obj->get_top_section ();
+        print STDERR "+ top section: '$section'\n";
+        my $doc_OID = $doc_obj->get_OID();
+        my $url = "";
+        while (defined $section)
+          {
+            print STDERR "+ processing section: '$section'\n";
+            # Attach all the other metadata to this document
+            # output the fact that this document is a document (unless doctype
+            # has been set to something else from within a plugin
+            my $dtype = $doc_obj->get_metadata_element ($section, "doctype");
+            if (!defined $dtype || $dtype !~ /\w/)
+              {
+                $doc_obj->add_utf8_metadata($section, "doctype", $dtype);
+              }
+            # output whether this node contains text
+            if ($doc_obj->get_text_length($section) > 0)
+              {
+                $doc_obj->add_utf8_metadata($section, "hastxt", 1);
+              }
+            else
+              {
+                $doc_obj->add_utf8_metadata($section, "hastxt", 0);
+              }
+
+            # output archivedir if at top level
+            if ($section eq $doc_obj->get_top_section())
+              {
+                $doc_obj->add_utf8_metadata($section, "archivedir", $archivedir);
+        $doc_obj->add_utf8_metadata($section, "thistype", $thistype);
+              }
+
+            # output a list of children
+            my $children = $doc_obj->get_children ($section);
+            if (scalar(@$children) > 0)
+              {
+                $doc_obj->add_utf8_metadata($section, "childtype", $childtype);
+                my @contains = ();
+                foreach my $child (@$children)
+                  {
+                    if ($child =~ /^.*?\.(\d+)$/)
+                      {
+                        push (@contains, "\".$1");
+                      }
+                    else
+                      {
+                        push (@contains, "\".$child");
+                      }
+                  }
+                $doc_obj->add_utf8_metadata($section, "contains", join(";", @contains));
+              }
+            #output the matching doc number
+            print STDERR "+ docnum=" . $self->{'numincdocs'} . "\n";
+            $doc_obj->add_utf8_metadata($section, "docnum", $self->{'numincdocs'});
+
+            $self->{'numincdocs'}++;
+            $section = $doc_obj->get_next_section($section);
+            # if no sections wanted, only gdbm the docs
+            last if ($self->{'gdbm_level'} eq "document");
+          }
+        print STDERR "\n*** incrementally add metadata from document at: " . $file . "\n";
+        &IncrementalBuildUtils::addDocument($self->{'collection'}, $doc_obj, $doc_obj->get_top_section());
+      }
+    else
+      {
+        $self->mgppbuildproc::process(@_);
+      }
+  }
+# /** process() **/
+
+sub get_num_docs {
+    my $self = shift (@_);
+    #rint STDERR "get_num_docs(): $self->{'num_docs'}\n";
+    return $self->{'num_docs'};
+}
+
+sub get_num_sections {
+    my $self = shift (@_);
+    #rint STDERR "get_num_sections(): $self->{'num_sections'}\n";
+    return $self->{'num_sections'};
+}
+
+# num_bytes is the actual number of bytes in the collection
+# this is normally the same as what's processed during text compression
+sub get_num_bytes {
+    my $self = shift (@_);
+    #rint STDERR "get_num_bytes(): $self->{'num_bytes'}\n";
+    return $self->{'num_bytes'};
+}
+
 1;
 

trunk/gsdl/perllib/plugins/GAPlug.pm

@@ -70 +70 @@
     $self->{'metadata_value'} = "";
     $self->{'content'} = "";
+
+#    # Currently used to store information for previous values controls. In
+#    # the next contract I'll move to using information directly from Lucene.
+#    $self->{'sqlfh'} = 0;
    
     return bless $self, $class;
@@ -128 +132 @@
     elsif ($element eq "Metadata") {
     $self->{'doc_obj'}->add_utf8_metadata($self->{'section'}, $self->{'metadata_name'},$self->{'metadata_value'});
+        # Ensure this value is added to the allvalues database in gseditor.
+        # Note that the database constraints prevent multiple occurances of the
+        # same key-value pair.
+        # We write these out to a file, so they can all be commited in one
+        # transaction
+        #if (!$self->{'sqlfh'})
+        #  {
+        #    my $sql_file = $ENV{'GSDLHOME'} . "/collect/lld/tmp/gseditor.sql";
+        #    # If the file doesn't already exist, open it and begin a transaction
+        #    my $sql_fh;
+        #    if (!-e $sql_file)
+        #      {
+        #        open($sql_fh, ">" . $sql_file);
+        #        print $sql_fh "BEGIN TRANSACTION;\n";
+        #      }
+        #    else
+        #      {
+        #        open($sql_fh, ">>" . $sql_file);
+        #      }
+        #    print STDERR "Opened SQL log\n";
+        #    $self->{'sqlfh'} = $sql_fh;
+        #  }
+
+        #my $mvalue = $self->{'metadata_value'};
+        #$mvalue =~ s/\'/\'\'/g;
+        #$mvalue =~ s/_claimantsep_/ \& /g;
+
+        #my $fh = $self->{'sqlfh'};
+        #if ($fh)
+        #  {
+        #    print $fh "INSERT INTO allvalues (mkey, mvalue) VALUES ('" . $self->{'metadata_name'} . "', '" . $mvalue . "');\n";
+        #  }
+
+        # Clean Up
     $self->{'metadata_name'} = "";
     $self->{'metadata_value'} = "";
@@ -135 +173 @@
     $self->{'content'} = "";
     }
-    
     $self->{'element'} = "";
 }
@@ -161 +198 @@
 sub close_document {
     my $self = shift(@_);
-    
+
     # add the associated files
     my $assoc_files = 
@@ -170 +207 @@
 
     my $assoc_filepath=shift (@$assoc_filepath_list);
-    if (defined ($assoc_filepath)) {
-    # make absolute rather than relative...
-    $self->{'filename'} =~ m@^(.*[\\/]archives)@;
-    $assoc_filepath = "$1/$assoc_filepath/";
-    } else {
+
+    #rint STDERR "Filename is: " . $self->{'filename'} . "\n";
+    #rint STDERR "Initially my assoc_filepath is: $assoc_filepath\n";
+    #rint STDERR "Custom archive dir is: " . $self->{'base_dir'} . "\n";
+    # Correct the assoc filepath if one is defined
+    if (defined ($assoc_filepath))
+      {
+        # Check whether the assoc_filepath already includes the base dir
+        if (index($assoc_filepath, $self->{'base_dir'}) == -1)
+          {
+            # And if not, append it so as to make this absolute
+            $assoc_filepath = &util::filename_cat($self->{'base_dir'}, $assoc_filepath);
+          }
+      }
+    else
+      {
     $assoc_filepath = $self->{'filename'};
     $assoc_filepath =~ s/[^\\\/]*$//;
-    }
+      }
+    #rint STDERR "Goned and made it absolute: $assoc_filepath\n";
 
     foreach my $assoc_file_info (@$assoc_files) {
     my ($assoc_file, $mime_type, $dir) = split (":", $assoc_file_info);
+        #rint STDERR "assoc_file: $assoc_file\n";
+        #rint STDERR "mime_type: $mime_type\n";
+        #rint STDERR "dir: $dir\n";
     my $real_dir = &util::filename_cat($assoc_filepath, $assoc_file),
     my $assoc_dir = (defined $dir && $dir ne "") 
         ? &util::filename_cat($dir, $assoc_file) : $assoc_file;
     $self->{'doc_obj'}->associate_file($real_dir, $assoc_dir, $mime_type);
+        #rint STDERR "According to me the real assoc_filepath is: $real_dir\n";
     }
     $self->{'doc_obj'}->delete_metadata($self->{'doc_obj'}->get_top_section(), "gsdlassocfile");

trunk/gsdl/perllib/plugins/XMLPlug.pm

@@ -163 +163 @@
 
     $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+    $self->{'base_dir'} = $base_dir;
     $self->{'file'} = $file;
     $self->{'filename'} = $filename;