--- NewStuffCheck.pl 2006/08/24 21:17:08 1.10 +++ NewStuffCheck.pl 2008/02/05 05:15:42 1.26 @@ -3,20 +3,15 @@ =head1 New Stuff Checker This script compares the genomes, features, and annotations in -the old and new sprouts and lists the differences. +the old and new sprouts and lists the differences and produces +a report in HTML. The output is an HTML fragment, not an entire +web page. This is because we expect it to be included in another +page. -The currently-supported command-line options are as follows. +The currently-supported command-line options for NewStuffCheck are as follows. =over 4 -=item summary - -Do not display details, only difference summaries. - -=item nofeats - -Do not process features. - =item user Name suffix to be used for log files. If omitted, the PID is used. @@ -47,28 +42,72 @@ Phone number to message when the script is complete. +=item groupFile + +Name of the group file (described below). The default is C +in the Sprout data directory. + +=item outFile + +Output file name. The default is C in the +nmpdr C directory. + +=item orgFile + +Output file for the genome report. The default is C in +the nmpdr C directory. + +=back + +=head2 The Group File + +A key data file for this process is C. This file is kept in the +Sprout Data directory, and contains the following columns: + +=over 4 + +=item name + +Name of the group. + +=item page + +Name of the group's page on the web site (e.g. C for +Campylobacter) + +=item genus + +Genus of the group + +=item species + +Species of the group, or an empty string if the group is for an entire +genus. If the group contains more than one species, the species names +should be separated by commas. + =back =cut use strict; use Tracer; -use DocUtils; -use TestUtils; use Cwd; use File::Copy; use File::Path; use FIG; use SFXlate; use Sprout; +use CGI; +use FIGRules; # Get the command-line options and parameters. my ($options, @parameters) = StandardSetup([qw(Sprout) ], { - nofeats => ["", "if specified, only genome changes will be displayed; otherwise, genome features will be compared and differences shown"], - trace => ["2-", "tracing level; use a minus to prevent tracing to standard output"], - summary => ["", "if specified, detailed lists of the different items will not be displayed"], + groupFile => ["$FIG_Config::sproutData/groups.tbl", "location of the NMPDR group description file"], + trace => ["2", "tracing level; use a minus to prevent tracing to standard output"], phone => ["", "phone number (international format) to call when load finishes"], + outFile => ["$FIG_Config::nmpdr_base/next/html/includes/diff.inc", "output file for the difference report"], + orgFile => ["$FIG_Config::nmpdr_base/next/html/includes/genomes.inc", "output file for the genome report"], }, "", @ARGV); @@ -76,11 +115,30 @@ my $rtype; # Insure we catch errors. eval { + # Get a CGI object for building the output. We pass it the options hash so + # the formatting subroutines have access to it. Also, we want it to know + # we're not a real web script. + my $cgi = CGI->new($options); + # Start accumulating HTML data. + my @html = (); + # Open the output file. We do this early in case there's a problem. + my $outFileName = $options->{outFile}; + Trace("Opening output file $outFileName.") if T(2); + Open(\*OUTPUT, ">$outFileName"); + # Get a nice-looking version name and make it into a title. + my $version = uc $FIG_Config::nmpdr_version; + $version =~ tr/_/ /; + push @html, $cgi->h4({align => "center"}, "Difference Report for $version"); + # Start the table. + push @html, $cgi->start_table({align => "center", border => "2"}); + # Get the group file. + my $groupFileName = $options->{groupFile}; + Trace("Reading group file $groupFileName.") if T(2); Trace("Processing genomes.") if T(2); # Get the current SEED. my $fig = FIG->new(); # Get the old Sprout. - my $oldSprout = SFXlate->new_sprout_only($FIG_Config::oldSproutDB); + my $oldSprout = SFXlate->old_sprout_only(); # Get its genomes in alphabetical order. my @oldGenomes = GetGenomes($oldSprout); # Get the new Sprout. @@ -89,27 +147,44 @@ my @newGenomes = GetGenomes($newSprout); # Compare the two genomes lists. my ($insertedGenomes, $deletedGenomes) = Tracer::CompareLists(\@newGenomes, \@oldGenomes); - # Add feature counts to the new genomes. + # Get the super-group data. + my %superTable = $newSprout->CheckGroupFile(); + # Create a list for the new genomes that includes BBH and feature counts. We'll flip this + # lists so that the genome names are first and the IDs second. + my @insertedGenomeList = (); for my $insertedGenome (@{$insertedGenomes}) { my $genomeID = $insertedGenome->[0]; - # For a new genome, display the feature count. + # For a new genome, display the feature and BBH counts. my $count = $newSprout->GetCount(['HasFeature'], "HasFeature(from-link) = ?", [$genomeID]); - my $suffix = ($count == 1 ? " one feature" : "$count features"); - $insertedGenome->[1] .= "($suffix)"; + my $suffix = ($count == 1 ? "one feature" : "$count features"); + my $bbhCount = FIGRules::BatchBBHs("fig|$genomeID.%", 1e-10); + $suffix .= "; " . ($bbhCount == 1 ? "one BBH" : "$bbhCount BBHs"); + push @insertedGenomeList, [$insertedGenome->[1], "$genomeID ($suffix)"]; } - # Add information about SEED status to the deleted genomes. + # Create a list for the deleted genomes that contains information about SEED status. + # This list is flipped, too. + my @deletedGenomeList = (); for my $deletedGenome (@{$deletedGenomes}) { my $genomeID = $deletedGenome->[0]; + my $suffix = ""; if ($fig->is_genome($genomeID)) { + # Here the deleted genome is still in the SEED. my $complete = ($fig->is_complete($genomeID) ? "complete" : "incomplete"); - $deletedGenome->[1] .= "(still in SEED, $complete)"; + $suffix = " (still in SEED, $complete)"; + } else { + # It's not in the SEED. See if it has been replaced. + my ($genus, $species, $strain) = $oldSprout->GetGenomeNameData($genomeID); + my @genomeIDs = $newSprout->GetGenomeByNameData($genus, $species, $strain); + if (scalar @genomeIDs) { + $suffix = " (replaced)"; + } } + push @deletedGenomeList, [$deletedGenome->[1], "$genomeID$suffix"]; } # Display the lists. - ShowLists(! $options->{summary}, - 'New Genomes' => $insertedGenomes, - 'Deleted Genomes' => $deletedGenomes); + push @html, ShowLists($cgi, 'New Genomes' => \@insertedGenomeList, + 'Deleted Genomes' => \@deletedGenomeList); # Now the groups. Trace("Comparing groups.") if T(2); my %oldGroups = $oldSprout->GetGroups(); @@ -121,22 +196,22 @@ if (! exists $oldGroups{$newGroup}) { # Construct a list of this group's genes. my @groupGenomes = NameGenomes($newSprout, $newGroups{$newGroup}); - ShowLists(! $options->{summary}, "Genomes in new group $newGroup" => \@groupGenomes); + push @html, ShowLists($cgi, "Genomes in new group $newGroup" => \@groupGenomes); } else { - # Here the group is in both versions. Fix the lists and compare them. - my @newGroupList = NameGenomes($newSprout, $newGroups{$newGroup}); - my @oldGroupList = NameGenomes($oldSprout, $oldGroups{$newGroup}); + # Here the group is in both versions. Fix the lists and compare them. Note that we'll be comparing + # on the genome ID, which will become the second list element after the call to NameGenomes. + my @newGroupList = sort { $a->[1] <=> $b->[1] } NameGenomes($newSprout, $newGroups{$newGroup}); + my @oldGroupList = sort { $a->[1] <=> $b->[1] } NameGenomes($oldSprout, $oldGroups{$newGroup}); Trace("Comparing lists for $newGroup.") if T(4); - my ($insertedGroupGenomes, $deletedGroupGenomes) = Tracer::CompareLists(\@newGroupList, \@oldGroupList); + my ($insertedGroupGenomes, $deletedGroupGenomes) = Tracer::CompareLists(\@newGroupList, \@oldGroupList, 1); Trace("Comparison complete.") if T(4); - # Delete the old group data. When we're done, this means we'll have a list of the deleted - # groups. + # Delete the old group data. When we're done, this means the hash + # will contain only the deleted groups. delete $oldGroups{$newGroup}; # Show the lists. Empty lists will not be shown. Trace("Displaying group lists.") if T(4); - ShowLists(! $options->{summary}, - "Genomes new to $newGroup" => $insertedGroupGenomes, - "Genomes no longer in $newGroup" => $deletedGroupGenomes); + push @html, ShowLists($cgi, "Genomes new to $newGroup" => $insertedGroupGenomes, + "Genomes no longer in $newGroup" => $deletedGroupGenomes); } } Trace("Processing deleted groups.") if T(4); @@ -144,7 +219,7 @@ for my $oldGroup (sort keys %oldGroups) { Trace("Processing deleted group $oldGroup.") if T(3); my @groupGenomes = NameGenomes($oldSprout, $oldGroups{$oldGroup}); - ShowLists(! $options->{summary}, "Genomes in deleted group $oldGroup" => \@groupGenomes); + push @html, ShowLists($cgi, "Genomes in deleted group $oldGroup" => \@groupGenomes); } # Next, we get the subsystems. Trace("Processing subsystems.") if T(2); @@ -163,39 +238,187 @@ } } } - ShowLists(! $options->{summary}, - 'New Subsystems' => $insertedSubs, - 'Deleted Subsystems' => $deletedSubs); - # Now we process the features of the common genes. - if (! $options->{nofeats}) { - # First we need a hash of the inserted stuff so we know to skip it. - my %skipGenomes = map { $_->[0] => 1 } @{$insertedGenomes}; - # Loop through the genomees. - for my $genome (@newGenomes) { - # Get the ID and name. - my ($genomeID, $genomeName) = @{$genome}; - Trace("Processing $genomeID.") if T(3); - # Only process the common genes. - if (! $skipGenomes{$genomeID}) { - # Compare the genome group information. - # Get the new and old features. This will be very stressful to the machine, - # because there are lots of features. - my @oldFeatures = GetFeatures($oldSprout, $genomeID); - my @newFeatures = GetFeatures($newSprout, $genomeID); - Trace("Comparing features for $genomeID.") if T(3); - # Compare the lists. - my ($insertedFeatures, $deletedFeatures) = Tracer::CompareLists(\@newFeatures, \@oldFeatures); - # Display the lists. Only nonempty lists are displayed; however, we do a check - # first anyway so the trace tells us what's happening. - if (scalar @{$insertedFeatures} + scalar @{$deletedFeatures} > 0) { - Trace("Displaying feature differences.") if T(3); - ShowLists(! $options->{summary}, - "New Features for $genomeID" => $insertedFeatures, - "Features Deleted from $genomeID" => $deletedFeatures); + push @html, ShowLists($cgi, 'New Subsystems' => $insertedSubs, + 'Deleted Subsystems' => $deletedSubs); + # Print what we've done so far. + FlushData(\*OUTPUT, \@html); + # Now we need to process some statistics that require looping through all the + # features in the new sprout. While we're at it, we'll collect the BBH and + # coupling counts. + my $bbhCount = 0; + my $couplingCount = 0; + # We'll accumulate a report of genomes with missing BBHs in here. + my @bbhMissingGenomes = (); + # One of the reports is only for genomes common to both sprouts. To help us + # make this determination, we get a hash of the inserted genomes. + my %skipGenomes = map { $_->[0] => 1 } @{$insertedGenomes}; + # Open the organism report file. + Open(\*ORGOUT, ">$options->{orgFile}"); + # Start the table. + my @orgHtml = (); + push @orgHtml, $cgi->h4({ align => 'center' }, "Genome Report for $version"); + push @orgHtml, $cgi->start_table({ border => 2, align => 'center'}); + push @orgHtml, $cgi->Tr($cgi->th("Genome"), + $cgi->th({align => 'right'}, ["Size (bp)", "Feats", "Contigs", "Subs", + "F In SS", "PEGs", "RNAs", "PPs", "New", "Del"])); + FlushData(\*ORGOUT, \@orgHtml); + # Now we start the loop. Note that "newGenomes" means all the genomes in the new Sprout, + # not the list of genomes that are new! + for my $genomeData (@newGenomes) { + # Get this genome's ID and name. + my $genomeID = $genomeData->[0]; + # Create a title for it. + my $genomeTitle = "$genomeID: $genomeData->[1]"; + # Compute its size. + my $genomeSize = $newSprout->GenomeLength($genomeID); + # Get a list of the genomes in the new Sprout that are not this one. + my @otherGenomes = grep { $_ ne $genomeID } map { $_->[0] } @newGenomes; + Trace("Computing BBH matrix for $genomeID.") if T(3); + # Get the bbh matrix going from the current genome to the others. + my %matrix = $newSprout->BBHMatrix($genomeID, 1e-20, @otherGenomes); + # Set up the subsystem hash. This will be used to track which subsystems are used by + # the genome's features. + my %subHash = (); + # Set up the contig hash. This will be used to track which contigs are used by the + # genome's features. + my %contigHash = (); + # Set up a counter hash for feature types. + my %counters = (peg => 0, in_ss => 0, rna => 0, pp => 0, total => 0); + # We'll store information about the genome's features (ID and functional role) in here. + my @newFeatures = (); + # Finally, we'll use this flag to warn us if there are no BBHs. + my $bbhsFound = 0; + # Loop through the genome's features. The order is important here, because we need + # to match the order used by "GetFeatures" for the feature difference comparison. + Trace("Processing feature statistics for $genomeID.") if T(3); + my $fquery = $newSprout->Get(['HasFeature', 'Feature'], "HasFeature(from-link) = ? ORDER BY HasFeature(to-link)", + [$genomeID]); + # Loop through the features, updating the counts. + while (my $feature = $fquery->Fetch()) { + # Update the total feature count. + $counters{total}++; + Trace("$counters{total} features processed for $genomeID.") if T(3) && ($counters{total} % 500 == 0); + # Get the feature ID and role. + my $fid = $feature->PrimaryValue('Feature(id)'); + push @newFeatures, [$fid, $feature->PrimaryValue('Feature(assignment)')]; + # Check to see if we have BBH data. + if (exists $matrix{$fid}) { + my $fidBbhCount = scalar keys %{$matrix{$fid}}; + if ($fidBbhCount > 0) { + # Denote that this feature has BBHs. + $bbhsFound = 1; + # Add them to the total BBH count. + $bbhCount += $fidBbhCount; + } + } + # Ask for couplings. + my %coupleHash = $newSprout->CoupledFeatures($fid); + $couplingCount += keys %coupleHash; + # See if this feature is in a subsystem. + my %subs = $newSprout->SubsystemsOf($fid); + if (keys %subs) { + $counters{in_ss}++; + for my $sub (keys %subs) { + $subHash{$sub} = 1; } } + # Increment the feature type counter. + $counters{$feature->PrimaryValue('Feature(feature-type)')}++; + # Insure we've tracked this feature's contigs. + my @locations = split /\s*,\s*/, $feature->PrimaryValue('Feature(location-string)'); + for my $loc (@locations) { + my $locObject = BasicLocation->new($loc); + $contigHash{$locObject->Contig} = 1; + } + } + Trace("Feature data compiled for $genomeID.") if T(3); + # The last thing we need to do is compute the number of features added or deleted. + # This goes in the genome report, but it's only meaningful for common genomes. + my ($addCount, $delCount) = ("",""); + if (! $skipGenomes{$genomeID}) { + # Get the old features. + my @oldFeatures = GetFeatures($oldSprout, $genomeID); + Trace("Comparing features for $genomeID.") if T(3); + # Compare the lists. + my ($insertedFeatures, $deletedFeatures) = Tracer::CompareLists(\@newFeatures, \@oldFeatures); + $addCount = scalar(@{$insertedFeatures}); + $delCount = scalar(@{$deletedFeatures}); + } + # Check to see if this genome is missing its BBHs. + if (! $bbhsFound) { + # It is, so add a line for it to the missing-BBH list. + push @bbhMissingGenomes, ShowDatum($cgi, $genomeData->[1], $genomeID); + } + push @orgHtml, $cgi->Tr($cgi->td($genomeTitle), + $cgi->td({align => 'right'}, [$genomeSize, $counters{total}, scalar(keys %contigHash), + scalar(keys %subHash), $counters{in_ss}, $counters{peg}, + $counters{rna}, $counters{pp}, $addCount, $delCount])); + FlushData(\*ORGOUT, \@orgHtml); + } + # Close the table for the genome report. + push @orgHtml, $cgi->end_table(); + FlushData(\*ORGOUT, \@orgHtml); + close ORGOUT; + # Check for a missing-BBH report. + if (scalar @bbhMissingGenomes) { + # There is a report, so put it into the output stream. + push @html, ShowTitle($cgi, "Genomes without BBHs"); + push @html, @bbhMissingGenomes; + } + # Flush the genome feature comparison data and the missing-BBH report (if any). + FlushData(\*OUTPUT, \@html); + # Next, we show some basic counts. + Trace("Displaying counts.") if T(3); + push @html, ShowTitle($cgi, "Statistics for old Sprout"); + push @html, ShowCounts($cgi, $oldSprout); + push @html, ShowTitle($cgi, "Statistics for new Sprout"); + push @html, ShowCounts($cgi, $newSprout); + push @html, ShowDatum($cgi, BBHs => $bbhCount); + push @html, ShowDatum($cgi, "Functional Couplings", $couplingCount); + FlushData(\*OUTPUT, \@html); + # Now we show the genomes that are not in groups but could be. First, we convert + # our group hash from the new Sprout into the form used on the web site. + Trace("Examining possible missing genomes in groups.") if T(2); + my %fixedGroups = $newSprout->Fix(%newGroups); + for my $group (sort keys %superTable) { + Trace("Checking group $group."); + # Loop through this group's genus/species pairs creating filters + # for a genome query. + my @filters = (); + my @filterParms = (); + for my $genusSpecies (@{$superTable{$group}->{content}}) { + my ($genus, $species) = @{$genusSpecies}; + # Filter on genus. + my $filter = 'Genome(genus) = ?'; + push @filterParms, $genus; + # If necessary, filter on species. + if ($species) { + $filter .= ' AND Genome(species) = ?'; + push @filterParms, $species; + } + # Add this filter to the list. + push @filters, "($filter)"; + } + # Get all the genomes that should be in the super-group. + my @possibles = $newSprout->GetFlat(['Genome'], join(" OR ", @filters), + \@filterParms, 'Genome(id)'); + # Get a hash of the genomes already in it. + my %inGroup = map { $_ => 1 } @{$fixedGroups{$group}}; + # Get the possibles that aren't in the group and add identifying information. + my @leftOut = NameGenomes($newSprout, [ grep { ! exists $inGroup{$_} } @possibles ]); + # If anything survived, show the list. + if (@leftOut) { + push @html, ShowLists($cgi, "Candidates for $group" => \@leftOut); } } + FlushData(\*OUTPUT, \@html); + # Close the table. + push @html, $cgi->end_table(); + # Flush the last of the HTML. + FlushData(\*OUTPUT, \@html); + # Close the output file. + close OUTPUT; + Trace("Analysis complete.") if T(2); }; if ($@) { Trace("Script failed with error: $@") if T(0); @@ -205,7 +428,7 @@ $rtype = "no error"; } if ($options->{phone}) { - my $msgID = Tracer::SendSMS($options->{phone}, "Subsystem Checker terminated with $rtype."); + my $msgID = Tracer::SendSMS($options->{phone}, "New Stuff Checker terminated with $rtype."); if ($msgID) { Trace("Phone message sent with ID $msgID.") if T(2); } else { @@ -213,9 +436,46 @@ } } +=head3 FlushData + + FlushData($handle, \@lines); + +Write the specified lines to the output file and clear them out of the list. This +method is called periodically so that even if something goes wrong we can still +see the data accumulating in the output file. The key aspect here is that we +put new-line characters after each line written and show something in the trace +log. + +=over 4 + +=item handle + +Output handle to which the lines should be written. + +=item lines + +Reference to a list of output lines. The output lines will be written to the output +handle and then removed from the list. + +=back + +=cut + +sub FlushData { + # Get the parameters. + my ($handle, $lines) = @_; + Trace("Flushing " . scalar(@{$lines}) . " lines to output file.") if T(3); + # Write the lines. + print $handle join("\n", @{$lines}); + # Write a terminating new-line. + print $handle "\n"; + # Clear the list. + splice @{$lines}; +} + =head3 GetGenomes -C<< my @geneList = GetGenomes($sprout); >> + my @geneList = GetGenomes($sprout); Return a list of the genomes in the specified Sprout instance. The genomes are returned in alphabetical order by genome ID. @@ -251,7 +511,7 @@ =head3 NameGenomes -C<< my $newList = NameGenomes($sprout, \@genomes); >> + my @newList = NameGenomes($sprout, \@genomes); Convert a list of genome IDs to a list of genome IDs with names. @@ -278,14 +538,14 @@ # Get the parameters. my ($sprout, $genomes) = @_; # Attach the names. - my @retVal = map { [$_, $sprout->GenusSpecies($_) ] } @{$genomes}; + my @retVal = map { [$sprout->GenusSpecies($_), $_ ] } @{$genomes}; # Return the result. return @retVal; } =head3 GetSubsystems -C<< my @subsystems = GetSubsystems($sprout); >> + my @subsystems = GetSubsystems($sprout); Get a list of the subsystems in the specified Sprout instance. @@ -314,9 +574,56 @@ return @retVal; } +=head3 GetProperties + + my @propertyList = GetProperties($sprout); + +Return a list of properties. Each element in the list will be a 2-tuple containing +the property name and value in the first column and its ID in the second column. + +=over 4 + +=item sprout + +Sprout instance to be used to retrieve the properties. + +=item RETURN + +Returns a list of 2-tuples. The first element in each 2-tuple will be a string +in the form of an assignment of the property value to the property name. The second +element will be the number of features possessing the property. The list will be +sorted in ascending alphabetical order. + +=back + +=cut + +sub GetProperties { + # Get the parameters. + my ($sprout) = @_; + # Get the properties. + my @props = $sprout->GetAll(['Property'], + "ORDER BY Property(property-name), Property(property-value)", [], + ['Property(property-name)', 'Property(property-value)', 'Property(id)']); + # Combine the property names and values and replace each property ID by a feature count. + my @retVal; + for my $propItem (@props) { + # Split up the value on punctuation boundaries for readability. + my $propValue = $propItem->[1]; + $propValue =~ s/::/ :: /g; + $propValue =~ s/([,;])(\S)/$1 $2/g; + my $label = $propItem->[0] . " = " . $propValue; + my $count = $sprout->GetCount(['Feature', 'HasProperty'], "HasProperty(to-link) = ?", + [$propItem->[2]]); + push @retVal, [$label, $count]; + } + # Return the result. + return @retVal; +} + =head3 GetFeatures -C<< my @features = GetFeatures($sprout, $genomeID); >> + my @features = GetFeatures($sprout, $genomeID); Return the features of the specified genome in the specified Sprout instance. @@ -352,26 +659,37 @@ =head3 ShowLists -C<< ShowLists($all, %lists); >> + my @htmlLines = ShowLists($cgi, %lists); -Display a set of lists. Each list should consist of 2-tuples. +Display a set of lists. Each list should consist of 2-tuples, and the list +entries will be displayed as 2-element table rows with a header row. =over 4 -=item all +=item cgi -TRUE if details should be displayed; FALSE if only summaries should be displayed. +A CGI query object containing the options for this program. It is also used to format +HTML. =item lists A hash mapping list names to list references. +=item RETURN + +Returns a list of HTML lines displaying the list in tabular form. + +=back + =cut sub ShowLists { # Get the parameters. - my $all = shift @_; + my $cgi = shift @_; my %lists = @_; + # Declare the return variable. The HTML lines will be accumulated + # in here and then joined with new-lines. + my @retVal = (); # Loop through the lists in alphabetical order by list name. for my $listName (sort keys %lists) { # Get the list itself. @@ -380,32 +698,26 @@ my $listSize = scalar @{$list}; # Only proceed if the list is nonempty. if ($listSize > 0) { - my $header = ShowHeader($listName, $listSize); - print "$header\n"; + my $header = ComputeHeader($listName, $listSize); Trace($header) if T(3); - # If we're at trace level 3, display the list. - if ($all) { - # Put a spacer under the title. - print "\n"; - # Get the width of the name column. - my $width = 0; - for my $entryLen (map { length $_->[0] } @{$list}) { - $width = $entryLen if $entryLen > $width; - } - # Now display the list. - for my $entry (@{$list}) { - my ($name, $data) = @{$entry}; - print " $name" . (" " x ($width - length $name)) . " $data\n"; - } - print "\n\n"; + # Display the header line as a header. + push @retVal, ShowTitle($cgi, $header); + # Now display the list as table rows. Note we convert underbars to spaces + # in the name row to make the table easier to fit into narrow places. + for my $entry (@{$list}) { + my ($name, $data) = @{$entry}; + $name =~ tr/_/ /; + push @retVal, ShowDatum($cgi, $name => $data); } } } + # Return the list of HTML lines. + return @retVal; } -=head3 ShowHeader +=head3 ComputeHeader -C<< my $header = ShowHeader($name, $count); >> + my $header = ComputeHeader($name, $count); Return a list header for a list of the specified length. @@ -427,20 +739,133 @@ =cut -sub ShowHeader { +sub ComputeHeader { # Get the parameters. my ($name, $count) = @_; # Declare the return variable. - my $retVal; + my $retVal; if ($count == 0) { - $retVal = "*** $name: none"; + $retVal = "$name: none"; } elsif ($count == 1) { - $retVal = "*** $name: one"; + $retVal = "$name: one"; } else { - $retVal = "*** $name: $count"; + $retVal = "$name: $count"; } # Return the result. return $retVal; } +=head3 ShowCounts + + ShowCounts($sprout); + +Display general counts for the specified sprout instance. These counts are +used in progress reports. + +=over 4 + +=item cgi + +CGI query object used to format the output. + +=item sprout + +Sprout instance for which counts are to be produced. + +=item RETURN + +Returns a list of HTML lines with the counts arranged in table rows. + +=back + +=cut + +sub ShowCounts { + # Get the parameters. + my ($cgi, $sprout) = @_; + # Count genomes and subsystems. + my $genomes = $sprout->GetCount(['Genome']); + my $subsystems = $sprout->GetCount(['Subsystem']); + # Count roles and external functional assignments. + my $roles = $sprout->GetCount(['OccursInSubsystem']); + my $funcs = $sprout->GetCount(['ExternalAliasFunc']); + # Count features. + my $features = $sprout->GetCount(['Feature']); + # Display the counts. + my @retVal = (); + push @retVal, ShowDatum($cgi, Genomes => $genomes); + push @retVal, ShowDatum($cgi, Subsystems => $subsystems); + push @retVal, ShowDatum($cgi, Roles => $roles); + push @retVal, ShowDatum($cgi, 'External function assignments', $funcs); + push @retVal, ShowDatum($cgi, Features => $features); + # Return the html. + return @retVal; +} + +=head3 ShowDatum + + my $htmlText = ShowDatum($cgi, $label, $value); + +Return a table row displaying the specified label and value. + +=over 4 + +=item cgi + +CGI query object used to generate the HTML text. + +=item label + +Label to appear in the left cell of the table row. + +=item value + +Value to appear in the right cell of the table row. + +=item RETURN + +Returns the HTML for a single table row with the last cell right-aligned. + +=back + +=cut + +sub ShowDatum { + # Get the parameters. + my ($cgi, $label, $value) = @_; + # Create the table row. + my $retVal = $cgi->Tr($cgi->td($label), $cgi->td({align => 'right'}, $value)); + # Return it. + return $retVal; +} + +=head3 ShowTitle + + my $html = ShowTitle($cgi, $title); + +Display a title line. This will be a merged table row with bolded text. + +=over 4 + +=item cgi + +CGI query object used to generate HTML output. + +=item RETURN + +Returns the HTML text. + +=back + +=cut + +sub ShowTitle { + # Get the parameters. + my ($cgi, $title) = @_; + # Declare the return variable. + my $retVal = $cgi->Tr($cgi->th({colspan => 2, align => "center"}, $title)); + # Return the result. + return $retVal; +} + 1; \ No newline at end of file