Annotation of loncom/homework/lonproblem.pm, revision 1.4
1.4 ! harris41 1: # The LON-CAPA problem handler
! 2: #
1.1 albertel 3: # Problem Handler
4: #
1.2 harris41 5: # 12/15-01/21,01/24 Gerd Kortemeyer
1.4 ! harris41 6: # 4/12 Guy Albertelli
! 7: # 8/6 Scott Harrison
1.1 albertel 8:
9: package Apache::lonproblem;
10:
11: use strict;
12: use HTML::TokeParser;
13: use Safe;
14: use Apache::File;
15:
16: # ================================================================ Main Handler
17: sub handler {
1.4 ! harris41 18: my $r=shift;
! 19: my @parsecontents;
! 20: my $parsestring;
! 21: my $outstring;
! 22:
! 23: {
! 24: my $fh=Apache::File->new($r->filename);
! 25: @parsecontents=<$fh>;
! 26: }
! 27:
! 28: $parsestring=join('',@parsecontents);
! 29:
! 30: print "<form>";
! 31:
! 32: &xmlparse($r,$parsestring,'web');
! 33:
! 34: print "\n---------------\n";
! 35: print "<form>";
! 36: &xmlparse($r,$parsestring,'edit');
! 37: $outstring=xmlparse($parsestring,'modified');
! 38: print "\n---------------\n$outstring\n";
! 39: return 1; #change to ok
1.1 albertel 40: }
41:
42: # ============================================================= Parsing Routine
43: # Takes $parsestring and $target
44: sub xmlparse {
1.3 albertel 45:
1.4 ! harris41 46: my ($r,$parsestring,$target) = @_;
1.3 albertel 47:
1.4 ! harris41 48: my $safeeval = new Safe 'Script';
1.3 albertel 49:
1.4 ! harris41 50: my $parsereval = new Safe 'Parser';
! 51:
! 52: my $parser=HTML::TokeParser->new(\$parsestring);
1.3 albertel 53:
1.4 ! harris41 54: my $outtext='';
1.3 albertel 55:
1.1 albertel 56: # ---------------------------------------------------------------- Handled tags
57:
1.4 ! harris41 58: my %toptoplevel = ( 'problem' => 'Problem',
! 59: 'entryform' => 'Entry Form',
! 60: 'survey' => 'Survey',
! 61: 'graded' => 'Manually Graded' );
1.3 albertel 62:
63:
1.2 harris41 64: # --------------------------------------------------------------- Toplevel Tags
1.1 albertel 65:
1.4 ! harris41 66: my %topleveltags = ( 'block' => 'Condition Block',
! 67: 'part' => 'Problem Part',
! 68: 'include' => 'Include Section',
! 69: 'answer' => 'Answerfield',
! 70: 'script' => 'Script',
! 71: 'outtext' => 'Text Block' );
1.2 harris41 72:
73: # ---------------------------------------------------------- Preregistered Tags
1.1 albertel 74:
1.4 ! harris41 75: my %includetags = ( 'scriptlib' => 'Script Library',
! 76: 'parserlib' => 'Parser Library' );
1.3 albertel 77: # -------------------------------------------------------------Answer type Tags
78:
1.4 ! harris41 79: my %answertags = ( 'capaanswer' => 'CAPA Standard Answers');
1.2 harris41 80:
81: # -------------------------------------------------------------------- All Tags
82:
1.1 albertel 83:
1.4 ! harris41 84: my %xmltags = ( %includetags, %topleveltags, %toptoplevel,
! 85: %answertags );
1.3 albertel 86:
1.4 ! harris41 87: my $toplevel = '';
! 88: my $above = '';
1.3 albertel 89:
1.1 albertel 90: # --------------------------------------------------- Depth counter for editing
91:
1.4 ! harris41 92: my @depthcounter = ();
! 93: my $depth = -1;
! 94: my $olddepth = -1;
1.1 albertel 95:
96: # ----------------------------------------------------------------------- Stack
97:
1.4 ! harris41 98: my @stack = ('');
1.1 albertel 99:
100: # -------------------------------------------------------------- Init $saveeval
1.4 ! harris41 101:
! 102: &init_safeeval($safeeval);
1.1 albertel 103:
104: # ---------------------------------------------------------- Parse $parsestring
105:
1.4 ! harris41 106: my $token;
1.1 albertel 107:
1.4 ! harris41 108: while ($token = $parser->get_token) {
1.2 harris41 109: # =============================================================================
1.4 ! harris41 110: if ($token->[0] eq 'S') {
1.2 harris41 111: # =================================================================== Start Tag
112: # --------------------------------------------------------------- Depth Counter
1.4 ! harris41 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.4 ! harris41 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.4 ! harris41 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: }
1.3 albertel 163: }
1.4 ! harris41 164:
! 165: if ($target eq 'modified') {
1.3 albertel 166: }
1.4 ! harris41 167:
1.2 harris41 168: # =============================================================================
1.4 ! harris41 169: } elsif ($token->[0] eq 'E') {
1.2 harris41 170: # ===================================================================== End Tag
171:
1.4 ! harris41 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') {
1.3 albertel 197: }
1.2 harris41 198: # --------------------------------------------------------------- Depth Counter
1.4 ! harris41 199: if (defined($xmltags{$token->[1]})) { $depth--; }
1.2 harris41 200: # -----------------------------------------------------------------------------
201: # =============================================================================
1.4 ! harris41 202: } elsif ($token->[0] eq 'T') {
1.2 harris41 203: # ================================================================= Parsed Text
1.4 ! harris41 204: $stack[$#stack] .= $token->[1];
! 205: }
1.3 albertel 206: }
1.4 ! harris41 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.4 ! harris41 219: my ($r,$data) = @_;
1.3 albertel 220: $r->print($data);
1.1 albertel 221: }
222:
223: sub insertmenu {
1.4 ! harris41 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>');
1.3 albertel 228: &rawprint($r,"\n".
1.4 ! harris41 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");
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.4 ! harris41 247: my $safeeval = shift;
! 248: my $initprg =<<'ENDINIT';
1.2 harris41 249:
250: # -------------------------------------------- Initializations inside $safeeval
251:
1.4 ! harris41 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.4 ! harris41 263: my ($r,$data,$safespace) = @_;
! 264: $r->print($safespace->reval('return qq('.$data.');'));
1.1 albertel 265: }
266:
267: sub runfile {
1.4 ! harris41 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.4 ! harris41 282: my ($expression,$safespace) = @_;
! 283: $safespace->reval($expression);
1.1 albertel 284: }
285:
286: sub booleanexpr {
1.4 ! harris41 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.4 ! harris41 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: }
1.3 albertel 310: }
311: }
1.4 ! harris41 312: return;
1.1 albertel 313: }
314:
315: sub start_script {
1.4 ! harris41 316: my ($r,$token,$parser,$safeeval,$stackref) = @_;
! 317: $stackref->[$#$stackref+1] = '';
1.1 albertel 318: }
319:
320: sub end_script {
1.4 ! harris41 321: my ($r,$token,$parser,$safeeval,$stackref) = @_;
! 322: &run($stackref->[$#$stackref],$safeeval);
! 323: $#$stackref--;
1.1 albertel 324: }
325:
326: sub start_outtext {
1.4 ! harris41 327: my ($r,$token,$parser,$safeeval,$stackref) = @_;
! 328: $stackref->[$#$stackref+1] = '';
1.1 albertel 329: }
330:
331: sub end_outtext {
1.4 ! harris41 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.4 ! harris41 338: &start_outtext(@_);
1.1 albertel 339: }
340:
341: sub end_inlinetext {
1.4 ! harris41 342: &end_outtext(@_);
1.1 albertel 343: }
344:
1.2 harris41 345: sub start_scriptlib {
1.4 ! harris41 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.4 ! harris41 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.4 ! harris41 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.4 ! harris41 364: my ($r,$token,$parser,$safeeval,$stackref) = @_;
! 365: my @itemtexts;
! 366: my @itemargs;
! 367: my $stackpointer = $#$stackref;
! 368: while (($stackref->[$stackpointer] !~ '<answer>::') &&
! 369: ($stackpointer > 0)) {
! 370: $stackpointer--;
! 371: }
! 372: my %answerargs=split(/:/,$stackref->[$stackpointer]);
1.1 albertel 373: }
374:
375: sub start_item {
1.4 ! harris41 376: my ($r,$token,$parser,$safeeval,$stackref) = @_;
! 377: $stackref->[$#$stackref+1] = '<item>::'.
! 378: join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
! 379: $stackref->[$#$stackref+1]='';
1.1 albertel 380: }
381:
382: sub end_item {}
383:
1.2 harris41 384: # =============================================================================
385: # ==================================================== Tag Handlers for Editing
386: # =============================================================================
1.1 albertel 387:
388: sub start_edit_outtext {
1.4 ! harris41 389: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
! 390: $stackref) = @_;
! 391: &rawprint($r,"\n<h3>$description</h3>".
! 392: '<textarea rows="10" cols="80" name="data_'.$depthlabel.'">');
! 393: $stackref->[$#$stackref+1] = '';
1.1 albertel 394: }
395:
396: sub end_edit_outtext {
1.4 ! harris41 397: my ($r,$token,$above,$stackref) = @_;
! 398: &rawprint($r,$stackref->[$#$stackref]."</textarea>\n");
! 399: $#$stackref--;
1.1 albertel 400: }
401:
402: sub start_edit_script {
1.4 ! harris41 403: &start_edit_outtext(@_);
1.1 albertel 404: }
405:
406: sub end_edit_script {
1.4 ! harris41 407: &end_edit_outtext(@_);
1.1 albertel 408: }
409:
410: sub start_edit_inlinetext {
1.4 ! harris41 411: &start_edit_outtext(@_);
1.1 albertel 412: }
413:
414: sub end_edit_inlinetext {
1.4 ! harris41 415: &end_edit_inlinetext(@_);
1.1 albertel 416: }
417:
418: sub start_edit_block {
1.4 ! harris41 419: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
! 420: $stackref) = @_;
! 421: my $bgcolor = $depthlabel;
! 422: $bgcolor =~ s/\_//g;
! 423: $bgcolor = substr(length($bgcolor),-1,1);
! 424: $bgcolor =~ tr/1-5/A-E/;
! 425: $bgcolor = $bgcolor.'FFF'.$bgcolor.'A';
! 426: &rawprint($r,"\n".'<br><table border="2" cellpadding="10" bgcolor="#'.
! 427: $bgcolor.
! 428: '" width="100%"><tr><td><h3>'.$description.'</h3>');
1.1 albertel 429: }
430:
431: sub end_edit_block {
1.4 ! harris41 432: my ($r,$token,$above,$stackref) = @_;
! 433: &rawprint($r,"\n".'</td></tr></table><br>');
1.1 albertel 434: }
435:
436: sub start_edit_answer {
1.4 ! harris41 437: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
! 438: $stackref) = @_;
! 439: start_edit_block(@_);
! 440: $above = $token->[2]{'type'};
! 441: &rawprint($r,"\n".'<select name="mod_type_'.$depthlabel.'">');
! 442: my $key;
! 443: foreach $key (keys %$answertyperef) {
! 444: &rawprint($r,"\n".'<option value="'.$key.'"');
! 445: if ($above eq $key) { &rawprint($r,' selected'); }
! 446: &rawprint($r,'>'.$$answertyperef{$key}.'</option>');
! 447: }
! 448: &rawprint($r,"\n".'</select>'."\n");
1.1 albertel 449: }
450:
451: sub end_edit_answer {
1.4 ! harris41 452: my ($r,$token,$above,$stackref)=@_;
! 453: end_edit_block(@_);
1.1 albertel 454: }
455:
456: sub start_edit_include {
1.4 ! harris41 457: start_edit_block(@_);
1.1 albertel 458: }
459:
460: sub end_edit_include {
1.4 ! harris41 461: end_edit_block(@_);
1.1 albertel 462: }
463:
464: sub start_edit_problem {
1.4 ! harris41 465: start_edit_block(@_);
1.1 albertel 466: }
467:
468: sub end_edit_problem {
1.4 ! harris41 469: end_edit_block(@_);
1.1 albertel 470: }
471:
472: 1;
1.4 ! harris41 473:
1.1 albertel 474: __END__
1.3 albertel 475:
1.1 albertel 476:
477:
478:
479:
480:
481:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonproblem.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework