Return to lonproblem.pm CVS log

Up to [LON-CAPA] / loncom / homework

- adding problem handler

# 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__