Parent Directory
|
Revision Log
modified use lib lines in cgi-scripts, scripts, courseScripts removed Global.pm updating and use lib line code from system_webwork_setup modified Global.pm to use webworkConfig (which is not in the repository!)
1 #!/usr/local/bin/webwork-perl 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 |