[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.605, Mon Jul 16 16:34:29 2007 UTC revision 1.606, Mon Jul 16 19:15:36 2007 UTC
# Line 247  Line 247 
247      return bless $self, $class;      return bless $self, $class;
248  }  }
249    
250    =head3 CacheTrick
251    
252    C<< my $value = $fig->CacheTrick($self, $field => $evalString); >>
253    
254    This is a helper method used to create simple field caching in another object. If the
255    named field is found in $self, then it will be returned directly. Otherwise, the eval
256    string will be executed to compute the value. The value is then cahced in the $self
257    object so it can be retrieved easily when needed. Use this method to make a FIG
258    data-access object more like an object created by PPO or ERDB.
259    
260    =over 4
261    
262    =item self
263    
264    Hash or blessed object containing the cached fields.
265    
266    =item field
267    
268    Name of the field desired.
269    
270    =item evalString
271    
272    String that can be evaluated to compute the field value.
273    
274    =item RETURN
275    
276    Returns the value of the desired field.
277    
278    =back
279    
280    =cut
281    
282    sub CacheTrick {
283        # Get the parameters. Note that we get this object under the name "$fig" rather than
284        # "$self", because $self represents the caller's object.
285        my ($fig, $self, $field, $evalString) = @_;
286        # Declare the return variable.
287        my $retVal;
288        # Check the cache.
289        if (exists $self->{$field}) {
290            # Return the cached data.
291            $retVal = $self->{$field};
292        } else {
293            # Compute the field value.
294            Trace("Retrieving data for $field using formula: $evalString") if T(4);
295            $retVal = eval($evalString);
296            # Cache it for future use.
297            $self->{$field} = $retVal;
298        }
299        # Return the field value.
300        return $retVal;
301    }
302    
303  =head3 go_number_to_term  =head3 go_number_to_term
304    
305  Returns GO term for GO number from go_number_to_term table in database  Returns GO term for GO number from go_number_to_term table in database
# Line 6737  Line 6790 
6790      return @$relational_db_response;      return @$relational_db_response;
6791  }  }
6792    
6793  sub net_coupled_to  sub net_coupled_to {
 {  
6794      my($self, $peg) = @_;      my($self, $peg) = @_;
6795      my $ua = LWP::UserAgent->new();      return FIGRules::NetCouplingData('coupled_to', id1 => $peg);
     my $url = $FIG_Config::pch_server_url;  
     $url = "http://anno-2.nmpdr.org/simserver/perl/pchs.pl" if $url eq '';  
   
     my $resp = $ua->post($url, { function => 'coupled_to', id1 => $peg });  
     if ($resp->is_success)  
     {  
         my @out;  
         my $dat = $resp->content;  
         while ($dat =~ /([^\n]+)\n/g)  
         {  
             my @l = split(/\t/, $1);  
             push(@out, \@l);  
         }  
         return @out;  
     }  
     else  
     {  
         die "Failure retriving network coupling: " . $resp->content . "\n";  
     }  
6796  }  }
6797    
6798  sub net_coupling_evidence  sub net_coupling_evidence
6799  {  {
6800      my($self, $peg1, $peg2) = @_;      my($self, $peg1, $peg2) = @_;
6801      my $ua = LWP::UserAgent->new();      return FIGRules::NetCouplingData('coupling_evidence', id1 => $peg1, id2 => $peg2);
     my $url = $FIG_Config::pch_server_url;  
     $url = "http://anno-2.nmpdr.org/simserver/perl/pchs.pl" if $url eq '';  
   
     my $resp = $ua->post($url, { function => 'coupling_evidence', id1 => $peg1, id2 => $peg2 });  
     if ($resp->is_success)  
     {  
         my @out;  
         my $dat = $resp->content;  
         while ($dat =~ /([^\n]+)\n/g)  
         {  
             my @l = split(/\t/, $1);  
             push(@out, \@l);  
         }  
         return @out;  
     }  
     else  
     {  
         die "Failure retriving network coupling: " . $resp->content . "\n";  
     }  
6802  }  }
6803    
6804  sub net_coupling_and_evidence  sub net_coupling_and_evidence {
 {  
6805      my($self, $peg) = @_;      my($self, $peg) = @_;
6806      my $ua = LWP::UserAgent->new();      my @rawList = FIGRules::NetCouplingData('coupling_and_evidence', id1 => $peg);
6807      my $url = $FIG_Config::pch_server_url;      # The return is supposed to be a list of 3-tuples, where the third element is
6808      $url = "http://anno-2.nmpdr.org/simserver/perl/pchs.pl" if $url eq '';      # another list of 3-tuples. Instead, it comes back as n-tuples. We fix things
6809        # below.
6810      my $resp = $ua->post($url, { function => 'coupling_and_evidence', id1 => $peg });      my @retVal = ();
6811      if ($resp->is_success)      for my $rawTuple (@rawList) {
6812      {          my ($score, $p2, @rest) = @{$rawTuple};
         my @out;  
         my $dat = $resp->content;  
         while ($dat =~ /([^\n]+)\n/g)  
         {  
             my ($score, $p2, @rest) = split(/\t/, $1);  
6813              my @ev;              my @ev;
6814              while (my @x = splice(@rest, 0, 2))          while (my @x = splice(@rest, 0, 2)) {
             {  
6815                  push(@ev, \@x);                  push(@ev, \@x);
6816              }              }
6817              push(@out, [$score, $p2, \@ev]);          push(@retVal, [$score, $p2, \@ev]);
         }  
         return @out;  
     }  
     else  
     {  
         die "Failure retriving network coupling: " . $resp->content . "\n";  
6818      }      }
6819        return @retVal;
6820  }  }
6821    
6822  sub net_bbhs {  sub net_bbhs {
# Line 15569  Line 15571 
15571    
15572  sub subsystem_genomes :Scalar {  sub subsystem_genomes :Scalar {
15573      my($self,$ssa,$all) = @_;      my($self,$ssa,$all) = @_;
15574        my $fileName = "$FIG_Config::data/Subsystems/$ssa/spreadsheet";
15575        my $genomes = $self->readSpreadsheetForGenomes($fileName, $all);
15576        return $genomes;
15577    }
15578    
15579    =head3 readSpreadsheetForGenomes
15580    
15581    C<< my $genomeList = $fig->readSpreadsheetForGenomes($fileName, $all); >>
15582    
15583    Read the genomes from a specific subsystem file. This allows the client to get
15584    the genome data for a backup subsystem.
15585    
15586    =over 4
15587    
15588    =item fileName
15589    
15590    Name of the subsystem spreadsheet file.
15591    
15592    =item all
15593    
15594    If TRUE, all genomes will be read. Otherwise, only those genomes with a specific variant code
15595    (i.e. not 0 or -1) will be returned.
15596    
15597    =item RETURN
15598    
15599    Returns a reference to a list of 2-tuples, each consisting of a genome ID and the genome's name.
15600    
15601    =back
15602    
15603    =cut
15604    
15605    sub readSpreadsheetForGenomes {
15606        my ($self, $fileName, $all) = @_;
15607      my($genomes);      my($genomes);
15608    
     $ssa =~ s/[ \/]/_/g;  
15609      $genomes = [];      $genomes = [];
15610    
15611      if (open(SSA,"<$FIG_Config::data/Subsystems/$ssa/spreadsheet"))      if (open(SSA,"<$fileName"))
15612      {      {
15613          #          #
15614          # The spreadsheet appears to be of the form          # The spreadsheet appears to be of the form

Legend:
Removed from v.1.605  
changed lines
  Added in v.1.606

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3