[Bio] / FigWebServices / ProcessTemplate.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/ProcessTemplate.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     BEGIN {
4 :     # Print the header.
5 :     print "CONTENT-TYPE: text/plain\n\n";
6 :     }
7 :    
8 :     =head1 Produce Template
9 :    
10 :     This script applies prompt values to a template. The template is passed in via a
11 :     file name, and the template contains special tokens delimited by double brackets
12 :     with a percent sign (e.g. C<[[%ask1:Method Name]]>). The data from the CGI
13 :     parameters is used to process the tokens, and the result is returned as a
14 :     plain text web page.
15 :    
16 :     This script supports the following CGI query parameters.
17 :    
18 :     =over 4
19 :    
20 :     =item askX
21 :    
22 :     The value of the C<ask> prompt with ID I<X>.
23 :    
24 :     =item flagX
25 :    
26 :     The value of the C<flag> checkbox with ID I<X>
27 :    
28 :     =item templateFile
29 :    
30 :     The name of the template file on the server.
31 :    
32 :     =back
33 :    
34 :     =cut
35 :    
36 :     use strict;
37 :     use Tracer;
38 :     use CGI;
39 :    
40 :     my ($cgi, $varHash) = ScriptSetup();
41 :     eval {
42 :     # Extract the ask and flag parameters.
43 :     my @names = $cgi->param;
44 :     my %parms = map { $_ => $cgi->param($_) } grep { $_ =~ /^(ask|flag)/ } @names;
45 :     # We'll accumulate the page text in here.
46 :     my $retVal = "";
47 :     # Set up the IF stack. The top entry on the stack tells us whether or not
48 :     # we're generating or skipping. We start with generating.
49 :     my @ifStack = (1);
50 :     # Denote we haven't stopped.
51 :     my $going = 1;
52 :     # Slurp in the template.
53 :     my $fileName = $cgi->param('templateFile');
54 :     my @lines = Tracer::GetFile($fileName);
55 :     # Loop through the template lines, generating code.
56 :     for my $line (@lines) {
57 :     # Only proceed if we're not stopped.
58 :     if ($going) {
59 :     # We need to run through all the markers in the current line and act
60 :     # accordingly. We do this with a match loop. The variable "$pos" will
61 :     # point to the unparsed part of the line.
62 :     my $pos = 0;
63 :     # The horrific search expression below will match any marker. A marker
64 :     # is surrounded by doubled square brackets. Inside the brackets there is
65 :     # a percent sign, a label (with optional number), and an optional
66 :     # argument. If an argument is present, it is preceded by a colon.
67 :     # Each time through the loop, the pos($line) function will point
68 :     # after the end of the token, the entire token will be in $1, the label
69 :     # will be in $2, and the argument will be in $4.
70 :     while ($line =~ /(\[\[%(\w+\d*)(:([^\]]+))?\]\])/g) {
71 :     # Get the data we need from the pattern match.
72 :     my $tokenLen = length $1;
73 :     my $label = $2;
74 :     my $argument = $4;
75 :     my $endPos = pos $line;
76 :     # If we are generating, start with the residual (that is, the text prior to
77 :     # the current token).
78 :     if ($ifStack[$#ifStack]) {
79 :     $retVal .= substr($line, $pos, $endPos - $tokenLen - $pos);
80 :     }
81 :     # Now check the token type.
82 :     if ($label eq 'if') {
83 :     # IF: evaluate the argument and push its truth or falsehood onto the
84 :     # if-stack. No code is generated.
85 :     if (! exists $parms{$argument}) {
86 :     Confess("Token definition for $argument not found.");
87 :     } else {
88 :     push @ifStack, ($parms{$label} ? 1 : 0);
89 :     }
90 :     } elsif ($label eq 'fi') {
91 :     # FI: pop the IF-stack. No code is generated.
92 :     if (@ifStack == 1) {
93 :     Confess("FI without matching IF.");
94 :     } else {
95 :     pop @ifStack;
96 :     }
97 :     } elsif ($label eq 'stop') {
98 :     # STOP: Denote we're no longer going. The rest of the line
99 :     # will parse, but subsequent lines will be ignored.
100 :     $going = 0;
101 :     } elsif ($label =~ /ask/) {
102 :     # ASK: substitute the labelled parameter value. (But
103 :     # only if we're generating.
104 :     if (! exists $parms{$label}) {
105 :     Confess("Label $label not found.");
106 :     } elsif ($ifStack[$#ifStack]) {
107 :     $retVal .= $parms{$label};
108 :     }
109 :     } elsif ($label =~ /flag/) {
110 :     # FLAG: all flags are ignored.
111 :     } else {
112 :     Confess("Invalid token label $label.");
113 :     }
114 :     # Save the current position for the next iteration of the search pattern
115 :     # loop,
116 :     $pos = $endPos;
117 :     }
118 :     # We've reached the end of the line. If we're generating, add on the
119 :     # residual and the new-line code.
120 :     if ($ifStack[$#ifStack]) {
121 :     $retVal .= substr($line, $pos) . "\n";
122 :     }
123 :     }
124 :     }
125 :     # Write the generated text to the output.
126 :     print $retVal;
127 :     };
128 :     if ($@) {
129 :     my $errorMessage = $@;
130 :     Trace("Script Error: $errorMessage") if T(0);
131 :     print "Script Error: $errorMessage";
132 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3