Loading ...
Sorry, an error occurred while loading the content.

Help

Expand Messages
  • axis_2_user
    Hi All, I am trying to connect to a web-service, implemented in Perl (uses SOAP::Lite) and get back a text file as attachment; when i call the service
    Message 1 of 1 , Oct 1, 2007
    • 0 Attachment
      Hi All,

      I am trying to connect to a web-service, implemented in Perl (uses
      SOAP::Lite) and get back a text file as attachment; when i call the
      service "getAnnotation".

      I am not familiar with perl. I have pasted the two modules that are
      the server side of the web-service. Can some one please take a look at
      these files and let me know if they actually return a text file?

      Your help would be highly appreciated.

      Thanks

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

      rsrcSOAP.pm

      ################################################################
      #!/usr/local/bin/perl

      package rsrcSOAP;

      use SOAP::Lite +trace => [ fault => \&log_faults];
      use MIME::Entity;
      use DFGIEnv;
      use dbi_oracle;
      use TGIWeb;

      use strict;
      my $server = &TGIWeb::getServer('humoest');

      sub log_faults {
      my @param = @_;
      open LOGFILE,">>/tmp/rsrcSOAP.log";
      print LOGFILE '*'x 80,"\nFault signal with ".scalar(@param)."
      parameters\n";
      $,="\t";
      print LOGFILE '*'x 80,"\nParameters: ",@param,"\n";
      close LOGFILE;
      }

      sub log_methods {
      my @param = @_;
      open LOGFILE,">>/tmp/rsrcSOAP.log";
      print LOGFILE '*'x 80,"\nMethod signal with ".scalar(@param)."
      parameters\n";
      $,="\t";
      print LOGFILE '*'x 80,"\nParameters: ",@param,"\n";
      close LOGFILE;
      }

      sub getAllArrays {
      my $dbh = &auto_login('toga');
      my $results = &sql_get_all($dbh, 'select name from clonesets order
      by lower(name)');
      my @list;
      foreach my $r (@$results) {
      push @list, $r->[0];
      }
      &db_logout($dbh);
      return \@list;
      }

      sub getLastUpdate {
      # my $dbh = &auto_login('toga');
      # &db_logout($dbh);
      return '12/01/2006';
      # in the future we will have a release_info table
      }

      sub getAnnotation {
      my $self = shift;
      my $my_array = shift;
      my @params = @_;

      my @my_data;
      my $dbh = &auto_login('toga');
      my ($cloneset_id, $taxon_id) = &sql_get_values($dbh,"select
      cloneset_id, taxon_id from clonesets where upper(name) =
      '".uc($my_array)."'");
      push @my_data, "# Array: $my_array Taxon:$taxon_id";
      push @my_data, '# Fields requested: ';
      my @fields;
      my $from = "clones c";
      my $where = "c.cloneset_id=$cloneset_id";
      my $orderby = '';
      my $cnt = 0;
      my $fcnt = 0;
      foreach my $param (@params) {
      $fcnt++; push @my_data,"# $fcnt. $param";
      if (uc($param) eq 'CLONE_ID') {
      push @fields, 'c.plate_id';
      $orderby = 'order by c.plate_id';
      }
      elsif (uc($param) eq 'REFSEQ_ACC') { #4
      $cnt++;
      push @fields, "x$cnt.acc";
      $from .= ", xref_link xl$cnt, xref x$cnt";
      $where .= " and c.id=xl$cnt.id and xl$cnt.xref_id=x$cnt.xref_id
      and x$cnt.db=4";
      }
      elsif (uc($param) eq 'GENBANK_ACC') { #1
      $cnt++;
      push @fields, "x$cnt.acc";
      $from .= ", xref_link xl$cnt, xref x$cnt";
      $where .= " and c.id=xl$cnt.id and xl$cnt.xref_id=x$cnt.xref_id
      and x$cnt.db=1";
      }
      elsif (uc($param) eq 'ENTREZ_ID') { #3
      $cnt++;
      push @fields, "x$cnt.acc";
      $from .= ", xref_link xl$cnt, xref x$cnt";
      $where .= " and c.id=xl$cnt.id and xl$cnt.xref_id=x$cnt.xref_id
      and x$cnt.db=3";
      }
      elsif (uc($param) eq 'GENE_SYMBOL') { #7
      $cnt++;
      push @fields, "x$cnt.acc";
      $from .= ", xref_link xl$cnt, xref x$cnt";
      $where .= " and c.id=xl$cnt.id and xl$cnt.xref_id=x$cnt.xref_id
      and x$cnt.db=7";
      }
      elsif (uc($param) eq 'GENE_TITLE') { #6
      $cnt++;
      push @fields, "x$cnt.acc";
      $from .= ", xref_link xl$cnt, xref x$cnt";
      $where .= " and c.id=xl$cnt.id and xl$cnt.xref_id=x$cnt.xref_id
      and x$cnt.db=6";
      }
      elsif (uc($param) eq 'UNIGENE_ID') { #2
      $cnt++;
      push @fields, "x$cnt.acc";
      $from .= ", xref_link xl$cnt, xref x$cnt";
      $where .= " and c.id=xl$cnt.id and xl$cnt.xref_id=x$cnt.xref_id
      and x$cnt.db=2";
      }
      elsif (uc($param) eq 'CHR') {
      push @fields, 'ch.chr_name';
      $from .= ', tc_links t, sequence s, hits h, chromosome ch' unless
      ($from =~ /chromosome ch/);
      $where .= " and c.id=t.id and t.link_type=1 and t.seq_id=s.seq_id
      and s.seq_type=0 and s.taxon_id=$taxon_id and s.seq_id=h.seq_id and
      h.ctg_id = ch.ctg_id and ch.taxon_id=$taxon_id and ch.iscurrent=1"
      unless ($where =~ /ch.iscurrent/);
      }

      elsif (uc($param) eq 'TX_START') {
      push @fields, 'h.chr_lend';
      $from .= ', tc_links t, sequence s, hits h, chromosome ch' unless
      ($from =~ /chromosome ch/);
      $where .= " and c.id=t.id and t.link_type=1 and t.seq_id=s.seq_id
      and s.seq_type=0 and s.taxon_id=$taxon_id and s.seq_id=h.seq_id and
      h.ctg_id = ch.ctg_id and ch.taxon_id=$taxon_id and ch.iscurrent=1"
      unless ($where =~ /ch.iscurrent/);
      }

      elsif (uc($param) eq 'TX_END') {
      push @fields, 'h.chr_rend';
      $from .= ', tc_links t, sequence s, hits h, chromosome ch' unless
      ($from =~ /chromosome ch/);
      $where .= " and c.id=t.id and t.link_type=1 and t.seq_id=s.seq_id
      and s.seq_type=0 and s.taxon_id=$taxon_id and s.seq_id=h.seq_id and
      h.ctg_id = ch.ctg_id and ch.taxon_id=$taxon_id and ch.iscurrent=1"
      unless ($where =~ /ch.iscurrent/);
      }


      elsif (uc($param) eq 'STRAND') {
      push @fields, "case when (h.hit_lend<h.hit_rend) then '+' else
      '-' end";
      $from .= ', tc_links t, sequence s, hits h, chromosome ch' unless
      ($from =~ /chromosome ch/);
      $where .= " and c.id=t.id and t.link_type=1 and t.seq_id=s.seq_id
      and s.seq_type=0 and s.taxon_id=$taxon_id and s.seq_id=h.seq_id and
      h.ctg_id = ch.ctg_id and ch.taxon_id=$taxon_id and ch.iscurrent=1"
      unless ($where =~ /ch.iscurrent/);
      }


      else { # CDS_START, CDS_END, PROTEIN_ACC, CYTOBAND, SEQUENCE,
      GO_TERMS, BIO_CARTA, KEGG, DESC
      push @fields,"'NA'";
      }
      }
      my $query = 'select '.(join(",",@fields))." from $from where $where
      $orderby"; # and rownum<11
      my $results = &sql_get_all($dbh, $query);
      &db_logout($dbh);
      foreach my $r (@$results) {
      push @my_data, join("\t",@$r);
      }
      my $my_data = join("\n",@my_data);

      my $ent = MIME::Entity->build(
      'Id' => "<$$>",
      'Type' => 'text/plain',
      'Filename' => "$my_array.txt",
      'Data' => $my_data,
      'Disposition' => 'attachment',
      'Encoding' => '8bit'
      );

      return SOAP::Data->name("file" => "$my_array"),$ent;
      }

      1;

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


      rsrc.cgi

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

      #!/usr/local/bin/perl

      use lib '/tgiweb/cgi-bin/tgi/SOAP/service';
      use rsrcSOAP;
      use SOAP::Transport::HTTP;

      My::CGI::Handler
      -> dispatch_to('/tgiweb/cgi-bin/tgi/SOAP/service','rsrcSOAP')
      -> options({compress_threshold => 10000})
      -> handle()
      ;

      BEGIN {
      #####################################################################
      package My::CGI::Handler;
      use vars qw(@ISA);
      @ISA = qw(SOAP::Transport::HTTP::CGI);
      sub handle {
      my $pcount = scalar @_;
      my $self = shift;
      print STDERR "My::CGI::Handler => inside\n";
      print STDERR "My::CGI::Handler => content-type:
      ".$ENV{'SCRIPT_NAME'}."\n";
      # while (<>) {
      # print STDERR $_;
      # }
      return $self->SUPER::handle;
      }
      sub make_response {
      my $self = shift;
      my($code, $response) = @_;
      print STDERR "About to call My::CGI::Handler::make_response\n";
      return $self->SUPER::make_response($code, $response);
      }
      ###############################################################
      1;
      }
    Your message has been successfully submitted and would be delivered to recipients shortly.