File:
[LON-CAPA] /
loncom /
homework /
Attic /
lonproblem.pm
Revision
1.6:
download - view:
text,
annotated -
select for diffs
Tue Dec 4 15:17:56 2001 UTC (22 years, 6 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_1_2_X,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
version_1_0_3,
version_1_0_2,
version_1_0_1,
version_1_0_0,
version_0_99_5,
version_0_99_4,
version_0_99_3,
version_0_99_2,
version_0_99_1,
version_0_99_0,
version_0_6_2,
version_0_6,
version_0_5_1,
version_0_5,
version_0_4,
stable_2002_spring,
stable_2002_july,
conference_2003,
STABLE,
HEAD
- GPL headers
1: # The LearningOnline Network with CAPA
2: # Problem Handler
3: #
4: # $Id: lonproblem.pm,v 1.6 2001/12/04 15:17:56 albertel Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: #
29: # 12/15-01/21,01/24 Gerd Kortemeyer
30:
31: package Apache::lonproblem;
32:
33: use strict;
34: use HTML::TokeParser;
35: use Safe;
36: use Apache::File;
37:
38: # ================================================================ Main Handler
39:
40: sub handler {
41: my $r=shift;
42: my @parsecontents;
43: my $parsestring;
44: my $outstring;
45:
46: {
47: my $fh=Apache::File->new($r->filename);
48: @parsecontents=<$fh>;
49: }
50:
51: $parsestring=join('',@parsecontents);
52:
53: print "<form>";
54:
55: &xmlparse($r,$parsestring,'web');
56:
57: print "\n---------------\n";
58: print "<form>";
59: &xmlparse($r,$parsestring,'edit');
60: $outstring=xmlparse($parsestring,'modified');
61: print "\n---------------\n$outstring\n";
62: return 1; #change to ok
63: }
64:
65: # =============================================================================
66: # ============================================================= Parsing Routine
67: # Takes $parsestring and $target
68: # =============================================================================
69:
70: sub xmlparse {
71:
72: my ($r,$parsestring,$target) = @_;
73:
74: my $safeeval = new Safe 'Script';
75:
76: my $parsereval = new Safe 'Parser';
77:
78: my $parser=HTML::TokeParser->new(\$parsestring);
79:
80: my $outtext='';
81:
82: # ---------------------------------------------------------------- Handled tags
83:
84: my %toptoplevel = ( 'problem' => 'Problem',
85: 'entryform' => 'Entry Form',
86: 'survey' => 'Survey',
87: 'graded' => 'Manually Graded' );
88:
89:
90: # --------------------------------------------------------------- Toplevel Tags
91:
92: my %topleveltags = ( 'block' => 'Condition Block',
93: 'part' => 'Problem Part',
94: 'include' => 'Include Section',
95: 'answer' => 'Answerfield',
96: 'script' => 'Script',
97: 'outtext' => 'Text Block' );
98:
99: # ---------------------------------------------------------- Preregistered Tags
100:
101: my %includetags = ( 'scriptlib' => 'Script Library',
102: 'parserlib' => 'Parser Library' );
103: # -------------------------------------------------------------Answer type Tags
104:
105: my %answertags = ( 'capaanswer' => 'CAPA Standard Answers');
106:
107: # -------------------------------------------------------------------- All Tags
108:
109:
110: my %xmltags = ( %includetags, %topleveltags, %toptoplevel, %answertags );
111:
112: my $toplevel = '';
113: my $above = '';
114:
115: # --------------------------------------------------- Depth counter for editing
116:
117: my @depthcounter=();
118: my $depth=-1;
119: my $olddepth=-1;
120:
121: # ----------------------------------------------------------------------- Stack
122:
123: my @stack=('');
124:
125: # -------------------------------------------------------------- Init $saveeval
126:
127: &init_safeeval($safeeval);
128:
129: # ---------------------------------------------------------- Parse $parsestring
130:
131: my $token;
132:
133: while ($token=$parser->get_token) {n
134: # =============================================================================
135: if ($token->[0] eq 'S') {
136: # =================================================================== Start Tag
137: # --------------------------------------------------------------- Depth Counter
138: if (defined($xmltags{$token->[1]})) {
139: if ($depth<$olddepth-1) {
140: $#depthcounter--;
141: $olddepth=$depth;
142: }
143: $depth++;
144: $depthcounter[$depth]++;
145: if ($depthcounter[$depth]==1) {
146: $olddepth=$depth;
147: }
148: }
149: # -----------------------------------------------------------------------------
150:
151:
152: if ($target eq 'web') {
153: my $sub="start_$token->[1]";
154: {
155: no strict 'refs';
156: if (defined (&$sub)) {
157: &$sub($r,$token,$parser,$safeeval,\@stack);
158: } else {
159: $stack[$#stack].=$token->[4];
160: }
161: }
162: }
163:
164: if ($target eq 'edit') {
165: my $depthlabel=join('_',@depthcounter);
166: if (defined($xmltags{$token->[1]})) {
167: if (defined($topleveltags{$token->[1]})) {
168: &insertmenu($r,$xmltags{$token->[1]},
169: $depthlabel,\%topleveltags);
170: $toplevel=$token->[1];
171: } else {
172: if ($toplevel eq 'answer') {
173: &insertmenu($r,$xmltags{$token->[1]},
174: $depthlabel,\%answertags);
175: }
176: }
177: my $sub="start_edit_$token->[1]";
178: {
179: no strict 'refs';
180: if (defined (&$sub)) {
181: &$sub($r,$token,$parser,$xmltags{$token->[1]},
182: $depthlabel,$above,\%answertypes,\@stack);
183: }
184: }
185: } else {
186: $stack[$#stack].=$token->[4];
187: }
188: }
189:
190: if ($target eq 'modified') {
191: }
192:
193: # =============================================================================
194: } elsif ($token->[0] eq 'E') {
195: # ===================================================================== End Tag
196:
197: if ($target eq 'web') {
198: my $sub="end_$token->[1]";
199: {
200: no strict 'refs';
201: if (defined (&$sub)) {
202: &$sub($r,$token,$parser,$safeeval,\@stack);
203: } else {
204: $stack[$#stack].=$token->[2];
205: }
206: }
207: }
208:
209: if ($target eq 'edit') {
210: if (defined($xmltags{$token->[1]})) {
211: my $sub="end_edit_$token->[1]";
212: {
213: no strict 'refs';
214: if (defined (&$sub)) {
215: &$sub($r,$token,$above,\@stack);
216: }
217: }
218: }
219: }
220:
221: if ($target eq 'modified') {
222: }
223: # --------------------------------------------------------------- Depth Counter
224: if (defined($xmltags{$token->[1]})) { $depth--; }
225: # -----------------------------------------------------------------------------
226: # =============================================================================
227: } elsif ($token->[0] eq 'T') {
228: # ================================================================= Parsed Text
229: $stack[$#stack].=$token->[1];
230: }
231: }
232:
233: return $outtext;
234: }
235: # =============================================================================
236:
237: # --------------------------------------------------------------- Execute Token
238:
239:
240:
241: # ------------------------------------------------- Helper Routines for Editing
242:
243: sub rawprint {
244: my ($r,$data)=@_;
245: $r->print($data);
246: }
247:
248: sub insertmenu {
249: my ($r,$description,$depthlabel,$xmltagsref)=@_;
250: &rawprint($r,'<br><table bgcolor="#DDDD33" width="100%"><tr><td>');
251: &rawprint($r,"\n".'<select name="mod_menu_'.$depthlabel.'">'."\n");
252: &rawprint($r,'<option value="no_changes" selected>(no changes)</option>');
253: &rawprint($r,"\n".
254: '<option value="delete">Delete '.$description.
255: ' Below</option>');
256: my $key;
257: foreach $key (keys %$xmltagsref) {
258: &rawprint($r,"\n".
259: '<option value="insert_'.$key.'">Insert '.
260: $$xmltagsref{$key}.'</option>');
261: }
262: &rawprint($r,"\n".'</select></td></tr></table><br>'."\n");
263: }
264:
265: # =============================================================================
266: # ================================================ Routines for Safe Evaluation
267: # =============================================================================
268:
269: # -------------------------------------------- Initialize routines in $safeeval
270:
271: sub init_safeeval {
272: my $safeeval=shift;
273: my $initprg=<<'ENDINIT';
274:
275: # -------------------------------------------- Initializations inside $safeeval
276:
277: $e=25;
278: $c=20;
279:
280: ENDINIT
281: # ---------------------------------------------------------------- Execute that
282: $safeeval->reval($initprg);
283: }
284:
285: # ----------------------------------------------- Routines that use Safe Spaces
286:
287: sub printout {
288: my ($r,$data,$safespace)=@_;
289: $r->print($safespace->reval('return qq('.$data.');'));
290: }
291:
292: sub runfile {
293: my ($r,$filename,$safespace)=@_;
294: my $includefile;
295: if ($filename=~/^\//) {
296: $includefile=$filename;
297: } else {
298: $includefile=$r->dir_config('lonIncludes');
299: $includefile.='/'.$filename;
300: }
301: if (-e $includefile) {
302: $safespace->rdo($includefile);
303: }
304: }
305:
306: sub run {
307: my ($expression,$safespace)=@_;
308: $safespace->reval($expression);
309: }
310:
311: sub booleanexpr {
312: my ($expression,$safespace)=@_;
313: return $safespace->reval('return '.$expression.';');
314: }
315:
316:
317: # =============================================================================
318: # ================================================== Tag Handlers for Rendering
319: # =============================================================================
320:
321: sub start_block {
322: my ($r,$token,$parser,$safeeval,$stackref)=@_;
323: if (!booleanexpr($token->[2]{'condition'},$safeeval)) {
324: my $blockdepth=0;
325: my $nexttoken;
326: while ($nexttoken=$parser->get_tag()) {
327: if ($nexttoken->[0] eq 'block') { $blockdepth++ };
328: if ($nexttoken->[0] eq '/block') {
329: if ($blockdepth==0) {
330: return;
331: } else {
332: $blockdepth--;
333: }
334: }
335: }
336: }
337: return;
338: }
339:
340: sub start_script {
341: my ($r,$token,$parser,$safeeval,$stackref)=@_;
342: $stackref->[$#$stackref+1]='';
343: }
344:
345: sub end_script {
346: my ($r,$token,$parser,$safeeval,$stackref)=@_;
347: &run($stackref->[$#$stackref],$safeeval);
348: $#$stackref--;
349: }
350:
351: sub start_outtext {
352: my ($r,$token,$parser,$safeeval,$stackref)=@_;
353: $stackref->[$#$stackref+1]='';
354: }
355:
356: sub end_outtext {
357: my ($r,$token,$parser,$safeeval,$stackref)=@_;
358: &printout($r,$stackref->[$#$stackref],$safeeval);
359: $#$stackref--;
360: }
361:
362: sub start_inlinetext {
363: &start_outtext(@_);
364: }
365:
366: sub end_inlinetext {
367: &end_outtext(@_);
368: }
369:
370: sub start_scriptlib {
371: my ($r,$token,$parser,$safeeval,$stackref)=@_;
372: &runfile($r,$parser->get_text('/scriptlib'),$safeeval);
373: }
374:
375: sub start_parserlib {
376: my ($r,$token,$parser,$safeeval,$stackref)=@_;
377: &runfile($r,$parser->get_text('/parserlib'),$parsereval);
378: }
379:
380:
381: sub start_answer {
382: my ($r,$token,$parser,$safeeval,$stackref)=@_;
383: $stackref->[$#$stackref+1]='<answer>::'.
384: join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
385: $stackref->[$#$stackref+1]='';
386: }
387:
388: sub end_answer {
389: my ($r,$token,$parser,$safeeval,$stackref)=@_;
390: my @itemtexts;
391: my @itemargs;
392: my $stackpointer=$#$stackref;
393: while (($stackref->[$stackpointer]!~'<answer>::') && ($stackpointer>0)) {
394: $stackpointer--;
395: }
396: my %answerargs=split(/:/,$stackref->[$stackpointer]);
397: }
398:
399: sub start_item {
400: my ($r,$token,$parser,$safeeval,$stackref)=@_;
401: $stackref->[$#$stackref+1]='<item>::'.
402: join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
403: $stackref->[$#$stackref+1]='';
404: }
405:
406: sub end_item {}
407:
408: # =============================================================================
409: # ==================================================== Tag Handlers for Editing
410: # =============================================================================
411:
412: sub start_edit_outtext {
413: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
414: $stackref)=@_;
415: &rawprint($r,"\n<h3>$description</h3>".
416: '<textarea rows="10" cols="80" name="data_'.$depthlabel.'">');
417: $stackref->[$#$stackref+1]='';
418: }
419:
420: sub end_edit_outtext {
421: my ($r,$token,$above,$stackref)=@_;
422: &rawprint($r,$stackref->[$#$stackref]."</textarea>\n");
423: $#$stackref--;
424: }
425:
426: sub start_edit_script {
427: &start_edit_outtext(@_);
428: }
429:
430: sub end_edit_script {
431: &end_edit_outtext(@_);
432: }
433:
434: sub start_edit_inlinetext {
435: &start_edit_outtext(@_);
436: }
437:
438: sub end_edit_inlinetext {
439: &end_edit_inlinetext(@_);
440: }
441:
442: sub start_edit_block {
443: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
444: $stackref)=@_;
445: my $bgcolor=$depthlabel;
446: $bgcolor=~s/\_//g;
447: $bgcolor=substr(length($bgcolor),-1,1);
448: $bgcolor=~tr/1-5/A-E/;
449: $bgcolor=$bgcolor.'FFF'.$bgcolor.'A';
450: &rawprint($r,"\n".'<br><table border="2" cellpadding="10" bgcolor="#'.
451: $bgcolor.
452: '" width="100%"><tr><td><h3>'.$description.'</h3>');
453: }
454:
455: sub end_edit_block {
456: my ($r,$token,$above,$stackref)=@_;
457: &rawprint($r,"\n".'</td></tr></table><br>');
458: }
459:
460: sub start_edit_answer {
461: my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
462: $stackref)=@_;
463: start_edit_block(@_);
464: $above=$token->[2]{'type'};
465: &rawprint($r,"\n".'<select name="mod_type_'.$depthlabel.'">');
466: my $key;
467: foreach $key (keys %$answertyperef) {
468: &rawprint($r,"\n".'<option value="'.$key.'"');
469: if ($above eq $key) { &rawprint($r,' selected'); }
470: &rawprint($r,'>'.$$answertyperef{$key}.'</option>');
471: }
472: &rawprint($r,"\n".'</select>'."\n");
473: }
474:
475: sub end_edit_answer {
476: my ($r,$token,$above,$stackref)=@_;
477: end_edit_block(@_);
478: }
479:
480: sub start_edit_include {
481: start_edit_block(@_);
482: }
483:
484: sub end_edit_include {
485: end_edit_block(@_);
486: }
487:
488: sub start_edit_problem {
489: start_edit_block(@_);
490: }
491:
492: sub end_edit_problem {
493: end_edit_block(@_);
494: }
495:
496: 1;
497: __END__
498:
499:
500:
501:
502:
503:
504:
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