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

Diff of /FigWebServices/ProcessTemplate.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2, Sat May 5 02:19:38 2007 UTC revision 1.3, Tue Nov 6 13:54:12 2007 UTC
# Line 24  Line 24 
24    
25  The name of the template file on the server.  The name of the template file on the server.
26    
27    =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  =back  =back
36    
37  =cut  =cut
# Line 35  Line 43 
43  my ($cgi, $varHash) = ScriptSetup();  my ($cgi, $varHash) = ScriptSetup();
44  eval {  eval {
45      # Get the template file name.      # Get the template file name.
46        my $fileNamePart = $cgi->param('fileTitle') || 'NewFile';
47      my $fileName = $cgi->param('templateFile');      my $fileName = $cgi->param('templateFile');
48      my $fileTitle = ($fileName =~ m#-(\w+)\.# ? "NewFile.$1" : "NewFile.pm");      my $fileTitle = ($fileName =~ m#-(\w+)\.# ? "$fileNamePart.$1" : "$fileNamePart.pm");
49      print $cgi->header(-type => 'application/octet-stream',      Trace("Chosen output file name is $fileTitle.") if T(3);
                        -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);  
50      # Extract the ask and flag parameters.      # Extract the ask and flag parameters.
51      my @names = $cgi->param;      my @names = $cgi->param;
52      my %parms = map { $_ => $cgi->param($_) } grep { $_ =~ /^(ask|flag)/ } @names;      my %parms = map { $_ => $cgi->param($_) } grep { $_ =~ /^(ask|flag)/ } @names;
53        # Put in missing flag parameters. This is so we can tell when the template asks for
54        # a nonexistent flag.
55        my @flags = split /\s*,\s*/, $cgi->param("flagList");
56        for my $flag (@flags) {
57            if (! exists $parms{$flag}) {
58                $parms{$flag} = 0;
59            }
60        }
61      # We'll accumulate the page text in here.      # We'll accumulate the page text in here.
62      my $retVal = "";      my $retVal = "";
63      # Set up the IF stack. The top entry on the stack tells us whether or not      # Set up the IF stack. The top entry on the stack tells us whether or not
# Line 62  Line 75 
75              # accordingly. We do this with a match loop. The variable "$pos" will              # accordingly. We do this with a match loop. The variable "$pos" will
76              # point to the unparsed part of the line.              # point to the unparsed part of the line.
77              my $pos = 0;              my $pos = 0;
78                # This variable is set to 1 if we want to discard the line, which is
79                # sometimes the case.
80                my $discard = 0;
81              # The horrific search expression below will match any marker. A marker              # The horrific search expression below will match any marker. A marker
82              # is surrounded by doubled square brackets. Inside the brackets there is              # is surrounded by doubled square brackets. Inside the brackets there is
83              # a percent sign, a label (with optional number), and an optional              # a percent sign, a label (with optional number), and an optional
84              # argument. If an argument is present, it is preceded by a colon.              # argument.
85              # Each time through the loop, the pos($line) function will point              while (!$discard && $line =~ /(\[\[%(\w+\d*)(:([^\]]+))?\]\])/g) {
             # 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) {  
86                  # Get the data we need from the pattern match.                  # Get the data we need from the pattern match.
87                  my $tokenLen = length $1;                  my $tokenLen = length $1;
88                  my $label = $2;                  my $label = $2;
89                  my $argument = $4;                  my $argument = $4;
90                  my $endPos = pos $line;                  my $endPos = pos $line;
91                    Trace("Token label is $label with argument \"$argument\".") if T(4);
92                  # If we are generating, start with the residual (that is, the text prior to                  # If we are generating, start with the residual (that is, the text prior to
93                  # the current token).                  # the current token). If the token starts the line, however, we won't generate
94                    # anything here.
95                  if ($ifStack[$#ifStack]) {                  if ($ifStack[$#ifStack]) {
96                      $retVal .= substr($line, $pos, $endPos - $tokenLen - $pos);                      $retVal .= substr($line, $pos, $endPos - $tokenLen - $pos);
97                  }                  }
# Line 87  Line 102 
102                      if (! exists $parms{$argument}) {                      if (! exists $parms{$argument}) {
103                          Confess("Token definition for $argument not found.");                          Confess("Token definition for $argument not found.");
104                      } else {                      } else {
105                          push @ifStack, ($parms{$label} ? 1 : 0);                          Trace("IF value pushed for $argument is \"$parms{$argument}\".") if T(3);
106                            push @ifStack, ($parms{$argument} ? 1 : 0);
107                            $discard = 1;
108                      }                      }
109                  } elsif ($label eq 'fi') {                  } elsif ($label eq 'fi') {
110                      # FI: pop the IF-stack. No code is generated.                      # FI: pop the IF-stack. No code is generated.
# Line 95  Line 112 
112                          Confess("FI without matching IF.");                          Confess("FI without matching IF.");
113                      } else {                      } else {
114                          pop @ifStack;                          pop @ifStack;
115                            $discard = 1;
116                      }                      }
117                  } elsif ($label eq 'stop') {                  } elsif ($label eq 'stop') {
118                      # STOP: Denote we're no longer going. The rest of the line                      # STOP: Denote we're no longer going.
                     # will parse, but subsequent lines will be ignored.  
119                      $going = 0;                      $going = 0;
120                        $discard = 1;
121                  } elsif ($label =~ /ask/) {                  } elsif ($label =~ /ask/) {
122                      # ASK: substitute the labelled parameter value. (But                      # ASK: substitute the labeled parameter value. (But
123                      # only if we're generating.                      # only if we're generating.
124                      if (! exists $parms{$label}) {                      if (! exists $parms{$label}) {
125                          Confess("Label $label not found.");                          Confess("Label $label not found.");
# Line 109  Line 127 
127                          $retVal .= $parms{$label};                          $retVal .= $parms{$label};
128                      }                      }
129                  } elsif ($label =~ /flag/) {                  } elsif ($label =~ /flag/) {
130                      # FLAG: all flags are ignored.                      # FLAG: all flags are ignored. They are used by the if-logic, but
131                        # are not part of the generated code.
132                        $discard = 1;
133                  } else {                  } else {
134                      Confess("Invalid token label $label.");                      Confess("Invalid token label $label.");
135                  }                  }
# Line 119  Line 139 
139              }              }
140              # We've reached the end of the line. If we're generating, add on the              # We've reached the end of the line. If we're generating, add on the
141              # residual and the new-line code.              # residual and the new-line code.
142              if ($ifStack[$#ifStack]) {              if ($ifStack[$#ifStack] && ! $discard) {
143                  $retVal .= substr($line, $pos) . "\n";                  $retVal .= substr($line, $pos) . "\n";
144              }              }
145          }          }
146      }      }
147        print $cgi->header(-type => 'application/octet-stream',
148                           -attachment => $fileTitle);
149        # Put us in binary mode so that the output doesn't do screwy stuff with new-lines.
150        # The resulting file will be encoded for Unix.
151        binmode(STDOUT);
152      # Write the generated text to the output.      # Write the generated text to the output.
153      print $retVal;      print $retVal;
154  };  };
155  if ($@) {  if ($@) {
156      my $errorMessage = $@;      my $errorMessage = $@;
157      Trace("Script Error: $errorMessage") if T(0);      Trace("Script Error: $errorMessage") if T(0);
158      print "Script Error: $errorMessage";      # Put us in web page output mode.
159        print $cgi->header();
160        print $cgi->html($cgi->body("Script Error: $errorMessage"));
161  }  }
162    
163    1;

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3