Index: gs2-extensions/parallel-building/trunk/src/perllib/parallelbuildingbuildcolutils.pm
===================================================================
--- gs2-extensions/parallel-building/trunk/src/perllib/parallelbuildingbuildcolutils.pm	(revision 27280)
+++ gs2-extensions/parallel-building/trunk/src/perllib/parallelbuildingbuildcolutils.pm	(revision 27280)
@@ -0,0 +1,217 @@
+###########################################################################
+#
+# parallelbuildingbuildcolutils.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.
+#
+###########################################################################
+
+# search for: parallel indexname indexlevel
+
+package parallelbuildingbuildcolutils;
+
+# Pragma
+use strict;
+no strict 'refs'; # allow filehandles to be variables and vice versa
+no strict 'subs'; # allow barewords (eg STDERR) as function arguments
+
+# Greenstone Modules
+use buildcolutils;
+use gsprintf;
+
+BEGIN
+{
+  @parallelbuildingbuildcolutils::ISA = ('buildcolutils');
+}
+
+# Parallel Build Customization
+my $arguments = [
+      { 'name' => "workers",
+        'desc' => "**Parallel Processing** The number of 'worker' threads to spawn when parallel processing",
+        'type' => "int",
+        'range' => "0,",
+        'reqd' => "no",
+        'hiddengli' => "yes" }
+      ];
+
+## @method new()
+#
+sub new
+{
+  my $class = shift(@_);
+  my $self = new buildcolutils(@_);
+
+  # Sanity checks
+
+  return bless($self, $class);
+}
+
+# @function getSupportedArguments
+# Retrieve the list of arguments that are specific to this subclass of
+# buildcolutils so they can be added to the list of supported arguments to
+# buildcol.pl. The use of any of these arguments automatically causes this
+# subclass to be instantiated and used in preference to the parent class.
+# ATM it is up to the implementer to ensure these arguments are unique between
+# subclasses
+sub getSupportedArguments
+{
+  return $arguments;
+}
+# getSupportedArguments()
+
+# @function set_collection_options
+#
+sub set_collection_options
+{
+  my $self = shift @_;
+  my ($collectcfg) = @_;
+
+  $self->SUPER::set_collection_options($collectcfg);
+
+  # Sanity tests
+  if ($collectcfg->{'infodbtype'} eq 'sqlite' && $self->{'workers'} > 0)
+  {
+    print STDERR "WARNING: Parallel builds not current supported by SQLite - reverting to serial build\n";
+    $self->{'workers'} = 0;
+  }
+
+  # Add parallel building prefix to requests buildertype as necessary
+  if ($self->{'buildtype'} !~ /^parallelbuilding/)
+  {
+    print STDERR "WARNING: using parallel processing version of indexer: " . $self->{'buildtype'} . "\n";
+    $self->{'buildtype'} = 'parallel' . $self->{'buildtype'};
+  }
+}
+# set_collection_options()
+
+# @function build_collection()
+# Parallel Building Support
+# - if parallel building is requested then we subvert the normal 'all' mode
+#   process, insert attempting to create an XML 'recipe' for building this
+#   collection. We then pass this recipe to an Open MPI augmented compiled
+#   executable (which will in turn make multiple calls back to buildcol.pl
+#   according to the instructions in the recipe)!
+sub build_collection
+{
+  my $self = shift(@_);
+  my $builders_ref = shift(@_);
+  my $out = $self->{'out'};
+
+  if ($self->{'workers'} > 0)
+  {
+    print $out "*** parallel building\n";
+    # Some infodb modes (namely GDBMServer at the moment) need to open the
+    # connection to the database in such a way that it persists over the
+    # child threads. We do this by adding a dummy call to build the file path
+    # to archiveinf-doc as it is the database in question. The '1' at the end
+    # means launch the server... it will then persist until this block passes
+    # out of scope (presumably after all the child mpi processes are done)
+    my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($self->{'infodbtype'}, "archiveinf-doc", $self->{'archivedir'}, 1);
+
+    # we initially create the recipe as a datastructure to make it easier for
+    # each builder to determine what has already been defined
+    # - each step of the recipe will have a command as a string and a (possibly
+    #   empty) array of steps that depend on this step (possibly recursive)
+    print $out "Generating indexing 'recipe'\n";
+    my $recipe = [];
+    # pass to each builder to have it populated with appropriate commands
+    map { local $_=$_; $_->prepareIndexRecipe($self->{'collection'}, $recipe); } @{$builders_ref};
+    # now write the recipe to an XML file, resolving any path macros
+    my $max_parallel_tasks = scalar(@{$recipe});
+    my $xml_lines = ();
+    push(@{$xml_lines},'<?xml version="1.0" standalone="no" ?>');
+    push(@{$xml_lines},'<Recipe>');
+    foreach my $item (@{$recipe})
+    {
+      my $max_parallel_child_tasks = &print_recipe($xml_lines, $item);
+      if ($max_parallel_child_tasks > $max_parallel_tasks)
+      {
+        $max_parallel_tasks = $max_parallel_child_tasks;
+      }
+    }
+    push(@{$xml_lines}, '</Recipe>');
+    my $recipe_path = &util::get_tmp_filename('.xml');
+    open(XMLOUT, ">:utf8", $recipe_path) or die("Error! Failed to open recipe file for writing: " . $recipe_path . "\nReason: " . $!);
+    print XMLOUT join("\n", @{$xml_lines});
+    close(XMLOUT);
+    # call mpibuildcol executable using mpirun and passing path to recipe
+    my $number_of_threads = $self->{'workers'} + 1;
+    my $mpirun_cmd = 'mpirun -n ' . $number_of_threads . ' mpibuildcol "' . $recipe_path . '"';
+    print $out "Running command: " . $mpirun_cmd . "\n";
+    print `$mpirun_cmd`;
+    # clean up recipe
+    unlink($recipe_path);
+  }
+  else
+  {
+    $self::SUPER->build_collection($builders_ref);
+  }
+}
+# build_collection()
+
+# @function build_auxiliary_files
+#
+sub build_auxiliary_files
+{
+  my $self = shift(@_);
+  my ($builders_ref) = @_;
+  if (!$self->{'parallel'} && !$self->{'debug'})
+  {
+    $self->SUPER::build_auxiliary_files($builders_ref);
+  }
+}
+# build_auxiliary_files()
+
+# @function print_recipe
+#
+sub print_recipe
+{
+  my ($xml_lines, $item) = @_;
+  my $max_parallel_tasks = 0;
+
+  # start building up the command in our xml buffer
+  push(@{$xml_lines}, '<Task>');
+  my $command = $item->{'command'};
+  $command =~ s/&/&amp;/g;
+  $command =~ s/</&lt;/g;
+  $command =~ s/>/&gt;/g;
+  push(@{$xml_lines}, '<Command>' . $command . '</Command>');
+
+  # - print children before closing task
+  if (defined $item->{'children'})
+  {
+    $max_parallel_tasks = scalar(@{$item->{'children'}});
+
+    foreach my $child_item (@{$item->{'children'}})
+    {
+      my $max_parallel_child_tasks = &print_recipe($xml_lines, $child_item);
+      if ($max_parallel_child_tasks > $max_parallel_tasks)
+      {
+        $max_parallel_tasks = $max_parallel_child_tasks;
+      }
+    }
+  }
+  # - now we can close the task having printed nested children
+  push(@{$xml_lines},'</Task>');
+  # done
+  return $max_parallel_tasks;
+}
+# print_recipe()
