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

Diff of /Sprout/ERDB.pm

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

revision 1.77, Mon Nov 20 05:53:02 2006 UTC revision 1.84, Wed Jan 24 10:22:22 2007 UTC
# Line 257  Line 257 
257    
258  =back  =back
259    
260  The B<Index>, B<FromIndex>, and B<ToIndex> tags themselves have no attributes.  The B<FromIndex>, and B<ToIndex> tags have no attributes. The B<Index> tag can
261    have a B<Unique> attribute. If specified, the index will be generated as a unique
262    index.
263    
264  =head3 Object and Field Names  =head3 Object and Field Names
265    
# Line 394  Line 396 
396                   );                   );
397    
398  my %XmlInOpts  = (  my %XmlInOpts  = (
399                    ForceArray => ['Field', 'Index', 'IndexField'],                    ForceArray => ['Field', 'Index', 'IndexField', 'Relationship', 'Entity'],
400                    ForceContent => 1,                    ForceContent => 1,
401                    NormalizeSpace => 2,                    NormalizeSpace => 2,
402                   );                   );
# Line 546  Line 548 
548          if (my $notes = $entityData->{Notes}) {          if (my $notes = $entityData->{Notes}) {
549              $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n";              $retVal .= "<p>" . HTMLNote($notes->{content}) . "</p>\n";
550          }          }
551          # Now we want a list of the entity's relationships. First, we set up the relationship subsection.          # See if we need a list of the entity's relationships.
552            my $relCount = keys %{$relationshipList};
553            if ($relCount > 0) {
554                # First, we set up the relationship subsection.
555          $retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n";          $retVal .= "<h4>Relationships for <b>$key</b></h4>\n<ul>\n";
556          # Loop through the relationships.          # Loop through the relationships.
557          for my $relationship (sort keys %{$relationshipList}) {          for my $relationship (sort keys %{$relationshipList}) {
# Line 562  Line 567 
567          }          }
568          # Close off the relationship list.          # Close off the relationship list.
569          $retVal .= "</ul>\n";          $retVal .= "</ul>\n";
570            }
571          # Get the entity's relations.          # Get the entity's relations.
572          my $relationList = $entityData->{Relations};          my $relationList = $entityData->{Relations};
573          # Create a header for the relation subsection.          # Create a header for the relation subsection.
# Line 966  Line 972 
972          my @rawFields = @{$indexData->{IndexFields}};          my @rawFields = @{$indexData->{IndexFields}};
973          # Get a hash of the relation's field types.          # Get a hash of the relation's field types.
974          my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}};          my %types = map { $_->{name} => $_->{type} } @{$relationData->{Fields}};
975          # We need to check for text fields. We need a append a length limitation for them. To do          # We need to check for text fields so we can append a length limitation for them. To do
976          # that, we need the relation's field list.          # that, we need the relation's field list.
977          my $relFields = $relationData->{Fields};          my $relFields = $relationData->{Fields};
978          for (my $i = 0; $i <= $#rawFields; $i++) {          for (my $i = 0; $i <= $#rawFields; $i++) {
# Line 1418  Line 1424 
1424      return $retVal;      return $retVal;
1425  }  }
1426    
1427    
1428    
1429  =head3 Search  =head3 Search
1430    
1431  C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >>  C<< my $query = $erdb->Search($searchExpression, $idx, \@objectNames, $filterClause, \@params); >>
# Line 1489  Line 1497 
1497          my $actualKeywords = $self->CleanKeywords($searchExpression);          my $actualKeywords = $self->CleanKeywords($searchExpression);
1498          # Prefix a "+" to each uncontrolled word. This converts the default          # Prefix a "+" to each uncontrolled word. This converts the default
1499          # search mode from OR to AND.          # search mode from OR to AND.
1500          $actualKeywords =~ s/(^|\s)(\w)/$1\+$2/g;          $actualKeywords =~ s/(^|\s)(\w|")/$1\+$2/g;
1501          Trace("Actual keywords for search are\n$actualKeywords") if T(3);          Trace("Actual keywords for search are\n$actualKeywords") if T(3);
1502          # We need two match expressions, one for the filter clause and one in the          # We need two match expressions, one for the filter clause and one in the
1503          # query itself. Both will use a parameter mark, so we need to push the          # query itself. Both will use a parameter mark, so we need to push the
# Line 1612  Line 1620 
1620    
1621  =head3 Delete  =head3 Delete
1622    
1623  C<< my $stats = $erdb->Delete($entityName, $objectID, $testFlag); >>  C<< my $stats = $erdb->Delete($entityName, $objectID, %options); >>
1624    
1625  Delete an entity instance from the database. The instance is deleted along with all entity and  Delete an entity instance from the database. The instance is deleted along with all entity and
1626  relationship instances dependent on it. The definition of I<dependence> is recursive.  relationship instances dependent on it. The definition of I<dependence> is recursive.
# Line 1632  Line 1640 
1640  ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>),  ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>),
1641  then it is presumed to by a LIKE pattern.  then it is presumed to by a LIKE pattern.
1642    
1643  =item testFlag  =item options
1644    
1645  If TRUE, the delete statements will be traced without being executed.  A hash detailing the options for this delete operation.
1646    
1647  =item RETURN  =item RETURN
1648    
# Line 1643  Line 1651 
1651    
1652  =back  =back
1653    
1654    The permissible options for this method are as follows.
1655    
1656    =over 4
1657    
1658    =item testMode
1659    
1660    If TRUE, then the delete statements will be traced, but no changes will be made to the database.
1661    
1662    =item keepRoot
1663    
1664    If TRUE, then the entity instances will not be deleted, only the dependent records.
1665    
1666    =back
1667    
1668  =cut  =cut
1669  #: Return Type $%;  #: Return Type $%;
1670  sub Delete {  sub Delete {
1671      # Get the parameters.      # Get the parameters.
1672      my ($self, $entityName, $objectID, $testFlag) = @_;      my ($self, $entityName, $objectID, %options) = @_;
1673      # Declare the return variable.      # Declare the return variable.
1674      my $retVal = Stats->new();      my $retVal = Stats->new();
1675      # Get the DBKernel object.      # Get the DBKernel object.
# Line 1664  Line 1686 
1686      # FROM-relationships and entities.      # FROM-relationships and entities.
1687      my @fromPathList = ();      my @fromPathList = ();
1688      my @toPathList = ();      my @toPathList = ();
1689      # This final hash is used to remember what work still needs to be done. We push paths      # This final list is used to remember what work still needs to be done. We push paths
1690      # onto the list, then pop them off to extend the paths. We prime it with the starting      # onto the list, then pop them off to extend the paths. We prime it with the starting
1691      # point. Note that we will work hard to insure that the last item on a path in the      # point. Note that we will work hard to insure that the last item on a path in the
1692      # to-do list is always an entity.      # to-do list is always an entity.
# Line 1675  Line 1697 
1697          # Copy it into a list.          # Copy it into a list.
1698          my @stackedPath = @{$current};          my @stackedPath = @{$current};
1699          # Pull off the last item on the path. It will always be an entity.          # Pull off the last item on the path. It will always be an entity.
1700          my $entityName = pop @stackedPath;          my $myEntityName = pop @stackedPath;
1701          # Add it to the alreadyFound list.          # Add it to the alreadyFound list.
1702          $alreadyFound{$entityName} = 1;          $alreadyFound{$myEntityName} = 1;
1703            # Figure out if we need to delete this entity.
1704            if ($myEntityName ne $entityName || ! $options{keepRoot}) {
1705          # Get the entity data.          # Get the entity data.
1706          my $entityData = $self->_GetStructure($entityName);              my $entityData = $self->_GetStructure($myEntityName);
1707          # The first task is to loop through the entity's relation. A DELETE command will              # Loop through the entity's relations. A DELETE command will be needed for each of them.
         # be needed for each of them.  
1708          my $relations = $entityData->{Relations};          my $relations = $entityData->{Relations};
1709          for my $relation (keys %{$relations}) {          for my $relation (keys %{$relations}) {
1710              my @augmentedList = (@stackedPath, $relation);              my @augmentedList = (@stackedPath, $relation);
1711              push @fromPathList, \@augmentedList;              push @fromPathList, \@augmentedList;
1712          }          }
1713            }
1714          # Now we need to look for relationships connected to this entity.          # Now we need to look for relationships connected to this entity.
1715          my $relationshipList = $self->{_metaData}->{Relationships};          my $relationshipList = $self->{_metaData}->{Relationships};
1716          for my $relationshipName (keys %{$relationshipList}) {          for my $relationshipName (keys %{$relationshipList}) {
1717              my $relationship = $relationshipList->{$relationshipName};              my $relationship = $relationshipList->{$relationshipName};
1718              # Check the FROM field. We're only interested if it's us.              # Check the FROM field. We're only interested if it's us.
1719              if ($relationship->{from} eq $entityName) {              if ($relationship->{from} eq $myEntityName) {
1720                  # Add the path to this relationship.                  # Add the path to this relationship.
1721                  my @augmentedList = (@stackedPath, $entityName, $relationshipName);                  my @augmentedList = (@stackedPath, $myEntityName, $relationshipName);
1722                  push @fromPathList, \@augmentedList;                  push @fromPathList, \@augmentedList;
1723                  # Check the arity. If it's MM we're done. If it's 1M                  # Check the arity. If it's MM we're done. If it's 1M
1724                  # and the target hasn't been seen yet, we want to                  # and the target hasn't been seen yet, we want to
# Line 1713  Line 1737 
1737              }              }
1738              # Now check the TO field. In this case only the relationship needs              # Now check the TO field. In this case only the relationship needs
1739              # deletion.              # deletion.
1740              if ($relationship->{to} eq $entityName) {              if ($relationship->{to} eq $myEntityName) {
1741                  my @augmentedList = (@stackedPath, $entityName, $relationshipName);                  my @augmentedList = (@stackedPath, $myEntityName, $relationshipName);
1742                  push @toPathList, \@augmentedList;                  push @toPathList, \@augmentedList;
1743              }              }
1744          }          }
1745      }      }
1746      # Create the first qualifier for the WHERE clause. This selects the      # Create the first qualifier for the WHERE clause. This selects the
1747      # keys of the primary entity records to be deleted. When we're deleting      # keys of the primary entity records to be deleted. When we're deleting
1748      # from a dependent table, we construct a join page from the first qualifier      # from a dependent table, we construct a join path from the first qualifier
1749      # to the table containing the dependent records to delete.      # to the table containing the dependent records to delete.
1750      my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");      my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");
1751      # We need to make two passes. The first is through the to-list, and      # We need to make two passes. The first is through the to-list, and
# Line 1760  Line 1784 
1784                  }                  }
1785              }              }
1786              # Now we have our desired DELETE statement.              # Now we have our desired DELETE statement.
1787              if ($testFlag) {              if ($options{testMode}) {
1788                  # Here the user wants to trace without executing.                  # Here the user wants to trace without executing.
1789                  Trace($stmt) if T(0);                  Trace($stmt) if T(0);
1790              } else {              } else {
# Line 1779  Line 1803 
1803      return $retVal;      return $retVal;
1804  }  }
1805    
1806    =head3 Disconnect
1807    
1808    C<< $erdb->Disconnect($relationshipName, $originEntityName, $originEntityID); >>
1809    
1810    Disconnect an entity instance from all the objects to which it is related. This
1811    will delete each relationship instance that connects to the specified entity.
1812    
1813    =over 4
1814    
1815    =item relationshipName
1816    
1817    Name of the relationship whose instances are to be deleted.
1818    
1819    =item originEntityName
1820    
1821    Name of the entity that is to be disconnected.
1822    
1823    =item originEntityID
1824    
1825    ID of the entity that is to be disconnected.
1826    
1827    =back
1828    
1829    =cut
1830    
1831    sub Disconnect {
1832        # Get the parameters.
1833        my ($self, $relationshipName, $originEntityName, $originEntityID) = @_;
1834        # Get the relationship descriptor.
1835        my $structure = $self->_GetStructure($relationshipName);
1836        # Insure we have a relationship.
1837        if (! exists $structure->{from}) {
1838            Confess("$relationshipName is not a relationship in the database.");
1839        } else {
1840            # Get the database handle.
1841            my $dbh = $self->{_dbh};
1842            # We'll set this value to 1 if we find our entity.
1843            my $found = 0;
1844            # Loop through the ends of the relationship.
1845            for my $dir ('from', 'to') {
1846                if ($structure->{$dir} eq $originEntityName) {
1847                    # Delete all relationship instances on this side of the entity instance.
1848                    Trace("Disconnecting in $dir direction with ID \"$originEntityID\".");
1849                    $dbh->SQL("DELETE FROM $relationshipName WHERE ${dir}_link = ?", 0, $originEntityID);
1850                    $found = 1;
1851                }
1852            }
1853            # Insure we found the entity on at least one end.
1854            if (! $found) {
1855                Confess("Entity \"$originEntityName\" does not use $relationshipName.");
1856            }
1857        }
1858    }
1859    
1860    =head3 DeleteRow
1861    
1862    C<< $erdb->DeleteRow($relationshipName, $fromLink, $toLink, \%values); >>
1863    
1864    Delete a row from a relationship. In most cases, only the from-link and to-link are
1865    needed; however, for relationships with intersection data values can be specified
1866    for the other fields using a hash.
1867    
1868    =over 4
1869    
1870    =item relationshipName
1871    
1872    Name of the relationship from which the row is to be deleted.
1873    
1874    =item fromLink
1875    
1876    ID of the entity instance in the From direction.
1877    
1878    =item toLink
1879    
1880    ID of the entity instance in the To direction.
1881    
1882    =item values
1883    
1884    Reference to a hash of other values to be used for filtering the delete.
1885    
1886    =back
1887    
1888    =cut
1889    
1890    sub DeleteRow {
1891        # Get the parameters.
1892        my ($self, $relationshipName, $fromLink, $toLink, $values) = @_;
1893        # Create a hash of all the filter information.
1894        my %filter = ('from-link' => $fromLink, 'to-link' => $toLink);
1895        if (defined $values) {
1896            for my $key (keys %{$values}) {
1897                $filter{$key} = $values->{$key};
1898            }
1899        }
1900        # Build an SQL statement out of the hash.
1901        my @filters = ();
1902        my @parms = ();
1903        for my $key (keys %filter) {
1904            push @filters, _FixName($key) . " = ?";
1905            push @parms, $filter{$key};
1906        }
1907        Trace("Parms for delete row are " . join(", ", map { "\"$_\"" } @parms) . ".") if T(SQL => 4);
1908        my $command = "DELETE FROM $relationshipName WHERE " .
1909                      join(" AND ", @filters);
1910        # Execute it.
1911        my $dbh = $self->{_dbh};
1912        $dbh->SQL($command, undef, @parms);
1913    }
1914    
1915  =head3 SortNeeded  =head3 SortNeeded
1916    
1917  C<< my $parms = $erdb->SortNeeded($relationName); >>  C<< my $parms = $erdb->SortNeeded($relationName); >>
# Line 2175  Line 2308 
2308    
2309  =head3 InsertObject  =head3 InsertObject
2310    
2311  C<< my $ok = $erdb->InsertObject($objectType, \%fieldHash); >>  C<< $erdb->InsertObject($objectType, \%fieldHash); >>
2312    
2313  Insert an object into the database. The object is defined by a type name and then a hash  Insert an object into the database. The object is defined by a type name and then a hash
2314  of field names to values. Field values in the primary relation are represented by scalars.  of field names to values. Field values in the primary relation are represented by scalars.
# Line 2201  Line 2334 
2334    
2335  Hash of field names to values.  Hash of field names to values.
2336    
 =item RETURN  
   
 Returns 1 if successful, 0 if an error occurred.  
   
