[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.628, Fri Oct 5 18:33:12 2007 UTC revision 1.629, Tue Oct 9 18:57:27 2007 UTC
# Line 38  Line 38 
38  use MIME::Base64;  use MIME::Base64;
39  use File::Basename;  use File::Basename;
40  use FileHandle;  use FileHandle;
41    use DirHandle;
42  use File::Copy;  use File::Copy;
43  use SOAP::Lite;  use SOAP::Lite;
44  use File::Path;  use File::Path;
# Line 746  Line 747 
747          print STDERR "Errors found while verifying genome directory $genomeF:\n";          print STDERR "Errors found while verifying genome directory $genomeF:\n";
748          print STDERR join("", @errors);          print STDERR join("", @errors);
749    
750          if (!$force)          #
751            # Special case check: If the only errors returned are peg_tbl_stop_missing, we're
752            # probably hitting a possibly_truncated bug. Let the process continue.
753            #
754    
755            my @corrupt = grep { /corrupt/ } @errors;
756            if (@corrupt == 1 and $corrupt[0] =~ /is corrupt \(peg_tbl_stop_missing=(\d+)\)/)
757            {
758                my $count = $1;
759                my $s = $count > 1 ? "s" : "";
760                print "Only error is $count peg_tbl_stop_missing error$s, continuing\n";
761            }
762            elsif (!$force)
763          {          {
764              return $rc;              return $rc;
765          }          }
# Line 963  Line 976 
976          }          }
977      }      }
978    
979    
980        #
981        # Make sure that the features are registered for this genome. We assume here that
982        # the genome is already registered (as it should be if we came from RAST).
983        #
984    
985        my $dh = new DirHandle("$genome_dir/Features");
986        for my $ftype ($dh->read())
987        {
988            my $path = "$genome_dir/Features/$ftype";
989            next if $ftype =~ /^\d./ or ! -d $path;
990    
991            my $fh = new FileHandle("<$ftype/tbl");
992            if (!$fh)
993            {
994                warn "Cannot open tbl file in feature directory $path: $!";
995                next;
996            }
997            #
998            # Find the largest feature in use.
999            #
1000            my $max = -1;
1001            while (<$fh>)
1002            {
1003                chomp;
1004                my($fid) = split(/\t/);
1005                if ($fid =~ /^fig\|\d+\.\d+\.[^.]+\.(\d+)/)
1006                {
1007                    $max = $1 > $max ? $1 : $max;
1008                }
1009            }
1010            close($fh);
1011    
1012            #
1013            # See what the clearinghouse has, and register features if they are not there.
1014            #
1015            my $clnext = $self->clearinghouse_next_feature_id($genome, $ftype);
1016            if ($clnext <= $max)
1017            {
1018                #
1019                # Not enough features are registered in the clearinghouse. ($clnext needs to be $max + 1)
1020                # Register some more.
1021                #
1022    
1023                my $missing = $max - $clnext + 1;
1024                my $start = $self->clearinghouse_register_features($genome, $ftype, $missing);
1025                if (defined($start))
1026                {
1027                    print "Registered $missing new features of type $ftype on $genome (start=$start)\n";
1028                }
1029            }
1030        }
1031    
1032      return $rc;      return $rc;
1033  }  }
1034    
1035    
1036    
1037  sub get_index {  sub get_index {
1038      my($self,$gs) = @_;      my($self,$gs) = @_;
1039    
# Line 18291  Line 18359 
18359      return $resp->result;      return $resp->result;
18360  }  }
18361    
18362    =head3 clearinghouse_next_feature_id
18363    
18364        my $val = $fig->clearinghouse_next_feature_id($genome, $type)
18365    
18366    Return the next feature ID that would be allocated by the clearinghouse for the given
18367    genome and feature type.
18368    
18369    =cut
18370    
18371    sub clearinghouse_next_feature_id
18372    {
18373        my($self, $genome, $type) = @_;
18374    
18375        my $ch_url = "http://clearinghouse.theseed.org/Clearinghouse/clearinghouse_services.cgi";
18376        my $proxy = SOAP::Lite->uri("http://www.soaplite.com/Scripts")->proxy($ch_url);
18377    
18378        my $resp;
18379        eval {
18380            $resp = $proxy->get_next_feature_id($genome, $type);
18381        };
18382        if ($@)
18383        {
18384            warn "Error on proxy call: $@\n";
18385            return undef;
18386        }
18387        if ($resp->fault)
18388        {
18389            warn "Failure on get_next_feature_id($genome, $type): " .$resp->faultcode . ": " . $resp->faultstring . "\n";
18390            return undef;
18391        }
18392    
18393        return $resp->result;
18394    }
18395    
18396    =head3 clearinghouse_register_features
18397    
18398        my $val = $fig->clearinghouse_register_features($genome, $type, $num)
18399    
18400    Register $num new features of type $type on genome $genome. Returns the starting index for the
18401    new features.
18402    
18403    =cut
18404    
18405    sub clearinghouse_register_features
18406    {
18407        my($self, $genome, $type, $num) = @_;
18408    
18409        my $ch_url = "http://clearinghouse.theseed.org/Clearinghouse/clearinghouse_services.cgi";
18410        my $proxy = SOAP::Lite->uri("http://www.soaplite.com/Scripts")->proxy($ch_url);
18411    
18412        my $resp;
18413        eval {
18414            $resp = $proxy->register_feature($genome, $type, $num);
18415        };
18416        if ($@)
18417        {
18418            warn "Error on proxy call: $@\n";
18419            return undef;
18420        }
18421        if ($resp->fault)
18422        {
18423            warn "Failure on register_feature($genome, $type, $num): " .$resp->faultcode . ": " . $resp->faultstring . "\n";
18424            return undef;
18425        }
18426    
18427        return $resp->result;
18428    }
18429    
18430    
18431  sub next_fid {  sub next_fid {
18432      my($self,$genome,$type) = @_;      my($self,$genome,$type) = @_;

Legend:
Removed from v.1.628  
changed lines
  Added in v.1.629

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3