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

Annotation of /Sprout/CompileTemplate.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     =head1 PERL Template Compiler
4 :    
5 :     This script compiles the Komodo templates into web pages. Each web page
6 :     displays the template and the relevant prompts. Filling in the prompts
7 :     and clicking the SUBMIT button brings up a text page containing the
8 :     code to copy into your code editor.
9 :    
10 :     When formatting the template for display, comments are displayed using
11 :     the C<codeComment> style and template variables using the C<codeVar>
12 :     style. The entire text will be in a C<pre> element with the
13 :     C<codeNormal> style.
14 :    
15 : parrello 1.3 The templates use the notation C<[[%ask>I<n>C<:>I<prompt>C<]]> for most
16 : parrello 1.1 variables. In more complex templates, there are also flag prompts
17 :     and if-constructs. This notation is designed to be compatible with
18 :     the Komodo template/snippet facility.
19 :    
20 :     Each template produces two output files: the web page itself and a
21 :     copy of the template that the composition script can to form the
22 :     output code. The web page has the extension C<.html> and the
23 :     template copy has the extension C<.txt>.
24 :    
25 :     There are two positional parameters: the name of the directory containing
26 :     the template files (usually somewhere in the source code tree) and the
27 :     name of the output directory into which the template files should be stored.
28 :     The template files will be placed in a subdirectory called C<Helpers> under
29 :     the output directory. This makes them easier to find.
30 :    
31 :     The currently-supported command-line options are as follows.
32 :    
33 :     =over 4
34 :    
35 :     =item user
36 :    
37 :     Name suffix to be used for log files. If omitted, the PID is used.
38 :    
39 :     =item trace
40 :    
41 :     Numeric trace level. A higher trace level causes more messages to appear. The
42 :     default trace level is 2. Tracing will be directly to the standard output
43 :     as well as to a C<trace>I<User>C<.log> file in the FIG temporary directory,
44 :     where I<User> is the value of the B<user> option above.
45 :    
46 :     =item background
47 :    
48 :     Save the standard and error output to files. The files will be created
49 :     in the FIG temporary directory and will be named C<err>I<User>C<.log> and
50 :     C<out>I<User>C<.log>, respectively, where I<User> is the value of the
51 :     B<user> option above.
52 :    
53 :     =item h
54 :    
55 :     Display this command's parameters and options.
56 :    
57 :     =item phone
58 :    
59 :     Phone number to message when the script is complete.
60 :    
61 :     =item style
62 :    
63 : parrello 1.2 URL for the style file. The default is C<../Georgia.css>.
64 : parrello 1.1
65 : parrello 1.4 =item
66 : parrello 1.1
67 :     =back
68 :    
69 :     =cut
70 :    
71 :     use strict;
72 :     use Tracer;
73 :     use DocUtils;
74 :     use TestUtils;
75 :     use Cwd;
76 :     use File::Copy;
77 :     use File::Path;
78 :     use FIG;
79 :     use CGI;
80 :    
81 :     # Get the command-line options and parameters.
82 :     my ($options, @parameters) = StandardSetup([qw() ],
83 :     {
84 :     trace => ["2", "trace level"],
85 : parrello 1.2 style => ["../Georgia.css", "style file URL for the generated pages"],
86 : parrello 1.1 phone => ["", "phone number (international format) to call when load finishes"],
87 :     },
88 :     "<sourceDirectory> <outputDirectory>",
89 :     @ARGV);
90 :     # Set a variable to contain return type information.
91 :     my $rtype;
92 :     # Insure we catch errors.
93 :     eval {
94 :     # Check the input and output directories.
95 :     my ($inputDir, $outputDir) = @parameters;
96 :     if (! $inputDir) {
97 :     Confess("No input directory specified.");
98 :     } elsif (! -d $inputDir) {
99 :     Confess("Input directory not found.");
100 :     } elsif (! $outputDir) {
101 :     Confess("No output directory specified.");
102 :     } elsif (! -d $outputDir) {
103 :     Confess("Output directory not found.");
104 :     } else {
105 :     # Create a subdirectory for the helpers in the output directory.
106 :     if (! -d "$outputDir/Helpers") {
107 :     Trace("Creating helpers subdirectory in $outputDir.") if T(2);
108 :     mkdir "$outputDir/Helpers";
109 :     }
110 :     # Get the files from the input directory. (The "1" means hidden (.) files are omitted.
111 :     Trace("Reading input directory $inputDir.") if T(2);
112 :     my @files = OpenDir($inputDir, 1);
113 :     Trace(scalar(@files) . " files found.") if T(2);
114 :     # Loop through the files.
115 :     for my $file (@files) {
116 :     # Compute the input and output file names.
117 :     my $inputName = "$inputDir/$file";
118 :     # Only proceed if this is a real file.
119 :     if (-f $inputName) {
120 :     $file =~ s/\./-/g;
121 :     my $outputName = "$outputDir/Helpers/$file.html";
122 :     Trace("$inputName will be compiled into $outputName.") if T(3);
123 :     # Copy the template to the VAR directory.
124 :     my $copyName = "$FIG_Config::var/$file.txt";
125 :     copy($inputName, $copyName);
126 :     # Open the input and output files.
127 :     my $ih = Open(undef, "<$inputName");
128 :     my $oh = Open(undef, ">$outputName");
129 :     # Compile the input file into a web page.
130 :     CompileTemplate($ih, $oh, $copyName, $file, $options->{style});
131 :     # Close the files.
132 :     close $oh;
133 :     close $ih;
134 :     Trace("Compilation complete.") if T(3);
135 :     }
136 :     }
137 :     }
138 :     };
139 :     if ($@) {
140 :     Trace("Script failed with error: $@") if T(0);
141 :     $rtype = "error";
142 :     } else {
143 :     Trace("Script complete.") if T(2);
144 :     $rtype = "no error";
145 :     }
146 :     if ($options->{phone}) {
147 :     my $msgID = Tracer::SendSMS($options->{phone}, "PERL Template Compiler terminated with $rtype.");
148 :     if ($msgID) {
149 :     Trace("Phone message sent with ID $msgID.") if T(2);
150 :     } else {
151 :     Trace("Phone message not sent.") if T(2);
152 :     }
153 :     }
154 :    
155 :     =head3 CompileTemplate
156 :    
157 : parrello 1.4 CompileTemplate($ih, $oh, $copyName, $templateName, $style);
158 : parrello 1.1
159 :     Compile a template from an input stream into a web page that can be used to generate code from
160 :     the template. The web page will contain a display of the template file plus a form allowing the
161 :     user to enter the values of various template variables. The template content is read from a
162 :     file whose name is stored as a hidden variable in the form.
163 :    
164 :     =over 4
165 :    
166 :     =item ih
167 :    
168 :     Open handle for the input file (template).
169 :    
170 :     =item oh
171 :    
172 :     Open handle for the output file (interactive web page).
173 :    
174 :     =item copyName
175 :    
176 :     Fully-qualified name of the server file that contains the template text.
177 :    
178 :     =item templateName
179 :    
180 :     Name of the template (for display purposes).
181 :    
182 :     =item style
183 :    
184 :     Style URL to use for the output web page.
185 :    
186 :     =back
187 :    
188 :     =cut
189 :    
190 :     sub CompileTemplate {
191 :     # Get the parameters.
192 :     my ($ih, $oh, $copyName, $templateName, $style) = @_;
193 :     # We'll accumulate the web page lines in here and unspool them at the end.
194 :     my @retVal = ();
195 :     # Get a CGI object for building the web page.
196 :     my $cgi = CGI->new();
197 :     # Start with the page header.
198 :     push @retVal, $cgi->start_html(-title => "FIG Code Template $templateName",
199 :     -style => { src => $style });
200 :     # Create a heading for the template display.
201 :     push @retVal, $cgi->h2("Template Text");
202 :     # We will present the template as preformatted text with SPAN tags mixed in.
203 :     # We do some syntax coloring to distinguish comments, and this requires that
204 :     # we keept track of whether or not we're in POD mode.
205 :     my $inPod = 0;
206 :     # We also need to track the various variables we encounter, because these
207 :     # determine the prompts in the form.
208 :     my %prompts = ();
209 :     # Get some useful strings for adding span codes.
210 :     my $spanVar = $cgi->start_span({ class => "codeVar" });
211 :     my $spanComment = $cgi->start_span({ class => "codeComment" });
212 :     my $spanEnd = $cgi->end_span();
213 :     # Start the table to enclose the text.
214 :     push @retVal, $cgi->start_table({border => 2});
215 :     push @retVal, "<tr><td><pre class=\"codeNormal\">";
216 :     # Now loop through the input file.
217 :     while (! eof $ih) {
218 :     # Get the current line.
219 :     my $line = <$ih>;
220 :     # Chop off the new-line mark.
221 :     chomp $line;
222 :     # Parse for prompts.
223 :     while ($line =~ /\[\[\%([a-z]+\d+):([^\]]+)\]\]/g) {
224 :     $prompts{$1} = $2;
225 :     }
226 :     # Html-escape the text.
227 :     $line = CGI::escapeHTML($line);
228 :     # Span the various meta-constructs.
229 :     $line =~ s/(\[\[\%[^]]+\]\])/$spanVar$1$spanEnd/g;
230 :     # Check for a pod mode change.
231 :     if ($inPod && $line =~ /^=cut/) {
232 :     # End of pod mode, so we turn off the comment style.
233 :     $line .= $spanEnd;
234 :     $inPod = 0;
235 :     } elsif (! $inPod && $line =~ /^=/) {
236 :     # Start pod mode, so we turn on the comment style.
237 :     $line = "$spanComment$line";
238 :     $inPod = 1;
239 :     }
240 :     # If we're not in POD mode, check for comment lines. Sadly, we aren't yet
241 :     # smart enough to find inline comments. We're trying to be simple here.
242 :     if (! $inPod) {
243 :     $line =~ s/(#.*$)/$spanComment$1$spanEnd/;
244 :     }
245 :     # Output the modified line.
246 :     push @retVal, $line;
247 :     }
248 :     # Stop the table.
249 : parrello 1.3 push @retVal, "</pre></td></tr>";
250 : parrello 1.1 push @retVal, $cgi->end_table();
251 :     # Now comes the form. The form data is processed by the ProcessTemplate CGI script.
252 :     push @retVal, $cgi->h2("Code Generation Form");
253 :     push @retVal, $cgi->start_form(-name => 'CodeGen',
254 :     -action => "$FIG_Config::cgi_url/ProcessTemplate.cgi");
255 :     # Put in the hidden field containing the template file name.
256 :     push @retVal, $cgi->hidden(-name => 'templateFile', -value => $copyName);
257 :     # We'll use the prompt hash to generate the input fields. We'll process them by key name, so that
258 :     # they sort in a natural order.
259 : parrello 1.4 my @promptKeys = sort keys %prompts;
260 : parrello 1.1 # Start a table. This helps format the prompts.
261 :     push @retVal, $cgi->start_table({ border => 2 });
262 :     # We'll put all the flags in here. They are added at the end of the table.
263 :     my @flagLines = ();
264 : parrello 1.3 # This will be a list of the flag names. We put this list into a hidden field so we
265 :     # know which flag IDs are valid.
266 :     my @flagNames = ();
267 : parrello 1.1 # Loop through the prompts.
268 :     for my $promptKey (@promptKeys) {
269 :     # Extract the prompt text.
270 :     my $promptText = $prompts{$promptKey};
271 :     if ($promptKey =~ /flag/) {
272 :     # Here we have a checkbox. It goes in the cell for flags.
273 :     push @flagLines, $cgi->checkbox(-name => $promptKey, -value => 1, -label => $promptText);
274 : parrello 1.3 # Save its name.
275 :     push @flagNames, $promptKey;
276 : parrello 1.1 } else {
277 :     # Here we have an input box. It goes in a table row.
278 :     push @retVal, $cgi->Tr($cgi->td([$promptText, $cgi->textfield(-name => $promptKey, -size => 40)]));
279 :     }
280 :     }
281 :     # Put in the flag row (if any)
282 :     if (@flagLines) {
283 :     push @retVal, $cgi->Tr($cgi->td(["Flags", join($cgi->br, @flagLines)]));
284 :     }
285 : parrello 1.3 # Put in the file title row.
286 :     push @retVal, $cgi->Tr($cgi->td(["File Title", $cgi->textfield(-name => "fileTitle", -size => 40)]));
287 : parrello 1.4 # Finally, add the description.
288 :     push @retVal, $cgi->Tr($cgi->td(["Description", $cgi->textarea(-name => 'desc', -rows => 10,
289 :     -cols => 80, -wrap => 'physical')]));
290 : parrello 1.1 # Now for the submit button.
291 :     push @retVal, $cgi->Tr( $cgi->td({-colspan => 2, -align => "center" },
292 :     $cgi->submit(-name => 'submit', -value => 'GENERATE')));
293 :     # Close the table.
294 :     push @retVal, $cgi->end_table();
295 : parrello 1.3 # Put in a list of the flag names.
296 :     push @retVal, $cgi->hidden(-name => 'flagList', -value => join(",", @flagNames));
297 : parrello 1.1 # Close the form.
298 :     push @retVal, $cgi->end_form();
299 :     # Write the output web page.
300 :     print $oh join("\n", @retVal);
301 :     }
302 :    
303 : parrello 1.4 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3