Annotation of loncom/homework/lonproblem.pm, revision 1.2
1.1 albertel 1: # The LearningOnline Network with CAPA
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
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:
1.2 ! harris41 40: # =============================================================================
1.1 albertel 41: # ============================================================= Parsing Routine
42: # Takes $parsestring and $target
1.2 ! harris41 43: # =============================================================================
1.1 albertel 44:
45: sub xmlparse {
46:
47: my ($r,$parsestring,$target) = @_;
48:
1.2 ! harris41 49: my $safeeval = new Safe 'Script';
! 50:
! 51: my $parsereval = new Safe 'Parser';
1.1 albertel 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',
1.2 ! harris41 61: 'survey' => 'Survey',
! 62: 'graded' => 'Manually Graded' );
1.1 albertel 63:
64:
1.2 ! harris41 65: # --------------------------------------------------------------- Toplevel Tags
1.1 albertel 66:
67: my %topleveltags = ( 'block' => 'Condition Block',
1.2 ! harris41 68: 'part' => 'Problem Part';
1.1 albertel 69: 'include' => 'Include Section',
1.2 ! harris41 70: 'answer' => 'Answerfield';
1.1 albertel 71: 'script' => 'Script',
72: 'outtext' => 'Text Block' );
1.2 ! harris41 73:
! 74: # ---------------------------------------------------------- Preregistered Tags
1.1 albertel 75:
1.2 ! harris41 76: my %includetags = ( 'scriptlib' => 'Script Library',
! 77: 'parserlib' => 'Parser Library' );
! 78:
! 79: # -------------------------------------------------------------------- All Tags
! 80:
! 81: my %xmltags = ( %includetags, %topleveltags, %toptoplevel );
1.1 albertel 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:
1.2 ! harris41 98: &init_safeeval($safeeval);
1.1 albertel 99:
100: # ---------------------------------------------------------- Parse $parsestring
101:
102: my $token;
103:
104: while ($token=$parser->get_token) {
1.2 ! harris41 105: # =============================================================================
1.1 albertel 106: if ($token->[0] eq 'S') {
1.2 ! harris41 107: # =================================================================== Start Tag
! 108: # --------------------------------------------------------------- Depth Counter
1.1 albertel 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: }
1.2 ! harris41 120: # -----------------------------------------------------------------------------
! 121:
! 122:
1.1 albertel 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: }
1.2 ! harris41 134:
1.1 albertel 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: }
1.2 ! harris41 160:
1.1 albertel 161: if ($target eq 'modified') {
162: }
1.2 ! harris41 163:
! 164: # =============================================================================
1.1 albertel 165: } elsif ($token->[0] eq 'E') {
1.2 ! harris41 166: # ===================================================================== End Tag
! 167:
1.1 albertel 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: }
1.2 ! harris41 179:
1.1 albertel 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: }
1.2 ! harris41 191:
1.1 albertel 192: if ($target eq 'modified') {
193: }
1.2 ! harris41 194: # --------------------------------------------------------------- Depth Counter
1.1 albertel 195: if (defined($xmltags{$token->[1]})) { $depth--; }
1.2 ! harris41 196: # -----------------------------------------------------------------------------
! 197: # =============================================================================
1.1 albertel 198: } elsif ($token->[0] eq 'T') {
1.2 ! harris41 199: # ================================================================= Parsed Text
1.1 albertel 200: $stack[$#stack].=$token->[1];
201: }
202: }
203:
204: return $outtext;
205: }
206: # =============================================================================
207:
1.2 ! harris41 208: # --------------------------------------------------------------- Execute Token
1.1 albertel 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: }
1.2 ! harris41 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
1.1 albertel 257:
258: sub printout {
1.2 ! harris41 259: my ($r,$data,$safespace)=@_;
! 260: $r->print($safespace->reval('return qq('.$data.');'));
1.1 albertel 261: }
262:
263: sub runfile {
1.2 ! harris41 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: }
1.1 albertel 275: }
276:
277: sub run {
1.2 ! harris41 278: my ($expression,$safespace)=@_;
! 279: $safespace->reval($expression);
1.1 albertel 280: }
281:
282: sub booleanexpr {
1.2 ! harris41 283: my ($expression,$safespace)=@_;
! 284: return $safespace->reval('return '.$expression.';');
1.1 albertel 285: }
286:
1.2 ! harris41 287:
! 288: # =============================================================================
! 289: # ================================================== Tag Handlers for Rendering
! 290: # =============================================================================
1.1 albertel 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:
1.2 ! harris41 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 {
1.1 albertel 347: my ($r,$token,$parser,$safeeval,$stackref)=@_;
1.2 ! harris41 348: &runfile($r,$parser->get_text('/parserlib'),$parsereval);
1.1 albertel 349: }
350:
1.2 ! harris41 351:
1.1 albertel 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:
1.2 ! harris41 379: # =============================================================================
! 380: # ==================================================== Tag Handlers for Editing
! 381: # =============================================================================
1.1 albertel 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:
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