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

View of /Sprout/NewStuffCheck.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.23 - (download) (as text) (annotate)
Mon Jul 16 20:05:23 2007 UTC (12 years, 4 months ago) by parrello
Branch: MAIN
Changes since 1.22: +198 -47 lines
Changed to include the figures needed for the semi-annual report.

#!/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);
    # We'll put each group's data into a hash, keyed by group
    # name, each entry being a 3-tuple of page name, genus,
    # and species
    my %groups = Sprout::ReadGroupFile($groupFileName);
    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);
    # Add feature counts to the new genomes.
    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");
        $insertedGenome->[1] .= "($suffix)";
    }
    # Add information about SEED status to the deleted genomes.
    for my $deletedGenome (@{$deletedGenomes}) {
        my $genomeID = $deletedGenome->[0];
        if ($fig->is_genome($genomeID)) {
            my $complete = ($fig->is_complete($genomeID) ? "complete" : "incomplete");
            $deletedGenome->[1] .= "(still in SEED, $complete)";
        }
    }
    # Display the lists.
    push @html, ShowLists($cgi, 'New Genomes'     => $insertedGenomes,
                                'Deleted Genomes' => $deletedGenomes);
    # 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
            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;
    # 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.
    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 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 gene 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 = ();
        # 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}) {
                $bbhCount += scalar keys %{$matrix{$fid}};
            }
            # 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});
        }
        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;
    # Flush the genome feature comparison data.
    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 = Sprout::Fix(%newGroups);
    for my $group (sort keys %groups) {
        Trace("Checking group $group.");
        # Get this group's genus and species.
        my $genus = $groups{$group}->[1];
        my $species = $groups{$group}->[2];
        # Get a hash of the genomes already in it.
        my %inGroup = map { $_ => 1 } @{$fixedGroups{$group}};
        # Get a list of its possible genomes.
        my $filter = 'Genome(genus) = ?';
        my @parms = ($genus);
        # The species list is tricky because a given group may involve more than
        # one target species. The species names will be comma-separated, and
        # we use some PERL trickiness to generate an OR filter for them.
        if ($species) {
            # Get the individual species.
            my @speciesList = split /\s*,\s*/, $species;
            # Create one species filter per species.
            my @filterClauses = map { 'Genome(species) = ?' } @speciesList;
            # OR the filter clauses together to get a real filter.
            $filter .= " AND (" . (join " OR ", @filterClauses) . ")";
            # Add the specieis names to the SQL parameter list.
            push @parms, @speciesList;
        }
        my @possibles = $newSprout->GetFlat(['Genome'], $filter, \@parms, 'Genome(id)');
        # 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

C<< 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.

=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); >>

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

C<< 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

C<< 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

C<< 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); >>

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

C<< 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

C<< 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

C<< 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

C<< 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

C<< 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