[Bio] / Sprout / NewStuffCheck.pl Repository:
ViewVC logotype

Annotation of /Sprout/NewStuffCheck.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     =head1 New Stuff Checker
4 :    
5 :     This script compares the genomes, features, and annotations in
6 : parrello 1.16 the old and new sprouts and lists the differences and produces
7 :     a report in HTML. The output is an HTML fragment, not an entire
8 :     web page. This is because we expect it to be included in another
9 :     page.
10 : parrello 1.1
11 : parrello 1.11 The currently-supported command-line options for NewStuffCheck are as follows.
12 : parrello 1.1
13 :     =over 4
14 :    
15 : parrello 1.8 =item nofeats
16 :    
17 :     Do not process features.
18 :    
19 : parrello 1.1 =item user
20 :    
21 :     Name suffix to be used for log files. If omitted, the PID is used.
22 :    
23 :     =item trace
24 :    
25 :     Numeric trace level. A higher trace level causes more messages to appear. The
26 :     default trace level is 2. Tracing will be directly to the standard output
27 :     as well as to a C<trace>I<User>C<.log> file in the FIG temporary directory,
28 :     where I<User> is the value of the B<user> option above.
29 :    
30 :     =item sql
31 :    
32 :     If specified, turns on tracing of SQL activity.
33 :    
34 :     =item background
35 :    
36 :     Save the standard and error output to files. The files will be created
37 :     in the FIG temporary directory and will be named C<err>I<User>C<.log> and
38 :     C<out>I<User>C<.log>, respectively, where I<User> is the value of the
39 :     B<user> option above.
40 :    
41 :     =item h
42 :    
43 :     Display this command's parameters and options.
44 :    
45 :     =item phone
46 :    
47 :     Phone number to message when the script is complete.
48 :    
49 : parrello 1.11 =item groupFile
50 :    
51 :     Name of the group file (described below). The default is C<groups.tbl>
52 :     in the Sprout data directory.
53 :    
54 : parrello 1.16 =item outFile
55 :    
56 :     Output file name. The default is C<html/includes/differences.inc> in the
57 :     nmpdr C<next> directory.
58 :    
59 : parrello 1.11 =back
60 :    
61 :     =head2 The Group File
62 :    
63 :     A key data file for this process is C<groups.tbl>. This file is kept in the
64 :     Sprout Data directory, and contains the following columns:
65 :    
66 :     =over 4
67 :    
68 :     =item name
69 :    
70 :     Name of the group.
71 :    
72 :     =item page
73 :    
74 :     Name of the group's page on the web site (e.g. C<campy.php> for
75 :     Campylobacter)
76 :    
77 :     =item genus
78 :    
79 :     Genus of the group
80 :    
81 :     =item species
82 :    
83 :     Species of the group, or an empty string if the group is for an entire
84 : parrello 1.13 genus. If the group contains more than one species, the species names
85 :     should be separated by commas.
86 : parrello 1.11
87 : parrello 1.1 =back
88 :    
89 :     =cut
90 :    
91 :     use strict;
92 :     use Tracer;
93 :     use DocUtils;
94 :     use TestUtils;
95 :     use Cwd;
96 :     use File::Copy;
97 :     use File::Path;
98 :     use FIG;
99 :     use SFXlate;
100 :     use Sprout;
101 : parrello 1.16 use CGI;
102 : parrello 1.1
103 :     # Get the command-line options and parameters.
104 :     my ($options, @parameters) = StandardSetup([qw(Sprout) ],
105 :     {
106 : parrello 1.11 groupFile => ["$FIG_Config::sproutData/groups.tbl", "location of the NMPDR group description file"],
107 : parrello 1.8 nofeats => ["", "if specified, only genome changes will be displayed; otherwise, genome features will be compared and differences shown"],
108 : parrello 1.16 trace => ["2", "tracing level; use a minus to prevent tracing to standard output"],
109 : parrello 1.1 phone => ["", "phone number (international format) to call when load finishes"],
110 : parrello 1.16 outFile => ["$FIG_Config::nmpdr_base/next/html/includes/diff.inc", "output file for the difference report"],
111 : parrello 1.1 },
112 :     "",
113 :     @ARGV);
114 :     # Set a variable to contain return type information.
115 :     my $rtype;
116 :     # Insure we catch errors.
117 :     eval {
118 : parrello 1.16 # Get a CGI object for building the output. We pass it the options hash so
119 :     # the formatting subroutines have access to it. Also, we want it to know
120 :     # we're not a real web script.
121 :     my $cgi = CGI->new($options);
122 :     # Start accumulating HTML data.
123 :     my @html = ();
124 :     # Open the output file. We do this early in case there's a problem.
125 :     my $outFileName = $options->{outFile};
126 :     Trace("Opening output file $outFileName.") if T(2);
127 :     Open(\*OUTPUT, ">$outFileName");
128 :     # Get a nice-looking version name and make it into a title.
129 :     my $version = uc $FIG_Config::nmpdr_version;
130 :     $version =~ tr/_/ /;
131 :     push @html, $cgi->h4({align => "center"}, "Difference Report for $version.");
132 :     # Start the table.
133 :     push @html, $cgi->start_table({align => "center", border => "2"});
134 : parrello 1.11 # Get the group file.
135 :     my $groupFileName = $options->{groupFile};
136 :     Trace("Reading group file $groupFileName.") if T(2);
137 : parrello 1.16 # We'll put each group's data into a hash, keyed by group
138 : parrello 1.11 # name, each entry being a 3-tuple of page name, genus,
139 :     # and species
140 : parrello 1.13 my %groups = Sprout::ReadGroupFile($groupFileName);
141 : parrello 1.2 Trace("Processing genomes.") if T(2);
142 : parrello 1.8 # Get the current SEED.
143 :     my $fig = FIG->new();
144 : parrello 1.1 # Get the old Sprout.
145 :     my $oldSprout = SFXlate->new_sprout_only($FIG_Config::oldSproutDB);
146 :     # Get its genomes in alphabetical order.
147 : parrello 1.8 my @oldGenomes = GetGenomes($oldSprout);
148 : parrello 1.1 # Get the new Sprout.
149 :     my $newSprout = SFXlate->new_sprout_only();
150 :     # Get its genomes in alphabetical order.
151 : parrello 1.8 my @newGenomes = GetGenomes($newSprout);
152 : parrello 1.7 # Compare the two genomes lists.
153 : parrello 1.1 my ($insertedGenomes, $deletedGenomes) = Tracer::CompareLists(\@newGenomes, \@oldGenomes);
154 : parrello 1.7 # Add feature counts to the new genomes.
155 :     for my $insertedGenome (@{$insertedGenomes}) {
156 :     my $genomeID = $insertedGenome->[0];
157 :     # For a new genome, display the feature count.
158 :     my $count = $newSprout->GetCount(['HasFeature'], "HasFeature(from-link) = ?",
159 :     [$genomeID]);
160 :     my $suffix = ($count == 1 ? " one feature" : "$count features");
161 :     $insertedGenome->[1] .= "($suffix)";
162 :     }
163 : parrello 1.8 # Add information about SEED status to the deleted genomes.
164 :     for my $deletedGenome (@{$deletedGenomes}) {
165 :     my $genomeID = $deletedGenome->[0];
166 :     if ($fig->is_genome($genomeID)) {
167 :     my $complete = ($fig->is_complete($genomeID) ? "complete" : "incomplete");
168 : parrello 1.9 $deletedGenome->[1] .= "(still in SEED, $complete)";
169 : parrello 1.8 }
170 :     }
171 : parrello 1.1 # Display the lists.
172 : parrello 1.16 push @html, ShowLists($cgi, 'New Genomes' => $insertedGenomes,
173 :     'Deleted Genomes' => $deletedGenomes);
174 : parrello 1.8 # Now the groups.
175 :     Trace("Comparing groups.") if T(2);
176 :     my %oldGroups = $oldSprout->GetGroups();
177 :     my %newGroups = $newSprout->GetGroups();
178 :     # Loop through the new groups.
179 :     for my $newGroup (sort keys %newGroups) {
180 :     Trace("Processing group $newGroup.") if T(3);
181 :     # Find out if this group is new to this version.
182 :     if (! exists $oldGroups{$newGroup}) {
183 :     # Construct a list of this group's genes.
184 :     my @groupGenomes = NameGenomes($newSprout, $newGroups{$newGroup});
185 : parrello 1.16 push @html, ShowLists($cgi, "Genomes in new group $newGroup" => \@groupGenomes);
186 : parrello 1.8 } else {
187 :     # Here the group is in both versions. Fix the lists and compare them.
188 :     my @newGroupList = NameGenomes($newSprout, $newGroups{$newGroup});
189 :     my @oldGroupList = NameGenomes($oldSprout, $oldGroups{$newGroup});
190 : parrello 1.10 Trace("Comparing lists for $newGroup.") if T(4);
191 : parrello 1.8 my ($insertedGroupGenomes, $deletedGroupGenomes) = Tracer::CompareLists(\@newGroupList, \@oldGroupList);
192 : parrello 1.10 Trace("Comparison complete.") if T(4);
193 : parrello 1.16 # Delete the old group data. When we're done, this means the hash
194 :     # will contain only the deleted groups.
195 : parrello 1.8 delete $oldGroups{$newGroup};
196 :     # Show the lists. Empty lists will not be shown.
197 : parrello 1.10 Trace("Displaying group lists.") if T(4);
198 : parrello 1.16 push @html, ShowLists($cgi, "Genomes new to $newGroup" => $insertedGroupGenomes,
199 :     "Genomes no longer in $newGroup" => $deletedGroupGenomes);
200 : parrello 1.8 }
201 :     }
202 : parrello 1.10 Trace("Processing deleted groups.") if T(4);
203 : parrello 1.8 # Now list the deleted groups.
204 :     for my $oldGroup (sort keys %oldGroups) {
205 :     Trace("Processing deleted group $oldGroup.") if T(3);
206 :     my @groupGenomes = NameGenomes($oldSprout, $oldGroups{$oldGroup});
207 : parrello 1.16 push @html, ShowLists($cgi, "Genomes in deleted group $oldGroup" => \@groupGenomes);
208 : parrello 1.8 }
209 : parrello 1.1 # Next, we get the subsystems.
210 : parrello 1.2 Trace("Processing subsystems.") if T(2);
211 : parrello 1.1 my @oldSubsystems = GetSubsystems($oldSprout);
212 :     my @newSubsystems = GetSubsystems($newSprout);
213 :     # Compare and display the subsystem lists.
214 :     my ($insertedSubs, $deletedSubs) = Tracer::CompareLists(\@newSubsystems, \@oldSubsystems);
215 : parrello 1.8 # Check the deleted subsystems to see if they're in SEED.
216 :     if (scalar @{$deletedSubs} > 0) {
217 :     my %subChecker = map { $_ => 1 } $fig->all_subsystems();
218 :     for my $deletedSub (@{$deletedSubs}) {
219 :     my $subID = $deletedSub->[0];
220 :     if ($subChecker{$subID}) {
221 :     my $trusted = ($fig->usable_subsystem($subID) ? "usable" : "not usable");
222 : parrello 1.9 $deletedSub->[1] .= " (still in SEED, $trusted)";
223 : parrello 1.8 }
224 :     }
225 :     }
226 : parrello 1.16 push @html, ShowLists($cgi, 'New Subsystems' => $insertedSubs,
227 :     'Deleted Subsystems' => $deletedSubs);
228 : parrello 1.11 # Next, we show some basic counts.
229 : parrello 1.16 push @html, ShowTitle($cgi, "Statistics for old Sprout");
230 :     push @html, ShowCounts($cgi, $oldSprout);
231 :     push @html, ShowTitle($cgi, "Statistics for new Sprout");
232 :     push @html, ShowCounts($cgi, $newSprout);
233 : parrello 1.11 # Now we show the genomes that are not in groups but could be. First, we convert
234 :     # our group hash from the new Sprout into the form used on the web site.
235 :     Trace("Examining possible missing genomes in groups.") if T(2);
236 :     my %fixedGroups = Sprout::Fix(%newGroups);
237 :     for my $group (sort keys %groups) {
238 :     Trace("Checking group $group.");
239 :     # Get this group's genus and species.
240 :     my $genus = $groups{$group}->[1];
241 :     my $species = $groups{$group}->[2];
242 :     # Get a hash of the genomes already in it.
243 :     my %inGroup = map { $_ => 1 } @{$fixedGroups{$group}};
244 :     # Get a list of its possible genomes.
245 :     my $filter = 'Genome(genus) = ?';
246 :     my @parms = ($genus);
247 : parrello 1.13 # The species list is tricky because a given group may involve more than
248 :     # one target species. The species names will be comma-separated, and
249 :     # we use some PERL trickiness to generate an OR filter for them.
250 : parrello 1.11 if ($species) {
251 : parrello 1.13 # Get the individual species.
252 :     my @speciesList = split /\s*,\s*/, $species;
253 :     # Create one species filter per species.
254 :     my @filterClauses = map { 'Genome(species) = ?' } @speciesList;
255 :     # OR the filter clauses together to get a real filter.
256 :     $filter .= " AND (" . (join " OR ", @filterClauses) . ")";
257 :     # Add the specieis names to the SQL parameter list.
258 :     push @parms, @speciesList;
259 : parrello 1.11 }
260 :     my @possibles = $newSprout->GetFlat(['Genome'], $filter, \@parms, 'Genome(id)');
261 :     # Get the possibles that aren't in the group and add identifying information.
262 : parrello 1.12 my @leftOut = NameGenomes($newSprout, [ grep { ! exists $inGroup{$_} } @possibles ]);
263 : parrello 1.11 # If anything survived, show the list.
264 :     if (@leftOut) {
265 : parrello 1.16 push @html, ShowLists($cgi, "Candidates for $group" => \@leftOut);
266 : parrello 1.11 }
267 :     }
268 :     # Compare the property tables.
269 :     Trace("Comparing properties.") if T(2);
270 :     # Set up lists of all the properties in each sprout.
271 :     my @oldProps = GetProperties($oldSprout);
272 :     my @newProps = GetProperties($newSprout);
273 :     # Compare the lists.
274 :     my ($insertedProps, $deletedProps) = Tracer::CompareLists(\@oldProps, \@newProps);
275 :     # Now get all the properties in the new Sprout without any features.
276 :     my @emptyProps = grep { $_->[1] == 0 } @newProps;
277 :     # Show what we've found.
278 : parrello 1.16 push @html, ShowLists($cgi, 'New Properties' => $insertedProps,
279 :     'Deleted Properties' => $deletedProps,
280 :     'Empty Properties' => \@emptyProps);
281 : parrello 1.8 # Now we process the features of the common genes.
282 :     if (! $options->{nofeats}) {
283 :     # First we need a hash of the inserted stuff so we know to skip it.
284 :     my %skipGenomes = map { $_->[0] => 1 } @{$insertedGenomes};
285 :     # Loop through the genomees.
286 :     for my $genome (@newGenomes) {
287 :     # Get the ID and name.
288 :     my ($genomeID, $genomeName) = @{$genome};
289 :     Trace("Processing $genomeID.") if T(3);
290 :     # Only process the common genes.
291 :     if (! $skipGenomes{$genomeID}) {
292 :     # Compare the genome group information.
293 :     # Get the new and old features. This will be very stressful to the machine,
294 :     # because there are lots of features.
295 :     my @oldFeatures = GetFeatures($oldSprout, $genomeID);
296 :     my @newFeatures = GetFeatures($newSprout, $genomeID);
297 :     Trace("Comparing features for $genomeID.") if T(3);
298 :     # Compare the lists.
299 :     my ($insertedFeatures, $deletedFeatures) = Tracer::CompareLists(\@newFeatures, \@oldFeatures);
300 :     # Display the lists. Only nonempty lists are displayed; however, we do a check
301 :     # first anyway so the trace tells us what's happening.
302 :     if (scalar @{$insertedFeatures} + scalar @{$deletedFeatures} > 0) {
303 :     Trace("Displaying feature differences.") if T(3);
304 : parrello 1.16 push @html, ShowLists($cgi, "New Features for $genomeID" => $insertedFeatures,
305 :     "Features Deleted from $genomeID" => $deletedFeatures);
306 : parrello 1.8 }
307 : parrello 1.1 }
308 :     }
309 :     }
310 : parrello 1.16 # Close the table.
311 :     push @html, $cgi->end_table();
312 :     # Assemble and write the HTML.
313 :     Trace("Writing to output.") if T(2);
314 :     print OUTPUT join("\n", @html, "");
315 :     # Close the output file.
316 :     close OUTPUT;
317 :     Trace("Analysis complete.") if T(2);
318 : parrello 1.1 };
319 :     if ($@) {
320 :     Trace("Script failed with error: $@") if T(0);
321 :     $rtype = "error";
322 :     } else {
323 :     Trace("Script complete.") if T(2);
324 :     $rtype = "no error";
325 :     }
326 :     if ($options->{phone}) {
327 : parrello 1.11 my $msgID = Tracer::SendSMS($options->{phone}, "New Stuff Checker terminated with $rtype.");
328 : parrello 1.1 if ($msgID) {
329 :     Trace("Phone message sent with ID $msgID.") if T(2);
330 :     } else {
331 :     Trace("Phone message not sent.") if T(2);
332 :     }
333 :     }
334 :    
335 : parrello 1.8 =head3 GetGenomes
336 : parrello 1.1
337 : parrello 1.8 C<< my @geneList = GetGenomes($sprout); >>
338 : parrello 1.1
339 :     Return a list of the genomes in the specified Sprout instance. The genomes
340 :     are returned in alphabetical order by genome ID.
341 :    
342 :     =over 4
343 :    
344 :     =item sprout
345 :    
346 :     Sprout instance whose gene list is desired.
347 :    
348 :     =item RETURN
349 :    
350 :     Returns a list of two-tuples. The first element in each tuple is the genome ID,
351 :     and the second is the genome name (genus, species, strain).
352 :    
353 :     =back
354 :    
355 :     =cut
356 :    
357 : parrello 1.8 sub GetGenomes {
358 : parrello 1.1 # Get the parameters.
359 :     my ($sprout) = @_;
360 :     # Get the desired data.
361 :     my @genomes = $sprout->GetAll(['Genome'], "ORDER BY Genome(id)", [], ['Genome(id)',
362 :     'Genome(genus)',
363 :     'Genome(species)',
364 :     'Genome(unique-characterization)']);
365 :     # Create the genome names from the three pieces of the name.
366 :     my @retVal = map { [$_->[0], join(" ", @{$_}[1..3])] } @genomes;
367 :     # Return the result.
368 :     return @retVal;
369 :     }
370 :    
371 : parrello 1.8 =head3 NameGenomes
372 :    
373 : parrello 1.11 C<< my @newList = NameGenomes($sprout, \@genomes); >>
374 : parrello 1.8
375 :     Convert a list of genome IDs to a list of genome IDs with names.
376 :    
377 :     =over 4
378 :    
379 :     =item sprout
380 :    
381 :     The relevant sprout instance.
382 :    
383 :     =item genomes
384 :    
385 :     Reference to a list of genome IDs
386 :    
387 :     =item RETURN
388 :    
389 :     Returns a list of 2-tuples, each tuple consisting of a genome ID followed by a
390 :     genome name.
391 :    
392 :     =back
393 :    
394 :     =cut
395 :    
396 :     sub NameGenomes {
397 :     # Get the parameters.
398 :     my ($sprout, $genomes) = @_;
399 :     # Attach the names.
400 : parrello 1.16 my @retVal = map { [$sprout->GenusSpecies($_), $_ ] } @{$genomes};
401 : parrello 1.8 # Return the result.
402 :     return @retVal;
403 :     }
404 :    
405 : parrello 1.1 =head3 GetSubsystems
406 :    
407 :     C<< my @subsystems = GetSubsystems($sprout); >>
408 :    
409 :     Get a list of the subsystems in the specified Sprout instance.
410 :    
411 :     =over 4
412 :    
413 :     =item sprout
414 :    
415 :     Sprout instance whose subsystems are desired.
416 :    
417 :     =item RETURN
418 :    
419 :     Returns a list of 2-tuples, each consisting of the subsystem name followed by
420 :     the name of the curator.
421 :    
422 :     =back
423 :    
424 :     =cut
425 :    
426 :     sub GetSubsystems {
427 :     # Get the parameters.
428 :     my ($sprout) = @_;
429 :     # Declare the return variable.
430 :     my @retVal = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(id)",
431 :     [], ['Subsystem(id)', 'Subsystem(curator)']);
432 :     # Return the result.
433 :     return @retVal;
434 :     }
435 :    
436 : parrello 1.11 =head3 GetProperties
437 :    
438 :     C<< my @propertyList = GetProperties($sprout); >>
439 :    
440 :     Return a list of properties. Each element in the list will be a 2-tuple containing
441 :     the property name and value in the first column and its ID in the second column.
442 :    
443 :     =over 4
444 :    
445 :     =item sprout
446 :    
447 :     Sprout instance to be used to retrieve the properties.
448 :    
449 :     =item RETURN
450 :    
451 :     Returns a list of 2-tuples. The first element in each 2-tuple will be a string
452 :     in the form of an assignment of the property value to the property name. The second
453 :     element will be the number of features possessing the property. The list will be
454 :     sorted in ascending alphabetical order.
455 :    
456 :     =back
457 :    
458 :     =cut
459 :    
460 :     sub GetProperties {
461 :     # Get the parameters.
462 :     my ($sprout) = @_;
463 :     # Get the properties.
464 :     my @props = $sprout->GetAll(['Property'],
465 :     "ORDER BY Property(property-name), Property(property-value)", [],
466 :     ['Property(property-name)', 'Property(property-value)', 'Property(id)']);
467 :     # Combine the property names and values and replace each property ID by a feature count.
468 :     my @retVal;
469 :     for my $propItem (@props) {
470 :     my $label = $propItem->[0] . " = " . $propItem->[1];
471 :     my $count = $sprout->GetCount(['Feature', 'HasProperty'], "HasProperty(to-link) = ?",
472 :     [$propItem->[2]]);
473 :     push @retVal, [$label, $count];
474 :     }
475 :     # Return the result.
476 :     return @retVal;
477 :     }
478 :    
479 : parrello 1.1 =head3 GetFeatures
480 :    
481 :     C<< my @features = GetFeatures($sprout, $genomeID); >>
482 :    
483 :     Return the features of the specified genome in the specified Sprout instance.
484 :    
485 :     =over 4
486 :    
487 :     =item sprout
488 :    
489 :     Sprout instance to use to get the features.
490 :    
491 :     =item genomeID
492 :    
493 :     ID of the genome in question.
494 :    
495 :     =item RETURN
496 :    
497 :     Returns a list of 2-tuples, the first element being the feature ID and the second its
498 :     functional assignment (if any).
499 :    
500 :     =back
501 :    
502 :     =cut
503 :    
504 :     sub GetFeatures {
505 :     # Get the parameters.
506 :     my ($sprout, $genomeID) = @_;
507 :     # Get a list of the feature IDs and map them to their functional assignments.
508 :     my @retVal = map { [$_, $sprout->FunctionOf($_)] } $sprout->GetFlat(['HasFeature'],
509 :     "HasFeature(from-link) = ? ORDER BY HasFeature(to-link)",
510 :     [$genomeID], 'HasFeature(to-link)');
511 :     # Return the result.
512 :     return @retVal;
513 :     }
514 :    
515 :     =head3 ShowLists
516 :    
517 : parrello 1.16 C<< my @htmlLines = ShowLists($cgi, %lists); >>
518 : parrello 1.1
519 : parrello 1.16 Display a set of lists. Each list should consist of 2-tuples, and the list
520 :     entries will be displayed as 2-element table rows with a header row.
521 : parrello 1.1
522 :     =over 4
523 :    
524 : parrello 1.16 =item cgi
525 : parrello 1.2
526 : parrello 1.16 A CGI query object containing the options for this program. It is also used to format
527 :     HTML.
528 : parrello 1.2
529 : parrello 1.1 =item lists
530 :    
531 :     A hash mapping list names to list references.
532 :    
533 : parrello 1.16 =item RETURN
534 :    
535 :     Returns a list of HTML lines displaying the list in tabular form.
536 :    
537 : parrello 1.15 =back
538 :    
539 : parrello 1.1 =cut
540 :    
541 :     sub ShowLists {
542 :     # Get the parameters.
543 : parrello 1.16 my $cgi = shift @_;
544 : parrello 1.1 my %lists = @_;
545 : parrello 1.16 # Declare the return variable. The HTML lines will be accumulated
546 :     # in here and then joined with new-lines.
547 :     my @retVal = ();
548 : parrello 1.1 # Loop through the lists in alphabetical order by list name.
549 : parrello 1.6 for my $listName (sort keys %lists) {
550 : parrello 1.1 # Get the list itself.
551 :     my $list = $lists{$listName};
552 :     # Get the number of list items.
553 :     my $listSize = scalar @{$list};
554 : parrello 1.6 # Only proceed if the list is nonempty.
555 :     if ($listSize > 0) {
556 : parrello 1.16 my $header = ComputeHeader($listName, $listSize);
557 : parrello 1.6 Trace($header) if T(3);
558 : parrello 1.16 # Display the header line as a header.
559 :     push @retVal, ShowTitle($cgi, $header);
560 :     # Now display the list as table rows.
561 :     for my $entry (@{$list}) {
562 :     my ($name, $data) = @{$entry};
563 :     push @retVal, $cgi->Tr($cgi->td($name), $cgi->td({align => "right"}, $data));
564 : parrello 1.1 }
565 :     }
566 :     }
567 : parrello 1.16 # Return the list of HTML lines.
568 :     return @retVal;
569 : parrello 1.1 }
570 :    
571 : parrello 1.16 =head3 ComputeHeader
572 : parrello 1.7
573 : parrello 1.16 C<< my $header = ComputeHeader($name, $count); >>
574 : parrello 1.7
575 :     Return a list header for a list of the specified length.
576 :    
577 :     =over 4
578 :    
579 :     =item name
580 :    
581 :     Name of the list.
582 :    
583 :     =item count
584 :    
585 :     Number of entries in the list.
586 :    
587 :     =item RETURN
588 :    
589 :     Returns a list header that shows the name of the list and the number of entries.
590 :    
591 :     =back
592 :    
593 :     =cut
594 :    
595 : parrello 1.16 sub ComputeHeader {
596 : parrello 1.7 # Get the parameters.
597 :     my ($name, $count) = @_;
598 :     # Declare the return variable.
599 : parrello 1.15 my $retVal;
600 : parrello 1.7 if ($count == 0) {
601 : parrello 1.16 $retVal = "$name: none";
602 : parrello 1.7 } elsif ($count == 1) {
603 : parrello 1.16 $retVal = "$name: one";
604 : parrello 1.7 } else {
605 : parrello 1.16 $retVal = "$name: $count";
606 : parrello 1.7 }
607 :     # Return the result.
608 :     return $retVal;
609 :     }
610 :    
611 : parrello 1.11 =head3 ShowCounts
612 :    
613 :     C<< ShowCounts($sprout); >>
614 :    
615 :     Display general counts for the specified sprout instance. These counts are
616 :     used in progress reports.
617 :    
618 :     =over 4
619 :    
620 : parrello 1.16 =item cgi
621 :    
622 :     CGI query object used to format the output.
623 :    
624 : parrello 1.11 =item sprout
625 :    
626 :     Sprout instance for which counts are to be produced.
627 :    
628 : parrello 1.16 =item RETURN
629 :    
630 :     Returns a list of HTML lines with the counts arranged in table rows.
631 :    
632 : parrello 1.11 =back
633 :    
634 :     =cut
635 :    
636 :     sub ShowCounts {
637 :     # Get the parameters.
638 : parrello 1.16 my ($cgi, $sprout) = @_;
639 : parrello 1.11 # Count genomes and subsystems.
640 :     my $genomes = $sprout->GetCount(['Genome']);
641 :     my $subsystems = $sprout->GetCount(['Subsystem']);
642 :     # Count roles, external functional assignments, and functional couplings.
643 :     my $roles = $sprout->GetCount(['OccursInSubsystem']);
644 :     my $funcs = $sprout->GetCount(['ExternalAliasFunc']);
645 :     my $couples = $sprout->GetCount(['Coupling']);
646 : parrello 1.16 # Count features.
647 : parrello 1.11 my $features = $sprout->GetCount(['Feature']);
648 :     # Display the counts.
649 : parrello 1.16 my @retVal = ();
650 :     push @retVal, $cgi->Tr($cgi->td("Genomes"), $cgi->td({ align => "right" }, $genomes));
651 :     push @retVal, $cgi->Tr($cgi->td("Subsystems"), $cgi->td({ align => "right" }, $subsystems));
652 :     push @retVal, $cgi->Tr($cgi->td("Roles"), $cgi->td({ align => "right" }, $roles));
653 :     push @retVal, $cgi->Tr($cgi->td("External function assignments"), $cgi->td({ align => "right" }, $funcs));
654 :     push @retVal, $cgi->Tr($cgi->td("Features"), $cgi->td({ align => "right" }, $features));
655 :     push @retVal, $cgi->Tr($cgi->td("Functional Coupling"), $cgi->td({ align => "right" }, $couples));
656 :     # Return the html.
657 :     return @retVal;
658 :     }
659 :    
660 :     =head3 ShowTitle
661 :    
662 :     C<< my $html = ShowTitle($cgi, $title); >>
663 :    
664 :     Display a title line. This will be a merged table row with bolded text.
665 :    
666 :     =over 4
667 :    
668 :     =item cgi
669 :    
670 :     CGI query object used to generate HTML output.
671 :    
672 :     =item RETURN
673 :    
674 :     Returns the HTML text.
675 :    
676 :     =back
677 :    
678 :     =cut
679 :    
680 :     sub ShowTitle {
681 :     # Get the parameters.
682 :     my ($cgi, $title) = @_;
683 :     # Declare the return variable.
684 :     my $retVal = $cgi->Tr($cgi->th({colspan => 2, align => "center"}, $title));
685 :     # Return the result.
686 :     return $retVal;
687 : parrello 1.11 }
688 : parrello 1.16
689 : parrello 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3