[Bio] / FigWebServices / sdk_uniprot_search.cgi Repository:
ViewVC logotype

View of /FigWebServices/sdk_uniprot_search.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (download) (annotate)
Mon Feb 13 20:04:44 2006 UTC (13 years, 9 months ago) by mkubal
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, caBIG-05Apr06-00, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, caBIG-13Feb06-00, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.6: +2 -2 lines
Gene now Gene Name or Symbol

#use SOAP::Lite +trace;
use SOAP::Lite;

use Classes;

use HTML;
use CGI;
use HTML;
use FIG;
use FIG_Config;

my $cgi = new CGI;
my $fig = new FIG;
my $html = [];
my $search_term;

eval{
    my $soap = SOAP::Lite
    -> readable(1)
    -> service('http://armstrong.arc.georgetown.edu:8081/gridPIR4/ws/PIRDataServices?wsdl');
};

&build_no_connection_page($fig,$cgi,$html) if $@; 

my $number_of_results;

if( $cgi->param('limit_search_results') ){
 	$number_of_results = $cgi->param('limit_search_results'); 
}
else{
	$number_of_results = 100;
}


if ($cgi->param('request') eq "Search"){
    $search_term = $cgi->param('search_term');
    &search($fig,$cgi,$html,$search_term,$number_of_results);	
}

else{	
    &build_page($fig,$cgi,$html);
}

sub search{
    
    my($fig,$cgi,$html,$search_term,$number_of_results) = @_;
    my $rows = [];

    #$search_term = "*".$search_term."*";
    #getting Protein attributes via Gene - works
    
    if ($cgi->param('select_domain') eq "Gene Name or Symbol"){
        my $criteria = GeneImpl->new(undef,$search_term,undef);
    	my $r = doQuery("ProteinImpl,edu.georgetown.pir.domain.ws.GeneImpl", $criteria, "GeneImpl", 0, $number_of_results);
    	my @ids_via_gene = ();
    	for my $pi ( @{$r} ) {
                #if($pi eq "no_connection"){&problem($cgi,$html)}
		my $id = $pi->{uniprotkbPrimaryAccession};
        	print STDERR "via gene: $id\n";
		my $row = &build_row($id);
		push(@$rows,$row);
    	}

    }

    elsif($cgi->param('select_domain') eq "UniProt Primary Accession"){
 	my $criteria = ProteinImpl->new(undef, $search_term, undef);
    	my $r = doQuery("ProteinImpl", $criteria, "ProteinImpl", 0, $number_of_results);
    	for my $pi ( @{$r} ) {
		my $id = $pi->{uniprotkbPrimaryAccession};
		my $row = &build_row($id);
		push(@$rows,$row);
    		}
    }
  

    elsif($cgi->param('select_domain') eq "ProteinName"){
	my $criteria = ProteinNameImpl->new(undef, undef, $search_term);
    	my $r = doQuery("ProteinImpl,edu.georgetown.pir.domain.ws.ProteinNameImpl", $criteria, "ProteinNameImpl", 0, $number_of_results);
    	for my $pi ( @{$r} ){
		my $id = $pi->{uniprotkbPrimaryAccession};
        	print STDERR "via pn: $id\n";
		my $row = &build_row($id);
		push(@$rows,$row);
        }
    }
   	
  
    else{
    
	my $criteria = GeneImpl->new(undef,$search_term,undef);
    	my $r = doQuery("ProteinImpl,edu.georgetown.pir.domain.ws.GeneImpl", $criteria, "GeneImpl", 0, $number_of_results);
    	my @ids_via_gene = ();
    	for my $pi ( @{$r} ) {
		my $id = $pi->{uniprotkbPrimaryAccession};
        	print STDERR "via gene: $id\n";
		my $row = &build_row($id);
		push(@$rows,$row);
    	}

    	#getting Protein attributes via ProteinName - works
    	my $criteria = ProteinNameImpl->new(undef, undef, $search_term);
    	my $r = doQuery("ProteinImpl,edu.georgetown.pir.domain.ws.ProteinNameImpl", $criteria, "ProteinNameImpl", 0, $number_of_results);
    	for my $pi ( @{$r} ){
		my $id = $pi->{uniprotkbPrimaryAccession};
        	print STDERR "via pn: $id\n";
		my $row = &build_row($id);
		push(@$rows,$row);
    	}

    	#getting Protein Attributes directly from Protein Domain - works
    	my $criteria = ProteinImpl->new(undef, $search_term, undef);
    	my $r = doQuery("ProteinImpl", $criteria, "ProteinImpl", 0, $number_of_results);
    	for my $pi ( @{$r} ) {
		my $id = $pi->{uniprotkbPrimaryAccession};
		my $row = &build_row($id);
		push(@$rows,$row);
    	 }
    }

    
    $search_result_col_hdrs =["Fig ID","UniProtKB Primary Accession ID","Gene Names","Protein Names","Organisms"];
    
   #$rows = [["test1","test2","test3","test4"]];	
    push @$html,
    $cgi->start_form(),
    $cgi->hr,
    &HTML::make_table($search_result_col_hdrs,$rows),
    $cgi->end_form();
    &HTML::show_page($cgi,$html,1);
    
    exit(0);
	
}

########################################################################

