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

Annotation of /FigKernelPackages/FudgeTransactions.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package FudgeTransactions;
4 :    
5 :     use TransactionProcessor;
6 :     @ISA = ('TransactionProcessor');
7 :    
8 :     use strict;
9 :     use Tracer;
10 :     use PageBuilder;
11 :     use FIG;
12 :    
13 :     =head1 Fudge Transactions
14 :    
15 :     =head2 Introduction
16 :    
17 :     This is a TransactionProcessor subclass that creates test data from transactions
18 :     that have already been applied. Each ADD is converted into an ADD and a DELETE,
19 :     and each CHANGE is updated to use the new ID. Note that the ID file will need to
20 :     be modified before the transactions can be applied.
21 :    
22 :     =head2 Methods
23 :    
24 :     =head3 new
25 :    
26 :     C<< my $xprc = FudgeTransactions->new(\%options, $command, $directory, $idFile); >>
27 :    
28 :     Construct a new FudgeTransactions object.
29 :    
30 :     =over 4
31 :    
32 :     =item options
33 :    
34 :     Reference to a hash table containing the command-line options.
35 :    
36 :     =item command
37 :    
38 :     Command specified on the B<TransactFeatures> command line. This command determines
39 :     which TransactionProcessor subclass is active.
40 :    
41 :     =item directory
42 :    
43 :     Directory containing the transaction files.
44 :    
45 :     =item idFile
46 :    
47 :     Name of the ID file (if needed).
48 :    
49 :     =back
50 :    
51 :     =cut
52 :    
53 :     sub new {
54 :     # Get the parameters.
55 :     my ($class, $options, $command, $directory, $idFile) = @_;
56 :     # Construct via the subclass.
57 :     return TransactionProcessor::new($class, $options, $command, $directory, $idFile);
58 :     }
59 :    
60 :     =head3 Setup
61 :    
62 :     C<< $xprc->Setup(); >>
63 :    
64 :     Set up to apply the transactions. This includes reading the ID file.
65 :    
66 :     =cut
67 :     #: Return Type ;
68 :     sub Setup {
69 :     # Get the parameters.
70 :     my ($self) = @_;
71 :     # Read the ID hash from the ID file.
72 :     $self->ReadIDHash();
73 :     }
74 :    
75 :    
76 :     =head3 Teardown
77 :    
78 :     C<< $xprc->Teardown(); >>
79 :    
80 :     Update the ID table with high numbers to avoid duplication.
81 :    
82 :     =cut
83 :     #: Return Type ;
84 :     sub Teardown {
85 :     # Get the parameters.
86 :     my ($self) = @_;
87 :     # Get the ID hash.
88 :     my $idHash = $self->IDHash;
89 :     # Loop through the ID hash, creating a new ID file.
90 :     my $countFile = $self->IDFileName;
91 :     Open(\*COUNTFILE, ">$countFile");
92 :     print "\nTable of Counts\n";
93 :     for my $idKey (keys %{$idHash}) {
94 :     $idKey =~ /^(\d+\.\d+)\.([a-z]+)$/;
95 :     my ($org, $ftype) = ($1, $2);
96 :     print COUNTFILE "$org\t$ftype\t9000\n";
97 :     }
98 :     close COUNTFILE;
99 :     Trace("ID file $countFile updated.") if T(2);
100 :     }
101 :    
102 :     =head3 SetupGenome
103 :    
104 :     C<< $xprc->SetupGenome(); >>
105 :    
106 :     Set up for processing this genome. This opens the output file.
107 :    
108 :     =cut
109 :     #: Return Type ;
110 :     sub SetupGenome {
111 :     # Get the parameters.
112 :     my ($self) = @_;
113 :     my $fig = $self->FIG();
114 :     # Create the output file for this genome.
115 :     my $fileBase = $self->CurrentFileName;
116 :     Open(\*TRANSOUT, ">$fileBase.tbl");
117 :     }
118 :    
119 :     =head3 TeardownGenome
120 :    
121 :     C<< $xprc->TeardownGenome(); >>
122 :    
123 :     Clean up after processing this genome. This involves closing the output file and
124 :     doing a rename.
125 :    
126 :     =cut
127 :     #: Return Type ;
128 :     sub TeardownGenome {
129 :     # Get the parameters.
130 :     my ($self) = @_;
131 :     my $fig = $self->FIG();
132 :     # Close the transaction output file.
133 :     close TRANSOUT;
134 :     # Rename the files.
135 :     my $fileBase = $self->CurrentFileName;
136 :     my $nameBase = $fileBase;
137 :     if ($fileBase =~ m!/(.*)$!) {
138 :     $nameBase = $1;
139 :     }
140 :     my $okFlag = rename($fileBase, "$nameBase.bak");
141 :     $okFlag = rename("$fileBase.tbl", $nameBase);
142 :     }
143 :    
144 :     =head3 Add
145 :    
146 :     C<< $xprc->Add($newID, $locations, $translation); >>
147 :    
148 :     Add a new feature to the data store. The Add is transmitted unmodified to the
149 :     output file and then a delete is created for the ID added the last time.
150 :    
151 :     =over 4
152 :    
153 :     =item newID
154 :    
155 :     ID to give to the new feature.
156 :    
157 :     =item locations
158 :    
159 :     Location of the new feature, in the form of a comma-separated list of location
160 :     strings in SEED format.
161 :    
162 :     =item translation (optional)
163 :    
164 :     Protein translation string for the new feature. If this field is omitted and
165 :     the feature is a peg, the translation will be generated by normal means.
166 :    
167 :     =back
168 :    
169 :     =cut
170 :    
171 :     sub Add {
172 :     my ($self, $newID, $locations, $translation) = @_;
173 :     my $fig = $self->{fig};
174 :     # Echo the add to the output file.
175 :     print TRANSOUT "ADD\t$newID\t$locations\t$translation\n";
176 :     # Extract the feature type and ordinal number from the new ID.
177 :     my ($ftype, $ordinal, $key) = $self->ParseNewID($newID);
178 :     # Get the real version of the new ID.
179 :     my $realID = $self->GetRealID($ordinal, $key);
180 :     # Create the delete command.
181 :     print TRANSOUT "DELETE\t$realID\n";
182 :     }
183 :    
184 :     =head3 Change
185 :    
186 :     C<< $xprc->Change($fid, $newID, $locations, $aliases, $translation); >>
187 :    
188 :     Replace a feature to the data store. The feature will be marked for deletion and
189 :     a new feature will be put in its place.
190 :    
191 :     We change this so that it replaces the original real ID.
192 :    
193 :     =over 4
194 :    
195 :     =item fid
196 :    
197 :     ID of the feature being changed.
198 :    
199 :     =item newID
200 :    
201 :     New ID to give to the feature.
202 :    
203 :     =item locations
204 :    
205 :     New location to give to the feature, in the form of a comma-separated list of location
206 :     strings in SEED format.
207 :    
208 :     =item aliases (optional)
209 :    
210 :     A new list of alias names for the feature.
211 :    
212 :     =item translation (optional)
213 :    
214 :     New protein translation string for the feature. If this field is omitted and
215 :     the feature is a peg, the translation will be generated by normal means.
216 :    
217 :     =back
218 :    
219 :     =cut
220 :    
221 :     sub Change {
222 :     my ($self, $fid, $newID, $locations, $aliases, $translation) = @_;
223 :     my $fig = $self->{fig};
224 :     # Extract the feature type and ordinal number from the new ID.
225 :     my ($ftype, $ordinal, $key) = $self->ParseNewID($newID);
226 :     # Get the real version of the new ID.
227 :     my $realID = $self->GetRealID($ordinal, $key);
228 :     # Create the change command.
229 :     print TRANSOUT "CHANGE\t$realID\t$newID\t$locations\t$aliases\t$translation\n";
230 :     }
231 :    
232 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3