#!/usr/local/bin/perl -w 

# Copyright (C) 2001 Michael Gage 

###############################################################################
# The initial code simply initializes variables, defines addresses
# for directories, defines some simple subroutines responders used in debugging
# and makes sure that the appropriate CPAN library modules
# are available.  The main code begins below that with the initialization
# of the PGtranslator5 module. 
###############################################################################
package Webwork;

use strict;
use sigtrap;
use Carp;

#BEGIN {
#	local $^W=0;
#	require '/usr/local/lib/perl5/5.6.1/Benchmark.pm';
#}
print STDERR "using the perl version of MIME::Base64\n";
use MIME::Base64 qw( encode_base64 decode_base64);


# These libraries contain files which must at least be available, even though
# only Global.pm is actively used.

use lib "/Users/gage/webwork/system/lib/", "/Users/gage/webwork/system/courseScripts/";
my $WEBWORKDIRECTORY = '/Users/gage/webwork/';
my $COURSESCRIPTSDIRECTORY = "/Users/gage/webwork/system/courseScripts/";
my $PGTRANSLATOR = "PGtranslator5.pm";

my $COURSETEMPDIRECTORY = '/Users/gage/Sites/demoCoursetmp/';
my $COURSETEMPURL 		=	'http://webwork-db.math.rochester.edu/~gage/demoCoursetmp';



my $PASSWORD = 'geometry';
###############################################################################

BEGIN{
	my $GLOBAL_INIT = "/Users/gage/webwork/system/lib/Global.pm";
	print "Opening $GLOBAL_INIT\n";
	require $GLOBAL_INIT or die $GLOBAL_INIT;
	import Global;
}



require $PGTRANSLATOR or die "Can't open $PGTRANSLATOR";

###############################################################################
# List and address myof available problemlibraries
###############################################################################


my $libraryPath 				= 	'${WEBWORKDIRECTORY}rochester_problib/';

my %AVAILABLE_PROBLEM_LIBRARIES	= 	(	ww_prob_lib		=> 	"${WEBWORKDIRECTORY}rochester_problib/",
										indiana_prob_lib	=> 	"${WEBWORKDIRECTORY}Indiana_prob_lib/",
										capaOK_lib		=>	'/ww/webwork/courses1/capaOK/templates/',
										capa_lib		=>	'/ww/webwork/courses/capa/templates/',
										prob_lib_cvs	=>	'/ww/webwork/courses/WW_Prob_Lib_CVS/templates/',
										maa_100			=>	'/ww/webwork/courses/maa100/templates/',
										teitel_physics121			=>	'/ww/webwork/courses/teitel-phy121/templates/',
									);

###############################################################################
# Configure daemon:
###############################################################################
my $courseScriptsDirectory 		= 	$COURSESCRIPTSDIRECTORY;
my $macroDirectory				=	"${courseScriptsDirectory}macros/";
my $scriptDirectory				= 	"${WEBWORKDIRECTORY}system/scripts/";
my $templateDirectory			= 	"${WEBWORKDIRECTORY}courseData/rochester_problib/";

$Global::courseTempDirectory 	= 	$COURSETEMPDIRECTORY;
$Global::courseTempURL 			= 	$COURSETEMPURL;


$Global::groupID 				= 	"webadmin";
$Global::numericalGroupID 		= 	1005;

my $displayMode					=	'HTML_tth';

my $PG_PL 						= 	"${courseScriptsDirectory}PG.pl";
my $DANGEROUS_MACROS_PL			= 	"${courseScriptsDirectory}dangerousMacros.pl";
my @MODULE_LIST					= ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", 
										"Circle", "Label", "PGrandom", "Units", "Hermite", 
										"List", "Match","Multiple", "Select", "AlgParser", 
										"AnswerHash", "Fraction", "VectorField", "Complex1", 
										"Complex", "MatrixReal1", "Matrix","Distributions",
										"Regression"
								);
my @EXTRA_PACKAGES				= ( "AlgParserWithImplicitExpand", "Expr", 
										"ExprWithImplicitExpand", "AnswerEvaluator", 
										"AnswerEvaluatorMaker"  

							);

