source: main/tags/2.62/gsdl/cgi-bin/launch@ 32110

#!/usr/bin/perl -w

use gsdlCGI;

sub load_gsdl_utils
{
    my ($gsdlhome) = @_;

    require "$gsdlhome/perllib/util.pm";
}

sub run_gencmd
{
    my ($prog,$col,$gsdl_cgi) = @_;

    my @arg_keys = $gsdl_cgi->param;

    my $os = $gsdl_cgi->get_gsdl_os();

    my $cmd = "perl -S $prog.pl ";

    foreach my $k ( @arg_keys ) {
    my $arg_val = $gsdl_cgi->clean_param($k);
    if ($k eq "about") {
        # special case (allow most things, but not quotes)
        $arg_val =~ s/\"/"/g;
    }
    else {
        # ensure only alphanumeric, plus a few special chars
        $arg_val = $gsdl_cgi->safe_val($arg_val);
    }
    $cmd .= " -$k";
    if ($arg_val ne "") {
        $cmd .= " \"$arg_val\"";
    }
    }

    $cmd .= " $col" if (defined $col);

    my $status;

    print STDOUT "Content-type:text/plain\n\n";

    my $report = "";

    if (open(PIN,"$cmd 2>&1 |")) {
    while (defined (my $line=<PIN>)) {
        print STDOUT $line;
        $report .= $line;
    }
    close(PIN);

    $status = $?;

    if ($status>0) {
        $status = $status/256;
        my $exit_status = "Exit status: $status\n";
        my $mess = "'".$cmd."' failed.\n$report\n$exit_status";
        $gsdl_cgi->generate_error($mess);
    }
    }
    else {
    $gsdl_cgi->generate_error("Unable to execute cmd: $cmd");
    $status = -1;
    }

    return $status;
}


sub run_xmlinfo
{
    my ($cmd,$col,$gsdl_cgi) = @_;

    if (defined $col) {
    $gsdl_cgi->param(-name=>"collect",-value=>$col);
    $col = undef;
    }

    if ($cmd eq "pluginfo") {
    my $plug =  $gsdl_cgi->clean_param("plug");

    if (defined $plug) {
        $gsdl_cgi->delete("plug");
        $col = $gsdl_cgi->safe_val($plug);
    }
    }
    elsif ($cmd eq "classinfo") {
    my $class =  $gsdl_cgi->clean_param("class");

    if (defined $class) {
        $gsdl_cgi->delete("class");
        $col = $gsdl_cgi->safe_val($class);
    }
    }

    return run_gencmd($cmd,$col,$gsdl_cgi);
}


sub run_buildcol
{
    my ($gsdlhome,$col,$gsdl_cgi) = @_;
    
    my $full_col_dir  = &util::filename_cat($gsdlhome,"collect",$col);
    my $full_building = &util::filename_cat($full_col_dir,"building");
    my $full_index    = &util::filename_cat($full_col_dir,"index");

    if (defined $col) {
    &util::rm_r($full_building);
    &util::mk_dir($full_building);
    }

    my $status = run_gencmd("buildcol",$col,$gsdl_cgi);

    if ($status == 0) {
    if (defined $col) {
        &util::rm_r($full_index);

        # While it is more efficient to move the building directory
        # to become the index folder, this gets things out of order
        # back on the client.  Use copy for now as this makes things
        # simpler for now.

        my $full_building_here = &util::filename_cat($full_building,".");
        &util::cp_r($full_building_here,$full_index);
    }
    }
    # no need to do else clause as error message will have already
    # been generated.
}

sub run_exportcol
{
    my ($gsdlhome,$col,$gsdl_cgi) = @_;
    
    # multiple collections represented by ':' concatenated list
    $col =~ s/:/ /g;

    if (defined $col) {
    my ($remote_user) = ($col =~ m/^([^\-]+)/);

    my $cddir = $gsdl_cgi->clean_param("cddir");
    
    my $remote_dirname = &util::filename_cat($gsdlhome,"tmp",$remote_user);
    my $remote_cd_dirname = &util::filename_cat($remote_dirname,$cddir);

    if (!-e $remote_dirname) {
        &util::mk_dir($remote_dirname);
    }

    if (-e $remote_cd_dirname) {
        &util::rm_r($remote_cd_dirname);
    }

    # Update cddir cgi param prefiexed by remote_user
    $cddir = &util::filename_cat($remote_user,$cddir);
    $gsdl_cgi->delete("cddir");
    $gsdl_cgi->param(-name=>"cddir", -value=>$cddir);
    }

    return run_gencmd("exportcol",$col,$gsdl_cgi);
}

sub run_exportas
{
    my ($col,$gsdl_cgi) = @_;
    
    # multiple collections represented by ':' concatenated list
    $col =~ s/:/ /g;

    return run_gencmd("export",$col,$gsdl_cgi);
}



sub run_deldir
{
    my ($col,$gsdl_cgi) = @_;

    if ((!defined $col) || ($col =~ m/^\s*$/)) {
    $gsdl_cgi->generate_error( "No collection name specified");
    }

    $gsdl_cgi->checked_chdir("collect");

    my $dir = $gsdl_cgi->clean_param("dir");
    $dir = "" if ($dir eq ".");

    $gsdl_cgi->local_rm_r("$col/$dir");
    $gsdl_cgi->checked_chdir("..");

    $gsdl_cgi->generate_ok_message("$col deleted successfully");
}

sub main
{
    my $gsdl_cgi = new gsdlCGI("+cmdline");
    $gsdl_cgi->parse_cgi_args();
    $gsdl_cgi->setup_gsdl();
    my $gsdlhome = $ENV{'GSDLHOME'};

    load_gsdl_utils($gsdlhome);
    
    $gsdl_cgi->checked_chdir($gsdlhome);

    my $cmd = $gsdl_cgi->clean_param("cmd");
    if (!defined $cmd) {
    $gsdl_cgi->generate_error("No command specified.");
    }

    $gsdl_cgi->delete("cmd");
    $cmd =~ s/\..*$//;
    $cmd = $gsdl_cgi->safe_val($cmd);

    my $col = $gsdl_cgi->clean_param("c");

    $gsdl_cgi->delete("c");
    $col = $gsdl_cgi->safe_val($col);

    if ($cmd eq "mkcol") {
    run_gencmd($cmd,$col,$gsdl_cgi);
    }
    elsif ($cmd eq "pluginfo") {
    run_xmlinfo($cmd,$col,$gsdl_cgi);
    }
    elsif ($cmd eq "classinfo") {
    run_xmlinfo($cmd,$col,$gsdl_cgi);
    }
    elsif ($cmd eq "import") {
    run_gencmd($cmd,$col,$gsdl_cgi);
    }
    elsif ($cmd eq "buildcol") {
    run_buildcol($gsdlhome,$col,$gsdl_cgi);
    }
    elsif ($cmd eq "exportcol") {
    run_exportcol($gsdlhome,$col,$gsdl_cgi);
    }
    elsif ($cmd eq "exportas") {
    run_exportas($col,$gsdl_cgi);
    }
    elsif ($cmd eq "deldir") {
    run_deldir($col,$gsdl_cgi);
    }
    else {
    $gsdl_cgi->generate_error("unrecognised command: '$cmd'");
    }
}

&main();