[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.740, Wed Nov 26 19:28:37 2008 UTC revision 1.741, Mon Dec 15 20:59:52 2008 UTC
# Line 18054  Line 18054 
18054  sub get_subsystem :Scalar  sub get_subsystem :Scalar
18055  {  {
18056      my($self, $subsystem, $force_load) = @_;      my($self, $subsystem, $force_load) = @_;
18057        my $ent;
18058      my $sub;      my $sub;
18059    
18060        my $ss_cache_size = $FIG_Config::subsystem_cache_size;
18061        $ss_cache_size = 30 unless $ss_cache_size =~ /^\d+$/;
18062    
18063    
18064        my $now = time;
18065      $subsystem =~ s/[ \/]/_/g;      $subsystem =~ s/[ \/]/_/g;
18066      my $cache = $self->cached('_Subsystems');      my $cache = $self->cached('_Subsystems');
18067      if ($force_load || !($sub = $cache->{$subsystem}))  
18068        if ($force_load || !($ent = $cache->{$subsystem}))
18069      {      {
18070          $sub = new Subsystem($subsystem, $self);          $sub = new Subsystem($subsystem, $self);
18071          $cache->{$subsystem} = $sub if $sub;          if ($sub)
18072            {
18073                $ent = $cache->{$subsystem} = [$sub, $now];
18074                if (scalar(keys(%$cache)) > $ss_cache_size)
18075                {
18076                    my @sorted = sort { $cache->{$a}->[1] <=> $cache->{$b}->[1] } keys %$cache;
18077                    my $remove = $sorted[0];
18078                    #warn "Removing ss $remove from cache\n";
18079                    #warn Dumper(\@sorted);
18080                    delete $cache->{$remove};
18081                }
18082            }
18083        }
18084    
18085        if ($ent)
18086        {
18087            $ent->[1] = $now;
18088            return $ent->[0];
18089        }
18090        else
18091        {
18092            return undef;
18093      }      }
     return $sub;  
18094  }  }
18095    
18096  =head3 subsystem_to_roles  =head3 subsystem_to_roles
# Line 20909  Line 20936 
20936      return $resp->result;      return $resp->result;
20937  }  }
20938    
20939    =head3 clearinghouse_ping
20940    
20941        $fig->clearinghouse_ping($timeout);
20942    
20943    Send a ping message to the clearinghouse. If it doesn't respond within the timeout,
20944    the clearinghouse is not available for use.
20945    
20946    =cut
20947    
20948    sub clearinghouse_ping
20949    {
20950        my($self, $timeout) = @_;
20951    
20952        my $ch_url = "http://clearinghouse.theseed.org/Clearinghouse/clearinghouse_services.cgi";
20953        my $proxy = SOAP::Lite->uri("http://www.soaplite.com/Scripts")->proxy($ch_url, timeout => $ timeout);
20954    
20955        my $resp;
20956        eval {
20957            $resp = $proxy->ping();
20958        };
20959        if ($@)
20960        {
20961            warn "Error on proxy call: $@\n";
20962            return undef;
20963        }
20964        if ($resp->fault)
20965        {
20966            warn "Failure on ping(): " .$resp->faultcode . ": " . $resp->faultstring . "\n";
20967            return undef;
20968        }
20969    
20970        return $resp->result;
20971    }
20972    
20973    
20974  =head3 clearinghouse_next_feature_id  =head3 clearinghouse_next_feature_id
20975    
20976      my $val = $fig->clearinghouse_next_feature_id($genome, $type)      my $val = $fig->clearinghouse_next_feature_id($genome, $type)

Legend:
Removed from v.1.740  
changed lines
  Added in v.1.741

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3