################################################################################ # WeBWorK # # Copyright (c) 1995-2001 University of Rochester # All rights reserved # # $Id$ ################################################################################ use sigtrap; BEGIN { sub PG_floating_point_exception_handler { # 1st argument is signal name my($sig) = @_; print "Content-type: text/html\n\n

There was a floating point arithmetic error (exception SIG$sig )

--perhaps you divided by zero or took the square root of a negative number?
\n Use the back button to return to the previous page and recheck your entries.
\n"; exit(0); } $SIG{'FPE'} = \&PG_floating_point_exception_handler; sub PG_warnings_handler { my @input = @_; my $msg_string = longmess(@_); my @msg_array = split("\n",$msg_string); my $out_string = "##More details:
\n----"; foreach my $line (@msg_array) { chomp($line); next unless $line =~/\w+\:\:/; $out_string .= "----" .$line . "
\n"; } $Global::WARNINGS .="* " . join("
",@input) . "
\n" . $out_string . "
\n--------------------------------------
\n
\n"; $Global::background_plain_url = $Global::background_warn_url; $Global::bg_color = '#FF99CC'; #for warnings -- this change may come too late } $SIG{__WARN__}=\&PG_warnings_handler; $SIG{__DIE__} = sub { print "Content-type: text/html\r\n\r\n

Software error

@_
Please inform the webwork meister.

In addition to the error message above the following warnings were detected:


$Global::WARNINGS;
It's sometimes hard to tell exactly what has gone wrong since the full error message may have been sent to standard error instead of to standard out.

To debug you can

