Diff of /Sprout/CustomAttributes.pm

-revision 1.21, Sun Feb 18 22:13:53 2007 UTC
+revision 1.28, Sun Sep 30 20:52:51 2007 UTC
 Line 9
      use Tracer;
      use ERDBLoad;
      use Stats;
+     use Time::HiRes qw(time);
  =head1 Custom SEED Attribute Manager
-Line 344
+Line 345
                                      -labels => \%labelMap,
                                      -default => 'string');
      # Allow the user to specify a new field name. This is required if the
-     # 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\">";
      my $fieldField = "document.$name.fieldName";
      my $newName = "\"" . NewName() . "\"";
      push @retVal, $cgi->Tr($cgi->th("New Field Name"),
-Line 387
+Line 386
  =head3 LoadAttributesFrom
  C<< my $stats = $attrDB->LoadAttributesFrom($fileName, %options); >>
+ s
  Load attributes from the specified tab-delimited file. Each line of the file must
  contain an object ID in the first column, an attribute key name in the second
  column, and attribute values in the remaining columns. The attribute values will
-Line 430
+Line 429
  If specified, the specified object type will be prefixed to each object ID.
+ =item resume
+ If specified, key-value pairs already in the database will not be reinserted.
  =back
  =cut
-Line 439
+Line 442
      my ($self, $fileName, %options) = @_;
      # Declare the return variable.
      my $retVal = Stats->new('keys', 'values');
+     # Initialize the timers.
+     my ($insertTime, $eraseTime, $archiveTime, $checkTime) = (0, 0, 0, 0);
      # Check for append mode.
      my $append = ($options{append} ? 1 : 0);
+     # Check for resume mode.
+     my $resume = ($options{resume} ? 1 : 0);
      # Create a hash of key names found.
      my %keyHash = ();
      # Open the file for input. Note we must anticipate the possibility of an
-Line 459
+Line 466
          $ah = Open(undef, ">$options{archive}");
          Trace("Load file will be archived to $options{archive}.") if T(3);
      }
-     # 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.
      eval {
          # Loop through the file.
          while (! eof $fh) {
-Line 475
+Line 479
              }
              # Archive the line (if necessary).
              if (defined $ah) {
+                 my $startTime = time();
                  Tracer::PutLine($ah, [$id, $key, @values]);
+                 $archiveTime += time() - $startTime;
              }
              # Do some validation.
              if (! $id) {
-Line 488
+Line 494
                  # An ID without a key is a serious error.
                  my $lines = $retVal->Ask('linesIn');
                  Confess("Line $lines in $fileName has no attribute key.");
+             } elsif (! @values) {
+                 # A line with no values is not allowed.
+                 my $lines = $retVal->Ask('linesIn');
+                 Trace("Line $lines for key $key has no attribute values.") if T(1);
+                 $retVal->Add(skipped => 1);
              } else {
                  # The key contains a real part and an optional sub-part. We need the real part.
                  my ($realKey, $subKey) = $self->SplitKey($key);
-Line 502
+Line 513
                          $retVal->Add(keys => 1);
                          # If this is NOT append mode, erase the key.
                          if (! $append) {
+                             my $startTime = time();
                              $self->EraseAttribute($realKey);
+                             $eraseTime += time() - $startTime;
+                             Trace("Attribute $realKey erased.") if T(3);
                          }
                      }
                      Trace("Key $realKey found.") if T(3);
                  }
+                 # If we're in resume mode, check to see if this insert is redundant.
+                 my $ok = 1;
+                 if ($resume) {
+                     my $startTime = time();
+                     my $count = $self->GetAttributes($id, $key, @values);
+                     $ok = ! $count;
+                     $checkTime += time() - $startTime;
+                 }
+                 if ($ok) {
                  # Everything is all set up, so add the value.
+                     my $startTime = time();
                  $self->AddAttribute($id, $key, @values);
+                     $insertTime += time() - $startTime;
+                 } else {
+                     # Here we skipped because of resume mode.
+                     $retVal->Add(resumeSkip => 1);
+                 }
                  my $progress = $retVal->Add(values => 1);
                  Trace("$progress values loaded.") if T(3) && ($progress % 1000 == 0);
              }
          }
+         $retVal->Add(eraseTime   => $eraseTime);
+         $retVal->Add(insertTime  => $insertTime);
+         $retVal->Add(archiveTime => $archiveTime);
+         $retVal->Add(checkTime   => $checkTime);
      };
      # Check for an error.
      if ($@) {
-         # Here we have an error. Roll back the transaction and delete the archive file.
+         # Here we have an error. Display the error message.
          my $message = $@;
-         Trace("Rolling back attribute updates due to error.") if T(1);
+         Trace("Error during attribute load: $message") if T(0);
-         $self->RollbackTran();
+         $retVal->AddMessage($message);
-         if (defined $ah) {
-             Trace("Deleting archive file $options{archive}.") if T(1);
-             close $ah;
-             unlink $options{archive};
          }
-         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();
          if (defined $ah) {
              Trace("Closing archive file $options{archive}.") if T(2);
              close $ah;
          }
-     }
      # Return the result.
      return $retVal;
  }
