Index: /main/trunk/greenstone2/perllib/cgiactions/explodeaction.pm
===================================================================
--- /main/trunk/greenstone2/perllib/cgiactions/explodeaction.pm	(revision 23480)
+++ /main/trunk/greenstone2/perllib/cgiactions/explodeaction.pm	(revision 23480)
@@ -0,0 +1,215 @@
+###########################################################################
+#
+# explodeaction.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) 2009 New Zealand Digital Library Project
+#
+# This program is free software; you can redistr   te 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.
+#
+###########################################################################
+
+package explodeaction;
+
+use strict;
+
+use cgiactions::baseaction;
+
+use dbutil;
+use ghtml;
+
+
+BEGIN {
+#    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan/perl-5.8");
+    require XML::Rules;
+}
+
+
+@explodeaction::ISA = ('baseaction');
+
+
+# 'a' for action, and 'c' for collection are also compulsorary, and
+# added in automatically by baseaction
+
+my $action_table =
+{ 
+    "explode"          => { 'compulsory-args' => ["d"],
+			    'optional-args'   => [] }
+};
+
+
+sub new 
+{
+    my $class = shift (@_);
+    my ($gsdl_cgi,$iis6_mode) = @_;
+
+    my $self = new baseaction($action_table,$gsdl_cgi,$iis6_mode);
+
+    return bless $self, $class;
+}
+
+
+sub get_infodb_type
+{
+    my ($opt_site,$collect_home,$collect) = @_;
+
+    my $out = "STDERR";
+
+    $collect = &colcfg::use_collection($opt_site, $collect, $collect_home);
+
+    if ($collect eq "") {
+	print STDERR "Error: failed to find collection $collect in $collect_home\n";
+	print STDOUT "Content-type:text/plain\n\n";
+	print STDOUT "ERROR: Failed to find collection $collect\n";
+	exit 0;
+	
+    }
+
+    # Read in the collection configuration file.
+    my ($config_filename, $gs_mode) = &colcfg::get_collect_cfg_name($out);
+    my $collectcfg = &colcfg::read_collection_cfg ($config_filename, $gs_mode);
+
+    return $collectcfg->{'infodbtype'};
+}
+
+
+sub oid_to_import_filenames
+{
+    my $self = shift @_;
+
+    my @docids = @_;
+
+    my $infodb_type = $self->{'infodbtype'};
+
+    # Derive the archives dir    
+    my $archive_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"archives");
+
+    my $arcinfo_doc_filename 
+	= &dbutil::get_infodb_file_path($infodb_type, "archiveinf-doc", 
+					$archive_dir);
+
+    print STDERR "**** arcinfo doc filename = $arcinfo_doc_filename\n";
+
+    my @import_files = ();
+    
+    foreach my $docid (@docids) {
+	# Obtain the src and associated files specified docID
+	
+	print STDERR "*** looking up key \"$docid\"\n";
+
+	my $doc_rec
+	    = &dbutil::read_infodb_entry($infodb_type, $arcinfo_doc_filename, 
+					 $docid);
+
+	print STDERR "*** doc_rec = $doc_rec\n";
+	
+	my $src_files = $doc_rec->{'src-file'};
+	my $assoc_files = $doc_rec->{'assoc-file'};
+	
+	push(@import_files,@$src_files) if (defined $src_files);
+	push(@import_files,@$assoc_files) if (defined $assoc_files);
+    }
+
+    return \@import_files;
+}
+
+
+sub import_filenames_to_oids
+{
+    my $self = shift @_;
+
+    my ($import_filenames) = @_;
+
+    my $infodb_type = $self->{'infodbtype'};
+
+    # Derive the archives dir    
+    my $archive_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"archives");
+
+    # Obtain the doc.xml path for the specified docID
+    my $arcinfo_doc_filename 
+	= &dbutil::get_infodb_file_path($infodb_type, "archiveinf-src", 
+				 	$archive_dir);
+
+    my %all_oid_keys = ();
+
+    foreach my $if (@$import_filenames) {
+
+	print STDERR "*** looking if key \"$if\"\n";
+
+	my $src_rec
+	    = &dbutil::read_infodb_entry($infodb_type, $arcinfo_doc_filename, 
+					 $if);
+	my $oids = $src_rec->{'oid'};
+
+	foreach my $o (@$oids) {
+	    $all_oid_keys{$o} = 1;
+	}
+    }
+
+    my @all_oids = keys %all_oid_keys;
+
+    return \@all_oids;
+}
+
+
+
+sub explode 
+{
+    my $self = shift @_;
+
+    my $username  = $self->{'username'};
+    my $collect   = $self->{'collect'};
+    my $gsdl_cgi  = $self->{'gsdl_cgi'};
+    my $gsdl_home  = $self->{'gsdlhome'};
+
+    # Authenticate user if it is enabled
+    if ($baseaction::authentication_enabled) {
+	# Ensure the user is allowed to edit this collection
+	&authenticate_user($gsdl_cgi, $username, $collect);
+    }
+	
+    # Obtain the collect dir
+    my $collect_dir = &util::filename_cat($gsdl_home, "collect");
+
+    # Make sure the collection isn't locked by someone else
+    $self->lock_collection($username, $collect);
+
+    # look up additional args
+    my $docid  = $self->{'d'};
+    if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
+	$self->unlock_collection($username, $collect);
+	$gsdl_cgi->generate_error("No docid (d=...) specified.");
+    }
+
+    my $orig_import_filenames = $self->oid_to_import_filenames($docid);
+    my $oid_keys = $self->import_filenames_to_oids($orig_import_filenames);
+    my $expanded_import_filenames = $self->oid_to_import_filenames(@$oid_keys);
+
+
+    # Release the lock once it is done
+    $self->unlock_collection($username, $collect);
+
+    my $mess = "Base OID: $docid\n-----\n";
+    $mess .= join("\n",@$expanded_import_filenames);
+
+    $gsdl_cgi->generate_ok_message($mess);
+
+}
+
+
+
+1;
