source: main/trunk/greenstone2/perllib/cgiactions/explodeaction.pm@ 23480

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