# The LearningOnline Network with CAPA
# Problem Handler
#
# 12/15-01/21 Gerd Kortemeyer
package Apache::lonproblem;
use strict;
use HTML::TokeParser;
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 "<form>";
&xmlparse($r,$parsestring,'web');
print "\n---------------\n";
print "<form>";
&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;
my $parser=HTML::TokeParser->new(\$parsestring);
my $outtext='';
# ---------------------------------------------------------------- Handled 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' );
# --------------------------------------------------- Depth counter for editing
my @depthcounter=();
my $depth=-1;
my $olddepth=-1;
# ----------------------------------------------------------------------- Stack
my @stack=('');
# -------------------------------------------------------------- Init $saveeval
if ($target eq 'web') {
&init_safeeval($safeeval);
}
# ---------------------------------------------------------- Parse $parsestring
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];
}
}
return $outtext;
}
# =============================================================================
# -------------------------------------------- Initialize routines in $safeeval
sub init_safeeval {
my $safeeval=shift;
my $initprg=<<'ENDINIT';
# -------------------------------------------- Initializations inside $safeeval
$e=25;
$c=20;
ENDINIT
# ---------------------------------------------------------------- Execute that
$safeeval->reval($initprg);
}
# ------------------------------------------------- Helper Routines for Editing
sub rawprint {
my ($r,$data)=@_;
$r->print($data);
}
sub insertmenu {
my ($r,$description,$depthlabel,$xmltagsref)=@_;
&rawprint($r,'<br><table bgcolor="#DDDD33" width="100%"><tr><td>');
&rawprint($r,"\n".'<select name="mod_menu_'.$depthlabel.'">'."\n");
&rawprint($r,'<option value="no_changes" selected>(no changes)</option>');
&rawprint($r,"\n".
'<option value="delete">Delete '.$description.
' Below</option>');
my $key;
foreach $key (keys %$xmltagsref) {
&rawprint($r,"\n".
'<option value="insert_'.$key.'">Insert '.
$$xmltagsref{$key}.'</option>');
}
&rawprint($r,"\n".'</select></td></tr></table><br>'."\n");
}
# ----------------------------------------------- Helper Routines for Renderers
sub printout {
my ($r,$data,$safeeval)=@_;
$r->print($safeeval->reval('return qq('.$data.');'));
}
sub runfile {
my ($r,$filename,$safeeval)=@_;
my $includespath=$r->dir_config('lonIncludes');
$safeeval->rdo($includespath.'/'.$filename);
}
sub run {
my ($expression,$safeeval)=@_;
$safeeval->reval($expression);
}
sub booleanexpr {
my ($expression,$safeeval)=@_;
return $safeeval->reval('return '.$expression.';');
}
# -------------------------------------------------- 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;
}
sub start_script {
my ($r,$token,$parser,$safeeval,$stackref)=@_;
$stackref->[$#$stackref+1]='';
}
sub end_script {
my ($r,$token,$parser,$safeeval,$stackref)=@_;
&run($stackref->[$#$stackref],$safeeval);
$#$stackref--;
}
sub start_outtext {
my ($r,$token,$parser,$safeeval,$stackref)=@_;
$stackref->[$#$stackref+1]='';
}
sub end_outtext {
my ($r,$token,$parser,$safeeval,$stackref)=@_;
&printout($r,$stackref->[$#$stackref],$safeeval);
$#$stackref--;
}
sub start_inlinetext {
&start_outtext(@_);
}
sub end_inlinetext {
&end_outtext(@_);
}
sub start_codelib {
my ($r,$token,$parser,$safeeval,$stackref)=@_;
&runfile($r,$parser->get_text('/codelib'),$safeeval);
}
sub start_answer {
my ($r,$token,$parser,$safeeval,$stackref)=@_;
$stackref->[$#$stackref+1]='<answer>::'.
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]!~'<answer>::') && ($stackpointer>0)) {
$stackpointer--;
}
my %answerargs=split(/:/,$stackref->[$stackpointer]);
}
sub start_item {
my ($r,$token,$parser,$safeeval,$stackref)=@_;
$stackref->[$#$stackref+1]='<item>::'.
join(':',map{$_.':'.$token->[2]->{$_}} @{$token->[3]});
$stackref->[$#$stackref+1]='';
}
sub end_item {}
# ------------------------------------------------------------ Edit Tag Handler
sub start_edit_outtext {
my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
$stackref)=@_;
&rawprint($r,"\n<h3>$description</h3>".
'<textarea rows="10" cols="80" name="data_'.$depthlabel.'">');
$stackref->[$#$stackref+1]='';
}
sub end_edit_outtext {
my ($r,$token,$above,$stackref)=@_;
&rawprint($r,$stackref->[$#$stackref]."</textarea>\n");
$#$stackref--;
}
sub start_edit_script {
&start_edit_outtext(@_);
}
sub end_edit_script {
&end_edit_outtext(@_);
}
sub start_edit_inlinetext {
&start_edit_outtext(@_);
}
sub 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".'<br><table border="2" cellpadding="10" bgcolor="#'.
$bgcolor.
'" width="100%"><tr><td><h3>'.$description.'</h3>');
}
sub end_edit_block {
my ($r,$token,$above,$stackref)=@_;
&rawprint($r,"\n".'</td></tr></table><br>');
}
sub start_edit_answer {
my ($r,$token,$parser,$description,$depthlabel,$above,$answertyperef,
$stackref)=@_;
start_edit_block(@_);
$above=$token->[2]{'type'};
&rawprint($r,"\n".'<select name="mod_type_'.$depthlabel.'">');
my $key;
foreach $key (keys %$answertyperef) {
&rawprint($r,"\n".'<option value="'.$key.'"');
if ($above eq $key) { &rawprint($r,' selected'); }
&rawprint($r,'>'.$$answertyperef{$key}.'</option>');
}
&rawprint($r,"\n".'</select>'."\n");
}
sub end_edit_answer {
my ($r,$token,$above,$stackref)=@_;
end_edit_block(@_);
}
sub start_edit_include {
start_edit_block(@_);
}
sub end_edit_include {
end_edit_block(@_);
}
sub start_edit_problem {
start_edit_block(@_);
}
sub end_edit_problem {
end_edit_block(@_);
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>