[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.10, Fri Feb 25 18:41:45 2005 UTC revision 1.16, Fri Jun 24 21:45:45 2005 UTC
# Line 269  Line 269 
269  sub GetEntity {  sub GetEntity {
270          # Get the parameters.          # Get the parameters.
271          my ($self, $entityType, $ID) = @_;          my ($self, $entityType, $ID) = @_;
272          # Create a query.      # Call the ERDB method.
273          my $query = $self->Get([$entityType], "$entityType(id) = ?", [$ID]);      return $self->{_erdb}->GetEntity($entityType, $ID);
         # Get the first (and only) object.  
         my $retVal = $query->Fetch();  
         # Return the result.  
         return $retVal;  
274  }  }
275    
276  =head3 GetEntityValues  =head3 GetEntityValues
# Line 308  Line 304 
304  sub GetEntityValues {  sub GetEntityValues {
305          # Get the parameters.          # Get the parameters.
306          my ($self, $entityType, $ID, $fields) = @_;          my ($self, $entityType, $ID, $fields) = @_;
307          # Get the specified entity.      # Call the ERDB method.
308          my $entity = $self->GetEntity($entityType, $ID);      return $self->{_erdb}->GetEntityValues($entityType, $ID, $fields);
         # Declare the return list.  
         my @retVal = ();  
         # If we found the entity, push the values into the return list.  
         if ($entity) {  
                 push @retVal, $entity->Values($fields);  
         }  
         # Return the result.  
         return @retVal;  
309  }  }
310    
311  =head3 ShowMetaData  =head3 ShowMetaData
# Line 1070  Line 1058 
1058  C<< my %functions = $sprout->AllFunctionsOf($featureID); >>  C<< my %functions = $sprout->AllFunctionsOf($featureID); >>
1059    
1060  Return all of the functional assignments for a particular feature. The data is returned as a  Return all of the functional assignments for a particular feature. The data is returned as a
1061  hash of functional assignments to user IDs. A functional assignment is a type of annotation.  hash of functional assignments to user IDs. A functional assignment is a type of annotation,
1062  It has the format "XXXX\nset XXXX function to\nYYYYY". In this instance, XXXX is the user ID  Functional assignments are described in the L</ParseAssignment> function. Its worth noting that
1063  and YYYYY is the functional assignment text. Its worth noting that we cannot filter on the content  we cannot filter on the content of the annotation itself because it's a text field; however,
1064  of the annotation itself because it's a text field; however, this is not a big problem because most  this is not a big problem because most features only have a small number of annotations.
1065  features only have a small number of annotations. Finally, if a single user has multiple  Finally, if a single user has multiple functional assignments, we will only keep the most
1066  functional assignments, we will only keep the most recent one.  recent one.
1067    
1068  =over 4  =over 4
1069    
# Line 1109  Line 1097 
1097          # Get the annotation fields.          # Get the annotation fields.
1098          my ($timeStamp, $text) = @{$annotation};          my ($timeStamp, $text) = @{$annotation};
1099                  # Check to see if this is a functional assignment.                  # Check to see if this is a functional assignment.
1100                  my ($user, $function) = ParseAssignment($text);          my ($user, $function) = _ParseAssignment($text);
1101          if ($user && ! exists $timeHash{$user}) {          if ($user && ! exists $timeHash{$user}) {
1102              # Here it is a functional assignment and there has been no              # Here it is a functional assignment and there has been no
1103              # previous assignment for this user, so we stuff it in the              # previous assignment for this user, so we stuff it in the
# Line 1131  Line 1119 
1119    
1120  The functional assignment is handled differently depending on the type of feature. If  The functional assignment is handled differently depending on the type of feature. If
1121  the feature is identified by a FIG ID (begins with the string C<fig|>), then a functional  the feature is identified by a FIG ID (begins with the string C<fig|>), then a functional
1122  assignment is a type of annotation. It has the format "XXXX\nset XXXX function to\nYYYYY". In this  assignment is a type of annotation. The format of an assignment is described in
1123  instance, XXXX is the user ID and YYYYY is the functional assignment text. Its worth noting that  L</ParseLocation>. Its worth noting that we cannot filter on the content of the
1124  we cannot filter on the content of the annotation itself because it's a text field; however, this  annotation itself because it's a text field; however, this is not a big problem because
1125  is not a big problem because most features only have a small number of annotations.  most features only have a small number of annotations.
1126    
1127  Each user has an associated list of trusted users. The assignment returned will be the most  Each user has an associated list of trusted users. The assignment returned will be the most
1128  recent one by at least one of the trusted users. If no trusted user list is available, then  recent one by at least one of the trusted users. If no trusted user list is available, then
# Line 1203  Line 1191 
1191              # Get the annotation text.              # Get the annotation text.
1192              my ($text, $time) = $annotation->Values(['Annotation(annotation)','Annotation(time)']);              my ($text, $time) = $annotation->Values(['Annotation(annotation)','Annotation(time)']);
1193              # Check to see if this is a functional assignment for a trusted user.              # Check to see if this is a functional assignment for a trusted user.
1194              my ($user, $type, $function) = split(/\n/, $text);              my ($user, $function) = _ParseAssignment($text);
1195              if ($type =~ m/^set $user function to$/i) {              if ($user) {
1196                  # Here it is a functional assignment. Check the time and the user                  # Here it is a functional assignment. Check the time and the user
1197                  # name. The time must be recent and the user must be trusted.                  # name. The time must be recent and the user must be trusted.
1198                  if ((exists $trusteeTable{$user}) && ($time > $timeSelected)) {                  if ((exists $trusteeTable{$user}) && ($time > $timeSelected)) {
# Line 1242  Line 1230 
1230    
1231  =item RETURN  =item RETURN
1232    
1233  Returns a reference to a hash that maps the IDs of the incoming features to the IDs of  Returns a reference to a hash that maps the IDs of the incoming features to the best hits
1234  their best hits.  on the target genome.
1235    
1236  =back  =back
1237    
# Line 1271  Line 1259 
1259          return \%retVal;          return \%retVal;
1260  }  }
1261    
1262    =head3 SimList
1263    
1264    C<< my %similarities = $sprout->SimList($featureID, $count); >>
1265    
1266    Return a list of the similarities to the specified feature.
1267    
1268    Sprout does not support real similarities, so this method just returns the bidirectional
1269    best hits.
1270    
1271    =over 4
1272    
1273    =item featureID
1274    
1275    ID of the feature whose similarities are desired.
1276    
1277    =item count
1278    
1279    Maximum number of similar features to be returned, or C<0> to return them all.
1280    
1281    =back
1282    
1283    =cut
1284    #: Return Type %;
1285    sub SimList {
1286        # Get the parameters.
1287        my ($self, $featureID, $count) = @_;
1288        # Ask for the best hits.
1289        my @lists = $self->GetAll(['IsBidirectionalBestHitOf'],
1290                                  "IsBidirectionalBestHitOf(from-link) = ? ORDER BY IsBidirectionalBestHitOf(score) DESC",
1291                                  [$featureID], ['IsBidirectionalBestHitOf(to-link)', 'IsBidirectionalBestHitOf(score)'],
1292                                  $count);
1293        # Create the return value.
1294        my %retVal = ();
1295        for my $tuple (@lists) {
1296            $retVal{$tuple->[0]} = $tuple->[1];
1297        }
1298        # Return the result.
1299        return %retVal;
1300    }
1301    
1302    
1303    
1304    =head3 IsComplete
1305    
1306    C<< my $flag = $sprout->IsComplete($genomeID); >>
1307    
1308    Return TRUE if the specified genome is complete, else FALSE.
1309    
1310    =over 4
1311    
1312    =item genomeID
1313    
1314    ID of the genome whose completeness status is desired.
1315    
1316    =item RETURN
1317    
1318    Returns TRUE if the genome is complete, FALSE if it is incomplete, and C<undef> if it is
1319    not found.
1320    
1321    =back
1322    
1323    =cut
1324    #: Return Type $;
1325    sub IsComplete {
1326        # Get the parameters.
1327        my ($self, $genomeID) = @_;
1328        # Declare the return variable.
1329        my $retVal;
1330        # Get the genome's data.
1331        my $genomeData = $self->GetEntity('Genome', $genomeID);
1332        if ($genomeData) {
1333            # The genome exists, so get the completeness flag.
1334            ($retVal) = $genomeData->Value('complete');
1335        }
1336        # Return the result.
1337        return $retVal;
1338    }
1339    
1340  =head3 FeatureAliases  =head3 FeatureAliases
1341    
1342  C<< my @aliasList = $sprout->FeatureAliases($featureID); >>  C<< my @aliasList = $sprout->FeatureAliases($featureID); >>
# Line 1361  Line 1427 
1427  sub CoupledFeatures {  sub CoupledFeatures {
1428          # Get the parameters.          # Get the parameters.
1429          my ($self, $featureID) = @_;          my ($self, $featureID) = @_;
1430          # Create a query to retrieve the functionally-coupled features. Note that we depend on the      # Create a query to retrieve the functionally-coupled features.
1431          # fact that the functional coupling is physically paired. If (A,B) is in the database, then      my $query = $self->Get(['ParticipatesInCoupling', 'Coupling'],
1432          # (B,A) will also be found.                             "ParticipatesInCoupling(from-link) = ?", [$featureID]);
         my $query = $self->Get(['IsClusteredOnChromosomeWith'],  
                                                    "IsClusteredOnChromosomeWith(from-link) = ?", [$featureID]);  
1433          # This value will be set to TRUE if we find at least one coupled feature.          # This value will be set to TRUE if we find at least one coupled feature.
1434          my $found = 0;          my $found = 0;
1435          # Create the return hash.          # Create the return hash.
1436          my %retVal = ();          my %retVal = ();
1437          # Retrieve the relationship records and store them in the hash.          # Retrieve the relationship records and store them in the hash.
1438          while (my $clustering = $query->Fetch()) {          while (my $clustering = $query->Fetch()) {
1439                  my ($otherFeatureID, $score) = $clustering->Values(['IsClusteredOnChromosomeWith(to-link)',          # Get the ID and score of the coupling.
1440                                                                      'IsClusteredOnChromosomeWith(score)']);          my ($couplingID, $score) = $clustering->Values(['Coupling(id)',
1441                                                            'Coupling(score)']);
1442            # The coupling ID contains the two feature IDs separated by a space. We use
1443            # this information to find the ID of the other feature.
1444            my ($fid1, $fid2) = split / /, $couplingID;
1445            my $otherFeatureID = ($featureID eq $fid1 ? $fid2 : $fid1);
1446            # Attach the other feature's score to its ID.
1447                  $retVal{$otherFeatureID} = $score;                  $retVal{$otherFeatureID} = $score;
1448                  $found = 1;                  $found = 1;
1449          }          }
# Line 1386  Line 1456 
1456          return %retVal;          return %retVal;
1457  }  }
1458    
1459    =head3 CouplingEvidence
1460    
1461    C<< my @evidence = $sprout->CouplingEvidence($peg1, $peg2); >>
1462    
1463    Return the evidence for a functional coupling.
1464    
1465    A pair of features is considered evidence of a coupling between two other
1466    features if they occur close together on a contig and both are similar to
1467    the coupled features. So, if B<A1> and B<A2> are close together on a contig,
1468    B<B1> and B<B2> are considered evidence for the coupling if (1) B<B1> and
1469    B<B2> are close together, (2) B<B1> is similar to B<A1>, and (3) B<B2> is
1470    similar to B<A2>.
1471    
1472    The score of a coupling is determined by the number of pieces of evidence
1473    that are considered I<representative>. If several evidence items belong to
1474    a group of genomes that are close to each other, only one of those items
1475    is considered representative. The other evidence items are presumed to be
1476    there because of the relationship between the genomes rather than because
1477    the two proteins generated by the features have a related functionality.
1478    
1479    Each evidence item is returned as a three-tuple in the form C<[>I<$peg1a>C<,>
1480    I<$peg2a>C<,> I<$rep>C<]>, where I<$peg1a> is similar to I<$peg1>, I<$peg2a>
1481    is similar to I<$peg2>, and I<$rep> is TRUE if the evidence is representative
1482    and FALSE otherwise.
1483    
1484    =over 4
1485    
1486    =item peg1
1487    
1488    ID of the feature of interest.
1489    
1490    =item peg2
1491    
1492    ID of a feature functionally coupled to the feature of interest.
1493    
1494    =item RETURN
1495    
1496    Returns a list of 3-tuples. Each tuple consists of a feature similar to the feature
1497    of interest, a feature similar to the functionally coupled feature, and a flag
1498    that is TRUE for a representative piece of evidence and FALSE otherwise.
1499    
1500    =back
1501    
1502    =cut
1503    #: Return Type @@;
1504    sub CouplingEvidence {
1505        # Get the parameters.
1506        my ($self, $peg1, $peg2) = @_;
1507        # Declare the return variable.
1508        my @retVal = ();
1509        # Our first task is to find out the nature of the coupling.
1510        my ($couplingID, $inverted, $score) = $self->GetCoupling($peg1, $peg2);
1511        # Only proceed if a coupling exists.
1512        if ($couplingID) {
1513            # Determine the ordering to place on the evidence items. If we're
1514            # inverted, we want to see feature 2 before feature 1; otherwise,
1515            # we want the reverse.
1516            my $ordering = ($inverted ? "DESC" : "");
1517            # Get the coupling evidence.
1518            my @evidenceList = $self->GetAll(['IsEvidencedBy', 'PCH', 'UsesAsEvidence'],
1519                                              "IsEvidencedBy(from-link) = ? ORDER BY PCH(id), UsesAsEvidence(pos) $ordering",
1520                                              [$couplingID],
1521                                              ['PCH(used)', 'UsesAsEvidence(pos)']);
1522            # Loop through the evidence items. Each piece of evidence is represented by two
1523            # positions in the evidence list, one for each feature on the other side of the
1524            # evidence link. If at some point we want to generalize to couplings with
1525            # more than two positions, this section of code will need to be re-done.
1526            while (@evidenceList > 0) {
1527                my $peg1Data = shift @evidenceList;
1528                my $peg2Data = shift @evidenceList;
1529                push @retVal, [$peg1Data->[1], $peg2Data->[1], $peg1Data->[0]];
1530            }
1531        }
1532        # TODO: code
1533        # Return the result.
1534        return @retVal;
1535    }
1536    
1537    =head3 GetCoupling
1538    
1539    C<< my ($couplingID, $inverted, $score) = $sprout->GetCoupling($peg1, $peg2); >>
1540    
1541    Return the coupling (if any) for the specified pair of PEGs. If a coupling
1542    exists, we return the coupling ID along with an indicator of whether the
1543    coupling is stored as C<(>I<$peg1>C<, >I<$peg2>C<)> or C<(>I<$peg2>C<, >I<$peg1>C<)>.
1544    In the second case, we say the coupling is I<inverted>. The importance of an
1545    inverted coupling is that the PEGs in the evidence will appear in reverse order.
1546    
1547    =over 4
1548    
1549    =item peg1
1550    
1551    ID of the feature of interest.
1552    
1553    =item peg2
1554    
1555    ID of the potentially coupled feature.
1556    
1557    =item RETURN
1558    
1559    Returns a three-element list. The first element contains the database ID of
1560    the coupling. The second element is FALSE if the coupling is stored in the
1561    database in the caller specified order and TRUE if it is stored in the
1562    inverted order. The third element is the coupling's score. If the coupling
1563    does not exist, all three list elements will be C<undef>.
1564    
1565    =back
1566    
1567    =cut
1568    #: Return Type $%@;
1569    sub GetCoupling {
1570        # Get the parameters.
1571        my ($self, $peg1, $peg2) = @_;
1572        # Declare the return values. We'll start with the coupling ID and undefine the
1573        # flag and score until we have more information.
1574        my ($retVal, $inverted, $score) = (CouplingID($peg1, $peg2), undef, undef);
1575        # Find the coupling data.
1576        my @pegs = $self->GetAll(['Coupling', 'ParticipatesInCoupling'],
1577                                     "Coupling(id) = ? ORDER BY ParticipatesInCoupling(pos)",
1578                                     [$retVal], "ParticipatesInCoupling(from-link), Coupling(score)");
1579        # Check to see if we found anything.
1580        if (!@pegs) {
1581            # No coupling, so undefine the return value.
1582            $retVal = undef;
1583        } else {
1584            # We have a coupling! Get the score and check for inversion.
1585            $score = $pegs[0]->[1];
1586            $inverted = ($pegs[0]->[0] eq $peg1);
1587        }
1588        # Return the result.
1589        return ($retVal, $inverted, $score);
1590    }
1591    
1592    =head3 CouplingID
1593    
1594    C<< my $couplingID = Sprout::CouplingID($peg1, $peg2); >>
1595    
1596    Return the coupling ID for a pair of feature IDs.
1597    
1598    The coupling ID is currently computed by joining the feature IDs in
1599    sorted order with a space. Client modules (that is, modules which
1600    use Sprout) should not, however, count on this always being the
1601    case. This method provides a way for abstracting the concept of a
1602    coupling ID. All that we know for sure about it is that it can be
1603    generated easily from the feature IDs and the order of the IDs
1604    in the parameter list does not matter (i.e. C<CouplingID("a1", "b1")>
1605    will have the same value as C<CouplingID("b1", "a1")>.
1606    
1607    =over 4
1608    
1609    =item peg1
1610    
1611    First feature of interest.
1612    
1613    =item peg2
1614    
1615    Second feature of interest.
1616    
1617    =item RETURN
1618    
1619    Returns the ID that would be used to represent a functional coupling of
1620    the two specified PEGs.
1621    
1622    =back
1623    
1624    =cut
1625    #: Return Type $;
1626    sub CouplingID {
1627        return join " ", sort @_;
1628    }
1629    
1630  =head3 GetEntityTypes  =head3 GetEntityTypes
1631    
1632  C<< my @entityList = $sprout->GetEntityTypes(); >>  C<< my @entityList = $sprout->GetEntityTypes(); >>
# Line 1447  Line 1688 
1688                  if ($line =~ m/^>\s*(.+?)(\s|\n)/) {                  if ($line =~ m/^>\s*(.+?)(\s|\n)/) {
1689                          # 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.
1690                          if ($id) {                          if ($id) {
1691                                  $retVal{$id} = $sequence;                  $retVal{$id} = uc $sequence;
1692                          }                          }
1693                          # Clear the sequence accumulator and save the new ID.                          # Clear the sequence accumulator and save the new ID.
1694                          ($id, $sequence) = ("$prefix$1", "");                          ($id, $sequence) = ("$prefix$1", "");
1695                  } else {                  } else {
1696                          # 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.
1697                          # First, we get the actual data out.              # First, we get the actual data out. Note that we normalize to upper
1698                # case.
1699                          $line =~ /^\s*(.*?)(\s|\n)/;                          $line =~ /^\s*(.*?)(\s|\n)/;
1700                          $sequence .= $1;                          $sequence .= $1;
1701                  }                  }
1702          }          }
1703          # Flush out the last sequence (if any).          # Flush out the last sequence (if any).
1704          if ($sequence) {          if ($sequence) {
1705                  $retVal {$id} = $sequence;          $retVal{$id} = uc $sequence;
1706          }          }
1707        # Close the file.
1708        close FASTAFILE;
1709          # Return the hash constructed from the file.          # Return the hash constructed from the file.
1710          return %retVal;          return %retVal;
1711  }  }
# Line 1577  Line 1821 
1821  The next statement inserts a C<HasProperty> relationship between feature C<fig|158879.1.peg.1> and  The next statement inserts a C<HasProperty> relationship between feature C<fig|158879.1.peg.1> and
1822  property C<4> with an evidence URL of C<http://seedu.uchicago.edu/query.cgi?article_id=142>.  property C<4> with an evidence URL of C<http://seedu.uchicago.edu/query.cgi?article_id=142>.
1823    
1824  C<< $sprout->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence = 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >>  C<< $sprout->InsertObject('HasProperty', { 'from-link' => 'fig|158879.1.peg.1', 'to-link' => 4, evidence => 'http://seedu.uchicago.edu/query.cgi?article_id=142'}); >>
1825    
1826  =over 4  =over 4
1827    
# Line 1656  Line 1900 
1900    
1901  =head3 AssignFunction  =head3 AssignFunction
1902    
1903  C<< my $ok = $sprout->AssignFunction($featureID, $user, $function); >>  C<< my $ok = $sprout->AssignFunction($featureID, $user, $function, $assigningUser); >>
1904    
1905  This method assigns a function to a feature. Functions are a special type of annotation. The general  This method assigns a function to a feature. Functions are a special type of annotation. The general
1906  format is "XXXX\nset XXXX function to\nYYYYY" where XXXX is the feature type and YYYY is the functional  format is described in L</ParseAssignment>.
 assignment text.  
1907    
1908  =over 4  =over 4
1909    
# Line 1670  Line 1913 
1913    
1914  =item user  =item user
1915    
1916  Name of the user making the assignment. This is frequently a group name, like C<kegg> or C<fig>.  Name of the user group making the assignment, such as C<kegg> or C<fig>.
1917    
1918  =item function  =item function
1919    
1920  Text of the function being assigned.  Text of the function being assigned.
1921    
1922    =item assigningUser (optional)
1923    
1924    Name of the individual user making the assignment. If omitted, defaults to the user group.
1925    
1926  =item RETURN  =item RETURN
1927    
1928  Returns 1 if successful, 0 if an error occurred.  Returns 1 if successful, 0 if an error occurred.
# Line 1686  Line 1933 
1933  #: Return Type $;  #: Return Type $;
1934  sub AssignFunction {  sub AssignFunction {
1935          # Get the parameters.          # Get the parameters.
1936          my ($self, $featureID, $user, $function) = @_;      my ($self, $featureID, $user, $function, $assigningUser) = @_;
1937        # Default the assigning user.
1938        if (! $assigningUser) {
1939            $assigningUser = $user;
1940        }
1941          # Create an annotation string from the parameters.          # Create an annotation string from the parameters.
1942          my $annotationText = "$user\nset $user function to\n$function";      my $annotationText = "$assigningUser\nset $user function to\n$function";
1943          # Get the current time.          # Get the current time.
1944          my $now = time;          my $now = time;
1945          # Declare the return variable.          # Declare the return variable.
# Line 2181  Line 2432 
2432  sub SubsystemsOf {  sub SubsystemsOf {
2433          # Get the parameters.          # Get the parameters.
2434          my ($self, $featureID) = @_;          my ($self, $featureID) = @_;
2435          # Use the SSCell to connect features to subsystems.      # Get the subsystem list.
2436          my @subsystems = $self->GetAll(['ContainsFeature', 'HasSSCell', 'IsRoleOf'],          my @subsystems = $self->GetAll(['ContainsFeature', 'HasSSCell', 'IsRoleOf'],
2437                                                                          "ContainsFeature(to-link) = ?", [$featureID],                                                                          "ContainsFeature(to-link) = ?", [$featureID],
2438                                                                          ['HasSSCell(from-link)', 'IsRoleOf(from-link)']);                                                                          ['HasSSCell(from-link)', 'IsRoleOf(from-link)']);
# Line 2195  Line 2446 
2446          return %retVal;          return %retVal;
2447  }  }
2448    
2449    =head3 SubsystemList
2450    
2451    C<< my @subsystems = $sprout->SubsystemList($featureID); >>
2452    
2453    Return a list containing the names of the subsystems in which the specified
2454    feature participates. Unlike L</SubsystemsOf>, this method only returns the
2455    subsystem names, not the roles.
2456    
2457    =over 4
2458    
2459    =item featureID
2460    
2461    ID of the feature whose subsystem names are desired.
2462    
2463    =item RETURN
2464    
2465    Returns a list of the names of the subsystems in which the feature participates.
2466    
2467    =back
2468    
2469    =cut
2470    #: Return Type @;
2471    sub SubsystemList {
2472        # Get the parameters.
2473        my ($self, $featureID) = @_;
2474        # Get the list of names.
2475        my @retVal = $self->GetFlat(['ContainsFeature', 'HasSSCell'], "ContainsFeature(to-link) = ?",
2476                                    [$featureID], 'HasSSCell(from-link)');
2477        # Return the result.
2478        return @retVal;
2479    }
2480    
2481  =head3 RelatedFeatures  =head3 RelatedFeatures
2482    
2483  C<< my @relatedList = $sprout->RelatedFeatures($featureID, $function, $userID); >>  C<< my @relatedList = $sprout->RelatedFeatures($featureID, $function, $userID); >>
# Line 2355  Line 2638 
2638  sub GetAll {  sub GetAll {
2639          # Get the parameters.          # Get the parameters.
2640          my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_;          my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_;
2641          # Create the query.      # Call the ERDB method.
2642          my $query = $self->Get($objectNames, $filterClause, $parameterList);      my @retVal = $self->{_erdb}->GetAll($objectNames, $filterClause, $parameterList,
2643          # Set up a counter of the number of records read.                                          $fields, $count);
         my $fetched = 0;  
         # Insure the counter has a value.  
         if (!defined $count) {  
                 $count = 0;  
         }  
         # Loop through the records returned, extracting the fields. Note that if the  
         # counter is non-zero, we stop when the number of records read hits the count.  
         my @retVal = ();  
         while (($count == 0 || $fetched < $count) && (my $row = $query->Fetch())) {  
                 my @rowData = $row->Values($fields);  
                 push @retVal, \@rowData;  
                 $fetched++;  
         }  
2644          # Return the resulting list.          # Return the resulting list.
2645          return @retVal;          return @retVal;
2646  }  }
# Line 2631  Line 2901 
2901  =head3 ParseAssignment  =head3 ParseAssignment
2902    
2903  Parse annotation text to determine whether or not it is a functional assignment. If it is,  Parse annotation text to determine whether or not it is a functional assignment. If it is,
2904  the user and function text will be returned as a 2-element list. If it isn't, an empty list  the user, function text, and assigning user will be returned as a 3-element list. If it
2905  will be returned.  isn't, an empty list will be returned.
2906    
2907    A functional assignment is always of the form
2908    
2909        I<XXXX>C<\nset >I<YYYY>C< function to\n>I<ZZZZZ>
2910    
2911    where I<XXXX> is the B<assigning user>, I<YYYY> is the B<user>, and I<ZZZZ> is the
2912    actual functional role. In most cases, the user and the assigning user will be the
2913    same, but that is not always the case.
2914    
2915  This is a static method.  This is a static method.
2916    
# Line 2651  Line 2929 
2929    
2930  =cut  =cut
2931    
2932  sub ParseAssignment {  sub _ParseAssignment {
2933          # Get the parameters.          # Get the parameters.
2934          my ($text) = @_;          my ($text) = @_;
2935          # Declare the return value.          # Declare the return value.
2936          my @retVal = ();          my @retVal = ();
2937          # Check to see if this is a functional assignment.          # Check to see if this is a functional assignment.
2938          my ($user, $type, $function) = split(/\n/, $text);          my ($user, $type, $function) = split(/\n/, $text);
2939          if ($type =~ m/^set $user function to$/i) {      if ($type =~ m/^set ([^ ]+) function to$/i) {
2940                  # Here it is, so we return the user name and function text.          # Here it is, so we return the user name (which is in $1), the functional role text,
2941                  @retVal = ($user, $function);          # and the assigning user.
2942            @retVal = ($1, $function, $user);
2943          }          }
2944          # Return the result list.          # Return the result list.
2945          return @retVal;          return @retVal;
# Line 2692  Line 2971 
2971      return $retVal;      return $retVal;
2972  }  }
2973    
2974    =head3 AddProperty
2975    
2976    C<< my  = $sprout->AddProperty($featureID, $key, $value, $url); >>
2977    
2978    Add a new attribute value (Property) to a feature. In the SEED system, attributes can
2979    be added to almost any object. In Sprout, they can only be added to features. In
2980    Sprout, attributes are implemented using I<properties>. A property represents a key/value
2981    pair. If the particular key/value pair coming in is not already in the database, a new
2982    B<Property> record is created to hold it.
2983    
2984    =over 4
2985    
2986    =item peg
2987    
2988    ID of the feature to which the attribute is to be replied.
2989    
2990    =item key
2991    
2992    Name of the attribute (key).
2993    
2994    =item value
2995    
2996    Value of the attribute.
2997    
2998    =item url
2999    
3000    URL or text citation from which the property was obtained.
3001    
3002    =back
3003    
3004    =cut
3005    #: Return Type ;
3006    sub AddProperty {
3007        # Get the parameters.
3008        my ($self, $featureID, $key, $value, $url) = @_;
3009        # Declare the variable to hold the desired property ID.
3010        my $propID;
3011        # Attempt to find a property record for this key/value pair.
3012        my @properties = $self->GetFlat(['Property'],
3013                                       "Property(property-name) = ? AND Property(property-value) = ?",
3014                                       [$key, $value], 'Property(id)');
3015        if (@properties) {
3016            # Here the property is already in the database. We save its ID.
3017            $propID = $properties[0];
3018            # Here the property value does not exist. We need to generate an ID. It will be set
3019            # to a number one greater than the maximum value in the database. This call to
3020            # GetAll will stop after one record.
3021            my @maxProperty = $self->GetAll(['Property'], "ORDER BY Property(id) DESC", [], ['Property(id)'],
3022                                            1);
3023            $propID = $maxProperty[0]->[0] + 1;
3024            # Insert the new property value.
3025            $self->Insert('Property', { 'property-name' => $key, 'property-value' => $value, id => $propID });
3026        }
3027        # Now we connect the incoming feature to the property.
3028        $self->Insert('HasProperty', { 'from-link' => $featureID, 'to-link' => $propID, evidence => $url });
3029    }
3030    
3031  1;  1;

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.16

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3