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

View of /FigWebServices/ProcessTemplate.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (download) (annotate)
Tue Apr 29 08:07:45 2008 UTC (11 years, 6 months ago) by parrello
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.4: +1 -1 lines
Fixed. Deprecated ScriptSetup methods are no longer exported by Tracer.

#!/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.

=item fileTitle

The title (file name without suffix) to give the file.

=item flagList

A comma-separated list of flag names used in the template.

=item desc

The module description.

=back

=cut

use strict;
use Tracer;
use CGI;
use Text::Wrap;

my ($cgi, $varHash) = Tracer::ScriptSetup();
eval {
    # Get the template file name.
    my $fileNamePart = $cgi->param('fileTitle') || 'NewFile';
    my $fileName = $cgi->param('templateFile');
    my $fileTitle = ($fileName =~ m#-(\w+)\.# ? "$fileNamePart.$1" : "$fileNamePart.pm");
    Trace("Chosen output file name is $fileTitle.") if T(3);
    # Extract the ask and flag parameters.
    my @names = $cgi->param;
    my %parms = map { $_ => $cgi->param($_) } grep { $_ =~ /^(ask|flag)/ } @names;
    # Put in missing flag parameters. This is so we can tell when the template asks for
    # a nonexistent flag.
    my @flags = split /\s*,\s*/, $cgi->param("flagList");
    for my $flag (@flags) {
        if (! exists $parms{$flag}) {
            $parms{$flag} = 0;
        }
    }
    # 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;
            # This variable is set to 1 if we want to discard the line, which is
            # sometimes the case.
            my $discard = 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.
            while (!$discard && $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;
                Trace("Token label is $label with argument \"$argument\".") if T(4);
                # If we are generating, start with the residual (that is, the text prior to
                # the current token). If the token starts the line, however, we won't generate
                # anything here.
                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 {
                        Trace("IF value pushed for $argument is \"$parms{$argument}\".") if T(3);
                        push @ifStack, ($parms{$argument} ? 1 : 0);
                        $discard = 1;
                    }
                } elsif ($label eq 'fi') {
                    # FI: pop the IF-stack. No code is generated.
                    if (@ifStack == 1) {
                        Confess("FI without matching IF.");
                    } else {
                        pop @ifStack;
                        $discard = 1;
                    }
                } elsif ($label eq 'stop') {
                    # STOP: Denote we're no longer going.
                    $going = 0;
                    $discard = 1;
                } elsif ($label =~ /ask/) {
                    # ASK: substitute the labeled 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 =~ /desc/) {
                    # DESC: substitute the description. First, insure we're generating.
                    if ($ifStack[$#ifStack]) {
                        # Use paragraph formatting.
                        $retVal .= Text::Wrap::fill("", "", $cgi->param('desc'));
                    }
                } elsif ($label =~ /flag/) {
                    # FLAG: all flags are ignored. They are used by the if-logic, but
                    # are not part of the generated code.
                    $discard = 1;
                } 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] && ! $discard) {
                $retVal .= substr($line, $pos) . "\n";
            }
        }
    }
    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.
    binmode(STDOUT);
    # Write the generated text to the output.
    print $retVal;
};
if ($@) {
    my $errorMessage = $@;
    Trace("Script Error: $errorMessage") if T(0);
    # Put us in web page output mode.
    print $cgi->header();
    print $cgi->html($cgi->body("Script Error: $errorMessage"));
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3