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

Annotation of /FigKernelPackages/TransactionProcessor.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (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 :     =head3 AddMessage
186 :    
187 :     C<< $xprc->AddMessage($message); >>
188 :    
189 :     Add the specified message to the organism statistics object.
190 :    
191 :     =over 4
192 :    
193 :     =item message
194 :    
195 :     Message to put in the statistical object's message queue.
196 :    
197 :     =back
198 :    
199 :     =cut
200 :     #: Return Type ;
201 :     sub AddMessage {
202 :     # Get the parameters.
203 :     my ($self, $message) = @_;
204 :     # Add the message to the statistics object.
205 :     $self->{orgStats}->AddMessage($message);
206 :     }
207 :    
208 :     =head3 StartGenome
209 :    
210 :     C<< my = $xprc->StartGenome($genomeID, $orgFileName); >>
211 :    
212 :     Start processing a particular genome.
213 :    
214 :     =over 4
215 :    
216 :     =item genomeID
217 :    
218 :     ID of the genome for which processing is to begin.
219 :    
220 :     =item
221 :    
222 :     Name of the input file.
223 :    
224 :     =back
225 :    
226 :     =cut
227 :     #: Return Type ;
228 :     sub StartGenome {
229 :     # Get the parameters.
230 :     my ($self, $genomeID, $orgFileName) = @_;
231 :     # Save the genome ID.
232 :     $self->{genomeID} = $genomeID;
233 :     # Create the statistics object for this organism.
234 :     $self->{orgStats} = Stats->new();
235 :     # Save the file name.
236 :     $self->{fileName} = $orgFileName;
237 :     # Do the subclass setup.
238 :     $self->SetupGenome();
239 :     }
240 :    
241 :     =head3 EndGenome
242 :    
243 :     C<< my $orgStats = $xprc->EndGenome(); >>
244 :    
245 :     Terminate processing for the current genome and return its statistics object.
246 :    
247 :     =cut
248 :     #: Return Type $%;
249 :     sub EndGenome {
250 :     # Get the parameters.
251 :     my ($self) = @_;
252 :     # Do the subclass teardown.
253 :     $self->TeardownGenome();
254 :     # Get the statistics object.
255 :     my $retVal = $self->{orgStats};
256 :     # Roll it up into the global statistics object.
257 :     $self->{stats}->Accumulate($retVal);
258 :     # Count this genome.
259 : parrello 1.3 $self->{stats}->Add("genomes", 1);
260 : parrello 1.1 # Return the genome statistics.
261 :     return $retVal;
262 :     }
263 :    
264 :     =head3 Option
265 :    
266 :     C<< my $value = $xprc->Option($optionName); >>
267 :    
268 :     Return the value of the specified command-line option.
269 :    
270 :     =over 4
271 :    
272 :     =item optionName
273 :    
274 :     Name of the command-line option whose value is desired.
275 :    
276 :     =item RETURN
277 :    
278 :     Value of the desired command-line option, or C<undef> if the option does
279 :     not exist.
280 :    
281 :     =back
282 :    
283 :     =cut
284 :     #: Return Type $;
285 :     sub Option {
286 :     # Get the parameters.
287 :     my ($self, $optionName) = @_;
288 :     # Return the option value.
289 :     return $self->{options}->{$optionName};
290 :     }
291 :    
292 :     =head3 GetRealID
293 :    
294 :     C<< my $realID = $xprc->GetRealID($ftype, $ordinal, $key); >>
295 :    
296 :     Compute the real ID of a new feature. This involves interrogating the ID hash and
297 :     formatting a full-blown ID out of little bits of information.
298 :    
299 :     =over 4
300 :    
301 :     =item controlBlock
302 :    
303 :     Reference to a hash containing data used to manage the transaction process.
304 :    
305 :     =item ordinal
306 :    
307 :     Zero-based ordinal number of this feature. The ordinal number is added to the value
308 :     stored in the ID hash to compute the real feature number.
309 :    
310 :     =item key
311 :    
312 :     Key in the ID hash relevant to this feature. The key is composed of the genome ID
313 :     followed by the feature type, separated by a period.
314 :    
315 :     =item RETURN
316 :    
317 :     Returns a fully-formatted FIG ID for the new feature.
318 :    
319 :     =back
320 :    
321 :     =cut
322 :    
323 :     sub GetRealID {
324 :     # Get the parameters.
325 :     my ($self, $ordinal, $key) = @_;
326 :     #Declare the return value.
327 :     my $retVal;
328 :     # Get the base value for the feature ID number.
329 :     my $base = $self->{idHash}->{$key};
330 :     # If it didn't exist, we have an error.
331 :     if (! defined $base) {
332 :     Confess("No ID range found for genome ID and feature type $key.");
333 :     } else {
334 :     # Now we have enough data to format the ID.
335 :     my $num = $base + $ordinal;
336 :     $retVal = "fig|$key.$num";
337 :     }
338 :     # Return the result.
339 :     return $retVal;
340 :     }
341 :    
342 :     =head3 ParseNewID
343 :    
344 :     C<< my ($ftype, $ordinal, $key) = $xprc->ParseNewID($newID); >>
345 :    
346 :     Extract the feature type and ordinal number from an incoming new ID.
347 :    
348 :     =over 4
349 :    
350 :     =item newID
351 :    
352 :     New ID specification taken from a transaction input record. This contains the
353 :     feature type followed by a period and then the ordinal number of the ID.
354 :    
355 :     =item RETURN
356 :    
357 :     Returna a three-element list. If successful, the list will contain the feature
358 :     type followed by the ordinal number and the key to use in the ID hash to find
359 :     the feature's true ID number. If the incoming ID is invalid, the list
360 :     will contain three C<undef>s.
361 :    
362 :     =back
363 :    
364 :     =cut
365 :    
366 :     sub ParseNewID {
367 :     # Get the parameters.
368 :     my ($self, $newID) = @_;
369 :     # Declare the return variables.
370 :     my ($ftype, $ordinal, $key);
371 :     # Parse the ID.
372 :     if ($newID =~ /^([a-z]+)\.(\d+)$/) {
373 :     # Here we have a valid ID.
374 :     ($ftype, $ordinal) = ($1, $2);
375 :     $key = $self->GenomeID . ".$ftype";
376 :     # Update the feature type count in the statistics.
377 :     $self->{orgStats}->Add($ftype, 1);
378 :     } else {
379 :     # Here we have an invalid ID.
380 :     $self->{orgStats}->AddMessage("Invalid ID $newID found in line " .
381 :     $self->{line} . " for genome " .
382 :     $self->GenomeID . ".");
383 :     }
384 :     # Return the result.
385 :     return ($ftype, $ordinal, $key);
386 :     }
387 :    
388 :     =head3 CheckTranslation
389 :    
390 :     C<< my $actualTranslation = $xprc->CheckTranslation($ftype, $locations, $translation); >>
391 :    
392 :     If we are processing a PEG, insure we have a translation for the peg's locations.
393 :    
394 :     This method checks the feature type and the incoming translation string. If the
395 :     translation string is empty and the feature type is C<peg>, it will generate
396 :     a translation string using the specified locations for the genome currently
397 :     being processed.
398 :    
399 :     =over 4
400 :    
401 :     =item ftype
402 :    
403 :     Feature type (C<peg>, C<rna>, etc.)
404 :    
405 :     =item locations
406 :    
407 :     Comma-delimited list of location strings for the feature in question.
408 :    
409 :     =item translation (optional)
410 :    
411 :     If specified, will be returned to the caller as the result.
412 :    
413 :     =item RETURN
414 :    
415 :     Returns the protein translation string for the specified locations, or C<undef>
416 :     if no translation is warranted.
417 :    
418 :     =back
419 :    
420 :     =cut
421 :    
422 :     sub CheckTranslation {
423 :     # Get the parameters.
424 :     my ($self, $ftype, $locations, $translation) = @_;
425 :     my $fig = $self->FIG;
426 :     # Declare the return variable.
427 :     my $retVal;
428 :     if ($ftype eq 'peg') {
429 :     # Here we have a protein encoding gene. Check to see if we already have
430 :     # a translation.
431 :     if (defined $translation) {
432 :     # Pass it back unmodified.
433 :     $retVal = $translation;
434 :     } else {
435 :     # Here we need to compute the translation.
436 :     my $dna = $fig->dna_seq($self->GenomeID, $locations);
437 :     $retVal = FIG::translate($dna);
438 :     }
439 :     }
440 :     # Return the result.
441 :     return $retVal;
442 :     }
443 :    
444 :     =head3 ReadIDHash
445 :    
446 :     C<< $xprc->ReadIDHash(); >>
447 :    
448 :     Read the ID hash data from the ID file.
449 :    
450 :     =cut
451 :     #: Return Type ;
452 :     sub ReadIDHash {
453 :     # Get the parameters.
454 :     my ($self) = @_;
455 :     # Create a counter.
456 :     my $inCount = 0;
457 :     # Open the ID file.
458 :     my $idFileName = $self->{idFileName};
459 :     Open(\*IDFILE, "<$idFileName");
460 :     # Loop through the records in the file.
461 :     while (my $idRecord = <IDFILE>) {
462 :     # Extract the three fields from the record.
463 :     chomp $idRecord;
464 :     my ($orgID, $ftype, $firstNumber) = split /\t/, $idRecord;
465 :     # Add it to the ID hash.
466 :     $self->{idHash}->{"$orgID.$ftype"} = $firstNumber;
467 :     # Count the record.
468 :     $inCount++;
469 :     }
470 :     Trace("$inCount ID ranges read in from $idFileName.") if T(2);
471 :     }
472 :    
473 :     =head3 Directory
474 :    
475 :     C<< my $dirName = $xprc->Directory; >>
476 :    
477 :     Name of the directory containing the transaction files.
478 :    
479 :     =cut
480 :     #: Return Type $;
481 :     sub Directory {
482 :     # Get the parameters.
483 :     my ($self) = @_;
484 :     # Return the directory name.
485 : parrello 1.2 return $self->{directory};
486 : parrello 1.1 }
487 :    
488 :     =head3 IDHash
489 :    
490 :     C<< my $idHash = $xprc->IDHash; >>
491 :    
492 :     Return a reference to the ID hash. The ID hash is used to extract the base
493 :     value for new IDs when processing and to count the IDs needed when counting.
494 :    
495 :     =cut
496 :     #: Return Type $%;
497 :     sub IDHash {
498 :     # Get the parameters.
499 :     my ($self) = @_;
500 :     # Return the hash.
501 :     return $self->{idHash};
502 :     }
503 :    
504 :     =head3 IncrementID
505 :    
506 :     C<< $xprc->IncrementID($ftype); >>
507 :    
508 :     Increment the ID hash counter for the specified feature type and the current genome.
509 :    
510 :     =over 4
511 :    
512 :     =item ftype
513 :    
514 :     Feature type whose ID counter is to be incremented.
515 :    
516 :     =back
517 :    
518 :     =cut
519 :     #: Return Type ;
520 :     sub IncrementID {
521 :     # Get the parameters.
522 :     my ($self, $ftype) = @_;
523 :     # Create the key.
524 :     my $key = $self->GenomeID . ".$ftype";
525 :     # Increment the counter for the specified key.
526 :     if (exists $self->{idHash}->{$key}) {
527 :     $self->{idHash}->{$key}++;
528 :     } else {
529 :     $self->{idHash}->{$key} = 1;
530 :     }
531 :     }
532 :    
533 :     =head3 IDFileName
534 :    
535 :     C<< my $idFileName = $xprc->IDFileName; >>
536 :    
537 :     Return the name of the ID file.
538 :    
539 :     =cut
540 :     #: Return Type $;
541 :     sub IDFileName {
542 :     # Get the parameters.
543 :     my ($self) = @_;
544 :     # Return the ID file name.
545 :     return $self->{idFileName};
546 :     }
547 :    
548 :     =head3 Show
549 :    
550 :     C<< my $printout = $xprc->Show(); >>
551 :    
552 :     Return a display of the global statistics object. The display will be in printable
553 :     form with embedded new-lines.
554 :    
555 :     =cut
556 :     #: Return Type $;
557 :     sub Show {
558 :     # Get the parameters.
559 :     my ($self) = @_;
560 :     # Return the statistical trace.
561 :     return $self->{stats}->Show();
562 :     }
563 :    
564 :     #### STUBS
565 :     #
566 :     # These essentially do nothing, and are only called if no override is present
567 :     # in the subclass.
568 :     #
569 :    
570 :     sub Add {
571 :     Trace("Add stub called.") if T(4);
572 :     }
573 :    
574 :     sub Change {
575 :     Trace("Change stub called.") if T(4);
576 :     }
577 :    
578 :     sub Delete {
579 :     Trace("Delete stub called.") if T(4);
580 :     }
581 :    
582 :     sub Setup {
583 :     Trace("Setup stub called.") if T(4);
584 :     }
585 :    
586 :     sub Teardown {
587 :     Trace("Teardown stub called.") if T(4);
588 :     }
589 :    
590 :     sub SetupGenome {
591 :     Trace("SetupGenome stub called.") if T(4);
592 :     }
593 :    
594 :     sub TeardownGenome {
595 :     Trace("TeardownGenome stub called.") if T(4);
596 :     }
597 :    
598 :     1;
599 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3