[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.92, Mon Jun 11 18:51:23 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 1017  Line 1017 
1017              my $oldString = $fieldList->[$i];              my $oldString = $fieldList->[$i];
1018              if (length($oldString) > $maxLen) {              if (length($oldString) > $maxLen) {
1019                  # Here it's too big, so we truncate it.                  # Here it's too big, so we truncate it.
1020                  Trace("Truncating field $i in relation $relName to $maxLen characters from \"$oldString\".") if T(1);                  Trace("Truncating field $i ($fieldTypes->[$i]->{name}) in relation $relName to $maxLen characters from \"$oldString\".") if T(1);
1021                  $fieldList->[$i] = substr $oldString, 0, $maxLen;                  $fieldList->[$i] = substr $oldString, 0, $maxLen;
1022                  $retVal++;                  $retVal++;
1023              }              }
# 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 3059  Line 3127 
3127  fields specified returns multiple values, they are flattened in with the rest. For  fields specified returns multiple values, they are flattened in with the rest. For
3128  example, the following call will return a list of the features in a particular  example, the following call will return a list of the features in a particular
3129  spreadsheet cell, and each feature will be represented by a list containing the  spreadsheet cell, and each feature will be represented by a list containing the
3130  feature ID followed by all of its aliases.  feature ID followed by all of its essentiality determinations.
3131    
3132  C<< @query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(alias)']); >>  C<< @query = $erdb->Get(['ContainsFeature', 'Feature'], "ContainsFeature(from-link) = ?", [$ssCellID], ['Feature(id)', 'Feature(essential)']); >>
3133    
3134  =over 4  =over 4
3135    
# 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.92

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3