1: # The LON-CAPA problem handler
2: #
3: # Problem Handler
4: #
5: # 12/15-01/21,01/24 Gerd Kortemeyer
6: # 4/12 Guy Albertelli
7: # 8/6 Scott Harrison
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 {
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
40: }
41:
42: # ============================================================= Parsing Routine
43: # Takes $parsestring and $target
44: sub xmlparse {
45:
46: my ($r,$parsestring,$target) = @_;
47:
48: my $safeeval = new Safe 'Script';
49:
50: my $parsereval = new Safe 'Parser';
51:
52: my $parser=HTML::TokeParser->new(\$parsestring);
53:
54: my $outtext='';
55:
56: # ---------------------------------------------------------------- Handled tags
57:
58: my %toptoplevel = ( 'problem' => 'Problem',
59: 'entryform' => 'Entry Form',
60: 'survey' => 'Survey',
61: 'graded' => 'Manually Graded' );
62:
63:
64: # --------------------------------------------------------------- Toplevel Tags
65:
66: my %topleveltags = ( 'block' => 'Condition Block',
67: 'part' => 'Problem Part',
68: 'include' => 'Include Section',
69: 'answer' => 'Answerfield',
70: 'script' => 'Script',
71: 'outtext' => 'Text Block' );
72:
73: # ---------------------------------------------------------- Preregistered Tags
74:
75: my %includetags = ( 'scriptlib' => 'Script Library',
76: 'parserlib' => 'Parser Library' );
77: # -------------------------------------------------------------Answer type Tags
78:
79: my %answertags = ( 'capaanswer' => 'CAPA Standard Answers');
80:
81: # -------------------------------------------------------------------- All Tags
82:
83:
84: my %xmltags = ( %includetags, %topleveltags, %toptoplevel,
85: %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) {
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>::') &&
369: ($stackpointer > 0)) {
370: $stackpointer--;
371: }
372: my %answerargs=split(/:/,$stackref->[$stackpointer]);
373: }
374:
375: sub start_item {
376: my ($r,$token,$parser,$safeeval,$stackref) = @_;
377: $stackref->[$#$stackref+1] = '<item>::'.
378: join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
379: $stackref->[$#$stackref+1]='';
380: }
381:
382: sub end_item {}
383:
384: # =============================================================================
385: # ==================================================== Tag Handlers for Editing
386: # =============================================================================
387:
388: sub start_edit_outtext {
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] = '';
394: }
395:
396: sub end_edit_outtext {
397: my ($r,$token,$above,$stackref) = @_;
398: &rawprint($r,$stackref->[$#$stackref]."</textarea>\n");
399: $#$stackref--;
400: }
401:
402: sub start_edit_script {
403: &start_edit_outtext(@_);
404: }
405:
406: sub end_edit_script {
407: &end_edit_outtext(@_);
408: }
409:
410: sub start_edit_inlinetext {
411: &start_edit_outtext(@_);
412: }
413:
414: sub end_edit_inlinetext {
415: &end_edit_inlinetext(@_);
416: }
417:
418: sub start_edit_block {
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>');
429: }
430:
431: sub end_edit_block {
432: my ($r,$token,$above,$stackref) = @_;
433: &rawprint($r,"\n".'</td></tr></table><br>');
434: }
435:
436: sub start_edit_answer {
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");
449: }
450:
451: sub end_edit_answer {
452: my ($r,$token,$above,$stackref)=@_;
453: end_edit_block(@_);
454: }
455:
456: sub start_edit_include {
457: start_edit_block(@_);
458: }
459:
460: sub end_edit_include {
461: end_edit_block(@_);
462: }
463:
464: sub start_edit_problem {
465: start_edit_block(@_);
466: }
467:
468: sub end_edit_problem {
469: end_edit_block(@_);
470: }
471:
472: 1;
473:
474: __END__
475:
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