source: main/tags/2.51-fiji/gsdl/cgi-bin/launch@ 31712

#!/usr/bin/perl -w

use gsdlCGI;

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

    my @arg_keys = $gsdl_cgi->param;

    if (!-e "setup.bash") {
    my $note = "Note: Server side for Greenstone applet must currently be Unix based.";

    $gsdl_cgi->generate_error("Unable to locate setup.bash\n$note");
    }


    # Unix specific, need to generalise to Windows etc.
    my $cmd = "source setup.bash > /dev/null ; $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";

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

    $status = $?;

    if ($status>0) {
        my $exit_status = "Exit status: $status";
        $gsdl_cgi->generate_error( "'".$cmd."' failed.\n$exit_status");
    }
    }
    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 ($col,$gsdl_cgi) = @_;
    
    if (defined $col) {
    $gsdl_cgi->checked_chdir("collect/$col");
    $gsdl_cgi->rm_rf("building/*");
    $gsdl_cgi->checked_chdir("../..");
    }

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

    if ($status == 0) {
    if (defined $col) {
        $gsdl_cgi->checked_chdir("collect/$col");
        $gsdl_cgi->rm_rf("index");
        $gsdl_cgi->unix_cmd("/bin/cp -r building index");
        $gsdl_cgi->checked_chdir("../..");
    }
    }
    # no need to do else clause as error message will have already
    # been generated.
}


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->rm_rf("$col/$dir");
    $gsdl_cgi->checked_chdir("..");
}

sub main
{
    my $gsdl_cgi = new gsdlCGI("+cmdline");
    my $gsdlhome = $gsdl_cgi->get_config_info("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($col,$gsdl_cgi);
    }
    elsif ($cmd eq "deldir") {
    run_deldir($col,$gsdl_cgi);
    }
    else {
    $gsdl_cgi->generate_error("unrecognised command: '$cmd'");
    }
    
}

&main();