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

Annotation of /Sprout/CompileTemplate.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (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 Cwd;
74 :     use File::Copy;
75 :     use File::Path;
76 :     use FIG;
77 :     use CGI;
78 :    
79 :     # Get the command-line options and parameters.
80 :     my ($options, @parameters) = StandardSetup([qw() ],
81 :     {
82 :     trace => ["2", "trace level"],
83 : parrello 1.2 style => ["../Georgia.css", "style file URL for the generated pages"],
84 : parrello 1.1 phone => ["", "phone number (international format) to call when load finishes"],
85 :     },
86 :     "<sourceDirectory> <outputDirectory>",
87 :     @ARGV);
88 :     # Set a variable to contain return type information.
89 :     my $rtype;
90 :     # Insure we catch errors.
91 :     eval {
92 :     # Check the input and output directories.
93 :     my ($inputDir, $outputDir) = @parameters;
94 :     if (! $inputDir) {
95 :     Confess("No input directory specified.");
96 :     } elsif (! -d $inputDir) {
97 :     Confess("Input directory not found.");
98 :     } elsif (! $outputDir) {
99 :     Confess("No output directory specified.");
100 :     } elsif (! -d $outputDir) {
101 :     Confess("Output directory not found.");
102 :     } else {
103 :     # Create a subdirectory for the helpers in the output directory.
104 :     if (! -d "$outputDir/Helpers") {
105 :     Trace("Creating helpers subdirectory in $outputDir.") if T(2);
106 :     mkdir "$outputDir/Helpers";
107 :     }
108 :     # Get the files from the input directory. (The "1" means hidden (.) files are omitted.
109 :     Trace("Reading input directory $inputDir.") if T(2);
110 :     my @files = OpenDir($inputDir, 1);
111 :     Trace(scalar(@files) . " files found.") if T(2);
112 :     # Loop through the files.
113 :     for my $file (@files) {
114 :     # Compute the input and output file names.
115 :     my $inputName = "$inputDir/$file";
116 :     # Only proceed if this is a real file.
117 :     if (-f $inputName) {
118 :     $file =~ s/\./-/g;
119 :     my $outputName = "$outputDir/Helpers/$file.html";
120 :     Trace("$inputName will be compiled into $outputName.") if T(3);
121 :     # Copy the template to the VAR directory.
122 :     my $copyName = "$FIG_Config::var/$file.txt";
123 :     copy($inputName, $copyName);
124 :     # Open the input and output files.
125 :     my $ih = Open(undef, "<$inputName");
126 :     my $oh = Open(undef, ">$outputName");
127 :     # Compile the input file into a web page.
128 :     CompileTemplate($ih, $oh, $copyName, $file, $options->{style});
129 :     # Close the files.
130 :     close $oh;
131 :     close $ih;
132 :     Trace("Compilation complete.") if T(3);
133 :     }
134 :     }
135 :     }
136 :     };
137 :     if ($@) {
138 :     Trace("Script failed with error: $@") if T(0);
139 :     $rtype = "error";
140 :     } else {
141 :     Trace("Script complete.") if T(2);
142 :     $rtype = "no error";
143 :     }
144 :     if ($options->{phone}) {
145 :     my $msgID = Tracer::SendSMS($options->{phone}, "PERL Template Compiler terminated with $rtype.");
146 :     if ($msgID) {
147 :     Trace("Phone message sent with ID $msgID.") if T(2);
148 :     } else {
149 :     Trace("Phone message not sent.") if T(2);
150 :     }
151 :     }
152 :    
153 :     =head3 CompileTemplate
154 :    
155 : parrello 1.4 CompileTemplate($ih, $oh, $copyName, $templateName, $style);
156 : parrello 1.1
157 :     Compile a template from an input stream into a web page that can be used to generate code from
158 :     the template. The web page will contain a display of the template file plus a form allowing the
159 :     user to enter the values of various template variables. The template content is read from a
160 :     file whose name is stored as a hidden variable in the form.
161 :    
162 :     =over 4
163 :    
164 :     =item ih
165 :    
166 :     Open handle for the input file (template).
167 :    
168 :     =item oh
169 :    
170 :     Open handle for the output file (interactive web page).
171 :    
172 :     =item copyName
173 :    
174 :     Fully-qualified name of the server file that contains the template text.
175 :    
176 :     =item templateName
177 :    
178 :     Name of the template (for display purposes).
179 :    
180 :     =item style
181 :    
182 :     Style URL to use for the output web page.
183 :    
184 :     =back
185 :    
186 :     =cut
187 :    
188 :     sub CompileTemplate {
189 :     # Get the parameters.
190 :     my ($ih, $oh, $copyName, $templateName, $style) = @_;
191 :     # We'll accumulate the web page lines in here and unspool them at the end.
192 :     my @retVal = ();
193 :     # Get a CGI object for building the web page.
194 :     my $cgi = CGI->new();
195 :     # Start with the page header.
196 :     push @retVal, $cgi->start_html(-title => "FIG Code Template $templateName",
197 :     -style => { src => $style });
198 :     # Create a heading for the template display.
199 :     push @retVal, $cgi->h2("Template Text");
200 :     # We will present the template as preformatted text with SPAN tags mixed in.
201 :     # We do some syntax coloring to distinguish comments, and this requires that
202 :     # we keept track of whether or not we're in POD mode.
203 :     my $inPod = 0;
204 :     # We also need to track the various variables we encounter, because these
205 :     # determine the prompts in the form.
206 :     my %prompts = ();
207 :     # Get some useful strings for adding span codes.
208 :     my $spanVar = $cgi->start_span({ class => "codeVar" });
209 :     my $spanComment = $cgi->start_span({ class => "codeComment" });
210 :     my $spanEnd = $cgi->end_span();
211 :     # Start the table to enclose the text.
212 :     push @retVal, $cgi->start_table({border => 2});
213 :     push @retVal, "<tr><td><pre class=\"codeNormal\">";
214 :     # Now loop through the input file.
215 :     while (! eof $ih) {
216 :     # Get the current line.
217 :     my $line = <$ih>;
218 :     # Chop off the new-line mark.
219 :     chomp $line;
220 :     # Parse for prompts.
221 :     while ($line =~ /\[\[\%([a-z]+\d+):([^\]]+)\]\]/g) {
222 :     $prompts{$1} = $2;
223 :     }
224 :     # Html-escape the text.
225 :     $line = CGI::escapeHTML($line);
226 :     # Span the various meta-constructs.
227 :     $line =~ s/(\[\[\%[^]]+\]\])/$spanVar$1$spanEnd/g;
228 :     # Check for a pod mode change.
229 :     if ($inPod && $line =~ /^=cut/) {
230 :     # End of pod mode, so we turn off the comment style.
231 :     $line .= $spanEnd;
232 :     $inPod = 0;
233 :     } elsif (! $inPod && $line =~ /^=/) {
234 :     # Start pod mode, so we turn on the comment style.
235 :     $line = "$spanComment$line";
236 :     $inPod = 1;
237 :     }
238 :     # If we're not in POD mode, check for comment lines. Sadly, we aren't yet
239 :     # smart enough to find inline comments. We're trying to be simple here.
240 :     if (! $inPod) {
241 :     $line =~ s/(#.*$)/$spanComment$1$spanEnd/;
242 :     }
243 :     # Output the modified line.
244 :     push @retVal, $line;
245 :     }
246 :     # Stop the table.
247 : parrello 1.3 push @retVal, "</pre></td></tr>";
248 : parrello 1.1 push @retVal, $cgi->end_table();
249 :     # Now comes the form. The form data is processed by the ProcessTemplate CGI script.
250 :     push @retVal, $cgi->h2("Code Generation Form");
251 :     push @retVal, $cgi->start_form(-name => 'CodeGen',
252 :     -action => "$FIG_Config::cgi_url/ProcessTemplate.cgi");
253 :     # Put in the hidden field containing the template file name.
254 :     push @retVal, $cgi->hidden(-name => 'templateFile', -value => $copyName);
255 :     # We'll use the prompt hash to generate the input fields. We'll process them by key name, so that
256 :     # they sort in a natural order.
257 : parrello 1.4 my @promptKeys = sort keys %prompts;
258 : parrello 1.1 # Start a table. This helps format the prompts.
259 :     push @retVal, $cgi->start_table({ border => 2 });
260 :     # We'll put all the flags in here. They are added at the end of the table.
261 :     my @flagLines = ();
262 : parrello 1.3 # This will be a list of the flag names. We put this list into a hidden field so we
263 :     # know which flag IDs are valid.
264 :     my @flagNames = ();
265 : parrello 1.1 # Loop through the prompts.
266 :     for my $promptKey (@promptKeys) {
267 :     # Extract the prompt text.
268 :     my $promptText = $prompts{$promptKey};
269 :     if ($promptKey =~ /flag/) {
270 :     # Here we have a checkbox. It goes in the cell for flags.
271 :     push @flagLines, $cgi->checkbox(-name => $promptKey, -value => 1, -label => $promptText);
272 : parrello 1.3 # Save its name.
273 :     push @flagNames, $promptKey;
274 : parrello 1.1 } else {
275 :     # Here we have an input box. It goes in a table row.
276 :     push @retVal, $cgi->Tr($cgi->td([$promptText, $cgi->textfield(-name => $promptKey, -size => 40)]));
277 :     }
278 :     }
279 :     # Put in the flag row (if any)
280 :     if (@flagLines) {
281 :     push @retVal, $cgi->Tr($cgi->td(["Flags", join($cgi->br, @flagLines)]));
282 :     }
283 : parrello 1.3 # Put in the file title row.
284 :     push @retVal, $cgi->Tr($cgi->td(["File Title", $cgi->textfield(-name => "fileTitle", -size => 40)]));
285 : parrello 1.4 # Finally, add the description.
286 :     push @retVal, $cgi->Tr($cgi->td(["Description", $cgi->textarea(-name => 'desc', -rows => 10,
287 :     -cols => 80, -wrap => 'physical')]));
288 : parrello 1.1 # Now for the submit button.
289 :     push @retVal, $cgi->Tr( $cgi->td({-colspan => 2, -align => "center" },
290 :     $cgi->submit(-name => 'submit', -value => 'GENERATE')));
291 :     # Close the table.
292 :     push @retVal, $cgi->end_table();
293 : parrello 1.3 # Put in a list of the flag names.
294 :     push @retVal, $cgi->hidden(-name => 'flagList', -value => join(",", @flagNames));
295 : parrello 1.1 # Close the form.
296 :     push @retVal, $cgi->end_form();
297 :     # Write the output web page.
298 :     print $oh join("\n", @retVal);
299 :     }
300 :    
301 : parrello 1.4 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3