-Line 1722
+Line 1747
      return sort @groups;
  }
+ =head3 QueryAttributes
+ C<< my @attributeData = $ca->QueryAttributes($filter, $filterParms); >>
+ Return the attribute data based on an SQL filter clause. In the filter clause,
+ the name C<$object> should be used for the object ID, C<$key> should be used for
+ the key name, C<$subkey> for the subkey value, and C<$value> for the value field.
+ =over 4
+ =item filter
+ Filter clause in the standard ERDB format, except that the field names are C<$object> for
+ the object ID field, C<$key> for the key name field, C<$subkey> for the subkey field,
+ and C<$value> for the value field. This abstraction enables us to hide the details of
+ the database construction from the user.
+ =item filterParms
+ Parameters for the filter clause.
+ =item RETURN
+ Returns a list of tuples. Each tuple consists of an object ID, a key (with optional subkey), and
+ one or more attribute values.
+ =back
+ =cut
+ # This hash is used to drive the substitution process.
+ my %AttributeParms = (object => 'HasValueFor(to-link)',
+                       key    => 'HasValueFor(from-link)',
+                       subkey => 'HasValueFor(subkey)',
+                       value  => 'HasValueFor(value)');
+ sub QueryAttributes {
+     # Get the parameters.
+     my ($self, $filter, $filterParms) = @_;
+     # Declare the return variable.
+     my @retVal = ();
+     # Make sue we have filter parameters.
+     my $realParms = (defined($filterParms) ? $filterParms : []);
+     # Create the query by converting the filter.
+     my $realFilter = $filter;
+     for my $name (keys %AttributeParms) {
+         $realFilter =~ s/\$$name/$AttributeParms{$name}/g;
+     }
+     my $query = $self->Get(['HasValueFor'], $realFilter, $realParms);
+     # Loop through the results, forming the output attribute tuples.
+     while (my $result = $query->Fetch()) {
+         # Get the four values from this query result row.
+         my ($objectID, $key, $subkey, $value) = $result->Values([$AttributeParms{object},
+                                                                 $AttributeParms{key},
+                                                                 $AttributeParms{subkey},
+                                                                 $AttributeParms{value}]);
+         # Combine the key and the subkey.
+         my $realKey = ($subkey ? $key . $self->{splitter} . $subkey : $key);
+         # Split the value.
+         my @values = split $self->{splitter}, $value;
+         # Output the result.
+         push @retVal, [$objectID, $realKey, @values];
+     }
+     # Return the result.
+     return @retVal;
+ }
  =head2 Key and ID Manipulation Methods
  =head3 ParseID
-Line 1765
+Line 1857
      if ($idValue =~ /^([A-Za-z]+):(.+)/) {
          # Here we have a typed ID.
          ($type, $id) = ($1, $2);
+         # Fix the case sensitivity on PDB IDs.
+         if ($type eq 'PDB') { $id = lc $id; }
      } elsif ($idValue =~ /fig\|/) {
          # Here we have a feature ID.
          ($type, $id) = (Feature => $idValue);
-Line 1840
+Line 1934
  =item RETURN
- Returns a B<DBObject> for the attribute value's target object.
+ Returns a B<ERDBObject> for the attribute value's target object.
  =back
-Line 1939
+Line 2033
      return $retVal;
  }
+ =head3 AttributeTable
+ C<< my $tableHtml = CustomAttributes::AttributeTable($cgi, @attrList); >>
+ Format the attribute data into an HTML table.
+ =over 4
+ =item cgi
+ CGI query object used to generate the HTML
+ =item attrList
+ List of attribute results, in the format returned by the L</GetAttributes> or
+ L</QueryAttributes> methods.
+ =item RETURN
+ Returns an HTML table displaying the attribute keys and values.
+ =back
+ =cut
+ sub AttributeTable {
+     # Get the parameters.
+     my ($cgi, @attrList) = @_;
+     # Accumulate the table rows.
+     my @html = ();
+     for my $attrData (@attrList) {
+         # Format the object ID and key.
+         my @columns = map { CGI::escapeHTML($_) } @{$attrData}[0,1];
+         # Now we format the values. These remain unchanged unless one of them is a URL.
+         my $lastValue = scalar(@{$attrData}) - 1;
+         push @columns, map { $_ =~ /^http:/ ? $cgi->a({ href => $_ }, $_) : $_ } @{$attrData}[2 .. $lastValue];
+         # Assemble the values into a table row.
+         push @html, $cgi->Tr($cgi->td(\@columns));
+     }
+     # Format the table in the return variable.
+     my $retVal = $cgi->table({ border => 2 }, $cgi->Tr($cgi->th(['Object', 'Key', 'Values'])), @html);
+     # Return it.
+     return $retVal;
+ }
 ;

 Legend:



Removed from v.1.21
 


changed lines


 
Added in v.1.28
 Legend:



Removed from v.1.21
 


changed lines


 
Added in v.1.28
-Removed from v.1.21
+Added in v.1.28

MCS Webmaster	ViewVC Help
Powered by ViewVC 1.0.3