my $INITIAL_MACRO_PACKAGES;
unless (defined ($main::do_not_preload_macros) && $main::do_not_preload_macros == 1) {
	$INITIAL_MACRO_PACKAGES 		=  <<END_OF_TEXT;
		DOCUMENT();
		loadMacros(
		"PGbasicmacros.pl",
		"PGchoicemacros.pl",
		"PGanswermacros.pl",
		"PGnumericalmacros.pl",
		"PGgraphmacros.pl",
		"PGauxiliaryFunctions.pl",
		"PGmatrixmacros.pl",
		"PGcomplexmacros.pl",
		"PGstatisticsmacros.pl"
		
		);
		
		ENDDOCUMENT();
	
END_OF_TEXT
} else {
	$INITIAL_MACRO_PACKAGES 		=  <<END_OF_TEXT;
		DOCUMENT();
		loadMacros(
# 		"PGbasicmacros.pl",
# 		"PGchoicemacros.pl",
# 		"PGanswermacros.pl",
# 		"PGnumericalmacros.pl",
# 		"PGgraphmacros.pl",
# 		"PGauxiliaryFunctions.pl",
# 		"PGmatrixmacros.pl",
# 		"PGcomplexmacros.pl",
# 		"PGstatisticsmacros.pl"
		
		);
		
		ENDDOCUMENT();
	
END_OF_TEXT


}

###############################################################################
#
###############################################################################

###############################################################################
###############################################################################

print STDERR "ok so far reading file ${WEBWORKDIRECTORY}xmlrpc/daemon/Webwork.pm\n";

		

###############################################################################
#
# INITIALIZATION
#
# The following code initializes an instantiation of PGtranslator5 in the 
# parent process.  This initialized object is then share with each of the 
# children forked from this parent process by the daemon.
#
# As far as I can tell, the child processes don't share any variable values even
# though their namespaces are the same.
###############################################################################

print STDERR "Begin intitalization\n";
my $dummy_envir = {	courseScriptsDirectory 	=> 	$courseScriptsDirectory,
					displayMode 			=>	$displayMode,
					macroDirectory			=> 	$macroDirectory};
my $pt = new PGtranslator5;  #pt stands for problem translator;
$pt ->rh_directories(	{	courseScriptsDirectory 	=> $courseScriptsDirectory,
                      		macroDirectory			=> $macroDirectory,
                      		scriptDirectory			=> $scriptDirectory	,
                      		templateDirectory		=> $templateDirectory,
                      		tempDirectory			=> $Global::courseTempDirectory,
                      	}
);
$pt -> evaluate_modules( @MODULE_LIST);
$pt -> load_extra_packages( @EXTRA_PACKAGES );
$pt -> environment($dummy_envir);
$pt->initialize();
my $loadErrors    = $pt -> unrestricted_load($PG_PL );
print STDERR "$loadErrors\n" if ($loadErrors);
$loadErrors = $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
print STDERR "$loadErrors\n" if ($loadErrors);
$pt-> set_mask();
#
#	print STDERR "\nPG.pl: $PG_PL\n";
#	print STDERR "DANGEROUS_MACROS_PL: $DANGEROUS_MACROS_PL\n";
#	print STDERR "Print dummy environment\n";
#	print STDERR pretty_print_rh($dummy_envir), "\n\n";

$INITIAL_MACRO_PACKAGES =~ tr /\r/\n/;  # change everything to unix line endings.
$pt->source_string( $INITIAL_MACRO_PACKAGES   );
$pt ->rf_safety_filter( \&safetyFilter);   # install blank safety filter
$pt ->translate();

print STDERR "New PGtranslator object inititialization completed.\n";
################################################################################
## This ends the initialization of the PGtranslator object
################################################################################

###############################################################################
# This subroutine is called by the child process.  It reinitializes its copy of the 
# PGtranslator5 object.  The unrestricted_load and loadMacros subroutines of PGtranslator5
# have been modified so that if &_PG_init is already defined then nothing
# is read in but the initialization subroutine is run instead.
###############################################################################

