[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.91, Wed May 2 05:51:48 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 373  Line 372 
372                   'medium-string' =>                   'medium-string' =>
373                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, sort => "",                               { sqlType => 'VARCHAR(160)',       maxLen => 160,          avgLen =>  40, sort => "",
374                                 indexMod =>   0, notes => "character string, 0 to 160 characters"},                                 indexMod =>   0, notes => "character string, 0 to 160 characters"},
375                     'long-string' =>
376                                 { sqlType => 'VARCHAR(500)',       maxLen => 500,          avglen => 255, sort => "",
377                                   indexMod =>   0, notes => "character string, 0 to 500 characters"},
378                  );                  );
379    
380  # Table translating arities into natural language.  # Table translating arities into natural language.
# Line 756  Line 758 
758              my (@object_refs, @scalars, @indexes);              my (@object_refs, @scalars, @indexes);
759              # The relationship will be created as an object with object              # The relationship will be created as an object with object
760              # references for its links to the participating entities.              # references for its links to the participating entities.
761              my %links = ( from => $relationshipObject->{from},              my %links = ( from_link => $relationshipObject->{from},
762                            to => $relationshipObject->{to} );                            to_link => $relationshipObject->{to} );
763              for my $link (keys %links) {              for my $link (keys %links) {
764                  # Create an object_ref tag for this piece of the                  # Create an object_ref tag for this piece of the
765                  # relationship (from or to).                  # relationship (from or to).
# Line 787  Line 789 
789      }      }
790      # Compute a title.      # Compute a title.
791      my $title;      my $title;
792      if ($erdbXMLFile =~ /\/([^\/]+)DBD\.xml/) {      if ($erdbXMLFile =~ /(\/|^)([^\/]+)DBD\.xml/) {
793          # 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.
794          $title = $1;          $title = $2;
795      } else {      } else {
796          # Here the file name is non-standard, so we carve up the          # Here the file name is non-standard, so we carve up the
797          # database title.          # database title.
# Line 806  Line 808 
808      Tracer::PutFile($ppoXMLFile, [ $ppoString ]);      Tracer::PutFile($ppoXMLFile, [ $ppoString ]);
809  }  }
810    
   
   
811  =head3 FindIndexForEntity  =head3 FindIndexForEntity
812    
813  C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >>  C<< my $indexFound = ERDB::FindIndexForEntity($xml, $entityName, $attributeName); >>
# Line 2066  Line 2066 
2066      $dbh->SQL($command, undef, @parms);      $dbh->SQL($command, undef, @parms);
2067  }  }
2068    
2069    =head3 DeleteLike
2070    
2071    C<< my $deleteCount = $erdb->DeleteLike($relName, $filter, \@parms); >>
2072    
2073    Delete all the relationship rows that satisfy a particular filter condition. Unlike a normal
2074    filter, only fields from the relationship itself can be used.
2075    
2076    =over 4
2077    
2078    =item relName
2079    
2080    Name of the relationship whose records are to be deleted.
2081    
2082    =item filter
2083    
2084    A filter clause (L</Get>-style) for the delete query.
2085    
2086    =item parms
2087    
2088    Reference to a list of parameters for the filter clause.
2089    
2090    =item RETURN
2091    
2092    Returns a count of the number of rows deleted.
2093    
2094    =back
2095    
2096    =cut
2097    
2098    sub DeleteLike {
2099        # Get the parameters.
2100        my ($self, $objectName, $filter, $parms) = @_;
2101        # Declare the return variable.
2102        my $retVal;
2103        # Insure the parms argument is an array reference if the caller left it off.
2104        if (! defined($parms)) {
2105            $parms = [];
2106        }
2107        # Insure we have a relationship. The main reason for this is if we delete an entity
2108        # instance we have to yank out a bunch of other stuff with it.
2109        if ($self->IsEntity($objectName)) {
2110            Confess("Cannot use DeleteLike on $objectName, because it is not a relationship.");
2111        } else {
2112            # Create the SQL command suffix to get the desierd records.
2113            my ($suffix) = $self->_SetupSQL([$objectName], $filter);
2114            # Convert it to a DELETE command.
2115            my $command = "DELETE $suffix";
2116            # Execute the command.
2117            my $dbh = $self->{_dbh};
2118            my $result = $dbh->SQL($command, 0, @{$parms});
2119            # Check the results. Note we convert the "0D0" result to a real zero.
2120            # A failure causes an abnormal termination, so the caller isn't going to
2121            # worry about it.
2122            if (! defined $result) {
2123                Confess("Error deleting from $objectName: " . $dbh->errstr());
2124            } elsif ($result == 0) {
2125                $retVal = 0;
2126            } else {
2127                $retVal = $result;
2128            }
2129        }
2130        # Return the result count.
2131        return $retVal;
2132    }
2133    
2134  =head3 SortNeeded  =head3 SortNeeded
2135    
2136  C<< my $parms = $erdb->SortNeeded($relationName); >>  C<< my $parms = $erdb->SortNeeded($relationName); >>
# Line 2704  Line 2769 
2769          # leave extra room. We postulate a minimum row count of 1000 to          # leave extra room. We postulate a minimum row count of 1000 to
2770          # prevent problems with incoming empty load files.          # prevent problems with incoming empty load files.
2771          my $rowSize = $self->EstimateRowSize($relationName);          my $rowSize = $self->EstimateRowSize($relationName);
2772          my $estimate = FIG::max($fileSize * 1.5 / $rowSize, 1000);          my $estimate = $fileSize * 1.5 / $rowSize;
2773            if ($estimate < 1000) {
2774                $estimate = 1000;
2775            }
2776          # Re-create the table without its index.          # Re-create the table without its index.
2777          $self->CreateTable($relationName, 0, $estimate);          $self->CreateTable($relationName, 0, $estimate);
2778          # 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 3597 
3597      $self->{_dbh}->roll_tran();      $self->{_dbh}->roll_tran();
3598  }  }
3599    
3600    =head3 UpdateField
3601    
3602    C<< my $count = $erdb->UpdateField($objectNames, $fieldName, $oldValue, $newValue, $filter, $parms); >>
3603    
3604    Update all occurrences of a specific field value to a new value. The number of rows changed will be
3605    returned.
3606    
3607    =over 4
3608    
3609    =item fieldName
3610    
3611    Name of the field in standard I<objectName>C<(>I<fieldName>C<)> format.
3612    
3613    =item oldValue
3614    
3615    Value to be modified. All occurrences of this value in the named field will be replaced by the
3616    new value.
3617    
3618    =item newValue
3619    
3620    New value to be substituted for the old value when it's found.
3621    
3622    =item filter
3623    
3624    A standard ERDB filter clause (see L</Get>). The filter will be applied before any substitutions take place.
3625    
3626    =item parms
3627    
3628    Reference to a list of parameter values in the filter.
3629    
3630    =item RETURN
3631    
3632    Returns the number of rows modified.
3633    
3634    =back
3635    
3636    =cut
3637    
3638    sub UpdateField {
3639        # Get the parameters.
3640        my ($self, $fieldName, $oldValue, $newValue, $filter, $parms) = @_;
3641        # Get the object and field names from the field name parameter.
3642        $fieldName =~ /^([^(]+)\(([^)]+)\)/;
3643        my $objectName = $1;
3644        my $realFieldName = _FixName($2);
3645        # Add the old value to the filter. Note we allow the possibility that no
3646        # filter was specified.
3647        my $realFilter = "$fieldName = ?";
3648        if ($filter) {
3649            $realFilter .= " AND $filter";
3650        }
3651        # Format the query filter.
3652        my ($suffix, $mappedNameListRef, $mappedNameHashRef) =
3653            $self->_SetupSQL([$objectName], $realFilter);
3654        # Create the query. Since there is only one object name, the mapped-name data is not
3655        # necessary. Neither is the FROM clause.
3656        $suffix =~ s/^FROM.+WHERE\s+//;
3657        # Create the update statement.
3658        my $command = "UPDATE $objectName SET $realFieldName = ? WHERE $suffix";
3659        # Get the database handle.
3660        my $dbh = $self->{_dbh};
3661        # Add the old and new values to the parameter list. Note we allow the possibility that
3662        # there are no user-supplied parameters.
3663        my @params = ($newValue, $oldValue);
3664        if (defined $parms) {
3665            push @params, @{$parms};
3666        }
3667        # Execute the update.
3668        my $retVal = $dbh->SQL($command, 0, @params);
3669        # Make the funky zero a real zero.
3670        if ($retVal == 0) {
3671            $retVal = 0;
3672        }
3673        # Return the result.
3674        return $retVal;
3675    }
3676    
3677    
3678  =head2 Data Mining Methods  =head2 Data Mining Methods
3679    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3