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