sub renderProblem {
    my $rh = shift;
	my $beginTime = new Benchmark;
	$Global::WARNINGS = "";
	$pt->environment($rh->{envir});
	
# 	print STDERR pretty_print_rh($rh->{envir}), "\n\n";
	
	$pt->initialize();
	$pt -> unrestricted_load($PG_PL);
	$pt -> unrestricted_load($DANGEROUS_MACROS_PL);
	$pt-> set_mask();
	
	my $string =  decode_base64( $rh ->{source}   );
	$string =~ tr /\r/\n/;
	
	$pt->source_string( $string   );
    $pt ->rf_safety_filter( \&safetyFilter);   # install blank safety filter
    $pt ->translate();
    
    
    # Determine which problem grader to use
	#$pt->rf_problem_grader($pt->rf_std_problem_grader);  #this is the default
    my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE};

    if ( defined($problem_grader_to_use) and $problem_grader_to_use   ) {  # if defined and non-empty
    	if ($problem_grader_to_use eq 'std_problem_grader') {
    	  # Reset problem grader to standard problem grader.
    		$pt->rf_problem_grader($pt->rf_std_problem_grader);
    	} elsif ($problem_grader_to_use eq 'avg_problem_grader') {
    	  # Reset problem grader to average problem grader.
            $pt->rf_problem_grader($pt->rf_avg_problem_grader);
    	} elsif (ref($problem_grader_to_use) eq 'CODE') {
          # Set problem grader to instructor defined problem grader -- use cautiously.
    		$pt->rf_problem_grader($problem_grader_to_use)
    	} else {
    	    warn "Error:  Could not understand problem grader flag $problem_grader_to_use";
    		#this is the default set by the translator and used if the flag is not understood
    		#$pt->rf_problem_grader($pt->rf_std_problem_grader);
    	}

    } else {#this is the default set by the translator and used if no flag is set.
    	$pt->rf_problem_grader($pt->rf_std_problem_grader);   
    }
    
    # creates and stores a hash of answer results: $rh_answer_results
	$pt -> process_answers($rh->{envir}->{inputs_ref});


    $pt->rh_problem_state({ recorded_score 			=> $rh->{problem_state}->{recorded_score},
    						num_of_correct_ans		=> $rh->{problem_state}->{num_of_correct_ans} ,
    						num_of_incorrect_ans	=> $rh->{problem_state}->{num_of_incorrect_ans}
    					} );
	my %PG_FLAGS = $pt->h_flags;
    my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ?
	                      $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
    my  $answers_submitted = 0;
        $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted};

    my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
                                                                 ANSWER_ENTRY_ORDER => $ra_answer_entry_order
                                                               );       # grades the problem.
    # protect image data for delivery via XML-RPC.
    # Don't send code data.
    my %PG_flag=();
#    foreach my $key (keys %PG_FLAGS) {
#    	if ($key eq 'dynamic_images' ) {
#    		foreach my $ikey (keys %{$PG_FLAGS{'dynamic_images'} })   {
#    			$PG_flag{'dynamic_images'}->{$ikey} = 
#    			    encode_base64($PG_FLAGS{'dynamic_images'}->{$ikey});
#    		}
#    	} elsif (ref($PG_FLAGS{$key}) eq '' or  ref($PG_FLAGS{$key}) =~ /SCALAR|HASH/) {
#    		$PG_flag{$key} = $PG_FLAGS{$key} ;
#    	}
#    }
    	
    
	my $out = { 	
 					text 						=> encode_base64( ${$pt ->r_text()}  ),
 	                header_text 				=> encode_base64( ${ $pt->r_header } ),
 	                answers 					=> $pt->rh_evaluated_answers,
 	                errors         				=> $pt-> errors(),
 	                WARNINGS	   				=> encode_base64($Global::WARNINGS ),
	                problem_result 				=> $rh_problem_result,
	                problem_state				=> $rh_problem_state,
	                PG_flag						=> \%PG_flag
	           };
	my $endTime = new Benchmark;
	$out->{compute_time} = logTimingInfo($beginTime, $endTime);
	$out;
	         
}

###############################################################################
# This ends the main subroutine executed by the child process in responding to 
# a request.  The other subroutines are auxiliary.
###############################################################################


sub safetyFilter {
	    my $answer = shift;  # accepts one answer and checks it
	    my $submittedAnswer = $answer;
		$answer = '' unless defined $answer;
		my ($errorno, $answerIsCorrectQ);
		$answer =~ tr/\000-\037/ /;
   #### Return if answer field is empty ########
		unless ($answer =~ /\S/) {
#			$errorno = "<BR>No answer was submitted.";
            $errorno = 0;  ## don't report blank answer as error
			
			return ($answer,$errorno);
			}
   ######### replace ^ with **    (for exponentiation)
   # 	$answer =~ s/\^/**/g;
   ######### Return if  forbidden characters are found 
		unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ )  {
			$answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c;
			$errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>";
			
			return ($answer,$errorno);
			}
		
		$errorno = 0;
		return($answer, $errorno);
}


