Return to lonproblem.pm CVS log

Up to [LON-CAPA] / loncom / homework

Integrating loncom file into CVS archive.

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