[Bio] / Clearinghouse / clearinghouse_upload.pl Repository:
ViewVC logotype

View of /Clearinghouse/clearinghouse_upload.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (download) (as text) (annotate)
Mon May 9 19:31:20 2005 UTC (14 years, 5 months ago) by disz
Branch: MAIN
CVS Tags: myrast_33, HEAD
Changes since 1.16: +3 -3 lines
Added subsystem version suppression

#!/usr/bin/perl

use Clearinghouse::utils;
use CH_Config;
use CGI qw/:standard/;
use File::Temp qw/ :mktemp /;

use SOAP::Lite;

if (!param) {
    print header,
    start_html('Clearinghouse'),
    get_page_header(),
    h1('Clearinghouse Home Page');
    print_start();
} else {
    print header,
    start_html('Clearinghouse'),
    get_page_header(),
    h1('Clearinghouse Upload');
    if (param('upload')) {
	print_results();
    } else {
	print_type_page();
    }
}
print end_html;
exit;

sub print_start {
    print hr, h2("Register your genomes and features");
    
    print a({href=>'clearinghouse_register.cgi?TYPE=genome'},
	    "If you haven't already registered your genome, go here to do so before uploading a Genome."), p, br;

    print a({href=>'clearinghouse_register.cgi?TYPE=feature'}, "Go here if you need to register a feature"), p, br;
    print hr, h2("Upload");
    print a({href=>$url."?type=GENOME"}, "GENOME"), br;
    print a({href=>$url."?type=ANNOTATION"}, "ANNOTATIONS"), br;
    print a({href=>$url."?type=SUBSYSTEM"}, "SUBSYSTEM"), br;
    print a({href=>$url."?type=SIMS"}, "SIMS"), br;
    print a({href=>$url."?type=FEATURE"}, "Feature Updates"), br;
    print hr, h2("Browser"), br;
    print a({href=>"clearinghouse_browser.cgi"}, "Go to clearing house browser"), br;
}

sub print_type_page {
    my $type = param('type');

    print h2("Upload page for $type");

    print start_multipart_form(),
    "Your email addr: ", textfield(-name=>'email', -size=>30), br,br,
    "File to upload:  ", filefield(-name=>'upload_file',-size=>60),br, br,

    #make this a bigger window, maybe scroll

    "Description:  ", textfield(-name=>'description',-size=>60),br, br;
    
    print hidden('type', $type);

    if ($type eq "ANNOTATION") {
	print "Curator: ", textfield(-name=>'annotation_curator', -size=>30), br, br;
    } elsif ($type eq "GENOME") {
    } elsif ($type eq "SUBSYSTEM") {
    } elsif ($type eq "SIMS") {
	print "Tool Used:       ", textfield(-name=>'sim_tool', -size=>30), br, br;
	print "Tool Parameters: ", textfield(-name=>'sim_parms', -size=>30), br, br;
    } else {
	print "Curator:   ", textfield(-name=>'feature_curator', -size=>30), br, br;
    }
    
    print submit(-label=>'Upload File', -name=>'upload'),
    end_form;
}

sub print_results {
    #here, make the web service calls to upload this file to the CH
    
    my $length;
    my $type = param('type');
    my $file = param('upload_file');
    my $email = param('email');
    
    my $description = param('description');

    my $proxy = SOAP::Lite-> uri('http://www.soaplite.com/Scripts')-> proxy($CH_Config::service_url);
    
    my @table;

    #
    # Ensure we have an upload file; save to local disk.
    #
    
    if (!$file) {
	print "No file uploaded.";
	exit;
    }

    my $temp_file = mktemp("/tmp/clgXXXX");

    if (!open OUTFILE, ">$temp_file")
    {
	print "Cannot open temporary file $temp_file: $!";
	exit;
    }

    my $buf;
    while (read($file, $buf, 4096))
    {
	print OUTFILE $buf;
    }
    close OUTFILE;

    if ($type eq "GENOME") {

	my %meta;

	eval {
	    %meta = validate_package($temp_file, 'GENOME');
	};

	if ($@)
	{
	    print "Genome file validation failed: \n<pre>$@\n</pre>\n";
	    exit;
	}
	
	# check this meta data for genome id and see if it is registered
	# and if it already in teh table
	
	my $g_id = $meta{'genome_id'};
	
	my $reg_res = $proxy->is_genome_registered($g_id);
	
	if ($reg_res->fault)
	{
	    print "is_genome_registered call failed: ", $response->faultcode, " ", $response->faultstring, br;
	    goto done;
	}
	
	if (!$reg_res->result) {
	    print "Genome not registered";
	    goto done;
	}

	#
	# We're okay. Push the metadata into the @table list.
	#

	push(@table, map { "$_\t$meta{$_}" } keys(%meta));
    } 
    elsif ($type eq "SUBSYSTEM" or $type eq '1-SUBSYSTEM')
    {
	#
	# Upload a subsystem.
	#
	# Invoke the validator.
	#

	my %meta;

	eval {
	    %meta = validate_package($temp_file, $type);
	};

	if ($@)
	{
	    print "Error validating subsystem:\n<pre>\n$@</pre>\n";
	    exit;
	}

	my $sub_name = "name\t" . $meta{name};
	my $sub_curator = "curator\t" . $meta{curator};
	my $sub_version = "version\t" . $meta{version};

	push @table, $sub_name; 
	push @table, $sub_curator; 
	push @table, $sub_version; 
    }
    elsif ($type eq "SIMS") {
	my $sim_tool = "sim_tool\t".param('sim_tool');
	my $sim_parms = "sim_parms\t".param('sim_parms');
	push @table, $sim_tool; 
	push @table, $sim_parms; 
    }
    elsif ($type eq "FEATURE") {
	my $feature_curator = "curator\t".param('feature_curator');
	push @table, $feature_curator; 
    }
    elsif  ($type eq "ANNOTATION") {
	my $annotation_curator = "curator\t".param('annotation_curator');
	push @table, $annotation_curator; 
    }
    
    #
    # Mark the sources as being the IP address of the uploading machine.
    #
    my $source = $ENV{REMOTE_ADDR};
    
    my $meta_data = join("\n", @table);
    
    $response = $proxy->take_this_file($type, $email, $meta_data, $description, $source, $temp_file);
    if ($response->fault)
    {
	print "Failed to deposit: ", $response->faultcode, " ", $response->faultstring, br;
    } else {
	print "Upload successful", br;
    }
 done:
    print a({href=>'clearinghouse_upload.cgi'}, "Return to Clearinghouse Home Page"), br;
    print a({href=>"clearinghouse_browser.cgi"}, "Go to clearing house browser"), br;
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3