[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.89, Thu Apr 12 05:59:41 2007 UTC revision 1.90, Fri Apr 27 22:19:49 2007 UTC
# Line 10  Line 10 
10      use Stats;      use Stats;
11      use Time::HiRes qw(gettimeofday);      use Time::HiRes qw(gettimeofday);
12      use Digest::MD5 qw(md5_base64);      use Digest::MD5 qw(md5_base64);
     use FIG;  
13      use CGI;      use CGI;
14    
15  =head1 Entity-Relationship Database Package  =head1 Entity-Relationship Database Package
# Line 756  Line 755 
755              my (@object_refs, @scalars, @indexes);              my (@object_refs, @scalars, @indexes);
756              # The relationship will be created as an object with object              # The relationship will be created as an object with object
757              # references for its links to the participating entities.              # references for its links to the participating entities.
758              my %links = ( from => $relationshipObject->{from},              my %links = ( from_link => $relationshipObject->{from},
759                            to => $relationshipObject->{to} );                            to_link => $relationshipObject->{to} );
760              for my $link (keys %links) {              for my $link (keys %links) {
761                  # Create an object_ref tag for this piece of the                  # Create an object_ref tag for this piece of the
762                  # relationship (from or to).                  # relationship (from or to).
# Line 787  Line 786 
786      }      }
787      # Compute a title.      # Compute a title.
788      my $title;      my $title;
789      if ($erdbXMLFile =~ /\/([^\/]+)DBD\.xml/) {      if ($erdbXMLFile =~ /(\/|^)([^\/]+)DBD\.xml/) {
790          # Here we have a standard file name we can use for a title.          # Here we have a standard file name we can use for a title.
791          $title = $1;          $title = $2;
792      } else {      } else {
793          # Here the file name is non-standard, so we carve up the          # Here the file name is non-standard, so we carve up the
794          # database title.          # database title.
# Line 806  Line 805 
805      Tracer::PutFile($ppoXMLFile, [ $ppoString ]);      Tracer::PutFile($ppoXMLFile, [ $ppoString ]);
806  }  }
807    
   
   
808  =head3 FindIndexForEntity  =head3 FindIndexForEntity
809    
810  C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >>  C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >>
# Line 2704  Line 2701 
2701          # leave extra room. We postulate a minimum row count of 1000 to          # leave extra room. We postulate a minimum row count of 1000 to
2702          # prevent problems with incoming empty load files.          # prevent problems with incoming empty load files.
2703          my $rowSize = $self->EstimateRowSize($relationName);          my $rowSize = $self->EstimateRowSize($relationName);
2704          my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000);          my $estimate = $fileSize * 1.5 / $rowSize;
2705            if ($estimate < 1000) {
2706                $estimate = 1000;
2707            }
2708          # Re-create the table without its index.          # Re-create the table without its index.
2709          $self->CreateTable($relationName, 0, $estimate);          $self->CreateTable($relationName, 0, $estimate);
2710          # If this is a pre-index DBMS, create the index here.          # If this is a pre-index DBMS, create the index here.
# Line 3529  Line 3529 
3529      $self->{_dbh}->roll_tran();      $self->{_dbh}->roll_tran();
3530  }  }
3531    
3532    =head3 UpdateField
3533    
3534    C<< my $count = $erdb->UpdateField($objectNames, $fieldName, $oldValue, $newValue, $filter, $parms); >>
3535    
3536    Update all occurrences of a specific field value to a new value. The number of rows changed will be
3537    returned.
3538    
3539    =over 4
3540    
3541    =item fieldName
3542    
3543    Name of the field in standard I<objectName>C<(>I<fieldName>C<)> format.
3544    
3545    =item oldValue
3546    
3547    Value to be modified. All occurrences of this value in the named field will be replaced by the
3548    new value.
3549    
3550    =item newValue
3551    
3552    New value to be substituted for the old value when it's found.
3553    
3554    =item filter
3555    
3556    A standard ERDB filter clause (see L</Get>). The filter will be applied before any substitutions take place.
3557    
3558    =item parms
3559    
3560    Reference to a list of parameter values in the filter.
3561    
3562    =item RETURN
3563    
3564    Returns the number of rows modified.
3565    
3566    =back
3567    
3568    =cut
3569    
3570    sub UpdateField {
3571        # Get the parameters.
3572        my ($self, $fieldName, $oldValue, $newValue, $filter, $parms) = @_;
3573        # Get the object and field names from the field name parameter.
3574        $fieldName =~ /^([^(]+)\(([^)]+)\)/;
3575        my $objectName = $1;
3576        my $realFieldName = _FixName($2);
3577        # Add the old value to the filter. Note we allow the possibility that no
3578        # filter was specified.
3579        my $realFilter = "$fieldName = ?";
3580        if ($filter) {
3581            $realFilter .= " AND $filter";
3582        }
3583        # Format the query filter.
3584        my ($suffix, $mappedNameListRef, $mappedNameHashRef) =
3585            $self->_SetupSQL([$objectName], $realFilter);
3586        # Create the query. Since there is only one object name, the mapped-name data is not
3587        # necessary. Neither is the FROM clause.
3588        $suffix =~ s/^FROM.+WHERE\s+//;
3589        # Create the update statement.
3590        my $command = "UPDATE $objectName SET $realFieldName = ? WHERE $suffix";
3591        # Get the database handle.
3592        my $dbh = $self->{_dbh};
3593        # Add the old and new values to the parameter list. Note we allow the possibility that
3594        # there are no user-supplied parameters.
3595        my @params = ($newValue, $oldValue);
3596        if (defined $parms) {
3597            push @params, @{$parms};
3598        }
3599        # Execute the update.
3600        my $retVal = $dbh->SQL($command, 0, @params);
3601        # Make the funky zero a real zero.
3602        if ($retVal == 0) {
3603            $retVal = 0;
3604        }
3605        # Return the result.
3606        return $retVal;
3607    }
3608    
3609    
3610  =head2 Data Mining Methods  =head2 Data Mining Methods
3611    

Legend:
Removed from v.1.89  
changed lines
  Added in v.1.90

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3