Annotation of loncom/homework/lonproblem.pm, revision 1.6
1.5 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # Problem Handler
3: #
1.6 ! albertel 4: # $Id: gplheader.pl,v 1.1 2001/11/29 18:19:27 www 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: #
1.2 harris41 29: # 12/15-01/21,01/24 Gerd Kortemeyer
1.1 albertel 30:
31: package Apache::lonproblem;
32:
33: use strict;
34: use HTML::TokeParser;
35: use Safe;
36: use Apache::File;
37:
38: # ================================================================ Main Handler
1.5 albertel 39:
1.1 albertel 40: sub handler {
1.5 albertel 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
1.1 albertel 63: }
64:
1.5 albertel 65: # =============================================================================
1.1 albertel 66: # ============================================================= Parsing Routine
67: # Takes $parsestring and $target
1.5 albertel 68: # =============================================================================
69:
1.1 albertel 70: sub xmlparse {
1.3 albertel 71:
1.5 albertel 72: my ($r,$parsestring,$target) = @_;
1.3 albertel 73:
1.5 albertel 74: my $safeeval = new Safe 'Script';
1.3 albertel 75:
1.5 albertel 76: my $parsereval = new Safe 'Parser';
1.3 albertel 77:
1.5 albertel 78: my $parser=HTML::TokeParser->new(\$parsestring);
79:
80: my $outtext='';
1.3 albertel 81:
1.1 albertel 82: # ---------------------------------------------------------------- Handled tags
83:
1.5 albertel 84: my %toptoplevel = ( 'problem' => 'Problem',
85: 'entryform' => 'Entry Form',
86: 'survey' => 'Survey',
87: 'graded' => 'Manually Graded' );
1.3 albertel 88:
89:
1.2 harris41 90: # --------------------------------------------------------------- Toplevel Tags
1.1 albertel 91:
1.5 albertel 92: my %topleveltags = ( 'block' => 'Condition Block',
93: 'part' => 'Problem Part',
94: 'include' => 'Include Section',
95: 'answer' => 'Answerfield',
96: 'script' => 'Script',
97: 'outtext' => 'Text Block' );
1.2 harris41 98:
99: # ---------------------------------------------------------- Preregistered Tags
1.1 albertel 100:
1.5 albertel 101: my %includetags = ( 'scriptlib' => 'Script Library',
102: 'parserlib' => 'Parser Library' );
1.3 albertel 103: # -------------------------------------------------------------Answer type Tags
104:
1.5 albertel 105: my %answertags = ( 'capaanswer' => 'CAPA Standard Answers');
1.2 harris41 106:
107: # -------------------------------------------------------------------- All Tags
108:
1.1 albertel 109:
1.5 albertel 110: my %xmltags = ( %includetags, %topleveltags, %toptoplevel, %answertags );
1.3 albertel 111:
1.5 albertel 112: my $toplevel = '';
113: my $above = '';
1.3 albertel 114:
1.1 albertel 115: # --------------------------------------------------- Depth counter for editing
116:
1.5 albertel 117: my @depthcounter=();
118: my $depth=-1;
119: my $olddepth=-1;
1.1 albertel 120:
121: # ----------------------------------------------------------------------- Stack
122:
1.5 albertel 123: my @stack=('');
1.1 albertel 124:
125: # -------------------------------------------------------------- Init $saveeval
1.5 albertel 126:
127: &init_safeeval($safeeval);
1.1 albertel 128:
129: # ---------------------------------------------------------- Parse $parsestring
130:
1.5 albertel 131: my $token;
1.1 albertel 132:
1.5 albertel 133: while ($token=$parser->get_token) {n
1.2 harris41 134: # =============================================================================
1.5 albertel 135: if ($token->[0] eq 'S') {
1.2 harris41 136: # =================================================================== Start Tag
137: # --------------------------------------------------------------- Depth Counter
1.5 albertel 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: }
1.2 harris41 149: # -----------------------------------------------------------------------------
150:
151:
1.5 albertel 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: }
1.3 albertel 163:
1.5 albertel 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);
1.3 albertel 175: }
1.5 albertel 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);
1.3 albertel 183: }
1.5 albertel 184: }
185: } else {
186: $stack[$#stack].=$token->[4];
187: }
188: }
189:
190: if ($target eq 'modified') {
191: }
192:
1.2 harris41 193: # =============================================================================
1.5 albertel 194: } elsif ($token->[0] eq 'E') {
1.2 harris41 195: # ===================================================================== End Tag
196:
1.5 albertel 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);
1.3 albertel 216: }
1.5 albertel 217: }
218: }
219: }
220:
221: if ($target eq 'modified') {
222: }
1.2 harris41 223: # --------------------------------------------------------------- Depth Counter
1.5 albertel 224: if (defined($xmltags{$token->[1]})) { $depth--; }
1.2 harris41 225: # -----------------------------------------------------------------------------
226: # =============================================================================
1.5 albertel 227: } elsif ($token->[0] eq 'T') {
1.2 harris41 228: # ================================================================= Parsed Text
1.5 albertel 229: $stack[$#stack].=$token->[1];
1.3 albertel 230: }
1.5 albertel 231: }
232:
233: return $outtext;
1.1 albertel 234: }
235: # =============================================================================
236:
1.2 harris41 237: # --------------------------------------------------------------- Execute Token
1.1 albertel 238:
239:
240:
241: # ------------------------------------------------- Helper Routines for Editing
242:
243: sub rawprint {
1.5 albertel 244: my ($r,$data)=@_;
1.3 albertel 245: $r->print($data);
1.1 albertel 246: }
247:
248: sub insertmenu {
1.5 albertel 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) {
1.3 albertel 258: &rawprint($r,"\n".
1.5 albertel 259: '<option value="insert_'.$key.'">Insert '.
260: $$xmltagsref{$key}.'</option>');
261: }
262: &rawprint($r,"\n".'</select></td></tr></table><br>'."\n");
1.1 albertel 263: }
1.2 harris41 264:
265: # =============================================================================
266: # ================================================ Routines for Safe Evaluation
267: # =============================================================================
268:
269: # -------------------------------------------- Initialize routines in $safeeval
270:
271: sub init_safeeval {
1.5 albertel 272: my $safeeval=shift;
273: my $initprg=<<'ENDINIT';
1.2 harris41 274:
275: # -------------------------------------------- Initializations inside $safeeval
276:
1.5 albertel 277: $e=25;
278: $c=20;
1.2 harris41 279:
1.3 albertel 280: ENDINIT
1.2 harris41 281: # ---------------------------------------------------------------- Execute that
1.3 albertel 282: $safeeval->reval($initprg);
1.2 harris41 283: }
284:
285: # ----------------------------------------------- Routines that use Safe Spaces
1.1 albertel 286:
287: sub printout {
1.5 albertel 288: my ($r,$data,$safespace)=@_;
289: $r->print($safespace->reval('return qq('.$data.');'));
1.1 albertel 290: }
291:
292: sub runfile {
1.5 albertel 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: }
1.1 albertel 304: }
305:
306: sub run {
1.5 albertel 307: my ($expression,$safespace)=@_;
308: $safespace->reval($expression);
1.1 albertel 309: }
310:
311: sub booleanexpr {
1.5 albertel 312: my ($expression,$safespace)=@_;
313: return $safespace->reval('return '.$expression.';');
1.1 albertel 314: }
315:
1.2 harris41 316:
317: # =============================================================================
318: # ================================================== Tag Handlers for Rendering
319: # =============================================================================
1.1 albertel 320:
321: sub start_block {
1.5 albertel 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--;
1.3 albertel 333: }
1.5 albertel 334: }
1.3 albertel 335: }
1.5 albertel 336: }
337: return;
1.1 albertel 338: }
339:
340: sub start_script {
1.5 albertel 341: my ($r,$token,$parser,$safeeval,$stackref)=@_;
342: $stackref->[$#$stackref+1]='';
1.1 albertel 343: }
344:
345: sub end_script {
1.5 albertel 346: my ($r,$token,$parser,$safeeval,$stackref)=@_;
347: &run($stackref->[$#$stackref],$safeeval);
348: $#$stackref--;
1.1 albertel 349: }
350:
351: sub start_outtext {
1.5 albertel 352: my ($r,$token,$parser,$safeeval,$stackref)=@_;
353: $stackref->[$#$stackref+1]='';
1.1 albertel 354: }
355:
356: sub end_outtext {
1.5 albertel 357: my ($r,$token,$parser,$safeeval,$stackref)=@_;
358: &printout($r,$stackref->[$#$stackref],$safeeval);
359: $#$stackref--;
1.1 albertel 360: }
361:
362: sub start_inlinetext {
1.5 albertel 363: &start_outtext(@_);
1.1 albertel 364: }
365:
366: sub end_inlinetext {
1.5 albertel 367: &end_outtext(@_);
1.1 albertel 368: }
369:
1.2 harris41 370: sub start_scriptlib {
1.5 albertel 371: my ($r,$token,$parser,$safeeval,$stackref)=@_;
372: &runfile($r,$parser->get_text('/scriptlib'),$safeeval);
1.2 harris41 373: }
374:
375: sub start_parserlib {
1.5 albertel 376: my ($r,$token,$parser,$safeeval,$stackref)=@_;
377: &runfile($r,$parser->get_text('/parserlib'),$parsereval);
1.1 albertel 378: }
379:
1.2 harris41 380:
1.1 albertel 381: sub start_answer {
1.5 albertel 382: my ($r,$token,$parser,$safeeval,$stackref)=@_;
383: $stackref->[$#$stackref+1]='<answer>::'.
384: join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
385: $stackref->[$#$stackref+1]='';
1.1 albertel 386: }
387:
388: sub end_answer {
1.5 albertel 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]);
1.1 albertel 397: }
398:
399: sub start_item {
1.5 albertel 400: my ($r,$token,$parser,$safeeval,$stackref)=@_;
401: $stackref->[$#$stackref+1]='<item>::'.
402: join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
403: $stackref->[$#$stackref+1]='';
1.1 albertel 404: }
405:
406: sub end_item {}
407:
1.2 harris41 408: # =============================================================================
409: # ==================================================== Tag Handlers for Editing
410: # =============================================================================
1.1 albertel 411:
412: sub start_edit_outtext {
1.5 albertel 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]='';
1.1 albertel 418: }
419:
420: sub end_edit_outtext {
1.5 albertel 421: my ($r,$token,$above,$stackref)=@_;
422: &rawprint($r,$stackref->[$#$stackref]."</textarea>\n");
423: $#$stackref--;
1.1 albertel 424: }
425:
426: sub start_edit_script {
1.5 albertel 427: &start_edit_outtext(@_);
1.1 albertel 428: }
429:
430: sub end_edit_script {
1.5 albertel 431: &end_edit_outtext(@_);
1.1 albertel 432: }
433:
434: sub start_edit_inlinetext {
1.5 albertel 435: &start_edit_outtext(@_);
1.1 albertel 436: }
437:
438: sub end_edit_inlinetext {
1.5 albertel 439: &end_edit_inlinetext(@_);
1.1 albertel 440: }
441:
442: sub start_edit_block {
1.5 albertel 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>');
1.1 albertel 453: }
454:
455: sub end_edit_block {
1.5 albertel 456: my ($r,$token,$above,$stackref)=@_;
457: &rawprint($r,"\n".'</td></tr></table><br>');
1.1 albertel 458: }
459:
460: sub start_edit_answer {
1.5 albertel 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");
1.1 albertel 473: }
474:
475: sub end_edit_answer {
1.5 albertel 476: my ($r,$token,$above,$stackref)=@_;
477: end_edit_block(@_);
1.1 albertel 478: }
479:
480: sub start_edit_include {
1.5 albertel 481: start_edit_block(@_);
1.1 albertel 482: }
483:
484: sub end_edit_include {
1.5 albertel 485: end_edit_block(@_);
1.1 albertel 486: }
487:
488: sub start_edit_problem {
1.5 albertel 489: start_edit_block(@_);
1.1 albertel 490: }
491:
492: sub end_edit_problem {
1.5 albertel 493: end_edit_block(@_);
1.1 albertel 494: }
495:
496: 1;
497: __END__
1.3 albertel 498:
1.1 albertel 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