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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>