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

View of /Sprout/MarkupTest.pl

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.3 - (download) (as text) (annotate)
Tue Feb 5 05:47:32 2008 UTC (12 years, 3 months ago) by parrello
Branch: MAIN
CVS Tags: mgrast_dev_08112011, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, rast_rel_2008_06_16, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, rast_rel_2009_05_18, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.2: +0 -2 lines
Removed obsolete use clauses.

#!/usr/bin/perl -w

=head1 Protein Markup Test

This script creates a markup file for a feature and then verifies that it works.

It takes a single positional parameter-- the ID of the feature to use for testing.
The currently-supported command-line options are as follows.

=over 4

=item trace

Numeric trace level. A higher trace level causes more messages to appear. The
default trace level is 2.

=item sql

If specified, turns on tracing of SQL activity.

=item h

Display this commands parameters and options.



use strict;
use Tracer;
use Cwd;
use FIG;
use Markups;
use File::Copy;
use File::Path;

# Get the command-line options.
my ($options, @parameters) = StandardSetup(['Markup'],
                                            trace => [2, 'tracing level'],
Trace("Initializing.") if T(2);
# Get a FIG object.
my $fig = FIG->new();
# Check for the specified feature.
my $fid = $parameters[0];
#### DEBUG HACK: Stupid debugger doesn't like "|" in command-line arguments.
if ($fid =~ /^fig\./) {
    substr $fid, 3, 1, "|";
#### END DEBUG HACK ####
if ($fig->is_deleted_fid($fid)) {
    Confess("Invalid feature ID \"$fid\" specified.");
# Create the markup object.
my $marks = Markups->new($fid, $fig);
# Check for existing marks.
my @markList = $marks->List();
if (@markList > 0) {
    Confess("Feature $fid already has marks.");
# Get the translation length and verify it's long enough.
my $translationLength = $fig->translation_length($fid);
if ($translationLength < 400) {
    Confess("Translation for \"$fid\" is too short.");
# Now we need to create a labels file. We need to preserve the existing labels
# before we do this. Note that $labelSave will be used to hold the fake labels
# file so that we can display the rendered HTML.
my $labelFile = "$FIG_Config::fig/CGI/Html/css/labels.css";
my $labelSave = "labels$$.sav.css";
my $labelTemp;
if (-e $labelFile) {
    $labelTemp = "$FIG_Config::fig/CGI/Html/css/$labelFile$$.tmp.css";
    rename $labelFile, $labelTemp;
    Trace("Old label file renamed to $labelTemp.") if T(2);
Open(\*LABELSOUT, ">$labelFile");
print LABELSOUT " .lowerGamma { background-color: yellow }\n";
print LABELSOUT " .supraCore { color: red }\n";
print LABELSOUT " .upperGamma { background-color: turquoise }\n";
Trace("Test label file created.") if T(2);
# Check the label list.
my @labels = sort { $a cmp $b } Markups::GetLabels();
my $labelCount = @labels;
if ($labelCount != 3) {
    Trace("Incorrect number of labels returned: $labelCount found, 3 expected.") if T(0);
} else {
    if ($labels[0] ne "lowerGamma") {
        Trace("Invalid value for label 0: $labels[0] found, lowerGamma expected.") if T(0);
    if ($labels[1] ne "supraCore") {
        Trace("Invalid value for label 1: $labels[1] found, supraCore.") if T(0);
    if ($labels[2] ne "upperGamma") {
        Trace("Invalid value for label 2: $labels[2] found, upperGamma expected.") if T(0);
Trace("Label file verified.") if T(2);
# Add marks to this feature.
$marks->Insert(160, 20, "supraCore");
$marks->Insert(80, 40, "lowerGamma");
$marks->Insert(220, 40, "lowerGamma");
$marks->Insert(80, 20, "supraCore");
$marks->Insert(150, 50, "upperGamma");
$marks->Insert(240, 20, "supraCore");
Trace("Marks created.") if T(2);
# Verify the marks.
@markList = $marks->List();
CheckMark($markList[0],  80, 40, "lowerGamma");
CheckMark($markList[1],  80, 20, "supraCore");
CheckMark($markList[2], 150, 50, "upperGamma");
CheckMark($markList[3], 160, 20, "supraCore");
CheckMark($markList[4], 220, 40, "lowerGamma");
CheckMark($markList[5], 240, 20, "supraCore");
Trace("Inserts verified.") if T(2);
# Render the markups and dump them to a temp file
my $htmlString = $marks->Render("Markup_$fid", 100);
Open(\*HTMLOUT, ">$FIG_Config::temp/MarkupTest.html");
print HTMLOUT "<html><head>\n";
print HTMLOUT "<link href=\"${FIG_Config::cgi_url}Html/css/$labelSave\" rel=\"stylesheet\" type=\"text/css\">\n";
print HTMLOUT "</head><body>\n";
print HTMLOUT "$htmlString\n";
print HTMLOUT "</body></html>\n";
close HTMLOUT;
# Test deletion.
Trace("Deletion test.") if T(2);
$marks->Delete(220, 40, "lowerGamma");
@markList = $marks->List();
CheckMark($markList[4], 240, 20, "supraCore");
Trace("Checking save and reload.") if T(2);
# Test save.
# Create a new markup object to test the saved values.
my $marks2 = Markups->new($fid, $fig);
@markList = $marks->List();
CheckMark($markList[0],  80, 40, "lowerGamma");
CheckMark($markList[1],  80, 20, "supraCore");
CheckMark($markList[2], 150, 50, "upperGamma");
CheckMark($markList[3], 160, 20, "supraCore");
CheckMark($markList[4], 240, 20, "supraCore");
Trace("Cleaning up.") if T(2);
# Clear the marks to erase our tracks.
# Fix the labels file.
copy($labelFile, "$FIG_Config::fig/CGI/Html/css/$labelSave");
if ($labelTemp) {
    unlink $labelFile;
    rename $labelTemp, $labelFile;
Trace("Tests complete.") if T(2);

# Verify a particular markup.
sub CheckMark {
    my ($mark, $start, $len, $label) = @_;
    if (scalar(@{$mark}) != 3 || $mark->[0] != $start || $mark->[1] != $len ||
        $mark->[2] ne $label) {
        Trace("Markup mismatch: wanted [$start, $len, '$label'].") if T(0);


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3