--- loncom/homework/Attic/lonproblem.pm 2000/01/21 20:01:28 1.1 +++ loncom/homework/Attic/lonproblem.pm 2001/08/06 18:35:51 1.4 @@ -1,7 +1,10 @@ -# The LearningOnline Network with CAPA +# The LON-CAPA problem handler +# # Problem Handler # -# 12/15-01/21 Gerd Kortemeyer +# 12/15-01/21,01/24 Gerd Kortemeyer +# 4/12 Guy Albertelli +# 8/6 Scott Harrison package Apache::lonproblem; @@ -11,396 +14,443 @@ use Safe; use Apache::File; # ================================================================ Main Handler - sub handler { -my $r=shift; -my @parsecontents; -my $parsestring; -my $outstring; - -{ - my $fh=Apache::File->new($r->filename); - @parsecontents=<$fh>; -} - -$parsestring=join('',@parsecontents); - -print "
"; - -&xmlparse($r,$parsestring,'web'); - -print "\n---------------\n"; -print ""; -&xmlparse($r,$parsestring,'edit'); -$outstring=xmlparse($parsestring,'modified'); -print "\n---------------\n$outstring\n"; -return 1; #change to ok + my $r=shift; + my @parsecontents; + my $parsestring; + my $outstring; + + { + my $fh=Apache::File->new($r->filename); + @parsecontents=<$fh>; + } + + $parsestring=join('',@parsecontents); + + print ""; + + &xmlparse($r,$parsestring,'web'); + + print "\n---------------\n"; + print ""; + &xmlparse($r,$parsestring,'edit'); + $outstring=xmlparse($parsestring,'modified'); + print "\n---------------\n$outstring\n"; + return 1; #change to ok } # ============================================================= Parsing Routine # Takes $parsestring and $target - sub xmlparse { + + my ($r,$parsestring,$target) = @_; + + my $safeeval = new Safe 'Script'; + + my $parsereval = new Safe 'Parser'; + + my $parser=HTML::TokeParser->new(\$parsestring); + + my $outtext=''; + +# ---------------------------------------------------------------- Handled tags -my ($r,$parsestring,$target) = @_; - -my $safeeval = new Safe; + my %toptoplevel = ( 'problem' => 'Problem', + 'entryform' => 'Entry Form', + 'survey' => 'Survey', + 'graded' => 'Manually Graded' ); + + +# --------------------------------------------------------------- Toplevel Tags + + my %topleveltags = ( 'block' => 'Condition Block', + 'part' => 'Problem Part', + 'include' => 'Include Section', + 'answer' => 'Answerfield', + 'script' => 'Script', + 'outtext' => 'Text Block' ); + +# ---------------------------------------------------------- Preregistered Tags -my $parser=HTML::TokeParser->new(\$parsestring); + my %includetags = ( 'scriptlib' => 'Script Library', + 'parserlib' => 'Parser Library' ); +# -------------------------------------------------------------Answer type Tags -my $outtext=''; + my %answertags = ( 'capaanswer' => 'CAPA Standard Answers'); -# ---------------------------------------------------------------- Handled tags +# -------------------------------------------------------------------- All Tags -my %toptoplevel = ( 'problem' => 'Problem', - 'entryform' => 'Entry Form', - 'survey' => 'Survey' ); - -my %answertags = ( 'item' => 'Question Item', - 'inlinetext' => 'Inline Text' ); - -my %includetags = ( 'codelib' => 'Code Library' ); - -my %topleveltags = ( 'block' => 'Condition Block', - 'answer' => 'Answer Field', - 'include' => 'Include Section', - 'script' => 'Script', - 'outtext' => 'Text Block' ); - -my %xmltags = ( %answertags, %includetags, - %topleveltags, %toptoplevel ); - -my $toplevel = ''; -my $above = ''; - -my %answertypes = ( 'true_false' => 'True/False', - 'multiple_choice' => 'Multiple Choice', - 'numerical' => 'Numerical', - 'numerical_units' => 'Numerical with Units' ); + my %xmltags = ( %includetags, %topleveltags, %toptoplevel, + %answertags ); + + my $toplevel = ''; + my $above = ''; + # --------------------------------------------------- Depth counter for editing -my @depthcounter=(); -my $depth=-1; -my $olddepth=-1; + my @depthcounter = (); + my $depth = -1; + my $olddepth = -1; # ----------------------------------------------------------------------- Stack -my @stack=(''); + my @stack = (''); # -------------------------------------------------------------- Init $saveeval + + &init_safeeval($safeeval); -if ($target eq 'web') { - &init_safeeval($safeeval); +# ---------------------------------------------------------- Parse $parsestring + + my $token; + + while ($token = $parser->get_token) { +# ============================================================================= + if ($token->[0] eq 'S') { +# =================================================================== Start Tag +# --------------------------------------------------------------- Depth Counter + if (defined($xmltags{$token->[1]})) { + if ($depth<$olddepth-1) { + $#depthcounter--; + $olddepth=$depth; + } + $depth++; + $depthcounter[$depth]++; + if ($depthcounter[$depth] == 1) { + $olddepth = $depth; + } + } +# ----------------------------------------------------------------------------- + + + if ($target eq 'web') { + my $sub = "start_$token->[1]"; + { + no strict 'refs'; + if (defined (&$sub)) { + &$sub($r,$token,$parser,$safeeval,\@stack); + } else { + $stack[$#stack] .= $token->[4]; + } + } + } + + if ($target eq 'edit') { + my $depthlabel = join('_',@depthcounter); + if (defined($xmltags{$token->[1]})) { + if (defined($topleveltags{$token->[1]})) { + &insertmenu($r,$xmltags{$token->[1]}, + $depthlabel,\%topleveltags); + $toplevel = $token->[1]; + } else { + if ($toplevel eq 'answer') { + &insertmenu($r,$xmltags{$token->[1]}, + $depthlabel,\%answertags); + } + } + my $sub = "start_edit_$token->[1]"; + { + no strict 'refs'; + if (defined (&$sub)) { + &$sub($r,$token,$parser,$xmltags{$token->[1]}, + $depthlabel,$above,\%answertypes,\@stack); + } + } + } else { + $stack[$#stack] .= $token->[4]; + } + } + + if ($target eq 'modified') { + } + +# ============================================================================= + } elsif ($token->[0] eq 'E') { +# ===================================================================== End Tag + + if ($target eq 'web') { + my $sub = "end_$token->[1]"; + { + no strict 'refs'; + if (defined (&$sub)) { + &$sub($r,$token,$parser,$safeeval,\@stack); + } else { + $stack[$#stack] .= $token->[2]; + } + } + } + + if ($target eq 'edit') { + if (defined($xmltags{$token->[1]})) { + my $sub = "end_edit_$token->[1]"; + { + no strict 'refs'; + if (defined (&$sub)) { + &$sub($r,$token,$above,\@stack); + } + } + } + } + + if ($target eq 'modified') { + } +# --------------------------------------------------------------- Depth Counter + if (defined($xmltags{$token->[1]})) { $depth--; } +# ----------------------------------------------------------------------------- +# ============================================================================= + } elsif ($token->[0] eq 'T') { +# ================================================================= Parsed Text + $stack[$#stack] .= $token->[1]; + } + } + + return $outtext; } +# ============================================================================= -# ---------------------------------------------------------- Parse $parsestring +# --------------------------------------------------------------- Execute Token -my $token; -while ($token=$parser->get_token) { - if ($token->[0] eq 'S') { -# ------------------------------------------------------------------- Start Tag - if (defined($xmltags{$token->[1]})) { - if ($depth<$olddepth-1) { - $#depthcounter--; - $olddepth=$depth; - } - $depth++; - $depthcounter[$depth]++; - if ($depthcounter[$depth]==1) { - $olddepth=$depth; - } - } - if ($target eq 'web') { - my $sub="start_$token->[1]"; - { - no strict 'refs'; - if (defined (&$sub)) { - &$sub($r,$token,$parser,$safeeval,\@stack); - } else { - $stack[$#stack].=$token->[4]; - } - } - } - if ($target eq 'edit') { - my $depthlabel=join('_',@depthcounter); - if (defined($xmltags{$token->[1]})) { - if (defined($topleveltags{$token->[1]})) { - &insertmenu($r,$xmltags{$token->[1]}, - $depthlabel,\%topleveltags); - $toplevel=$token->[1]; - } else { - if ($toplevel eq 'answer') { - &insertmenu($r,$xmltags{$token->[1]}, - $depthlabel,\%answertags); - } - } - my $sub="start_edit_$token->[1]"; - { - no strict 'refs'; - if (defined (&$sub)) { - &$sub($r,$token,$parser,$xmltags{$token->[1]}, - $depthlabel,$above,\%answertypes,\@stack); - } - } - } else { - $stack[$#stack].=$token->[4]; - } - } - if ($target eq 'modified') { - } - } elsif ($token->[0] eq 'E') { -# --------------------------------------------------------------------- End Tag - if ($target eq 'web') { - my $sub="end_$token->[1]"; - { - no strict 'refs'; - if (defined (&$sub)) { - &$sub($r,$token,$parser,$safeeval,\@stack); - } else { - $stack[$#stack].=$token->[2]; - } - } - } - if ($target eq 'edit') { - if (defined($xmltags{$token->[1]})) { - my $sub="end_edit_$token->[1]"; - { - no strict 'refs'; - if (defined (&$sub)) { - &$sub($r,$token,$above,\@stack); - } - } - } - } - if ($target eq 'modified') { - } - if (defined($xmltags{$token->[1]})) { $depth--; } - } elsif ($token->[0] eq 'T') { -# ------------------------------------------------------------------------ Text - $stack[$#stack].=$token->[1]; - } + +# ------------------------------------------------- Helper Routines for Editing + +sub rawprint { + my ($r,$data) = @_; + $r->print($data); } -return $outtext; +sub insertmenu { + my ($r,$description,$depthlabel,$xmltagsref) = @_; + &rawprint($r,'
'); + &rawprint($r,"\n".'

'."\n"); } + +# ============================================================================= +# ================================================ Routines for Safe Evaluation # ============================================================================= # -------------------------------------------- Initialize routines in $safeeval sub init_safeeval { - my $safeeval=shift; - my $initprg=<<'ENDINIT'; + my $safeeval = shift; + my $initprg =<<'ENDINIT'; # -------------------------------------------- Initializations inside $safeeval -$e=25; -$c=20; + $e = 25; + $c = 20; -ENDINIT + ENDINIT # ---------------------------------------------------------------- Execute that - $safeeval->reval($initprg); -} - -# ------------------------------------------------- Helper Routines for Editing - -sub rawprint { - my ($r,$data)=@_; - $r->print($data); + $safeeval->reval($initprg); } -sub insertmenu { - my ($r,$description,$depthlabel,$xmltagsref)=@_; - &rawprint($r,'
'); - &rawprint($r,"\n".'

'."\n"); -} - -# ----------------------------------------------- Helper Routines for Renderers +# ----------------------------------------------- Routines that use Safe Spaces sub printout { - my ($r,$data,$safeeval)=@_; - $r->print($safeeval->reval('return qq('.$data.');')); + my ($r,$data,$safespace) = @_; + $r->print($safespace->reval('return qq('.$data.');')); } sub runfile { - my ($r,$filename,$safeeval)=@_; - my $includespath=$r->dir_config('lonIncludes'); - $safeeval->rdo($includespath.'/'.$filename); + my ($r,$filename,$safespace) = @_; + my $includefile; + if ($filename =~ /^\//) { + $includefile = $filename; + } else { + $includefile = $r->dir_config('lonIncludes'); + $includefile .= '/'.$filename; + } + if (-e $includefile) { + $safespace->rdo($includefile); + } } sub run { - my ($expression,$safeeval)=@_; - $safeeval->reval($expression); + my ($expression,$safespace) = @_; + $safespace->reval($expression); } sub booleanexpr { - my ($expression,$safeeval)=@_; - return $safeeval->reval('return '.$expression.';'); + my ($expression,$safespace) = @_; + return $safespace->reval('return '.$expression.';'); } -# -------------------------------------------------- Tag Handlers for Rendering + +# ============================================================================= +# ================================================== Tag Handlers for Rendering +# ============================================================================= sub start_block { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - if (!booleanexpr($token->[2]{'condition'},$safeeval)) { - my $blockdepth=0; - my $nexttoken; - while ($nexttoken=$parser->get_tag()) { - if ($nexttoken->[0] eq 'block') { $blockdepth++ }; - if ($nexttoken->[0] eq '/block') { - if ($blockdepth==0) { - return; - } else { - $blockdepth--; - } - } - } - } - return; + my ($r,$token,$parser,$safeeval,$stackref) = @_; + if (!booleanexpr($token->[2]{'condition'},$safeeval)) { + my $blockdepth = 0; + my $nexttoken; + while ($nexttoken=$parser->get_tag()) { + if ($nexttoken->[0] eq 'block') { $blockdepth++ }; + if ($nexttoken->[0] eq '/block') { + if ($blockdepth == 0) { + return; + } else { + $blockdepth--; + } + } + } + } + return; } sub start_script { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - $stackref->[$#$stackref+1]=''; + my ($r,$token,$parser,$safeeval,$stackref) = @_; + $stackref->[$#$stackref+1] = ''; } sub end_script { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - &run($stackref->[$#$stackref],$safeeval); - $#$stackref--; + my ($r,$token,$parser,$safeeval,$stackref) = @_; + &run($stackref->[$#$stackref],$safeeval); + $#$stackref--; } sub start_outtext { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - $stackref->[$#$stackref+1]=''; + my ($r,$token,$parser,$safeeval,$stackref) = @_; + $stackref->[$#$stackref+1] = ''; } sub end_outtext { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - &printout($r,$stackref->[$#$stackref],$safeeval); - $#$stackref--; + my ($r,$token,$parser,$safeeval,$stackref) = @_; + &printout($r,$stackref->[$#$stackref],$safeeval); + $#$stackref--; } sub start_inlinetext { - &start_outtext(@_); + &start_outtext(@_); } sub end_inlinetext { - &end_outtext(@_); + &end_outtext(@_); } -sub start_codelib { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - &runfile($r,$parser->get_text('/codelib'),$safeeval); +sub start_scriptlib { + my ($r,$token,$parser,$safeeval,$stackref) = @_; + &runfile($r,$parser->get_text('/scriptlib'),$safeeval); } +sub start_parserlib { + my ($r,$token,$parser,$safeeval,$stackref) = @_; + &runfile($r,$parser->get_text('/parserlib'),$parsereval); +} + + sub start_answer { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - $stackref->[$#$stackref+1]='::'. - join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]}); - $stackref->[$#$stackref+1]=''; + my ($r,$token,$parser,$safeeval,$stackref) = @_; + $stackref->[$#$stackref+1] = '::'. + join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]}); + $stackref->[$#$stackref+1] = ''; } sub end_answer { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - my @itemtexts; - my @itemargs; - my $stackpointer=$#$stackref; - while (($stackref->[$stackpointer]!~'::') && ($stackpointer>0)) { - $stackpointer--; - } - my %answerargs=split(/:/,$stackref->[$stackpointer]); + my ($r,$token,$parser,$safeeval,$stackref) = @_; + my @itemtexts; + my @itemargs; + my $stackpointer = $#$stackref; + while (($stackref->[$stackpointer] !~ '::') && + ($stackpointer > 0)) { + $stackpointer--; + } + my %answerargs=split(/:/,$stackref->[$stackpointer]); } sub start_item { - my ($r,$token,$parser,$safeeval,$stackref)=@_; - $stackref->[$#$stackref+1]='::'. - join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]}); - $stackref->[$#$stackref+1]=''; + my ($r,$token,$parser,$safeeval,$stackref) = @_; + $stackref->[$#$stackref+1] = '::'. + join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]}); + $stackref->[$#$stackref+1]=''; } sub end_item {} -# ------------------------------------------------------------ Edit Tag Handler +# ============================================================================= +# ==================================================== Tag Handlers for Editing +# ============================================================================= sub start_edit_outtext { - my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef, - $stackref)=@_; - &rawprint($r,"\n

$description

". - '\n"); - $#$stackref--; + my ($r,$token,$above,$stackref) = @_; + &rawprint($r,$stackref->[$#$stackref]."\n"); + $#$stackref--; } sub start_edit_script { - &start_edit_outtext(@_); + &start_edit_outtext(@_); } sub end_edit_script { - &end_edit_outtext(@_); + &end_edit_outtext(@_); } sub start_edit_inlinetext { - &start_edit_outtext(@_); + &start_edit_outtext(@_); } sub end_edit_inlinetext { - &end_edit_inlinetext(@_); + &end_edit_inlinetext(@_); } sub start_edit_block { - my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef, - $stackref)=@_; - my $bgcolor=$depthlabel; - $bgcolor=~s/\_//g; - $bgcolor=substr(length($bgcolor),-1,1); - $bgcolor=~tr/1-5/A-E/; - $bgcolor=$bgcolor.'FFF'.$bgcolor.'A'; - &rawprint($r,"\n".'

'.$description.'

'); + my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef, + $stackref) = @_; + my $bgcolor = $depthlabel; + $bgcolor =~ s/\_//g; + $bgcolor = substr(length($bgcolor),-1,1); + $bgcolor =~ tr/1-5/A-E/; + $bgcolor = $bgcolor.'FFF'.$bgcolor.'A'; + &rawprint($r,"\n".'

'.$description.'

'); } sub end_edit_block { - my ($r,$token,$above,$stackref)=@_; - &rawprint($r,"\n".'

'); + my ($r,$token,$above,$stackref) = @_; + &rawprint($r,"\n".'

'); } sub start_edit_answer { - my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef, - $stackref)=@_; - start_edit_block(@_); - $above=$token->[2]{'type'}; - &rawprint($r,"\n".''."\n"); + my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef, + $stackref) = @_; + start_edit_block(@_); + $above = $token->[2]{'type'}; + &rawprint($r,"\n".''."\n"); } sub end_edit_answer { - my ($r,$token,$above,$stackref)=@_; - end_edit_block(@_); + my ($r,$token,$above,$stackref)=@_; + end_edit_block(@_); } sub start_edit_include { @@ -420,8 +470,9 @@ sub end_edit_problem { } 1; -__END__ +__END__ +