Good luck./n" ; exit(0); }; #exit(0); # CGI::Carp::croak(@_); }; #use CGI::Carp qw( fatalsToBrowser carp croak); my $CarpLevel = 0; # How many extra package levels to skip on carp. my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. sub longmess { my $error = shift; my $mess = ""; my $i = 1 + $CarpLevel; my ($pack,$file,$line,$sub,$eval,$require); while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) { if ($error =~ m/\n$/) { $mess .= $error; } else { if (defined $eval) { if ($require) { $sub = "require $eval"; } else { $eval =~ s/[\\\']/\\$&/g; if ($MaxEvalLen && length($eval) > $MaxEvalLen) { substr($eval,$MaxEvalLen) = '...'; } $sub = "eval '$eval'"; } } elsif ($sub eq '(eval)') { $sub = 'eval {...}'; } $mess .= "\t$sub " if $error eq "called"; $mess .= "$error at $file line $line\n"; } $error = "called"; } $mess || $error; } } ################################### ## Begin Global ################################### package Global; use webworkConfig; #use CGI::Carp ; #qw( fatalsToBrowser carp croak); use PGtranslator; # this is so that PGtranslator->evalute_macros is available when webworkCourse.ph is processed. ## $Id$ # ############################################################# # Copyright © 1995-2000 University of Rochester # All Rights Reserved # ############################################################# ## IMPORTANT: The items in the section below: ## "##These will most likely need to be customized for your site" ## should be customized for your own site. ## The variables defined in this package set defaults and ## parameters for the whole weBWorK system. Defaults can ## be over ridden for individual courses by redefining ## variables in the individual course webworkCourse.ph file. ## For example the default SYSTEM feedback address set below as: ## $feedbackAddress = 'webwork@math.rochester.edu'; ## can (and should) be over ridden for an individual course by entering e.g. ## $Global::feedbackAdress = 'apizer@math.rochester.edu, gage@math.rochester.edu'; ## in the individual course webworkCourse.ph file. Of course you should really ## enter the email address(es) of the professors teaching the course. ### Private vars - refer to these as $Global::var ### ## These will most likely need to be customized for your site $feedbackAddress = 'webwork@math.rochester.edu'; $legalAddress = '^[\w\-\.]+(\@([\w\-\.]+\.)*rochester\.edu)?$'; # destinations must match #$webmaster = 'webmaster@math.rochester.edu'; $webmaster = $feedbackAddress; #$SENDMAIL = '/usr/sbin/sendmail -t -oi -n'; # this should no longer be needed $smtpServer = 'mail.math.rochester.edu'; $dirDelim = '/'; ## Change DBtie_file only if you want to change the default database. The script ## db_tie.pl uses DB_File (the Berkeley DB) and gdbm_tie.pl uses GDBM_File. This ## setting can be changed for an individual course in the webworkCourse.ph file. For ## some other database, you will have to write your own database tie-file. Such ## files reside in the scripts directory. #$DBtie_file = 'db_tie.pl'; $DBtie_file = 'gdbm_tie.pl'; ## Set to 1 to enable the access log; set to 0 to disable. ## ## The access log is stored in the logs/ directory under the system directory ## in a file called "access_log". It contains information about virtually ## every action committed by users, including all answers submitted. ## Usually this information is unneccessary, and the file becomes ## large very quickly, so this log is ordinarily turned off. However, the ## information it contains might be useful if, for example, a student wants an ## extension and claims not to have viewed the correct answers. $logAccessData = 1; #################################################################################### ########### There should be no need to customize after this point ################# #################################################################################### use diagnostics; ## Usually this is commented out for a system students are using. ## If you or students experience problems, uncomment this statement ## and you will see hopefully helpful error messages. ### URL's and directory defined by the setup script system_webwork_setup.pl # for debugging uncomment the "WeBWorKCGIDebugURL" line, # comment out the "WeBWorKCGINoDebugURL" line, and edit # the wrapper scripts in the directory $cgiWebworkURL. #$cgiWebworkURL = '/cgi-bin/gage_system/cgi-scripts/'; #WeBWorKCGINoDebugURL #$cgiWebworkURL = '/cgi-bin/gage_system/'; #WeBWorKCGIDebugURL # in order for system_webwork_setup.pl to set the above URLs # correctly, the comment tags must remain at the ends of # these lines. # #$htmlWebworkURL = '/webwork_system_html/'; #$mainDirectory = '/u/gage/webwork/system/'; ## URL's derived from above $loginURL = "${cgiWebworkURL}login.pl"; $imagesURL = "${htmlWebworkURL}images/"; $helpURL = "${htmlWebworkURL}helpFiles/"; $webworkDocsURL = 'http://webwork.math.rochester.edu/docs/docs/'; $appletsURL = "${htmlWebworkURL}applets/"; require 5.000; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( getWebworkScriptDirectory getWebworkCgiURL getCourseMOTDFile getSystemMOTDFile getCourseDatabaseDirectory getCourseDatabaseTieFile getCourseLogsDirectory getCourseTemplateDirectory getCourseURL getCourseScoringDirectory getCourseScriptsDirectory getCourseMacroDirectory getCourseHtmlDirectory getCourseEmailDirectory getCourseTempDirectory getCourseTempURL getCourseClasslistFile getCourseEnvironment getCourseKeyFile getCoursePasswordFile getCoursePermissionsFile getCourseDatabaseFile getCourseHtmlURL getCoursel2hDirectory getCoursel2hURL getDirDelim getDelim getScoreFilePrefix getScoring_log getDash getDat getBbext getStatusDrop convertPath getNumRelPercentTolDefault getNumZeroLevelDefault getNumZeroLevelTolDefault getNumAbsTolDefault getNumFormatDefault getFunctRelPercentTolDefault getFunctZeroLevelDefault getFunctZeroLevelTolDefault getFunctAbsTolDefault getFunctNumOfPoints getFunctVarDefault getFunctLLimitDefault getFunctULimitDefault getFunctMaxConstantOfIntegration getLoginURL getWebworkLogsDirectory wwerror getAllowDestroyRebuildProbSets ); ## practice users $practiceUser = 'practice'; # name of password-less "practice" user $practiceKey = 'practice'; # a dummy key for this user, can be anything ## The database handle for using mSQL: $dbh = 0; ## various gifs $helpGifUrl = "${imagesURL}ww_help.gif"; $logoutGifUrl = "${imagesURL}ww_logout.gif"; $feedbackGifUrl = "${imagesURL}ww_feedback.gif"; $currentImgUrl = "${imagesURL}ww_curr.gif"; $previousImgUrl = "${imagesURL}ww_prev.gif"; $nextImgUrl = "${imagesURL}ww_next.gif"; $problistImgUrl = "${imagesURL}ww_problist.gif"; $upImgUrl = "${imagesURL}ww_up.gif"; $bluesquareImgUrl = "${imagesURL}ww_bluesq.gif"; $headerImgUrl = "${imagesURL}webwork.gif"; # image to include at top of pages $squareWebworkGif = "${imagesURL}square_webwork.gif"; # image to include at top of pages ## backgrounds gifs for HTML documents $background_plain_url = "${imagesURL}white.gif"; $background_okay_url = "${imagesURL}green.gif"; $background_warn_url = "${imagesURL}red.gif"; $bg_color = '#EFEFEF'; #background color for processProblem ## Directories $coursesDirectory = convertPath("${mainDirectory}courses/"); $scriptDirectory = convertPath("${mainDirectory}scripts/"); $cgiDirectory = convertPath("${mainDirectory}cgi/"); #$tempDirectory = convertPath("/tmp/"); $authDirectory = convertPath(".auth/"); $courseScriptsDirectory = convertPath("${mainDirectory}courseScripts/"); $macroDirectory = convertPath("${mainDirectory}courseScripts/"); $classDirectory = ''; #This must be defined in webworkCourse.ph $webworkLogsDirectory = "${mainDirectory}/logs/"; ## File names $coursesFilename = 'courses-list'; $coursesFile = "${coursesDirectory}$coursesFilename"; $classlistFilename = 'classlist.lst'; $keyFilename = 'keys'; $passwordFilename = 'password'; $permissionsFilename = 'permissions'; $database = 'webwork-database'; $CL_Database = 'classlist-database'; $tipsFilename = 'tips.txt'; $system_motd_filename = 'motd.txt'; $course_motd_filename = 'motd.txt'; $tipsFile = "${mainDirectory}$tipsFilename"; # CGI script calls $login_CGI = "${cgiWebworkURL}login.pl"; $logout_CGI = "${cgiWebworkURL}logout.pl"; $welcome_CGI = "${cgiWebworkURL}welcome.pl"; $welcomeAction_CGI = "${cgiWebworkURL}welcomeAction.pl"; $processProblem_CGI = "${cgiWebworkURL}processProblem8.pl"; $feedback_CGI = "${cgiWebworkURL}feedback.pl"; $problemEditor_CGI = "${cgiWebworkURL}problemEditor.pl"; ## The following items control how the whole problem set is typeset by downloadPS.pl. ## The files (e.g. "tex_set_ptramble.tex") are found in the .../templates directory ## Note that the system dependent latex and dvips programs are defined in the file ## makePS which is in the .../scripts directory. makePS must be edited to call ## the correct programs. ## ## This is the tex preamble file used by downloadPS.pl in typeseting the whole problem set. ## E.g. loads AMS latex and graphics packages, some macro definitions. $TEX_SET_PREAMBLE = 'texSetPreamble.tex'; ## This is the tex header file used by downloadPS.pl in typeseting the whole problem set ## E.g. loads two column format, macro definitions. $TEX_SET_HEADER = ''; ## This is the header file used by downloadPS.pl to enter preliminary verbiage for the ## whole problem set. E.g. Course name, student name, problem set number,instructions, due date. $SET_HEADER = 'paperSetHeader.pg'; ## This is the tex footer file used by downloadPS.pl in typeseting the whole problem set $TEX_SET_FOOTER = 'texSetFooter.tex'; ## The following items control how an individual problem is typeset by processProblem.pl ## and l2h. Note that the system dependent latex2html program is defined in processProblem.pl. It ## should really be in a seperate file like makeps. ## This is the tex preamble file used by processProblem.pl typeseting an individual problem ## Usually very similar to $TEX_SET_PREAMBLE $TEX_PROB_PREAMBLE = 'texProbPreamble.tex'; ## This is the tex header file used by processProblem.pl typeseting an individual problem $TEX_PROB_HEADER = ''; ## This is the header file used by probSet.pl to enter preliminary verbiage on the prob set ## page. E.g. Instructions, due date. $PROB_HEADER = 'screenSetHeader.pg'; ## This is the tex footer file processProblem.pl typeseting an individual problem $TEX_PROB_FOOTER = 'texProbFooter.tex'; $courseEnvironmentFile = 'webworkCourse.ph'; #$webworkCourse_ph = 'webworkCourse.ph'; $DBglue_pl = 'DBglue8.pl'; $HTMLglue_pl = 'HTMLglue.pl'; $classlist_DBglue_pl = 'classlist_DBglue.pl'; $FILE_pl = 'FILE.pl'; $displayMacros_pl = 'displayMacros.pl'; $scoring_log = 'scoring.log'; #####$probSetHeader = 'probSetHeader'; $SCRtools_pl = 'pScSet6.pl'; $buildProbSetTools = 'proceduresForBuildProbSetDB.pl'; ## File and Directory permissions ## e.g. S1-1521.sco in (base course directory)/DATA $sco_files_permission = 0660; ## tie permissions (used in tie commands) ## The database, password, and permissions files ## always take their permissions from the Global ## vaiables below. The important keys file ## takes its permission from $restricted_tie_permission. $restricted_tie_permission = 0600; $standard_tie_permission = 0660; ## webwork-database in (base course directory)/DATA $webwork_database_permission = 0660; ## password in (base course directory)/DATA/.auth $password_permission = 0660; ## permissions in (base course directory)/DATA/.auth $permissions_permission = 0660; ## e.g. s1ful.csv in (base course directory)/scoring $scoring_files_permission = 0660; ## e.g. s1bak1.csv in (base course directory)/scoring $scoring_bak_files_permission = 0440; ## e.g. 8587l2h.log in (base course directory)/html/tmp/l2h $l2h_logs_permission = 0660; ## e.g. set1/ in (base course directory)/html/tmp/l2h $l2h_set_directory_permission = 0770; ## e.g. 1-1082/ in (base course directory)/html/tmp/l2h/set1 $l2h_prob_directory_permission = 0770; ## e.g. 1082output.html in (base course directory)/html/tmp/l2h/set1/1-1082 $l2h_data_permission = 0770; ## e.g. file.gif in (base course directory)/html/tmp/gif $tmp_file_permission = 0660; ## e.g. gif/ in (base course directory)/html/tmp/ $tmp_directory_permission = 0770; ##e.g. classlist files (e.g. MTH140A.lst) in (base course directory)/templates/ $classlist_file_permission = 0660; ## Prefixes, extensions, defaults, etc $scoreFilePrefix = 'S'; $dash = '-'; # Can not be the underscore character or an upper or # lowercase letter or a digit. Used in .sco file names $delim = ','; # used in scoring, classlist $dat = 'csv'; @statusDrop = qw(drop d withdraw); $courselist_delim = '::'; # used by login.pl to get course names / dirs $instructor_permissions = 10; $TA_permissions = 5; $psvn_digits = 5; # Number of digits in psvn numbers. E.g. if 4, psvn's # will be between 1000 and 9999. The number of available # psvn's must be greater than (#students)*(#problem sets) $score_decimal_digits = 1; # Number of decimal digits in recorded scores. For example # if this is 1 then on a 1 point problem that allows partial # credit, possible scores are 0, .1, .2, ..., 1. $maxAttemptsWarningLevel = 5; # If the set definition file puts a limit on the number of # times a problem may be attempted, processProblem.pl will # give a warning message when <= $maxAttemptsWarningLevel # attempts remain. $noOfFieldsInClasslist = 9; # The number of fields in the classlist file. This is used as # a check to make sure each record in the classlist file has # this number of fields $htmlModeDefault = 'HTML_tth'; # The default mode for displayed problems (either 'HTML', # 'Latex2HTML', or 'HTML_tth' $allowStudentToChangeEMAddress = 1; # setting to 1 allows students to change their # own email address. Setting to 0 disallows this $Global::PG_environment{showPartialCorrectAnswers} = 1; ## Set to 0 or 1. If set to 1 in multipart # questions the student will be told which parts are # correct and which are incorrect. Usually, this is # set explicitly in each individual problem. $allowDestroyRebuildProbSets = 0; # Set to 0 or 1. If set to 1 a professor can destroy and # rebuild problems sets in one operation. This is very # convenient and powerful, but also very dangerous. Usually # this is not allowed in courses students are using. It is # often set to 1 in a private course being used only for # developing problem sets. To do this, reset this in the # private course's webworkCourse.ph file. $Global::PG_environment{recordSubmittedAnswers} = 1; # Set to 0 or 1. If set to 1, submitted answers will be # stored. For example in a multipart question, a student can # do several parts, then logout or go onto another question. # When they view the problem again, the answer blanks will be # filled in with their most recent answers. This also allows # professors to see exactly what a student entered. This default # can be over ridden for an individual problem by setting # recordSubmittedAnswers in the .pg file for the problem. $maxSizeRecordedAns = 256; # Student answers longer than this length in bytes will not # stored in the database. $hide_studentID_from_TAs = 0; # Set to 0 or 1. If set to 1, studentID's will be hidden # from TA's. For example some Universities may use SS#'s for # student ID's and you may not want TA's to view these. ## arguments for flock() $shared_lock = 1; $exclusive_lock = 2; $nonblocking_lock = 4; $unlock_lock = 8; # These values provide defaults for the various answer comparison macros found # in PGanswermacros.pl. They can be over ridden for individual courses by # redefining the variables in the individual course webworkCourse.ph file. # They can be over ridden for individual problems by explicitly passing the # desired values to the answer comparison macro # The following effect numerical answer comparison $numRelPercentTolDefault = .1; $numZeroLevelDefault = 1E-14; $numZeroLevelTolDefault = 1E-12; $numAbsTolDefault = .001; $numFormatDefault = ''; ## use perl's format in prfmt() # The following effect function comparison $functRelPercentTolDefault = .1; $functZeroLevelDefault = 1E-14; $functZeroLevelTolDefault = 1E-12; $functAbsTolDefault = .001; $functNumOfPoints = 3; $functVarDefault = 'x'; $functLLimitDefault = .0000001; $functULimitDefault = .9999999; # The following effects function comparison upto constant for antidifferentiation $functMaxConstantOfIntegration = 1E8; ## These values provide defaults for the window size in the problemEditor.pl script $editor_window_rows = 25; $editor_window_columns = 90; ## This is the maximum number problems sets that can be downloaded at one time ## by a professor. Set this higher or lower depending on the speed of your server $max_num_of_ps_downloads_allowed = 20; # Subroutines for defining the directories and URLs ###### Public vars/routines - these are imported into your namespace, ####### ###### so they can be called as they are. ####### sub getWebworkScriptDirectory { convertPath($scriptDirectory ) }; sub getCourseDatabaseDirectory { convertPath($databaseDirectory )}; sub getCourseDatabaseTieFile { convertPath($DBtie_file )}; sub getCourseLogsDirectory { convertPath($logsDirectory )}; sub getCourseTemplateDirectory { convertPath($templateDirectory )}; sub getCourseEmailDirectory { convertPath("${templateDirectory}email/")}; sub getCourseScoringDirectory { convertPath($scoringDirectory ) }; sub getCourseHtmlDirectory { convertPath($htmlDirectory )}; sub getCourseTempDirectory {convertPath($courseTempDirectory)}; sub getCoursel2hDirectory { convertPath( "${courseTempDirectory}l2h/" )}; sub getCourseScriptsDirectory { convertPath($courseScriptsDirectory )}; sub getCourseMacroDirectory { convertPath($macroDirectory )}; sub getWebworkLogsDirectory { convertPath($webworkLogsDirectory)}; sub getCourseClasslistFile { convertPath("${coursesDirectory}$_[0]/templates/${classlistFilename}") }; sub getCourseKeyFile { convertPath("${coursesDirectory}$_[0]/DATA/${authDirectory}${keyFilename}") }; sub getCoursePasswordFile { convertPath("${coursesDirectory}$_[0]/DATA/${authDirectory}${passwordFilename}") }; sub getCoursePermissionsFile { convertPath("${coursesDirectory}$_[0]/DATA/${authDirectory}${permissionsFilename}") }; sub getCourseDatabaseFile { convertPath("${coursesDirectory}$_[0]/DATA/${$database}") }; sub getCourseMOTDFile { convertPath("${coursesDirectory}$_[0]/templates/${course_motd_filename}") }; sub getSystemMOTDFile { convertPath("${mainDirectory}${system_motd_filename}") }; sub getWebworkCgiURL { $cgiWebworkURL }; sub getCourseHtmlURL { $htmlURL }; sub getCoursel2hURL { "${courseTempURL}l2h/" } sub getCourseTempURL { $courseTempURL }; #defined in webworkCourse.ph sub getDirDelim { $dirDelim }; sub getDelim { $delim }; sub getScoreFilePrefix { $scoreFilePrefix }; sub getScoring_log { $scoring_log }; sub getDash { $dash }; sub getDat { $dat }; sub getBbext { @dbext }; sub getStatusDrop { @statusDrop }; sub getNumRelPercentTolDefault { $numRelPercentTolDefault }; sub getNumZeroLevelDefault { $numZeroLevelDefault }; sub getNumZeroLevelTolDefault { $numZeroLevelTolDefault }; sub getNumAbsTolDefault { $numAbsTolDefault }; sub getNumFormatDefault { $numFormatDefault }; sub getFunctRelPercentTolDefault { $functRelPercentTolDefault }; sub getFunctZeroLevelDefault { $functZeroLevelDefault }; sub getFunctZeroLevelTolDefault { $functZeroLevelTolDefault }; sub getFunctAbsTolDefault { $functAbsTolDefault }; sub getFunctNumOfPoints { $functNumOfPoints }; sub getFunctVarDefault { $functVarDefault }; sub getFunctLLimitDefault { $functLLimitDefault }; sub getFunctULimitDefault { $functULimitDefault }; sub getFunctMaxConstantOfIntegration { $functMaxConstantOfIntegration }; sub getLoginURL { $loginURL }; sub getAllowDestroyRebuildProbSets { $allowDestroyRebuildProbSets }; sub getCourseEnvironment { die "getCourseEnvironment was called without specifying a course" unless $_[0]; my $fullPath = convertPath("${coursesDirectory}$_[0]/$courseEnvironmentFile"); require "$fullPath" || die "Can't find local environment file for $fullPath\n"; } ### dump a (hopefully) descriptive error to the browser and quit #sub wwerror { # my($title, $msg, $url, $label, $query_string) = @_; # # print "content-type: text/html\n\n # Error: $title # #

