[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.24, Sun Sep 11 17:08:59 2005 UTC revision 1.36, Wed Sep 14 13:52:34 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 615  Line 622 
622          }          }
623          # Remember this specifier for the adjacent-segment test the next time through.          # Remember this specifier for the adjacent-segment test the next time through.
624          ($prevContig, $prevBeg, $prevDir, $prevLen) = ($contigID, $beg, $dir, $len);          ($prevContig, $prevBeg, $prevDir, $prevLen) = ($contigID, $beg, $dir, $len);
625            # Compute the initial base pair.
626            my $start = ($dir eq "+" ? $beg : $beg + $len - 1);
627          # Add the specifier to the list.          # Add the specifier to the list.
628          push @retVal, "${contigID}_$beg$dir$len";          push @retVal, "${contigID}_$start$dir$len";
629      }      }
630      # Return the list in the format indicated by the context.      # Return the list in the format indicated by the context.
631      return (wantarray ? @retVal : join(',', @retVal));      return (wantarray ? @retVal : join(',', @retVal));
# Line 758  Line 767 
767          # the start point is the ending. Note that in the latter case we must reverse the DNA string          # the start point is the ending. Note that in the latter case we must reverse the DNA string
768          # before putting it in the return value.          # before putting it in the return value.
769          my ($start, $stop);          my ($start, $stop);
770            Trace("Parse of \"$location\" is $beg$dir$len.") if T(SDNA => 4);
771          if ($dir eq "+") {          if ($dir eq "+") {
772              $start = $beg;              $start = $beg;
773              $stop = $beg + $len - 1;              $stop = $beg + $len;
774          } else {          } else {
775              $start = $beg + $len + 1;              $start = $beg - $len;
776              $stop = $beg;              $stop = $beg + 1;
777          }          }
778            Trace("Looking for sequences containing $start to $stop.") if T(SDNA => 4);
779          my $query = $self->Get(['IsMadeUpOf','Sequence'],          my $query = $self->Get(['IsMadeUpOf','Sequence'],
780              "IsMadeUpOf(from-link) = ? AND IsMadeUpOf(start-position) + IsMadeUpOf(len) > ? AND " .              "IsMadeUpOf(from-link) = ? AND IsMadeUpOf(start-position) + IsMadeUpOf(len) > ? AND " .
781              " IsMadeUpOf(start-position) <= ? ORDER BY IsMadeUpOf(start-position)",              " IsMadeUpOf(start-position) < ? ORDER BY IsMadeUpOf(start-position)",
782              [$contigID, $start, $stop]);              [$contigID, $start, $stop]);
783          # Loop through the sequences.          # Loop through the sequences.
784          while (my $sequence = $query->Fetch()) {          while (my $sequence = $query->Fetch()) {
# Line 776  Line 787 
787                  $sequence->Values(['IsMadeUpOf(start-position)', 'Sequence(sequence)',                  $sequence->Values(['IsMadeUpOf(start-position)', 'Sequence(sequence)',
788                                     'IsMadeUpOf(len)']);                                     'IsMadeUpOf(len)']);
789              my $stopPosition = $startPosition + $sequenceLength;              my $stopPosition = $startPosition + $sequenceLength;
790                Trace("Sequence is from $startPosition to $stopPosition.") if T(SDNA => 4);
791              # Figure out the start point and length of the relevant section.              # Figure out the start point and length of the relevant section.
792              my $pos1 = ($start < $startPosition ? 0 : $start - $startPosition);              my $pos1 = ($start < $startPosition ? 0 : $start - $startPosition);
793              my $len = ($stopPosition <= $stop ? $stopPosition : $stop) - $startPosition - $pos1;              my $len1 = ($stopPosition <= $stop ? $stopPosition : $stop) - $startPosition - $pos1;
794                Trace("Position is $pos1 for length $len1.") if T(SDNA => 4);
795              # Add the relevant data to the location data.              # Add the relevant data to the location data.
796              $locationDNA .= substr($sequenceData, $pos1, $len);              $locationDNA .= substr($sequenceData, $pos1, $len1);
797          }          }
798          # Add this location's data to the return string. Note that we may need to reverse it.          # Add this location's data to the return string. Note that we may need to reverse it.
799          if ($dir eq '+') {          if ($dir eq '+') {
800              $retVal .= $locationDNA;              $retVal .= $locationDNA;
801          } else {          } else {
802              $locationDNA = join('', reverse split //, $locationDNA);              $retVal .= FIG::reverse_comp($locationDNA);
             $retVal .= $locationDNA;  
803          }          }
804      }      }
805      # Return the result.      # Return the result.
# Line 2041  Line 2053 
2053      # Get the parameters.      # Get the parameters.
2054      my ($self, $entityName, $entityID) = @_;      my ($self, $entityName, $entityID) = @_;
2055      # Check for the entity instance.      # Check for the entity instance.
2056        Trace("Checking existence of $entityName with ID=$entityID.") if T(4);
2057      my $testInstance = $self->GetEntity($entityName, $entityID);      my $testInstance = $self->GetEntity($entityName, $entityID);
2058      # Return an existence indicator.      # Return an existence indicator.
2059      my $retVal = ($testInstance ? 1 : 0);      my $retVal = ($testInstance ? 1 : 0);

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.36

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3