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