Annotation of loncom/homework/lonproblem.pm, revision 1.5

1.5     ! albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # Problem Handler
                      3: #
1.2       harris41    4: # 12/15-01/21,01/24 Gerd Kortemeyer
1.1       albertel    5: 
                      6: package Apache::lonproblem;
                      7: 
                      8: use strict;
                      9: use HTML::TokeParser;
                     10: use Safe;
                     11: use Apache::File;
                     12: 
                     13: # ================================================================ Main Handler
1.5     ! albertel   14: 
1.1       albertel   15: sub handler {
1.5     ! albertel   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
1.1       albertel   38: }
                     39: 
1.5     ! albertel   40: # =============================================================================
1.1       albertel   41: # ============================================================= Parsing Routine
                     42: # Takes $parsestring and $target
1.5     ! albertel   43: # =============================================================================
        !            44: 
1.1       albertel   45: sub xmlparse {
1.3       albertel   46:   
1.5     ! albertel   47:   my ($r,$parsestring,$target) = @_;
1.3       albertel   48:   
1.5     ! albertel   49:   my $safeeval   = new Safe 'Script';
1.3       albertel   50:   
1.5     ! albertel   51:   my $parsereval = new Safe 'Parser';
1.3       albertel   52:   
1.5     ! albertel   53:   my $parser=HTML::TokeParser->new(\$parsestring);
        !            54:   
        !            55:   my $outtext='';
1.3       albertel   56:   
1.1       albertel   57: # ---------------------------------------------------------------- Handled tags
                     58: 
1.5     ! albertel   59:   my %toptoplevel  = ( 'problem'    => 'Problem',
        !            60: 		       'entryform'  => 'Entry Form',
        !            61: 		       'survey'     => 'Survey',
        !            62: 		       'graded'     => 'Manually Graded' );
1.3       albertel   63:   
                     64:   
1.2       harris41   65: # --------------------------------------------------------------- Toplevel Tags
1.1       albertel   66: 
1.5     ! albertel   67:   my %topleveltags = ( 'block'   => 'Condition Block',
        !            68: 		       'part'    => 'Problem Part',
        !            69: 		       'include' => 'Include Section',
        !            70: 		       'answer'  => 'Answerfield',
        !            71: 		       'script'  => 'Script', 
        !            72: 		       'outtext' => 'Text Block' );
1.2       harris41   73:  
                     74: # ---------------------------------------------------------- Preregistered Tags
1.1       albertel   75: 
1.5     ! albertel   76:   my %includetags  = ( 'scriptlib' => 'Script Library',
        !            77: 		       'parserlib' => 'Parser Library' );
1.3       albertel   78: # -------------------------------------------------------------Answer type Tags
                     79: 
1.5     ! albertel   80:   my %answertags   = ( 'capaanswer' => 'CAPA Standard Answers');
1.2       harris41   81: 
                     82: # -------------------------------------------------------------------- All Tags
                     83: 
1.1       albertel   84: 
1.5     ! albertel   85:   my %xmltags      = ( %includetags, %topleveltags, %toptoplevel, %answertags );
1.3       albertel   86:   
1.5     ! albertel   87:   my $toplevel     = '';
        !            88:   my $above        = '';
1.3       albertel   89:   
1.1       albertel   90: # --------------------------------------------------- Depth counter for editing
                     91: 
1.5     ! albertel   92:   my @depthcounter=();
        !            93:   my $depth=-1;
        !            94:   my $olddepth=-1;
1.1       albertel   95: 
                     96: # ----------------------------------------------------------------------- Stack
                     97: 
1.5     ! albertel   98:   my @stack=('');
1.1       albertel   99: 
                    100: # -------------------------------------------------------------- Init $saveeval
1.5     ! albertel  101: 
        !           102:   &init_safeeval($safeeval);
1.1       albertel  103: 
                    104: # ---------------------------------------------------------- Parse $parsestring
                    105: 
1.5     ! albertel  106:   my $token;
1.1       albertel  107: 
1.5     ! albertel  108:   while ($token=$parser->get_token) {n
1.2       harris41  109: # =============================================================================
1.5     ! albertel  110:     if ($token->[0] eq 'S') {
1.2       harris41  111: # =================================================================== Start Tag
                    112: # --------------------------------------------------------------- Depth Counter
1.5     ! albertel  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:       }  
1.2       harris41  124: # -----------------------------------------------------------------------------
                    125: 
                    126: 
1.5     ! albertel  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:       }
1.3       albertel  138:       
1.5     ! albertel  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);
1.3       albertel  150: 	    }
1.5     ! albertel  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); 
1.3       albertel  158: 	    }
1.5     ! albertel  159: 	  } 
        !           160: 	} else {
        !           161: 	  $stack[$#stack].=$token->[4];
        !           162: 	}
        !           163:       }
        !           164:       
        !           165:       if ($target eq 'modified') {
        !           166:       }
        !           167: 
