[Bio] / Sprout / ERDBObject.pm Repository:
ViewVC logotype

Annotation of /Sprout/ERDBObject.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (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 : parrello 1.4 my $dbObject = ERDBObject::new($name1 => \@list1, $name2 => \@list2, ... $nameN => \@listN);
29 : parrello 1.1
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 : parrello 1.4 my = $dbObject->SetDB($db, $target);
63 : parrello 1.1
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 : parrello 1.4 my @attrNames = $dbObject->Attributes();
97 : parrello 1.1
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 : parrello 1.4 my $flag = $dbObject->HasField($fieldSpec);
121 : parrello 1.1
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 : parrello 1.4 $dbObject->AddValues($name, @values);
153 : parrello 1.1
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 : parrello 1.5 push @{$fields->{$name}}, @values;
178 : parrello 1.1 }
179 :    
180 : parrello 1.3 =head3 PrimaryValue
181 :    
182 : parrello 1.4 my $value = $dbObject->PrimaryValue($name);
183 : parrello 1.3
184 :     Return the primary value of a field. This will be its first value in a standard value list.
185 :    
186 :     This method is a more convenient version of L</Value>. Basically, the call
187 :    
188 :     my ($value) = $dbObject->Value($name);
189 :    
190 :     is equivalent to
191 :    
192 :     my $value = $dbObject->PrimaryValue($name);
193 :    
194 :     but the latter is syntactically more convenient.
195 :    
196 :     =over 4
197 :    
198 :     =item name
199 :    
200 :     Name of the field whose value is desired, in the standard form.
201 :    
202 :     =item RETURN
203 :    
204 :     Returns the value of the specified field, or C<undef> if the field has no value.
205 :    
206 :     =back
207 :    
208 :     =cut
209 :    
210 :     sub PrimaryValue {
211 :     # Get the parameters.
212 :     my ($self, $name) = @_;
213 :     # Get the value.
214 :     my ($retVal) = $self->Value($name);
215 :     # Return it.
216 :     return $retVal;
217 :     }
218 :    
219 : parrello 1.1 =head3 Value
220 :    
221 : parrello 1.4 my @values = $dbObject->Value($attributeName);
222 : parrello 1.1
223 :     Return a list of the values for the specified attribute.
224 :    
225 :     =over 4
226 :    
227 :     =item attributeName
228 :    
229 :     Name of the desired attribute, in the form B<I<objectName>(I<fieldName>)>.
230 :    
231 :     =item RETURN
232 :    
233 :     Returns a list of the values for the specified attribute, which may have 0, 1, or
234 :     multiple values.
235 :    
236 :     =back
237 :    
238 :     =cut
239 :    
240 :     sub Value {
241 :     # Get the parameters.
242 :     my ($self, $attributeName) = @_;
243 :     # Declare the return variable.
244 :     my @retVal = ();
245 :     # Look for the field in the values hash.
246 :     my $fieldHash = $self->{_values};
247 :     my $retValRef = $fieldHash->{$attributeName};
248 :     Trace("retValRef for $attributeName is \"$retValRef\".") if T(Fields => 3);
249 :     if (defined $retValRef) {
250 :     # Here we have the field already, so return it.
251 :     @retVal = @{$retValRef};
252 :     } else {
253 :     # Here the field is not in the hash. If we don't have a database, we are
254 :     # done. The user will automatically get an empty list handed back to him.
255 :     if (exists $self->{_db}) {
256 :     # We have a database, so we can look for the value in a secondary relation.
257 :     # We start by getting the object name and the attribute name. Note
258 :     # that the object must be an entity, since relationships don't have
259 :     # secondary relations.
260 :     $attributeName =~ /^([^(]*)\(([^)]*)\)/;
261 :     my ($entityName, $fieldName) = ($1, $2);
262 :     my $entityData = $self->{_db}->{_metaData}->{Entities}->{$entityName};
263 :     # Determine the name of the relation that contains this field.
264 :     my $relationName = $entityData->{Fields}->{$fieldName}->{relation};
265 :     # Get the actual name of the field.
266 :     my $fixedFieldName = ERDB::_FixName($fieldName);
267 :     # Get the entity instance's ID.
268 :     my $id = $fieldHash->{"$entityName(id)"}->[0];
269 :     # Create the SELECT statement for the desired relation and execute it.
270 :     my $command = "SELECT $fixedFieldName FROM $relationName WHERE id = ?";
271 :     Trace("SQL subquery for '$id': $command") if T(SQL => 4);
272 :     my $sth = $self->{_db}->{_dbh}->prepare_command($command);
273 :     $sth->execute($id) || Confess("Subquery for $attributeName failed: " . $sth->errstr);
274 :     # Loop through the query results creating a list of the values found.
275 :     my $rows = $sth->fetchall_arrayref;
276 :     for my $row (@{$rows}) {
277 :     # Note we un-escape the value before stuffing it in the result list.
278 :     my $realValue = Tracer::UnEscape($row->[0]);
279 :     push @retVal, $row->[0];
280 :     }
281 :     # Put the list in the field hash for future use.
282 :     $fieldHash->{"$entityName($fieldName)"} = \@retVal;
283 :     }
284 :     }
285 :     # Return the field values found.
286 :     return @retVal;
287 :     }
288 :    
289 :     =head3 Values
290 :    
291 : parrello 1.4 my @values = $dbObject->Values(\@attributeNames);
292 : parrello 1.1
293 :     This method returns a list of all the values for a list of field specifiers. Essentially, it calls
294 :     the L</Value> method for each element in the parameter list and returns a flattened list of all
295 :     the results.
296 :    
297 : parrello 1.2 For example, let us say that C<$feature> contains a feature with two links and a translation.
298 :     The following call will put the feature links in C<$link1> and C<$link2> and the translation in
299 : parrello 1.1 C<$translation>.
300 :    
301 : parrello 1.4 my ($link1, $link2, $translation) = $feature->Values(['Feature(link)', 'Feature(translation)']);
302 : parrello 1.1
303 :     =over 4
304 :    
305 :     =item attributeNames
306 :    
307 :     List of attribute names.
308 :    
309 :     =item RETURN
310 :    
311 :     Returns a flattened list of all the results found for each specified field.
312 :    
313 :     =back
314 :    
315 :     =cut
316 :    
317 :     sub Values {
318 :     # Get the parameters.
319 :     my ($self, $attributeNames) = @_;
320 :     # Create the return list.
321 :     my @retVal = ();
322 :     # Loop through the specifiers, pushing their values into the return list.
323 :     for my $specifier (@{$attributeNames}) {
324 :     push @retVal, $self->Value($specifier);
325 :     }
326 :     # Return the resulting list.
327 :     return @retVal;
328 :     }
329 :    
330 :     =head3 Cross
331 :    
332 : parrello 1.4 my $query = $dbObject->Cross($relationshipName, $filterClause, $param1, $param2, ... $paramN);
333 : parrello 1.1
334 :     Return a query object for instances related to this one via a specified relationship.
335 :    
336 :     =over 4
337 :    
338 :     =item relationshipName
339 :    
340 :     Name of the relationship to cross.
341 :    
342 :     =item filterClause
343 :    
344 :     WHERE clause (without the WHERE) to be used to filter the query. The WHERE clause can be
345 :     parameterized with parameter markers (C<?>). Each field used in the WHERE clause must be
346 :     specified in the standard form B<I<objectName>(I<fieldName>)>.
347 :    
348 :     =item param1, param2, ..., paramN
349 :    
350 :     Parameters for the filter clause.
351 :    
352 :     =back
353 :    
354 :     =cut
355 :    
356 :     sub Cross {
357 :     # Get the parameters.
358 :     my ($self, $relationshipName, $filterClause, @params) = @_;
359 :     # Make sure the filter clause is not undefined. Empty is okay, just not undefined.
360 :     if (! defined($filterClause)) {
361 :     $filterClause = "";
362 :     }
363 :     # Get access to the key metadata structures.
364 :     my $db = $self->{_db};
365 :     my $metadata = $db->{_metaData};
366 :     my $entities = $metadata->{Entities};
367 :     my $relationships = $metadata->{Relationships};
368 :     # Determine whether we are using the from-link or the to-link, and get the name of the
369 :     # entity on the other side of the relationship.
370 :     my ($startLinkName, $targetLinkName, $targetEntity);
371 :     my $relationship = $relationships->{$relationshipName};
372 :     my $startingEntity = $self->{_targetEntity};
373 :     if ($relationship->{from} eq $startingEntity) {
374 :     # Here we're starting at the FROM entity.
375 :     $startLinkName = "$relationshipName(from-link)";
376 :     $targetEntity = $relationship->{to};
377 :     } else {
378 :     # Here we're starting at the TO entity.
379 :     $startLinkName = "$relationshipName(to-link)";
380 :     $targetEntity = $relationship->{from};
381 :     }
382 :     # Get the ID of the starting instance.
383 : parrello 1.3 my $id = $self->PrimaryValue("$startingEntity(id)");
384 : parrello 1.1 # Create the WHERE clause.
385 :     my $superFilter = "$startLinkName = ?";
386 :     # Analyze the filter clause. We need to pull out any strings and put them in parameters.
387 :     # Then we need to look for ORDER BY and LIMIT to position any parentheses we need. This
388 :     # will require a major parse of the filter string. The first step is to find the last
389 :     # single quote. Note that if there are no quotes, this will return -1.
390 :     my $lastQuote = rindex $filterClause, "'";
391 :     # Compute the position in the string after the last quote. All our searches will start
392 :     # from there.
393 :     my $startPos = $lastQuote + 1;
394 :     # Look for ORDER BY.
395 :     my $orderBy = index $filterClause, "ORDER BY", $startPos;
396 :     # Look for LIMIT.
397 :     my $limit = index $filterClause, "LIMIT", $startPos;
398 :     # Choose the first of these two clauses. That's where the real filter ends.
399 :     my $addendaPos = ($orderBy < 0 ? $limit : ($limit < 0 ? $orderBy :
400 :     ($orderBy < $limit ? $orderBy : $limit)));
401 :     # We have four cases: no ORDER BY or LIMIT, only ORDER BY or LIMIT, no filter at
402 :     # all, or ORDER BY or LIMIT present in the middle of the filter string. If we're
403 :     # only ORDER BY or LIMIT , no additional parentheses are needed. Similarly if there's
404 :     # no filter string at all. Hwever, in the other cases we need to put
405 :     # parentheses around the WHERE part of the filter.
406 :     if ($addendaPos < 0 && length($filterClause) > 0) {
407 :     # No ORDER BY or LIMIT: parentheses surround the whole clause.
408 :     $filterClause = "AND ($filterClause)";
409 :     } elsif ($addendaPos > 0) {
410 :     # Open parentheses at the beginning, and close them right before the ORDER BY
411 :     # or LIMIT part.
412 :     $filterClause = "AND (" . substr($filterClause, 0, $addendaPos) . ") " .
413 :     substr($filterClause, $addendaPos);
414 :     }
415 :     # Add the incoming filter to the filter we've built.
416 :     $superFilter .= " $filterClause";
417 :     # Create a relation-crossing query and return it.
418 :     Trace("Calling GET from CROSS. Filter is $superFilter.") if T(4);
419 :     my $retVal = $db->Get([$relationshipName, $targetEntity], $superFilter, [$id, @params]);
420 :     return $retVal;
421 :     }
422 :    
423 :     =head3 IsNew
424 :    
425 : parrello 1.4 my $boolean = $dbObject->IsNew();
426 : parrello 1.1
427 :     Return TRUE if this is a new object inserted into the database, or FALSE if it was loaded from
428 :     the input data files.
429 :    
430 :     =cut
431 :    
432 :     sub IsNew {
433 :     # Get the parameters.
434 :     my ($self) = @_;
435 :     return $self->{_newObjectFlag};
436 :     }
437 :    
438 :     =head2 Utility Methods
439 :    
440 :     =head3 _new
441 :    
442 :     Create a new instance object.
443 :    
444 :     This is a static method.
445 :    
446 :     =over 4
447 :    
448 :     =item dbquery
449 :    
450 :     B<DBQuery> object for the relevant query.
451 :    
452 :     =item value, value2, ... valueN
453 :    
454 :     List of values returned by the query for the current object.
455 :    
456 :     =back
457 :    
458 :     =cut
459 :    
460 :     sub _new {
461 :     # Get the parameters.
462 :     my ($dbquery, @values) = @_;
463 :     # Pull out the ERDB object and the relationship map.
464 :     my $database = $dbquery->{_db};
465 :     my $relationMap = $dbquery->{_objectNames};
466 :     # Get the metadata.
467 :     my $metadata = $database->{_metaData};
468 :     my $entities = $metadata->{Entities};
469 :     my $relationships = $metadata->{Relationships};
470 :     # This variable will be used to save the name of the last entity in the object list.
471 :     # That entity is the one we'll start from when crossing relationships.
472 :     my $target;
473 :     # Create the field hash table.
474 :     my %fieldHash = ();
475 :     # Check for search relevance.
476 :     if ($dbquery->{_fullText}) {
477 :     # Create the special search relevance field from the first element of the row values.
478 :     # Note that the object name is the value of the _fullText property.
479 :     my $relevanceName = "$dbquery->{_fullText}(search-relevance)";
480 :     $fieldHash{$relevanceName} = [shift @values];
481 :     }
482 :     # Denote that so far this does not appear to be a new object (as opposed to a loaded object).
483 :     my $newObjectFlag = 0;
484 :     # Loop through the object names, extracting its fields. We will strip each field from
485 :     # the value array and add it to the hash table using the ERDB-format field name.
486 :     for my $mappingPair (@{$relationMap}) {
487 :     # Get the real object name for this mapped name.
488 :     my ($mappedObjectName, $objectName) = @{$mappingPair};
489 :     # Declare the variable to hold the field list and the entity flag.
490 :     my ($fieldList, $entityFlag);
491 :     # Get the descriptor for this object.
492 :     my $objectDescriptor = $entities->{$objectName};
493 :     if ($objectDescriptor) {
494 :     # Here we have an entity object.
495 :     $target = $objectName;
496 :     $fieldList = $objectDescriptor->{Relations}->{$objectName}->{Fields};
497 :     $entityFlag = 1;
498 :     } else {
499 :     $objectDescriptor = $relationships->{$objectName};
500 :     if ($objectDescriptor) {
501 :     # Here we have a relationship object.
502 :     $fieldList = $objectDescriptor->{Relations}->{$objectName}->{Fields};
503 :     $entityFlag = 0;
504 :     } else {
505 :     Confess("Object $objectName not found in database.");
506 :     }
507 :     }
508 :     # Loop through the field list.
509 :     for my $field (@{$fieldList}) {
510 :     # Get the current value from the array.
511 :     my $thisValue = shift @values;
512 :     # Un-escape its text.
513 :     my $realValue = Tracer::UnEscape($thisValue);
514 :     # Get the current field's name.
515 :     my $fieldName = $field->{name};
516 :     # Add the field's name and value to the hash table.
517 :     my $fieldKey = "$mappedObjectName($fieldName)";
518 :     $fieldHash{$fieldKey} = [$realValue];
519 :     Trace("$fieldKey = '$thisValue'") if T(Fields => 3);
520 :     }
521 :     }
522 :     # Create the result object.
523 : parrello 1.6 my $self = { _db => $database, _targetEntity => $target, _values => \%fieldHash };
524 : parrello 1.1 # Bless and return it.
525 :     bless $self;
526 :     return $self;
527 :     }
528 :    
529 : parrello 1.4 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3