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

Annotation of /Sprout/ERDBObject.pm

Parent Directory Parent Directory | Revision Log 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