[Bio] / FigKernelPackages / TransactionProcessor.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/TransactionProcessor.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package TransactionProcessor;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use PageBuilder;
8 :     use FIG;
9 :     use Stats;
10 :    
11 :     =head1 Transaction Processor
12 :    
13 :     =head2 Introduction
14 :    
15 :     This is the base class for a transaction processor. Transaction processors are
16 :     used by the B<TransactFeatures> script to process transactions found in feature
17 :     transaction files. The script reads through files containing add, delete, and
18 :     change transactions for features, and then calls this object's methods to
19 :     effect the transactions. A different subclass of this object is used for
20 :     each of the possible commands that can be input to B<TransactFeatures>.
21 :    
22 :     The transaction processor subclass must provide five methods.
23 :    
24 :     =over 4
25 :    
26 :     =item Add
27 :    
28 :     Add a new feature.
29 :    
30 :     =item Delete
31 :    
32 :     Delete a feature
33 :    
34 :     =item Change
35 :    
36 :     Replace a feature.
37 :    
38 :     =item Setup
39 :    
40 :     Initialize for processing.
41 :    
42 :     =item SetupGenome
43 :    
44 :     Initialize for processing a genome.
45 :    
46 :     =item TeardownGenome
47 :    
48 :     Terminate processing for a genome.
49 :    
50 :     =item Teardown
51 :    
52 :     Terminate processing.
53 :    
54 :     =back
55 :    
56 :     =cut
57 :    
58 :     #: Constructor TransactionProcessor->new();
59 :    
60 :     =head2 Public Methods
61 :    
62 :     =head3 new
63 :    
64 :     C<< my $xprc = TransactionProcessor->new(\%options, $command, $idFile); >>
65 :    
66 :     Construct a new Transaction Processor object.
67 :    
68 :     =over 4
69 :    
70 :     =item options
71 :    
72 :     Reference to a hash table containing the command-line options.
73 :    
74 :     =item command
75 :    
76 :     Command specified on the B<TransactFeatures> command line. This command determines
77 :     which TransactionProcessor subclass is active.
78 :    
79 :     =item directory
80 :    
81 :     Directory containing the transaction files.
82 :    
83 :     =item idFile
84 :    
85 :     Name of the ID file (if needed).
86 :    
87 :     =back
88 :    
89 :     =cut
90 :    
91 :     sub new {
92 :     # Get the parameters.
93 :     my ($class, $options, $command, $directory, $idFile) = @_;
94 :     # Set up tracing.
95 :     my $traceLevel = $options->{trace};
96 :     TSetup("$traceLevel $class Tracer FIG TransactionProcessor", "TEXT");
97 :     # Create the xprc object.
98 :     my $retVal = {
99 :     fig => FIG->new(),
100 :     idHash => {},
101 :     options => $options,
102 :     command => $command,
103 :     stats => Stats->new("genomes", "add", "change", "delete"),
104 :     idFileName => $idFile,
105 :     directory => $directory,
106 :     fileName => undef,
107 :     genomeID => undef,
108 :     orgStats => undef
109 :     };
110 :     # Bless and return it.
111 :     bless $retVal, $class;
112 :     return $retVal;
113 :     }
114 :    
115 :     =head3 FIG
116 :    
117 :     C<< my $fig = $xprc->FIG; >>
118 :    
119 :     Return the FIG object used to access and manipulate the data store.
120 :    
121 :     =cut
122 :     #: Return Type $%;
123 :     sub FIG {
124 :     # Get the parameters.
125 :     my ($self) = @_;
126 :     # Return the result.
127 :     return $self->{fig};
128 :     }
129 :    
130 :     =head3 GenomeID
131 :    
132 :     C<< my $genomeID = $xprc->GenomeID; >>
133 :    
134 :     Return the ID of the current genome. The current genome is specified by the
135 :     L</StartGenome> method.
136 :    
137 :     =cut
138 :     #: Return Type $;
139 :     sub GenomeID {
140 :     # Get the parameters.
141 :     my ($self) = @_;
142 :     # Return the genome ID.
143 :     return $self->{genomeID};
144 :     }
145 :    
146 :     =head3 CurrentFileName
147 :    
148 :     C<< my $name = $xprc->CurrentFileName; >>
149 :    
150 :     Return the name of the transaction file currently being read. There is a
151 :     difference file for each genome being processed.
152 :    
153 :     =cut
154 :     #: Return Type $;
155 :     sub CurrentFileName {
156 :     # Get the parameters.
157 :     my ($self) = @_;
158 :     # Return the result.
159 :     return $self->{fileName};
160 :     }
161 :    
162 :     =head3 IncrementStat
163 :    
164 :     C<< $xprc->IncrementStat($name); >>
165 :    
166 :     Increment the named statistics in the organism statistics object.
167 :    
168 :     =over 4
169 :    
170 :     =item name
171 :    
172 :     Name of the statistic to increment.
173 :    
174 :     =back
175 :    
176 :     =cut
177 :     #: Return Type ;
178 :     sub IncrementStat {
179 :     # Get the parameters.
180 :     my ($self, $name) = @_;
181 :     # Increment the statistic.
182 :     $self->{orgStats}->Add($name, 1);
183 :     }
184 :    
185 : parrello 1.4 =head3 AddStats
186 :    
187 :     C<< $xprc->AddStats($name1, $name2, ... $nameN); >>
188 :    
189 :     Insure statistics with the specified names exist in the organism statistics
190 :     object.
191 :    
192 :     =over 4
193 :    
194 :     =item name1, name2, ..., nameN
195 :    
196 :     Names of the statistics to create.
197 :    
198 :     =back
199 :    
200 :     =cut
201 :     #: Return Type ;
202 :     sub AddStats {
203 :     # Get the parameters.
204 :     my ($self, @names) = @_;
205 :     # Create the statistics.
206 :     map { $self->{orgStats}->Add($_, 0) } @names;
207 :     }
208 :    
209 : parrello 1.1 =head3 AddMessage
210 :    
211 :     C<< $xprc->AddMessage($message); >>
212 :    
213 :     Add the specified message to the organism statistics object.
214 :    
215 :     =over 4
216 :    
217 :     =item message
218 :    
219 :     Message to put in the statistical object's message queue.
220 :    
221 :     =back
222 :    
223 :     =cut
224 :     #: Return Type ;
225 :     sub AddMessage {
226 :     # Get the parameters.
227 :     my ($self, $message) = @_;
228 :     # Add the message to the statistics object.
229 :     $self->{orgStats}->AddMessage($message);
230 :     }
231 :    
232 :     =head3 StartGenome
233 :    
234 :     C<< my = $xprc->StartGenome($genomeID, $orgFileName); >>
235 :    
236 :     Start processing a particular genome.
237 :    
238 :     =over 4
239 :    
240 :     =item genomeID
241 :    
242 :     ID of the genome for which processing is to begin.
243 :    
244 :     =item
245 :    
246 :     Name of the input file.
247 :    
248 :     =back
249 :    
250 :     =cut
251 :     #: Return Type ;
252 :     sub StartGenome {
253 :     # Get the parameters.
254 :     my ($self, $genomeID, $orgFileName) = @_;
255 :     # Save the genome ID.
256 :     $self->{genomeID} = $genomeID;
257 :     # Create the statistics object for this organism.
258 :     $self->{orgStats} = Stats->new();
259 :     # Save the file name.
260 :     $self->{fileName} = $orgFileName;
261 :     # Do the subclass setup.
262 :     $self->SetupGenome();
263 :     }
264 :    
265 :     =head3 EndGenome
266 :    
267 :     C<< my $orgStats = $xprc->EndGenome(); >>
268 :    
269 :     Terminate processing for the current genome and return its statistics object.
270 :    
271 :     =cut
272 :     #: Return Type $%;
273 :     sub EndGenome {
274 :     # Get the parameters.
275 :     my ($self) = @_;
276 :     # Do the subclass teardown.
277 :     $self->TeardownGenome();
278 :     # Get the statistics object.
279 :     my $retVal = $self->{orgStats};
280 :     # Roll it up into the global statistics object.
281 :     $self->{stats}->Accumulate($retVal);
282 :     # Count this genome.
283 : parrello 1.3 $self->{stats}->Add("genomes", 1);
284 : parrello 1.1 # Return the genome statistics.
285 :     return $retVal;
286 :     }
287 :    
288 :     =head3 Option
289 :    
290 :     C<< my $value = $xprc->Option($optionName); >>
291 :    
292 :     Return the value of the specified command-line option.
293 :    
294 :     =over 4
295 :    
296 :     =item optionName
297 :    
298 :     Name of the command-line option whose value is desired.
299 :    
300 :     =item RETURN
301 :    
302 :     Value of the desired command-line option, or C<undef> if the option does
303 :     not exist.
304 :    
305 :     =back
306 :    
307 :     =cut
308 :     #: Return Type $;
309 :     sub Option {
310 :     # Get the parameters.
311 :     my ($self, $optionName) = @_;
312 :     # Return the option value.
313 :     return $self->{options}->{$optionName};
314 :     }
315 :    
316 :     =head3 GetRealID
317 :    
318 :     C<< my $realID = $xprc->GetRealID($ftype, $ordinal, $key); >>
319 :    
320 :     Compute the real ID of a new feature. This involves interrogating the ID hash and
321 :     formatting a full-blown ID out of little bits of information.
322 :    
323 :     =over 4
324 :    
325 :     =item controlBlock
326 :    
327 :     Reference to a hash containing data used to manage the transaction process.
328 :    
329 :     =item ordinal
330 :    
331 :     Zero-based ordinal number of this feature. The ordinal number is added to the value
332 :     stored in the ID hash to compute the real feature number.
333 :    
334 :     =item key
335 :    
336 :     Key in the ID hash relevant to this feature. The key is composed of the genome ID
337 :     followed by the feature type, separated by a period.
338 :    
339 :     =item RETURN
340 :    
341 :     Returns a fully-formatted FIG ID for the new feature.
342 :    
343 :     =back
344 :    
345 :     =cut
346 :    
347 :     sub GetRealID {
348 :     # Get the parameters.
349 :     my ($self, $ordinal, $key) = @_;
350 :     #Declare the return value.
351 :     my $retVal;
352 :     # Get the base value for the feature ID number.
353 :     my $base = $self->{idHash}->{$key};
354 :     # If it didn't exist, we have an error.
355 :     if (! defined $base) {
356 :     Confess("No ID range found for genome ID and feature type $key.");
357 :     } else {
358 :     # Now we have enough data to format the ID.
359 :     my $num = $base + $ordinal;
360 :     $retVal = "fig|$key.$num";
361 :     }
362 :     # Return the result.
363 :     return $retVal;
364 :     }
365 :    
366 :     =head3 ParseNewID
367 :    
368 :     C<< my ($ftype, $ordinal, $key) = $xprc->ParseNewID($newID); >>
369 :    
370 :     Extract the feature type and ordinal number from an incoming new ID.
371 :    
372 :     =over 4
373 :    
374 :     =item newID
375 :    
376 :     New ID specification taken from a transaction input record. This contains the
377 :     feature type followed by a period and then the ordinal number of the ID.
378 :    
379 :     =item RETURN
380 :    
381 :     Returna a three-element list. If successful, the list will contain the feature
382 :     type followed by the ordinal number and the key to use in the ID hash to find
383 :     the feature's true ID number. If the incoming ID is invalid, the list
384 :     will contain three C<undef>s.
385 :    
386 :     =back
387 :    
388 :     =cut
389 :    
390 :     sub ParseNewID {
391 :     # Get the parameters.
392 :     my ($self, $newID) = @_;
393 :     # Declare the return variables.
394 :     my ($ftype, $ordinal, $key);
395 :     # Parse the ID.
396 :     if ($newID =~ /^([a-z]+)\.(\d+)$/) {
397 :     # Here we have a valid ID.
398 :     ($ftype, $ordinal) = ($1, $2);
399 :     $key = $self->GenomeID . ".$ftype";
400 :     # Update the feature type count in the statistics.
401 :     $self->{orgStats}->Add($ftype, 1);
402 :     } else {
403 :     # Here we have an invalid ID.
404 :     $self->{orgStats}->AddMessage("Invalid ID $newID found in line " .
405 :     $self->{line} . " for genome " .
406 :     $self->GenomeID . ".");
407 :     }
408 :     # Return the result.
409 :     return ($ftype, $ordinal, $key);
410 :     }
411 :    
412 :     =head3 CheckTranslation
413 :    
414 :     C<< my $actualTranslation = $xprc->CheckTranslation($ftype, $locations, $translation); >>
415 :    
416 :     If we are processing a PEG, insure we have a translation for the peg's locations.
417 :    
418 :     This method checks the feature type and the incoming translation string. If the
419 :     translation string is empty and the feature type is C<peg>, it will generate
420 :     a translation string using the specified locations for the genome currently
421 :     being processed.
422 :    
423 :     =over 4
424 :    
425 :     =item ftype
426 :    
427 :     Feature type (C<peg>, C<rna>, etc.)
428 :    
429 :     =item locations
430 :    
431 :     Comma-delimited list of location strings for the feature in question.
432 :    
433 :     =item translation (optional)
434 :    
435 :     If specified, will be returned to the caller as the result.
436 :    
437 :     =item RETURN
438 :    
439 :     Returns the protein translation string for the specified locations, or C<undef>
440 :     if no translation is warranted.
441 :    
442 :     =back
443 :    
444 :     =cut
445 :    
446 :     sub CheckTranslation {
447 :     # Get the parameters.
448 :     my ($self, $ftype, $locations, $translation) = @_;
449 :     my $fig = $self->FIG;
450 :     # Declare the return variable.
451 :     my $retVal;
452 :     if ($ftype eq 'peg') {
453 :     # Here we have a protein encoding gene. Check to see if we already have
454 :     # a translation.
455 :     if (defined $translation) {
456 :     # Pass it back unmodified.
457 :     $retVal = $translation;
458 :     } else {
459 :     # Here we need to compute the translation.
460 :     my $dna = $fig->dna_seq($self->GenomeID, $locations);
461 :     $retVal = FIG::translate($dna);
462 :     }
463 :     }
464 :     # Return the result.
465 :     return $retVal;
466 :     }
467 :    
468 :     =head3 ReadIDHash
469 :    
470 :     C<< $xprc->ReadIDHash(); >>
471 :    
472 :     Read the ID hash data from the ID file.
473 :    
474 :     =cut
475 :     #: Return Type ;
476 :     sub ReadIDHash {
477 :     # Get the parameters.
478 :     my ($self) = @_;
479 :     # Create a counter.
480 :     my $inCount = 0;
481 :     # Open the ID file.
482 :     my $idFileName = $self->{idFileName};
483 :     Open(\*IDFILE, "<$idFileName");
484 :     # Loop through the records in the file.
485 :     while (my $idRecord = <IDFILE>) {
486 :     # Extract the three fields from the record.
487 :     chomp $idRecord;
488 :     my ($orgID, $ftype, $firstNumber) = split /\t/, $idRecord;
489 :     # Add it to the ID hash.
490 :     $self->{idHash}->{"$orgID.$ftype"} = $firstNumber;
491 :     # Count the record.
492 :     $inCount++;
493 :     }
494 :     Trace("$inCount ID ranges read in from $idFileName.") if T(2);
495 :     }
496 :    
497 :     =head3 Directory
498 :    
499 :     C<< my $dirName = $xprc->Directory; >>
500 :    
501 :     Name of the directory containing the transaction files.
502 :    
503 :     =cut
504 :     #: Return Type $;
505 :     sub Directory {
506 :     # Get the parameters.
507 :     my ($self) = @_;
508 :     # Return the directory name.
509 : parrello 1.2 return $self->{directory};
510 : parrello 1.1 }
511 :    
512 :     =head3 IDHash
513 :    
514 :     C<< my $idHash = $xprc->IDHash; >>
515 :    
516 :     Return a reference to the ID hash. The ID hash is used to extract the base
517 :     value for new IDs when processing and to count the IDs needed when counting.
518 :    
519 :     =cut
520 :     #: Return Type $%;
521 :     sub IDHash {
522 :     # Get the parameters.
523 :     my ($self) = @_;
524 :     # Return the hash.
525 :     return $self->{idHash};
526 :     }
527 :    
528 :     =head3 IncrementID
529 :    
530 :     C<< $xprc->IncrementID($ftype); >>
531 :    
532 :     Increment the ID hash counter for the specified feature type and the current genome.
533 :    
534 :     =over 4
535 :    
536 :     =item ftype
537 :    
538 :     Feature type whose ID counter is to be incremented.
539 :    
540 :     =back
541 :    
542 :     =cut
543 :     #: Return Type ;
544 :     sub IncrementID {
545 :     # Get the parameters.
546 :     my ($self, $ftype) = @_;
547 :     # Create the key.
548 :     my $key = $self->GenomeID . ".$ftype";
549 :     # Increment the counter for the specified key.
550 :     if (exists $self->{idHash}->{$key}) {
551 :     $self->{idHash}->{$key}++;
552 :     } else {
553 :     $self->{idHash}->{$key} = 1;
554 :     }
555 :     }
556 :    
557 :     =head3 IDFileName
558 :    
559 :     C<< my $idFileName = $xprc->IDFileName; >>
560 :    
561 :     Return the name of the ID file.
562 :    
563 :     =cut
564 :     #: Return Type $;
565 :     sub IDFileName {
566 :     # Get the parameters.
567 :     my ($self) = @_;
568 :     # Return the ID file name.
569 :     return $self->{idFileName};
570 :     }
571 :    
572 :     =head3 Show
573 :    
574 :     C<< my $printout = $xprc->Show(); >>
575 :    
576 :     Return a display of the global statistics object. The display will be in printable
577 :     form with embedded new-lines.
578 :    
579 :     =cut
580 :     #: Return Type $;
581 :     sub Show {
582 :     # Get the parameters.
583 :     my ($self) = @_;
584 :     # Return the statistical trace.
585 :     return $self->{stats}->Show();
586 :     }
587 :    
588 :     #### STUBS
589 :     #
590 :     # These essentially do nothing, and are only called if no override is present
591 :     # in the subclass.
592 :     #
593 :    
594 :     sub Add {
595 :     Trace("Add stub called.") if T(4);
596 :     }
597 :    
598 :     sub Change {
599 :     Trace("Change stub called.") if T(4);
600 :     }
601 :    
602 :     sub Delete {
603 :     Trace("Delete stub called.") if T(4);
604 :     }
605 :    
606 :     sub Setup {
607 :     Trace("Setup stub called.") if T(4);
608 :     }
609 :    
610 :     sub Teardown {
611 :     Trace("Teardown stub called.") if T(4);
612 :     }
613 :    
614 :     sub SetupGenome {
615 :     Trace("SetupGenome stub called.") if T(4);
616 :     }
617 :    
618 :     sub TeardownGenome {
619 :     Trace("TeardownGenome stub called.") if T(4);
620 :     }
621 :    
622 :     1;
623 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3