1.2       harris41  168: # =============================================================================
1.5     ! albertel  169:     } elsif ($token->[0] eq 'E') {
1.2       harris41  170: # ===================================================================== End Tag
                    171: 
1.5     ! albertel  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); 
1.3       albertel  191: 	    }
1.5     ! albertel  192: 	  } 
        !           193: 	} 
        !           194:       }
        !           195:       
        !           196:       if ($target eq 'modified') {
        !           197:       }
1.2       harris41  198: # --------------------------------------------------------------- Depth Counter
1.5     ! albertel  199:       if (defined($xmltags{$token->[1]})) { $depth--; }
1.2       harris41  200: # -----------------------------------------------------------------------------
                    201: # =============================================================================
1.5     ! albertel  202:     } elsif ($token->[0] eq 'T') {
1.2       harris41  203: # ================================================================= Parsed Text
1.5     ! albertel  204:       $stack[$#stack].=$token->[1];
1.3       albertel  205:     }
1.5     ! albertel  206:   }
        !           207: 
        !           208:   return $outtext;
1.1       albertel  209: }
                    210: # =============================================================================
                    211: 
1.2       harris41  212: # --------------------------------------------------------------- Execute Token
1.1       albertel  213: 
                    214: 
                    215: 
                    216: # ------------------------------------------------- Helper Routines for Editing
                    217: 
                    218: sub rawprint {
1.5     ! albertel  219:   my ($r,$data)=@_;
1.3       albertel  220:   $r->print($data);
1.1       albertel  221: }
                    222: 
                    223: sub insertmenu {
1.5     ! albertel  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) {
1.3       albertel  233:     &rawprint($r,"\n".
1.5     ! albertel  234: 	      '<option value="insert_'.$key.'">Insert '.
        !           235: 	      $$xmltagsref{$key}.'</option>');
        !           236:   }
        !           237:   &rawprint($r,"\n".'</select></td></tr></table><br>'."\n");
1.1       albertel  238: }
1.2       harris41  239: 
                    240: # =============================================================================
                    241: # ================================================ Routines for Safe Evaluation
                    242: # =============================================================================
                    243: 
                    244: # -------------------------------------------- Initialize routines in $safeeval
                    245: 
                    246: sub init_safeeval {
1.5     ! albertel  247:   my $safeeval=shift;
        !           248:   my $initprg=<<'ENDINIT'; 
1.2       harris41  249: 
                    250: # -------------------------------------------- Initializations inside $safeeval
                    251: 
1.5     ! albertel  252:   $e=25;
        !           253:   $c=20;
1.2       harris41  254: 
1.3       albertel  255:   ENDINIT
1.2       harris41  256: # ---------------------------------------------------------------- Execute that
1.3       albertel  257:     $safeeval->reval($initprg);
1.2       harris41  258: }
                    259: 
                    260: # ----------------------------------------------- Routines that use Safe Spaces
1.1       albertel  261: 
                    262: sub printout {
1.5     ! albertel  263:   my ($r,$data,$safespace)=@_;
        !           264:   $r->print($safespace->reval('return qq('.$data.');'));
1.1       albertel  265: }
                    266: 
                    267: sub runfile {
1.5     ! albertel  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:   }   
1.1       albertel  279: }
                    280: 
                    281: sub run {
1.5     ! albertel  282:   my ($expression,$safespace)=@_;
        !           283:   $safespace->reval($expression);   
1.1       albertel  284: }
                    285: 
                    286: sub booleanexpr {
1.5     ! albertel  287:   my ($expression,$safespace)=@_;
        !           288:   return $safespace->reval('return '.$expression.';');
1.1       albertel  289: }
                    290: 
1.2       harris41  291: 
                    292: # =============================================================================
                    293: # ================================================== Tag Handlers for Rendering
                    294: # =============================================================================
1.1       albertel  295: 
                    296: sub start_block {
1.5     ! albertel  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--;
1.3       albertel  308: 	}
1.5     ! albertel  309:       }
1.3       albertel  310:     }
1.5     ! albertel  311:   }
        !           312:   return;
