Annotation of loncom/homework/lonproblem.pm, revision 1.1
1.1 ! albertel 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