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

Annotation of /Sprout/SaplingDataLoader.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     #
4 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
5 :     # for Interpretations of Genomes. All Rights Reserved.
6 :     #
7 :     # This file is part of the SEED Toolkit.
8 :     #
9 :     # The SEED Toolkit is free software. You can redistribute
10 :     # it and/or modify it under the terms of the SEED Toolkit
11 :     # Public License.
12 :     #
13 :     # You should have received a copy of the SEED Toolkit Public License
14 :     # along with this program; if not write to the University of Chicago
15 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
16 :     # Genomes at veronika@thefig.info or download a copy from
17 :     # http://www.theseed.org/LICENSE.TXT.
18 :     #
19 :    
20 :     package SaplingDataLoader;
21 :    
22 :     use strict;
23 :     use Tracer;
24 :     use Stats;
25 :     use SeedUtils;
26 :     use SAPserver;
27 :     use Sapling;
28 : parrello 1.3 use AliasAnalysis;
29 : parrello 1.1
30 :     =head1 Sapling Data Loader
31 :    
32 :     This is the base class for packages that load the Sapling database from
33 :     SEED data files.
34 :    
35 :     =head2 Loader Object Methods
36 :    
37 :     =head3 new
38 :    
39 : parrello 1.5 my $loaderObject = SaplingDataLoader->new($sap, @stats);
40 : parrello 1.1
41 :     Create a loader object that can be used to facilitate loading Sapling data from a
42 :     directory.
43 :    
44 :     =over 4
45 :    
46 :     =item sap
47 :    
48 :     L<Sapling> object used to access the target database.
49 :    
50 :     =item stats
51 :    
52 :     List of names for statistics to be initialized in the statistics object.
53 :    
54 :     =back
55 :    
56 :     The object created contains the following fields.
57 :    
58 :     =over 4
59 :    
60 :     =item supportRecords
61 :    
62 :     A hash of hashes, used to track the support records known to exist in the database.
63 :    
64 :     =item sap
65 :    
66 :     L<Sapling> object used to access the database.
67 :    
68 :     =item stats
69 :    
70 :     L<Stats> object for tracking statistical information about the load.
71 :    
72 :     =back
73 :    
74 :     =cut
75 :    
76 :     sub new {
77 :     # Get the parameters.
78 :     my ($class, $sap, @stats) = @_;
79 :     # Create the object.
80 :     my $retVal = {
81 :     sap => $sap,
82 :     stats => Stats->new(@stats),
83 :     supportRecords => {}
84 :     };
85 :     # Bless and return it.
86 :     bless $retVal, $class;
87 :     return $retVal;
88 :     }
89 :    
90 :     =head2 Internal Utility Methods
91 :    
92 :     =head3 DeleteRelatedRecords
93 :    
94 :     DeleteRelatedRecords($sap, $genome, $stats, $relName, $entityName);
95 :    
96 :     Delete all the records in the named entity and relationship relating to the
97 :     specified genome and roll up the statistics in the specified statistics object.
98 :    
99 :     =over 4
100 :    
101 :     =item sap
102 :    
103 :     L<Sapling> object for accessing the database.
104 :    
105 :     =item genome
106 :    
107 :     ID of the relevant genome.
108 :    
109 :     =item stats
110 :    
111 :     L<Stats> object for tracking the delete activity.
112 :    
113 :     =item relName
114 :    
115 :     Name of a relationship from the B<Genome> table.
116 :    
117 :     =item entityName
118 :    
119 :     Name of the entity on the other side of the relationship.
120 :    
121 :     =back
122 :    
123 :     =cut
124 :    
125 :     sub DeleteRelatedRecords {
126 :     # Get the parameters.
127 :     my ($sap, $genome, $stats, $relName, $entityName) = @_;
128 :     # Get all the relationship records.
129 :     my (@targets) = $sap->GetFlat($relName, "$relName(from-link) = ?", [$genome],
130 :     "to-link");
131 : parrello 1.4 Trace(scalar(@targets) . " entries found for delete of $entityName via $relName.") if T(3) && @targets;
132 : parrello 1.1 # Loop through the relationship records, deleting them and the target entity
133 :     # records.
134 :     for my $target (@targets) {
135 :     # Delete the relationship instance.
136 :     $sap->DeleteRow($relName, $genome, $target);
137 : parrello 1.6 $stats->Add("delete-$relName" => 1);
138 : parrello 1.1 # Delete the entity instance.
139 :     my $subStats = $sap->Delete($entityName, $target);
140 :     # Roll up the statistics.
141 :     $stats->Accumulate($subStats);
142 :     }
143 :     }
144 :    
145 :     =head3 ExtractFields
146 :    
147 :     my %fieldHash = SaplingGenomeLoader::ExtractFields($tableName, $dataHash);
148 :    
149 :     Extract from the incoming hash the field names and values from the specified table.
150 :    
151 :     =over 4
152 :    
153 :     =item tableName
154 :    
155 :     Name of the table whose field names and values are desired.
156 :    
157 :     =item dataHash
158 :    
159 :     Reference to a hash mapping fully-qualified ERDB field names to values.
160 :    
161 :     =item RETURN
162 :    
163 :     Returns a hash containing only the fields from the specified table and their values.
164 :    
165 :     =back
166 :    
167 :     =cut
168 :    
169 :     sub ExtractFields {
170 :     # Get the parameters.
171 :     my ($tableName, $dataHash) = @_;
172 :     # Declare the return variable.
173 :     my %retVal;
174 :     # Extract the desired fields.
175 :     for my $field (keys %$dataHash) {
176 :     # Is this a field for the specified table?
177 :     if ($field =~ /^$tableName\(([^)]+)/) {
178 :     # Yes, put it in the output hash.
179 :     $retVal{$1} = $dataHash->{$field};
180 :     }
181 :     }
182 :     # Return the computed hash.
183 :     return %retVal;
184 :     }
185 :    
186 :     =head3 InsureEntity
187 :    
188 :     my $createdFlag = $loaderObject->InsureEntity($entityType => $id, %fields);
189 :    
190 :     Insure that the specified record exists in the database. If no record is found of the
191 :     specified type with the specified ID, one will be created with the indicated fields.
192 :    
193 :     =over 4
194 :    
195 :     =item $entityType
196 :    
197 :     Type of entity to check.
198 :    
199 :     =item id
200 :    
201 :     ID of the entity instance in question.
202 :    
203 :     =item fields
204 :    
205 :     Hash mapping field names to values for all the fields in the desired entity record except
206 :     for the ID.
207 :    
208 :     =item RETURN
209 :    
210 :     Returns TRUE if a new object was created, FALSE if it already existed.
211 :    
212 :     =back
213 :    
214 :     =cut
215 :    
216 :     sub InsureEntity {
217 :     # Get the parameters.
218 :     my ($self, $entityType, $id, %fields) = @_;
219 :     # Get the database.
220 :     my $sap = $self->{sap};
221 :     # Get the support record ID hash.
222 :     my $supportHash = $self->{supportRecords};
223 :     # Denote we haven't created a new record.
224 :     my $retVal = 0;
225 :     # Get the sub-hash for this entity type.
226 :     my $entityHash = $supportHash->{$entityType};
227 :     if (! defined $entityHash) {
228 :     $entityHash = {};
229 :     $supportHash->{$entityType} = $entityHash;
230 :     }
231 :     # Check for this instance.
232 :     if (! $entityHash->{$id}) {
233 :     # It's not found. Check the database.
234 :     if (! $sap->Exists($entityType => $id)) {
235 :     # It's not in the database either, so create it.
236 :     $sap->InsertObject($entityType, id => $id, %fields);
237 :     $self->{stats}->Add(insertSupport => 1);
238 :     $retVal = 1;
239 :     }
240 :     # Mark the record in the hash so we know we have it.
241 :     $entityHash->{$id} = 1;
242 :     }
243 :     # Return the insertion indicator.
244 :     return $retVal;
245 :     }
246 :    
247 : parrello 1.2 =head3 ConnectFunctionRoles
248 :    
249 :     $self->ConnectFunctionRoles($fid, $function);
250 :    
251 :     Connect the specified feature to the roles indicated by its functional assignment.
252 :    
253 :     =over 4
254 :    
255 :     =item fid
256 :    
257 :     ID of the feature of interest.
258 :    
259 :     =item function
260 :    
261 :     Functional assignment for the feature. Most of the time, this corresponds to a single role,
262 :     but that is not always the case.
263 :    
264 :     =back
265 :    
266 :     =cut
267 :    
268 :     sub ConnectFunctionRoles {
269 :     # Get the parameters.
270 :     my ($self, $fid, $function) = @_;
271 :     # Get the statistics object.
272 :     my $stats = $self->{stats};
273 :     # Get the Sapling database.
274 :     my $sap = $self->{sap};
275 :     # Get the roles and the error count from the function.
276 :     my ($roles, $errors) = SeedUtils::roles_for_loading($function);
277 :     # Accumulate the errors in the stats object.
278 :     $stats->Add(roleErrors => $errors);
279 :     # Is this a suspicious function?
280 :     if (! defined $roles) {
281 :     # Yes, so track it.
282 :     $stats->Add(badFunction => 1);
283 :     } else {
284 :     # No, connect the roles.
285 :     for my $role (@$roles) {
286 :     # Insure this role exists.
287 :     my $hypo = hypo($role);
288 :     $self->InsureEntity(Role => $role, hypothetical => $hypo);
289 :     # Connect it to the feature.
290 :     $sap->InsertObject('IsFunctionalIn', from_link => $role, to_link => $fid);
291 :     }
292 :     }
293 :     }
294 :    
295 : parrello 1.5 =head3 ComputeAnnotationID
296 : parrello 1.2
297 :     my $annotationID = SaplingDataLoader::ComputeAnnotationID($fid, $keyStamp);
298 :    
299 :     Compute the annotation ID for the specified feature and timestamp. The annotation ID is an
300 :     inverted number designed so that higher timestamps sort later in the ordering.
301 :    
302 :     =over 4
303 :    
304 :     =item fid
305 :    
306 :     Relevant feature ID.
307 :    
308 :     =item keyStamp
309 :    
310 :     Timestamp to be used to form the key.
311 :    
312 :     =item RETURN
313 :    
314 :     Returns an ID string formed from the feature ID and the inverted timestamp.
315 :    
316 :     =back
317 :    
318 :     =cut
319 :    
320 :     sub ComputeAnnotationID {
321 :     # Get the parameters.
322 :     my ($fid, $keyStamp) = @_;
323 :     # Compute the annotation ID from the feature ID and keystamp.
324 :     my $retVal = "$fid:" . Tracer::Pad(9999999999 - $keyStamp, 10, 1, "0");
325 :     # Return the result.
326 :     return $retVal;
327 :     }
328 :    
329 :     =head3 ComputeKeyStamp
330 :    
331 :     my $keyStamp = SaplingDataLoader::ComputeKeyStamp($annotationID, $default);
332 :    
333 :     Compute the timestamp value from the specified annotation ID. The timestamp portion is
334 :     parsed out and then inverted to get the original time value.
335 :    
336 :     =over 4
337 :    
338 :     =item annotationID
339 :    
340 :     The annotation ID to parse for the timestamp.
341 :    
342 :     =item default
343 :    
344 :     Default value to return if the original annotation ID is undefined or invalid.
345 :    
346 :     =item RETURN
347 :    
348 :     Returns the timestamp value used to compute the original annotation ID.
349 :    
350 :     =back
351 :    
352 :     =cut
353 :    
354 :     sub ComputeKeyStamp {
355 :     # Get the parameters.
356 :     my ($annotationID, $default) = @_;
357 :     # Declare the return variable. We initialize it to the default value.
358 :     my $retVal = $default;
359 :     # Parse out the timestamp portion of the annotation ID.
360 :     if ($annotationID && $annotationID =~ /:(\d+)/) {
361 :     # If we found one, convert it to a timestamp.
362 :     $retVal = 9999999999 - $1;
363 :     }
364 :     # Return the result.
365 :     return $retVal;
366 :     }
367 :    
368 : parrello 1.3 =head3 CreateIdentifier
369 :    
370 :     $loaderObject->CreateIdentifier($alias, $conf, $aliasType, $fid);
371 :    
372 :     Link an identifier to a feature. The identifier is presented in prefixed form and is of the
373 :     specified type and the specified confidence level.
374 :    
375 :     =over 4
376 :    
377 :     =item alias
378 :    
379 :     Identifier to connect to the feature.
380 :    
381 :     =item conf
382 :    
383 :     Confidence level (C<A> curated, C<B> normal, C<C> protein only).
384 :    
385 :     =item aliasType
386 :    
387 :     Type of alias (e.g. C<NCBI>, C<LocusTag>).
388 :    
389 :     =item fid
390 :    
391 :     ID of the relevant feature.
392 :    
393 :     =back
394 :    
395 :     =cut
396 :    
397 :     sub CreateIdentifier {
398 :     # Get the parameters.
399 :     my ($self, $alias, $conf, $aliasType, $fid) = @_;
400 :     # Get the Sapling object.
401 :     my $sap = $self->{sap};
402 :     # Compute the identifier's natural form.
403 :     my $natural = $alias;
404 :     if ($natural =~ /[:|](.+)/ && $aliasType ne 'SEED') {
405 :     $natural = $1;
406 :     }
407 :     # Insure the identifier exists in the database.
408 :     $self->InsureEntity(Identifier => $alias, source => $aliasType, natural_form => $natural);
409 :     # Connect the identifier to the feature.
410 :     $sap->InsertObject('IsIdentifiedBy', to_link => $alias, from_link => $fid, conf => $conf);
411 :     }
412 :    
413 :     =head3 ProcessAliases
414 :    
415 :     $loaderObject->ProcessAliases($fid, \@aliases);
416 :    
417 :     Create all the aliases for the specified feature. Each alias will be analyzed to determine
418 :     its type and processed accordingly.
419 :    
420 :     =over 4
421 :    
422 :     =item fid
423 :    
424 :     ID of the feature to which the aliases apply.
425 :    
426 :     =item aliases
427 :    
428 :     Reference to a list of the aliases for the specified feature.
429 :    
430 :     =back
431 :    
432 :     =cut
433 :    
434 :     sub ProcessAliases {
435 :     # Get the parameters.
436 :     my ($self, $fid, $aliases) = @_;
437 :     # Get the Sapling database.
438 :     my $sap = $self->{sap};
439 :     # Get the statistics object.
440 :     my $stats = $self->{stats};
441 :     # Loop through the aliases.
442 :     for my $alias (@$aliases) {
443 :     my $normalized;
444 :     # Determine the type.
445 :     my $aliasType = AliasAnalysis::TypeOf($alias);
446 :     $stats->Add(aliasAll => 1);
447 :     # Is this a recognized type?
448 :     if ($aliasType) {
449 :     $stats->Add(aliasNormal => 1);
450 :     # Yes. Write it normally.
451 :     $self->CreateIdentifier($alias, B => $aliasType, $fid);
452 :     } elsif ($alias =~ /^LocusTag:(.+)/ || $alias =~ /^(?:locus|locus_tag|LocusTag)\|(.+)/) {
453 :     # No, but this is a specially-marked locus tag.
454 :     $normalized = "LocusTag:$1";
455 :     $stats->Add(aliasLocus => 1);
456 :     $self->CreateIdentifier($normalized, B => 'LocusTag', $fid);
457 :     } elsif ($normalized = AliasAnalysis::IsNatural(LocusTag => $alias)) {
458 :     # No, but this is a natural locus tag.
459 :     $stats->Add(aliasLocus => 1);
460 :     $self->CreateIdentifier($normalized, B => 'LocusTag', $fid);
461 :     } elsif ($normalized = AliasAnalysis::IsNatural(GENE => $alias)) {
462 :     # No, but this is a natural gene name.
463 :     $stats->Add(aliasGene => 1);
464 :     $self->CreateIdentifier($normalized, B => 'GENE', $fid);
465 :     } elsif ($alias =~ /^\d+$/) {
466 :     # Here it's a naked number, which means it's a GI number
467 :     # of some sort.
468 :     $stats->Add(aliasGI => 1);
469 :     $self->CreateIdentifier("gi|$alias", B => 'NCBI', $fid);
470 :     } elsif ($alias =~ /^protein_id\|(.+)/) {
471 :     # Here we have a REFSEQ protein ID. Right now we don't have a way to
472 :     # handle that, because we don't know the feature's protein ID here.
473 :     $stats->Add(aliasProtein => 1);
474 :     } elsif ($alias =~ /[:|]/) {
475 :     # Here it's an alias of an unknown type, so we skip it.
476 :     $stats->Add(aliasUnknown => 1);
477 :     } else {
478 :     # Here it's a miscellaneous type.
479 :     $stats->Add(aliasMisc => 1);
480 :     $self->CreateIdentifier($alias, B => 'Miscellaneous', $fid);
481 :     }
482 :     }
483 :     # Add an identifier for the FIG ID itself.
484 :     $self->CreateIdentifier($fid, A => 'SEED', $fid);
485 :     }
486 :    
487 :     =head3 AddFeature
488 :    
489 :     $loaderObject->AddFeature($fid, $function, $locations, $aliases, $protein, $evidence);
490 :    
491 :     Add a new feature to the database. The feature will be connected to the roles implied by
492 :     the functional assignment, its location(s) will be stored, and the necessary aliases will be
493 :     attached. If it is a PEG, its protein assignment will also be put in place.
494 :    
495 :     =over 4
496 :    
497 :     =item fid
498 :    
499 :     ID of the feature to add.
500 :    
501 :     =item function
502 :    
503 :     Functional assignment for the feature.
504 :    
505 :     =item locations
506 :    
507 :     A string containing a comma-delimited list of the feature's locations in SEED format.
508 :    
509 :     =item aliases
510 :    
511 :     Reference to a list of the feature's aliases. If it has no aliases, this parameter must
512 :     be an empty list.
513 :    
514 :     =item protein (optional)
515 :    
516 :     The protein translation for this feature.
517 :    
518 :     =item evidence (optional)
519 :    
520 :     A string containing a comma-delimited list of the feature's evidence codes.
521 :    
522 :     =back
523 :    
524 :     =cut
525 :    
526 :     sub AddFeature {
527 :     # Get the parameters.
528 :     my ($self, $fid, $function, $locations, $aliases, $protein, $evidence) = @_;
529 :     # Get the Sapling database.
530 :     my $sap = $self->{sap};
531 :     # Get the statistics object.
532 :     my $stats = $self->{stats};
533 :     # Parse the feature ID to get the genome and feature type.
534 :     unless ($fid =~ /^fig\|(\d+\.\d+)\.(\w+)\.\d+/) {
535 :     # Here the feature ID is invalid.
536 :     $stats->Add(badFeatureID => 1);
537 :     Trace("Invalid feature ID $fid.") if T(0);
538 :     } else {
539 :     my $genomeID = $1;
540 :     my $featureType = $2;
541 :     # This will record the number of errors found.
542 :     my $errorCount = 0;
543 :     # Verify that we have a protein sequence iff this is a PEG.
544 :     if ($featureType eq 'peg' && ! $protein) {
545 :     Trace("Missing protein sequence for $fid.") if T(0);
546 :     $errorCount++;
547 :     $stats->Add(missingProtein => 1);
548 :     } elsif ($featureType ne 'peg' && $protein) {
549 :     Trace("Protein sequence provided for non-encoding feature $fid.") if T(0);
550 :     $errorCount++;
551 :     $stats->Add(extraProtein => 1);
552 :     }
553 :     # We need to analyze the locations next. The following list will contain the
554 :     # location components, in order.
555 :     my @locs;
556 :     # Get the maximum location segment length.
557 :     my $maxLength = $sap->TuningParameter('maxLocationLength');
558 :     # This will record the total number of base pairs.
559 :     my $dnaLength = 0;
560 :     # Process the locations.
561 : parrello 1.6 for my $loc (split m/\s*,\s*/, $locations) {
562 : parrello 1.3 # Parse the location.
563 :     unless ($loc =~ /^(.+)_(\d+)_(\d+)$/) {
564 :     # Here the location is invalid.
565 :     $stats->Add(badLocation => 1);
566 :     $errorCount++;
567 :     Trace("Invalid location $loc for $fid.") if T(0);
568 :     } else {
569 :     # Save the pieces of the location.
570 :     my ($contig, $start, $end) = ($1, $2, $3);
571 :     my ($dir, $len);
572 :     if ($start <= $end) {
573 :     $dir = '+';
574 :     $len = $end + 1 - $start;
575 :     } else {
576 :     $dir = '-';
577 :     $len = $start + 1 - $end;
578 :     }
579 :     # Record the length.
580 :     $dnaLength += $len;
581 :     # Fix the contig ID. Sometimes it comes in without the genome ID prefixed
582 :     # to it.
583 :     unless ($contig =~ /^\d+\.\d+:/) {
584 :     $contig = "$genomeID:$contig";
585 :     }
586 :     # The next processing depends on the direction we're going: we need
587 :     # to break up the location into segments so that each segment is no
588 :     # greater than the maximum length.
589 :     if ($dir eq '+') {
590 :     # Here the location is on the forward strand. We peel off segments
591 :     # from the left.
592 :     while ($len > $maxLength) {
593 :     push @locs, [$contig, $start, $dir, $maxLength];
594 :     $len -= $maxLength;
595 :     $start += $maxLength;
596 :     $stats->Add(dnaSegmented => 1);
597 :     }
598 :     # Store the residual segment. There will always be one because
599 :     # the loop condition insures the length never becomes zero
600 :     # unless the entire location is zero-length on entry.
601 :     push @locs, [$contig, $start, $dir, $len];
602 :     } else {
603 :     # Here the location is on the backward strand. We peel off
604 :     #segments from the right.
605 :     while ($len > $maxLength) {
606 :     push @locs, [$contig, $start - $maxLength + 1, $dir, $maxLength];
607 :     $len -= $maxLength;
608 :     $start -= $maxLength;
609 :     $stats->Add(dnaSegmented => 1);
610 :     }
611 :     # Store the residual segment. Again, the loop condition
612 :     # insures there will always be one.
613 :     push @locs, [$contig, $start - $len + 1, $dir, $len];
614 :     }
615 :     }
616 :     }
617 :     # Only proceed if no errors were found.
618 :     if (! $errorCount) {
619 :     # Make this feature part of the genome.
620 :     $sap->InsertObject('IsOwnerOf', from_link => $genomeID, to_link => $fid);
621 :     # Create the feature record.
622 :     $sap->InsertObject('Feature', id => $fid, feature_type => $featureType,
623 :     function => $function, locked => 0, sequence_length => $dnaLength);
624 :     $stats->Add(addFeature => 1);
625 :     # Connect it to its locations.
626 :     my $ordinal = 1;
627 :     for my $loc (@locs) {
628 :     my ($contig, $begin, $dir, $len) = @$loc;
629 :     $sap->InsertObject('IsLocatedIn', from_link => $fid, to_link => $contig,
630 :     begin => $begin, dir => $dir, len => $len,
631 :     ordinal => $ordinal);
632 :     $ordinal++;
633 :     $stats->Add(addIsLocatedIn => 1);
634 :     }
635 :     # Connect it to its roles.
636 :     $self->ConnectFunctionRoles($fid, $function);
637 :     # If this is a protein, we need to process the protein sequence.
638 :     if ($protein) {
639 :     # Compute the key for the protein sequence.
640 :     my $protID = $sap->ProteinID($protein);
641 :     # Insure the protein exists.
642 :     $self->InsureEntity(ProteinSequence => $protID, sequence => $protein);
643 :     # Connect the feature to it.
644 :     $sap->InsertObject('IsProteinFor', from_link => $protID, to_link => $fid);
645 :     $stats->Add(addIsProteinFor => 1);
646 :     }
647 :     # Add the evidence codes (if any).
648 :     if ($evidence) {
649 : parrello 1.6 for my $evCode (split m/\s*,\s*/, $evidence) {
650 : parrello 1.3 $sap->InsertValue($fid, 'Feature(evidence-code)', $evCode);
651 :     $stats->Add(addEvidenceCode => 1);
652 :     }
653 :     }
654 :     # Finally, connect the aliases.
655 :     $self->ProcessAliases($fid, $aliases);
656 :     }
657 :     }
658 :     }
659 :    
660 :     =head3 MakeAnnotation
661 :    
662 :     $loaderObject->MakeAnnotation($fid, $message, $user, $timeStamp);
663 :    
664 :     Make an annotation against the specified feature. This method simply adds an
665 :     annotation; if the annotation relates to a functional assignment it will not
666 :     update the assignment as well.
667 :    
668 :     =over 4
669 :    
670 :     =item fid
671 :    
672 :     ID of the feature to be annotated.
673 :    
674 :     =item message
675 :    
676 :     Text of the annotation.
677 :    
678 :     =item user
679 :    
680 :     Name of the user who made the annotation.
681 :    
682 :     =item timeStamp (optional)
683 :    
684 :     Time at which the annotation was made. If omitted, the current time will be used.
685 :    
686 :     =back
687 :    
688 :     =cut
689 :    
690 :     sub MakeAnnotation {
691 :     # Get the parameters.
692 :     my ($self, $fid, $message, $user, $timeStamp) = @_;
693 :     # Get the Sapling database.
694 :     my $sap = $self->{sap};
695 :     # Get the current time if no timestamp was provided.
696 :     if (! $timeStamp) {
697 :     $timeStamp = time();
698 :     }
699 :     # Convert a master assignment to a FIG assignment.
700 :     $message =~ s/Set master function/Set FIG function/;
701 :     # Compute the annotation ID for this timestamp.
702 :     my $newID = ComputeAnnotationID($fid, $timeStamp);
703 :     # Is it already in the database?
704 :     if ($sap->Exists("Annotation", $newID)) {
705 :     # Yes, so we need to compute a better one. Get the timestamp for the last annotation update
706 :     # to this feature. One has to exist, because we found a duplicate.
707 :     my ($id) = $sap->GetFlat("Annotation", "Annotation(id) LIKE ? ORDER BY Annotation(id) LIMIT 1",
708 :     ["$fid:%"], 'id');
709 :     # Get a new timestamp by incrementing its time value.
710 :     my $oldStamp = ComputeKeyStamp($id, 0) + 1;
711 :     # Create the annotation ID.
712 :     $newID = ComputeAnnotationID($fid, $oldStamp);
713 :     }
714 :     # Create the annotation.
715 :     $sap->InsertObject("IsAnnotatedBy", from_link => $fid, to_link => $newID);
716 :     $sap->InsertObject("Annotation", id => $newID, annotation_time => $timeStamp,
717 :     annotator => $user, comment => $message);
718 :     }
719 :    
720 : parrello 1.2 =head2 The Process Method
721 :    
722 :     Each loader must provide a C<Process> method for processing input from the
723 :     master file of load instructions. The master file contains a load type in the
724 :     first column that indicates the relevant load class (e.g. C<Function> for
725 :     L<SaplingFunctionLoader>). The remaining columns are the parameters passed to
726 :     the load method in sequence. The load method first clears existing data (if
727 :     necessary), then loads the new data.
728 :    
729 :     my $stats = SaplingDataLoader::Process($sap, @parms);
730 :    
731 :     =cut
732 :    
733 :    
734 : parrello 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3