Parent Directory
| 
Revision Log
Revision 2989 - (view) (download) (as text)
| 1 : | gage | 279 | #!/usr/local/bin/perl -w |
| 2 : | gage | 593 | |
| 3 : | gage | 279 | # 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 : | gage | 2989 | BEGIN { |
| 13 : | gage | 497 | |
| 14 : | gage | 2989 | use lib "$ENV{WEBWORK_ROOT}/lib"; |
| 15 : | |||
| 16 : | |||
| 17 : | } | ||
| 18 : | gage | 279 | package Webwork; |
| 19 : | |||
| 20 : | gage | 2989 | BEGIN { $main::VERSION = "2.1"; } |
| 21 : | |||
| 22 : | #FIXME | ||
| 23 : | $SIG{__WARN__} = sub {}; | ||
| 24 : | $SIG{__DIE__} = sub {}; | ||
| 25 : | |||
| 26 : | gage | 279 | use strict; |
| 27 : | use sigtrap; | ||
| 28 : | use Carp; | ||
| 29 : | gage | 593 | use Safe; |
| 30 : | gage | 2989 | |
| 31 : | use WeBWorK::CourseEnvironment; | ||
| 32 : | gage | 497 | use WeBWorK::PG::Translator; |
| 33 : | gage | 2989 | use WeBWorK::DB; |
| 34 : | use WeBWorK::Constants; | ||
| 35 : | use WeBWorK::Utils; | ||
| 36 : | gage | 593 | use WeBWorK::PG::IO; |
| 37 : | gage | 2353 | use WeBWorK::PG::ImageGenerator; |
| 38 : | gage | 593 | use Benchmark; |
| 39 : | gage | 279 | use MIME::Base64 qw( encode_base64 decode_base64); |
| 40 : | |||
| 41 : | gage | 2989 | 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 : | gage | 279 | |
| 53 : | gage | 2989 | my $WW_DIRECTORY = $ENV{WEBWORK_ROOT}; |
| 54 : | gage | 279 | |
| 55 : | gage | 2989 | our $COURSENAME = 'daemon_course'; |
| 56 : | our $HOSTURL = 'http://devel.webwork.rochester.edu:11002'; | ||
| 57 : | gage | 687 | |
| 58 : | |||
| 59 : | gage | 2989 | our $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME); |
| 60 : | gage | 687 | |
| 61 : | gage | 2989 | print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce); |
| 62 : | gage | 687 | |
| 63 : | |||
| 64 : | gage | 2989 | print "webwork is realy ready\n\n"; |
| 65 : | #other services | ||
| 66 : | # File variables | ||
| 67 : | my $WARNINGS=''; | ||
| 68 : | gage | 687 | |
| 69 : | |||
| 70 : | gage | 2989 | # imported constants |
| 71 : | gage | 687 | |
| 72 : | gage | 2989 | my $COURSE_TEMP_DIRECTORY = $ce->{courseDirs}->{html_tmp}; |
| 73 : | my $COURSE_TEMP_URL = $HOSTURL.$ce->{courseURLs}->{html_tmp}; | ||
| 74 : | gage | 386 | |
| 75 : | gage | 2989 | my $pgMacrosDirectory = $ce->{pg_dir}.'/macros/'; |
| 76 : | my $macroDirectory = $ce->{courseDirs}->{macros}.'/'; | ||
| 77 : | my $templateDirectory = $ce->{courseDirs}->{templates}; | ||
| 78 : | gage | 279 | |
| 79 : | gage | 2989 | my %PG_environment = $ce->{pg}->{specialPGEnvironmentVars}; |
| 80 : | print STDERR "using the perl version of MIME::Base64\n"; | ||
| 81 : | gage | 375 | |
| 82 : | gage | 593 | |
| 83 : | gage | 2989 | 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 : | gage | 593 | |
| 93 : | gage | 2989 | 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 : | gage | 593 | |
| 108 : | gage | 279 | ############################################################################### |
| 109 : | gage | 497 | # List and address of available problemlibraries |
| 110 : | gage | 279 | ############################################################################### |
| 111 : | |||
| 112 : | |||
| 113 : | gage | 2353 | #my $libraryPath = '/Users/gage/rochester_problib/'; |
| 114 : | gage | 279 | |
| 115 : | |||
| 116 : | gage | 593 | |
| 117 : | gage | 279 | ############################################################################### |
| 118 : | gage | 593 | # Initialize renderProblem |
| 119 : | gage | 279 | ############################################################################### |
| 120 : | |||
| 121 : | |||
| 122 : | |||
| 123 : | gage | 786 | |
| 124 : | gage | 320 | my $displayMode = 'HTML_tth'; |
| 125 : | gage | 279 | |
| 126 : | gage | 2989 | my $PG_PL = "${pgMacrosDirectory}/PG.pl"; |
| 127 : | my $DANGEROUS_MACROS_PL = "${pgMacrosDirectory}/dangerousMacros.pl"; | ||
| 128 : | my $IO_PL = "${pgMacrosDirectory}/IO.pl"; | ||
| 129 : | gage | 497 | my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", |
| 130 : | gage | 279 | "Circle", "Label", "PGrandom", "Units", "Hermite", |
| 131 : | "List", "Match","Multiple", "Select", "AlgParser", | ||
| 132 : | "AnswerHash", "Fraction", "VectorField", "Complex1", | ||
| 133 : | "Complex", "MatrixReal1", "Matrix","Distributions", | ||
| 134 : | "Regression" | ||
| 135 : | gage | 497 | ); |
| 136 : | gage | 386 | my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", |
| 137 : | gage | 279 | "ExprWithImplicitExpand", "AnswerEvaluator", |
| 138 : | gage | 497 | # "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 : | gage | 328 | ); |
| 153 : | gage | 497 | |
| 154 : | ENDDOCUMENT(); | ||
| 155 : | gage | 386 | |
| 156 : | gage | 279 | END_OF_TEXT |
| 157 : | |||
| 158 : | ############################################################################### | ||
| 159 : | # | ||
| 160 : | ############################################################################### | ||
| 161 : | |||
| 162 : | ############################################################################### | ||
| 163 : | ############################################################################### | ||
| 164 : | |||
| 165 : | gage | 497 | #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n"; |
| 166 : | gage | 279 | |
| 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 : | gage | 497 | |
| 179 : | gage | 2989 | my $dummy_envir = { courseScriptsDirectory => $pgMacrosDirectory, |
| 180 : | gage | 279 | displayMode => $displayMode, |
| 181 : | gage | 593 | macroDirectory => $macroDirectory, |
| 182 : | gage | 2989 | displayModeFailover => DISPLAY_MODE_FAILOVER(), |
| 183 : | externalTTHPath => $ce->{externalPrograms}->{tth}, | ||
| 184 : | }; | ||
| 185 : | gage | 497 | my $pt = new WeBWorK::PG::Translator; #pt stands for problem translator; |
| 186 : | gage | 2989 | $pt ->rh_directories( { courseScriptsDirectory => $pgMacrosDirectory, |
| 187 : | gage | 279 | macroDirectory => $macroDirectory, |
| 188 : | gage | 2989 | scriptDirectory => '' , |
| 189 : | gage | 279 | templateDirectory => $templateDirectory, |
| 190 : | gage | 687 | tempDirectory => $COURSE_TEMP_DIRECTORY, |
| 191 : | gage | 279 | } |
| 192 : | ); | ||
| 193 : | $pt -> evaluate_modules( @MODULE_LIST); | ||
| 194 : | gage | 497 | #print STDERR "Completed loading of modules, now loading extra packages\n"; |
| 195 : | gage | 279 | $pt -> load_extra_packages( @EXTRA_PACKAGES ); |
| 196 : | gage | 497 | #print STDERR "Completed loading of packages, now loading environment\n"; |
| 197 : | gage | 279 | $pt -> environment($dummy_envir); |
| 198 : | gage | 497 | #print STDERR "Completed loading environment, next initialize\n"; |
| 199 : | gage | 279 | $pt->initialize(); |
| 200 : | gage | 497 | #print STDERR "Initialized. \n"; |
| 201 : | $pt -> unrestricted_load($PG_PL ); | ||
| 202 : | $pt -> unrestricted_load($DANGEROUS_MACROS_PL); | ||
| 203 : | gage | 2353 | $pt -> unrestricted_load($IO_PL); |
| 204 : | gage | 279 | $pt-> set_mask(); |
| 205 : | # | ||
| 206 : | gage | 497 | #print STDERR "Unrestricted loads completed.\n"; |
| 207 : | gage | 279 | |
| 208 : | gage | 497 | $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; |
| 209 : | gage | 279 | $pt->source_string( $INITIAL_MACRO_PACKAGES ); |
| 210 : | gage | 497 | #print STDERR "source strings read in\n"; |
| 211 : | gage | 279 | $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter |
| 212 : | $pt ->translate(); | ||
| 213 : | gage | 320 | |
| 214 : | print STDERR "New PGtranslator object inititialization completed.\n"; | ||
| 215 : | gage | 279 | ################################################################################ |
| 216 : | ## This ends the initialization of the PGtranslator object | ||
| 217 : | ################################################################################ | ||
| 218 : | |||
| 219 : | gage | 593 | |
| 220 : | |||
| 221 : | gage | 279 | ############################################################################### |
| 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 : | gage | 687 | $WARNINGS = ""; |
| 232 : | local $SIG{__WARN__} =\&PG_warnings_handler; | ||
| 233 : | gage | 2353 | |
| 234 : | my $envir = $rh->{envir}; | ||
| 235 : | gage | 2989 | foreach my $item (keys %PG_environment) { |
| 236 : | $envir->{$item} = $PG_environment{$item}; | ||
| 237 : | } | ||
| 238 : | gage | 2353 | my $basename = 'equation-'.$envir->{psvn}. '.' .$envir->{probNum}; |
| 239 : | $basename .= '.' . $envir->{problemSeed} if $envir->{problemSeed}; | ||
| 240 : | gage | 2989 | |
| 241 : | #FIXME debug line | ||
| 242 : | #print STDERR "basename is $basename and psvn is ", $envir->{psvn}; | ||
| 243 : | my $imagesModeOptions = $ce->{pg}->{displayModeOptions}->{images}; | ||
| 244 : | |||
| 245 : | gage | 2353 | # Object for generating equation images |
| 246 : | gage | 2989 | 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 : | gage | 2353 | } |
| 260 : | gage | 2989 | |
| 261 : | gage | 2353 | $pt->environment($envir); |
| 262 : | gage | 497 | #$pt->{safe_cache} = $safe_cmpt_cache; |
| 263 : | gage | 279 | $pt->initialize(); |
| 264 : | $pt -> unrestricted_load($PG_PL); | ||
| 265 : | $pt -> unrestricted_load($DANGEROUS_MACROS_PL); | ||
| 266 : | gage | 2353 | $pt -> unrestricted_load($IO_PL); |
| 267 : | gage | 279 | $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 : | gage | 2353 | # 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 : | gage | 279 | # 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 : | gage | 593 | 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 : | gage | 2353 | # $imgen->render('refresh'=>$forceRefresh); # Can force new images |
| 351 : | gage | 593 | } |
| 352 : | gage | 279 | 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 : | gage | 687 | WARNINGS => encode_base64($WARNINGS ), |
| 358 : | gage | 279 | problem_result => $rh_problem_result, |
| 359 : | problem_state => $rh_problem_state, | ||
| 360 : | PG_flag => \%PG_flag | ||
| 361 : | }; | ||
| 362 : | gage | 687 | |
| 363 : | gage | 279 | 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 : | gage | 961 | |
| 389 : | gage | 279 | ######### Return if forbidden characters are found |
| 390 : | gage | 961 | unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\[\]\(\)\,\|]+$/ ) { |
| 391 : | gage | 279 | $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 : | gage | 687 | ###################################################################### |
| 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 : | gage | 279 | |
| 415 : | gage | 687 | # 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 : | gage | 279 | |
| 424 : | gage | 687 | |
| 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 : | gage | 279 | 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 : | gage | 497 | $out .= "type = $type \n"; |
| 504 : | gage | 279 | } |
| 505 : | return $out; | ||
| 506 : | } | ||
| 507 : | |||
| 508 : | |||
| 509 : | |||
| 510 : | |||
| 511 : | |||
| 512 : | |||
| 513 : | |||
| 514 : | |||
| 515 : | |||
| 516 : | gage | 497 | |
| 517 : | |||
| 518 : | |||
| 519 : | |||
| 520 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |