[Bio] / FigKernelPackages / FIG.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/FIG.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.417, Wed Jan 11 22:58:57 2006 UTC revision 1.418, Thu Jan 12 04:14:24 2006 UTC
# Line 13311  Line 13311 
13311    
13312      my $dbh = $self->db_handle();      my $dbh = $self->db_handle();
13313    
13314      $aliases = $aliases ? $aliases : "";      my @loc = split( /,/, $location );
     my $aliasesT = $aliases;  
     $aliasesT =~ s/,/\t/g;  
     my @aliases = split(/\t/,$aliasesT);  
     if (! defined $fid) {  
         $fid = $self->next_fid($genome,$type);  
     }  
     &add_tbl_entry($fid,$location,$aliasesT);  
13315    
13316      if (($type eq "peg") and $translation)      if ( ! defined $fid )
13317      {      {
13318          $self->add_translation($fid,$translation);          my %seen = {};
13319            my @checksums = map { [ $_, $self->contig_md5sum( $genome, $_ ) ] }
13320                            grep { $_ && ( ! $seen{ $_ }++ ) }
13321                            map  { m/^(\S+)_\d+_\d+$/ }
13322                            @loc;
13323            $fid = $self->fid_from_clearinghouse( $genome, $type, $location, \@checksums, $translation );
13324    
13325            if ( ! $fid )
13326            {
13327                print STDERR "Failed to get a fid for $genome.$type at $location\n";
13328                return undef;
13329            }
13330      }      }
13331    
     my @loc = split(/,/,$location);  
13332      my($contig,$beg,$end);      my($contig,$beg,$end);
13333      if (($loc[0] =~ /^(\S+)_(\d+)_\d+$/) && (($contig,$beg) = ($1,$2)) && ($location =~ /(\d+)$/))      if ( ($loc[0] =~ /^(\S+)_(\d+)_\d+$/) && ( ($contig,$beg) = ($1,$2) ) )
13334      {      {
13335          $end = $1;          # Find the last end location on the same contig
13336            my @same_contig = grep { $_ =~ /^(\S+)_\d+_\d+$/ && ( $1 eq $contig ) } @loc;
13337            ( $end ) = $same_contig[-1] =~ /(\d+)$/;
13338    
13339          if ($beg > $end)  { ($beg,$end) = ($end,$beg) }          if ($beg > $end)  { ($beg,$end) = ($end,$beg) }
13340          $fid =~ /(\d+)$/;          $fid =~ /(\d+)$/;
13341          my $fidN = $1;          my $fidN = $1;
13342          if ((length($location) < 5000) && (length($contig) < 96) && (length($fid) < 32) && ($fid =~ /(\d+)$/))          if ((length($location) < 5000) && (length($contig) < 96) && (length($fid) < 32) && ($fid =~ /(\d+)$/))
13343          {          {
13344                $aliases = $aliases ? $aliases : "";
13345                my $aliasesT = $aliases;
13346                $aliasesT =~ s/,\s*/\t/g;
13347                my @aliases = split(/\t/,$aliasesT);
13348    
13349                if ( 0 )   # GJO - Debug disabling of function =================================
13350                {
13351                    print STDERR "Creating feature:\n"
13352                               . "   fid      = $fid\n"
13353                               . "   fidN     = $fidN\n"
13354                               . "   type     = $type\n"
13355                               . "   genome   = $genome\n"
13356                               . "   location = $location\n"
13357                               . "   contig   = $contig\n"
13358                               . "   minloc   = $beg\n"
13359                               . "   maxloc   = $end\n"
13360                               . "   aliases  = $aliases\n"
13361                               . "   translation = " . ($translation || '') . "\n";
13362                }
13363    
13364                &add_tbl_entry( $fid, $location, $aliasesT );
13365    
13366                if ( ( $type eq "peg" ) and $translation )
13367                {
13368                    $self->add_translation( $fid, $translation );
13369                }
13370    
13371              my $rv = $dbh->SQL("INSERT INTO features (id,idN,type,genome,location,contig,minloc,maxloc,aliases)              my $rv = $dbh->SQL("INSERT INTO features (id,idN,type,genome,location,contig,minloc,maxloc,aliases)
13372                                VALUES ('$fid',$fidN,'$type','$genome','$location','$contig',$beg,$end,'$aliases')");                                VALUES ('$fid',$fidN,'$type','$genome','$location','$contig',$beg,$end,'$aliases')");
13373    
# Line 13357  Line 13390 
13390      return undef;      return undef;
13391  }  }
13392    
13393    
13394  sub fid_from_clearinghouse  sub fid_from_clearinghouse
13395  {  {
13396      my($self, $genome, $type, $location, $translation, $checksums) = @_;      my($self, $genome, $type, $location, $checksums, $translation) = @_;
13397    
13398      my $ch_url = "http://clearinghouse.theseed.org/Clearinghouse/clearinghouse_services.cgi";      my $ch_url = "http://clearinghouse.theseed.org/Clearinghouse/clearinghouse_services.cgi";
13399    
   
     print "Getting proxy for $ch_url\n";  
13400      my $proxy = SOAP::Lite->uri("http://www.soaplite.com/Scripts")->proxy($ch_url);      my $proxy = SOAP::Lite->uri("http://www.soaplite.com/Scripts")->proxy($ch_url);
13401    
13402      my $resp;      my $resp;
     print "Call add_feature\n";  
13403      eval {      eval {
13404      $resp = $proxy->add_feature($genome, $type, $location, $translation, $checksums);      $resp = $proxy->add_feature($genome, $type, $location, $checksums, $translation);
13405  };  };
13406      if ($@)      if ($@)
13407      {      {
13408          return "ERROR $@\n";          return "ERROR $@\n";
13409      }      }
     print "Result is $resp\n";  
13410      if ($resp->fault)      if ($resp->fault)
13411      {      {
13412          die "Failure on add_feature: " .$resp->faultcode . ": " . $resp->faultstring . "\n";          die "Failure on add_feature: " .$resp->faultcode . ": " . $resp->faultstring . "\n";

Legend:
Removed from v.1.417  
changed lines
  Added in v.1.418

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3