Return to lonproblem.pm CVS log

Up to [LON-CAPA] / loncom / homework

- added CAPA-converter
- lonproblem reformatting

    1: # The LearningOnline Network with CAPA
    2: # Problem Handler
    3: #
    4: # 12/15-01/21,01/24 Gerd Kortemeyer
    5: 
    6: package Apache::lonproblem;
    7: 
    8: use strict;
    9: use HTML::TokeParser;
   10: use Safe;
   11: use Apache::File;
   12: 
   13: # ================================================================ Main Handler
   14: 
   15: sub handler {
   16:   my $r=shift;
   17:   my @parsecontents;
   18:   my $parsestring;
   19:   my $outstring;
   20:   
   21:   {
   22:     my $fh=Apache::File->new($r->filename);
   23:     @parsecontents=<$fh>;
   24:   }
   25:   
   26:   $parsestring=join('',@parsecontents);
   27:   
   28:   print "<form>";
   29:   
   30:   &xmlparse($r,$parsestring,'web');
   31:   
   32:   print "\n---------------\n";
   33:   print "<form>";
   34:   &xmlparse($r,$parsestring,'edit');
   35:   $outstring=xmlparse($parsestring,'modified');
   36:   print "\n---------------\n$outstring\n";
   37:   return 1; #change to ok
   38: }
   39: 
   40: # =============================================================================
   41: # ============================================================= Parsing Routine
   42: # Takes $parsestring and $target
   43: # =============================================================================
   44: 
   45: sub xmlparse {
   46:   
   47:   my ($r,$parsestring,$target) = @_;
   48:   
   49:   my $safeeval   = new Safe 'Script';
   50:   
   51:   my $parsereval = new Safe 'Parser';
   52:   
   53:   my $parser=HTML::TokeParser->new(\$parsestring);
   54:   
   55:   my $outtext='';
   56:   
   57: # ---------------------------------------------------------------- Handled tags
   58: 
   59:   my %toptoplevel  = ( 'problem'    => 'Problem',
   60: 		       'entryform'  => 'Entry Form',
   61: 		       'survey'     => 'Survey',
   62: 		       'graded'     => 'Manually Graded' );
   63:   
   64:   
   65: # --------------------------------------------------------------- Toplevel Tags
   66: 
   67:   my %topleveltags = ( 'block'   => 'Condition Block',
   68: 		       'part'    => 'Problem Part',
   69: 		       'include' => 'Include Section',
   70: 		       'answer'  => 'Answerfield',
   71: 		       'script'  => 'Script', 
   72: 		       'outtext' => 'Text Block' );
   73:  
   74: # ---------------------------------------------------------- Preregistered Tags
   75: 
   76:   my %includetags  = ( 'scriptlib' => 'Script Library',
   77: 		       'parserlib' => 'Parser Library' );
   78: # -------------------------------------------------------------Answer type Tags
   79: 
   80:   my %answertags   = ( 'capaanswer' => 'CAPA Standard Answers');
   81: 
   82: # -------------------------------------------------------------------- All Tags
   83: 
   84: 
   85:   my %xmltags      = ( %includetags, %topleveltags, %toptoplevel, %answertags );
   86:   
   87:   my $toplevel     = '';
   88:   my $above        = '';
   89:   
   90: # --------------------------------------------------- Depth counter for editing
   91: 
   92:   my @depthcounter=();
   93:   my $depth=-1;
   94:   my $olddepth=-1;
   95: 
   96: # ----------------------------------------------------------------------- Stack
   97: 
   98:   my @stack=('');
   99: 
  100: # -------------------------------------------------------------- Init $saveeval
  101: 
  102:   &init_safeeval($safeeval);
  103: 
  104: # ---------------------------------------------------------- Parse $parsestring
  105: 
  106:   my $token;
  107: 
  108:   while ($token=$parser->get_token) {n
  109: # =============================================================================
  110:     if ($token->[0] eq 'S') {
  111: # =================================================================== Start Tag
  112: # --------------------------------------------------------------- Depth Counter
  113:       if (defined($xmltags{$token->[1]})) {
  114: 	if ($depth<$olddepth-1) {
  115: 	  $#depthcounter--;
  116: 	  $olddepth=$depth;
  117: 	}
  118: 	$depth++;
  119: 	$depthcounter[$depth]++;
  120: 	if ($depthcounter[$depth]==1) {
  121: 	  $olddepth=$depth;
  122: 	}
  123:       }  
  124: # -----------------------------------------------------------------------------
  125: 
  126: 
  127:       if ($target eq 'web') {
  128: 	my $sub="start_$token->[1]";
  129: 	{
  130: 	  no strict 'refs';
  131: 	  if (defined (&$sub)) { 
  132: 	    &$sub($r,$token,$parser,$safeeval,\@stack); 
  133: 	  } else {
  134: 	    $stack[$#stack].=$token->[4];
  135: 	  }
  136: 	}
  137:       }
  138:       
  139:       if ($target eq 'edit') {
  140: 	my $depthlabel=join('_',@depthcounter);
  141: 	if (defined($xmltags{$token->[1]})) {
  142: 	  if (defined($topleveltags{$token->[1]})) {
  143: 	    &insertmenu($r,$xmltags{$token->[1]},
  144: 			$depthlabel,\%topleveltags);
  145: 	    $toplevel=$token->[1];
  146: 	  } else {
  147: 	    if ($toplevel eq 'answer') {
  148: 	      &insertmenu($r,$xmltags{$token->[1]},
  149: 			  $depthlabel,\%answertags);
  150: 	    }
  151: 	  }
  152: 	  my $sub="start_edit_$token->[1]";
  153: 	  {
  154: 	    no strict 'refs';
  155: 	    if (defined (&$sub)) { 
  156: 	      &$sub($r,$token,$parser,$xmltags{$token->[1]},
  157: 		    $depthlabel,$above,\%answertypes,\@stack); 
  158: 	    }
  159: 	  } 
  160: 	} else {
  161: 	  $stack[$#stack].=$token->[4];
  162: 	}
  163:       }
  164:       
  165:       if ($target eq 'modified') {
  166:       }
  167: 
  168: # =============================================================================
  169:     } elsif ($token->[0] eq 'E') {
  170: # ===================================================================== End Tag
  171: 
  172:       if ($target eq 'web') {
  173: 	my $sub="end_$token->[1]";
  174: 	{
  175: 	  no strict 'refs';
  176: 	  if (defined (&$sub)) { 
  177: 	    &$sub($r,$token,$parser,$safeeval,\@stack);
  178: 	  } else {
  179: 	    $stack[$#stack].=$token->[2];
  180: 	  }
  181: 	}
  182:       }
  183:       
  184:       if ($target eq 'edit') {
  185: 	if (defined($xmltags{$token->[1]})) {
  186: 	  my $sub="end_edit_$token->[1]";
  187: 	  {
  188: 	    no strict 'refs';
  189: 	    if (defined (&$sub)) { 
  190: 	      &$sub($r,$token,$above,\@stack); 
  191: 	    }
  192: 	  } 
  193: 	} 
  194:       }
  195:       
  196:       if ($target eq 'modified') {
  197:       }
  198: # --------------------------------------------------------------- Depth Counter
  199:       if (defined($xmltags{$token->[1]})) { $depth--; }
  200: # -----------------------------------------------------------------------------
  201: # =============================================================================
  202:     } elsif ($token->[0] eq 'T') {
  203: # ================================================================= Parsed Text
  204:       $stack[$#stack].=$token->[1];
  205:     }
  206:   }
  207: 
  208:   return $outtext;
  209: }
  210: # =============================================================================
  211: 
  212: # --------------------------------------------------------------- Execute Token
  213: 
  214: 
  215: 
  216: # ------------------------------------------------- Helper Routines for Editing
  217: 
  218: sub rawprint {
  219:   my ($r,$data)=@_;
  220:   $r->print($data);
  221: }
  222: 
  223: sub insertmenu {
  224:   my ($r,$description,$depthlabel,$xmltagsref)=@_;
  225:   &rawprint($r,'<br><table bgcolor="#DDDD33" width="100%"><tr><td>');
  226:   &rawprint($r,"\n".'<select name="mod_menu_'.$depthlabel.'">'."\n");
  227:   &rawprint($r,'<option value="no_changes" selected>(no changes)</option>');
  228:   &rawprint($r,"\n".
  229: 	    '<option value="delete">Delete '.$description.
  230: 	    ' Below</option>');
  231:   my $key;
  232:   foreach $key (keys %$xmltagsref) {
  233:     &rawprint($r,"\n".
  234: 	      '<option value="insert_'.$key.'">Insert '.
  235: 	      $$xmltagsref{$key}.'</option>');
  236:   }
  237:   &rawprint($r,"\n".'</select></td></tr></table><br>'."\n");
  238: }
  239: 
  240: # =============================================================================
  241: # ================================================ Routines for Safe Evaluation
  242: # =============================================================================
  243: 
  244: # -------------------------------------------- Initialize routines in $safeeval
  245: 
  246: sub init_safeeval {
  247:   my $safeeval=shift;
  248:   my $initprg=<<'ENDINIT'; 
  249: 
  250: # -------------------------------------------- Initializations inside $safeeval
  251: 
  252:   $e=25;
  253:   $c=20;
  254: 
  255:   ENDINIT
  256: # ---------------------------------------------------------------- Execute that
  257:     $safeeval->reval($initprg);
  258: }
  259: 
  260: # ----------------------------------------------- Routines that use Safe Spaces
  261: 
  262: sub printout {
  263:   my ($r,$data,$safespace)=@_;
  264:   $r->print($safespace->reval('return qq('.$data.');'));
  265: }
  266: 
  267: sub runfile {
  268:   my ($r,$filename,$safespace)=@_;
  269:   my $includefile;
  270:   if ($filename=~/^\//) {
  271:     $includefile=$filename;
  272:   } else {
  273:     $includefile=$r->dir_config('lonIncludes');
  274:     $includefile.='/'.$filename;
  275:   }
  276:   if (-e $includefile) {
  277:     $safespace->rdo($includefile);
  278:   }   
  279: }
  280: 
  281: sub run {
  282:   my ($expression,$safespace)=@_;
  283:   $safespace->reval($expression);   
  284: }
  285: 
  286: sub booleanexpr {
  287:   my ($expression,$safespace)=@_;
  288:   return $safespace->reval('return '.$expression.';');
  289: }
  290: 
  291: 
  292: # =============================================================================
  293: # ================================================== Tag Handlers for Rendering
  294: # =============================================================================
  295: 
  296: sub start_block {
  297:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  298:   if (!booleanexpr($token->[2]{'condition'},$safeeval)) {
  299:     my $blockdepth=0;
  300:     my $nexttoken;
  301:     while ($nexttoken=$parser->get_tag()) { 
  302:       if ($nexttoken->[0] eq 'block') { $blockdepth++ };
  303:       if ($nexttoken->[0] eq '/block') {
  304: 	if ($blockdepth==0) { 
  305: 	  return; 
  306: 	} else {
  307: 	  $blockdepth--;
  308: 	}
  309:       }
  310:     }
  311:   }
  312:   return;
  313: }
  314: 
  315: sub start_script {
  316:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  317:   $stackref->[$#$stackref+1]='';
  318: }
  319: 
  320: sub end_script {
  321:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  322:   &run($stackref->[$#$stackref],$safeeval);
  323:   $#$stackref--;
  324: }
  325: 
  326: sub start_outtext {
  327:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  328:   $stackref->[$#$stackref+1]='';
  329: }
  330: 
  331: sub end_outtext {
  332:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  333:   &printout($r,$stackref->[$#$stackref],$safeeval);
  334:   $#$stackref--;
  335: }
  336: 
  337: sub start_inlinetext {
  338:   &start_outtext(@_);
  339: }
  340: 
  341: sub end_inlinetext {
  342:   &end_outtext(@_);
  343: }
  344: 
  345: sub start_scriptlib {
  346:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  347:   &runfile($r,$parser->get_text('/scriptlib'),$safeeval);
  348: }
  349: 
  350: sub start_parserlib {
  351:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  352:   &runfile($r,$parser->get_text('/parserlib'),$parsereval);
  353: }
  354: 
  355: 
  356: sub start_answer {
  357:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  358:   $stackref->[$#$stackref+1]='<answer>::'.
  359:     join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});   
  360:   $stackref->[$#$stackref+1]='';
  361: }
  362: 
  363: sub end_answer {
  364:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  365:   my @itemtexts;
  366:   my @itemargs;
  367:   my $stackpointer=$#$stackref;
  368:   while (($stackref->[$stackpointer]!~'<answer>::') && ($stackpointer>0)) { 
  369:     $stackpointer--; 
  370:   }
  371:   my %answerargs=split(/:/,$stackref->[$stackpointer]);
  372: }
  373: 
  374: sub start_item {
  375:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
  376:   $stackref->[$#$stackref+1]='<item>::'.
  377:     join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});   
  378:   $stackref->[$#$stackref+1]='';
  379: }
  380: 
  381: sub end_item {}
  382: 
  383: # =============================================================================
  384: # ==================================================== Tag Handlers for Editing
  385: # =============================================================================
  386: 
  387: sub start_edit_outtext {
  388:   my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
  389:       $stackref)=@_;
  390:   &rawprint($r,"\n<h3>$description</h3>".
  391: 	    '<textarea rows="10" cols="80" name="data_'.$depthlabel.'">');
  392:   $stackref->[$#$stackref+1]='';
  393: }
  394: 
  395: sub end_edit_outtext {
  396:   my ($r,$token,$above,$stackref)=@_;
  397:   &rawprint($r,$stackref->[$#$stackref]."</textarea>\n");   
  398:   $#$stackref--;
  399: }
  400: 
  401: sub start_edit_script {
  402:   &start_edit_outtext(@_);
  403: }
  404: 
  405: sub end_edit_script {
  406:   &end_edit_outtext(@_);
  407: }
  408: 
  409: sub start_edit_inlinetext {
  410:   &start_edit_outtext(@_);
  411: }
  412: 
  413: sub end_edit_inlinetext {
  414:   &end_edit_inlinetext(@_);
  415: }
  416: 
  417: sub start_edit_block {
  418:   my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
  419:       $stackref)=@_;
  420:   my $bgcolor=$depthlabel;
  421:   $bgcolor=~s/\_//g;
  422:   $bgcolor=substr(length($bgcolor),-1,1);
  423:   $bgcolor=~tr/1-5/A-E/;
  424:   $bgcolor=$bgcolor.'FFF'.$bgcolor.'A';
  425:   &rawprint($r,"\n".'<br><table border="2" cellpadding="10" bgcolor="#'.
  426: 	    $bgcolor.
  427: 	    '" width="100%"><tr><td><h3>'.$description.'</h3>');
  428: }
  429: 
  430: sub end_edit_block {
  431:   my ($r,$token,$above,$stackref)=@_;
  432:   &rawprint($r,"\n".'</td></tr></table><br>');
  433: }
  434: 
  435: sub start_edit_answer {
  436:   my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
  437:       $stackref)=@_;
  438:   start_edit_block(@_);
  439:   $above=$token->[2]{'type'};
  440:   &rawprint($r,"\n".'<select name="mod_type_'.$depthlabel.'">');
  441:   my $key;
  442:   foreach $key (keys %$answertyperef) {
  443:     &rawprint($r,"\n".'<option value="'.$key.'"');
  444:     if ($above eq $key) { &rawprint($r,' selected'); }
  445:     &rawprint($r,'>'.$$answertyperef{$key}.'</option>');
  446:   }
  447:   &rawprint($r,"\n".'</select>'."\n");
  448: }
  449: 
  450: sub end_edit_answer {
  451:   my ($r,$token,$above,$stackref)=@_;
  452:   end_edit_block(@_);
  453: }
  454: 
  455: sub start_edit_include {
  456:   start_edit_block(@_);
  457: }
  458: 
  459: sub end_edit_include {
  460:   end_edit_block(@_);
  461: }
  462: 
  463: sub start_edit_problem {
  464:   start_edit_block(@_);
  465: }
  466: 
  467: sub end_edit_problem {
  468:   end_edit_block(@_);
  469: }
  470: 
  471: 1;
  472: __END__
  473:   
  474: 
  475: 
  476: 
  477: 
  478: 
  479: