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