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

Diff of /Sprout/CustomAttributes.pm

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

revision 1.21, Sun Feb 18 22:13:53 2007 UTC revision 1.31, Thu Dec 6 14:58:03 2007 UTC
# Line 9  Line 9 
9      use Tracer;      use Tracer;
10      use ERDBLoad;      use ERDBLoad;
11      use Stats;      use Stats;
12        use Time::HiRes qw(time);
13    
14  =head1 Custom SEED Attribute Manager  =head1 Custom SEED Attribute Manager
15    
# Line 130  Line 131 
131    
132  =head3 new  =head3 new
133    
134  C<< my $attrDB = CustomAttributes->new(%options); >>      my $attrDB = CustomAttributes->new(%options);
135    
136  Construct a new CustomAttributes object. The following options are  Construct a new CustomAttributes object. The following options are
137  supported.  supported.
# Line 173  Line 174 
174    
175  =head3 StoreAttributeKey  =head3 StoreAttributeKey
176    
177  C<< $attrDB->StoreAttributeKey($attributeName, $type, $notes, \@groups); >>      $attrDB->StoreAttributeKey($attributeName, $type, $notes, \@groups);
178    
179  Create or update an attribute for the database.  Create or update an attribute for the database.
180    
# Line 246  Line 247 
247    
248  =head3 DeleteAttributeKey  =head3 DeleteAttributeKey
249    
250  C<< my $stats = $attrDB->DeleteAttributeKey($attributeName); >>      my $stats = $attrDB->DeleteAttributeKey($attributeName);
251    
252  Delete an attribute from the custom attributes database.  Delete an attribute from the custom attributes database.
253    
# Line 278  Line 279 
279    
280  =head3 NewName  =head3 NewName
281    
282  C<< my $text = CustomAttributes::NewName(); >>      my $text = CustomAttributes::NewName();
283    
284  Return the string used to indicate the user wants to add a new attribute.  Return the string used to indicate the user wants to add a new attribute.
285    
# Line 290  Line 291 
291    
292  =head3 ControlForm  =head3 ControlForm
293    
294  C<< my $formHtml = $attrDB->ControlForm($cgi, $name, \%keys); >>      my $formHtml = $attrDB->ControlForm($cgi, $name, \%keys);
295    
296  Return a form that can be used to control the creation and modification of  Return a form that can be used to control the creation and modification of
297  attributes. Only a subset of the attribute keys will be displayed, as  attributes. Only a subset of the attribute keys will be displayed, as
# Line 344  Line 345 
345                                      -labels => \%labelMap,                                      -labels => \%labelMap,
346                                      -default => 'string');                                      -default => 'string');
347      # Allow the user to specify a new field name. This is required if the      # Allow the user to specify a new field name. This is required if the
348      # user has selected the "(new)" marker. We put a little scriptlet in here that      # user has selected the "(new)" marker.
     # selects the (new) marker when the user enters the field.  
     push @retVal, "<script language=\"javaScript\">";  
349      my $fieldField = "document.$name.fieldName";      my $fieldField = "document.$name.fieldName";
350      my $newName = "\"" . NewName() . "\"";      my $newName = "\"" . NewName() . "\"";
351      push @retVal, $cgi->Tr($cgi->th("New Field Name"),      push @retVal, $cgi->Tr($cgi->th("New Field Name"),
# Line 386  Line 385 
385    
386  =head3 LoadAttributesFrom  =head3 LoadAttributesFrom
387    
388  C<< my $stats = $attrDB->LoadAttributesFrom($fileName, %options); >>      my $stats = $attrDB->LoadAttributesFrom($fileName, %options);
389    s
390  Load attributes from the specified tab-delimited file. Each line of the file must  Load attributes from the specified tab-delimited file. Each line of the file must
391  contain an object ID in the first column, an attribute key name in the second  contain an object ID in the first column, an attribute key name in the second
392  column, and attribute values in the remaining columns. The attribute values will  column, and attribute values in the remaining columns. The attribute values will
# Line 430  Line 429 
429    
430  If specified, the specified object type will be prefixed to each object ID.  If specified, the specified object type will be prefixed to each object ID.
431    
432    =item resume
433    
434    If specified, key-value pairs already in the database will not be reinserted.
435    
436  =back  =back
437    
438  =cut  =cut
# Line 439  Line 442 
442      my ($self, $fileName, %options) = @_;      my ($self, $fileName, %options) = @_;
443      # Declare the return variable.      # Declare the return variable.
444      my $retVal = Stats->new('keys', 'values');      my $retVal = Stats->new('keys', 'values');
445        # Initialize the timers.
446        my ($insertTime, $eraseTime, $archiveTime, $checkTime) = (0, 0, 0, 0);
447      # Check for append mode.      # Check for append mode.
448      my $append = ($options{append} ? 1 : 0);      my $append = ($options{append} ? 1 : 0);
449        # Check for resume mode.
450        my $resume = ($options{resume} ? 1 : 0);
451      # Create a hash of key names found.      # Create a hash of key names found.
452      my %keyHash = ();      my %keyHash = ();
453      # Open the file for input. Note we must anticipate the possibility of an      # Open the file for input. Note we must anticipate the possibility of an
# Line 459  Line 466 
466          $ah = Open(undef, ">$options{archive}");          $ah = Open(undef, ">$options{archive}");
467          Trace("Load file will be archived to $options{archive}.") if T(3);          Trace("Load file will be archived to $options{archive}.") if T(3);
468      }      }
469      # Finally, open a database transaction.      # Insure we recover from errors.
     $self->BeginTran();  
     # Insure we recover from errors. If an error occurs, we will delete the archive file and  
     # roll back the updates.  
470      eval {      eval {
471          # Loop through the file.          # Loop through the file.
472          while (! eof $fh) {          while (! eof $fh) {
# Line 475  Line 479 
479              }              }
480              # Archive the line (if necessary).              # Archive the line (if necessary).
481              if (defined $ah) {              if (defined $ah) {
482                    my $startTime = time();
483                  Tracer::PutLine($ah, [$id, $key, @values]);                  Tracer::PutLine($ah, [$id, $key, @values]);
484                    $archiveTime += time() - $startTime;
485              }              }
486              # Do some validation.              # Do some validation.
487              if (! $id) {              if (! $id) {
# Line 488  Line 494 
494                  # An ID without a key is a serious error.                  # An ID without a key is a serious error.
495                  my $lines = $retVal->Ask('linesIn');                  my $lines = $retVal->Ask('linesIn');
496                  Confess("Line $lines in $fileName has no attribute key.");                  Confess("Line $lines in $fileName has no attribute key.");
497                } elsif (! @values) {
498                    # A line with no values is not allowed.
499                    my $lines = $retVal->Ask('linesIn');
500                    Trace("Line $lines for key $key has no attribute values.") if T(1);
501                    $retVal->Add(skipped => 1);
502              } else {              } else {
503                  # The key contains a real part and an optional sub-part. We need the real part.                  # The key contains a real part and an optional sub-part. We need the real part.
504                  my ($realKey, $subKey) = $self->SplitKey($key);                  my ($realKey, $subKey) = $self->SplitKey($key);
# Line 502  Line 513 
513                          $retVal->Add(keys => 1);                          $retVal->Add(keys => 1);
514                          # If this is NOT append mode, erase the key.                          # If this is NOT append mode, erase the key.
515                          if (! $append) {                          if (! $append) {
516                                my $startTime = time();
517                              $self->EraseAttribute($realKey);                              $self->EraseAttribute($realKey);
518                                $eraseTime += time() - $startTime;
519                                Trace("Attribute $realKey erased.") if T(3);
520                          }                          }
521                      }                      }
522                      Trace("Key $realKey found.") if T(3);                      Trace("Key $realKey found.") if T(3);
523                  }                  }
524                    # If we're in resume mode, check to see if this insert is redundant.
525                    my $ok = 1;
526                    if ($resume) {
527                        my $startTime = time();
528                        my $count = $self->GetAttributes($id, $key, @values);
529                        $ok = ! $count;
530                        $checkTime += time() - $startTime;
531                    }
532                    if ($ok) {
533                  # Everything is all set up, so add the value.                  # Everything is all set up, so add the value.
534                        my $startTime = time();
535                  $self->AddAttribute($id, $key, @values);                  $self->AddAttribute($id, $key, @values);
536                        $insertTime += time() - $startTime;
537                        # Turn off resume mode.
538                        $resume = 0;
539                    } else {
540                        # Here we skipped because of resume mode.
541                        $retVal->Add(resumeSkip => 1);
542                    }
543    
544                  my $progress = $retVal->Add(values => 1);                  my $progress = $retVal->Add(values => 1);
545                  Trace("$progress values loaded.") if T(3) && ($progress % 1000 == 0);                  Trace("$progress values loaded.") if T(3) && ($progress % 1000 == 0);
546              }              }
547          }          }
548            $retVal->Add(eraseTime   => $eraseTime);
549            $retVal->Add(insertTime  => $insertTime);
550            $retVal->Add(archiveTime => $archiveTime);
551            $retVal->Add(checkTime   => $checkTime);
552      };      };
553      # Check for an error.      # Check for an error.
554      if ($@) {      if ($@) {
555          # Here we have an error. Roll back the transaction and delete the archive file.          # Here we have an error. Display the error message.
556          my $message = $@;          my $message = $@;
557          Trace("Rolling back attribute updates due to error.") if T(1);          Trace("Error during attribute load: $message") if T(0);
558          $self->RollbackTran();          $retVal->AddMessage($message);
         if (defined $ah) {  
             Trace("Deleting archive file $options{archive}.") if T(1);  
             close $ah;  
             unlink $options{archive};  
559          }          }
560          Confess("Error during attribute load: $message");      # Close the archive file, if any.
     } else {  
         # Here the load worked. Commit the transaction and close the archive file.  
         Trace("Committing attribute upload.") if T(2);  
         $self->CommitTran();  
561          if (defined $ah) {          if (defined $ah) {
562              Trace("Closing archive file $options{archive}.") if T(2);              Trace("Closing archive file $options{archive}.") if T(2);
563              close $ah;              close $ah;
564          }          }
     }  
565      # Return the result.      # Return the result.
566      return $retVal;      return $retVal;
567  }  }
568    
569  =head3 BackupKeys  =head3 BackupKeys
570    
571  C<< my $stats = $attrDB->BackupKeys($fileName, %options); >>      my $stats = $attrDB->BackupKeys($fileName, %options);
572    
573  Backup the attribute key information from the attribute database.  Backup the attribute key information from the attribute database.
574    
# Line 603  Line 630 
630    
631  =head3 RestoreKeys  =head3 RestoreKeys
632    
633  C<< my $stats = $attrDB->RestoreKeys($fileName, %options); >>      my $stats = $attrDB->RestoreKeys($fileName, %options);
634    
635  Restore the attribute keys and groups from a backup file.  Restore the attribute keys and groups from a backup file.
636    
# Line 675  Line 702 
702    
703  =head3 ArchiveFileName  =head3 ArchiveFileName
704    
705  C<< my $fileName = $ca->ArchiveFileName(); >>      my $fileName = $ca->ArchiveFileName();
706    
707  Compute a file name for archiving attribute input data. The file will be in the attribute log directory  Compute a file name for archiving attribute input data. The file will be in the attribute log directory
708    
# Line 708  Line 735 
735    
736  =head3 BackupAllAttributes  =head3 BackupAllAttributes
737    
738  C<< my $stats = $attrDB->BackupAllAttributes($fileName, %options); >>      my $stats = $attrDB->BackupAllAttributes($fileName, %options);
739    
740  Backup all of the attributes to a file. The attributes will be stored in a  Backup all of the attributes to a file. The attributes will be stored in a
741  tab-delimited file suitable for reloading via L</LoadAttributesFrom>.  tab-delimited file suitable for reloading via L</LoadAttributesFrom>.
# Line 775  Line 802 
802    
803  =head3 FieldMenu  =head3 FieldMenu
804    
805  C<< my $menuHtml = $attrDB->FieldMenu($cgi, $height, $name, $keys, %options); >>      my $menuHtml = $attrDB->FieldMenu($cgi, $height, $name, $keys, %options);
806    
807  Return the HTML for a menu to select an attribute field. The menu will  Return the HTML for a menu to select an attribute field. The menu will
808  be a standard SELECT/OPTION thing which is called "popup menu" in the  be a standard SELECT/OPTION thing which is called "popup menu" in the
# Line 949  Line 976 
976    
977  =head3 GetGroups  =head3 GetGroups
978    
979  C<< my @groups = $attrDB->GetGroups(); >>      my @groups = $attrDB->GetGroups();
980    
981  Return a list of the available groups.  Return a list of the available groups.
982    
# Line 966  Line 993 
993    
994  =head3 GetAttributeData  =head3 GetAttributeData
995    
996  C<< my %keys = $attrDB->GetAttributeData($type, @list); >>      my %keys = $attrDB->GetAttributeData($type, @list);
997    
998  Return attribute data for the selected attributes. The attribute  Return attribute data for the selected attributes. The attribute
999  data is a hash mapping each attribute key name to a n-tuple containing the  data is a hash mapping each attribute key name to a n-tuple containing the
# Line 1035  Line 1062 
1062    
1063  =head3 LogOperation  =head3 LogOperation
1064    
1065  C<< $ca->LogOperation($action, $target, $description); >>      $ca->LogOperation($action, $target, $description);
1066    
1067  Write an operation description to the attribute activity log (C<$FIG_Config::var/attributes.log>).  Write an operation description to the attribute activity log (C<$FIG_Config::var/attributes.log>).
1068    
# Line 1076  Line 1103 
1103    
1104  =head3 _KeywordString  =head3 _KeywordString
1105    
1106  C<< my $keywordString = $ca->_KeywordString($key, $value); >>      my $keywordString = $ca->_KeywordString($key, $value);
1107    
1108  Compute the keyword string for a specified key/value pair. This consists of the  Compute the keyword string for a specified key/value pair. This consists of the
1109  key name and value converted to lower case with underscores translated to spaces.  key name and value converted to lower case with underscores translated to spaces.
# Line 1121  Line 1148 
1148    
1149  =head3 _QueryResults  =head3 _QueryResults
1150    
1151  C<< my @attributeList = $attrDB->_QueryResults($query, @values); >>      my @attributeList = $attrDB->_QueryResults($query, @values);
1152    
1153  Match the results of a B<HasValueFor> query against value criteria and return  Match the results of a B<HasValueFor> query against value criteria and return
1154  the results. This is an internal method that splits the values coming back  the results. This is an internal method that splits the values coming back
# Line 1234  Line 1261 
1261    
1262  =head3 GetAttributes  =head3 GetAttributes
1263    
1264  C<< my @attributeList = $attrDB->GetAttributes($objectID, $key, @values); >>      my @attributeList = $attrDB->GetAttributes($objectID, $key, @values);
1265    
1266  In the database, attribute values are sectioned into pieces using a splitter  In the database, attribute values are sectioned into pieces using a splitter
1267  value specified in the constructor (L</new>). This is not a requirement of  value specified in the constructor (L</new>). This is not a requirement of
# Line 1439  Line 1466 
1466      # Now @filter contains one or more filter strings and @parms contains the parameter      # Now @filter contains one or more filter strings and @parms contains the parameter
1467      # values to bind to them.      # values to bind to them.
1468      my $actualFilter = join(" AND ", @filter);      my $actualFilter = join(" AND ", @filter);
1469        # Insure we have at least one filter.
1470        if (! $actualFilter) {
1471            Confess("No filter specified in GetAttributes query.");
1472        }
1473      # Now we're ready to make our query.      # Now we're ready to make our query.
1474      my $query = $self->Get(['HasValueFor'], $actualFilter, \@parms);      my $query = $self->Get(['HasValueFor'], $actualFilter, \@parms);
1475      # Format the results.      # Format the results.
# Line 1449  Line 1480 
1480    
1481  =head3 AddAttribute  =head3 AddAttribute
1482    
1483  C<< $attrDB->AddAttribute($objectID, $key, @values); >>      $attrDB->AddAttribute($objectID, $key, @values);
1484    
1485  Add an attribute key/value pair to an object. This method cannot add a new key, merely  Add an attribute key/value pair to an object. This method cannot add a new key, merely
1486  add a value to an existing key. Use L</StoreAttributeKey> to create a new key.  add a value to an existing key. Use L</StoreAttributeKey> to create a new key.
# Line 1503  Line 1534 
1534    
1535  =head3 DeleteAttribute  =head3 DeleteAttribute
1536    
1537  C<< $attrDB->DeleteAttribute($objectID, $key, @values); >>      $attrDB->DeleteAttribute($objectID, $key, @values);
1538    
1539  Delete the specified attribute key/value combination from the database.  Delete the specified attribute key/value combination from the database.
1540    
# Line 1553  Line 1584 
1584    
1585  =head3 DeleteMatchingAttributes  =head3 DeleteMatchingAttributes
1586    
1587  C<< my @deleted = $attrDB->DeleteMatchingAttributes($objectID, $key, @values); >>      my @deleted = $attrDB->DeleteMatchingAttributes($objectID, $key, @values);
1588    
1589  Delete all attributes that match the specified criteria. This is equivalent to  Delete all attributes that match the specified criteria. This is equivalent to
1590  calling L</GetAttributes> and then invoking L</DeleteAttribute> for each  calling L</GetAttributes> and then invoking L</DeleteAttribute> for each
# Line 1613  Line 1644 
1644    
1645  =head3 ChangeAttribute  =head3 ChangeAttribute
1646    
1647  C<< $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >>      $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues);
1648    
1649  Change the value of an attribute key/value pair for an object.  Change the value of an attribute key/value pair for an object.
1650    
# Line 1665  Line 1696 
1696    
1697  =head3 EraseAttribute  =head3 EraseAttribute
1698    
1699  C<< $attrDB->EraseAttribute($key); >>      $attrDB->EraseAttribute($key);
1700    
1701  Erase all values for the specified attribute key. This does not remove the  Erase all values for the specified attribute key. This does not remove the
1702  key from the database; it merely removes all the values.  key from the database; it merely removes all the values.
# Line 1694  Line 1725 
1725    
1726  =head3 GetAttributeKeys  =head3 GetAttributeKeys
1727    
1728  C<< my @keyList = $attrDB->GetAttributeKeys($groupName); >>      my @keyList = $attrDB->GetAttributeKeys($groupName);
1729    
1730  Return a list of the attribute keys for a particular group.  Return a list of the attribute keys for a particular group.
1731    
# Line 1722  Line 1753 
1753      return sort @groups;      return sort @groups;
1754  }  }
1755    
1756    =head3 QueryAttributes
1757    
1758        my @attributeData = $ca->QueryAttributes($filter, $filterParms);
1759    
1760    Return the attribute data based on an SQL filter clause. In the filter clause,
1761    the name C<$object> should be used for the object ID, C<$key> should be used for
1762    the key name, C<$subkey> for the subkey value, and C<$value> for the value field.
1763    
1764    =over 4
1765    
1766    =item filter
1767    
1768    Filter clause in the standard ERDB format, except that the field names are C<$object> for
1769    the object ID field, C<$key> for the key name field, C<$subkey> for the subkey field,
1770    and C<$value> for the value field. This abstraction enables us to hide the details of
1771    the database construction from the user.
1772    
1773    =item filterParms
1774    
1775    Parameters for the filter clause.
1776    
1777    =item RETURN
1778    
1779    Returns a list of tuples. Each tuple consists of an object ID, a key (with optional subkey), and
1780    one or more attribute values.
1781    
1782    =back
1783    
1784    =cut
1785    
1786    # This hash is used to drive the substitution process.
1787    my %AttributeParms = (object => 'HasValueFor(to-link)',
1788                          key    => 'HasValueFor(from-link)',
1789                          subkey => 'HasValueFor(subkey)',
1790                          value  => 'HasValueFor(value)');
1791    
1792    sub QueryAttributes {
1793        # Get the parameters.
1794        my ($self, $filter, $filterParms) = @_;
1795        # Declare the return variable.
1796        my @retVal = ();
1797        # Make sue we have filter parameters.
1798        my $realParms = (defined($filterParms) ? $filterParms : []);
1799        # Create the query by converting the filter.
1800        my $realFilter = $filter;
1801        for my $name (keys %AttributeParms) {
1802            $realFilter =~ s/\$$name/$AttributeParms{$name}/g;
1803        }
1804        my $query = $self->Get(['HasValueFor'], $realFilter, $realParms);
1805        # Loop through the results, forming the output attribute tuples.
1806        while (my $result = $query->Fetch()) {
1807            # Get the four values from this query result row.
1808            my ($objectID, $key, $subkey, $value) = $result->Values([$AttributeParms{object},
1809                                                                    $AttributeParms{key},
1810                                                                    $AttributeParms{subkey},
1811                                                                    $AttributeParms{value}]);
1812            # Combine the key and the subkey.
1813            my $realKey = ($subkey ? $key . $self->{splitter} . $subkey : $key);
1814            # Split the value.
1815            my @values = split $self->{splitter}, $value;
1816            # Output the result.
1817            push @retVal, [$objectID, $realKey, @values];
1818        }
1819        # Return the result.
1820        return @retVal;
1821    }
1822    
1823  =head2 Key and ID Manipulation Methods  =head2 Key and ID Manipulation Methods
1824    
1825  =head3 ParseID  =head3 ParseID
1826    
1827  C<< my ($type, $id) = CustomAttributes::ParseID($idValue); >>      my ($type, $id) = CustomAttributes::ParseID($idValue);
1828    
1829  Determine the type and object ID corresponding to an ID value from the attribute database.  Determine the type and object ID corresponding to an ID value from the attribute database.
1830  Most ID values consist of a type name and an ID, separated by a colon (e.g. C<Family:aclame|cluster10>);  Most ID values consist of a type name and an ID, separated by a colon (e.g. C<Family:aclame|cluster10>);
# Line 1765  Line 1863 
1863      if ($idValue =~ /^([A-Za-z]+):(.+)/) {      if ($idValue =~ /^([A-Za-z]+):(.+)/) {
1864          # Here we have a typed ID.          # Here we have a typed ID.
1865          ($type, $id) = ($1, $2);          ($type, $id) = ($1, $2);
1866            # Fix the case sensitivity on PDB IDs.
1867            if ($type eq 'PDB') { $id = lc $id; }
1868      } elsif ($idValue =~ /fig\|/) {      } elsif ($idValue =~ /fig\|/) {
1869          # Here we have a feature ID.          # Here we have a feature ID.
1870          ($type, $id) = (Feature => $idValue);          ($type, $id) = (Feature => $idValue);
# Line 1781  Line 1881 
1881    
1882  =head3 FormID  =head3 FormID
1883    
1884  C<< my $idValue = CustomAttributes::FormID($type, $id); >>      my $idValue = CustomAttributes::FormID($type, $id);
1885    
1886  Convert an object type and ID pair into an object ID string for the attribute system. Subsystems,  Convert an object type and ID pair into an object ID string for the attribute system. Subsystems,
1887  genomes, and features are stored in the database without type information, but all other object IDs  genomes, and features are stored in the database without type information, but all other object IDs
# Line 1822  Line 1922 
1922    
1923  =head3 GetTargetObject  =head3 GetTargetObject
1924    
1925  C<< my $object = CustomAttributes::GetTargetObject($erdb, $idValue); >>      my $object = CustomAttributes::GetTargetObject($erdb, $idValue);
1926    
1927  Return the database object corresponding to the specified attribute object ID. The  Return the database object corresponding to the specified attribute object ID. The
1928  object type associated with the ID value must correspond to an entity name in the  object type associated with the ID value must correspond to an entity name in the
# Line 1840  Line 1940 
1940    
1941  =item RETURN  =item RETURN
1942    
1943  Returns a B<DBObject> for the attribute value's target object.  Returns a B<ERDBObject> for the attribute value's target object.
1944    
1945  =back  =back
1946    
# Line 1861  Line 1961 
1961    
1962  =head3 SplitKey  =head3 SplitKey
1963    
1964  C<< my ($realKey, $subKey) = $ca->SplitKey($key); >>      my ($realKey, $subKey) = $ca->SplitKey($key);
1965    
1966  Split an external key (that is, one passed in by a caller) into the real key and the sub key.  Split an external key (that is, one passed in by a caller) into the real key and the sub key.
1967  The real and sub keys are separated by a splitter value (usually C<::>). If there is no splitter,  The real and sub keys are separated by a splitter value (usually C<::>). If there is no splitter,
# Line 1897  Line 1997 
1997    
1998  =head3 JoinKey  =head3 JoinKey
1999    
2000  C<< my $key = $ca->JoinKey($realKey, $subKey); >>      my $key = $ca->JoinKey($realKey, $subKey);
2001    
2002  Join a real key and a subkey together to make an external key. The external key is the attribute key  Join a real key and a subkey together to make an external key. The external key is the attribute key
2003  used by the caller. The real key and the subkey are how the keys are represented in the database. The  used by the caller. The real key and the subkey are how the keys are represented in the database. The
# Line 1939  Line 2039 
2039      return $retVal;      return $retVal;
2040  }  }
2041    
2042    
2043    =head3 AttributeTable
2044    
2045        my $tableHtml = CustomAttributes::AttributeTable($cgi, @attrList);
2046    
2047    Format the attribute data into an HTML table.
2048    
2049    =over 4
2050    
2051    =item cgi
2052    
2053    CGI query object used to generate the HTML
2054    
2055    =item attrList
2056    
2057    List of attribute results, in the format returned by the L</GetAttributes> or
2058    L</QueryAttributes> methods.
2059    
2060    =item RETURN
2061    
2062    Returns an HTML table displaying the attribute keys and values.
2063    
2064    =back
2065    
2066    =cut
2067    
2068    sub AttributeTable {
2069        # Get the parameters.
2070        my ($cgi, @attrList) = @_;
2071        # Accumulate the table rows.
2072        my @html = ();
2073        for my $attrData (@attrList) {
2074            # Format the object ID and key.
2075            my @columns = map { CGI::escapeHTML($_) } @{$attrData}[0,1];
2076            # Now we format the values. These remain unchanged unless one of them is a URL.
2077            my $lastValue = scalar(@{$attrData}) - 1;
2078            push @columns, map { $_ =~ /^http:/ ? $cgi->a({ href => $_ }, $_) : $_ } @{$attrData}[2 .. $lastValue];
2079            # Assemble the values into a table row.
2080            push @html, $cgi->Tr($cgi->td(\@columns));
2081        }
2082        # Format the table in the return variable.
2083        my $retVal = $cgi->table({ border => 2 }, $cgi->Tr($cgi->th(['Object', 'Key', 'Values'])), @html);
2084        # Return it.
2085        return $retVal;
2086    }
2087  1;  1;

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.31

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3