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

View of /Sprout/NewStuffCheck.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.25 - (download) (as text) (annotate)
Fri Dec 7 18:29:34 2007 UTC (11 years, 11 months ago) by parrello
Branch: MAIN
Changes since 1.24: +21 -20 lines
Fixed group file management to eliminate the old, awful concept of sort-of groups.

#!/usr/bin/perl -w

=head1 New Stuff Checker

This script compares the genomes, features, and annotations in
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 for NewStuffCheck are as follows.

=over 4

=item user

Name suffix to be used for log files. If omitted, the PID is used.

=item trace

Numeric trace level. A higher trace level causes more messages to appear. The
default trace level is 2. Tracing will be directly to the standard output
as well as to a C<trace>I<User>C<.log> file in the FIG temporary directory,
where I<User> is the value of the B<user> option above.

=item sql

If specified, turns on tracing of SQL activity.

=item background

Save the standard and error output to files. The files will be created
in the FIG temporary directory and will be named C<err>I<User>C<.log> and
C<out>I<User>C<.log>, respectively, where I<User> is the value of the
B<user> option above.

=item h

Display this command's parameters and options.

=item phone

Phone number to message when the script is complete.

=item groupFile

Name of the group file (described below). The default is C<groups.tbl>
in the Sprout data directory.

=item outFile

Output file name. The default is C<html/includes/diff.inc> in the
nmpdr C<next> directory.

=item orgFile

Output file for the genome report. The default is C<html/includes/genomes.inc> in
the nmpdr C<next> directory.

=back

=head2 The Group File

A key data file for this process is C<groups.tbl>. 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<campy.php> 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) ],
                                           {
                                              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);
# Set a variable to contain return type information.
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->old_sprout_only();
    # Get its genomes in alphabetical order.
    my @oldGenomes = GetGenomes($oldSprout);
    # Get the new Sprout.
    my $newSprout = SFXlate->new_sprout_only();
    # Get its genomes in alphabetical order.
    my @newGenomes = GetGenomes($newSprout);
    # Compare the two genomes lists.
    my ($insertedGenomes, $deletedGenomes) = Tracer::CompareLists(\@newGenomes, \@oldGenomes);
    # 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 and BBH counts.
        my $count = $newSprout->GetCount(['HasFeature'], "HasFeature(from-link) = ?",
                                         [$genomeID]);
        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)"];
    }
    # 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");
            $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.
    push @html, ShowLists($cgi, 'New Genomes'     => \@insertedGenomeList,
                                'Deleted Genomes' => \@deletedGenomeList);
    # Now the groups.
    Trace("Comparing groups.") if T(2);
    my %oldGroups = $oldSprout->GetGroups();
    my %newGroups = $newSprout->GetGroups();
    # Loop through the new groups.
    for my $newGroup (sort keys %newGroups) {
        Trace("Processing group $newGroup.") if T(3);
        # Find out if this group is new to this version.
        if (! exists $oldGroups{$newGroup}) {
            # Construct a list of this group's genes.
            my @groupGenomes = NameGenomes($newSprout, $newGroups{$newGroup});
            push @html, ShowLists($cgi, "Genomes in new group $newGroup" => \@groupGenomes);
        } else {
            # 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, 1);
            Trace("Comparison complete.") if T(4);
            # 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);
            push @html, ShowLists($cgi, "Genomes new to $newGroup"       => $insertedGroupGenomes,
                                        "Genomes no longer in $newGroup" => $deletedGroupGenomes);
        }
    }
    Trace("Processing deleted groups.") if T(4);
    # Now list the deleted groups.
    for my $oldGroup (sort keys %oldGroups) {
        Trace("Processing deleted group $oldGroup.") if T(3);
        my @groupGenomes = NameGenomes($oldSprout, $oldGroups{$oldGroup});
        push @html, ShowLists($cgi, "Genomes in deleted group $oldGroup" => \@groupGenomes);
    }
    # Next, we get the subsystems.
    Trace("Processing subsystems.") if T(2);
    my @oldSubsystems = GetSubsystems($oldSprout);
    my @newSubsystems = GetSubsystems($newSprout);
    # Compare and display the subsystem lists.
    my ($insertedSubs, $deletedSubs) = Tracer::CompareLists(\@newSubsystems, \@oldSubsystems);
    # Check the deleted subsystems to see if they're in SEED.
    if (scalar @{$deletedSubs} > 0) {
        my %subChecker = map { $_ => 1 } $fig->all_subsystems();
        for my $deletedSub (@{$deletedSubs}) {
            my $subID = $deletedSub->[0];
            if ($subChecker{$subID}) {
                my $trusted = ($fig->usable_subsystem($subID) ? "usable" : "not usable");
                $deletedSub->[1] .= " (still in SEED, $trusted)";
            }
        }
    }
    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("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);
    $rtype = "error";
} else {
    Trace("Script complete.") if T(2);
    $rtype = "no error";
}
if ($options->{phone}) {
    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 {
        Trace("Phone message not sent.") if T(2);
    }
}