2337  =back  =back
2338    
2339  =cut  =cut
# Line 2303  Line 2432 
2432                  $retVal = $sth->execute(@parameterList);                  $retVal = $sth->execute(@parameterList);
2433                  if (!$retVal) {                  if (!$retVal) {
2434                      my $errorString = $sth->errstr();                      my $errorString = $sth->errstr();
2435                      Trace("Insert error: $errorString.") if T(0);                      Confess("Error inserting into $relationName: $errorString");
2436                  }                  }
2437              }              }
2438          }          }
2439      }      }
2440      # Return the success indicator.      # Return a 1 for backward compatability.
2441      return $retVal;      return 1;
2442    }
2443    
2444    =head3 UpdateEntity
2445    
2446    C<< $erdb->UpdateEntity($entityName, $id, \%fields); >>
2447    
2448    Update the values of an entity. This is an unprotected update, so it should only be
2449    done if the database resides on a database server.
2450    
2451    =over 4
2452    
2453    =item entityName
2454    
2455    Name of the entity to update. (This is the entity type.)
2456    
2457    =item id
2458    
2459    ID of the entity to update. If no entity exists with this ID, an error will be thrown.
2460    
2461    =item fields
2462    
2463    Reference to a hash mapping field names to their new values. All of the fields named
2464    must be in the entity's primary relation, and they cannot any of them be the ID field.
2465    
2466    =back
2467    
2468    =cut
2469    
2470    sub UpdateEntity {
2471        # Get the parameters.
2472        my ($self, $entityName, $id, $fields) = @_;
2473        # Get a list of the field names being updated.
2474        my @fieldList = keys %{$fields};
2475        # Verify that the fields exist.
2476        my $checker = $self->GetFieldTable($entityName);
2477        for my $field (@fieldList) {
2478            if ($field eq 'id') {
2479                Confess("Cannot update the ID field for entity $entityName.");
2480            } elsif ($checker->{$field}->{relation} ne $entityName) {
2481                Confess("Cannot find $field in primary relation of $entityName.");
2482            }
2483        }
2484        # Build the SQL statement.
2485        my @sets = ();
2486        my @valueList = ();
2487        for my $field (@fieldList) {
2488            push @sets, _FixName($field) . " = ?";
2489            push @valueList, $fields->{$field};
2490        }
2491        my $command = "UPDATE $entityName SET " . join(", ", @sets) . " WHERE id = ?";
2492        # Add the ID to the list of binding values.
2493        push @valueList, $id;
2494        # Call SQL to do the work.
2495        my $rows = $self->{_dbh}->SQL($command, 0, @valueList);
2496        # Check for errors.
2497        if ($rows == 0) {
2498            Confess("Entity $id of type $entityName not found.");
2499        }
2500  }  }
2501    
2502  =head3 LoadTable  =head3 LoadTable
2503    
2504  C<< my %results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>  C<< my $results = $erdb->LoadTable($fileName, $relationName, $truncateFlag); >>
2505    
2506  Load data from a tab-delimited file into a specified table, optionally re-creating the table  Load data from a tab-delimited file into a specified table, optionally re-creating the table
2507  first.  first.
# Line 2403  Line 2590 
2590              # The full-text index (if any) is always built last, even for MySQL.              # The full-text index (if any) is always built last, even for MySQL.
2591              # First we need to see if this table has a full-text index. Only              # First we need to see if this table has a full-text index. Only
2592              # primary relations are allowed that privilege.              # primary relations are allowed that privilege.
2593                Trace("Checking for full-text index on $relationName.") if T(2);
2594              if ($self->_IsPrimary($relationName)) {              if ($self->_IsPrimary($relationName)) {
2595                  # Get the relation's entity/relationship structure.                  $self->CreateSearchIndex($relationName);
                 my $structure = $self->_GetStructure($relationName);  
                 # Check for a searchable fields list.  
                 if (exists $structure->{searchFields}) {  
                     # Here we know that we need to create a full-text search index.  
                     # Get an SQL-formatted field name list.  
                     my $fields = join(", ", $self->_FixNames(@{$structure->{searchFields}}));  
                     # Create the index.  
                     $dbh->create_index(tbl => $relationName, idx => "search_idx",  
                                        flds => $fields, kind => 'fulltext');  
                 }  
2596              }              }
2597          }          }
2598      }      }
# Line 2426  Line 2604 
2604      return $retVal;      return $retVal;
2605  }  }
2606    
2607    =head3 CreateSearchIndex
2608    
2609    C<< $erdb->CreateSearchIndex($objectName); >>
2610    
2611    Check for a full-text search index on the specified entity or relationship object, and
2612    if one is required, rebuild it.
2613    
2614    =over 4
2615    
2616    =item objectName
2617    
2618    Name of the entity or relationship to be indexed.
2619    
2620    =back
2621    
2622    =cut
2623    
2624    sub CreateSearchIndex {
2625        # Get the parameters.
2626        my ($self, $objectName) = @_;
2627        # Get the relation's entity/relationship structure.
2628        my $structure = $self->_GetStructure($objectName);
2629        # Get the database handle.
2630        my $dbh = $self->{_dbh};
2631        Trace("Checking for search fields in $objectName.") if T(3);
2632        # Check for a searchable fields list.
2633        if (exists $structure->{searchFields}) {
2634            # Here we know that we need to create a full-text search index.
2635            # Get an SQL-formatted field name list.
2636            my $fields = join(", ", _FixNames(@{$structure->{searchFields}}));
2637            # Create the index. If it already exists, it will be dropped.
2638            $dbh->create_index(tbl => $objectName, idx => "search_idx",
2639                               flds => $fields, kind => 'fulltext');
2640            Trace("Index created for $fields in $objectName.") if T(2);
2641        }
2642    }
2643    
2644  =head3 DropRelation  =head3 DropRelation
2645    
2646  C<< $erdb->DropRelation($relationName); >>  C<< $erdb->DropRelation($relationName); >>
# Line 2454  Line 2669 
2669      $dbh->drop_table(tbl => $relationName);      $dbh->drop_table(tbl => $relationName);
2670  }  }
2671    
2672    =head3 MatchSqlPattern
2673    
2674    C<< my $matched = ERDB::MatchSqlPattern($value, $pattern); >>
2675    
2676    Determine whether or not a specified value matches an SQL pattern. An SQL
2677    pattern has two wild card characters: C<%> that matches multiple characters,
2678    and C<_> that matches a single character. These can be escaped using a
2679    backslash (C<\>). We pull this off by converting the SQL pattern to a
2680    PERL regular expression. As per SQL rules, the match is case-insensitive.
2681    
2682    =over 4
2683    
2684    =item value
2685    
2686    Value to be matched against the pattern. Note that an undefined or empty
2687    value will not match anything.
2688    
2689    =item pattern
2690    
2691    SQL pattern against which to match the value. An undefined or empty pattern will
2692    match everything.
2693    
2694    =item RETURN
2695    
2696    Returns TRUE if the value and pattern match, else FALSE.
2697    
2698    =back
2699    
2700    =cut
2701    
2702    sub MatchSqlPattern {
2703        # Get the parameters.
2704        my ($value, $pattern) = @_;
2705        # Declare the return variable.
2706        my $retVal;
2707        # Insure we have a pattern.
2708        if (! defined($pattern) || $pattern eq "") {
2709            $retVal = 1;
2710        } else {
2711            # Break the pattern into pieces around the wildcard characters. Because we
2712            # use parentheses in the split function's delimiter expression, we'll get
2713            # list elements for the delimiters as well as the rest of the string.
2714            my @pieces = split /([_%]|\\[_%])/, $pattern;
2715            # Check some fast special cases.
2716            if ($pattern eq '%') {
2717                # A null pattern matches everything.
2718                $retVal = 1;
2719            } elsif (@pieces == 1) {
2720                # No wildcards, so we have a literal comparison. Note we're case-insensitive.
2721                $retVal = (lc($value) eq lc($pattern));
2722            } elsif (@pieces == 2 && $pieces[1] eq '%') {
2723                # A wildcard at the end, so we have a substring match. This is also case-insensitive.
2724                $retVal = (lc(substr($value, 0, length($pieces[0]))) eq lc($pieces[0]));
2725            } else {
2726                # Okay, we have to do it the hard way. Convert each piece to a PERL pattern.
2727                my $realPattern = "";
2728                for my $piece (@pieces) {
2729                    # Determine the type of piece.
2730                    if ($piece eq "") {
2731                        # Empty pieces are ignored.
2732                    } elsif ($piece eq "%") {
2733                        # Here we have a multi-character wildcard. Note that it can match
2734                        # zero or more characters.
2735                        $realPattern .= ".*"
2736                    } elsif ($piece eq "_") {
2737                        # Here we have a single-character wildcard.
2738                        $realPattern .= ".";
2739                    } elsif ($piece eq "\\%" || $piece eq "\\_") {
2740                        # This is an escape sequence (which is a rare thing, actually).
2741                        $realPattern .= substr($piece, 1, 1);
2742                    } else {
2743                        # Here we have raw text.
2744                        $realPattern .= quotemeta($piece);
2745                    }
2746                }
2747                # Do the match.
2748                $retVal = ($value =~ /^$realPattern$/i ? 1 : 0);
2749            }
2750        }
2751        # Return the result.
2752        return $retVal;
2753    }
2754    
2755  =head3 GetEntity  =head3 GetEntity
2756    
2757  C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >>  C<< my $entityObject = $erdb->GetEntity($entityType, $ID); >>
# Line 2607  Line 2905 
2905  spreadsheet cell, and each feature will be represented by a list containing the  spreadsheet cell, and each feature will be represented by a list containing the
2906  feature ID followed by all of its aliases.  feature ID followed by all of its aliases.
2907    
2908  C<< $query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >>  C<< @query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >>
2909    
2910  =over 4  =over 4
2911    
# Line 2861  Line 3159 
3159      # Declare the return variable. The field name is valid until we hear      # Declare the return variable. The field name is valid until we hear
3160      # differently.      # differently.
3161      my $retVal = 1;      my $retVal = 1;
3162        # Compute the maximum name length.
3163        my $maxLen = $TypeTable{'name-string'}->{maxLen};
3164      # Look for bad stuff in the name.      # Look for bad stuff in the name.
3165      if ($fieldName =~ /--/) {      if ($fieldName =~ /--/) {
3166          # Here we have a doubled minus sign.          # Here we have a doubled minus sign.
# Line 2870  Line 3170 
3170          # Here the field name is missing the initial letter.          # Here the field name is missing the initial letter.
3171          Trace("Field name $fieldName does not begin with a letter.") if T(1);          Trace("Field name $fieldName does not begin with a letter.") if T(1);
3172          $retVal = 0;          $retVal = 0;
3173        } elsif (length($fieldName) > $maxLen) {
3174            # Here the field name is too long.
3175            Trace("Maximum field name length is $maxLen. Field name must be truncated to " . substr($fieldName,0, $maxLen) . ".");
3176      } else {      } else {
3177          # Strip out the minus signs. Everything remaining must be a letter,          # Strip out the minus signs. Everything remaining must be a letter,
3178          # underscore, or digit.          # underscore, or digit.
# Line 3024  Line 3327 
3327      # Substitute the bulletin board codes.      # Substitute the bulletin board codes.
3328      $retVal =~ s!\[(/?[bi])\]!<$1>!g;      $retVal =~ s!\[(/?[bi])\]!<$1>!g;
3329      $retVal =~ s!\[p\]!</p><p>!g;      $retVal =~ s!\[p\]!</p><p>!g;
3330        $retVal =~ s!\[link\s+([^\]]+)\]!<a href="$1">!g;
3331        $retVal =~ s!\[/link\]!</a>!g;
3332      # Return the result.      # Return the result.
3333      return $retVal;      return $retVal;
3334  }  }
# Line 3968  Line 4273 
4273          _FixupFields($relationshipStructure, $relationshipName, 2, 3);          _FixupFields($relationshipStructure, $relationshipName, 2, 3);
4274          # Format a description for the FROM field.          # Format a description for the FROM field.
4275          my $fromEntity = $relationshipStructure->{from};          my $fromEntity = $relationshipStructure->{from};
4276          my $fromComment = "<b>id</b> of the source <b><a href=\"#$fromEntity\">$fromEntity</a></b>.";          my $fromComment = "[b]id[/b] of the source [b][link #$fromEntity]$fromEntity\[/link][/b].";
4277          # Get the FROM entity's key type.          # Get the FROM entity's key type.
4278          my $fromType = $entityList->{$fromEntity}->{keyType};          my $fromType = $entityList->{$fromEntity}->{keyType};
4279          # Add the FROM field.          # Add the FROM field.
# Line 3978  Line 4283 
4283                                                      PrettySort => 1});                                                      PrettySort => 1});
4284          # Format a description for the TO field.          # Format a description for the TO field.
4285          my $toEntity = $relationshipStructure->{to};          my $toEntity = $relationshipStructure->{to};
4286          my $toComment = "<b>id</b> of the target <b><a href=\"#$toEntity\">$toEntity</a></b>.";          my $toComment = "[b]id[/b] of the target [b][link #$toEntity]$toEntity\[/link][/b].";
4287          # Get the TO entity's key type.          # Get the TO entity's key type.
4288          my $toType = $entityList->{$toEntity}->{keyType};          my $toType = $entityList->{$toEntity}->{keyType};
4289          # Add the TO field.          # Add the TO field.
# Line 4681  Line 4986 
4986      # Compute the number of columns.      # Compute the number of columns.
4987      my $colCount = @colNames;      my $colCount = @colNames;
4988      # Generate the title row.      # Generate the title row.
4989      my $htmlString = "<p><table border=\"2\"><tr><td colspan=\"$colCount\" align=\"center\">$tablename</td></tr>\n";      my $htmlString = "<table border=\"2\"><tr><td colspan=\"$colCount\" align=\"center\">$tablename</td></tr>\n";
4990      # Loop through the columns, adding the column header rows.      # Loop through the columns, adding the column header rows.
4991      $htmlString .= "<tr>";      $htmlString .= "<tr>";
4992      for my $colName (@colNames) {      for my $colName (@colNames) {
# Line 4700  Line 5005 
5005  =cut  =cut
5006    
5007  sub _CloseTable {  sub _CloseTable {
5008      return "</table></p>\n";      return "</table>\n";
5009  }  }
5010    
5011  =head3 _ShowField  =head3 _ShowField

Legend:
Removed from v.1.77  
changed lines
  Added in v.1.84

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3