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

Annotation of /FigWebServices/ProcessTemplate.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (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 :     =back
28 :    
29 :     =cut
30 :    
31 :     use strict;
32 :     use Tracer;
33 :     use CGI;
34 :    
35 :     my ($cgi, $varHash) = ScriptSetup();
36 :     eval {
37 : parrello 1.2 # Get the template file name.
38 :     my $fileName = $cgi->param('templateFile');
39 :     my $fileTitle = ($fileName =~ m#-(\w+)\.# ? "NewFile.$1" : "NewFile.pm");
40 :     print $cgi->header(-type => 'application/octet-stream',
41 :     -attachment => $fileTitle);
42 :     # Put us in binary mode so that the output doesn't do screwy stuff with new-lines.
43 :     # The resulting file will be encoded for Unix.
44 :     binmode(STDOUT);
45 : parrello 1.1 # Extract the ask and flag parameters.
46 :     my @names = $cgi->param;
47 :     my %parms = map { $_ => $cgi->param($_) } grep { $_ =~ /^(ask|flag)/ } @names;
48 :     # We'll accumulate the page text in here.
49 :     my $retVal = "";
50 :     # Set up the IF stack. The top entry on the stack tells us whether or not
51 :     # we're generating or skipping. We start with generating.
52 :     my @ifStack = (1);
53 :     # Denote we haven't stopped.
54 :     my $going = 1;
55 :     # Slurp in the template.
56 :     my @lines = Tracer::GetFile($fileName);
57 :     # Loop through the template lines, generating code.
58 :     for my $line (@lines) {
59 :     # Only proceed if we're not stopped.
60 :     if ($going) {
61 :     # We need to run through all the markers in the current line and act
62 :     # accordingly. We do this with a match loop. The variable "$pos" will
63 :     # point to the unparsed part of the line.
64 :     my $pos = 0;
65 :     # The horrific search expression below will match any marker. A marker
66 :     # is surrounded by doubled square brackets. Inside the brackets there is
67 :     # a percent sign, a label (with optional number), and an optional
68 :     # argument. If an argument is present, it is preceded by a colon.
69 :     # Each time through the loop, the pos($line) function will point
70 :     # after the end of the token, the entire token will be in $1, the label
71 :     # will be in $2, and the argument will be in $4.
72 :     while ($line =~ /(\[\[%(\w+\d*)(:([^\]]+))?\]\])/g) {
73 :     # Get the data we need from the pattern match.
74 :     my $tokenLen = length $1;
75 :     my $label = $2;
76 :     my $argument = $4;
77 :     my $endPos = pos $line;
78 :     # If we are generating, start with the residual (that is, the text prior to
79 :     # the current token).
80 :     if ($ifStack[$#ifStack]) {
81 :     $retVal .= substr($line, $pos, $endPos - $tokenLen - $pos);
82 :     }
83 :     # Now check the token type.
84 :     if ($label eq 'if') {
85 :     # IF: evaluate the argument and push its truth or falsehood onto the
86 :     # if-stack. No code is generated.
87 :     if (! exists $parms{$argument}) {
88 :     Confess("Token definition for $argument not found.");
89 :     } else {
90 :     push @ifStack, ($parms{$label} ? 1 : 0);
91 :     }
92 :     } elsif ($label eq 'fi') {
93 :     # FI: pop the IF-stack. No code is generated.
94 :     if (@ifStack == 1) {
95 :     Confess("FI without matching IF.");
96 :     } else {
97 :     pop @ifStack;
98 :     }
99 :     } elsif ($label eq 'stop') {
100 :     # STOP: Denote we're no longer going. The rest of the line
101 :     # will parse, but subsequent lines will be ignored.
102 :     $going = 0;
103 :     } elsif ($label =~ /ask/) {
104 :     # ASK: substitute the labelled parameter value. (But
105 :     # only if we're generating.
106 :     if (! exists $parms{$label}) {
107 :     Confess("Label $label not found.");
108 :     } elsif ($ifStack[$#ifStack]) {
109 :     $retVal .= $parms{$label};
110 :     }
111 :     } elsif ($label =~ /flag/) {
112 :     # FLAG: all flags are ignored.
113 :     } else {
114 :     Confess("Invalid token label $label.");
115 :     }
116 :     # Save the current position for the next iteration of the search pattern
117 :     # loop,
118 :     $pos = $endPos;
119 :     }
120 :     # We've reached the end of the line. If we're generating, add on the
121 :     # residual and the new-line code.
122 :     if ($ifStack[$#ifStack]) {
123 :     $retVal .= substr($line, $pos) . "\n";
124 :     }
125 :     }
126 :     }
127 :     # Write the generated text to the output.
128 :     print $retVal;
129 :     };
130 :     if ($@) {
131 :     my $errorMessage = $@;
132 :     Trace("Script Error: $errorMessage") if T(0);
133 :     print "Script Error: $errorMessage";
134 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3