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

View of /FigWebServices/ProcessTemplate.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.2 - (download) (annotate)
Sat May 5 02:19:38 2007 UTC (12 years, 8 months ago) by parrello
Branch: MAIN
Changes since 1.1: +9 -7 lines
Changed to download the generated file instead of displaying it.

#!/usr/bin/perl -w

=head1 Produce Template

This script applies prompt values to a template. The template is passed in via a
file name, and the template contains special tokens delimited by double brackets
with a percent sign (e.g. C<[[%ask1:Method Name]]>). The data from the CGI
parameters is used to process the tokens, and the result is returned as a
downloadable file.

This script supports the following CGI query parameters.

=over 4

=item askX

The value of the C<ask> prompt with ID I<X>.

=item flagX

The value of the C<flag> checkbox with ID I<X>

=item templateFile

The name of the template file on the server.



use strict;
use Tracer;
use CGI;

my ($cgi, $varHash) = ScriptSetup();
eval {
    # Get the template file name.
    my $fileName = $cgi->param('templateFile');
    my $fileTitle = ($fileName =~ m#-(\w+)\.# ? "NewFile.$1" : "NewFile.pm");
    print $cgi->header(-type => 'application/octet-stream',
                       -attachment => $fileTitle);
    # Put us in binary mode so that the output doesn't do screwy stuff with new-lines.
    # The resulting file will be encoded for Unix.
    # Extract the ask and flag parameters.
    my @names = $cgi->param;
    my %parms = map { $_ => $cgi->param($_) } grep { $_ =~ /^(ask|flag)/ } @names;
    # We'll accumulate the page text in here.
    my $retVal = "";
    # Set up the IF stack. The top entry on the stack tells us whether or not
    # we're generating or skipping. We start with generating.
    my @ifStack = (1);
    # Denote we haven't stopped.
    my $going = 1;
    # Slurp in the template.
    my @lines = Tracer::GetFile($fileName);
    # Loop through the template lines, generating code.
    for my $line (@lines) {
        # Only proceed if we're not stopped.
        if ($going) {
            # We need to run through all the markers in the current line and act
            # accordingly. We do this with a match loop. The variable "$pos" will
            # point to the unparsed part of the line.
            my $pos = 0;
            # The horrific search expression below will match any marker. A marker
            # is surrounded by doubled square brackets. Inside the brackets there is
            # a percent sign, a label (with optional number), and an optional
            # argument. If an argument is present, it is preceded by a colon.
            # Each time through the loop, the pos($line) function will point
            # after the end of the token, the entire token will be in $1, the label
            # will be in $2, and the argument will be in $4.
            while ($line =~ /(\[\[%(\w+\d*)(:([^\]]+))?\]\])/g) {
                # Get the data we need from the pattern match.
                my $tokenLen = length $1;
                my $label = $2;
                my $argument = $4;
                my $endPos = pos $line;
                # If we are generating, start with the residual (that is, the text prior to
                # the current token).
                if ($ifStack[$#ifStack]) {
                    $retVal .= substr($line, $pos, $endPos - $tokenLen - $pos);
                # Now check the token type.
                if ($label eq 'if') {
                    # IF: evaluate the argument and push its truth or falsehood onto the
                    # if-stack. No code is generated.
                    if (! exists $parms{$argument}) {
                        Confess("Token definition for $argument not found.");
                    } else {
                        push @ifStack, ($parms{$label} ? 1 : 0);
                } elsif ($label eq 'fi') {
                    # FI: pop the IF-stack. No code is generated.
                    if (@ifStack == 1) {
                        Confess("FI without matching IF.");
                    } else {
                        pop @ifStack;
                } elsif ($label eq 'stop') {
                    # STOP: Denote we're no longer going. The rest of the line
                    # will parse, but subsequent lines will be ignored.
                    $going = 0;
                } elsif ($label =~ /ask/) {
                    # ASK: substitute the labelled parameter value. (But
                    # only if we're generating.
                    if (! exists $parms{$label}) {
                        Confess("Label $label not found.");
                    } elsif ($ifStack[$#ifStack]) {
                        $retVal .= $parms{$label};
                } elsif ($label =~ /flag/) {
                    # FLAG: all flags are ignored.
                } else {
                    Confess("Invalid token label $label.");
                # Save the current position for the next iteration of the search pattern
                # loop,
                $pos = $endPos;
            # We've reached the end of the line. If we're generating, add on the
            # residual and the new-line code.
            if ($ifStack[$#ifStack]) {
                $retVal .= substr($line, $pos) . "\n";
    # Write the generated text to the output.
    print $retVal;
if ($@) {
    my $errorMessage = $@;
    Trace("Script Error: $errorMessage") if T(0);
    print "Script Error: $errorMessage";

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3