sub logTimingInfo{
    my ($beginTime,$endTime,) = @_;
    my $out = "";
    $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) );
    $out;
}

###############

sub echo {
    my $in= shift;
    print "data  $in   end data\n";
    return(ref($in));
}
sub hello {
	print "Receiving request for hello world\n";
	return "Hello world";
}
sub pretty_print_rh {
	my $rh = shift;
	my $out = "";
	my $type = ref($rh);
	if ( ref($rh) =~/HASH/ ) {
 		foreach my $key (sort keys %{$rh})  {
 			$out .= "  $key => " . pretty_print_rh( $rh->{$key} ) . "\n";
 		}
	} elsif ( ref($rh) =~ /SCALAR/ ) {
		$out = "scalar reference ". ${$rh};
	} elsif ( ref($rh) =~/Base64/ ) {
		$out .= "base64 reference " .$$rh;
	} else {
		$out =  $rh;
	}
	if (defined($type) ) {
		$out .= " (type = $type )\n";
	}
	return $out;
}

#sub xmlquit {
#	print "exiting daemon\n";
#	return "";
#}

###############################################################################
#OTHER SERVICES
###############################################################################



use File::stat;
sub readFile {
	my $rh = shift;
	local($|)=1;
	my $out = {};
	my $filePath = $rh->{filePath};
	unless ($rh->{pw} eq $PASSWORD ) {
		$out->{error}=404;
		return($out);
	}
	if (  defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} )   ) {
		$filePath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} . $filePath;
	} else {
		$out->{error} = "Could not find library:".$rh->{library_name}.":";
		return($out);
	}
	
	if (-r $filePath) {
		open IN, "<$filePath";
		local($/)=undef;
		my $text = <IN>;
		$out->{text}= encode_base64($text);
		my $sb=stat($filePath);
		$out->{size}=$sb->size;
		$out->{path}=$filePath;
		$out->{permissions}=$sb->mode&07777;
		$out->{modTime}=scalar localtime $sb->mtime;
		close(IN);
	} else {
		$out->{error} = "Could not read file at |$filePath|";
	}
	return($out);
}



use File::Find;	
sub listLib {
	my $rh = shift;
	my $out = {};
	my $dirPath;
	unless ($rh->{pw} eq $PASSWORD ) {
		$out->{error}=404;
		return($out);
	}
	
	if (  defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} )   ) {
		$dirPath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ;
	} else {
		$out->{error} = "Could not find library:".$rh->{library_name}.":";
		return($out);
	}

	my @outListLib;
	my $wanted = sub {
		my $name = $File::Find::name;
		my @out=();
		if ($name =~/\S/ ) {
			$name =~ s|^$dirPath||o;  # cut the first directory
			push(@outListLib, "$name\n") if $name =~/\.pg/;
		}
	};
	my $command = $rh->{command};
	$command = 'all' unless defined($command);
			$command eq 'all' &&    do {print "$dirPath\n\n";
										find($wanted, $dirPath);
										@outListLib = sort @outListLib;
										$out->{ra_out} = \@outListLib;
										$out->{text} = join("", sort @outListLib);
										return($out);
			};
			$command eq 'setsOnly' &&   do {
											if ( opendir(DIR, $dirPath) ) {  
											    my @fileList=();
												while (defined(my $file = readdir(DIR))) {
													push(@fileList,$file) if -d "$dirPath/$file";
													
												}
												$out->{text} = join("\n",sort @fileList);
												closedir(DIR);
											} else {
												$out->{error}= "Can't open directory $dirPath";
											}
											return($out);
			};
			$command eq 'listSet' &&   do { my $dirPath2 = $dirPath . $rh->{set};
			
											if ( opendir(DIR, $dirPath2) ) { 
											    my @fileList =(); 
												while (defined(my $file = readdir(DIR))) {
													if (-d "$dirPath2/$file") {
														push(@fileList, "$file/${file}.pg");
													
													} elsif ($file =~ /.pg$/ ) { # file ends in .pg
														push(@fileList, $file);
													
													}
													
													
												}
												$out->{text} = join("\n",sort @fileList);
												closedir(DIR);
											} else {
												$out->{error}= "Can't open directory $dirPath2";
											}
											
											return($out);
			};
			# else
			$out->{error}="Unrecognized command $command";
			$out;
}