Error: $title

\n $msg \n"; # if ($url) { # print "
# #
\n"; # } # print ""; # &log_error($title, $query_string); # exit 1; #} sub wwerror { my($title, $msg, $url, $label, $query_string) = @_; # $msg = '' unless defined $msg; $url = '' unless defined $url; $label = '' unless defined $label; $query_string = '' unless defined $query_string; print "content-type: text/html\n\n Error: $title

Error: $title

$msg\n
          
"; if ($url) { print "
\n"; } print ""; &log_error($title, $query_string); exit 1; } sub error {wwerror(@_);} ##alias for wwerror # return a (scalar) tip sub tip { my ($tips, @tiplist); local($/) = undef; #undef $/; # slurp it all in open(TIPS, "$tipsFile") || &error("Can't open $tipsFile"); $tips = ; close(TIPS); # add any local tips to the list before we pick a random one if (-r "${templateDirectory}$tipsFilename") { open(TIPS, "${templateDirectory}$tipsFilename"); $tips .= '%%' . ; close(TIPS); } $/ = "\n"; # <> now reads until newline $tips =~ s/#.*?\n//mg; # remove comments @tiplist = split(/%%/, $tips); return $tiplist[rand(@tiplist)]; # choose one at random } # return an array of tips sub all_tips { my ($tip, $tips, @tiplist); local($/) = undef; # slurp it all in open(TIPS, "$tipsFile") || &error("Can't open $tipsFile"); $tips = ; close(TIPS); # add any local tips to the list before we pick a random one if (-r "${templateDirectory}$tipsFilename") { open(TIPS, "${templateDirectory}$tipsFilename"); $tips .= '%%' . ; close(TIPS); } $/ = "\n"; # <> now reads until newline $tips =~ s/#.*?\n//mg; # remove comments @tiplist = split(/%%/, $tips); return @tiplist; } # begin Timing code use Benchmark; sub dateTime { my @timeArray = localtime(time); my $out = sprintf("%2.2d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d", $timeArray[5],$timeArray[4]+1,@timeArray[3,2,1,0]); $out; } #the ps system calls do not work on all systems, and are usually not #necessary anyway. If you wish that information to be logged, simply #uncomment the relevant lines, but be warned that they might need to #be modified for your system sub logTimingInfo { my ($beginTime,$endTime,$script,$course,$user,$remoteHost,$userAgent) = @_; $remoteHost = ""unless defined($remoteHost); $userAgent = "" unless defined($userAgent); open(TIMELOG, ">>${webworkLogsDirectory}timing_log") || warn "*Unable to open timing log for writing:\n ${webworkLogsDirectory}timing_log. "; my $mem_string = ''; # my $process_string = `ps -o vsz -p $$`; # $process_string =~ s/^\s*//; # $process_string =~ s/\s*$//; # my @process_string = split(/\s+/,$process_string); # gets memory size # my $mem_string = " mem: ${process_string[1]}K"; my $load_string = ''; # my @load = split(/\n/,`ps -U wwhttpd -o state`); # my $load_string = " load: " . grep(/R/,@load); print TIMELOG $script,"\t",$course,"\t",&dateTime,"\t", timestr( timediff($endTime,$beginTime), 'all' ),"\t", "pid: $$ DBtie_tries: $Global::DBtie_tries" . $mem_string . $load_string,"\t",$user,"\t", $remoteHost,"\t",$userAgent,"\n"; close(TIMELOG); } # end Timing code # handy routines for modules that wish to throw exceptions outside of the # current package. (taken from Carp.pm) # # We'll want to remove this in final versions of WeBWorK. sub log_error { my ($comment, $data) = @_; my $accessLog = convertPath("${webworkLogsDirectory}access_log"); my $errorLog = convertPath("${webworkLogsDirectory}error_log"); open(ACCESS, ">>$accessLog"); open(ERROR, ">>$errorLog"); print ACCESS "ERROR ($comment) ", scalar(localtime), ': ', &shortmess($data); print ERROR "ERROR ($comment) ", scalar(localtime), ': ', &shortmess($data); close(ACCESS); close(ERROR); } sub log_info { if( $Global::logAccessData == 1 ) { my ($comment, $data) = @_; my $accessLog = convertPath("${webworkLogsDirectory}access_log"); open(LOG, ">>$accessLog") or warn "Can't open accessLog $accessLog"; print LOG "INFO ($comment) ", scalar(localtime), ': ', &shortmess($data); close(LOG); } } ## converts full path names to to use the $dirDelim instead of / sub convertPath { my ($path) = @_; warn "convertPath has been asked to convert an empty path
|$path| at ", caller(),"
" unless $path; $path =~ s|/|$dirDelim|g; $path; } ############### ## Error message routines ############### BEGIN { #error message routines my $CarpLevel = 0; # How many extra package levels to skip on carp. my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. sub longmess { my $error = shift; my $mess = ""; my $i = 1 + $CarpLevel; my ($pack,$file,$line,$sub,$eval,$require); while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) { if ($error =~ m/\n$/) { $mess .= $error; } else { if (defined $eval) { if ($require) { $sub = "require $eval"; } else { $eval =~ s/[\\\']/\\$&/g; if ($MaxEvalLen && length($eval) > $MaxEvalLen) { substr($eval,$MaxEvalLen) = '...'; } $sub = "eval '$eval'"; } } elsif ($sub eq '(eval)') { $sub = 'eval {...}'; } $mess .= "\t$sub " if $error eq "called"; $mess .= "$error at $file line $line\n"; } $error = "called"; } $mess || $error; } sub shortmess { # Short-circuit &longmess if called via multiple packages my $error = $_[0]; # Instead of "shift" my ($curpack) = caller(1); my $extra = $CarpLevel; my $i = 2; my ($pack,$file,$line); while (($pack,$file,$line) = caller($i++)) { if ($pack ne $curpack) { if ($extra-- > 0) { $curpack = $pack; } else { return "$error at $file line $line\n"; } } } goto &longmess; } } ############### ## End Error message routines ############### 1; ## This line is required by perl