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

Annotation of /Sprout/MarkupTest.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3