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

Annotation of /FigWebServices/ProcessTemplate.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (view) (download)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     =head1 Produce Template
4 :    
5 :     This script applies prompt values to a template. The template is passed in via a
6 :     file name, and the template contains special tokens delimited by double brackets
7 :     with a percent sign (e.g. C<[[%ask1:Method Name]]>). The data from the CGI
8 :     parameters is used to process the tokens, and the result is returned as a
9 : parrello 1.2 downloadable file.
10 : parrello 1.1
11 :     This script supports the following CGI query parameters.
12 :    
13 :     =over 4
14 :    
15 :     =item askX
16 :    
17 :     The value of the C<ask> prompt with ID I<X>.
18 :    
19 :     =item flagX
20 :    
21 :     The value of the C<flag> checkbox with ID I<X>
22 :    
23 :     =item templateFile
24 :    
25 :     The name of the template file on the server.
26 :    
27 : parrello 1.3 =item fileTitle
28 :    
29 :     The title (file name without suffix) to give the file.
30 :    
31 :     =item flagList
32 :    
33 :     A comma-separated list of flag names used in the template.
34 :    
35 : parrello 1.4 =item desc
36 :    
37 :     The module description.
38 :    
39 : parrello 1.1 =back
40 :    
41 :     =cut
42 :    
43 :     use strict;
44 :     use Tracer;
45 :     use CGI;
46 : parrello 1.4 use Text::Wrap;
47 : parrello 1.1
48 : parrello 1.5 my ($cgi, $varHash) = Tracer::ScriptSetup();
49 : parrello 1.1 eval {
50 : parrello 1.2 # Get the template file name.
51 : parrello 1.3 my $fileNamePart = $cgi->param('fileTitle') || 'NewFile';
52 : parrello 1.2 my $fileName = $cgi->param('templateFile');
53 : parrello 1.3 my $fileTitle = ($fileName =~ m#-(\w+)\.# ? "$fileNamePart.$1" : "$fileNamePart.pm");
54 :     Trace("Chosen output file name is $fileTitle.") if T(3);
55 : parrello 1.1 # Extract the ask and flag parameters.
56 :     my @names = $cgi->param;
57 :     my %parms = map { $_ => $cgi->param($_) } grep { $_ =~ /^(ask|flag)/ } @names;
58 : parrello 1.3 # Put in missing flag parameters. This is so we can tell when the template asks for
59 :     # a nonexistent flag.
60 :     my @flags = split /\s*,\s*/, $cgi->param("flagList");
61 :     for my $flag (@flags) {
62 :     if (! exists $parms{$flag}) {
63 :     $parms{$flag} = 0;
64 :     }
65 :     }
66 : parrello 1.1 # We'll accumulate the page text in here.
67 :     my $retVal = "";
68 :     # Set up the IF stack. The top entry on the stack tells us whether or not
69 :     # we're generating or skipping. We start with generating.
70 :     my @ifStack = (1);
71 :     # Denote we haven't stopped.
72 :     my $going = 1;
73 :     # Slurp in the template.
74 :     my @lines = Tracer::GetFile($fileName);
75 :     # Loop through the template lines, generating code.
76 :     for my $line (@lines) {
77 :     # Only proceed if we're not stopped.
78 :     if ($going) {
79 :     # We need to run through all the markers in the current line and act
80 :     # accordingly. We do this with a match loop. The variable "$pos" will
81 :     # point to the unparsed part of the line.
82 :     my $pos = 0;
83 : parrello 1.3 # This variable is set to 1 if we want to discard the line, which is
84 :     # sometimes the case.
85 :     my $discard = 0;
86 : parrello 1.1 # The horrific search expression below will match any marker. A marker
87 :     # is surrounded by doubled square brackets. Inside the brackets there is
88 :     # a percent sign, a label (with optional number), and an optional
89 : parrello 1.3 # argument.
90 :     while (!$discard && $line =~ /(\[\[%(\w+\d*)(:([^\]]+))?\]\])/g) {
91 : parrello 1.1 # Get the data we need from the pattern match.
92 :     my $tokenLen = length $1;
93 :     my $label = $2;
94 :     my $argument = $4;
95 :     my $endPos = pos $line;
96 : parrello 1.3 Trace("Token label is $label with argument \"$argument\".") if T(4);
97 : parrello 1.1 # If we are generating, start with the residual (that is, the text prior to
98 : parrello 1.3 # the current token). If the token starts the line, however, we won't generate
99 :     # anything here.
100 : parrello 1.1 if ($ifStack[$#ifStack]) {
101 :     $retVal .= substr($line, $pos, $endPos - $tokenLen - $pos);
102 :     }
103 :     # Now check the token type.
104 :     if ($label eq 'if') {
105 :     # IF: evaluate the argument and push its truth or falsehood onto the
106 :     # if-stack. No code is generated.
107 :     if (! exists $parms{$argument}) {
108 :     Confess("Token definition for $argument not found.");
109 :     } else {
110 : parrello 1.3 Trace("IF value pushed for $argument is \"$parms{$argument}\".") if T(3);
111 :     push @ifStack, ($parms{$argument} ? 1 : 0);
112 :     $discard = 1;
113 : parrello 1.1 }
114 :     } elsif ($label eq 'fi') {
115 :     # FI: pop the IF-stack. No code is generated.
116 :     if (@ifStack == 1) {
117 :     Confess("FI without matching IF.");
118 :     } else {
119 :     pop @ifStack;
120 : parrello 1.3 $discard = 1;
121 : parrello 1.1 }
122 :     } elsif ($label eq 'stop') {
123 : parrello 1.3 # STOP: Denote we're no longer going.
124 : parrello 1.1 $going = 0;
125 : parrello 1.3 $discard = 1;
126 : parrello 1.1 } elsif ($label =~ /ask/) {
127 : parrello 1.3 # ASK: substitute the labeled parameter value. (But
128 : parrello 1.1 # only if we're generating.
129 :     if (! exists $parms{$label}) {
130 :     Confess("Label $label not found.");
131 :     } elsif ($ifStack[$#ifStack]) {
132 :     $retVal .= $parms{$label};
133 :     }
134 : parrello 1.4 } elsif ($label =~ /desc/) {
135 :     # DESC: substitute the description. First, insure we're generating.
136 :     if ($ifStack[$#ifStack]) {
137 :     # Use paragraph formatting.
138 :     $retVal .= Text::Wrap::fill("", "", $cgi->param('desc'));
139 :     }
140 : parrello 1.1 } elsif ($label =~ /flag/) {
141 : parrello 1.3 # FLAG: all flags are ignored. They are used by the if-logic, but
142 :     # are not part of the generated code.
143 :     $discard = 1;
144 : parrello 1.1 } else {
145 :     Confess("Invalid token label $label.");
146 :     }
147 :     # Save the current position for the next iteration of the search pattern
148 :     # loop,
149 :     $pos = $endPos;
150 :     }
151 :     # We've reached the end of the line. If we're generating, add on the
152 :     # residual and the new-line code.
153 : parrello 1.3 if ($ifStack[$#ifStack] && ! $discard) {
154 : parrello 1.1 $retVal .= substr($line, $pos) . "\n";
155 :     }
156 :     }
157 :     }
158 : parrello 1.3 print $cgi->header(-type => 'application/octet-stream',
159 :     -attachment => $fileTitle);
160 :     # Put us in binary mode so that the output doesn't do screwy stuff with new-lines.
161 :     # The resulting file will be encoded for Unix.
162 :     binmode(STDOUT);
163 : parrello 1.1 # Write the generated text to the output.
164 :     print $retVal;
165 :     };
166 :     if ($@) {
167 :     my $errorMessage = $@;
168 :     Trace("Script Error: $errorMessage") if T(0);
169 : parrello 1.3 # Put us in web page output mode.
170 :     print $cgi->header();
171 :     print $cgi->html($cgi->body("Script Error: $errorMessage"));
172 : parrello 1.1 }
173 : parrello 1.3
174 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3