[system] / trunk / xmlrpc / daemon / Webwork.pm Repository:
ViewVC logotype

View of /trunk/xmlrpc/daemon/Webwork.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2989 - (download) (as text) (annotate)
Tue Nov 9 00:03:37 2004 UTC (14 years, 8 months ago) by gage
File size: 17528 byte(s)
Made changes which remove duplication between the code in Webwork.pm
and code in WW2.1  -- This should make it easier to maintain the webwork
daemons when changes are made in the core webwork code.

More changes are on the way so that the daemon can run behind apache.

    1 #!/usr/local/bin/perl -w
    2 
    3 # Copyright (C) 2001 Michael Gage
    4 
    5 ###############################################################################
    6 # The initial code simply initializes variables, defines addresses
    7 # for directories, defines some simple subroutines responders used in debugging
    8 # and makes sure that the appropriate CPAN library modules
    9 # are available.  The main code begins below that with the initialization
   10 # of the PGtranslator5 module.
   11 ###############################################################################
   12 BEGIN {
   13 
   14   use lib "$ENV{WEBWORK_ROOT}/lib";
   15 
   16 
   17 }
   18 package Webwork;
   19 
   20 BEGIN { $main::VERSION = "2.1"; }
   21 
   22 #FIXME
   23 $SIG{__WARN__} = sub {};
   24 $SIG{__DIE__} =  sub {};
   25 
   26 use strict;
   27 use sigtrap;
   28 use Carp;
   29 use Safe;
   30 
   31 use WeBWorK::CourseEnvironment;
   32 use WeBWorK::PG::Translator;
   33 use WeBWorK::DB;
   34 use WeBWorK::Constants;
   35 use WeBWorK::Utils;
   36 use WeBWorK::PG::IO;
   37 use WeBWorK::PG::ImageGenerator;
   38 use Benchmark;
   39 use MIME::Base64 qw( encode_base64 decode_base64);
   40 
   41 print "rereading Webwork\n";
   42 BEGIN {
   43   my $WW_DIRECTORY = $ENV{WEBWORK_ROOT};
   44   our $COURSENAME = 'daemon_course';
   45   our $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
   46 
   47   print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
   48 
   49 
   50   print "webwork is starting\n\n";
   51 }
   52 
   53 my $WW_DIRECTORY = $ENV{WEBWORK_ROOT};
   54 
   55 our $COURSENAME = 'daemon_course';
   56 our $HOSTURL   =  'http://devel.webwork.rochester.edu:11002';
   57 
   58 
   59 our $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
   60 
   61 print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
   62 
   63 
   64 print "webwork is realy ready\n\n";
   65 #other services
   66 # File variables
   67 my $WARNINGS='';
   68 
   69 
   70 # imported constants
   71 
   72 my $COURSE_TEMP_DIRECTORY   =   $ce->{courseDirs}->{html_tmp};
   73 my $COURSE_TEMP_URL     =   $HOSTURL.$ce->{courseURLs}->{html_tmp};
   74 
   75 my $pgMacrosDirectory     =   $ce->{pg_dir}.'/macros/';
   76 my $macroDirectory      = $ce->{courseDirs}->{macros}.'/';
   77 my $templateDirectory   =   $ce->{courseDirs}->{templates};
   78 
   79 my %PG_environment          =   $ce->{pg}->{specialPGEnvironmentVars};
   80 print STDERR "using the perl version of MIME::Base64\n";
   81 
   82 
   83 use constant DISPLAY_MODES => {
   84   # display name   # mode name
   85   tex           => "TeX",
   86   plainText     => "HTML",
   87   formattedText => "HTML_tth",
   88   images        => "HTML_dpng",
   89   jsMath        => "HTML_jsMath",
   90   asciimath     => "HTML_asciimath",
   91 };
   92 
   93 use constant DISPLAY_MODE_FAILOVER => {
   94     TeX            => [],
   95     HTML           => [],
   96     HTML_tth       => [ "HTML", ],
   97     HTML_dpng      => [ "HTML_tth", "HTML", ],
   98     HTML_jsMath    => [ "HTML_dpng", "HTML_tth", "HTML", ],
   99     HTML_asciimath => [ "HTML_dpng", "HTML_tth", "HTML", ],
  100     # legacy modes -- these are not supported, but some problems might try to
  101     # set the display mode to one of these values manually and some macros may
  102     # provide rendered versions for these modes but not the one we want.
  103     Latex2HTML  => [ "TeX", "HTML", ],
  104     HTML_img    => [ "HTML_dpng", "HTML_tth", "HTML", ],
  105   };
  106 
  107 
  108 ###############################################################################
  109 # List and address of available problemlibraries
  110 ###############################################################################
  111 
  112 
  113 #my $libraryPath        =   '/Users/gage/rochester_problib/';
  114 
  115 
  116 
  117 ###############################################################################
  118 # Initialize renderProblem
  119 ###############################################################################
  120 
  121 
  122 
  123 
  124 my $displayMode         = 'HTML_tth';
  125 
  126 my $PG_PL             =   "${pgMacrosDirectory}/PG.pl";
  127 my $DANGEROUS_MACROS_PL     =   "${pgMacrosDirectory}/dangerousMacros.pl";
  128 my $IO_PL                 =   "${pgMacrosDirectory}/IO.pl";
  129 my @MODULE_LIST         = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun",
  130                     "Circle", "Label", "PGrandom", "Units", "Hermite",
  131                     "List", "Match","Multiple", "Select", "AlgParser",
  132                     "AnswerHash", "Fraction", "VectorField", "Complex1",
  133                     "Complex", "MatrixReal1", "Matrix","Distributions",
  134                     "Regression"
  135                 );
  136 my @EXTRA_PACKAGES        = (   "AlgParserWithImplicitExpand", "Expr",
  137                     "ExprWithImplicitExpand", "AnswerEvaluator",
  138 #                   "AnswerEvaluatorMaker"
  139                 );
  140 my $INITIAL_MACRO_PACKAGES    =  <<END_OF_TEXT;
  141   DOCUMENT();
  142   loadMacros(
  143     "PGbasicmacros.pl",
  144     "PGchoicemacros.pl",
  145     "PGanswermacros.pl",
  146     "PGnumericalmacros.pl",
  147     "PGgraphmacros.pl",
  148     "PGauxiliaryFunctions.pl",
  149     "PGmatrixmacros.pl",
  150     "PGstatisticsmacros.pl",
  151     "PGcomplexmacros.pl",
  152     );
  153 
  154   ENDDOCUMENT();
  155 
  156 END_OF_TEXT
  157 
  158 ###############################################################################
  159 #
  160 ###############################################################################
  161 
  162 ###############################################################################
  163 ###############################################################################
  164 
  165 #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n";
  166 
  167 
  168 
  169 ###############################################################################
  170 # The following code initializes an instantiation of PGtranslator5 in the
  171 # parent process.  This initialized object is then share with each of the
  172 # children forked from this parent process by the daemon.
  173 #
  174 # As far as I can tell, the child processes don't share any variable values even
  175 # though their namespaces are the same.
  176 ###############################################################################
  177 
  178 
  179 my $dummy_envir = { courseScriptsDirectory  =>  $pgMacrosDirectory,
  180           displayMode       =>  $displayMode,
  181           macroDirectory      =>  $macroDirectory,
  182           displayModeFailover     =>  DISPLAY_MODE_FAILOVER(),
  183           externalTTHPath     =>  $ce->{externalPrograms}->{tth},
  184 };
  185 my $pt = new WeBWorK::PG::Translator;  #pt stands for problem translator;
  186 $pt ->rh_directories( { courseScriptsDirectory  => $pgMacrosDirectory,
  187                           macroDirectory      => $macroDirectory,
  188                           scriptDirectory     => '' ,
  189                           templateDirectory   => $templateDirectory,
  190                           tempDirectory     => $COURSE_TEMP_DIRECTORY,
  191                         }
  192 );
  193 $pt -> evaluate_modules( @MODULE_LIST);
  194 #print STDERR "Completed loading of modules, now loading extra packages\n";
  195 $pt -> load_extra_packages( @EXTRA_PACKAGES );
  196 #print STDERR "Completed loading of packages, now loading environment\n";
  197 $pt -> environment($dummy_envir);
  198 #print STDERR "Completed loading environment, next initialize\n";
  199 $pt->initialize();
  200 #print STDERR "Initialized.  \n";
  201 $pt -> unrestricted_load($PG_PL );
  202 $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
  203 $pt -> unrestricted_load($IO_PL);
  204 $pt-> set_mask();
  205 #
  206 #print STDERR "Unrestricted loads completed.\n";
  207 
  208 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/;
  209 $pt->source_string( $INITIAL_MACRO_PACKAGES   );
  210 #print STDERR "source strings read in\n";
  211 $pt ->rf_safety_filter( \&safetyFilter);   # install blank safety filter
  212 $pt ->translate();
  213 
  214 print STDERR "New PGtranslator object inititialization completed.\n";
  215 ################################################################################
  216 ## This ends the initialization of the PGtranslator object
  217 ################################################################################
  218 
  219 
  220 
  221 ###############################################################################
  222 # This subroutine is called by the child process.  It reinitializes its copy of the
  223 # PGtranslator5 object.  The unrestricted_load and loadMacros subroutines of PGtranslator5
  224 # have been modified so that if &_PG_init is already defined then nothing
  225 # is read in but the initialization subroutine is run instead.
  226 ###############################################################################
  227 
  228 sub renderProblem {
  229     my $rh = shift;
  230   my $beginTime = new Benchmark;
  231   $WARNINGS = "";
  232   local $SIG{__WARN__} =\&PG_warnings_handler;
  233 
  234   my $envir = $rh->{envir};
  235   foreach my $item (keys %PG_environment) {
  236     $envir->{$item} = $PG_environment{$item};
  237   }
  238   my $basename = 'equation-'.$envir->{psvn}. '.' .$envir->{probNum};
  239   $basename .= '.' . $envir->{problemSeed}  if $envir->{problemSeed};
  240 
  241   #FIXME  debug line
  242   #print STDERR "basename is  $basename  and psvn is ", $envir->{psvn};
  243   my $imagesModeOptions = $ce->{pg}->{displayModeOptions}->{images};
  244 
  245   # Object for generating equation images
  246     if (  $envir->{displayMode} eq 'HTML_dpng' ) {
  247               $envir->{imagegen} = WeBWorK::PG::ImageGenerator->new(
  248           tempDir         => $ce->{webworkDirs}->{tmp},           # $Global::globalTmpDirectory, # global temp dir
  249           latex         => $ce->{externalPrograms}->{latex},    #$envir->{externalLaTeXPath},
  250           dvipng          => $ce->{externalPrograms}->{dvipng}, # $envir ->{externalDvipngPath},
  251           useCache        => 1,
  252           cacheDir        => $ce->{webworkDirs}->{equationCache},
  253           cacheURL        => $HOSTURL.$ce->{webworkURLs}->{equationCache},
  254           cacheDB         => $ce->{webworkFiles}->{equationCacheDB},
  255           useMarkers      => ($imagesModeOptions->{dvipng_align} && $imagesModeOptions->{dvipng_align} eq 'mysql'),
  256           dvipng_align    => $imagesModeOptions->{dvipng_align},
  257           dvipng_depth_db => $imagesModeOptions->{dvipng_depth_db},
  258         );
  259   }
  260 
  261   $pt->environment($envir);
  262   #$pt->{safe_cache} = $safe_cmpt_cache;
  263   $pt->initialize();
  264   $pt -> unrestricted_load($PG_PL);
  265   $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
  266   $pt -> unrestricted_load($IO_PL);
  267   $pt-> set_mask();
  268 
  269   my $string =  decode_base64( $rh ->{source}   );
  270   $string =~ tr /\r/\n/;
  271 
  272   $pt->source_string( $string   );
  273     $pt ->rf_safety_filter( \&safetyFilter);   # install blank safety filter
  274     $pt ->translate();
  275 
  276     # HTML_dpng, on the other hand, uses an ImageGenerator. We have to
  277   # render the queued equations.
  278   if ($envir->{imagegen}) {
  279     my $sourceFile = 'foobar'; #$ce->{courseDirs}->{templates} . "/" . $problem->source_file;
  280     my %mtimeOption = -e $sourceFile
  281       ? (mtime => (stat $sourceFile)[9])
  282       : ();
  283 
  284     $envir->{imagegen}->render(
  285       refresh => 1,
  286       %mtimeOption,
  287     );
  288   }
  289     # Determine which problem grader to use
  290   #$pt->rf_problem_grader($pt->rf_std_problem_grader);  #this is the default
  291     my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE};
  292 
  293     if ( defined($problem_grader_to_use) and $problem_grader_to_use   ) {  # if defined and non-empty
  294       if ($problem_grader_to_use eq 'std_problem_grader') {
  295         # Reset problem grader to standard problem grader.
  296         $pt->rf_problem_grader($pt->rf_std_problem_grader);
  297       } elsif ($problem_grader_to_use eq 'avg_problem_grader') {
  298         # Reset problem grader to average problem grader.
  299             $pt->rf_problem_grader($pt->rf_avg_problem_grader);
  300       } elsif (ref($problem_grader_to_use) eq 'CODE') {
  301           # Set problem grader to instructor defined problem grader -- use cautiously.
  302         $pt->rf_problem_grader($problem_grader_to_use)
  303       } else {
  304           warn "Error:  Could not understand problem grader flag $problem_grader_to_use";
  305         #this is the default set by the translator and used if the flag is not understood
  306         #$pt->rf_problem_grader($pt->rf_std_problem_grader);
  307       }
  308 
  309     } else {#this is the default set by the translator and used if no flag is set.
  310       $pt->rf_problem_grader($pt->rf_std_problem_grader);
  311     }
  312 
  313     # creates and stores a hash of answer results: $rh_answer_results
  314   $pt -> process_answers($rh->{envir}->{inputs_ref});
  315 
  316 
  317     $pt->rh_problem_state({ recorded_score      => $rh->{problem_state}->{recorded_score},
  318                 num_of_correct_ans    => $rh->{problem_state}->{num_of_correct_ans} ,
  319                 num_of_incorrect_ans  => $rh->{problem_state}->{num_of_incorrect_ans}
  320               } );
  321   my %PG_FLAGS = $pt->h_flags;
  322     my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ?
  323                         $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
  324     my  $answers_submitted = 0;
  325         $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted};
  326 
  327     my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
  328                                                                  ANSWER_ENTRY_ORDER => $ra_answer_entry_order
  329                                                                );       # grades the problem.
  330     # protect image data for delivery via XML-RPC.
  331     # Don't send code data.
  332     my %PG_flag=();
  333 #    foreach my $key (keys %PG_FLAGS) {
  334 #     if ($key eq 'dynamic_images' ) {
  335 #       foreach my $ikey (keys %{$PG_FLAGS{'dynamic_images'} })   {
  336 #         $PG_flag{'dynamic_images'}->{$ikey} =
  337 #             encode_base64($PG_FLAGS{'dynamic_images'}->{$ikey});
  338 #       }
  339 #     } elsif (ref($PG_FLAGS{$key}) eq '' or  ref($PG_FLAGS{$key}) =~ /SCALAR|HASH/) {
  340 #       $PG_flag{$key} = $PG_FLAGS{$key} ;
  341 #     }
  342 #    }
  343 
  344       if($rh->{envir}->{displayMode} eq 'HTML_dpng') {
  345     my $forceRefresh=1;
  346 #   if($inputs{'refreshCachedImages'} || $main::refreshCachedImages
  347 #      || $displaySolutionsQ || $displayHintsQ) {
  348 #     $forceRefresh=1;
  349 #   }
  350 #   $imgen->render('refresh'=>$forceRefresh); # Can force new images
  351   }
  352   my $out = {
  353           text            => encode_base64( ${$pt ->r_text()}  ),
  354                   header_text         => encode_base64( ${ $pt->r_header } ),
  355                   answers           => $pt->rh_evaluated_answers,
  356                   errors                => $pt-> errors(),
  357                   WARNINGS            => encode_base64($WARNINGS ),
  358                   problem_result        => $rh_problem_result,
  359                   problem_state       => $rh_problem_state,
  360                   PG_flag           => \%PG_flag
  361              };
  362 
  363   my $endTime = new Benchmark;
  364   $out->{compute_time} = logTimingInfo($beginTime, $endTime);
  365   $out;
  366 
  367 }
  368 
  369 ###############################################################################
  370 # This ends the main subroutine executed by the child process in responding to
  371 # a request.  The other subroutines are auxiliary.
  372 ###############################################################################
  373 
  374 
  375 sub safetyFilter {
  376       my $answer = shift;  # accepts one answer and checks it
  377       my $submittedAnswer = $answer;
  378     $answer = '' unless defined $answer;
  379     my ($errorno, $answerIsCorrectQ);
  380     $answer =~ tr/\000-\037/ /;
  381    #### Return if answer field is empty ########
  382     unless ($answer =~ /\S/) {
  383 #     $errorno = "<BR>No answer was submitted.";
  384             $errorno = 0;  ## don't report blank answer as error
  385 
  386       return ($answer,$errorno);
  387       }
  388 
  389    ######### Return if  forbidden characters are found
  390     unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\[\]\(\)\,\|]+$/ )  {
  391       $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c;
  392       $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>";
  393 
  394       return ($answer,$errorno);
  395       }
  396 
  397     $errorno = 0;
  398     return($answer, $errorno);
  399 }
  400 
  401 
  402 sub logTimingInfo{
  403     my ($beginTime,$endTime,) = @_;
  404     my $out = "";
  405     $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) );
  406     $out;
  407 }
  408 ######################################################################
  409 sub PG_warnings_handler {
  410   my @input = @_;
  411   my $msg_string = longmess(@_);
  412   my @msg_array = split("\n",$msg_string);
  413   my $out_string = '';
  414 
  415   # Extra stack information is provided in this next block
  416   # If the warning message does NOT end in \n then a line
  417   # number is appended (see Perl manual about warn function)
  418   # The presence of the line number is detected below and extra
  419   # stack information is added.
  420   # To suppress the line number and the extra stack information
  421   # add \n to the end of a warn message (in .pl files.  In .pg
  422   # files add ~~n instead
  423 
  424 
  425   if (@msg_array) {   # if there are more details
  426     $out_string .= "##More details.  The calling sequence is: <BR>\n";
  427     foreach my $line (@msg_array) {
  428       chomp($line);
  429       next unless $line =~/\w+\:\:/;
  430       $out_string .= "----" .$line . "<BR>\n";
  431     }
  432   }
  433 
  434   $WARNINGS .="*  " . join("<BR>",@input) . "<BR>\n" . $out_string .
  435             "<BR>\n--------------------------------------<BR>\n<BR>\n";
  436 }
  437 
  438 my $CarpLevel = 0;  # How many extra package levels to skip on carp.
  439 my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
  440 sub longmess {
  441     my $error = shift;
  442     my $mess = "";
  443     my $i = 1 + $CarpLevel;
  444     my ($pack,$file,$line,$sub,$eval,$require);
  445 
  446     while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
  447       if ($error =~ m/\n$/) {
  448         $mess .= $error;
  449       }
  450       else {
  451         if (defined $eval) {
  452           if ($require) {
  453             $sub = "require $eval";
  454           }
  455           else {
  456             $eval =~ s/[\\\']/\\$&/g;
  457             if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
  458               substr($eval,$MaxEvalLen) = '...';
  459             }
  460             $sub = "eval '$eval'";
  461           }
  462         }
  463         elsif ($sub eq '(eval)') {
  464           $sub = 'eval {...}';
  465         }
  466 
  467         $mess .= "\t$sub " if $error eq "called";
  468         $mess .= "$error at $file line $line\n";
  469       }
  470 
  471       $error = "called";
  472     }
  473 
  474     $mess || $error;
  475 }
  476 
  477 ######################################################################
  478 
  479 sub echo {
  480     my $in= shift;
  481     return(ref($in));
  482 }
  483 sub hello {
  484   print "Receiving request for hello world\n";
  485   return "Hello world";
  486 }
  487 sub pretty_print_rh {
  488   my $rh = shift;
  489   my $out = "";
  490   my $type = ref($rh);
  491   if ( ref($rh) =~/HASH/ ) {
  492     foreach my $key (sort keys %{$rh})  {
  493       $out .= "  $key => " . pretty_print_rh( $rh->{$key} ) . "\n";
  494     }
  495   } elsif ( ref($rh) =~ /SCALAR/ ) {
  496     $out = "scalar reference ". ${$rh};
  497   } elsif ( ref($rh) =~/Base64/ ) {
  498     $out .= "base64 reference " .$$rh;
  499   } else {
  500     $out =  $rh;
  501   }
  502   if (defined($type) ) {
  503     $out .= "type = $type \n";
  504   }
  505   return $out;
  506 }
  507 
  508 
  509 
  510 
  511 
  512 
  513 
  514 
  515 
  516 
  517 
  518 
  519 
  520 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9