[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 51 - (download) (as text) (annotate)
Thu Jun 21 20:53:03 2001 UTC (18 years, 8 months ago) by sam
File size: 16515 byte(s)
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