Parent Directory
| 
Revision Log
Revision 1.2 - (view) (download) (as text)
| 1 : | parrello | 1.1 | package ERDBObject; |
| 2 : | |||
| 3 : | use strict; | ||
| 4 : | use DBKernel; | ||
| 5 : | use Tracer; | ||
| 6 : | |||
| 7 : | =head1 Entity-Relationship Database Package Instance Object | ||
| 8 : | |||
| 9 : | =head2 Introduction | ||
| 10 : | |||
| 11 : | This package defines the instance object for the Entity-Relationship Database Package. | ||
| 12 : | This object can be created directly, returned by the C<Fetch> | ||
| 13 : | method of the B<DBQuery> object, or returned by the C<Cross> method of this object. | ||
| 14 : | An object created directly is considered I<transient>. An object created by one of the | ||
| 15 : | database methods is considered I<persistent>. A transient object can be made persistent | ||
| 16 : | using the C<Insert> method of the B<ERDB> object. | ||
| 17 : | |||
| 18 : | An instance object allows the user to access the fields in the current instance. The | ||
| 19 : | instance consists of zero or more entity and/or relationship objects and a map of field | ||
| 20 : | names to locations. Some entity fields require additional queries to the database. If | ||
| 21 : | the entity object is present, the additional queries are executed automatically. Otherwise, | ||
| 22 : | the value is treated as missing. | ||
| 23 : | |||
| 24 : | =head2 Public Methods | ||
| 25 : | |||
| 26 : | =head3 new | ||
| 27 : | |||
| 28 : | C<< my $dbObject = ERDBObject::new($name1 => \@list1, $name2 => \@list2, ... $nameN => \@listN); >> | ||
| 29 : | |||
| 30 : | Create a new transient object. A transient object maps fields to values, but is not | ||
| 31 : | associated with a database. The parameter list should be an entity name followed by | ||
| 32 : | a set of key-value pairs. Each key should be in the standard I<objectName>C<(>I<attributeName>C<)> | ||
| 33 : | format used by all of the ERDB methods. All values must be list references. For example, | ||
| 34 : | parrello | 1.2 | the following code fragment creates an pseudo-Feature named C<peg.1> with two hyperlinks. |
| 35 : | parrello | 1.1 | |
| 36 : | parrello | 1.2 | my $feature = ERDBObject::new('Feature(id)' => ['peg.1'], |
| 37 : | 'Feature(link)' => ['http://www.undhoople.edu/NC1004.html', | ||
| 38 : | 'http://www.miskatonic.edu/PC1006.html']); | ||
| 39 : | parrello | 1.1 | |
| 40 : | =cut | ||
| 41 : | |||
| 42 : | sub new { | ||
| 43 : | # Create the value list. | ||
| 44 : | my %values = (); | ||
| 45 : | # Loop through the parameters. | ||
| 46 : | my @parms = @_; | ||
| 47 : | while (@parms > 0) { | ||
| 48 : | # Get the current key-value pair. | ||
| 49 : | my $list = pop @parms; | ||
| 50 : | my $name = pop @parms; | ||
| 51 : | # Put this key-value pair in the value hash | ||
| 52 : | $values{$name} = $list; | ||
| 53 : | } | ||
| 54 : | # Create this object and bless it. | ||
| 55 : | my $retVal = { _values => \%values, _newObjectFlag => 1 }; | ||
| 56 : | bless $retVal; | ||
| 57 : | return $retVal; | ||
| 58 : | } | ||
| 59 : | |||
| 60 : | =head3 SetDB | ||
| 61 : | |||
| 62 : | C<< my = $dbObject->SetDB($db, $target); >> | ||
| 63 : | |||
| 64 : | Attach a database to this object. This method is useful if you have to create an | ||
| 65 : | object manually (using L</new>) but want to be able to use the database methods | ||
| 66 : | (e.g. L</Cross>) to retrieve additional data. | ||
| 67 : | |||
| 68 : | =over 4 | ||
| 69 : | |||
| 70 : | =item db | ||
| 71 : | |||
| 72 : | B<ERDB> object for the database to use. | ||
| 73 : | |||
| 74 : | =item target | ||
| 75 : | |||
| 76 : | Name of the entity relevant to this object. This parameter is important for cases where | ||
| 77 : | a single B<ERDBObject> actually has data from multiple tables. The parameter indicates | ||
| 78 : | the table from which a relationship crossing should occur. So, for example, a ERDBObject | ||
| 79 : | could contain data from the I<IsLocatedIn> and I<Contig> tables; we would specify a | ||
| 80 : | target of I<Contig> so that the L</Cross> method crosses from there. | ||
| 81 : | |||
| 82 : | =back | ||
| 83 : | |||
| 84 : | =cut | ||
| 85 : | #: Return Type ; | ||
| 86 : | sub SetDB { | ||
| 87 : | # Get the parameters. | ||
| 88 : | my ($self, $db, $target) = @_; | ||
| 89 : | # Store the database and target entity data. | ||
| 90 : | $self->{_db} = $db; | ||
| 91 : | $self->{_targetEntity} = $target; | ||
| 92 : | } | ||
| 93 : | |||
| 94 : | =head3 Attributes | ||
| 95 : | |||
| 96 : | C<< my @attrNames = $dbObject->Attributes(); >> | ||
| 97 : | |||
| 98 : | This method will return a sorted list of the attributes present in this object. | ||
| 99 : | The list can be used in the L</Values> method to get all the values stored. | ||
| 100 : | |||
| 101 : | If the ERDBObject was created by a database query, the attributes returned will | ||
| 102 : | only be those which occur on the primary relation. Additional fields may get | ||
| 103 : | loaded into the object if the client has asked for them in a L</Value> or | ||
| 104 : | L</Values> command. Initially, however, only the primary fields-- each of which | ||
| 105 : | has one and only one value-- will be found in the attribute list. | ||
| 106 : | |||
| 107 : | =cut | ||
| 108 : | #: Return Type @; | ||
| 109 : | sub Attributes { | ||
| 110 : | # Get the parameters. | ||
| 111 : | my ($self) = @_; | ||
| 112 : | # Get the keys of the value hash. | ||
| 113 : | my @retVal = sort keys %{$self->{_values}}; | ||
| 114 : | # Return the result. | ||
| 115 : | return @retVal; | ||
| 116 : | } | ||
| 117 : | |||
| 118 : | =head3 HasField | ||
| 119 : | |||
| 120 : | C<< my $flag = $dbObject->HasField($fieldSpec); >> | ||
| 121 : | |||
| 122 : | Return TRUE if this object has the specified field available, else FALSE. | ||
| 123 : | This method can be used to determine if a value is available without | ||
| 124 : | requiring an additional database query. | ||
| 125 : | |||
| 126 : | =over 4 | ||
| 127 : | |||
| 128 : | =item fieldSpec | ||
| 129 : | |||
| 130 : | A standard field specifier, as is used to specify fields to the B<Get> | ||
| 131 : | method of the B<Sprout> object. | ||
| 132 : | |||
| 133 : | =item RETURN | ||
| 134 : | |||
| 135 : | Returns TRUE if there's a value for the field in this object, else FALSE. | ||
| 136 : | |||
| 137 : | =back | ||
| 138 : | |||
| 139 : | =cut | ||
| 140 : | |||
| 141 : | sub HasField { | ||
| 142 : | # Get the parameters. | ||
| 143 : | my ($self, $fieldName) = @_; | ||
| 144 : | # Get the field hash. | ||
| 145 : | my $fields = $self->{_values}; | ||
| 146 : | # Return the result. | ||
| 147 : | return exists $fields->{$fieldName}; | ||
| 148 : | } | ||
| 149 : | |||
| 150 : | =head3 AddValues | ||
| 151 : | |||
| 152 : | C<< $dbObject->AddValues($name, @values); >> | ||
| 153 : | |||
| 154 : | Add one or more values to a specified field. | ||
| 155 : | |||
| 156 : | =over 4 | ||
| 157 : | |||
| 158 : | =item name | ||
| 159 : | |||
| 160 : | Name of the field to receive the new values. If the field does | ||
| 161 : | not exist, it will be created. | ||
| 162 : | |||
| 163 : | =item values | ||
| 164 : | |||
| 165 : | List of values to put in the field. | ||
| 166 : | |||
| 167 : | =back | ||
| 168 : | |||
| 169 : | =cut | ||
| 170 : | |||
| 171 : | sub AddValues { | ||
| 172 : | # Get the parameters. | ||
| 173 : | my ($self, $name, @values) = @_; | ||
| 174 : | # Get the field hash. | ||
| 175 : | my $fields = $self->{_values}; | ||
| 176 : | # Add the new values. | ||
| 177 : | Tracer::AddToListMap($fields, $name, @values); | ||
| 178 : | } | ||
| 179 : | |||
| 180 : | =head3 Value | ||
| 181 : | |||
| 182 : | C<< my @values = $dbObject->Value($attributeName); >> | ||
| 183 : | |||
| 184 : | Return a list of the values for the specified attribute. | ||
| 185 : | |||
| 186 : | =over 4 | ||
| 187 : | |||
| 188 : | =item attributeName | ||
| 189 : | |||
| 190 : | Name of the desired attribute, in the form B<I<objectName>(I<fieldName>)>. | ||
| 191 : | |||
| 192 : | =item RETURN | ||
| 193 : | |||
| 194 : | Returns a list of the values for the specified attribute, which may have 0, 1, or | ||
| 195 : | multiple values. | ||
| 196 : | |||
| 197 : | =back | ||
| 198 : | |||
| 199 : | =cut | ||
| 200 : | |||
| 201 : | sub Value { | ||
| 202 : | # Get the parameters. | ||
| 203 : | my ($self, $attributeName) = @_; | ||
| 204 : | # Declare the return variable. | ||
| 205 : | my @retVal = (); | ||
| 206 : | # Look for the field in the values hash. | ||
| 207 : | my $fieldHash = $self->{_values}; | ||
| 208 : | my $retValRef = $fieldHash->{$attributeName}; | ||
| 209 : | Trace("retValRef for $attributeName is \"$retValRef\".") if T(Fields => 3); | ||
| 210 : | if (defined $retValRef) { | ||
| 211 : | # Here we have the field already, so return it. | ||
| 212 : | @retVal = @{$retValRef}; | ||
| 213 : | } else { | ||
| 214 : | # Here the field is not in the hash. If we don't have a database, we are | ||
| 215 : | # done. The user will automatically get an empty list handed back to him. | ||
| 216 : | if (exists $self->{_db}) { | ||
| 217 : | # We have a database, so we can look for the value in a secondary relation. | ||
| 218 : | # We start by getting the object name and the attribute name. Note | ||
| 219 : | # that the object must be an entity, since relationships don't have | ||
| 220 : | # secondary relations. | ||
| 221 : | $attributeName =~ /^([^(]*)\(([^)]*)\)/; | ||
| 222 : | my ($entityName, $fieldName) = ($1, $2); | ||
| 223 : | my $entityData = $self->{_db}->{_metaData}->{Entities}->{$entityName}; | ||
| 224 : | # Determine the name of the relation that contains this field. | ||
| 225 : | my $relationName = $entityData->{Fields}->{$fieldName}->{relation}; | ||
| 226 : | # Get the actual name of the field. | ||
| 227 : | my $fixedFieldName = ERDB::_FixName($fieldName); | ||
| 228 : | # Get the entity instance's ID. | ||
| 229 : | my $id = $fieldHash->{"$entityName(id)"}->[0]; | ||
| 230 : | # Create the SELECT statement for the desired relation and execute it. | ||
| 231 : | my $command = "SELECT $fixedFieldName FROM $relationName WHERE id = ?"; | ||
| 232 : | Trace("SQL subquery for '$id': $command") if T(SQL => 4); | ||
| 233 : | my $sth = $self->{_db}->{_dbh}->prepare_command($command); | ||
| 234 : | $sth->execute($id) || Confess("Subquery for $attributeName failed: " . $sth->errstr); | ||
| 235 : | # Loop through the query results creating a list of the values found. | ||
| 236 : | my $rows = $sth->fetchall_arrayref; | ||
| 237 : | for my $row (@{$rows}) { | ||
| 238 : | # Note we un-escape the value before stuffing it in the result list. | ||
| 239 : | my $realValue = Tracer::UnEscape($row->[0]); | ||
| 240 : | push @retVal, $row->[0]; | ||
| 241 : | } | ||
| 242 : | # Put the list in the field hash for future use. | ||
| 243 : | $fieldHash->{"$entityName($fieldName)"} = \@retVal; | ||
| 244 : | } | ||
| 245 : | } | ||
| 246 : | # Return the field values found. | ||
| 247 : | return @retVal; | ||
| 248 : | } | ||
| 249 : | |||
| 250 : | =head3 Values | ||
| 251 : | |||
| 252 : | C<< my @values = $dbObject->Values(\@attributeNames); >> | ||
| 253 : | |||
| 254 : | This method returns a list of all the values for a list of field specifiers. Essentially, it calls | ||
| 255 : | the L</Value> method for each element in the parameter list and returns a flattened list of all | ||
| 256 : | the results. | ||
| 257 : | |||
| 258 : | parrello | 1.2 | For example, let us say that C<$feature> contains a feature with two links and a translation. |
| 259 : | The following call will put the feature links in C<$link1> and C<$link2> and the translation in | ||
| 260 : | parrello | 1.1 | C<$translation>. |
| 261 : | |||
| 262 : | parrello | 1.2 | C<< my ($link1, $link2, $translation) = $feature->Values(['Feature(link)', 'Feature(translation)']); >> |
| 263 : | parrello | 1.1 | |
| 264 : | =over 4 | ||
| 265 : | |||
| 266 : | =item attributeNames | ||
| 267 : | |||
| 268 : | List of attribute names. | ||
| 269 : | |||
| 270 : | =item RETURN | ||
| 271 : | |||
| 272 : | Returns a flattened list of all the results found for each specified field. | ||
| 273 : | |||
| 274 : | =back | ||
| 275 : | |||
| 276 : | =cut | ||
| 277 : | |||
| 278 : | sub Values { | ||
| 279 : | # Get the parameters. | ||
| 280 : | my ($self, $attributeNames) = @_; | ||
| 281 : | # Create the return list. | ||
| 282 : | my @retVal = (); | ||
| 283 : | # Loop through the specifiers, pushing their values into the return list. | ||
| 284 : | for my $specifier (@{$attributeNames}) { | ||
| 285 : | push @retVal, $self->Value($specifier); | ||
| 286 : | } | ||
| 287 : | # Return the resulting list. | ||
| 288 : | return @retVal; | ||
| 289 : | } | ||
| 290 : | |||
| 291 : | =head3 Cross | ||
| 292 : | |||
| 293 : | C<< my $query = $dbObject->Cross($relationshipName, $filterClause, $param1, $param2, ... $paramN); >> | ||
| 294 : | |||
| 295 : | Return a query object for instances related to this one via a specified relationship. | ||
| 296 : | |||
| 297 : | =over 4 | ||
| 298 : | |||
| 299 : | =item relationshipName | ||
| 300 : | |||
| 301 : | Name of the relationship to cross. | ||
| 302 : | |||
| 303 : | =item filterClause | ||
| 304 : | |||
| 305 : | WHERE clause (without the WHERE) to be used to filter the query. The WHERE clause can be | ||
| 306 : | parameterized with parameter markers (C<?>). Each field used in the WHERE clause must be | ||
| 307 : | specified in the standard form B<I<objectName>(I<fieldName>)>. | ||
| 308 : | |||
| 309 : | =item param1, param2, ..., paramN | ||
| 310 : | |||
| 311 : | Parameters for the filter clause. | ||
| 312 : | |||
| 313 : | =back | ||
| 314 : | |||
| 315 : | =cut | ||
| 316 : | |||
| 317 : | sub Cross { | ||
| 318 : | # Get the parameters. | ||
| 319 : | my ($self, $relationshipName, $filterClause, @params) = @_; | ||
| 320 : | # Make sure the filter clause is not undefined. Empty is okay, just not undefined. | ||
| 321 : | if (! defined($filterClause)) { | ||
| 322 : | $filterClause = ""; | ||
| 323 : | } | ||
| 324 : | # Get access to the key metadata structures. | ||
| 325 : | my $db = $self->{_db}; | ||
| 326 : | my $metadata = $db->{_metaData}; | ||
| 327 : | my $entities = $metadata->{Entities}; | ||
| 328 : | my $relationships = $metadata->{Relationships}; | ||
| 329 : | # Determine whether we are using the from-link or the to-link, and get the name of the | ||
| 330 : | # entity on the other side of the relationship. | ||
| 331 : | my ($startLinkName, $targetLinkName, $targetEntity); | ||
| 332 : | my $relationship = $relationships->{$relationshipName}; | ||
| 333 : | my $startingEntity = $self->{_targetEntity}; | ||
| 334 : | if ($relationship->{from} eq $startingEntity) { | ||
| 335 : | # Here we're starting at the FROM entity. | ||
| 336 : | $startLinkName = "$relationshipName(from-link)"; | ||
| 337 : | $targetEntity = $relationship->{to}; | ||
| 338 : | } else { | ||
| 339 : | # Here we're starting at the TO entity. | ||
| 340 : | $startLinkName = "$relationshipName(to-link)"; | ||
| 341 : | $targetEntity = $relationship->{from}; | ||
| 342 : | } | ||
| 343 : | # Get the ID of the starting instance. | ||
| 344 : | my ($id) = $self->Value("$startingEntity(id)"); | ||
| 345 : | # Create the WHERE clause. | ||
| 346 : | my $superFilter = "$startLinkName = ?"; | ||
| 347 : | # Analyze the filter clause. We need to pull out any strings and put them in parameters. | ||
| 348 : | # Then we need to look for ORDER BY and LIMIT to position any parentheses we need. This | ||
| 349 : | # will require a major parse of the filter string. The first step is to find the last | ||
| 350 : | # single quote. Note that if there are no quotes, this will return -1. | ||
| 351 : | my $lastQuote = rindex $filterClause, "'"; | ||
| 352 : | # Compute the position in the string after the last quote. All our searches will start | ||
| 353 : | # from there. | ||
| 354 : | my $startPos = $lastQuote + 1; | ||
| 355 : | # Look for ORDER BY. | ||
| 356 : | my $orderBy = index $filterClause, "ORDER BY", $startPos; | ||
| 357 : | # Look for LIMIT. | ||
| 358 : | my $limit = index $filterClause, "LIMIT", $startPos; | ||
| 359 : | # Choose the first of these two clauses. That's where the real filter ends. | ||
| 360 : | my $addendaPos = ($orderBy < 0 ? $limit : ($limit < 0 ? $orderBy : | ||
| 361 : | ($orderBy < $limit ? $orderBy : $limit))); | ||
| 362 : | # We have four cases: no ORDER BY or LIMIT, only ORDER BY or LIMIT, no filter at | ||
| 363 : | # all, or ORDER BY or LIMIT present in the middle of the filter string. If we're | ||
| 364 : | # only ORDER BY or LIMIT , no additional parentheses are needed. Similarly if there's | ||
| 365 : | # no filter string at all. Hwever, in the other cases we need to put | ||
| 366 : | # parentheses around the WHERE part of the filter. | ||
| 367 : | if ($addendaPos < 0 && length($filterClause) > 0) { | ||
| 368 : | # No ORDER BY or LIMIT: parentheses surround the whole clause. | ||
| 369 : | $filterClause = "AND ($filterClause)"; | ||
| 370 : | } elsif ($addendaPos > 0) { | ||
| 371 : | # Open parentheses at the beginning, and close them right before the ORDER BY | ||
| 372 : | # or LIMIT part. | ||
| 373 : | $filterClause = "AND (" . substr($filterClause, 0, $addendaPos) . ") " . | ||
| 374 : | substr($filterClause, $addendaPos); | ||
| 375 : | } | ||
| 376 : | # Add the incoming filter to the filter we've built. | ||
| 377 : | $superFilter .= " $filterClause"; | ||
| 378 : | # Create a relation-crossing query and return it. | ||
| 379 : | Trace("Calling GET from CROSS. Filter is $superFilter.") if T(4); | ||
| 380 : | my $retVal = $db->Get([$relationshipName, $targetEntity], $superFilter, [$id, @params]); | ||
| 381 : | return $retVal; | ||
| 382 : | } | ||
| 383 : | |||
| 384 : | =head3 IsNew | ||
| 385 : | |||
| 386 : | C<< my $boolean = $dbObject->IsNew(); >> | ||
| 387 : | |||
| 388 : | Return TRUE if this is a new object inserted into the database, or FALSE if it was loaded from | ||
| 389 : | the input data files. | ||
| 390 : | |||
| 391 : | =cut | ||
| 392 : | |||
| 393 : | sub IsNew { | ||
| 394 : | # Get the parameters. | ||
| 395 : | my ($self) = @_; | ||
| 396 : | return $self->{_newObjectFlag}; | ||
| 397 : | } | ||
| 398 : | |||
| 399 : | =head2 Utility Methods | ||
| 400 : | |||
| 401 : | =head3 _new | ||
| 402 : | |||
| 403 : | Create a new instance object. | ||
| 404 : | |||
| 405 : | This is a static method. | ||
| 406 : | |||
| 407 : | =over 4 | ||
| 408 : | |||
| 409 : | =item dbquery | ||
| 410 : | |||
| 411 : | B<DBQuery> object for the relevant query. | ||
| 412 : | |||
| 413 : | =item value, value2, ... valueN | ||
| 414 : | |||
| 415 : | List of values returned by the query for the current object. | ||
| 416 : | |||
| 417 : | =back | ||
| 418 : | |||
| 419 : | =cut | ||
| 420 : | |||
| 421 : | sub _new { | ||
| 422 : | # Get the parameters. | ||
| 423 : | my ($dbquery, @values) = @_; | ||
| 424 : | # Pull out the ERDB object and the relationship map. | ||
| 425 : | my $database = $dbquery->{_db}; | ||
| 426 : | my $relationMap = $dbquery->{_objectNames}; | ||
| 427 : | # Get the metadata. | ||
| 428 : | my $metadata = $database->{_metaData}; | ||
| 429 : | my $entities = $metadata->{Entities}; | ||
| 430 : | my $relationships = $metadata->{Relationships}; | ||
| 431 : | # This variable will be used to save the name of the last entity in the object list. | ||
| 432 : | # That entity is the one we'll start from when crossing relationships. | ||
| 433 : | my $target; | ||
| 434 : | # Create the field hash table. | ||
| 435 : | my %fieldHash = (); | ||
| 436 : | # Check for search relevance. | ||
| 437 : | if ($dbquery->{_fullText}) { | ||
| 438 : | # Create the special search relevance field from the first element of the row values. | ||
| 439 : | # Note that the object name is the value of the _fullText property. | ||
| 440 : | my $relevanceName = "$dbquery->{_fullText}(search-relevance)"; | ||
| 441 : | $fieldHash{$relevanceName} = [shift @values]; | ||
| 442 : | } | ||
| 443 : | # Denote that so far this does not appear to be a new object (as opposed to a loaded object). | ||
| 444 : | my $newObjectFlag = 0; | ||
| 445 : | # Loop through the object names, extracting its fields. We will strip each field from | ||
| 446 : | # the value array and add it to the hash table using the ERDB-format field name. | ||
| 447 : | for my $mappingPair (@{$relationMap}) { | ||
| 448 : | # Get the real object name for this mapped name. | ||
| 449 : | my ($mappedObjectName, $objectName) = @{$mappingPair}; | ||
| 450 : | # Declare the variable to hold the field list and the entity flag. | ||
| 451 : | my ($fieldList, $entityFlag); | ||
| 452 : | # Get the descriptor for this object. | ||
| 453 : | my $objectDescriptor = $entities->{$objectName}; | ||
| 454 : | if ($objectDescriptor) { | ||
| 455 : | # Here we have an entity object. | ||
| 456 : | $target = $objectName; | ||
| 457 : | $fieldList = $objectDescriptor->{Relations}->{$objectName}->{Fields}; | ||
| 458 : | $entityFlag = 1; | ||
| 459 : | } else { | ||
| 460 : | $objectDescriptor = $relationships->{$objectName}; | ||
| 461 : | if ($objectDescriptor) { | ||
| 462 : | # Here we have a relationship object. | ||
| 463 : | $fieldList = $objectDescriptor->{Relations}->{$objectName}->{Fields}; | ||
| 464 : | $entityFlag = 0; | ||
| 465 : | } else { | ||
| 466 : | Confess("Object $objectName not found in database."); | ||
| 467 : | } | ||
| 468 : | } | ||
| 469 : | # Loop through the field list. | ||
| 470 : | for my $field (@{$fieldList}) { | ||
| 471 : | # Get the current value from the array. | ||
| 472 : | my $thisValue = shift @values; | ||
| 473 : | # Un-escape its text. | ||
| 474 : | my $realValue = Tracer::UnEscape($thisValue); | ||
| 475 : | # Get the current field's name. | ||
| 476 : | my $fieldName = $field->{name}; | ||
| 477 : | # Add the field's name and value to the hash table. | ||
| 478 : | my $fieldKey = "$mappedObjectName($fieldName)"; | ||
| 479 : | $fieldHash{$fieldKey} = [$realValue]; | ||
| 480 : | Trace("$fieldKey = '$thisValue'") if T(Fields => 3); | ||
| 481 : | } | ||
| 482 : | # Save the new-object flag. | ||
| 483 : | $newObjectFlag = shift @values; | ||
| 484 : | } | ||
| 485 : | # Create the result object. | ||
| 486 : | my $self = { _db => $database, _targetEntity => $target, _values => \%fieldHash, | ||
| 487 : | _newObjectFlag => $newObjectFlag }; | ||
| 488 : | # Bless and return it. | ||
| 489 : | bless $self; | ||
| 490 : | return $self; | ||
| 491 : | } | ||
| 492 : | |||
| 493 : | 1; |
| MCS Webmaster | ViewVC Help |
| Powered by ViewVC 1.0.3 |