=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

    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.

=over 4

=item sprout

Sprout instance whose gene list is desired.

=item RETURN

Returns a list of two-tuples. The first element in each tuple is the genome ID,
and the second is the genome name (genus, species, strain).

=back

=cut

sub GetGenomes {
    # Get the parameters.
    my ($sprout) = @_;
    # Get the desired data.
    my @genomes = $sprout->GetAll(['Genome'], "ORDER BY Genome(id)", [], ['Genome(id)',
                                                                          'Genome(genus)',
                                                                          'Genome(species)',
                                                                          'Genome(unique-characterization)']);
    # Create the genome names from the three pieces of the name.
    my @retVal = map { [$_->[0], join(" ", @{$_}[1..3])] } @genomes;
    # Return the result.
    return @retVal;
}

=head3 NameGenomes

    my @newList = NameGenomes($sprout, \@genomes);

Convert a list of genome IDs to a list of genome IDs with names.

=over 4

=item sprout

The relevant sprout instance.

=item genomes

Reference to a list of genome IDs

=item RETURN

Returns a list of 2-tuples, each tuple consisting of a genome ID followed by a
genome name.

=back

=cut

sub NameGenomes {
    # Get the parameters.
    my ($sprout, $genomes) = @_;
    # Attach the names.
    my @retVal = map { [$sprout->GenusSpecies($_), $_ ] } @{$genomes};
    # Return the result.
    return @retVal;
}

=head3 GetSubsystems

    my @subsystems = GetSubsystems($sprout);

Get a list of the subsystems in the specified Sprout instance.

=over 4

=item sprout

Sprout instance whose subsystems are desired.

=item RETURN

Returns a list of 2-tuples, each consisting of the subsystem name followed by
the name of the curator.

=back

=cut

sub GetSubsystems {
    # Get the parameters.
    my ($sprout) = @_;
    # Declare the return variable.
    my @retVal = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(id)",
                                 [], ['Subsystem(id)', 'Subsystem(curator)']);
    # Return the result.
    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

    my @features = GetFeatures($sprout, $genomeID);

Return the features of the specified genome in the specified Sprout instance.

=over 4

=item sprout

Sprout instance to use to get the features.

=item genomeID

ID of the genome in question.

=item RETURN

Returns a list of 2-tuples, the first element being the feature ID and the second its
functional assignment (if any).

=back

=cut

sub GetFeatures {
    # Get the parameters.
    my ($sprout, $genomeID) = @_;
    # Get a list of the feature IDs and map them to their functional assignments.
    my @retVal = map { [$_, $sprout->FunctionOf($_)] } $sprout->GetFlat(['HasFeature'],
                                                                        "HasFeature(from-link) = ? ORDER BY HasFeature(to-link)",
                                                                        [$genomeID], 'HasFeature(to-link)');
    # Return the result.
    return @retVal;
}

=head3 ShowLists

    my @htmlLines = ShowLists($cgi, %lists);

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 cgi

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 $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.
        my $list = $lists{$listName};
        # Get the number of list items.
        my $listSize = scalar @{$list};
        # Only proceed if the list is nonempty.
        if ($listSize > 0) {
            my $header = ComputeHeader($listName, $listSize);
            Trace($header) if T(3);
            # 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 ComputeHeader

    my $header = ComputeHeader($name, $count);

Return a list header for a list of the specified length.

=over 4

=item name

Name of the list.

=item count

Number of entries in the list.

=item RETURN

Returns a list header that shows the name of the list and the number of entries.

=back

=cut

sub ComputeHeader {
    # Get the parameters.
    my ($name, $count) = @_;
    # Declare the return variable.
    my $retVal;
    if ($count == 0) {
        $retVal = "$name: none";
    } elsif ($count == 1) {
        $retVal = "$name: one";
    } else {
        $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;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3