Return to lonproblem.pm CVS log

Up to [LON-CAPA] / loncom / homework

- added CAPA-converter
- lonproblem reformatting

# The LearningOnline Network with CAPA
# Problem Handler
#
# 12/15-01/21,01/24 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 'Script';
  
  my $parsereval = new Safe 'Parser';
  
  my $parser=HTML::TokeParser->new(\$parsestring);
  
  my $outtext='';
  
# ---------------------------------------------------------------- Handled tags

  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 %includetags  = ( 'scriptlib' => 'Script Library',
		       'parserlib' => 'Parser Library' );
# -------------------------------------------------------------Answer type Tags

  my %answertags   = ( 'capaanswer' => 'CAPA Standard Answers');

# -------------------------------------------------------------------- All Tags


  my %xmltags      = ( %includetags, %topleveltags, %toptoplevel, %answertags );
  
  my $toplevel     = '';
  my $above        = '';
  
# --------------------------------------------------- Depth counter for editing

  my @depthcounter=();
  my $depth=-1;
  my $olddepth=-1;

# ----------------------------------------------------------------------- Stack

  my @stack=('');

# -------------------------------------------------------------- Init $saveeval

  &init_safeeval($safeeval);

# ---------------------------------------------------------- Parse $parsestring

  my $token;

  while ($token=$parser->get_token) {n
# =============================================================================
    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;
}
# =============================================================================

# --------------------------------------------------------------- Execute Token



# ------------------------------------------------- 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");
}

# =============================================================================
# ================================================ Routines for Safe Evaluation
# =============================================================================

# -------------------------------------------- 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);
}

# ----------------------------------------------- Routines that use Safe Spaces

sub printout {
  my ($r,$data,$safespace)=@_;
  $r->print($safespace->reval('return qq('.$data.');'));
}

sub runfile {
  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,$safespace)=@_;
  $safespace->reval($expression);   
}

sub booleanexpr {
  my ($expression,$safespace)=@_;
  return $safespace->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_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]='<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 {}

# =============================================================================
# ==================================================== Tag Handlers for Editing
# =============================================================================

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__