[Bio] / Sprout / Sprout.pm Repository:
ViewVC logotype

Diff of /Sprout/Sprout.pm

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

revision 1.22, Fri Sep 9 21:10:46 2005 UTC revision 1.26, Tue Sep 13 18:33:20 2005 UTC
# Line 70  Line 70 
70    
71  * B<maxSequenceLength> maximum number of residues per sequence, (default C<8000>)  * B<maxSequenceLength> maximum number of residues per sequence, (default C<8000>)
72    
73    * B<noDBOpen> suppresses the connection to the database if TRUE, else FALSE
74    
75  =back  =back
76    
77  For example, the following constructor call specifies a database named I<Sprout> and a user name of  For example, the following constructor call specifies a database named I<Sprout> and a user name of
# Line 98  Line 100 
100                                                          # database connection port                                                          # database connection port
101                         maxSegmentLength => 4500,        # maximum feature segment length                         maxSegmentLength => 4500,        # maximum feature segment length
102                         maxSequenceLength => 8000,       # maximum contig sequence length                         maxSequenceLength => 8000,       # maximum contig sequence length
103                           noDBOpen     => 0,               # 1 to suppress the database open
104                        }, $options);                        }, $options);
105      # Get the data directory.      # Get the data directory.
106      my $dataDir = $optionTable->{dataDir};      my $dataDir = $optionTable->{dataDir};
# Line 105  Line 108 
108      $optionTable->{userData} =~ m!([^/]*)/(.*)$!;      $optionTable->{userData} =~ m!([^/]*)/(.*)$!;
109      my ($userName, $password) = ($1, $2);      my ($userName, $password) = ($1, $2);
110      # Connect to the database.      # Connect to the database.
111      my $dbh = DBKernel->new($optionTable->{dbType}, $dbName, $userName, $password, $optionTable->{port});      my $dbh;
112        if (! $optionTable->{noDBOpen}) {
113            $dbh = DBKernel->new($optionTable->{dbType}, $dbName, $userName,
114                                    $password, $optionTable->{port});
115        }
116      # Create the ERDB object.      # Create the ERDB object.
117      my $xmlFileName = "$optionTable->{xmlFileName}";      my $xmlFileName = "$optionTable->{xmlFileName}";
118      my $erdb = ERDB->new($dbh, $xmlFileName);      my $erdb = ERDB->new($dbh, $xmlFileName);
# Line 1588  Line 1595 
1595                                   [$retVal], ["ParticipatesInCoupling(from-link)", "Coupling(score)"]);                                   [$retVal], ["ParticipatesInCoupling(from-link)", "Coupling(score)"]);
1596      # Check to see if we found anything.      # Check to see if we found anything.
1597      if (!@pegs) {      if (!@pegs) {
1598            Trace("No coupling found.") if T(Coupling => 4);
1599          # No coupling, so undefine the return value.          # No coupling, so undefine the return value.
1600          $retVal = undef;          $retVal = undef;
1601      } else {      } else {
1602          # We have a coupling! Get the score and check for inversion.          # We have a coupling! Get the score and check for inversion.
1603          $score = $pegs[0]->[1];          $score = $pegs[0]->[1];
1604          $inverted = ($pegs[0]->[0] eq $peg1);          my $firstFound = $pegs[0]->[0];
1605            $inverted = ($firstFound ne $peg1);
1606            Trace("Coupling score is $score. First peg is $firstFound, peg 1 is $peg1.") if T(Coupling => 4);
1607      }      }
1608      # Return the result.      # Return the result.
1609      return ($retVal, $inverted, $score);      return ($retVal, $inverted, $score);
# Line 1698  Line 1708 
1708          if ($line =~ m/^>\s*(.+?)(\s|\n)/) {          if ($line =~ m/^>\s*(.+?)(\s|\n)/) {
1709              # Here we have a new header. Store the current sequence if we have one.              # Here we have a new header. Store the current sequence if we have one.
1710              if ($id) {              if ($id) {
1711                  $retVal{$id} = uc $sequence;                  $retVal{$id} = lc $sequence;
1712              }              }
1713              # Clear the sequence accumulator and save the new ID.              # Clear the sequence accumulator and save the new ID.
1714              ($id, $sequence) = ("$prefix$1", "");              ($id, $sequence) = ("$prefix$1", "");
1715          } else {          } else {
1716              # Here we have a data line, so we add it to the sequence accumulator.              # Here we have a data line, so we add it to the sequence accumulator.
1717              # First, we get the actual data out. Note that we normalize to upper              # First, we get the actual data out. Note that we normalize to lower
1718              # case.              # case.
1719              $line =~ /^\s*(.*?)(\s|\n)/;              $line =~ /^\s*(.*?)(\s|\n)/;
1720              $sequence .= $1;              $sequence .= $1;
# Line 1712  Line 1722 
1722      }      }
1723      # Flush out the last sequence (if any).      # Flush out the last sequence (if any).
1724      if ($sequence) {      if ($sequence) {
1725          $retVal{$id} = uc $sequence;          $retVal{$id} = lc $sequence;
1726      }      }
1727      # Close the file.      # Close the file.
1728      close FASTAFILE;      close FASTAFILE;
# Line 2038  Line 2048 
2048      # Get the parameters.      # Get the parameters.
2049      my ($self, $entityName, $entityID) = @_;      my ($self, $entityName, $entityID) = @_;
2050      # Check for the entity instance.      # Check for the entity instance.
2051        Trace("Checking existence of $entityName with ID=$entityID.") if T(4);
2052      my $testInstance = $self->GetEntity($entityName, $entityID);      my $testInstance = $self->GetEntity($entityName, $entityID);
2053      # Return an existence indicator.      # Return an existence indicator.
2054      my $retVal = ($testInstance ? 1 : 0);      my $retVal = ($testInstance ? 1 : 0);

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.26

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3