Return to lonproblem.pm CVS log

Up to [LON-CAPA] / loncom / homework

beautify/optimize

# The LON-CAPA problem handler
#
# Problem Handler
#
# 12/15-01/21,01/24 Gerd Kortemeyer
# 4/12 Guy Albertelli
# 8/6 Scott Harrison

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) {
# =============================================================================
	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__