Parent Directory
| 
Revision Log
Revision 399 - (view) (download) (as text)
| 1 : | malsyned | 353 | package WeBWorK::ContentGenerator::Problem; |
| 2 : | our @ISA = qw(WeBWorK::ContentGenerator); | ||
| 3 : | malsyned | 396 | |
| 4 : | use strict; | ||
| 5 : | use warnings; | ||
| 6 : | use lib '/home/malsyned/xmlrpc/daemon'; | ||
| 7 : | gage | 388 | use lib '/Users/gage/webwork-modperl/lib'; |
| 8 : | use PGtranslator5; | ||
| 9 : | malsyned | 353 | use WeBWorK::ContentGenerator; |
| 10 : | use Apache::Constants qw(:common); | ||
| 11 : | |||
| 12 : | gage | 392 | ############################################################################### |
| 13 : | # Configuration | ||
| 14 : | ############################################################################### | ||
| 15 : | gage | 398 | my $USER_DIRECTORY = '/Users/gage'; |
| 16 : | my $COURSE_SCRIPTS_DIRECTORY = "$USER_DIRECTORY/webwork/system/courseScripts/"; | ||
| 17 : | my $MACRO_DIRECTORY = "$USER_DIRECTORY/webwork-modperl/courses/demoCourse/templates/macros/"; | ||
| 18 : | my $TEMPLATE_DIRECTORY = "$USER_DIRECTORY/rochester_problib/"; | ||
| 19 : | my $TEMP_URL = "http://127.0.0.1/~gage/rochester_problibtmp/"; | ||
| 20 : | ##my $HTML_DIRECTORY = "/Users/gage/Sites/rochester_problib/" #already obtained from courseEnvironment | ||
| 21 : | my $HTML_URL = "http://127.0.0.1/~gage/rochester_problib/"; | ||
| 22 : | malsyned | 396 | my $TEMP_DIRECTORY = ""; # has to be here... for now |
| 23 : | gage | 392 | |
| 24 : | ############################################################################### | ||
| 25 : | # End configuration | ||
| 26 : | ############################################################################### | ||
| 27 : | |||
| 28 : | malsyned | 353 | sub title { |
| 29 : | my ($self, $problem_set, $problem) = @_; | ||
| 30 : | my $r = $self->{r}; | ||
| 31 : | my $user = $r->param('user'); | ||
| 32 : | return "Problem $problem of problem set $problem_set for $user"; | ||
| 33 : | } | ||
| 34 : | |||
| 35 : | gage | 392 | ############################################################################### |
| 36 : | # | ||
| 37 : | # INITIALIZATION | ||
| 38 : | # | ||
| 39 : | # The following code initializes an instantiation of PGtranslator5 in the | ||
| 40 : | # parent process. This initialized object is then share with each of the | ||
| 41 : | # children forked from this parent process by the daemon. | ||
| 42 : | # | ||
| 43 : | # As far as I can tell, the child processes don't share any variable values even | ||
| 44 : | # though their namespaces are the same. | ||
| 45 : | ############################################################################### | ||
| 46 : | # First some dummy values to use for testing. | ||
| 47 : | # These should be available from the problemEnvironment(it might be ok to assume that PG and dangerousMacros | ||
| 48 : | # live in the courseScripts (system level macros) directory. | ||
| 49 : | |||
| 50 : | malsyned | 396 | #print STDERR "Begin intitalization\n"; |
| 51 : | gage | 392 | my $dummy_envir = { courseScriptsDirectory => $COURSE_SCRIPTS_DIRECTORY, |
| 52 : | displayMode => 'HTML_tth', | ||
| 53 : | macroDirectory => $MACRO_DIRECTORY, | ||
| 54 : | cgiURL => 'foo_cgiURL'}; | ||
| 55 : | |||
| 56 : | |||
| 57 : | my $PG_PL = "${COURSE_SCRIPTS_DIRECTORY}PG.pl"; | ||
| 58 : | my $DANGEROUS_MACROS_PL = "${COURSE_SCRIPTS_DIRECTORY}dangerousMacros.pl"; | ||
| 59 : | my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", | ||
| 60 : | "Circle", "Label", "PGrandom", "Units", "Hermite", | ||
| 61 : | "List", "Match","Multiple", "Select", "AlgParser", | ||
| 62 : | "AnswerHash", "Fraction", "VectorField", "Complex1", | ||
| 63 : | "Complex", "MatrixReal1", "Matrix","Distributions", | ||
| 64 : | "Regression" | ||
| 65 : | ); | ||
| 66 : | my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", | ||
| 67 : | "ExprWithImplicitExpand", "AnswerEvaluator", | ||
| 68 : | |||
| 69 : | ); | ||
| 70 : | malsyned | 396 | my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT; |
| 71 : | gage | 392 | DOCUMENT(); |
| 72 : | loadMacros( | ||
| 73 : | "PGbasicmacros.pl", | ||
| 74 : | "PGchoicemacros.pl", | ||
| 75 : | "PGanswermacros.pl", | ||
| 76 : | "PGnumericalmacros.pl", | ||
| 77 : | "PGgraphmacros.pl", | ||
| 78 : | "PGauxiliaryFunctions.pl", | ||
| 79 : | "PGmatrixmacros.pl", | ||
| 80 : | "PGcomplexmacros.pl", | ||
| 81 : | "PGstatisticsmacros.pl" | ||
| 82 : | |||
| 83 : | ); | ||
| 84 : | |||
| 85 : | TEXT("Hello world"); | ||
| 86 : | |||
| 87 : | ENDDOCUMENT(); | ||
| 88 : | |||
| 89 : | END_OF_TEXT | ||
| 90 : | |||
| 91 : | #These here documents have their drawbacks. KEEP END_OF_TEXT left justified!!!!!! | ||
| 92 : | |||
| 93 : | ############################################################################### | ||
| 94 : | # Now to define the body subroutine which does the hard work. | ||
| 95 : | ############################################################################### | ||
| 96 : | |||
| 97 : | |||
| 98 : | #my $SOURCE1 = $INITIAL_MACRO_PACKAGES; | ||
| 99 : | |||
| 100 : | malsyned | 353 | sub body { |
| 101 : | my ($self, $problem_set, $problem) = @_; | ||
| 102 : | my $r = $self->{r}; | ||
| 103 : | my $courseEnvironment = $self->{courseEnvironment}; | ||
| 104 : | my $user = $r->param('user'); | ||
| 105 : | |||
| 106 : | malsyned | 396 | my $rh = {}; # this needs to be set to a hash containing CGI params |
| 107 : | gage | 388 | |
| 108 : | malsyned | 396 | |
| 109 : | my $SOURCE1 = readFile("$problem_set/$problem.pg"); | ||
| 110 : | gage | 392 | print STDERR "SOURCEFILE: \n$SOURCE1\n\n"; |
| 111 : | gage | 388 | |
| 112 : | ########################################################################### | ||
| 113 : | # The pg problem class should have a method for installing it's problemEnvironment | ||
| 114 : | ########################################################################### | ||
| 115 : | |||
| 116 : | malsyned | 396 | my $problemEnvir_rh = defineProblemEnvir($self); |
| 117 : | gage | 388 | |
| 118 : | gage | 392 | |
| 119 : | ################################################################################## | ||
| 120 : | # Prime the PGtranslator object and set it loose | ||
| 121 : | ################################################################################## | ||
| 122 : | |||
| 123 : | |||
| 124 : | ############################################################################### | ||
| 125 : | |||
| 126 : | ############################################################################### | ||
| 127 : | #Create the PG translator. | ||
| 128 : | ############################################################################### | ||
| 129 : | |||
| 130 : | my $pt = new PGtranslator5; #pt stands for problem translator; | ||
| 131 : | |||
| 132 : | |||
| 133 : | # All of these hard coded directories need to be drawn from courseEnvironment. | ||
| 134 : | # In addition I don't think that PGtranslator uses this stack internally yet. | ||
| 135 : | # Passing these directories through the problemEnvironment variable is what | ||
| 136 : | # is currently being done, but I don't think it is quite right, at least for most | ||
| 137 : | # of them. | ||
| 138 : | |||
| 139 : | |||
| 140 : | $pt ->rh_directories( { courseScriptsDirectory => $COURSE_SCRIPTS_DIRECTORY, | ||
| 141 : | macroDirectory => $MACRO_DIRECTORY, | ||
| 142 : | , | ||
| 143 : | templateDirectory => $TEMPLATE_DIRECTORY, | ||
| 144 : | tempDirectory => $TEMP_DIRECTORY, | ||
| 145 : | } | ||
| 146 : | ); | ||
| 147 : | |||
| 148 : | ############################################################################### | ||
| 149 : | # First we load the modules from courseScripts directory. | ||
| 150 : | # These do the "heavy lifting" in terms of formatting, creating graphs, and | ||
| 151 : | # performing other heavy duty algorithms. | ||
| 152 : | # | ||
| 153 : | ############################################################################### | ||
| 154 : | |||
| 155 : | $pt -> evaluate_modules( @MODULE_LIST); | ||
| 156 : | $pt -> load_extra_packages( @EXTRA_PACKAGES ); | ||
| 157 : | |||
| 158 : | ############################################################################### | ||
| 159 : | # Load the environment constants. Some are used by the PGtranslator object but | ||
| 160 : | # most of them are installed inside the Safe compartment where the problem | ||
| 161 : | # runs. | ||
| 162 : | ############################################################################### | ||
| 163 : | #$pt -> environment($dummy_envir); | ||
| 164 : | $pt -> environment($problemEnvir_rh); | ||
| 165 : | |||
| 166 : | |||
| 167 : | # I've forgotten what this does exactly :-) | ||
| 168 : | $pt->initialize(); | ||
| 169 : | |||
| 170 : | ############################################################################### | ||
| 171 : | # PG.pl contains the basic code which defines the problem interface, input and output. | ||
| 172 : | # dangerousMacros.pl contains subroutines which have access to the hard drive and | ||
| 173 : | # and the directory structure. All use of external resources by the problem is supposed | ||
| 174 : | # to go through these subroutines. The idea is to put the potentially dangerous | ||
| 175 : | # algorithms in on place so they can be watched closely. | ||
| 176 : | # These two files are evaluated in the Safe compartment without any restrictions. | ||
| 177 : | # They have full use of the perl commands. | ||
| 178 : | ############################################################################### | ||
| 179 : | my $loadErrors = $pt -> unrestricted_load($PG_PL ); | ||
| 180 : | print STDERR "$loadErrors\n" if ($loadErrors); | ||
| 181 : | $loadErrors = $pt -> unrestricted_load($DANGEROUS_MACROS_PL); | ||
| 182 : | print STDERR "$loadErrors\n" if ($loadErrors); | ||
| 183 : | |||
| 184 : | ############################################################################### | ||
| 185 : | # Now set the mask to restrict the operations which can be performed within | ||
| 186 : | # a problem or a macro file. | ||
| 187 : | ############################################################################### | ||
| 188 : | $pt-> set_mask(); | ||
| 189 : | |||
| 190 : | # print "\nPG.pl: $PG_PL<br>\n"; | ||
| 191 : | # print "DANGEROUS_MACROS_PL: $DANGEROUS_MACROS_PL<br>\n"; | ||
| 192 : | # print "Print dummy environment<br>\n"; | ||
| 193 : | # print pretty_print_rh($dummy_envir), "<p>\n\n"; | ||
| 194 : | |||
| 195 : | # Read in the source code for the problem | ||
| 196 : | |||
| 197 : | #$INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; # change everything to unix line endings. | ||
| 198 : | $SOURCE1 =~ tr /\r/\n/; | ||
| 199 : | #print STDERR "Source again \n $SOURCE1"; | ||
| 200 : | $pt->source_string( $SOURCE1 ); | ||
| 201 : | |||
| 202 : | ############################################################################### | ||
| 203 : | # Install a safety filter for screening student answers. The default is now the blank | ||
| 204 : | # filter since the answer evaluators do a pretty good job of recompiling and screening | ||
| 205 : | # student's answers. Still, you could prohibit back ticks, or something of the kind. | ||
| 206 : | ############################################################################### | ||
| 207 : | |||
| 208 : | $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter | ||
| 209 : | |||
| 210 : | |||
| 211 : | print STDERR "New PGtranslator object inititialization completed.<br>\n"; | ||
| 212 : | ################################################################################ | ||
| 213 : | ## This ends the initialization of the PGtranslator object | ||
| 214 : | ################################################################################ | ||
| 215 : | |||
| 216 : | |||
| 217 : | ################################################################################ | ||
| 218 : | # Run the problem (output the html text) but also store it within the object. | ||
| 219 : | # The correct answers are also calculated and stored within the object | ||
| 220 : | ################################################################################ | ||
| 221 : | $pt ->translate(); | ||
| 222 : | |||
| 223 : | #print problem output | ||
| 224 : | print "Problem goes here<p>\n"; | ||
| 225 : | print "Problem output <br>\n"; | ||
| 226 : | malsyned | 396 | print "################################################################################<br><br>"; |
| 227 : | gage | 392 | print ${$pt->r_text()}; |
| 228 : | print "<br><br>################################################################################<br>"; | ||
| 229 : | print "<p>End of problem output<br>"; | ||
| 230 : | |||
| 231 : | |||
| 232 : | #print source code | ||
| 233 : | print "Source code<pre>\n"; | ||
| 234 : | print $SOURCE1; | ||
| 235 : | print "</pre>End source code<p>"; | ||
| 236 : | ################################################################################ | ||
| 237 : | # The format for the output is described here. We'll need a local variable | ||
| 238 : | # to handle the warnings. From within the problem the warning command | ||
| 239 : | # has been slaved to the __WARNINGS__ routine which is defined in Global. | ||
| 240 : | # We'll need to provide an alternate mechanism. | ||
| 241 : | # The base64 encoding is only needed for xml transmission. | ||
| 242 : | ################################################################################ | ||
| 243 : | print "################################################################################<br>"; | ||
| 244 : | print "Warnings output<br>"; | ||
| 245 : | my $WARNINGS = "Let this be a warning:"; | ||
| 246 : | |||
| 247 : | print $WARNINGS; | ||
| 248 : | |||
| 249 : | ################################################################################ | ||
| 250 : | # Install the standard problem grader. See gage/xmlrpc/daemon.pm or processProblem8 for detailed | ||
| 251 : | # code on how to choose which problem grader to install, depending on courseEnvironment and problem data. | ||
| 252 : | # See also PG.pl which provides for problem by problem overrides. | ||
| 253 : | ################################################################################ | ||
| 254 : | |||
| 255 : | $pt->rf_problem_grader($pt->rf_std_problem_grader); | ||
| 256 : | |||
| 257 : | ################################################################################ | ||
| 258 : | # creates and stores a hash of answer results inside the object: $rh_answer_results | ||
| 259 : | ################################################################################ | ||
| 260 : | $pt -> process_answers($rh->{envir}->{inputs_ref}); | ||
| 261 : | |||
| 262 : | |||
| 263 : | # THE UPDATE AND GRADING LOGIC COULD USE AN OVERHAUL. IT WAS SOMEWHAT CONSTRAINED | ||
| 264 : | # BY LEGACY CONDITIONS IN THE ORIGINAL PROCESSPROBLEM8. IT'S NOT BAD | ||
| 265 : | # BUT IT COULD PROBABLY BE MADE A LITTLE MORE STRAIGHT FORWARD. | ||
| 266 : | ################################################################################ | ||
| 267 : | # updates the problem state stored by the translator object from the problemEnvironment data | ||
| 268 : | ################################################################################ | ||
| 269 : | |||
| 270 : | # $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score}, | ||
| 271 : | # num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} , | ||
| 272 : | # num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans} | ||
| 273 : | # } ); | ||
| 274 : | ################################################################################ | ||
| 275 : | # grade the problem (and update the problem state again.) | ||
| 276 : | ################################################################################ | ||
| 277 : | |||
| 278 : | # Define an entry order -- the default is the order they are received from the browser. | ||
| 279 : | # (Which as I understand it is NOT guaranteed to be the Left->Right Up-> Down order we're | ||
| 280 : | # used to in the West. | ||
| 281 : | |||
| 282 : | my %PG_FLAGS = $pt->h_flags; | ||
| 283 : | my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ? | ||
| 284 : | $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; | ||
| 285 : | # Decide whether any answers were submitted. | ||
| 286 : | my $answers_submitted = 0; | ||
| 287 : | $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted}; | ||
| 288 : | # If there are answers, grade them | ||
| 289 : | my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted, | ||
| 290 : | ANSWER_ENTRY_ORDER => $ra_answer_entry_order | ||
| 291 : | ); # grades the problem. | ||
| 292 : | |||
| 293 : | # Output format expected by Webwork.pm (and I believe processProblem8, but check.) | ||
| 294 : | my $out = { | ||
| 295 : | text => ${$pt ->r_text()}, # encode_base64( ${$pt ->r_text()} ), | ||
| 296 : | header_text => $pt->r_header, # encode_base64( ${ $pt->r_header } ), | ||
| 297 : | answers => $pt->rh_evaluated_answers, | ||
| 298 : | errors => $pt-> errors(), | ||
| 299 : | WARNINGS => $WARNINGS, #encode_base64($WARNINGS ), | ||
| 300 : | problem_result => $rh_problem_result, | ||
| 301 : | problem_state => $rh_problem_state, | ||
| 302 : | malsyned | 396 | PG_flag => \%PG_FLAGS |
| 303 : | gage | 392 | }; |
| 304 : | ########################################################################################## | ||
| 305 : | # Debugging printout of environment tables | ||
| 306 : | ########################################################################################## | ||
| 307 : | |||
| 308 : | print "<P>Request item<P>\n\n"; | ||
| 309 : | print "<TABLE border=\"3\">"; | ||
| 310 : | print $self->print_form_data('<tr><td>','</td><td>','</td></tr>'); | ||
| 311 : | print "</table>\n"; | ||
| 312 : | print "path info <br>\n"; | ||
| 313 : | print $r->path_info(); | ||
| 314 : | print "<P>\n\ncourseEnvironment<P>\n\n"; | ||
| 315 : | print pretty_print_rh($courseEnvironment); | ||
| 316 : | gage | 388 | print "<P>\n\nproblemEnvironment<P>\n\n"; |
| 317 : | print pretty_print_rh($problemEnvir_rh); | ||
| 318 : | gage | 392 | |
| 319 : | ########################################################################################## | ||
| 320 : | # End | ||
| 321 : | ########################################################################################## | ||
| 322 : | ""; | ||
| 323 : | malsyned | 353 | } |
| 324 : | gage | 392 | # End the"body" routine for the Problem object. |
| 325 : | malsyned | 353 | |
| 326 : | gage | 388 | |
| 327 : | gage | 399 | sub safetyFilter { |
| 328 : | my $answer = shift; # accepts one answer and checks it | ||
| 329 : | my $submittedAnswer = $answer; | ||
| 330 : | $answer = '' unless defined $answer; | ||
| 331 : | my ($errorno); | ||
| 332 : | $answer =~ tr/\000-\037/ /; | ||
| 333 : | #### Return if answer field is empty ######## | ||
| 334 : | unless ($answer =~ /\S/) { | ||
| 335 : | # $errorno = "<BR>No answer was submitted."; | ||
| 336 : | $errorno = 0; ## don't report blank answer as error | ||
| 337 : | gage | 392 | |
| 338 : | gage | 399 | return ($answer,$errorno); |
| 339 : | } | ||
| 340 : | ######### replace ^ with ** (for exponentiation) | ||
| 341 : | # $answer =~ s/\^/**/g; | ||
| 342 : | ######### Return if forbidden characters are found | ||
| 343 : | unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { | ||
| 344 : | $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; | ||
| 345 : | $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; | ||
| 346 : | gage | 392 | |
| 347 : | gage | 399 | return ($answer,$errorno); |
| 348 : | } | ||
| 349 : | gage | 392 | |
| 350 : | gage | 399 | $errorno = 0; |
| 351 : | return($answer, $errorno); | ||
| 352 : | } | ||
| 353 : | gage | 392 | |
| 354 : | gage | 399 | |
| 355 : | |||
| 356 : | |||
| 357 : | gage | 388 | ######################################################################################## |
| 358 : | gage | 392 | # This is the problemEnvironment structure that needs to be filled out in order to provide |
| 359 : | # information to PGtranslator which in turn supports the problem environment | ||
| 360 : | gage | 388 | ######################################################################################## |
| 361 : | |||
| 362 : | sub defineProblemEnvir { | ||
| 363 : | my $self = shift; | ||
| 364 : | my $r = $self->{r}; | ||
| 365 : | my $courseEnvironment = $self->{courseEnvironment}; | ||
| 366 : | my %envir=(); | ||
| 367 : | # $envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers); | ||
| 368 : | $envir{'psvnNumber'} = 123456789; | ||
| 369 : | $envir{'psvn'} = 123456789; | ||
| 370 : | $envir{'studentName'} = 'Jane Doe'; | ||
| 371 : | $envir{'studentLogin'} = 'jd001m'; | ||
| 372 : | $envir{'studentID'} = 'xxx-xx-4321'; | ||
| 373 : | $envir{'sectionName'} = 'gage'; | ||
| 374 : | $envir{'sectionNumber'} = '111foobar'; | ||
| 375 : | $envir{'recitationName'} = 'gage_recitation'; | ||
| 376 : | $envir{'recitationNumber'} = '11_foobar recitation'; | ||
| 377 : | $envir{'setNumber'} = 'setAlgebraicGeometry'; | ||
| 378 : | $envir{'questionNumber'} = 43; | ||
| 379 : | $envir{'probNum'} = 43; | ||
| 380 : | $envir{'openDate'} = 3014438528; | ||
| 381 : | $envir{'formattedOpenDate'} = '3/4/02'; | ||
| 382 : | $envir{'dueDate'} = 4014438528; | ||
| 383 : | $envir{'formattedDueDate'} = '10/4/04'; | ||
| 384 : | $envir{'answerDate'} = 4014438528; | ||
| 385 : | $envir{'formattedAnswerDate'} = '10/4/04'; | ||
| 386 : | $envir{'problemValue'} = 1; | ||
| 387 : | $envir{'fileName'} = 'problem1'; | ||
| 388 : | $envir{'probFileName'} = 'problem1'; | ||
| 389 : | $envir{'languageMode'} = 'HTML_tth'; | ||
| 390 : | $envir{'displayMode'} = 'HTML_tth'; | ||
| 391 : | $envir{'outputMode'} = 'HTML_tth'; | ||
| 392 : | $envir{'courseName'} = $courseEnvironment ->{courseName}; | ||
| 393 : | $envir{'sessionKey'} = 'asdf'; | ||
| 394 : | |||
| 395 : | # initialize constants for PGanswermacros.pl | ||
| 396 : | $envir{'numRelPercentTolDefault'} = .1; | ||
| 397 : | $envir{'numZeroLevelDefault'} = 1E-14; | ||
| 398 : | $envir{'numZeroLevelTolDefault'} = 1E-12; | ||
| 399 : | $envir{'numAbsTolDefault'} = .001; | ||
| 400 : | $envir{'numFormatDefault'} = ''; | ||
| 401 : | $envir{'functRelPercentTolDefault'} = .1; | ||
| 402 : | $envir{'functZeroLevelDefault'} = 1E-14; | ||
| 403 : | $envir{'functZeroLevelTolDefault'} = 1E-12; | ||
| 404 : | $envir{'functAbsTolDefault'} = .001; | ||
| 405 : | $envir{'functNumOfPoints'} = 3; | ||
| 406 : | $envir{'functVarDefault'} = 'x'; | ||
| 407 : | $envir{'functLLimitDefault'} = .0000001; | ||
| 408 : | $envir{'functULimitDefault'} = .9999999; | ||
| 409 : | $envir{'functMaxConstantOfIntegration'} = 1E8; | ||
| 410 : | # kludge check definition of number of attempts again. The +1 is because this is used before the current answer is evaluated. | ||
| 411 : | $envir{'numOfAttempts'} = 2; #&getProblemNumOfCorrectAns($probNum,$psvn) | ||
| 412 : | # &getProblemNumOfIncorrectAns($probNum,$psvn)+1; | ||
| 413 : | |||
| 414 : | # | ||
| 415 : | # | ||
| 416 : | # defining directorys and URLs | ||
| 417 : | $envir{'templateDirectory'} = $courseEnvironment ->{courseDirs}->{templates}; | ||
| 418 : | ############ $envir{'classDirectory'} = $Global::classDirectory; | ||
| 419 : | # $envir{'cgiDirectory'} = $Global::cgiDirectory; | ||
| 420 : | # $envir{'cgiURL'} = getWebworkCgiURL(); | ||
| 421 : | gage | 392 | |
| 422 : | gage | 388 | # $envir{'scriptDirectory'} = $Global::scriptDirectory;##omit |
| 423 : | $envir{'webworkDocsURL'} = 'http://webwork.math.rochester.edu'; | ||
| 424 : | $envir{'externalTTHPath'} = '/usr/local/bin/tth'; | ||
| 425 : | |||
| 426 : | |||
| 427 : | # | ||
| 428 : | $envir{'inputs_ref'} = $r->param; | ||
| 429 : | $envir{'problemSeed'} = 3245; | ||
| 430 : | $envir{'displaySolutionsQ'} = 1; | ||
| 431 : | $envir{'displayHintsQ'} = 1; | ||
| 432 : | |||
| 433 : | gage | 392 | # Directory values -- do we really need them here? |
| 434 : | $envir{courseScriptsDirectory} = $COURSE_SCRIPTS_DIRECTORY; | ||
| 435 : | $envir{macroDirectory} = $MACRO_DIRECTORY; | ||
| 436 : | $envir{templateDirectory} = $TEMPLATE_DIRECTORY; | ||
| 437 : | $envir{tempDirectory} = $TEMP_DIRECTORY; | ||
| 438 : | $envir{tempURL} = $TEMP_URL; | ||
| 439 : | $envir{htmlURL} = $HTML_URL; | ||
| 440 : | $envir{'htmlDirectory'} = $courseEnvironment ->{courseDirectory}->{html}; | ||
| 441 : | gage | 388 | # here is a way to pass environment variables defined in webworkCourse.ph |
| 442 : | # my $k; | ||
| 443 : | # foreach $k (keys %Global::PG_environment ) { | ||
| 444 : | # $envir{$k} = $Global::PG_environment{$k}; | ||
| 445 : | # } | ||
| 446 : | \%envir; | ||
| 447 : | } | ||
| 448 : | |||
| 449 : | ######################################################################################## | ||
| 450 : | # This recursive pretty_print function will print a hash and its sub hashes. | ||
| 451 : | ######################################################################################## | ||
| 452 : | sub pretty_print_rh { | ||
| 453 : | my $r_input = shift; | ||
| 454 : | my $out = ''; | ||
| 455 : | if ( not ref($r_input) ) { | ||
| 456 : | $out = $r_input; # not a reference | ||
| 457 : | } elsif (is_hash_ref($r_input)) { | ||
| 458 : | local($^W) = 0; | ||
| 459 : | $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">"; | ||
| 460 : | foreach my $key (sort keys %$r_input ) { | ||
| 461 : | $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print_rh($r_input->{$key}) . "</td></tr>"; | ||
| 462 : | } | ||
| 463 : | $out .="</table>"; | ||
| 464 : | } elsif (is_array_ref($r_input) ) { | ||
| 465 : | my @array = @$r_input; | ||
| 466 : | $out .= "( " ; | ||
| 467 : | while (@array) { | ||
| 468 : | $out .= pretty_print_rh(shift @array) . " , "; | ||
| 469 : | } | ||
| 470 : | $out .= " )"; | ||
| 471 : | } elsif (ref($r_input) eq 'CODE') { | ||
| 472 : | $out = "$r_input"; | ||
| 473 : | } else { | ||
| 474 : | $out = $r_input; | ||
| 475 : | } | ||
| 476 : | $out; | ||
| 477 : | } | ||
| 478 : | |||
| 479 : | sub is_hash_ref { | ||
| 480 : | my $in =shift; | ||
| 481 : | my $save_SIG_die_trap = $SIG{__DIE__}; | ||
| 482 : | $SIG{__DIE__} = sub {CORE::die(@_) }; | ||
| 483 : | my $out = eval{ %{ $in } }; | ||
| 484 : | $out = ($@ eq '') ? 1 : 0; | ||
| 485 : | $@=''; | ||
| 486 : | $SIG{__DIE__} = $save_SIG_die_trap; | ||
| 487 : | $out; | ||
| 488 : | } | ||
| 489 : | sub is_array_ref { | ||
| 490 : | my $in =shift; | ||
| 491 : | my $save_SIG_die_trap = $SIG{__DIE__}; | ||
| 492 : | $SIG{__DIE__} = sub {CORE::die(@_) }; | ||
| 493 : | my $out = eval{ @{ $in } }; | ||
| 494 : | $out = ($@ eq '') ? 1 : 0; | ||
| 495 : | $@=''; | ||
| 496 : | $SIG{__DIE__} = $save_SIG_die_trap; | ||
| 497 : | $out; | ||
| 498 : | } | ||
| 499 : | gage | 392 | |
| 500 : | ###### | ||
| 501 : | # Utility for slurping souce files | ||
| 502 : | ####### | ||
| 503 : | |||
| 504 : | sub readFile { | ||
| 505 : | my $input = shift; # The set and problem: 'set0/prob1.pg' | ||
| 506 : | my $filePath =$TEMPLATE_DIRECTORY .$input; | ||
| 507 : | print STDERR "Reading problem from file $filePath \n"; | ||
| 508 : | print STDERR "<br>Reading problem from file $filePath <br>\n"; | ||
| 509 : | my $out; | ||
| 510 : | print "The file is readable = ", -r $filePath, "\n"; | ||
| 511 : | if (-r $filePath) { | ||
| 512 : | open IN, "<$filePath" or print STDERR "Hey, this file was supposed to be readable\n"; | ||
| 513 : | local($/)=undef; | ||
| 514 : | $out = <IN>; | ||
| 515 : | close(IN); | ||
| 516 : | } else { | ||
| 517 : | print "Could not read file at |$filePath|"; | ||
| 518 : | print STDERR "Could not read file at |$filePath|"; | ||
| 519 : | } | ||
| 520 : | return($out); | ||
| 521 : | } | ||
| 522 : | |||
| 523 : | my $foo =0; | ||
| 524 : | |||
| 525 : | # The warning mechanism. This needs to be turned into an object of its own | ||
| 526 : | ############### | ||
| 527 : | ## Error message routines cribbed from CGI | ||
| 528 : | ############### | ||
| 529 : | |||
| 530 : | BEGIN { #error message routines cribbed from CGI | ||
| 531 : | |||
| 532 : | my $CarpLevel = 0; # How many extra package levels to skip on carp. | ||
| 533 : | my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. | ||
| 534 : | |||
| 535 : | sub longmess { | ||
| 536 : | my $error = shift; | ||
| 537 : | my $mess = ""; | ||
| 538 : | my $i = 1 + $CarpLevel; | ||
| 539 : | my ($pack,$file,$line,$sub,$eval,$require); | ||
| 540 : | |||
| 541 : | while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) { | ||
| 542 : | if ($error =~ m/\n$/) { | ||
| 543 : | $mess .= $error; | ||
| 544 : | } | ||
| 545 : | else { | ||
| 546 : | if (defined $eval) { | ||
| 547 : | if ($require) { | ||
| 548 : | $sub = "require $eval"; | ||
| 549 : | } | ||
| 550 : | else { | ||
| 551 : | $eval =~ s/[\\\']/\\$&/g; | ||
| 552 : | if ($MaxEvalLen && length($eval) > $MaxEvalLen) { | ||
| 553 : | substr($eval,$MaxEvalLen) = '...'; | ||
| 554 : | } | ||
| 555 : | $sub = "eval '$eval'"; | ||
| 556 : | } | ||
| 557 : | } | ||
| 558 : | elsif ($sub eq '(eval)') { | ||
| 559 : | $sub = 'eval {...}'; | ||
| 560 : | } | ||
| 561 : | |||
| 562 : | $mess .= "\t$sub " if $error eq "called"; | ||
| 563 : | $mess .= "$error at $file line $line\n"; | ||
| 564 : | } | ||
| 565 : | |||
| 566 : | $error = "called"; | ||
| 567 : | } | ||
| 568 : | |||
| 569 : | $mess || $error; | ||
| 570 : | } | ||
| 571 : | } | ||
| 572 : | ############### | ||
| 573 : | ### Our error messages for giving maximum feedback to the user for errors within problems. | ||
| 574 : | ############### | ||
| 575 : | BEGIN { | ||
| 576 : | sub PG_floating_point_exception_handler { # 1st argument is signal name | ||
| 577 : | my($sig) = @_; | ||
| 578 : | print "Content-type: text/html\n\n<H4>There was a floating point arithmetic error (exception SIG$sig )</H4>--perhaps | ||
| 579 : | you divided by zero or took the square root of a negative number? | ||
| 580 : | <BR>\n Use the back button to return to the previous page and recheck your entries.<BR>\n"; | ||
| 581 : | exit(0); | ||
| 582 : | } | ||
| 583 : | |||
| 584 : | $SIG{'FPE'} = \&PG_floating_point_exception_handler; | ||
| 585 : | malsyned | 396 | #!/usr/bin/perl -w |
| 586 : | gage | 392 | sub PG_warnings_handler { |
| 587 : | my @input = @_; | ||
| 588 : | my $msg_string = longmess(@_); | ||
| 589 : | my @msg_array = split("\n",$msg_string); | ||
| 590 : | my $out_string = ''; | ||
| 591 : | |||
| 592 : | # Extra stack information is provided in this next block | ||
| 593 : | # If the warning message does NOT end in \n then a line | ||
| 594 : | # number is appended (see Perl manual about warn function) | ||
| 595 : | # The presence of the line number is detected below and extra | ||
| 596 : | # stack information is added. | ||
| 597 : | # To suppress the line number and the extra stack information | ||
| 598 : | # add \n to the end of a warn message (in .pl files. In .pg | ||
| 599 : | # files add ~~n instead | ||
| 600 : | |||
| 601 : | if ($input[$#input]=~/line \d*\.\s*$/) { | ||
| 602 : | $out_string .= "##More details: <BR>\n----"; | ||
| 603 : | foreach my $line (@msg_array) { | ||
| 604 : | chomp($line); | ||
| 605 : | next unless $line =~/\w+\:\:/; | ||
| 606 : | $out_string .= "----" .$line . "<BR>\n"; | ||
| 607 : | } | ||
| 608 : | } | ||
| 609 : | |||
| 610 : | $Global::WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string . | ||
| 611 : | "<BR>\n--------------------------------------<BR>\n<BR>\n"; | ||
| 612 : | $Global::background_plain_url = $Global::background_warn_url; | ||
| 613 : | $Global::bg_color = '#FF99CC'; #for warnings -- this change may come too late | ||
| 614 : | } | ||
| 615 : | |||
| 616 : | $SIG{__WARN__}=\&PG_warnings_handler; | ||
| 617 : | |||
| 618 : | $SIG{__DIE__} = sub { | ||
| 619 : | my $message = longmess(@_); | ||
| 620 : | $message =~ s/\n/<BR>\n/; | ||
| 621 : | my ($package, $filename, $line) = caller(); | ||
| 622 : | # use standard die for errors eminating from XML::Parser::Expat | ||
| 623 : | # it uses a trapped eval which sometimes fails -- apparently on purpose | ||
| 624 : | # and the error is handled by Expat itself. We don't want | ||
| 625 : | # to interfer with that. | ||
| 626 : | |||
| 627 : | if ($package eq 'XML::Parser::Expat') { | ||
| 628 : | die @_; | ||
| 629 : | } | ||
| 630 : | #print "$package $filename $line \n"; | ||
| 631 : | |||
| 632 : | "Content-type: text/html\r\n\r\n <h4>Software error</h4> <p>\n\n$message\n<p>\n | ||
| 633 : | Please inform the webwork meister.<p>\n | ||
| 634 : | In addition to the error message above the following warnings were detected: | ||
| 635 : | <HR> | ||
| 636 : | $Global::WARNINGS; | ||
| 637 : | <HR> | ||
| 638 : | It's sometimes hard to tell exactly what has gone wrong since the | ||
| 639 : | full error message may have been sent to | ||
| 640 : | standard error instead of to standard out. | ||
| 641 : | <p> To debug you can | ||
| 642 : | <ul> | ||
| 643 : | <li> guess what went wrong and try to fix it. | ||
| 644 : | <li> call the offending script directly from the command line | ||
| 645 : | of unix | ||
| 646 : | <li> enable the debugging features by redefining | ||
| 647 : | \$cgiURL in Global.pm and checking the redirection scripts in | ||
| 648 : | system/cgi. This will force the standard error to be placed | ||
| 649 : | in the standard out pipe as well. | ||
| 650 : | <li> Run tail -f error_log <br> | ||
| 651 : | from the unix command line to see error messages from the webserver. | ||
| 652 : | The standard error output is being placed in the error_log file for the apache | ||
| 653 : | web server. To run this command you have to be in the directory containing the | ||
| 654 : | error_log or enter the full path name of the error_log. <p> | ||
| 655 : | In a standard apache installation, this file is at /usr/local/apache/logs/error_log<p> | ||
| 656 : | In a RedHat Linux installation, this file is at /var/log/httpd/error_log<p> | ||
| 657 : | At Rochester this file is at /ww/logs/error_log. | ||
| 658 : | </ul> | ||
| 659 : | Good luck.<p>\n" ; | ||
| 660 : | }; | ||
| 661 : | |||
| 662 : | |||
| 663 : | |||
| 664 : | } | ||
| 665 : | |||
| 666 : | malsyned | 353 | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |