[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.27, Sun Sep 30 03:46:30 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;
13    
14  =head1 Custom SEED Attribute Manager  =head1 Custom SEED Attribute Manager
15    
# 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 387  Line 386 
386  =head3 LoadAttributesFrom  =head3 LoadAttributesFrom
387    
388  C<< my $stats = $attrDB->LoadAttributesFrom($fileName, %options); >>  C<< 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 439  Line 438 
438      my ($self, $fileName, %options) = @_;      my ($self, $fileName, %options) = @_;
439      # Declare the return variable.      # Declare the return variable.
440      my $retVal = Stats->new('keys', 'values');      my $retVal = Stats->new('keys', 'values');
441        # Initialize the timers.
442        my ($insertTime, $eraseTime, $archiveTime) = (0, 0, 0);
443      # Check for append mode.      # Check for append mode.
444      my $append = ($options{append} ? 1 : 0);      my $append = ($options{append} ? 1 : 0);
445      # Create a hash of key names found.      # Create a hash of key names found.
# Line 475  Line 476 
476              }              }
477              # Archive the line (if necessary).              # Archive the line (if necessary).
478              if (defined $ah) {              if (defined $ah) {
479                    my $startTime = time();
480                  Tracer::PutLine($ah, [$id, $key, @values]);                  Tracer::PutLine($ah, [$id, $key, @values]);
481                    $archiveTime += time() - $startTime;
482              }              }
483              # Do some validation.              # Do some validation.
484              if (! $id) {              if (! $id) {
# Line 488  Line 491 
491                  # An ID without a key is a serious error.                  # An ID without a key is a serious error.
492                  my $lines = $retVal->Ask('linesIn');                  my $lines = $retVal->Ask('linesIn');
493                  Confess("Line $lines in $fileName has no attribute key.");                  Confess("Line $lines in $fileName has no attribute key.");
494                } elsif (! @values) {
495                    # A line with no values is not allowed.
496                    my $lines = $retVal->Ask('linesIn');
497                    Trace("Line $lines for key $key has no attribute values.") if T(1);
498                    $retVal->Add(skipped => 1);
499              } else {              } else {
500                  # 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.
501                  my ($realKey, $subKey) = $self->SplitKey($key);                  my ($realKey, $subKey) = $self->SplitKey($key);
# Line 502  Line 510 
510                          $retVal->Add(keys => 1);                          $retVal->Add(keys => 1);
511                          # If this is NOT append mode, erase the key.                          # If this is NOT append mode, erase the key.
512                          if (! $append) {                          if (! $append) {
513                                my $startTime = time();
514                              $self->EraseAttribute($realKey);                              $self->EraseAttribute($realKey);
515                                $eraseTime += time() - $startTime;
516                                Trace("Attribute $realKey erased.") if T(3);
517                          }                          }
518                      }                      }
519                      Trace("Key $realKey found.") if T(3);                      Trace("Key $realKey found.") if T(3);
520                  }                  }
521                  # Everything is all set up, so add the value.                  # Everything is all set up, so add the value.
522                    my $startTime = time();
523                  $self->AddAttribute($id, $key, @values);                  $self->AddAttribute($id, $key, @values);
524                    $insertTime += time() - $startTime;
525                  my $progress = $retVal->Add(values => 1);                  my $progress = $retVal->Add(values => 1);
526                  Trace("$progress values loaded.") if T(3) && ($progress % 1000 == 0);                  Trace("$progress values loaded.") if T(3) && ($progress % 1000 == 0);
527              }              }
528          }          }
529            $retVal->Add(eraseTime  =>  $eraseTime);
530            $retVal->Add(insertTime =>  $insertTime);
531            $retVal->Add(archiveTime => $archiveTime);
532      };      };
533      # Check for an error.      # Check for an error.
534      if ($@) {      if ($@) {
# Line 1722  Line 1738 
1738      return sort @groups;      return sort @groups;
1739  }  }
1740    
1741    =head3 QueryAttributes
1742    
1743    C<< my @attributeData = $ca->QueryAttributes($filter, $filterParms); >>
1744    
1745    Return the attribute data based on an SQL filter clause. In the filter clause,
1746    the name C<$object> should be used for the object ID, C<$key> should be used for
1747    the key name, C<$subkey> for the subkey value, and C<$value> for the value field.
1748    
1749    =over 4
1750    
1751    =item filter
1752    
1753    Filter clause in the standard ERDB format, except that the field names are C<$object> for
1754    the object ID field, C<$key> for the key name field, C<$subkey> for the subkey field,
1755    and C<$value> for the value field. This abstraction enables us to hide the details of
1756    the database construction from the user.
1757    
1758    =item filterParms
1759    
1760    Parameters for the filter clause.
1761    
1762    =item RETURN
1763    
1764    Returns a list of tuples. Each tuple consists of an object ID, a key (with optional subkey), and
1765    one or more attribute values.
1766    
1767    =back
1768    
1769    =cut
1770    
1771    # This hash is used to drive the substitution process.
1772    my %AttributeParms = (object => 'HasValueFor(to-link)',
1773                          key    => 'HasValueFor(from-link)',
1774                          subkey => 'HasValueFor(subkey)',
1775                          value  => 'HasValueFor(value)');
1776    
1777    sub QueryAttributes {
1778        # Get the parameters.
1779        my ($self, $filter, $filterParms) = @_;
1780        # Declare the return variable.
1781        my @retVal = ();
1782        # Make sue we have filter parameters.
1783        my $realParms = (defined($filterParms) ? $filterParms : []);
1784        # Create the query by converting the filter.
1785        my $realFilter = $filter;
1786        for my $name (keys %AttributeParms) {
1787            $realFilter =~ s/\$$name/$AttributeParms{$name}/g;
1788        }
1789        my $query = $self->Get(['HasValueFor'], $realFilter, $realParms);
1790        # Loop through the results, forming the output attribute tuples.
1791        while (my $result = $query->Fetch()) {
1792            # Get the four values from this query result row.
1793            my ($objectID, $key, $subkey, $value) = $result->Values([$AttributeParms{object},
1794                                                                    $AttributeParms{key},
1795                                                                    $AttributeParms{subkey},
1796                                                                    $AttributeParms{value}]);
1797            # Combine the key and the subkey.
1798            my $realKey = ($subkey ? $key . $self->{splitter} . $subkey : $key);
1799            # Split the value.
1800            my @values = split $self->{splitter}, $value;
1801            # Output the result.
1802            push @retVal, [$objectID, $realKey, @values];
1803        }
1804        # Return the result.
1805        return @retVal;
1806    }
1807    
1808  =head2 Key and ID Manipulation Methods  =head2 Key and ID Manipulation Methods
1809    
1810  =head3 ParseID  =head3 ParseID
# Line 1765  Line 1848 
1848      if ($idValue =~ /^([A-Za-z]+):(.+)/) {      if ($idValue =~ /^([A-Za-z]+):(.+)/) {
1849          # Here we have a typed ID.          # Here we have a typed ID.
1850          ($type, $id) = ($1, $2);          ($type, $id) = ($1, $2);
1851            # Fix the case sensitivity on PDB IDs.
1852            if ($type eq 'PDB') { $id = lc $id; }
1853      } elsif ($idValue =~ /fig\|/) {      } elsif ($idValue =~ /fig\|/) {
1854          # Here we have a feature ID.          # Here we have a feature ID.
1855          ($type, $id) = (Feature => $idValue);          ($type, $id) = (Feature => $idValue);
# Line 1840  Line 1925 
1925    
1926  =item RETURN  =item RETURN
1927    
1928  Returns a B<DBObject> for the attribute value's target object.  Returns a B<ERDBObject> for the attribute value's target object.
1929    
1930  =back  =back
1931    
# Line 1939  Line 2024 
2024      return $retVal;      return $retVal;
2025  }  }
2026    
2027    
2028    =head3 AttributeTable
2029    
2030    C<< my $tableHtml = CustomAttributes::AttributeTable($cgi, @attrList); >>
2031    
2032    Format the attribute data into an HTML table.
2033    
2034    =over 4
2035    
2036    =item cgi
2037    
2038    CGI query object used to generate the HTML
2039    
2040    =item attrList
2041    
2042    List of attribute results, in the format returned by the L</GetAttributes> or
2043    L</QueryAttributes> methods.
2044    
2045    =item RETURN
2046    
2047    Returns an HTML table displaying the attribute keys and values.
2048    
2049    =back
2050    
2051    =cut
2052    
2053    sub AttributeTable {
2054        # Get the parameters.
2055        my ($cgi, @attrList) = @_;
2056        # Accumulate the table rows.
2057        my @html = ();
2058        for my $attrData (@attrList) {
2059            # Format the object ID and key.
2060            my @columns = map { CGI::escapeHTML($_) } @{$attrData}[0,1];
2061            # Now we format the values. These remain unchanged unless one of them is a URL.
2062            my $lastValue = scalar(@{$attrData}) - 1;
2063            push @columns, map { $_ =~ /^http:/ ? $cgi->a({ href => $_ }, $_) : $_ } @{$attrData}[2 .. $lastValue];
2064            # Assemble the values into a table row.
2065            push @html, $cgi->Tr($cgi->td(\@columns));
2066        }
2067        # Format the table in the return variable.
2068        my $retVal = $cgi->table({ border => 2 }, $cgi->Tr($cgi->th(['Object', 'Key', 'Values'])), @html);
2069        # Return it.
2070        return $retVal;
2071    }
2072  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3