1: # The LearningOnline Network with CAPA
2: # Problem Handler
3: #
4: # 12/15-01/21 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: # ============================================================= Parsing Routine
41: # Takes $parsestring and $target
42:
43: sub xmlparse {
44:
45: my ($r,$parsestring,$target) = @_;
46:
47: my $safeeval = new Safe;
48:
49: my $parser=HTML::TokeParser->new(\$parsestring);
50:
51: my $outtext='';
52:
53: # ---------------------------------------------------------------- Handled tags
54:
55: my %toptoplevel = ( 'problem' => 'Problem',
56: 'entryform' => 'Entry Form',
57: 'survey' => 'Survey' );
58:
59: my %answertags = ( 'item' => 'Question Item',
60: 'inlinetext' => 'Inline Text' );
61:
62: my %includetags = ( 'codelib' => 'Code Library' );
63:
64: my %topleveltags = ( 'block' => 'Condition Block',
65: 'answer' => 'Answer Field',
66: 'include' => 'Include Section',
67: 'script' => 'Script',
68: 'outtext' => 'Text Block' );
69:
70: my %xmltags = ( %answertags, %includetags,
71: %topleveltags, %toptoplevel );
72:
73: my $toplevel = '';
74: my $above = '';
75:
76: my %answertypes = ( 'true_false' => 'True/False',
77: 'multiple_choice' => 'Multiple Choice',
78: 'numerical' => 'Numerical',
79: 'numerical_units' => 'Numerical with Units' );
80:
81: # --------------------------------------------------- Depth counter for editing
82:
83: my @depthcounter=();
84: my $depth=-1;
85: my $olddepth=-1;
86:
87: # ----------------------------------------------------------------------- Stack
88:
89: my @stack=('');
90:
91: # -------------------------------------------------------------- Init $saveeval
92:
93: if ($target eq 'web') {
94: &init_safeeval($safeeval);
95: }
96:
97: # ---------------------------------------------------------- Parse $parsestring
98:
99: my $token;
100:
101: while ($token=$parser->get_token) {
102: if ($token->[0] eq 'S') {
103: # ------------------------------------------------------------------- Start Tag
104: if (defined($xmltags{$token->[1]})) {
105: if ($depth<$olddepth-1) {
106: $#depthcounter--;
107: $olddepth=$depth;
108: }
109: $depth++;
110: $depthcounter[$depth]++;
111: if ($depthcounter[$depth]==1) {
112: $olddepth=$depth;
113: }
114: }
115: if ($target eq 'web') {
116: my $sub="start_$token->[1]";
117: {
118: no strict 'refs';
119: if (defined (&$sub)) {
120: &$sub($r,$token,$parser,$safeeval,\@stack);
121: } else {
122: $stack[$#stack].=$token->[4];
123: }
124: }
125: }
126: if ($target eq 'edit') {
127: my $depthlabel=join('_',@depthcounter);
128: if (defined($xmltags{$token->[1]})) {
129: if (defined($topleveltags{$token->[1]})) {
130: &insertmenu($r,$xmltags{$token->[1]},
131: $depthlabel,\%topleveltags);
132: $toplevel=$token->[1];
133: } else {
134: if ($toplevel eq 'answer') {
135: &insertmenu($r,$xmltags{$token->[1]},
136: $depthlabel,\%answertags);
137: }
138: }
139: my $sub="start_edit_$token->[1]";
140: {
141: no strict 'refs';
142: if (defined (&$sub)) {
143: &$sub($r,$token,$parser,$xmltags{$token->[1]},
144: $depthlabel,$above,\%answertypes,\@stack);
145: }
146: }
147: } else {
148: $stack[$#stack].=$token->[4];
149: }
150: }
151: if ($target eq 'modified') {
152: }
153: } elsif ($token->[0] eq 'E') {
154: # --------------------------------------------------------------------- End Tag
155: if ($target eq 'web') {
156: my $sub="end_$token->[1]";
157: {
158: no strict 'refs';
159: if (defined (&$sub)) {
160: &$sub($r,$token,$parser,$safeeval,\@stack);
161: } else {
162: $stack[$#stack].=$token->[2];
163: }
164: }
165: }
166: if ($target eq 'edit') {
167: if (defined($xmltags{$token->[1]})) {
168: my $sub="end_edit_$token->[1]";
169: {
170: no strict 'refs';
171: if (defined (&$sub)) {
172: &$sub($r,$token,$above,\@stack);
173: }
174: }
175: }
176: }
177: if ($target eq 'modified') {
178: }
179: if (defined($xmltags{$token->[1]})) { $depth--; }
180: } elsif ($token->[0] eq 'T') {
181: # ------------------------------------------------------------------------ Text
182: $stack[$#stack].=$token->[1];
183: }
184: }
185:
186: return $outtext;
187: }
188: # =============================================================================
189:
190: # -------------------------------------------- Initialize routines in $safeeval
191:
192: sub init_safeeval {
193: my $safeeval=shift;
194: my $initprg=<<'ENDINIT';
195:
196: # -------------------------------------------- Initializations inside $safeeval
197:
198: $e=25;
199: $c=20;
200:
201: ENDINIT
202: # ---------------------------------------------------------------- Execute that
203: $safeeval->reval($initprg);
204: }
205:
206: # ------------------------------------------------- Helper Routines for Editing
207:
208: sub rawprint {
209: my ($r,$data)=@_;
210: $r->print($data);
211: }
212:
213: sub insertmenu {
214: my ($r,$description,$depthlabel,$xmltagsref)=@_;
215: &rawprint($r,'<br><table bgcolor="#DDDD33" width="100%"><tr><td>');
216: &rawprint($r,"\n".'<select name="mod_menu_'.$depthlabel.'">'."\n");
217: &rawprint($r,'<option value="no_changes" selected>(no changes)</option>');
218: &rawprint($r,"\n".
219: '<option value="delete">Delete '.$description.
220: ' Below</option>');
221: my $key;
222: foreach $key (keys %$xmltagsref) {
223: &rawprint($r,"\n".
224: '<option value="insert_'.$key.'">Insert '.
225: $$xmltagsref{$key}.'</option>');
226: }
227: &rawprint($r,"\n".'</select></td></tr></table><br>'."\n");
228: }
229:
230: # ----------------------------------------------- Helper Routines for Renderers
231:
232: sub printout {
233: my ($r,$data,$safeeval)=@_;
234: $r->print($safeeval->reval('return qq('.$data.');'));
235: }
236:
237: sub runfile {
238: my ($r,$filename,$safeeval)=@_;
239: my $includespath=$r->dir_config('lonIncludes');
240: $safeeval->rdo($includespath.'/'.$filename);
241: }
242:
243: sub run {
244: my ($expression,$safeeval)=@_;
245: $safeeval->reval($expression);
246: }
247:
248: sub booleanexpr {
249: my ($expression,$safeeval)=@_;
250: return $safeeval->reval('return '.$expression.';');
251: }
252:
253: # -------------------------------------------------- Tag Handlers for Rendering
254:
255: sub start_block {
256: my ($r,$token,$parser,$safeeval,$stackref)=@_;
257: if (!booleanexpr($token->[2]{'condition'},$safeeval)) {
258: my $blockdepth=0;
259: my $nexttoken;
260: while ($nexttoken=$parser->get_tag()) {
261: if ($nexttoken->[0] eq 'block') { $blockdepth++ };
262: if ($nexttoken->[0] eq '/block') {
263: if ($blockdepth==0) {
264: return;
265: } else {
266: $blockdepth--;
267: }
268: }
269: }
270: }
271: return;
272: }
273:
274: sub start_script {
275: my ($r,$token,$parser,$safeeval,$stackref)=@_;
276: $stackref->[$#$stackref+1]='';
277: }
278:
279: sub end_script {
280: my ($r,$token,$parser,$safeeval,$stackref)=@_;
281: &run($stackref->[$#$stackref],$safeeval);
282: $#$stackref--;
283: }
284:
285: sub start_outtext {
286: my ($r,$token,$parser,$safeeval,$stackref)=@_;
287: $stackref->[$#$stackref+1]='';
288: }
289:
290: sub end_outtext {
291: my ($r,$token,$parser,$safeeval,$stackref)=@_;
292: &printout($r,$stackref->[$#$stackref],$safeeval);
293: $#$stackref--;
294: }
295:
296: sub start_inlinetext {
297: &start_outtext(@_);
298: }
299:
300: sub end_inlinetext {
301: &end_outtext(@_);
302: }
303:
304: sub start_codelib {
305: my ($r,$token,$parser,$safeeval,$stackref)=@_;
306: &runfile($r,$parser->get_text('/codelib'),$safeeval);
307: }
308:
309: sub start_answer {
310: my ($r,$token,$parser,$safeeval,$stackref)=@_;
311: $stackref->[$#$stackref+1]='<answer>::'.
312: join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
313: $stackref->[$#$stackref+1]='';
314: }
315:
316: sub end_answer {
317: my ($r,$token,$parser,$safeeval,$stackref)=@_;
318: my @itemtexts;
319: my @itemargs;
320: my $stackpointer=$#$stackref;
321: while (($stackref->[$stackpointer]!~'<answer>::') && ($stackpointer>0)) {
322: $stackpointer--;
323: }
324: my %answerargs=split(/:/,$stackref->[$stackpointer]);
325: }
326:
327: sub start_item {
328: my ($r,$token,$parser,$safeeval,$stackref)=@_;
329: $stackref->[$#$stackref+1]='<item>::'.
330: join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
331: $stackref->[$#$stackref+1]='';
332: }
333:
334: sub end_item {}
335:
336: # ------------------------------------------------------------ Edit Tag Handler
337:
338: sub start_edit_outtext {
339: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
340: $stackref)=@_;
341: &rawprint($r,"\n<h3>$description</h3>".
342: '<textarea rows="10" cols="80" name="data_'.$depthlabel.'">');
343: $stackref->[$#$stackref+1]='';
344: }
345:
346: sub end_edit_outtext {
347: my ($r,$token,$above,$stackref)=@_;
348: &rawprint($r,$stackref->[$#$stackref]."</textarea>\n");
349: $#$stackref--;
350: }
351:
352: sub start_edit_script {
353: &start_edit_outtext(@_);
354: }
355:
356: sub end_edit_script {
357: &end_edit_outtext(@_);
358: }
359:
360: sub start_edit_inlinetext {
361: &start_edit_outtext(@_);
362: }
363:
364: sub end_edit_inlinetext {
365: &end_edit_inlinetext(@_);
366: }
367:
368: sub start_edit_block {
369: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
370: $stackref)=@_;
371: my $bgcolor=$depthlabel;
372: $bgcolor=~s/\_//g;
373: $bgcolor=substr(length($bgcolor),-1,1);
374: $bgcolor=~tr/1-5/A-E/;
375: $bgcolor=$bgcolor.'FFF'.$bgcolor.'A';
376: &rawprint($r,"\n".'<br><table border="2" cellpadding="10" bgcolor="#'.
377: $bgcolor.
378: '" width="100%"><tr><td><h3>'.$description.'</h3>');
379: }
380:
381: sub end_edit_block {
382: my ($r,$token,$above,$stackref)=@_;
383: &rawprint($r,"\n".'</td></tr></table><br>');
384: }
385:
386: sub start_edit_answer {
387: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
388: $stackref)=@_;
389: start_edit_block(@_);
390: $above=$token->[2]{'type'};
391: &rawprint($r,"\n".'<select name="mod_type_'.$depthlabel.'">');
392: my $key;
393: foreach $key (keys %$answertyperef) {
394: &rawprint($r,"\n".'<option value="'.$key.'"');
395: if ($above eq $key) { &rawprint($r,' selected'); }
396: &rawprint($r,'>'.$$answertyperef{$key}.'</option>');
397: }
398: &rawprint($r,"\n".'</select>'."\n");
399: }
400:
401: sub end_edit_answer {
402: my ($r,$token,$above,$stackref)=@_;
403: end_edit_block(@_);
404: }
405:
406: sub start_edit_include {
407: start_edit_block(@_);
408: }
409:
410: sub end_edit_include {
411: end_edit_block(@_);
412: }
413:
414: sub start_edit_problem {
415: start_edit_block(@_);
416: }
417:
418: sub end_edit_problem {
419: end_edit_block(@_);
420: }
421:
422: 1;
423: __END__
424:
425:
426:
427:
428:
429:
430:
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