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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (download) (as text) (annotate)
Fri Jun 15 21:06:18 2001 UTC (12 years, 10 months ago) by sam
File size: 16258 byte(s)
nothing should change

    1 #!/usr/local/bin/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