[system] / trunk / webwork / system / lib / capa2PG.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork/system/lib/capa2PG.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (view) (download) (as text)

1 : gage 6 #!/usr/local/bin/perl
2 : sam 2
3 :     # READ CAPA file
4 :    
5 :    
6 :     package capa2PG;
7 :    
8 :     use vars qw( $STRING_FLAG $STRING_FLAG_STACK @ISA);
9 :     use Exporter;
10 :     @ISA = qw(Exporter);
11 :     @EXPORT = qw(parse_CAPA_file parse_CAPA_aux_file);
12 :    
13 :     use strict;
14 :     use Parse::RecDescent;
15 :    
16 :     ## begin Timing code
17 :     #use Benchmark;
18 :     #my $beginTime = new Benchmark;
19 :     ## end Timing code
20 :    
21 :     sub flatten {
22 :     my (@in) = @_;
23 :     my @out = ();
24 :     my $elem;
25 :     foreach $elem (@in) {
26 :     if (ref($elem) eq 'ARRAY') {
27 :     push(@out, flatten(@$elem) );
28 :     } else {
29 :     push(@out, $elem);
30 :     }
31 :     }
32 :     @out;
33 :     }
34 :    
35 :     sub printtree
36 :     {
37 :     print " " x $_[0];
38 :     if ( defined($_[1]) ) {
39 :    
40 :     if (ref($_[1]) ) {
41 :     printtree($_[0]+1,@{$_[1]});
42 :     } else {
43 :     print("$_[1]:\n");
44 :     }
45 :     foreach ( @_[2..$#_] )
46 :     {
47 :     if (ref($_)) { printtree($_[0]+1,@$_); }
48 :     else { print " " x $_[0], "$_\n" }
49 :     }
50 :     print "\n";
51 :     }
52 :    
53 :     }
54 :    
55 :    
56 :     sub DISPLAY {
57 :     $capa2PG::OUTPUTstring .= join("\n", @_) . "\n";
58 :     }
59 :    
60 :     sub ERROR {
61 :     $capa2PG::ERRORstring .= join("\n", @_) . "\n";
62 :     }
63 :    
64 :     #
65 :     # $::RD_AUTOACTION = q
66 :     # { print "--", join("<|>",@item), "\n"; };
67 :     #$::RD_HINT=1;
68 :    
69 :     $::RD_AUTOACTION = q{ "@item[1..$#item]"};
70 :     my $Grammar=<<'EOF';
71 :    
72 :    
73 :     line : '//' <commit> comment_line {
74 :     "## $item[3]"}
75 :     | m{/LET}i <commit> assignment_line end_comment{
76 :     "$item[3]; $item[4]"}
77 :     | m{/BEG}i <commit> begin_line end_comment { #begins with /BEGIN
78 :     qq{
79 :     ENDDOCUMENT();\n\n\n
80 :     ####################################################\n
81 :     DOCUMENT();\n
82 :     loadMacros(\n"PG.pl",\n
83 :     "PGbasicmacros.pl",\n
84 :     "PGauxiliaryFunctions.pl",
85 :     "PGchoicemacros.pl",\n
86 :     "PGanswermacros.pl",\n
87 :     "PGgraphmacros.pl",\n
88 :     "PG_CAPAmacros.pl"\n
89 :     );
90 :    
91 :     TEXT(beginproblem());\n
92 :     $item[3]; $item[4]\n
93 :     }
94 :     }
95 :     | m{/ANS}i <commit> answer_line end_comment{
96 :     "\nTEXT(\"\$BR\$BR\",ans_rule(30),\"\$BR\");\nANS( CAPA_ans( $item[3] ) ); $item[4]"}
97 :     | m{/IMP}i <commit> import_line end_comment {
98 :     "CAPA_import( $item[3] ); $item[4]"}
99 :     | m{/HIN}i <commit> hint_line { # no comments permitted in hints
100 :     "CAPA_hint( \"$item[3]\"); $item[4]"; }
101 :     | m{/EXP}i <commit> explanation_line { # no comments permitted in explanations
102 :     "CAPA_explanation( \"$item[3]\"); $item[4]"; }
103 :     | m{/END}i <commit> end_line {
104 :     "\nENDDOCUMENT();\n__END__\n"}
105 :     | text_line
106 :     { #anything else -- no end comments permitted in text.
107 :     "TEXT(CAPA_EV (<<'END_OF_TEXT'));\n$item[1]\nEND_OF_TEXT\n";
108 :     }
109 :    
110 :     | <error>
111 :    
112 :    
113 :     comment_line : /.*/ {
114 :     "$item[1]";
115 :     }
116 :     end_comment : '//' /.*/ {
117 :     "# $item[2]";
118 :     }
119 :     | {""}
120 :    
121 :     begin_line : identifier_to_be_defined '=' expression {
122 :     "@item[1..3]";}
123 :     import_line : '"' filename '"'
124 :     hint_line : /.*/
125 :     explanation_line : /.*/
126 :    
127 :     answer_line : <rulevar:$out><reject>
128 :     | '(' expression (':')(?) format(?) (',')(?) option_list(?) ')' {
129 :     $out = "$item[2]";
130 :     $out .= ", 'format' => ${$item[4]}[0]" if defined(${$item[4]}[0]);
131 :     $out .= " ${$item[5]}[0] ";
132 :     $out .= "${$item[6]}[0]"}
133 :    
134 :    
135 :    
136 :     end_line : /.*/
137 :    
138 :     text_line : m{[^/]*} command text_line {
139 :     "$item[1]$item[2]$item[3]";
140 :     }
141 :     | m{[^/]*} {
142 :     "$item[1]";
143 :     }
144 :    
145 :     command : map_command | display_command | '/'
146 :     display_command : '/' 'DIS' display_argument {
147 :     if ( $text =~ /^\s/) {
148 :     $return = "$item[3] "; # kludge -- put an extra space in if there is a space after the display command
149 :     } else {
150 :     $return = "$item[3]"
151 :     }
152 :    
153 :     }
154 :    
155 :     #display_argument : '(' /[^\)]*/ ')' {"@item"}
156 :    
157 :     display_argument : '(' function ')' {
158 :     "\\{ $item[2] \\}" ; # this keeps us from mistaking a function for an undefined variable and getting an error message
159 :     }
160 :     | '(' variable ')' {# no evaluation needed but we need to worry about spacing.
161 :     "\\{ $item[2] \\}"}
162 :     | '(' expression (':')(?) format(?) ')' {
163 :    
164 :     ${$item[4]}[0] ? "\\{ spf( $item[2] , ${$item[4]}[0] ) \\}" : "\\{ $item[2] \\}" ;
165 :    
166 :     }
167 :    
168 :     map_command : '/' 'MAP' <commit> '(' expression ';' variable_list ';' expression_list ')' {
169 :     "\\{CAPA_map( $item[5] , [ $item[7] ] , [ $item[9] ] )\\}\n";
170 :     }
171 :    
172 :     variable_list : list[rule => 'variable', sep => ','] { $item[1] =~ s/\$(\w+)/'$1'/g; $item[1]; }
173 :    
174 :     assignment_line : { $capa2PG::STRING_FLAG = 0;} <reject>
175 :     |<rulevar:$out> <reject>
176 :     | identifier_to_be_defined '=' expression
177 :     {
178 :    
179 :     $out = "$item[1] $item[2] $item[3]";
180 :     #print "line is $out\nSTRING_FLAG = $capa2PG::STRING_FLAG\n";
181 :     if ($capa2PG::STRING_FLAG) {
182 :     #print "defining $capa2PG::CURRENT_IDENTIFIER_TO_BE_DEFINED\n";
183 :     $capa2PG::IDENTIFIERS{$capa2PG::CURRENT_IDENTIFIER_TO_BE_DEFINED}++;
184 :     }
185 :     $out;
186 :     }
187 :    
188 :    
189 :    
190 :     list : <matchrule:$arg{rule}> extend_list[%arg]
191 :     { $return = "$item[1]$item[2]" }
192 :     extend_list : /$arg{sep}/ list[@arg] {"$item[1] $item[2]"}
193 :     | {""}
194 :    
195 :    
196 :     expression_list : list[rule => 'expression', sep => ','] {
197 :     "$item[1]"
198 :     }
199 :     option_list : list[rule => 'option', sep => ','] {
200 :     "$item[1]"
201 :     }
202 :     #option_list :/[^\)]*/
203 :     option : /SIG/i <commit> '=' option_value {"'sig' => \'$item[4]\'" }
204 :     | /TOL/i <commit> '=' expression ('%')(?) {
205 :     if (${$item[5]}[0]) {
206 :     $return = "'reltol' => $item[4]";
207 :     } else {
208 :     $return = "'tol' => $item[4]";
209 :     }
210 :     }
211 :     | /str/i <commit> '=' option_value {" 'str' => \'$item[3] \'"}
212 :     | option_name '=' expression {" '$item[1]' => $item[3] "}
213 :     option_name : identifier
214 :     option_value : /[^,\)]*/
215 :     expression : {unshift(@capa2PG::STRING_FLAG_STACK, 0 ); } <reject>
216 :     | expression_iter {$capa2PG::STRING_FLAG = shift (@capa2PG::STRING_FLAG_STACK);
217 :     #print "stack depth = ", scalar(@capa2PG::STRING_FLAG_STACK), "\n";
218 :     #print "string is $item[1]\nSTRING_FLAG is $capa2PG::STRING_FLAG\n";
219 :     # $item[1] =~ s/\+/ \. /g if $capa2PG::STRING_FLAG;
220 :     "$item[1] "
221 :     }
222 :     | '-' <commit> expression_iter {$capa2PG::STRING_FLAG = shift (@capa2PG::STRING_FLAG_STACK);
223 :     #print "stack depth = ", scalar(@capa2PG::STRING_FLAG_STACK), "\n";
224 :     #print "string is $item[1]\nSTRING_FLAG is $capa2PG::STRING_FLAG\n";
225 :     # $item[1] =~ s/\+/ \. /g if $capa2PG::STRING_FLAG;
226 :     "$item[1] $item[3]"
227 :     }
228 :     | {unshift(@capa2PG::STRING_FLAG_STACK);
229 :     #print "no match in expression\n";
230 :     #print "stack depth = ", scalar(@capa2PG::STRING_FLAG_STACK), "\n";
231 :     } <reject>
232 :     expression_iter : term extend_expression {
233 :     "$item[1] $item[2]";
234 :     }
235 :    
236 :     extend_expression : add_op <commit> expression_iter {
237 :     $item[1] =~ s/\+/\./ if $capa2PG::STRING_FLAG_STACK[0];
238 :     "$item[1] $item[3]"
239 :     }
240 :     | {''}
241 :    
242 :     term : factor <commit> extend_term {
243 :     "$item[1] $item[3]";
244 :     }
245 :     | quote
246 :    
247 :     extend_term : mult_op <commit> term { "$item[1] $item[3]"}
248 :     | {''}
249 :     factor : function {
250 :     "$item[1]"
251 :     }
252 :     | variable {
253 :     $item[1]
254 :     }
255 :     | '(' <commit> expression comparison_extension')'{
256 :     $capa2PG::STRING_FLAG_STACK[0]++ if $capa2PG::STRING_FLAG; # if the expression is a string variable
257 :     "$item[1] $item[3] $item[4]$item[5]"
258 :     }
259 :     | number {
260 :     $item[1]
261 :     }
262 :     comparison_extension : comparison_operator <commit> expression {"$item[1] $item[3]" }
263 :     | {''}
264 :     comparison_operator : '==' | '!=' | '>=' | '<=' | '>' | '<'
265 :    
266 :     function : function_identifier '(' ')' {
267 :     "$item[1]$item[2]$item[3]"
268 :     }
269 :     | function_identifier '(' <commit> expression_list ')' {
270 :     $capa2PG::STRING_FLAG_STACK[0]++ if $capa2PG::STRING_FLAG; # if the expression is a string variable
271 :     "$item[1]$item[2] $item[4]$item[5]"
272 :     }
273 :    
274 :     function_identifier : 'web' {'CAPA_web'}
275 :     | 'html' {'CAPA_html'}
276 :     | 'tex' {'CAPA_tex'}
277 :     | identifier
278 :    
279 :     identifier_to_be_defined : <rulevar: $var_name>
280 :     | identifier {
281 :     $var_name = "\$$item[1]";
282 :     $capa2PG::CURRENT_IDENTIFIER_TO_BE_DEFINED = $var_name;
283 :     $capa2PG::IDENTIFIERS{$capa2PG::CURRENT_IDENTIFIER_TO_BE_DEFINED} = 0;
284 :    
285 :     $var_name
286 :    
287 :     }
288 :     variable : <rulevar: $var_name>
289 :     | identifier {
290 :     $var_name = "\$$item[1]";
291 :     capa2PG::ERROR( "###Error: $var_name not defined in this file" )
292 :     unless defined ( $capa2PG::IDENTIFIERS{$var_name} ) ;
293 :     $capa2PG::STRING_FLAG_STACK[0]++ if $capa2PG::IDENTIFIERS{$var_name}; # if the identifier is a string variable
294 :    
295 :     $return = "${var_name}";
296 :    
297 :     }
298 :     quote : /"\s*/ <commit> /[^"]*/ '"' {
299 :     $item[3] =~ s/\'/~~'/g; #protect single quotes
300 :     # $item[3] = " " if $item[3] =~ /^\s*$/; # kludge to make sure spaces survive in quotes. Changing separator would be better.
301 :     $item[1] =~s/"/'/; # replace the first quote with a single quote, spacing is preserved.
302 :     $capa2PG::STRING_FLAG_STACK[0]++; "$item[1]$item[3]'"}
303 :    
304 :     format : /(\d+)(\w)/ {"\"%0.$1" .lc($2) . "\""}
305 :     number : /\-?\d+\.?\d*/ exponent(?) {
306 :     $item[1].join("",@{$item[2]})
307 :     }
308 :     | /\-?\.\d+/ exponent(?) {
309 :     $item[1].join("", @{$item[2]})
310 :     }
311 :    
312 :     integer : /\d+/
313 :     exponent : ('E' | 'e') <commit> ('-'|'+')(?) integer {
314 :     $item[1].join("",@{$item[3]}).$item[4]
315 :     }
316 :     identifier : /[A-Za-z][A-Za-z0-9_]*/
317 :    
318 :     mult_op : '*' | '/' ...!'/' # this keeps us from grabbing // (comment) by mistake
319 :     add_op : '+' | '-'
320 :    
321 :    
322 :     filename : /[A-Za-z0-9\.\/\#]+/
323 :    
324 :     EOF
325 :    
326 :    
327 :     my $parser = new Parse::RecDescent $Grammar or die "invalid grammar";
328 :    
329 :     sub parse_CAPA_file {
330 :     my $array_ref = shift; # takes an array ref for input -- check this below
331 :     return "\nparse_CAPA_file requires an array reference for input and returns a string\n\n"
332 :     unless ref($array_ref) =~ /ARRAY/;
333 :     $capa2PG::STRING_FLAG = 0;
334 :     @capa2PG::STRING_FLAG_STACK = ();
335 :     $capa2PG::OUTPUTstring = "";
336 :     $capa2PG::ERRORstring = "";
337 :     my $counter =0;
338 :    
339 :     DISPLAY qq{
340 :     DOCUMENT();
341 :     loadMacros( "PG.pl",
342 :     "PGbasicmacros.pl",
343 :     "PGauxiliaryFunctions.pl",
344 :     "PGchoicemacros.pl",
345 :     "PGanswermacros.pl",
346 :     "PGgraphmacros.pl",
347 :     "PG_CAPAmacros.pl"
348 :     );
349 :    
350 :     TEXT(beginproblem());
351 :     \$showPartialCorrectAnswers =1;
352 :    
353 :     };
354 :     my $line;
355 :     my $extend_line = "";
356 :     foreach $line (@$array_ref) {
357 :     chomp($line);
358 :     # continue lines which end in \
359 :     if ($line =~ /\\(\n*)$/) { # continue lines which end in \
360 :     $line =~ s/\\$/ /;
361 :     $extend_line .=$line;
362 :     next;
363 :     } else {
364 :     if ($extend_line) { # if extend_line is non-empty add line and process
365 :     $line = $extend_line . $line;
366 :     $extend_line = ""; # reset extend _line
367 :     }
368 :     }
369 :     $line =~ s/\$\$/\{\}\/*\/*\{\}/g;
370 :     $line =~ s/\$/\{\}\/*\{\}/g;
371 :     $line = $parser->line($line);
372 :     # $line =~ s|src\s*=\s*/teacher/capalibrary/Graphics/|src = \${Global::CAPA_Graphics_URL}|; # trying to guess the graphics url and directory addresses
373 :     # $line =~ s|/teacher/capalibrary/Graphics/|\${Global::CAPA_GraphicsDirectory}|;
374 :     # $line =~ s|/teacher/capalibrary/Tools/|\${Global::CAPA_Tools}|;
375 :     # $line =~ s|/teacher/capalibrary/MCTools/|\${Global::CAPA_MCTools}|;
376 :     $line =~ s|src\s*=\s*/teacher/capalibrary/Graphics/|src = \${CAPA_Graphics_URL}|; # trying to guess the graphics url and directory addresses
377 :     $line =~ s|/teacher/capalibrary/Graphics/|\${CAPA_GraphicsDirectory}|;
378 :     $line =~ s|/teacher/capalibrary/Tools/|\${CAPA_Tools}|;
379 :     $line =~ s|/teacher/capalibrary/MCTools/|\${CAPA_MCTools}|;
380 :     #print "\nSTRING_FLAG = $capa2PG::STRING_FLAG\n";
381 :     DISPLAY($line);
382 :     }
383 :    
384 :     DISPLAY("ENDDOCUMENT();\n");
385 :     #DISPLAY("1; # required for auxilliary files");
386 :    
387 :     DISPLAY( "#####################\n");
388 :     DISPLAY( $capa2PG::ERRORstring);
389 :     DISPLAY( "#####################\n");
390 :    
391 :    
392 :     $capa2PG::OUTPUTstring =~ s/\nEND_OF_TEXT\n[\s\n\r\#]*TEXT\(CAPA_EV \(<<'END\_OF\_TEXT'\)\);\n/\n/gs;
393 :    
394 :     $capa2PG::OUTPUTstring;
395 :     }
396 :    
397 :     sub parse_CAPA_aux_file {
398 :     my $array_ref = shift; # takes an array ref for input -- check this below
399 :     return "\nparse_CAPA_aux_file requires an array reference for input and returns a string\n\n"
400 :     unless ref($array_ref) =~ /ARRAY/;
401 :     $capa2PG::STRING_FLAG = 0;
402 :     @capa2PG::STRING_FLAG_STACK = ();
403 :     $capa2PG::OUTPUTstring = "";
404 :     $capa2PG::ERRORstring = "";
405 :     my $counter =0;
406 :    
407 :     my $line;
408 :     my $extend_line = "";
409 :     foreach $line (@$array_ref) {
410 :     # continue lines which end in \
411 :     if ($line =~ /\\(\n*)$/) { # continue lines which end in \
412 :     $line =~ s/\\$/ /;
413 :     $extend_line .=$line;
414 :     next;
415 :     } else {
416 :     if ($extend_line) { # if extend_line is non-empty add line and process
417 :     $line = $extend_line . $line;
418 :     $extend_line = ""; # reset extend _line
419 :     }
420 :     }
421 :     $line =~ s/\$\$/\{\}\/*\/*\{\}/g;
422 :     $line =~ s/\$/\{\}\/*\{\}/g;
423 :     $line = $parser->line($line);
424 :     # $line =~ s|src\s*=\s*/teacher/capalibrary/Graphics/|src = \${Global::CAPA_Graphics_URL}|; # trying to guess the graphics url and directory addresses
425 :     # $line =~ s|/teacher/capalibrary/Graphics/|\${Global::CAPA_GraphicsDirectory}|;
426 :     # $line =~ s|/teacher/capalibrary/Tools/|\${Global::CAPA_Tools}|;
427 :     # $line =~ s|/teacher/capalibrary/MCTools/|\${Global::CAPA_MCTools}|;
428 :     $line =~ s|src\s*=\s*/teacher/capalibrary/Graphics/|src = \${CAPA_Graphics_URL}|; # trying to guess the graphics url and directory addresses
429 :     $line =~ s|/teacher/capalibrary/Graphics/|\${CAPA_GraphicsDirectory}|;
430 :     $line =~ s|/teacher/capalibrary/Tools/|\${CAPA_Tools}|;
431 :     $line =~ s|/teacher/capalibrary/MCTools/|\${CAPA_MCTools}|;
432 :     #print "\nSTRING_FLAG = $::STRING_FLAG\n";
433 :     DISPLAY($line);
434 :     }
435 :    
436 :    
437 :     DISPLAY( "#####################\n");
438 :     DISPLAY( $capa2PG::ERRORstring);
439 :     DISPLAY( "#####################\n");
440 :    
441 :     DISPLAY("1; # required for auxiliary files");
442 :    
443 :    
444 :    
445 :     $capa2PG::OUTPUTstring =~ s/\nEND_OF_TEXT\n[\s\n\r\#]*TEXT\(CAPA_EV \(<<'END\_OF\_TEXT'\)\);\n/\n/gs;
446 :    
447 :     $capa2PG::OUTPUTstring;
448 :     }
449 :    
450 :    
451 :     # my $ARGV;
452 :     # my @file_lines;
453 :     # @ARGV = ('-') unless @ARGV;
454 :     # while ($ARGV = shift) {
455 :     # print "# READING FROM $ARGV\n\n";
456 :     #
457 :     # open(ARGV, "<$ARGV") || die " Can't read file $ARGV ";
458 :     # @file_lines = <ARGV>;
459 :     # close(ARGV);
460 :     # print parse_CAPA_file(\@file_lines);
461 :     # }
462 :    
463 :     ## begin Timing code
464 :     #my $endTime = new Benchmark;
465 :     #print "\n#################################################\n## Processing time = ", timestr( timediff($endTime,$beginTime) ),
466 :     # "\n#################################################\n";
467 :     ## end Timing code
468 :    
469 :     #exit;
470 :     1;
471 :     # __DATA__
472 :     # /Let test = 45 -67*87 + tex("testing" + "test",2+5,"one")
473 :     # /let test2 = 45 + 67 *9
474 :     # /let test3 = test + test2 + test
475 :    

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9