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

Annotation of /Sprout/MarkupTest.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     =head1 Protein Markup Test
4 :    
5 :     This script creates a markup file for a feature and then verifies that it works.
6 :    
7 :     It takes a single positional parameter-- the ID of the feature to use for testing.
8 :     The currently-supported command-line options are as follows.
9 :    
10 :     =over 4
11 :    
12 :     =item trace
13 :    
14 :     Numeric trace level. A higher trace level causes more messages to appear. The
15 :     default trace level is 2.
16 :    
17 :     =item sql
18 :    
19 :     If specified, turns on tracing of SQL activity.
20 :    
21 :     =item h
22 :    
23 :     Display this commands parameters and options.
24 :    
25 :     =back
26 :    
27 :     =cut
28 :    
29 :     use strict;
30 :     use Tracer;
31 :     use DocUtils;
32 :     use TestUtils;
33 :     use Cwd;
34 :     use FIG;
35 :     use Markups;
36 :     use File::Copy;
37 :     use File::Path;
38 :    
39 :     # Get the command-line options.
40 :     my ($options, @parameters) = StandardSetup(['Markup'],
41 :     {
42 :     },
43 :     '<featureID>',
44 :     @ARGV);
45 :     Trace("Initializing.") if T(2);
46 :     # Get a FIG object.
47 :     my $fig = FIG->new();
48 :     # Check for the specified feature.
49 :     my $fid = $parameters[0];
50 :     #### DEBUG HACK: Stupid debugger doesn't like "|" in command-line arguments.
51 :     if ($fid =~ /^fig\./) {
52 :     substr $fid, 3, 1, "|";
53 :     }
54 :     #### END DEBUG HACK ####
55 :     if ($fig->is_deleted_fid($fid)) {
56 :     Confess("Invalid feature ID \"$fid\" specified.");
57 :     }
58 :     # Create the markup object.
59 :     my $marks = Markups->new($fid, $fig);
60 :     # Check for existing marks.
61 :     my @markList = $marks->List();
62 :     if (@markList > 0) {
63 :     Confess("Feature $fid already has marks.");
64 :     }
65 :     # Get the translation length and verify it's long enough.
66 :     my $translationLength = $fig->translation_length($fid);
67 :     if ($translationLength < 400) {
68 :     Confess("Translation for \"$fid\" is too short.");
69 :     }
70 :     # Now we need to create a labels file. We need to preserve the existing labels
71 :     # before we do this. Note that $labelSave will be used to hold the fake labels
72 :     # file so that we can display the rendered HTML.
73 :     my $labelFile = "$FIG_Config::fig/CGI/Html/css/labels.css";
74 :     my $labelSave = "labels$$.sav.css";
75 :     my $labelTemp;
76 :     if (-e $labelFile) {
77 :     $labelTemp = "$FIG_Config::fig/CGI/Html/css/$labelFile$$.tmp.css";
78 :     rename $labelFile, $labelTemp;
79 :     Trace("Old label file renamed to $labelTemp.") if T(2);
80 :     }
81 :     Open(\*LABELSOUT, ">$labelFile");
82 :     print LABELSOUT " .lowerGamma { background-color: yellow }\n";
83 :     print LABELSOUT " .supraCore { color: red }\n";
84 :     print LABELSOUT " .upperGamma { background-color: turquoise }\n";
85 :     close LABELSOUT;
86 :     Trace("Test label file created.") if T(2);
87 :     # Check the label list.
88 :     my @labels = sort { $a cmp $b } Markups::GetLabels();
89 :     my $labelCount = @labels;
90 :     if ($labelCount != 3) {
91 :     Trace("Incorrect number of labels returned: $labelCount found, 3 expected.") if T(0);
92 :     } else {
93 :     if ($labels[0] ne "lowerGamma") {
94 :     Trace("Invalid value for label 0: $labels[0] found, lowerGamma expected.") if T(0);
95 :     }
96 :     if ($labels[1] ne "supraCore") {
97 :     Trace("Invalid value for label 1: $labels[1] found, supraCore.") if T(0);
98 :     }
99 :     if ($labels[2] ne "upperGamma") {
100 :     Trace("Invalid value for label 2: $labels[2] found, upperGamma expected.") if T(0);
101 :     }
102 :     }
103 :     Trace("Label file verified.") if T(2);
104 :     # Add marks to this feature.
105 :     $marks->Insert(160, 20, "supraCore");
106 :     $marks->Insert(80, 40, "lowerGamma");
107 :     $marks->Insert(220, 40, "lowerGamma");
108 :     $marks->Insert(80, 20, "supraCore");
109 :     $marks->Insert(150, 50, "upperGamma");
110 :     $marks->Insert(240, 20, "supraCore");
111 :     Trace("Marks created.") if T(2);
112 :     # Verify the marks.
113 :     @markList = $marks->List();
114 :     CheckMark($markList[0], 80, 40, "lowerGamma");
115 :     CheckMark($markList[1], 80, 20, "supraCore");
116 :     CheckMark($markList[2], 150, 50, "upperGamma");
117 :     CheckMark($markList[3], 160, 20, "supraCore");
118 :     CheckMark($markList[4], 220, 40, "lowerGamma");
119 :     CheckMark($markList[5], 240, 20, "supraCore");
120 :     Trace("Inserts verified.") if T(2);
121 :     # Render the markups and dump them to a temp file
122 :     my $htmlString = $marks->Render("Markup_$fid", 100);
123 :     Open(\*HTMLOUT, ">$FIG_Config::temp/MarkupTest.html");
124 :     print HTMLOUT "<html><head>\n";
125 :     print HTMLOUT "<link href=\"${FIG_Config::cgi_url}Html/css/$labelSave\" rel=\"stylesheet\" type=\"text/css\">\n";
126 :     print HTMLOUT "</head><body>\n";
127 :     print HTMLOUT "$htmlString\n";
128 :     print HTMLOUT "</body></html>\n";
129 :     close HTMLOUT;
130 :     # Test deletion.
131 :     Trace("Deletion test.") if T(2);
132 :     $marks->Delete(220, 40, "lowerGamma");
133 :     @markList = $marks->List();
134 :     CheckMark($markList[4], 240, 20, "supraCore");
135 :     Trace("Checking save and reload.") if T(2);
136 :     # Test save.
137 :     $marks->Save();
138 :     # Create a new markup object to test the saved values.
139 :     my $marks2 = Markups->new($fid, $fig);
140 :     @markList = $marks->List();
141 :     CheckMark($markList[0], 80, 40, "lowerGamma");
142 :     CheckMark($markList[1], 80, 20, "supraCore");
143 :     CheckMark($markList[2], 150, 50, "upperGamma");
144 :     CheckMark($markList[3], 160, 20, "supraCore");
145 :     CheckMark($markList[4], 240, 20, "supraCore");
146 :     Trace("Cleaning up.") if T(2);
147 :     # Clear the marks to erase our tracks.
148 :     $marks->Clear();
149 :     $marks->Save();
150 :     # Fix the labels file.
151 :     copy($labelFile, "$FIG_Config::fig/CGI/Html/css/$labelSave");
152 :     if ($labelTemp) {
153 :     unlink $labelFile;
154 :     rename $labelTemp, $labelFile;
155 :     }
156 :     Trace("Tests complete.") if T(2);
157 :    
158 :     # Verify a particular markup.
159 :     sub CheckMark {
160 :     my ($mark, $start, $len, $label) = @_;
161 :     if (scalar(@{$mark}) != 3 || $mark->[0] != $start || $mark->[1] != $len ||
162 :     $mark->[2] ne $label) {
163 :     Trace("Markup mismatch: wanted [$start, $len, '$label'].") if T(0);
164 :     }
165 :     }
166 :    
167 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3