[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.31, Thu Jan 19 09:28:11 2006 UTC revision 1.38, Fri Mar 17 22:02:03 2006 UTC
# Line 962  Line 962 
962              # whole.              # whole.
963              my $nameLength = 2 + length $objectName;              my $nameLength = 2 + length $objectName;
964              # Get the object's field list.              # Get the object's field list.
965              my $fieldList = $self->_GetFieldTable($objectName);              my $fieldList = $self->GetFieldTable($objectName);
966              # Find the field references for this object.              # Find the field references for this object.
967              while ($filterString =~ m/$objectName\(([^)]*)\)/g) {              while ($filterString =~ m/$objectName\(([^)]*)\)/g) {
968                  # At this point, $1 contains the field name, and the current position                  # At this point, $1 contains the field name, and the current position
# Line 1051  Line 1051 
1051      return $retVal;      return $retVal;
1052  }  }
1053    
1054    =head3 Delete
1055    
1056    C<< my $stats = $erdb->Delete($entityName, $objectID); >>
1057    
1058    Delete an entity instance from the database. The instance is deleted along with all entity and
1059    relationship instances dependent on it. The idea of dependence here is recursive. An object is
1060    always dependent on itself. An object is dependent if it is a 1-to-many or many-to-many
1061    relationship connected to a dependent entity or the "to" entity connected to a 1-to-many
1062    dependent relationship.
1063    
1064    =over 4
1065    
1066    =item entityName
1067    
1068    Name of the entity type for the instance being deleted.
1069    
1070    =item objectID
1071    
1072    ID of the entity instance to be deleted. If the ID contains a wild card character (C<%>),
1073    then it is presumed to by a LIKE pattern.
1074    
1075    =item testFlag
1076    
1077    If TRUE, the delete statements will be traced without being executed.
1078    
1079    =item RETURN
1080    
1081    Returns a statistics object indicating how many records of each particular table were
1082    deleted.
1083    
1084    =back
1085    
1086    =cut
1087    #: Return Type $%;
1088    sub Delete {
1089        # Get the parameters.
1090        my ($self, $entityName, $objectID, $testFlag) = @_;
1091        # Declare the return variable.
1092        my $retVal = Stats->new();
1093        # Get the DBKernel object.
1094        my $db = $self->{_dbh};
1095        # We're going to generate all the paths branching out from the starting entity. One of
1096        # the things we have to be careful about is preventing loops. We'll use a hash to
1097        # determine if we've hit a loop.
1098        my %alreadyFound = ();
1099        # These next lists will serve as our result stack. We start by pushing object lists onto
1100        # the stack, and then popping them off to do the deletes. This means the deletes will
1101        # start with the longer paths before getting to the shorter ones. That, in turn, makes
1102        # sure we don't delete records that might be needed to forge relationships back to the
1103        # original item. We have two lists-- one for TO-relationships, and one for
1104        # FROM-relationships and entities.
1105        my @fromPathList = ();
1106        my @toPathList = ();
1107        # This final hash is used to remember what work still needs to be done. We push paths
1108        # onto the list, then pop them off to extend the paths. We prime it with the starting
1109        # point. Note that we will work hard to insure that the last item on a path in the
1110        # TODO list is always an entity.
1111        my @todoList = ([$entityName]);
1112        while (@todoList) {
1113            # Get the current path.
1114            my $current = pop @todoList;
1115            # Copy it into a list.
1116            my @stackedPath = @{$current};
1117            # Pull off the last item on the path. It will always be an entity.
1118            my $entityName = pop @stackedPath;
1119            # Add it to the alreadyFound list.
1120            $alreadyFound{$entityName} = 1;
1121            # Get the entity data.
1122            my $entityData = $self->_GetStructure($entityName);
1123            # The first task is to loop through the entity's relation. A DELETE command will
1124            # be needed for each of them.
1125            my $relations = $entityData->{Relations};
1126            for my $relation (keys %{$relations}) {
1127                my @augmentedList = (@stackedPath, $relation);
1128                push @fromPathList, \@augmentedList;
1129            }
1130            # Now we need to look for relationships connected to this entity.
1131            my $relationshipList = $self->{_metaData}->{Relationships};
1132            for my $relationshipName (keys %{$relationshipList}) {
1133                my $relationship = $relationshipList->{$relationshipName};
1134                # Check the FROM field. We're only interested if it's us.
1135                if ($relationship->{from} eq $entityName) {
1136                    # Add the path to this relationship.
1137                    my @augmentedList = (@stackedPath, $entityName, $relationshipName);
1138                    push @fromPathList, \@augmentedList;
1139                    # Check the arity. If it's MM we're done. If it's 1M
1140                    # and the target hasn't been seen yet, we want to
1141                    # stack the entity for future processing.
1142                    if ($relationship->{arity} eq '1M') {
1143                        my $toEntity = $relationship->{to};
1144                        if (! exists $alreadyFound{$toEntity}) {
1145                            # Here we have a new entity that's dependent on
1146                            # the current entity, so we need to stack it.
1147                            my @stackList = (@augmentedList, $toEntity);
1148                            push @fromPathList, \@stackList;
1149                        } else {
1150                            Trace("$toEntity ignored because it occurred previously.") if T(4);
1151                        }
1152                    }
1153                }
1154                # Now check the TO field. In this case only the relationship needs
1155                # deletion.
1156                if ($relationship->{to} eq $entityName) {
1157                    my @augmentedList = (@stackedPath, $entityName, $relationshipName);
1158                    push @toPathList, \@augmentedList;
1159                }
1160            }
1161        }
1162        # Create the first qualifier for the WHERE clause. This selects the
1163        # keys of the primary entity records to be deleted. When we're deleting
1164        # from a dependent table, we construct a join page from the first qualifier
1165        # to the table containing the dependent records to delete.
1166        my $qualifier = ($objectID =~ /%/ ? "LIKE ?" : "= ?");
1167        # We need to make two passes. The first is through the to-list, and
1168        # the second through the from-list. The from-list is second because
1169        # the to-list may need to pass through some of the entities the
1170        # from-list would delete.
1171        my %stackList = ( from_link => \@fromPathList, to_link => \@toPathList );
1172        # Now it's time to do the deletes. We do it in two passes.
1173        for my $keyName ('to_link', 'from_link') {
1174            # Get the list for this key.
1175            my @pathList = @{$stackList{$keyName}};
1176            Trace(scalar(@pathList) . " entries in path list for $keyName.") if T(3);
1177            # Loop through this list.
1178            while (my $path = pop @pathList) {
1179                # Get the table whose rows are to be deleted.
1180                my @pathTables = @{$path};
1181                # Start the DELETE statement. We need to call DBKernel because the
1182                # syntax of a DELETE-USING varies among DBMSs.
1183                my $target = $pathTables[$#pathTables];
1184                my $stmt = $db->SetUsing(@pathTables);
1185                # Now start the WHERE. The first thing is the ID field from the starting table. That
1186                # starting table will either be the entity relation or one of the entity's
1187                # sub-relations.
1188                $stmt .= " WHERE $pathTables[0].id $qualifier";
1189                # Now we run through the remaining entities in the path, connecting them up.
1190                for (my $i = 1; $i <= $#pathTables; $i += 2) {
1191                    # Connect the current relationship to the preceding entity.
1192                    my ($entity, $rel) = @pathTables[$i-1,$i];
1193                    # The style of connection depends on the direction of the relationship.
1194                    $stmt .= " AND $entity.id = $rel.$keyName";
1195                    if ($i + 1 <= $#pathTables) {
1196                        # Here there's a next entity, so connect that to the relationship's
1197                        # to-link.
1198                        my $entity2 = $pathTables[$i+1];
1199                        $stmt .= " AND $rel.to_link = $entity2.id";
1200                    }
1201                }
1202                # Now we have our desired DELETE statement.
1203                if ($testFlag) {
1204                    # Here the user wants to trace without executing.
1205                    Trace($stmt) if T(0);
1206                } else {
1207                    # Here we can delete. Note that the SQL method dies with a confessing
1208                    # if an error occurs, so we just go ahead and do it.
1209                    Trace("Executing delete from $target using '$objectID'.") if T(3);
1210                    my $rv = $db->SQL($stmt, 0, $objectID);
1211                    # Accumulate the statistics for this delete. The only rows deleted
1212                    # are from the target table, so we use its name to record the
1213                    # statistic.
1214                    $retVal->Add($target, $rv);
1215                }
1216            }
1217        }
1218        # Return the result.
1219        return $retVal;
1220    }
1221    
1222  =head3 GetList  =head3 GetList
1223    
1224  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>  C<< my @dbObjects = $erdb->GetList(\@objectNames, $filterClause, $param1, $param2, ..., $paramN); >>
# Line 1688  Line 1856 
1856      return $retVal;      return $retVal;
1857  }  }
1858    
1859    =head3 GetFieldTable
1860    
1861    C<< my $fieldHash = $self->GetFieldTable($objectnName); >>
1862    
1863    Get the field structure for a specified entity or relationship.
1864    
1865    =over 4
1866    
1867    =item objectName
1868    
1869    Name of the desired entity or relationship.
1870    
1871    =item RETURN
1872    
1873    The table containing the field descriptors for the specified object.
1874    
1875    =back
1876    
1877    =cut
1878    
1879    sub GetFieldTable {
1880        # Get the parameters.
1881        my ($self, $objectName) = @_;
1882        # Get the descriptor from the metadata.
1883        my $objectData = $self->_GetStructure($objectName);
1884        # Return the object's field table.
1885        return $objectData->{Fields};
1886    }
1887    
1888    =head3 GetUsefulCrossValues
1889    
1890    C<< my @attrNames = $sprout->GetUsefulCrossValues($sourceEntity, $relationship); >>
1891    
1892    Return a list of the useful attributes that would be returned by a B<Cross> call
1893    from an entity of the source entity type through the specified relationship. This
1894    means it will return the fields of the target entity type and the intersection data
1895    fields in the relationship. Only primary table fields are returned. In other words,
1896    the field names returned will be for fields where there is always one and only one
1897    value.
1898    
1899    =over 4
1900    
1901    =item sourceEntity
1902    
1903    Name of the entity from which the relationship crossing will start.
1904    
1905    =item relationship
1906    
1907    Name of the relationship being crossed.
1908    
1909    =item RETURN
1910    
1911    Returns a list of field names in Sprout field format (I<objectName>C<(>I<fieldName>C<)>.
1912    
1913    =back
1914    
1915    =cut
1916    #: Return Type @;
1917    sub GetUsefulCrossValues {
1918        # Get the parameters.
1919        my ($self, $sourceEntity, $relationship) = @_;
1920        # Declare the return variable.
1921        my @retVal = ();
1922        # Determine the target entity for the relationship. This is whichever entity is not
1923        # the source entity. So, if the source entity is the FROM, we'll get the name of
1924        # the TO, and vice versa.
1925        my $relStructure = $self->_GetStructure($relationship);
1926        my $targetEntityType = ($relStructure->{from} eq $sourceEntity ? "to" : "from");
1927        my $targetEntity = $relStructure->{$targetEntityType};
1928        # Get the field table for the entity.
1929        my $entityFields = $self->GetFieldTable($targetEntity);
1930        # The field table is a hash. The hash key is the field name. The hash value is a structure.
1931        # For the entity fields, the key aspect of the target structure is that the {relation} value
1932        # must match the entity name.
1933        my @fieldList = map { "$targetEntity($_)" } grep { $entityFields->{$_}->{relation} eq $targetEntity }
1934                            keys %{$entityFields};
1935        # Push the fields found onto the return variable.
1936        push @retVal, sort @fieldList;
1937        # Get the field table for the relationship.
1938        my $relationshipFields = $self->GetFieldTable($relationship);
1939        # Here we have a different rule. We want all the fields other than "from-link" and "to-link".
1940        # This may end up being an empty set.
1941        my @fieldList2 = map { "$relationship($_)" } grep { $_ ne "from-link" && $_ ne "to-link" }
1942                            keys %{$relationshipFields};
1943        # Push these onto the return list.
1944        push @retVal, sort @fieldList2;
1945        # Return the result.
1946        return @retVal;
1947    }
1948    
1949  =head2 Internal Utility Methods  =head2 Internal Utility Methods
1950    
1951  =head3 GetLoadStats  =head3 GetLoadStats
# Line 1894  Line 2152 
2152      return $objectData->{Relations};      return $objectData->{Relations};
2153  }  }
2154    
 =head3 GetFieldTable  
   
 Get the field structure for a specified entity or relationship.  
   
 This is an instance method.  
   
 =over 4  
   
 =item objectName  
   
 Name of the desired entity or relationship.  
   
 =item RETURN  
   
 The table containing the field descriptors for the specified object.  
   
 =back  
   
 =cut  
   
 sub _GetFieldTable {  
     # Get the parameters.  
     my ($self, $objectName) = @_;  
     # Get the descriptor from the metadata.  
     my $objectData = $self->_GetStructure($objectName);  
     # Return the object's field table.  
     return $objectData->{Fields};  
 }  
   
2155  =head3 ValidateFieldNames  =head3 ValidateFieldNames
2156    
2157  Determine whether or not the field names are valid. A description of the problems with the names  Determine whether or not the field names are valid. A description of the problems with the names

Legend:
Removed from v.1.31  
changed lines
  Added in v.1.38

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3