View of /trunk/webwork/system/lib/Global.pm

    1 ################################################################################
    2 # WeBWorK
    3 #
    4 # Copyright (c) 1995-2001 WeBWorK Team, University of Rochester
    5 # All rights reserved
    6 #
    7 # $Id$
    8 ################################################################################
    9 
   10 ###################################
   11 ## Begin Global
   12 ###################################
   13 
   14 package Global;
   15 
   16 # The variables defined in this package set defaults and parameters for
   17 # the whole weBWorK system.  Defaults can be over ridden for individual
   18 # courses by redefining variables in the individual course
   19 # webworkCourse.ph file. For example the default SYSTEM feedback address
   20 # set below as: $feedbackAddress = 'webwork@math.rochester.edu'; can (and
   21 # should) be over ridden for an individual course by entering e.g.
   22 # $Global::feedbackAdress  = 'apizer@math.rochester.edu,
   23 # gage@math.rochester.edu'; in the individual course webworkCourse.ph
   24 # file. Of course you should really enter the email address(es) of the
   25 # professors teaching the course.
   26 
   27 ################################
   28 # Local configuration settings #
   29 ################################
   30 
   31 # $legalAddress defines addresses which are accepted for use in scripts that send mail.
   32 # it is a perl regular expression.
   33 $legalAddress = '^[\w\-\.]+(\@([\w\-\.]+\.)*rochester\.edu)?$'; # destinations must match
   34 
   35 # these define the default addresses to which will be used by the system.
   36 $feedbackAddress = 'webwork@math.rochester.edu';
   37 $webmaster       = $feedbackAddress;
   38 $defaultfrom     = $feedbackAddress;
   39 $defaultreply    = $feedbackAddress;
   40 
   41 # $smtpServer is the address of the sendmail server. if you are running sendmail on the
   42 # same machine as webwork, use "localhost"
   43 $smtpServer = 'mail.math.rochester.edu';
   44 
   45 # $dirDelim is the delimiter used in pathnames on your system.
   46 $dirDelim = '/';
   47 
   48 # $cgiDebugMode, if enabled, will call the debug wrapper scripts instead of the
   49 # cgi scripts themselves, allowing for header output, etc.
   50 $cgiDebugMode = 0;
   51 
   52 ## Change DBtie_file only if you want to change the default database. The script
   53 ## db_tie.pl uses DB_File (the Berkeley DB) and  gdbm_tie.pl uses GDBM_File.  This
   54 ## setting can be changed for an individual course in the webworkCourse.ph file. For
   55 ## some other database, you will have to write your own database tie-file. Such
   56 ## files reside in the scripts directory.
   57 #$DBtie_file = 'db_tie.pl';
   58 $DBtie_file = 'gdbm_tie.pl';
   59 
   60 ## Set to 1 to enable the access log; set to 0 to disable.
   61 ##
   62 ## The access log is stored in the logs/ directory under the system directory
   63 ## in a file called "access_log". It contains information about virtually
   64 ## every action committed by users, including all answers submitted.
   65 ## Usually this information is unneccessary, and the file becomes
   66 ## large very quickly, so this log is ordinarily turned off. However, the
   67 ## information it contains might be useful if, for example, a student wants an
   68 ## extension and claims not to have viewed the correct answers.
   69 $logAccessData = 1;
   70 
   71 ####################################################################################
   72 ########### There should be no need to customize after this point  #################
   73 ####################################################################################
   74 
   75 use sigtrap;
   76 use diagnostics;
   77 use webworkConfig;
   78 use PGtranslator;
   79     # this is so that PGtranslator->evalute_macros is available when webworkCourse.ph is processed.
   80 
   81 require 5.000;
   82 require Exporter;
   83 @ISA = qw(Exporter);
   84 @EXPORT = qw(
   85   getWebworkScriptDirectory
   86   getWebworkCgiURL
   87   getCourseMOTDFile
   88   getSystemMOTDFile
   89   getCourseDatabaseDirectory
   90   getCourseDatabaseTieFile
   91   getCourseLogsDirectory
   92   getCourseTemplateDirectory
   93   getCourseURL
   94   getCourseScoringDirectory
   95   getCourseScriptsDirectory
   96   getCourseMacroDirectory
   97   getCourseHtmlDirectory
   98   getCourseEmailDirectory
   99   getCourseTempDirectory
  100   getCourseTempURL
  101   getCourseClasslistFile
  102   getCourseEnvironment
  103   getCourseKeyFile
  104   getCoursePasswordFile
  105   getCoursePermissionsFile
  106   getCourseDatabaseFile
  107   getCourseHtmlURL
  108   getCoursel2hDirectory
  109   getCoursel2hURL
  110   getDirDelim
  111   getDelim
  112   getScoreFilePrefix
  113   getScoring_log
  114   getDash
  115   getDat
  116   getBbext
  117   getStatusDrop
  118   convertPath
  119   getNumRelPercentTolDefault
  120   getNumZeroLevelDefault
  121   getNumZeroLevelTolDefault
  122   getNumAbsTolDefault
  123   getNumFormatDefault
  124   getFunctRelPercentTolDefault
  125   getFunctZeroLevelDefault
  126   getFunctZeroLevelTolDefault
  127   getFunctAbsTolDefault
  128   getFunctNumOfPoints
  129   getFunctVarDefault
  130   getFunctLLimitDefault
  131   getFunctULimitDefault
  132   getFunctMaxConstantOfIntegration
  133   getLoginURL
  134   getWebworkLogsDirectory
  135   wwerror
  136   getAllowDestroyRebuildProbSets
  137 );
  138 
  139 ## URL's derived from webworkConfig.pm
  140 $loginURL   = "${cgiWebworkURL}login.pl";
  141 $imagesURL    = "${htmlWebworkURL}images/";
  142 $helpURL    = "${htmlWebworkURL}helpFiles/";
  143 $webworkDocsURL = 'http://webwork.math.rochester.edu/docs/docs/';
  144 $appletsURL   = "${htmlWebworkURL}applets/";
  145 
  146 ## practice users
  147 $practiceUser = 'practice';  # name of password-less "practice" user
  148 $practiceKey  = 'practice';  # a dummy key for this user, can be anything
  149 
  150 
  151 ## The database handle for using mSQL:
  152 $dbh = 0;
  153 
  154 ## various gifs
  155 $helpGifUrl     = "${imagesURL}ww_help.gif";
  156 $logoutGifUrl   = "${imagesURL}ww_logout.gif";
  157 $feedbackGifUrl   = "${imagesURL}ww_feedback.gif";
  158 $currentImgUrl    = "${imagesURL}ww_curr.gif";
  159 $previousImgUrl   = "${imagesURL}ww_prev.gif";
  160 $nextImgUrl     = "${imagesURL}ww_next.gif";
  161 $problistImgUrl   = "${imagesURL}ww_problist.gif";
  162 $upImgUrl     = "${imagesURL}ww_up.gif";
  163 $bluesquareImgUrl = "${imagesURL}ww_bluesq.gif";
  164 $headerImgUrl   = "${imagesURL}webwork.gif";      # image to include at top of pages
  165 $squareWebworkGif = "${imagesURL}square_webwork.gif"; # image to include at top of pages
  166 
  167 ## backgrounds gifs for HTML documents
  168 $background_plain_url = "${imagesURL}white.gif";
  169 $background_okay_url  = "${imagesURL}green.gif";
  170 $background_warn_url  = "${imagesURL}red.gif";
  171 $bg_color       = '#EFEFEF';   #background color for processProblem
  172 
  173 ## Directories
  174 $coursesDirectory   = convertPath("${mainDirectory}courses/");
  175 $scriptDirectory    = convertPath("${mainDirectory}scripts/");
  176 $cgiDirectory     = convertPath("${mainDirectory}cgi/");
  177 #$tempDirectory     = convertPath("/tmp/");
  178 $authDirectory      = convertPath(".auth/");
  179 $courseScriptsDirectory = convertPath("${mainDirectory}courseScripts/");
  180 $macroDirectory     = convertPath("${mainDirectory}courseScripts/");
  181 $classDirectory     = '';  #This must be defined in webworkCourse.ph
  182 $webworkLogsDirectory = "${mainDirectory}/logs/";
  183 
  184 ## File names
  185 $coursesFilename    = 'courses-list';
  186 $coursesFile      = "${coursesDirectory}$coursesFilename";
  187 $classlistFilename    = 'classlist.lst';
  188 $keyFilename      = 'keys';
  189 $passwordFilename   = 'password';
  190 $permissionsFilename  = 'permissions';
  191 $database       = 'webwork-database';
  192 $CL_Database          =   'classlist-database';
  193 $tipsFilename     = 'tips.txt';
  194 $system_motd_filename = 'motd.txt';
  195 $course_motd_filename = 'motd.txt';
  196 $tipsFile       = "${mainDirectory}$tipsFilename";
  197 
  198 #  CGI script calls
  199 
  200 $login_CGI      = "${cgiWebworkURL}login.pl";
  201 $logout_CGI     = "${cgiWebworkURL}logout.pl";
  202 $welcome_CGI    = "${cgiWebworkURL}welcome.pl";
  203 $welcomeAction_CGI  = "${cgiWebworkURL}welcomeAction.pl";
  204 $processProblem_CGI = "${cgiWebworkURL}processProblem8.pl";
  205 $feedback_CGI   = "${cgiWebworkURL}feedback.pl";
  206 $problemEditor_CGI  = "${cgiWebworkURL}problemEditor.pl";
  207 
  208 ##  The following items control how the whole problem set is typeset by downloadPS.pl.
  209 ##  The files (e.g. "tex_set_ptramble.tex") are found in the .../templates directory
  210 ##  Note that the system dependent latex and dvips programs are defined in the file
  211 ##  makePS which is in the .../scripts directory.  makePS must be edited to call
  212 ##  the correct programs.
  213 ##
  214 
  215 ##  This is the tex preamble file used by downloadPS.pl in typeseting the whole problem set.
  216 ##  E.g. loads AMS latex and graphics packages, some macro definitions.
  217 $TEX_SET_PREAMBLE = 'texSetPreamble.tex';
  218 
  219 ##  This is the tex header file used by downloadPS.pl in typeseting the whole problem set
  220 ##  E.g. loads two column format, macro definitions.
  221 $TEX_SET_HEADER = '';
  222 
  223 ##  This is the header file used by downloadPS.pl to enter preliminary verbiage for the
  224 ##  whole problem set. E.g. Course name, student name, problem set number,instructions, due date.
  225 $SET_HEADER = 'paperSetHeader.pg';
  226 
  227 ##  This is the tex footer file used by downloadPS.pl in typeseting the whole problem set
  228 $TEX_SET_FOOTER = 'texSetFooter.tex';
  229 
  230 
  231 ##  The following items control how an individual problem is typeset by processProblem.pl
  232 ##  and l2h.  Note that the system dependent latex2html program is defined in processProblem.pl.  It
  233 ##  should really be in a seperate file like makeps.
  234 
  235 ##  This is the tex preamble file used by processProblem.pl typeseting an individual problem
  236 ##  Usually very similar to $TEX_SET_PREAMBLE
  237 $TEX_PROB_PREAMBLE = 'texProbPreamble.tex';
  238 
  239 ##  This is the tex header file used by processProblem.pl typeseting an individual problem
  240 $TEX_PROB_HEADER = '';
  241 
  242 
  243 ##  This is the header file used by probSet.pl to enter preliminary verbiage on the prob set
  244 ##  page. E.g. Instructions, due date.
  245 $PROB_HEADER = 'screenSetHeader.pg';
  246 
  247 ##  This is the tex footer file processProblem.pl typeseting an individual problem
  248 $TEX_PROB_FOOTER = 'texProbFooter.tex';
  249 
  250 
  251 
  252 $courseEnvironmentFile  = 'webworkCourse.ph';
  253 #$webworkCourse_ph    = 'webworkCourse.ph';
  254 $DBglue_pl        = 'DBglue8.pl';
  255 $HTMLglue_pl      = 'HTMLglue.pl';
  256 $classlist_DBglue_pl  = 'classlist_DBglue.pl';
  257 $FILE_pl        = 'FILE.pl';
  258 $displayMacros_pl   = 'displayMacros.pl';
  259 $scoring_log      = 'scoring.log';
  260 #####$probSetHeader   = 'probSetHeader';
  261 $SCRtools_pl      = 'pScSet6.pl';
  262 $buildProbSetTools    = 'proceduresForBuildProbSetDB.pl';
  263 
  264 
  265 ## File and Directory permissions
  266 
  267 ## e.g. S1-1521.sco in (base course directory)/DATA
  268 $sco_files_permission = 0660;
  269 
  270 ## tie permissions (used in tie commands)
  271 ## The database, password, and permissions files
  272 ## always take their permissions from the Global
  273 ## vaiables below.  The important keys file
  274 ## takes its permission from $restricted_tie_permission.
  275 $restricted_tie_permission = 0600;
  276 $standard_tie_permission = 0660;
  277 
  278 ## webwork-database in (base course directory)/DATA
  279 $webwork_database_permission = 0660;
  280 
  281 ## password in (base course directory)/DATA/.auth
  282 $password_permission = 0660;
  283 
  284 ## permissions in (base course directory)/DATA/.auth
  285 $permissions_permission = 0660;
  286 
  287 ## e.g. s1ful.csv in (base course directory)/scoring
  288 $scoring_files_permission = 0660;
  289 
  290 ## e.g. s1bak1.csv in (base course directory)/scoring
  291 $scoring_bak_files_permission = 0440;
  292 
  293 ## e.g. 8587l2h.log  in (base course directory)/html/tmp/l2h
  294 $l2h_logs_permission = 0660;
  295 
  296 ## e.g. set1/ in (base course directory)/html/tmp/l2h
  297 $l2h_set_directory_permission = 0770;
  298 
  299 ## e.g. 1-1082/ in (base course directory)/html/tmp/l2h/set1
  300 $l2h_prob_directory_permission  = 0770;
  301 
  302 ## e.g. 1082output.html in (base course directory)/html/tmp/l2h/set1/1-1082
  303 $l2h_data_permission = 0770;
  304 
  305 ## e.g. file.gif in (base course directory)/html/tmp/gif
  306 $tmp_file_permission = 0660;
  307 
  308 ## e.g. gif/ in (base course directory)/html/tmp/
  309 $tmp_directory_permission = 0770;
  310 
  311 ##e.g. classlist files (e.g. MTH140A.lst) in (base course directory)/templates/
  312 $classlist_file_permission = 0660;
  313 
  314 ##   Prefixes, extensions, defaults, etc
  315 
  316 $scoreFilePrefix    = 'S';
  317 $dash         = '-';  # Can not be the underscore character or an upper or
  318                 # lowercase letter or a digit. Used in .sco file names
  319 $delim          = ',';  # used in scoring, classlist
  320 $dat          = 'csv';
  321 @statusDrop       = qw(drop d withdraw);
  322 $courselist_delim   = '::'; # used by login.pl to get course names / dirs
  323 $instructor_permissions = 10;
  324 $TA_permissions     = 5;
  325 $psvn_digits      = 5;    # Number of digits in psvn numbers. E.g. if 4, psvn's
  326                   # will be between 1000 and 9999. The number of available
  327                   # psvn's must be greater than (#students)*(#problem sets)
  328 $score_decimal_digits = 1;    # Number of decimal digits in recorded scores. For example
  329                   # if this is 1 then on a 1 point problem that allows partial
  330                   # credit, possible scores are 0, .1, .2, ..., 1.
  331 
  332 $maxAttemptsWarningLevel = 5;
  333                         # If the set definition file puts a limit on the number of
  334                         # times a problem may be attempted, processProblem.pl will
  335                         # give a warning message when <= $maxAttemptsWarningLevel
  336                         # attempts remain.
  337 
  338 $noOfFieldsInClasslist = 9;
  339                         # The number of fields in the classlist file. This is used as
  340                         # a check to make sure each record in the classlist file has
  341                         # this number of fields
  342 
  343 $htmlModeDefault = 'HTML_tth';    # The default mode for displayed problems (either 'HTML',
  344                               # 'Latex2HTML', or 'HTML_tth'
  345 
  346 $allowStudentToChangeEMAddress = 1; # setting to 1 allows students to change their
  347                                     # own email address. Setting to 0 disallows this
  348 
  349 $Global::PG_environment{showPartialCorrectAnswers} = 1;  ## Set to 0 or 1. If set to 1 in multipart
  350                                     # questions the student will be told which parts are
  351                                     # correct and which are incorrect.  Usually, this is
  352                                     # set explicitly in each individual problem.
  353 
  354 $allowDestroyRebuildProbSets = 0;   # Set to 0 or 1. If set to 1 a professor can destroy and
  355                                     # rebuild problems sets in one operation. This is very
  356                                     # convenient and powerful, but also very dangerous.  Usually
  357                                     # this is not allowed in courses students are using.  It is
  358                                     # often set to 1 in a private course being used only for
  359                                     # developing problem sets.  To do this, reset this in the
  360                                     # private course's webworkCourse.ph file.
  361 
  362 $Global::PG_environment{recordSubmittedAnswers} = 1;  # Set to 0 or 1. If set to 1, submitted answers will be
  363                   # stored. For example in a multipart question, a student can
  364                   # do several parts, then logout or go onto another question.
  365                   # When they view the problem again, the answer blanks will be
  366                   # filled in with their most recent answers. This also allows
  367                   # professors to see exactly what a student entered. This default
  368                   # can be over ridden for an individual problem by setting
  369                   # recordSubmittedAnswers in the .pg file for the problem.
  370 
  371 $maxSizeRecordedAns = 256;      # Student answers longer than this length in bytes will not
  372                   # stored in the database.
  373 
  374 $hide_studentID_from_TAs = 0;     # Set to 0 or 1. If set to 1, studentID's will be hidden
  375                   # from TA's.  For example some Universities may use SS#'s for
  376                   # student ID's and you may not want TA's to view these.
  377 
  378 ## arguments for flock()
  379 
  380 $shared_lock      = 1;
  381 $exclusive_lock   = 2;
  382 $nonblocking_lock = 4;
  383 $unlock_lock      = 8;
  384 
  385 # These values provide defaults for the various answer comparison macros found
  386 # in PGanswermacros.pl.  They can be over ridden for individual courses by
  387 # redefining the variables in the individual course webworkCourse.ph file.
  388 # They can be over ridden for individual problems by explicitly passing the
  389 # desired values to the answer comparison macro
  390 
  391 # The following effect numerical answer comparison
  392 $numRelPercentTolDefault  = .1;
  393 $numZeroLevelDefault    = 1E-14;
  394 $numZeroLevelTolDefault   = 1E-12;
  395 $numAbsTolDefault     = .001;
  396 $numFormatDefault     = '';   ## use perl's format in prfmt()
  397 # The following effect function comparison
  398 $functRelPercentTolDefault  = .1;
  399 $functZeroLevelDefault    = 1E-14;
  400 $functZeroLevelTolDefault = 1E-12;
  401 $functAbsTolDefault     = .001;
  402 $functNumOfPoints     = 3;
  403 $functVarDefault      = 'x';
  404 $functLLimitDefault     = .0000001;
  405 $functULimitDefault     = .9999999;
  406 # The following effects function comparison upto constant for antidifferentiation
  407 $functMaxConstantOfIntegration = 1E8;
  408 
  409 ## These values provide defaults for the window size in the problemEditor.pl script
  410 $editor_window_rows   = 25;
  411 $editor_window_columns  = 90;
  412 
  413 ## This is the maximum number problems sets that can be downloaded at one time
  414 ## by a professor.  Set this higher or lower depending on the speed of your server
  415 
  416 $max_num_of_ps_downloads_allowed = 20;
  417 
  418 
  419 # Subroutines for defining the directories and URLs
  420 ###### Public vars/routines - these are imported into your namespace, #######
  421 ###### so they can be called as they are.
  422                   #######
  423 
  424 sub getWebworkScriptDirectory { convertPath($scriptDirectory )  };
  425 sub getCourseDatabaseDirectory  { convertPath($databaseDirectory )};
  426 sub getCourseDatabaseTieFile  { convertPath($DBtie_file )};
  427 sub getCourseLogsDirectory    { convertPath($logsDirectory )};
  428 sub getCourseTemplateDirectory  { convertPath($templateDirectory )};
  429 sub getCourseEmailDirectory     { convertPath("${templateDirectory}email/")};
  430 sub getCourseScoringDirectory { convertPath($scoringDirectory ) };
  431 sub getCourseHtmlDirectory    { convertPath($htmlDirectory )};
  432 sub getCourseTempDirectory    {convertPath($courseTempDirectory)};
  433 sub getCoursel2hDirectory   { convertPath( "${courseTempDirectory}l2h/" )};
  434 sub getCourseScriptsDirectory { convertPath($courseScriptsDirectory  )};
  435 sub getCourseMacroDirectory   { convertPath($macroDirectory  )};
  436 sub getWebworkLogsDirectory   { convertPath($webworkLogsDirectory)};
  437 
  438 sub getCourseClasslistFile    { convertPath("${coursesDirectory}$_[0]/templates/${classlistFilename}") };
  439 
  440 sub getCourseKeyFile      { convertPath("${coursesDirectory}$_[0]/DATA/${authDirectory}${keyFilename}") };
  441 sub getCoursePasswordFile   { convertPath("${coursesDirectory}$_[0]/DATA/${authDirectory}${passwordFilename}") };
  442 sub getCoursePermissionsFile  { convertPath("${coursesDirectory}$_[0]/DATA/${authDirectory}${permissionsFilename}") };
  443 sub getCourseDatabaseFile     { convertPath("${coursesDirectory}$_[0]/DATA/${$database}") };
  444 
  445 sub getCourseMOTDFile       { convertPath("${coursesDirectory}$_[0]/templates/${course_motd_filename}") };
  446 sub getSystemMOTDFile       { convertPath("${mainDirectory}${system_motd_filename}") };
  447 
  448 sub getWebworkCgiURL  { $cgiWebworkURL };
  449 sub getCourseHtmlURL  { $htmlURL };
  450 sub getCoursel2hURL   { "${courseTempURL}l2h/" }
  451 sub getCourseTempURL  { $courseTempURL };   #defined in webworkCourse.ph
  452 sub getDirDelim     { $dirDelim };
  453 sub getDelim      { $delim };
  454 sub getScoreFilePrefix  { $scoreFilePrefix };
  455 sub getScoring_log    { $scoring_log };
  456 sub getDash       { $dash };
  457 sub getDat        { $dat };
  458 sub getBbext      { @dbext };
  459 sub getStatusDrop   { @statusDrop };
  460 
  461 sub  getNumRelPercentTolDefault     { $numRelPercentTolDefault };
  462 sub  getNumZeroLevelDefault       { $numZeroLevelDefault };
  463 sub  getNumZeroLevelTolDefault      { $numZeroLevelTolDefault };
  464 sub  getNumAbsTolDefault        { $numAbsTolDefault };
  465 sub  getNumFormatDefault        { $numFormatDefault };
  466 sub  getFunctRelPercentTolDefault   { $functRelPercentTolDefault };
  467 sub  getFunctZeroLevelDefault     { $functZeroLevelDefault };
  468 sub  getFunctZeroLevelTolDefault    { $functZeroLevelTolDefault };
  469 sub  getFunctAbsTolDefault        { $functAbsTolDefault };
  470 sub  getFunctNumOfPoints        { $functNumOfPoints };
  471 sub  getFunctVarDefault         { $functVarDefault };
  472 sub  getFunctLLimitDefault        { $functLLimitDefault };
  473 sub  getFunctULimitDefault        { $functULimitDefault };
  474 sub  getFunctMaxConstantOfIntegration { $functMaxConstantOfIntegration };
  475 
  476 sub  getLoginURL  { $loginURL };
  477 
  478 sub  getAllowDestroyRebuildProbSets { $allowDestroyRebuildProbSets };
  479 
  480 sub getCourseEnvironment {
  481     die "getCourseEnvironment was called without specifying a course" unless $_[0];
  482   my $fullPath = convertPath("${coursesDirectory}$_[0]/$courseEnvironmentFile");
  483     require "$fullPath"
  484         || die "Can't find local environment file for
  485                  $fullPath\n";
  486 }
  487 
  488 
  489 
  490 ### dump a (hopefully) descriptive error to the browser and quit
  491 #sub wwerror {
  492 #    my($title, $msg, $url, $label, $query_string) = @_;
  493 #
  494 #    print "content-type: text/html\n\n
  495 #          <HTML><HEAD><TITLE>Error: $title</TITLE></HEAD>
  496 #          <BODY BACKGROUND=\"$background_warn_url\">
  497 #          <H1>Error: $title</H1>\n $msg \n";
  498 #    if ($url) {
  499 #    print "<FORM ACTION=\"$url\">
  500 #           <INPUT TYPE=SUBMIT VALUE=\"$label\">
  501 #           </FORM>\n";
  502 #    }
  503 #    print "</BODY></HTML>";
  504 #    &log_error($title, $query_string);
  505 #    exit 1;
  506 #}
  507 
  508 sub wwerror {
  509     my($title, $msg, $url, $label, $query_string) = @_;
  510     # <BODY BACKGROUND=\"$background_warn_url\">
  511 
  512     $msg = '' unless defined $msg;
  513     $url = '' unless defined $url;
  514     $label = '' unless defined $label;
  515     $query_string = '' unless defined $query_string;
  516 
  517     print "content-type: text/html\n\n
  518           <HTML><HEAD><TITLE>Error: $title</TITLE></HEAD>
  519           <BODY BGCOLOR = 'CCCCCC'>
  520 
  521           <H2>Error: $title</H2>
  522           <PRE>$msg\n
  523           </PRE>";
  524     if ($url) {
  525     print "<FORM ACTION=\"$url\">
  526            <INPUT TYPE=SUBMIT VALUE=\"$label\">
  527            </FORM>\n";
  528     }
  529     print "</BODY></HTML>";
  530     &log_error($title, $query_string);
  531     exit 1;
  532 }
  533 
  534 sub error {wwerror(@_);}        ##alias for wwerror
  535 
  536 
  537 # return a (scalar) tip
  538 sub tip {
  539     my ($tips, @tiplist);
  540     local($/) = undef;
  541     #undef $/; # slurp it all in
  542     open(TIPS, "$tipsFile") || &error("Can't open $tipsFile");
  543     $tips = <TIPS>;
  544     close(TIPS);
  545 
  546     # add any local tips to the list before we pick a random one
  547     if (-r "${templateDirectory}$tipsFilename") {
  548         open(TIPS, "${templateDirectory}$tipsFilename");
  549         $tips .= '%%' . <TIPS>;
  550         close(TIPS);
  551     }
  552     $/ = "\n"; # <> now reads until newline
  553     $tips =~ s/#.*?\n//mg;  # remove comments
  554     @tiplist = split(/%%/, $tips);
  555     return $tiplist[rand(@tiplist)];    # choose one at random
  556 }
  557 
  558 # return an array of tips
  559 sub all_tips {
  560     my ($tip, $tips, @tiplist);
  561 
  562     local($/) = undef; # slurp it all in
  563     open(TIPS, "$tipsFile") || &error("Can't open $tipsFile");
  564     $tips = <TIPS>;
  565     close(TIPS);
  566 
  567     # add any local tips to the list before we pick a random one
  568     if (-r "${templateDirectory}$tipsFilename") {
  569         open(TIPS, "${templateDirectory}$tipsFilename");
  570         $tips .= '%%' . <TIPS>;
  571         close(TIPS);
  572     }
  573     $/ = "\n"; # <> now reads until newline
  574     $tips =~ s/#.*?\n//mg;  # remove comments
  575     @tiplist = split(/%%/, $tips);
  576     return @tiplist;
  577 }
  578 
  579 
  580 # begin Timing code
  581 use Benchmark;
  582 sub dateTime {
  583     my @timeArray = localtime(time);
  584     my $out = sprintf("%2.2d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d",
  585     $timeArray[5],$timeArray[4]+1,@timeArray[3,2,1,0]);
  586     $out;
  587 }
  588 
  589 #the ps system calls do not work on all systems, and are usually not
  590 #necessary anyway. If you wish that information to be logged, simply
  591 #uncomment the relevant lines, but be warned that they might need to
  592 #be modified for your system
  593 sub logTimingInfo {
  594     my ($beginTime,$endTime,$script,$course,$user,$remoteHost,$userAgent) = @_;
  595     $remoteHost = ""unless defined($remoteHost);
  596     $userAgent  = ""   unless defined($userAgent);
  597     open(TIMELOG, ">>${webworkLogsDirectory}timing_log") ||
  598       warn "*Unable to open timing log for writing:\n ${webworkLogsDirectory}timing_log. ";
  599 
  600   my $mem_string = '';
  601 #     my $process_string = `ps -o vsz -p $$`;
  602 #     $process_string =~ s/^\s*//;
  603 #     $process_string =~ s/\s*$//;
  604 #     my @process_string = split(/\s+/,$process_string);  # gets memory size
  605 #     my $mem_string = " mem: ${process_string[1]}K";
  606 
  607   my $load_string = '';
  608 #     my @load = split(/\n/,`ps -U wwhttpd -o state`);
  609 #     my $load_string = " load: " . grep(/R/,@load);
  610 
  611     print TIMELOG $script,"\t",$course,"\t",&dateTime,"\t",
  612                   timestr( timediff($endTime,$beginTime), 'all' ),"\t",
  613                   "pid: $$ DBtie_tries: $Global::DBtie_tries" . $mem_string . $load_string,"\t",$user,"\t",
  614                   $remoteHost,"\t",$userAgent,"\n";
  615     close(TIMELOG);
  616 }
  617 # end Timing code
  618 
  619 
  620 # handy routines for modules that wish to throw exceptions outside of the
  621 # current package. (taken from Carp.pm)
  622 #
  623 # We'll want to remove this in final versions of WeBWorK.
  624 
  625 sub log_error {
  626     my ($comment, $data) = @_;
  627     my $accessLog = convertPath("${webworkLogsDirectory}access_log");
  628     my $errorLog = convertPath("${webworkLogsDirectory}error_log");
  629     open(ACCESS, ">>$accessLog");
  630     open(ERROR, ">>$errorLog");
  631     print ACCESS "ERROR ($comment) ", scalar(localtime), ': ', &shortmess($data);
  632     print ERROR "ERROR ($comment) ", scalar(localtime), ': ', &shortmess($data);
  633     close(ACCESS);
  634     close(ERROR);
  635 }
  636 
  637 sub log_info {
  638     if( $Global::logAccessData == 1 ) {
  639     my ($comment, $data) = @_;
  640       my $accessLog = convertPath("${webworkLogsDirectory}access_log");
  641       open(LOG, ">>$accessLog") or warn "Can't open accessLog $accessLog";
  642       print LOG "INFO ($comment) ", scalar(localtime), ': ',  &shortmess($data);
  643       close(LOG);
  644   }
  645 }
  646 
  647 
  648 ## converts full path names to to use the $dirDelim instead of /
  649 sub convertPath {
  650     my ($path) = @_;
  651     warn "convertPath has been asked to convert an empty path<BR> |$path| at ", caller(),"<BR>" unless $path;
  652     $path =~ s|/|$dirDelim|g;
  653 
  654   $path;
  655 }
  656 
  657 # -----
  658 
  659 BEGIN {
  660   sub PG_floating_point_exception_handler {       # 1st argument is signal name
  661     my($sig) = @_;
  662     print "Content-type: text/html\n\n<H4>There was a floating point arithmetic error (exception SIG$sig )</H4>--perhaps
  663     you divided by zero or took the square root of a negative number?
  664     <BR>\n Use the back button to return to the previous page and recheck your entries.<BR>\n";
  665     exit(0);
  666   }
  667 
  668   $SIG{'FPE'}  = \&PG_floating_point_exception_handler;
  669 
  670   sub PG_warnings_handler {
  671     my @input = @_;
  672     my $msg_string = longmess(@_);
  673     my @msg_array = split("\n",$msg_string);
  674     my $out_string = "##More details:<BR>\n----";
  675     foreach my $line (@msg_array) {
  676       chomp($line);
  677       next unless $line =~/\w+\:\:/;
  678       $out_string .= "----" .$line . "<BR>\n";
  679     }
  680 
  681     $Global::WARNINGS .="*  " . join("<BR>",@input) . "<BR>\n" . $out_string .
  682                         "<BR>\n--------------------------------------<BR>\n<BR>\n";
  683     $Global::background_plain_url = $Global::background_warn_url;
  684     $Global::bg_color = '#FF99CC';  #for warnings -- this change may come too late
  685   }
  686 
  687   $SIG{__WARN__}=\&PG_warnings_handler;
  688 
  689   $SIG{__DIE__} = sub {
  690     print "Content-type: text/html\r\n\r\n <h4>Software error</h4> @_<br>
  691       Please inform the webwork meister.<p>
  692       In addition to the error message above the following warnings were detected:
  693       <HR>
  694       $Global::WARNINGS;
  695       <HR>
  696       It's sometimes hard to tell exactly what has gone wrong since the
  697       full error message may have been sent to
  698       standard error instead of to standard out.
  699       <p> To debug  you can
  700       <ul>
  701       <li> guess what went wrong and try to fix it.
  702       <li> call the offending script directly from the command line
  703       of unix
  704       <li> enable the debugging features by redefining
  705       \$cgiURL in Global.pm and checking the redirection scripts in
  706       system/cgi. This will force the standard error to be placed
  707       in the standard out pipe as well.
  708       <li> Run tail -f error_log <br>
  709       from the unix command line to see error messages from the webserver.
  710       The standard error output is being placed in the error_log file for the apache
  711       web server.  To run this command you have to be in the directory containing the
  712       error_log or enter the full path name of the error_log. <p>
  713       In a standard apache installation, this file is at /usr/local/apache/logs/error_log<p>
  714       In a RedHat Linux installation, this file is at /var/log/httpd/error_log<p>
  715       At Rochester this file is at /ww/logs/error_log.
  716       </ul>
  717       Good luck./n" ; exit(0);
  718   };
  719 
  720   #exit(0);
  721   #CGI::Carp::croak(@_);  };
  722   #use CGI::Carp qw( fatalsToBrowser carp croak);
  723 
  724   my $CarpLevel = 0;  # How many extra package levels to skip on carp.
  725   my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
  726 
  727 #   sub longmess {
  728 #     my $error = shift;
  729 #     my $mess = "";
  730 #     my $i = 1 + $CarpLevel;
  731 #     my ($pack,$file,$line,$sub,$eval,$require);
  732 #
  733 #     while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
  734 #       if ($error =~ m/\n$/) {
  735 #         $mess .= $error;
  736 #       }
  737 #       else {
  738 #         if (defined $eval) {
  739 #           if ($require) {
  740 #             $sub = "require $eval";
  741 #           }
  742 #           else {
  743 #             $eval =~ s/[\\\']/\\$&/g;
  744 #             if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
  745 #               substr($eval,$MaxEvalLen) = '...';
  746 #             }
  747 #             $sub = "eval '$eval'";
  748 #           }
  749 #         }
  750 #         elsif ($sub eq '(eval)') {
  751 #           $sub = 'eval {...}';
  752 #         }
  753 #
  754 #         $mess .= "\t$sub " if $error eq "called";
  755 #         $mess .= "$error at $file line $line\n";
  756 #       }
  757 #
  758 #       $error = "called";
  759 #     }
  760 #
  761 #     $mess || $error;
  762 #   }
  763 
  764 }
  765 
  766 ###############
  767 ## Error message routines
  768 ###############
  769 
  770 BEGIN {    #error message routines
  771 
  772   my $CarpLevel = 0;  # How many extra package levels to skip on carp.
  773   my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
  774 
  775   sub longmess {
  776     my $error = shift;
  777     my $mess = "";
  778     my $i = 1 + $CarpLevel;
  779     my ($pack,$file,$line,$sub,$eval,$require);
  780 
  781     while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
  782       if ($error =~ m/\n$/) {
  783         $mess .= $error;
  784       }
  785       else {
  786         if (defined $eval) {
  787           if ($require) {
  788             $sub = "require $eval";
  789           }
  790           else {
  791             $eval =~ s/[\\\']/\\$&/g;
  792             if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
  793               substr($eval,$MaxEvalLen) = '...';
  794             }
  795             $sub = "eval '$eval'";
  796           }
  797         }
  798         elsif ($sub eq '(eval)') {
  799           $sub = 'eval {...}';
  800         }
  801 
  802         $mess .= "\t$sub " if $error eq "called";
  803         $mess .= "$error at $file line $line\n";
  804       }
  805 
  806       $error = "called";
  807     }
  808 
  809     $mess || $error;
  810   }
  811 
  812   sub shortmess { # Short-circuit &longmess if called via multiple packages
  813     my $error = $_[0];  # Instead of "shift"
  814     my ($curpack) = caller(1);
  815     my $extra = $CarpLevel;
  816     my $i = 2;
  817     my ($pack,$file,$line);
  818 
  819     while (($pack,$file,$line) = caller($i++)) {
  820       if ($pack ne $curpack) {
  821         if ($extra-- > 0) {
  822           $curpack = $pack;
  823         }
  824         else {
  825           return "$error at $file line $line\n";
  826         }
  827       }
  828     }
  829 
  830     goto &longmess;
  831   }
  832 
  833 
  834 }
  835 
  836 ###############
  837 ## End Error message routines
  838 ###############
  839 
  840 
  841 1;  ## This line is required by perl