sub build_no_connection_page {
    my ($fig,$cgi,$html)=@_;
    push @$html, 
    $cgi->start_form(),
    "<h2>UniProt web-service search temporarily unavailbale, please try again later</h2>",
     $cgi->end_form;
    &HTML::show_page($cgi,$html,1);
    exit;
}


sub build_page {
    my ($fig,$cgi,$html)=@_;
    push @$html, 
    $cgi->start_form(),
    "<h2>Search UniProt</h2>",
    $cgi->br,
     "<h4>Enter Search Term (prefix and/or append term with * for partial matches)</h4>",
    $cgi->textfield(-name => 'search_term', -size => 20),
    $cgi->submit(-name=>'request', -value=>'Search'),   
    $cgi->br,
     "<h4>Limit Search to One Domain (for faster response)</h4>",
     "<select name=select_domain>
        <option value=All  > All 3</option>
	<option value=Gene  >Gene Name or Symbol</option>
	<option value=Protein  >UniProt Primary Accession</option>
        <option value=ProteinName  >ProteinName</option> 
     </select> &nbsp;&nbsp",
     $cgi->br,
     "<h4>Limit Number of Search Results (default = maximum of 100)</h4>",
     $cgi->textfield(-name => 'limit_search_results', -size => 20),
     $cgi->br,
     $cgi->end_form;
    &HTML::show_page($cgi,$html,1);
    exit;
}

sub doQuery{
    my ($target, $criteria, $crit_type, $max, $min) = @_;
    my $pirns = "urn:ws.domain.pir.georgetown.edu";

    my $soap = SOAP::Lite
    -> readable(1)
    -> service('http://armstrong.arc.georgetown.edu:8081/gridPIR4/ws/PIRDataServices?wsdl');

    
    # Notice the user of type and attr to make sure the SOAP
    # matches the WSDL for the service.  It looks like SOAP:Lite
    # is smart enough to use the WSDL to paint the "edu.georgetown..."
    # with the right element name, but for the criteria object,
    # the WSDL says any_type, but we need to say what was actually
    # sent.  I think that's why I end up having to do this.  Notice
    # I don't set the element name...that's correctly being set by
    # the soap::lite serializer.

    my $x = $soap->query( "edu.georgetown.pir.domain.ws." . $target,
			  SOAP::Data->type("pirns:$crit_type")
			            ->attr({'xmlns:pirns' => "$pirns"})
			            ->value($criteria),
			  $max,
			  $min);


    # have to do this to actually get SOM, else just get one element

    my $som = $soap->call;
    #print "SOM Dump:\n" . &Dumper( $som ) . "\n";

    # Result is array of blessed objects if we pull it out of the
    # SOM correctly.  I think this will work for any SDK call but
    # not sure.

    my @r;

    for my $t ($som->valueof('//queryResponse/queryReturn/queryReturn')) {
	push( @r, $t );
    }

    return \@r;
}

sub build_row {
    
    my ($id) = @_;
    my @row = ();
    my @pegs = $fig->by_alias($id);
    
    my $fig_id = 0;
    $fig_id = $pegs[0];
    if(!$fig_id){
	$fig_id = "no peg";
    }
    else{
     	#$prefix = $FIG_Config::cgi_url;
        $prefix = "http://rat.uchicago.edu/FIG";
	$url = $prefix."/protein.cgi?prot=".$fig_id."&user=";
        $fig_id = "<a href='$url'>$fig_id</a>";
    }
    my @gene_names = ();
    my @prot_names = ();   

    #getting Gene attributes via Protein
    my $criteria = ProteinImpl->new(undef,$id, undef,undef);
    my $r = doQuery( "GeneImpl,edu.georgetown.pir.domain.ws.ProteinImpl", $criteria, "ProteinImpl", 0, 100);
    my @gene_names = ();
    foreach my $gi ( @{$r} ) {
	my $name = $gi->{name};
	push(@gene_names,$name);
    }

    #getting ProteinName attributes via Protein - does work
    my $criteria = ProteinImpl->new(undef,$id, undef,undef);
    my $r = doQuery( "ProteinNameImpl,edu.georgetown.pir.domain.ws.ProteinImpl", $criteria, "ProteinImpl", 0, 100);
    my @prot_names = ();
    foreach my $pni ( @{$r} ) {
        my $prot_name = $pni->{value};
        push(@prot_names,$prot_name);
    }

    #getting Organism attributes via Protein - 
    my $criteria = ProteinImpl->new(undef,$id, undef,undef);
    my $r = doQuery( "OrganismImpl,edu.georgetown.pir.domain.ws.ProteinImpl", $criteria, "ProteinImpl", 0, 100);
    my @common_names = ();
    foreach my $o ( @{$r} ) {
        my $common_name = $o->{commonName};
        push(@common_names,$common_name);
    }

    push(@row,$fig_id);
    $url = "http://www.pir.uniprot.org/cgi-bin/upEntry?id=".$id;
    $id = "<a href='$url'>$id</a>";
    push(@row,$id);
    my $gene_names_string = join(" ",@gene_names);	
    push(@row,$gene_names_string);
    my $prot_names_string = join(" ",@prot_names);	
    push(@row,$prot_names_string);
    my $common_names_string = join(" ",@common_names);	
    push(@row,$common_names_string);
 
    return \@row;

}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3