1.1       albertel  313: }
                    314: 
                    315: sub start_script {
1.5     ! albertel  316:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
        !           317:   $stackref->[$#$stackref+1]='';
1.1       albertel  318: }
                    319: 
                    320: sub end_script {
1.5     ! albertel  321:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
        !           322:   &run($stackref->[$#$stackref],$safeeval);
        !           323:   $#$stackref--;
1.1       albertel  324: }
                    325: 
                    326: sub start_outtext {
1.5     ! albertel  327:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
        !           328:   $stackref->[$#$stackref+1]='';
1.1       albertel  329: }
                    330: 
                    331: sub end_outtext {
1.5     ! albertel  332:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
        !           333:   &printout($r,$stackref->[$#$stackref],$safeeval);
        !           334:   $#$stackref--;
1.1       albertel  335: }
                    336: 
                    337: sub start_inlinetext {
1.5     ! albertel  338:   &start_outtext(@_);
1.1       albertel  339: }
                    340: 
                    341: sub end_inlinetext {
1.5     ! albertel  342:   &end_outtext(@_);
1.1       albertel  343: }
                    344: 
1.2       harris41  345: sub start_scriptlib {
1.5     ! albertel  346:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
        !           347:   &runfile($r,$parser->get_text('/scriptlib'),$safeeval);
1.2       harris41  348: }
                    349: 
                    350: sub start_parserlib {
1.5     ! albertel  351:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
        !           352:   &runfile($r,$parser->get_text('/parserlib'),$parsereval);
1.1       albertel  353: }
                    354: 
1.2       harris41  355: 
1.1       albertel  356: sub start_answer {
1.5     ! albertel  357:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
        !           358:   $stackref->[$#$stackref+1]='<answer>::'.
        !           359:     join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});   
        !           360:   $stackref->[$#$stackref+1]='';
1.1       albertel  361: }
                    362: 
                    363: sub end_answer {
1.5     ! albertel  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]);
1.1       albertel  372: }
                    373: 
                    374: sub start_item {
1.5     ! albertel  375:   my ($r,$token,$parser,$safeeval,$stackref)=@_;
        !           376:   $stackref->[$#$stackref+1]='<item>::'.
        !           377:     join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});   
        !           378:   $stackref->[$#$stackref+1]='';
1.1       albertel  379: }
                    380: 
                    381: sub end_item {}
                    382: 
1.2       harris41  383: # =============================================================================
                    384: # ==================================================== Tag Handlers for Editing
                    385: # =============================================================================
1.1       albertel  386: 
                    387: sub start_edit_outtext {
1.5     ! albertel  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]='';
1.1       albertel  393: }
                    394: 
                    395: sub end_edit_outtext {
1.5     ! albertel  396:   my ($r,$token,$above,$stackref)=@_;
        !           397:   &rawprint($r,$stackref->[$#$stackref]."</textarea>\n");   
        !           398:   $#$stackref--;
1.1       albertel  399: }
                    400: 
                    401: sub start_edit_script {
1.5     ! albertel  402:   &start_edit_outtext(@_);
1.1       albertel  403: }
                    404: 
                    405: sub end_edit_script {
1.5     ! albertel  406:   &end_edit_outtext(@_);
1.1       albertel  407: }
                    408: 
                    409: sub start_edit_inlinetext {
1.5     ! albertel  410:   &start_edit_outtext(@_);
1.1       albertel  411: }
                    412: 
                    413: sub end_edit_inlinetext {
1.5     ! albertel  414:   &end_edit_inlinetext(@_);
1.1       albertel  415: }
                    416: 
                    417: sub start_edit_block {
1.5     ! albertel  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>');
1.1       albertel  428: }
                    429: 
                    430: sub end_edit_block {
1.5     ! albertel  431:   my ($r,$token,$above,$stackref)=@_;
        !           432:   &rawprint($r,"\n".'</td></tr></table><br>');
1.1       albertel  433: }
                    434: 
                    435: sub start_edit_answer {
1.5     ! albertel  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");
1.1       albertel  448: }
                    449: 
                    450: sub end_edit_answer {
1.5     ! albertel  451:   my ($r,$token,$above,$stackref)=@_;
        !           452:   end_edit_block(@_);
1.1       albertel  453: }
                    454: 
                    455: sub start_edit_include {
1.5     ! albertel  456:   start_edit_block(@_);
1.1       albertel  457: }
                    458: 
                    459: sub end_edit_include {
1.5     ! albertel  460:   end_edit_block(@_);
1.1       albertel  461: }
                    462: 
                    463: sub start_edit_problem {
1.5     ! albertel  464:   start_edit_block(@_);
1.1       albertel  465: }
                    466: 
                    467: sub end_edit_problem {
1.5     ! albertel  468:   end_edit_block(@_);
1.1       albertel  469: }
                    470: 
                    471: 1;
                    472: __END__
1.3       albertel  473:   
1.1       albertel  474: 
                    475: 
                    476: 
                    477: 
                    478: 
                    479: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>