#!/usr/bin/perl
# NOTE: the above line must be changed to show the path to the
# Perl interpreter on your system! Leave the #! as is, but
# the path may have to be changed if yours is different.
# DO NOT CHANGE the LINE BELOW.
use CGI::Carp qw(fatalsToBrowser); $| = 1; &clear_all();
#########################################################################
# QuizTest 3.0.31 #
# CGI quiz program for the worldwide web. May use multiple choice or #
# true/false questions. The program grades the quiz, shows students #
# their score, then emails the results to the designated instructor. #
# Intended for online courses that are graded. #
# Copyright 1996 - 2002, Kristina L. Pfaff-Harris #
# All rights reserved. #
# #
#########################################################################
##### Licensing: #
##### #
##### This program may be used free of charge under the following #
##### conditions: #
##### #
##### 1. All instructions and Copyright lines must remain unchanged. #
##### #
##### 2. All pages generated by the program must contain one of the #
##### following pieces of HTML code: #
##### #
##### This quiz engine uses QuizTest by #
##### Kristina Pfaff-Harris. It can be found at: #
##### #
##### http://www.tesol.net/scripts #
##### OR: #
##### #
##### #
##### #
##### 3. You may not sell or distribute this program. You may charge #
##### a reasonable fee for installing it for a client as long as #
##### you make it clear that you are not the author, and you are #
##### not selling the program to them: only charging for installing #
##### it. #
##### #
##### 4. You agree that this program is offered without warranty of #
##### any kind, including warranty of fitness for a particular #
##### purpose. You further agree that the author and all sites #
##### associated in any way with this program are not liable for #
##### any damage or loss incurred as a result of using this program.#
#########################################################################
##### #
##### IMPORTANT INSTRUCTIONS: #
##### #
##### In this program, I have put **CHANGE** in all the places where #
##### you will need to modify the program to run on your server, so #
##### that you can easily find all the places where changes are #
##### necessary. This program must be chmod 755 or 775 in order to #
##### work, and the directory where you want QuizTest to put its files #
##### must be chmod 777. #
##### #
##### In addition, if you wish to use the option that will email you #
##### the results every time a student takes one of the quizzes, #
##### and your website is hosted on a Unix or Linux-based web server, #
##### you must have the sendmail program on your web server, and your #
##### web server must have permission to access it as well as #
##### permission to run cgi programs. #
##### #
#########################################################################
# #
# IMPORTANT: If you FTPed this program to your server in "binary" mode, #
# it will NOT work! If you're not sure, please go back and FTP it #
# to your server again and make sure you use "ascii" mode. If you get #
# "500 Server Error", this is almost always the cause. :) #
# #
# Using the program: #
# This program requires the file "quiztest.cgi" at a minimum in order #
# to work. Please read the README.quiztest file for more information. #
# Please read the manual (Manual.html) and check the Scripts for #
# Educators FAQ first (http://tesol.net/scripts/FAQ/) if you have #
# problems. If none of that helps, email me and I'll at least try to #
# help. :-) #
# #
# I hope this program proves useful to you! Please contact me #
# (http://tesol.net/scriptmail.html) for any bugs or feedback. #
#########################################################################
# Special thanks to Selena Sol (http://www.extropia.com) for #
# MultipleChoice 2.0 which helped me get started on my very first quiz #
# program in Perl. #
#########################################################################
%data = &get_data();
if($data{'FA'} ne "ExportToAscii"){
print "Content-type: text/html\n\n";
}
#########################################################################
##### #
##### BEGIN SECTION WHERE YOU WILL NEED TO CHANGE THINGS: #
##### #
##### In this section, there are several places where you'll need #
##### to make changes. Please read all instructions carefully #
##### before you make the changes. #
##### #
#########################################################################
# $basedir: This is the base directory on your server where your
# course materials are located. This is used by the
# program to store the results file separately for each
# lesson. *CHANGE* this to the full base system path
# to where you want QuizTest to put all its quiz files
# and so forth. Please see the README.quiztest file under
# "Setting up Files, Directories, and Permissions" for more
# information about $basedir, and how to set it up.
# Please note that this is NOT a URL, and should NOT
# contain "http://"
#
# If your web server is a Unix-type system, then this
# MUST begin a /, and the folder must be writeable
# by the web server. For example:
# $basedir = "/path/to/your/files";
#
# If your web server is a Windows-type system, then this
# MUST begin a "c:" or "d:" or "e:". For example:
# $basedir = "c:/path/to/your/files";
#$basedir = "/path/to/your/files";
$basedir = "/site/ftp//web/gotacres_com/quiz/quizs";
# $cgi_url is the full web address of your quiztest.cgi program.
# This MUST start with "http://" or it will not work. Please
# **CHANGE** this to the actual web address of where you have
# installed the quiztest.cgi program.
$cgi_url = "http://www.gotacres.com/quiz/quiztest.cgi";
###################################################################
# #
# Operating System Specific Stuff #
# (Windows vs. Unix/Linux) #
# #
###################################################################
# In this section, we're going to try to get some data that will
# help us run this script whether you're using Windows NT/95/98 as
# a web server, or a Unix/Linux-based web server. Here, I feel
# it necessary to point out that Unix/Linux web servers tend to
# be much more flexible and robust (in my experience) than Windows
# ones. However, if you're stuck with Windows, we'll try to get
# this working anyway. :)
# If your web server is Linux/Unix based, please set
# $opsys below to "unix" like this and go to the Unix/Linux Stuff
# Section below:
# $opsys = "unix";
# Otherwise, if it is a Windows-based platform, set $opsys to "win"
# like this and go to the Windows Stuff section:
# $opsys = "win";
$opsys = "unix";
###################################################################
# #
# Unix/Linux Stuff #
# #
###################################################################
# $path_to_sendmail needs to be the FULL path to sendmail on your
# server, and the name of the sendmail file itself: You will
# probably be able to use what I have below, but sendmail
# is sometimes located in /usr/ucblib instead of /usr/lib and
# may be somewhere else altogether. Ask your systems administrator
# where sendmail is, just to make sure, then **CHANGE** this to
# the correct path. Note: on some systems, this is something
# totally different without the word "sendmail" at all such as
# "/var/qmail/bin/qmail-inject".
$path_to_sendmail = "/usr/sbin/sendmail";
###################################################################
# #
# Windows Stuff #
# #
###################################################################
# $mail_server_hostname needs to be the hostname of a mail server
# that your web server is allowed to send mail through. Generally,
# this will be something like "mail.yourdomain.com" but it may
# be something completely different, and you may not be able to
# use this at all. If your web server is also a mail server,
# you may be able to use "localhost" (yes, just that one word,
# no ".com" or anything -- it's a special word that means "this
# machine.") You will need to ask your local technical support
# people for your website what hostname to use for your outgoing
# mail server, then **CHANGE** this to reflect that. For example:
# $mail_server_hostname = "mail.yourdomain.com";
$mail_server_hostname = "mail.gotacres.com";
# $this_server_hostname needs to be the hostname of your web
# server where this script will be run. Sometimes, just the
# "www.yourdomain.com" will work, and sometimes your web
# server has its own name like "web-01.nt.somedomain.com".
# Again, you will need to get the hostname of this machine
# from the technical support people for your web server,
# and **CHANGE** this to reflect what they say. For example:
# $this_server_hostname = "www.yourdomain.com";
$this_server_hostname = "localhost";
# IMPORTANT: DO NOT CHANGE $smtp_auth UNLESS YOU KNOW THAT YOU NEED
# TO USE IT. Please look for "SMTP auth" in the FAQ if you have
# questions (http://tesol.net/scripts/FAQ/)
# Okay, you may NOT need these. If you're sending mail okay, then don't
# change the next two things. However, if you're having problems with
# your mail server requiring authentication to send mail, you may try
# one of these EXPERIMENTAL authentication thingies.
# $smtp_auth is what kind of authentication you want to try to push
# the mail past the mail server.
# $smtp_auth = "POP"; is for "POP before SMTP"
# $smtp_auth = "SMTP"; is for "PLAIN SMTP auth"
# $smtp_auth = "NONE"; is normal.
$smtp_auth = "NONE";
# If you are using POP or SMTP auth above, you must put the username
# and password of an email account located on the mail server you
# put in $mail_server_hostname here.
# NOTE: If there are any ", $, or @ signs in your username or password,
# you must put a \ (backslash) in front of them. For example, if your
# password is 1$jk"yn@, you would put:
# $pop_pw = "1\$jk\"yn\@";
# **CHANGE** "your email login" below to your email username on the
# mail server you'll be using.
# **CHANGE** "your email password" below to your email password on the
# mail server you'll be using.
$pop_un = "webmaster\@gotacres.com";
$pop_pw = "nomoreparts";
# If you are using POP or SMTP auth above, you may need to also
# specify your email address on that mail server. I know, for example,
# that if you have email at softhome.net, you will HAVE to use your
# softhome.net email address even if you have used the authentication
# above. **CHANGE** this to your actual email address if you have
# chosen POP or SMTP auth above.
$auth_from_address = "webmaster\@gotacres.com";
###################################################################
# #
# End of Operating System-Specific stuff. On to more changes: #
# #
###################################################################
# $webmaster: This is just a generic name for the "From" field
# You'll want to *CHANGE* "WebMaster" to something
# appropriate for your site. It can be anything from your
# real name to "Master of the Universe," whatever
# suits your fancy.
$webmaster = "QuizTest v3.0.31";
# $webemail: This is also a generic address for the "From" field
# *CHANGE* "webmaster\@mysite.edu to the webmaster address
# for your website, or to your own address.
$webemail = "webmaster\@mysite.edu";
# $instructor:
# This is the email address of the person who should get
# the results of any quizzes not otherwise assigned to
# an instructor. You will need to set $instructor to the
# email address of the person who should get the results
# of the quizzes after they are taken. **CHANGE** this
# to your own or other appropriate email address. NOTE:
# You must put a \ (backslash) in front of the @ sign
# like this: \@
# IMPORTANT: This is also what you will use as the username
# to log into the administrative section of the program.
$instructor = "dougcaffey\@gotacres.com";
# Now, you'll need to select a password of sorts. Please note
# that this does NOT make the admin functions secure, it just
# makes it a little more secure than if the password were
# "admin" as it is by default, or if there were no password.
# You will use this to log into the admin screen.
# So, **CHANGE** $admin_password = "admin"; to
# $admin_password = "something_else"; here. The only restriction
# is it cannot contain the "|" (pipe) symbol.
$admin_password = "nomoreparts";
# $multiple_instructors :
# This allows you to determine whether or not you wish to have
# multiple instructors, one for each quiz. If you **CHANGE**
# $multiple_instructors = "no"; to
# $multiple_instructors = "yes";
# then the program will create a file for the instructors in
# whatever folder you set up as $basedir. This will keep track
# of instructors and which quizzes they are responsible for.
$multiple_instructors = "yes";
# $show_scores_for_all_quizzes :
# If this is set to Yes, then users can click a link and see just
# the high scores for a quiz without actually taking a quiz. If this
# is set to No, then the link will not appear.
$show_scores_for_all_quizzes = "Yes";
#########################################################################
# #
# IMPORTANT: The rest of these options may be changed for each #
# individual quiz through the web-based quiz creation interface. #
# It is not necessary to change these settings here, as you may #
# override them when creating or editing a quiz. However, you may #
# wish to read through them and make sure the default settings are #
# satisfactory to you, and **CHANGE** them if you need to do so. #
# #
#########################################################################
# $debugging: Okay, first of all, if you're having problems with the
# script, and $debugging is not set to 1, then you will want to **CHANGE**
# $debugging = 0; to $debugging = 1;
# What this will do is print out some helpful information about why
# the script might not be working for you. If it's not helpful to
# you, then it will definitely be helpful to me when you email me
# for help! If you want, you can set this right off the bat to be
# sure that all the files and so forth are in the right place. Just
# be sure to turn it back to 0 before you actually use the program,
# or your users will get all these funny messages about files and
# directories.
# This setting may be changed for each quiz when you create or
# edit a quiz.
# This is set to 1 by default to help you install QuizTest. **CHANGE** it
# to 0 when you feel that it's all working properly.
$debugging = 0;
# Now, it is sometimes helpful to be able to turn on debugging
# without coming in here and editing this file. $remote_debugging
# lets you determine whether or not you want to be able to
# turn on debugging by calling the quiztest.cgi program like
# this:
#
# http://www.your.site/cgi-bin/quiztest.cgi?debugging=1
#
# If you set $remote_debugging = "on"; then you will be
# able to turn debugging on by calling the script like I
# have it above. Note: this means that anyone else can
# turn debugging on as well. It shouldn't really hurt anything,
# but some people are sensitive about outside people knowing
# where their files are and so forth. If you set
# $remote_debugging = "off"; then you will have to edit
# the script, and set $debugging = 1; if you want debugging
# information at all. **CHANGE** this to the appropriate
# setting.
# This setting may be changed for each quiz when you create or
# edit a quiz.
$remote_debugging = "off";
# This next is for purely aesthetic purposes. Basically, you can have
# any HTML code you like appear at the top of the pages generated by
# the program, and at the bottom. If you don't know much about HTML
# code, then I suggest you leave this alone. If you change it, then
# all of the following characters
# " @ \ % $
# MUST have a backslash in front of them. For example:
# \" \@ \\ \% \$
# If you aren't extremely careful with this, the program will not run.
# You may **CHANGE** $header = "...etc to contain the appropriate
# HTML code for your site.
$header = "
Gotacres.com: Test your rural land knowledge!
The Rural Land Quiz!
";
# $footer is pretty much the same deal as $header above: this HTML
# is at the end of all pages generated by the program.
$footer ="
";
# $grade_quiz_button_text is so that if you would like to change
# what the "Grade Quiz" button on the quizzes says, you can do that.
# This will not affect the operation of the program, so you can leave
# it the way it is if you like. Please make sure to put a \ (backslash)
# in front of any of the following characters:
# @ $ " % \
# like this:
# \@ \$ \" \% \\
$grade_quiz_button_text = "Grade Quiz";
# $mail_me_results lets you tell the program whether you want the
# results of the quizzes emailed to you or not. I put this in so
# that I could turn off emailing on the demo script: otherwise,
# I'd get inundated with emailed quizzes from people trying out the
# program. You should **CHANGE** this to
#
# $mail_me_results = "Yes";
#
# or you will never get the results of the quizzes! NOTE: If you set
# this to Yes, it will only email you the first time someone takes the
# quiz. If you set $mail_me_results = "All"; then it will email you all
# the results any time someone takes the quiz.
$mail_me_results = "No";
# $take_quiz_over :
# If you **CHANGE** $take_quiz_over = "no"; to
# $take_quiz_over = "yes";
# then students will be allowed to take any quiz more than once.
$take_quiz_over = "yes";
# $scores_to_save :
# If you have set $take_quiz_over to "yes", you will need to decide
# which scores you want to save. By default, QuizTest will only save
# the FIRST result: Any other attempts at the quiz will not be saved,
# since we tend to assume that anyone can pass the quiz just by trial
# and error, given enough attempts. However, some people wish to save
# all the results, and some wish to save only the last result.
# Here are the possible settings you can use:
# To save ONLY the first attempt:
# $scores_to_save = "first";
# To save ONLY the last attempt:
# $scores_to_save = "last";
# To save the scores from ALL attempts:
# $scores_to_save = "all";
$scores_to_save = "first";
# $force_complete_quiz is whether or not you want to have the
# script check to make sure that all questions have been answered
# on a quiz. If you set
# $force_complete_quiz = "yes";
# Then quiz takers will have to answer all questions on a quiz before
# it can be graded. If you set
# $force_complete_quiz = "no";
# Then quiz takers will be able to submit only partially-completed
# quizzes.
$force_complete_quiz = "yes";
# $authorized_users :
# This lets you decide whether just anyone can take the quiz,
# or only registered students. If you **CHANGE**
# $authorized_users = "no"; to
# $authorized_users = "yes";
# then you must add each student to the system through the
# admin interface.
$authorized_users = "no";
# $what_to_show_after_quiz is designed to let you determine whether
# or not to show the users whether their individual answers were
# correct or incorrect, and whether to show their score or not.
# The idea behind this is that if you show the score, the user could
# keep hitting the "Back" button on the browser, and changing answers
# until they got a perfect score, after which they could share the
# correct answers to those questions with all their friends. This
# setting has 4 options:
#
# To show the Correct answer if the user got the Incorrect answer, and
# show the total score (e.g. 50%, 100%) set this to:
#
# $what_to_show_after_quiz = "All";
#
# To tell users whether each answer was Correct or Incorrect, but not
# tell them what the correct answer actually was if they got it wrong,
# and to show the total score, set this to:
#
# $what_to_show_after_quiz = "StatusOnly";
#
# To show only the total percentage score with no feedback about which
# answers were correct or incorrect, set this to:
#
# $what_to_show_after_quiz = "ScoreOnly";
#
# To show no results at all, but rather the message "Thank you for
# taking this test, . You will be notified
# of your score when this test is closed," set this to:
#
# $what_to_show_after_quiz = "None";
$what_to_show_after_quiz = "ScoreOnly";
# $show_quiz_questions tells whether or not you'd like to display
# the quiz questions, as well as the answers and/or score in the
# results as shown above. If you would like QuizTest to display
# and email the questions along with the answers, **CHANGE**
# $show_quiz_questions = "no"; to
# $show_quiz_questions = "yes";
# If you would like QuizTest to only display/email the questions to
# the instructor, but not to the student, **CHANGE**
# $show_quiz_questions = "no"; to
# $show_quiz_questions = "instructor";
# Please note that if you have HTML code or embedded sounds, images,
# etc in your questions, this may have some very strange results.
# You may also set this "per quiz".
$show_quiz_questions = "yes";
# $show_other_scores should be "Yes" or "No". If you set
# $show_other_scores = "Yes"; then the program will not only
# show the user his score, but will show the top scorers out
# of others who have taken the quiz. Most people using this
# for educational purposes will leave this at "No" while
# people using this for amusement may wish to put it to "Yes"
# If you do **CHANGE** this to $show_other_scores = "Yes"; then
# you will need to tell how many scores to show in
# $number_of_scores_to_show below.
$show_other_scores = "No";
# $number_of_scores_to_show should be the number of previous
# quiz scores you wish to show to each person who takes a quiz.
$number_of_scores_to_show = "10";
# $show_grading_scale should just be "Yes" or "No". If it is
# "Yes", then you may wish to edit $grading_scale below to something
# appropriate for your setting. If it is "No" then the grading
# scale will not be shown at all. **CHANGE** this to
# $show_grading_scale = "No";
# if you don't wish to show a grading scale like the one below.
$show_grading_scale = "Yes";
# $grading_scale is just something to print out to tell students
# what their percentage score equals in terms of the A-F grading
# scale. You may edit this as you please, or delete it entirely
# if you do not choose to show a grading scale at all. You may
# **CHANGE** any of the text in between
# and , and may use any HTML code
# you wish to make it pretty. However, please be aware that if you
# use any of the following characters:
# @ $ \ "
# you must put a backslash \ in front of them like this:
# \@ \$ \\ \"
# or the program will not work.
$grading_scale = "
";
###################################################################
# #
# Options for Short-Answer scoring. PLEASE Read Carefully!!! #
# (These may also be changed on a per-quiz basis.) #
# #
###################################################################
#
# Now, QuizTest will support "short answer" questions. However,
# being a computer program and not a person, it does not have good
# judgement about scoring, and would be extremely strict if left to
# its own devices. For example, if the correct answer were "no." and
# the student were to type in the answers "No." or "no" in the form,
# QuizTest would count both of those wrong. Good for a spelling test,
# rather inconvenient for an essay test. Here, we try to give you some
# leeway. The following $sa_blahblah variables are designed to moderate
# this behavior a bit. **CHANGE** each of these to "yes" or "no" as
# you please, after reading the description.
#
# I strongly suggest that you experiment with these settings a bit
# before working with short-answer questions. If nothing else, please
# remember that a computer program is no substitute for a human grader,
# and any short-answer questions you have should be reviewed by a person
# before counting the student out for them.
#
# $sa_ignorecase = "yes";
# Tell QuizTest to ignore differences in case, so that "no", "No", and
# "NO" will all be counted as correct if the answer is "No."
# If you don't want this, **CHANGE** this to "no".
$sa_ignorecase = "yes";
# $sa_ignorepunctuation
# Tell QuizTest to ignore punctuation, so that '"Yes," she answered.'
# will be counted the same as 'Yes she answered' or 'Yes, she answered'
# This is a bad idea if you plan to do Math or Science quizzes, since
# 1/4 would ignore the "punctuation" sign "/" and 14 would be counted
# as a correct answer!
# If you do want this, **CHANGE** this to "yes".
$sa_ignorepunctuation = "no";
# $sa_ignorespaces
# Tell QuizTest to ignore differences in spaces between words, so that
# "Yes I do" will be the same as "Yes I do" and "YesIdo".
# If you don't want this, **CHANGE** this to "no".
$sa_ignorespaces = "yes";
# $sa_ignorenonwords
# Tell QuizTest to ignore spaces *and* punctuation, and basically just
# make sure that everything else is in there.
# This is a bad idea if you plan to do Math or Science quizzes, since
# 1/4 would ignore the "punctuation" sign "/" and 14 would be counted
# as a correct answer!
# If you do want this, **CHANGE** this to "yes".
$sa_ignorenonwords = "no";
# $sa_containsanswer
# This tells QuizTest that if student enters anything that is part
# of the correct answer, to score it correct. This is pretty lenient,
# as students entering "e" will be marked correct when the correct
# answer is "antidisestablishmentarianism".
# If you DO want this, **CHANGE** this to "yes".
$sa_containsanswer = "no";
# $sa_markallcorrect
# This tells QuizTest that if student enters anything *at all*
# in a short answer slot, to count it as correct. This is the most
# lenient of all.
# If you DO want this behaviour, **CHANGE** this to "yes".
$sa_markallcorrect = "no";
# $sa_alternates = "yes";
# When you create a quiz, you may give alternate answers for a short-
# answer question. For example, "behavior/behaviour" or "color/colour".
# This tells QuizTest that it is to treat each alternate as a correct
# answer.
# If you don't want this, **CHANGE** this to "no".
$sa_alternates = "yes";
#########################################################################
##### #
##### END SECTION WHERE THINGS NEED TO BE CHANGED. #
##### #
##### You should not HAVE to change anything beyond this point, #
##### although you might want to read through it to see what it does. #
##### If you're interested in how CGI programs work, then this may #
##### act as its own tutorial of sorts. You definitely shouldn't #
##### change anything beyond this point unless you know what you're #
##### doing, though. :) #
##### #
#########################################################################
# This just gives us some useful debugging information.
if($data{'debugging'} && $data{'debugging'} == 1){
$data{'remote_debug'} = 1;
}
# Grr. Workaround for buggy IIS servers that either don't support GET
# at all or that only support key=value.
if($ENV{'QUERY_STRING'} eq "" && $data{'method'} ne ""){
$ENV{'QUERY_STRING'} = $data{'method'};
}
if($ENV{'QUERY_STRING'}){
$ENV{'QUERY_STRING'} =~ s/&debugging=\d//g;
$ENV{'QUERY_STRING'} =~ s/debugging=\d//g;
}
# We cannot do anything if we can't write to $basedir or if it doesn't
# exist. So, let's check before we do anything else.
&no_basedir_error();
# I really hate to do this, but do you have any idea how many people
# never change the password from "admin" to something else? Quite a
# few, unfortunately. So now, if you haven't changed it, you will be
# yelled at until you do. :-)
# However, the password IS "admin" on my demo, so I don't want it to
# yell at me when it's on my site. :-)
if($ENV{'SERVER_NAME'} !~ /linguistic-funland.com$/i &&
$ENV{'SERVER_NAME'} !~ /tesol.net$/i){
if($admin_password eq "admin"){
print "
WARNING! You have not
changed the administrative password from its default.
This means that anyone can find out what it is and do things
to your QuizTest system. This message will only appear until you
change \$admin_password = \"admin\"; in the script to
use another password.
";
}
}
$0 = "QuizTest v3.0.31";
# We need to keep track of the real, hard-coded admin so we can let her
# edit or delete others' students if necessary.
$overall_admin = $instructor;
$quizresultsemail = $instructor;
&debug("IMPORTANT: If you need help with setting this up,
Please copy and paste all of this debug output into an email,
describe the problem you are having, and
send it to me. It will make helping much easier! NOTE: A lot
of the debugging information is just that: information. Errors
are things like \"Cannot open file\" or \"Could not read file\"
or \"Could not find something\". If the script seems to be working
as you expect other than printing out these messages, then it's
probably okay. :-)
When the script is set up, and functioning properly, set
\$debugging = 0; in the script and you will no longer see
these messages. ");
&debug("Web Server software is $ENV{'SERVER_SOFTWARE'}")
if $ENV{'SERVER_SOFTWARE'};
&debug("Base path to website files is $ENV{'DOCUMENT_ROOT'}")
if $ENV{'DOCUMENT_ROOT'};
&debug("Base path translated is $ENV{'PATH_TRANSLATED'}")
if $ENV{'PATH_TRANSLATED'};
&debug("Script is set as $cgi_url");
&debug("Script filename is $ENV{'SCRIPT_FILENAME'}")
if $ENV{'SCRIPT_FILENAME'};
&debug("Server O/S is $^O") if $^O;
################## Define the variables to be used #####################
# $basedir should not end with a "/", so we'll take it off in case they
# put one on.
$basedir =~ s/\/$//g;
# $Name: you must have an input field on your form that says name="name"
# This is generated by the program if you use it to make quizzes.
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
$Name =$data{"name"};
# $Email: one input field on your form must say name="email"
# This is also generated on the form by the program.
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
$Email =$data{"email"};
# $soc: On mine, this was intended for the students' social security
# number. Your form must have an input field with name="SSN"
# on it for this to work, so the program just sets this to N/A
# if you decide you don't want it or need it.
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
$soc =$data{"SSN"};
# $url: This makes sure that you can have several different quizzes
# in different directories, and that the program will refer
# the student to the correct quiz form if they need to go back
# and try again. For example, if they forget to enter their
# name and email address, the program will print a page that
# tells them so and makes them go back again.
$url =$ENV{'HTTP_REFERER'};
# $lessondir: This is the name of the directory where the quiz files
# are kept. There should be a hidden field in your form
# with this information. eg:
#
#
#
# When the program looks for the answerfile, it will
# look in the directory $basedir$lessondir/, or, in
# this case /path/to/my/files/lesson1/ .
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
# Get it from the form's hidden field
$lessondir =$data{"Lessondir"};
# Remove anything that is not a word character, and lowercase it.
$data{'Lessondir'} =~ s/\W+//g; $data{'Lessondir'} =~ tr/[A-Z]/[a-z]/;
$lessondir =~ s/\W+//g; $lessondir =~ tr/[A-Z]/[a-z]/;
# Now, make sure that only a-z and 0-9 (and _) are allowed in there.
$lessondir =~ /^(\w+)$/; $lessondir = $1;
$data{'Lessondir'} =~ /^(\w+)$/; $data{'Lessondir'} = $1;
# $lesson: This is the name of the lesson. It is used by the program
# when it prints the results of the quiz. For example, if
# I had one quiz for Grammar and another one for Arithmetic,
# I would put a hidden field in each separate quiz with a
# name="Lesson" tag. () and the student would see: "Results of the
# Grammar quiz for Student's Name:" and I would also be told
# that it was the Grammar quiz when the results were mailed
# to me.
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
$lesson =$data{"Lesson"};
# $answerfile: This is very important. For each quiz, you must have an
# HTML form AND a text file containing the answers to
# the questions for the quiz. Using the "$basedir"
# variable which we defined above means that you can
# have a different answerfile for each quiz. (I put
# my quizzes each in a separate directory so that I
# don't have to have different names for each answerfile.)
# The answer file must be a "pipe delimited database".
# All that means is that you have to have the question
# number, a "pipe" | and the answer. Like this:
#
# 1|true
# 2|false
# 3|false
#
# And so on. You'll need a separate one for each quiz, so
# they and the quizzes should be kept together in separate
# directories. These are generated by the program.
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
$answer_file = "$basedir/$lessondir/answerfile";
# $instructors_file :
# This is the full system path to a file where you'd like to
# keep track of instructors' email addresses and which quizzes
# each one is responsible for. On Unix-based systems, it will
# look something like this: "/home/users/public_html/instructors".
# On Windows-based systems, it will probably look like this:
# "C:/inetpub/wwwroot/yourname/instructors". **CHANGE** this
# to the real path to that file (including the filename). This
# file must be chmod 766 or otherwise set up so that the web
# server can write to it.
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
$instructors_file = "$basedir/instructors";
# $authorized_users_file :
# This is the full system path and name of the file that you
# want to use to keep track of authorized students.
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
$authorized_users_file = "$basedir/auth_users";
# $results_database: This is the file where the results for all people
# taking the quiz will be stored. You can pick it up
# and sort through it later if you'd like to compare
# students' scores. This will be generated by the
# program. All you really need to do is remember
# its name so you know what to look for.
# This is generated automatically by quiztest.cgi as of QuizTest v3.0
$results_database = "$basedir/$lessondir/results.data";
# WHEW! Glad that's over! Now let's get into the program itself.
# First, we will spit out some debugging info in case people are
# having problems with the script. The filenames can be a problem, so
# let's make sure that everything is readable, writable, and where we
# expect it to be. :) You won't see this unless you've set "$debugging = 1"
# earlier, but it should be very helpful if you need it.
&debug("I'm checking your base directory \"$basedir\"...");
# Check to see if $basedir is really a directory...
if(-d $basedir){
&debug("Good: \$basedir ($basedir) is really a directory.");
}
else {
&debug("Uh oh, I couldn't find that directory. Are you sure it exists?");
}
# We don't need sendmail if we're not using windows...
if($opsys ne "win"){
&debug("Okay. You said sendmail is in \"$path_to_sendmail\". Checking...");
if(-x $path_to_sendmail){
&debug("Looks like that might work. At least, $path_to_sendmail exists
and appears to be some sort of program.");
}
else {
&debug("Whoops, it looks like I can't use that sendmail. (Either it
doesn't exist, or is not executable, meaning I can't run it. Check with
your system administrator and make sure you're pointing to the right one.
If your server is Windows-based, and you're getting this message, then
you haven't set up this script correctly for Windows-based operation.
No external email program is used by this script under Windows. Not Blat,
not Cdonts, not sendmail, nothing. Under Windows, we connect directly to
a mail server to send mail.");
}
}
if($data{'remote_debug'}){ $rdebug = $data{'remote_debug'};} else { $rdebug = 0; }
if($data{'admlogin'}){ $admlogin = $data{'admlogin'};} else { $admlogin = ""; }
if($data{'admpass'}){ $admpass = $data{'admpass'};} else { $admpass = ""; }
my $admformtop = "
$admformtop
Title Of this quiz: \"$title\" (Sorry, Quiz
Titles may not be changed.)
If you'd like any custom HTML
code to be printed at the top of each quiz page, enter it here
If you'd like any custom HTML
code to be printed at the bottom of each quiz page, enter it here
Please enter instructions for
the quiz takers.
In the area below, enter any instructions or other text
which you would like to have appear at the top of the page for
this quiz.
If you'd like a specific message to be shown after the quiz,
you may enter it here. This can include a link to the home page,
links to the lesson pages, a \"Thank you for taking the quiz\"
message, etc.
Modify the form fields
Each quiz has three blanks for the user to fill
in. By default, these are \"Full Name,\" \"Email Address,\"
and \"ID Number\". Here, you will see the default messages
that will appear on the quiz form for each quiz. If you
would like different messages to appear, please take out
what is below, and enter your own messages. HINT: If you are using
the \"authorized users\" feature, you may blank these out, and the
program will use the values from the student databases instead.
Name
Email
ID
Quiz and Quiz Takers
On the left, enter the questions and the possible answers.
Hint: To enter a Short-Answer question, type the question as usual,
but make sure to select the check box for whether you want students
to see a single-line text field or a multi-line text field for
filling in their answer.
To give multiple
options for a Short-Answer field, separate the options with two
forward slashes (//), e.g.: \"Yes//Yep//Yeah//Yessir\".
Be sure to mark it as correct.
If you are using the \"authorized users\" function, select or unselect
the
checkboxes next to the students who are allowed to take this quiz.
$footer";
exit();
}
elsif($data{'FA2'} eq "Edit Configuration"){
print "$header";
$quizdir = &unpipe($data{'qtitle'});
$quizdir =~ tr/[A-Z]/[a-z]/; $quizdir =~ s/\W+//g;
print &quiz_options_form("$basedir/$quizdir/config");
foreach $key (keys(%data)){
if($key ne "formaction" && $key ne "admlogin" && $key ne "admpass" &&
$key ne "FA" && $key ne "FA2" && $key ne "Student"){
$pval = &unpipe_for_html($data{$key});
print "\n";
}
}
@stu = split(/\0/, $data{'Student'});
foreach $stu (@stu){
print "\n";
}
print "
$footer";
exit();
}
elsif($data{'FA2'} eq "Make Changes"){
foreach $key (keys(%data)){$data{$key} = &repipe($data{$key});}
$num = $data{'numquestions'};
$title = &unpipe($data{'qtitle'});
$fn = &unpipe($data{'fn'});
$ea = &unpipe($data{'ea'});
$id = &unpipe($data{'id'});
$instr = &unpipe($data{'instr'});
@qstudents = split(/\0/, $data{'Student'});
if($qstudents[0] eq ""){
$qstudents[0] = $data{'Student'};
}
# Add this quiz to any student who doesn't already
# have it.
&add_quiz_to_students($title,@qstudents);
# Get rid of newlines if any
$instr =~ s/\r\n/ /g;
$instr =~ s/\n/ /g;
$quizdir = $data{'qtitle'}; $quizdir =~ tr/[A-Z]/[a-z]/; $quizdir =~ s/\W+//g;
unless(-d "$basedir/$quizdir"){
$quizdir = unpipe($data{'qtitle'});
$quizdir =~ tr/[A-Z]/[a-z]/; $quizdir =~ s/\W+//g;
}
# Set up the header/footer if any
if($data{'Header'} ne ""){
open(F, ">$basedir/$quizdir/header") || &debug("could not open header $!");
$data{'Header'} =~ s/\r\n/\n/g;
$data{'Header'} =~ s/\n+/\n/g;
if($opsys ne "unix"){binmode(F);}
print F "$data{'Header'}"; close(F);
}
else {
if(-f "$basedir/$quizdir/header"){unlink("$basedir/$quizdir/header");}
}
if($data{'EndMessage'} ne ""){
open(F, ">$basedir/$quizdir/endmessage") ||
&debug("Could not open end-of-quiz message file $basedir/$quizdir/endmessage: $!");
$data{'EndMessage'} =~ s/\r\n/\n/g;
$data{'EndMessage'} =~ s/\n+/\n/g;
if($opsys ne "unix"){binmode(F);}
print F "$data{'EndMessage'}";
close(F);
}
if($data{'Footer'} ne ""){
$data{'Footer'} =~ s/\r\n/\n/g;
$data{'Footer'} =~ s/\n+/\n/g;
open(F, ">$basedir/$quizdir/footer") || &debug("could not open footer $!");
if($opsys ne "unix"){binmode(F);}
print F "$data{'Footer'}"; close(F);
}
else {
if(-f "$basedir/$quizdir/footer"){unlink("$basedir/$quizdir/footer");}
}
# Create quiz configuration section
$quizdir =~ tr/[A-Z]/[a-z]/; $quizdir =~ s/\W+//g;
open(QCONFIG, ">$basedir/$quizdir/config") ||
&debug("Could not create quiz configuration options file: $!");
if($opsys ne "unix"){binmode(QCONFIG);}
foreach $key (keys(%data)){
if($key =~ /^opt_/){
$var = $key; $var =~ s/^opt_//; $var =~ s/\W+//g;
if($key eq "opt_grading_scale"){
$config_value = $data{$key};
$config_value =~ s/\r/\n/sg;
$config_value =~ s/\r\n/\n/sg;
$config_value =~ s/\n+/\n/sg;
}
else {
$config_value = &perl_escape($data{$key});
}
print QCONFIG "$var = $config_value;\n";
}
}
$key = ""; $var = "";
close(QCONFIG);
# Whew! now, to figure out the question/answers..
# $k is the human-readable question number (e.g. 1, 2, 3 instead of 0, 1, 2)
$k = 1;
undef $answerfile;
undef $qline;
for ($i = 1; $i <= $num; $i++){
&unpipe($data{"$i-q"});
&unpipe($data{"$i-c"});
if($data{"$i-q"} ne ""){
# Only the correct answer goes in the answer file
$answerfile .= "$k|"; # the question number
$q = "$i-q";
# escape the stuff for quizdb
$esc_q = &unpipe($data{$q});
$qline .= "|$esc_q # ";
$j = 1; $k++;
# kph 01/20/01
$cor = &unpipe($data{$data{"$i-c"}});
# If it's a short answer question, log which one it is.
if($data{"SA-$i"} ne ""){
$saval = "SA-$i";
$esc_saval = &unpipe($data{$saval});
$qline .= "%$esc_saval% $cor %%";
}
$answerfile .= "$cor\n";
&unpipe($data{"$i-$j-a"});
while($data{"$i-$j-a"} ne ""){
$ans = &unpipe($data{"$i-$j-a"});
if($data{"SA-$i"} eq ""){ $qline .= "$ans %% "; }
$j++;
if($j > 100){last;}
}
# 02-29-04
print "\n";
if($data{"$i-$j-a"} ne ""){
$ans = &unpipe($data{"$i-$j-a"});
if($data{"SA-$i"} eq ""){
$qline .= "$ans %% ";
}
}
$qline =~ s/\s+$//;
}
}
$qline = "$title|$instr|$fn|$ea|$id$qline";
$k--;
&get_date;
$answerfile = "REM: Quiz edited on $date by $data{'admlogin'}\nREM: $k questions\n$answerfile";
$quizdir =~ tr/[A-Z]/[a-z]/; $quizdir =~ s/\W+//g;
unless(-f "$basedir/$quizdir/answerfile" && -f "$basedir/$quizdir/quizdb"){
print "$header
ERROR: Cannot write to quizdb or answerfile. Please check
that '$basedir/$quizdir/answerfile' and
'$basedir/$quizdir/quizdb' exist and are writeable by the
server!
$footer";
exit();
}
# Change the quiz file
open(QF, "+<$basedir/$quizdir/quizdb") ||
&debug("Could not write to quiz file $basedir/$quizdir/quizdb! $!");
if($opsys eq "unix"){ flock(QF, 2); }
else { binmode(QF); }
$oldfile = ;
if(length($oldfile) > length($qline)){
truncate(QF, length($qline));
seek(QF, 0,0);
}
else {
seek(QF, 0, 0);
}
print QF $qline;
close(QF);
# Change the answerfile
undef $/;
open(AF, "+<$basedir/$quizdir/answerfile") ||
&debug("Could not write to answerfile $basedir/$quizdir/answerfile: $!");
if($opsys eq "unix"){ flock(AF, 2); }
else { binmode(AF); }
$oldfile = ;
if(length($oldfile) > length($answerfile)){
truncate(AF, length($answerfile));
seek(AF, 0,0);
}
else {
seek(AF,0,0);
}
print AF $answerfile;
close(AF);
$/ = "\n";
$data{'FA2'} = "";
$message = "Quiz successfully modified.
$admformtop
You may view your newly edited quiz here:";
if($opsys eq "win"){
$message .= "";
}
else {
$message .= "
$cgi_url?$quizdir
";
}
$message .= "
You may also try out the quiz right
now to make sure that it works:
";
$another = "another";
&edit_quiz;
exit();
}
$another = "a" if $another eq "";
print "$header
$message
$admformtop
Please choose $another quiz to edit:
$footer";
exit();
}
sub add_student {
$quizopts = &find_quizzes("checkbox");
if($data{'FA2'} ne "Add"){
print "$header
$message
$admformtop
Student Info
Quiz(zes) for this Student$select_all_quizzes_html
$error
Student Name:
Student ID/Email:
Student Password:
Student Password again:
$quizopts
$footer";
exit();
}
if($data{'Password'} eq "" || $data{'Password2'} eq "" || $data{'ID'} eq ""){
$error = "Error: All fields must be filled in.";
$data{'FA2'} = "";
&add_student;
}
open(FILE, "<$authorized_users_file") ||
&debug("Could not open authorized users file $authorized_users_file: $!");
($student,$pw) = (split(/\|/, (grep(/^$data{'ID'}\|/, ))[0]))[0,1];
close(FILE);
if($student eq $data{'ID'}){
$error = "Error: Student $data{'ID'} exists.";
$data{'FA2'} = "";
&add_student;
}
if($data{'Password'} ne $data{'Password2'}){
$error = "Error: Passwords do not match.";
$data{'FA2'} = "";
&add_student;
}
@quizzes = split(/\0/, &unpipe($data{'QuizName'}));
undef $student_quizzes;
foreach $quiz (@quizzes){
$student_quizzes .= "$quiz%";
}
$student_quizzes =~ s/%$//;
$data{'ID'} = &unpipe(&fixmac($data{'ID'}));
$data{'Name'} = &unpipe(&fixmac($data{'Name'}));
$data{'Password'} = &unpipe(&fixmac($data{'Password'}));
open(FILE, ">>$authorized_users_file") ||
&debug("Could not open authorized users file ($authorized_users_file):$!");
if($opsys eq "unix"){ flock(FILE, 2); }
else { binmode(FILE); }
seek(FILE, 0, 2);
# 06/28/02 added admlogin so that we know who added it.
print FILE "$data{'ID'}|$data{'Password'}|$data{'Name'}|$student_quizzes|$data{'admlogin'}\n";
close(FILE);
$message = "Student $data{'ID'} added. Add another student:
Please modify whichever information you like in the
fields below. When you are finished, press the
\"Edit Results\" button. (Note: \"Name\", \"Password\", and
\"Email\" are what the student entered into the \"Name,\"
\"SSN,\" and \"Email\" fields on the quiz form, respectively and
may not have been checked for validity.)
$admformtop
$footer";
exit();
} # end if
$quizfile = "$basedir/$quiz/results.data";
undef $newline;
$newline = "$data{'1'}|$data{'2'}|$data{'3'}|$data{'4'}|";
$newline .= "$data{'5'}|$data{'6'}|$data{'7'}";
if($data{'8'}){
$newline .= "|$data{'8'}\n";
}
else {
$newline .= "\n";
}
open(FILE, "+<$quizfile") ||
&debug("Could not open $quizfile for read/write: $!");
if($opsys eq "unix"){ flock(FILE, 2); }
else { binmode(FILE); }
@lines = ;
undef $newfile;
$oldline =~ s/&KPHHASH35;/#/g;
$oldline =~ s/KPHHASH/#/g;
foreach $oldbit (split(/\|/, $oldline)){
$oldline2 .= repipe(unpipe($oldbit)) . "|";
}
$oldline2 =~ s/\|$//;
$oldline = $oldline2;
foreach $line (@lines){
$line =~ s/\s+$//sg;
$line = repipe($line);
$oldline =~ s/\s+$//sg;
if($line ne $oldline){
$newfile .= $line . "\n";
}
else {
$newfile .= "$newline";
}
}
truncate(FILE, length($newfile));
seek(FILE,0,0);
print FILE $newfile;
close(FILE);
$data{'FA2'} = "View";
&view_results;
}
sub perl_escape {
my($stuff) = $_[0];
# Just a quick routine to get rid of things that could hurt
# our program...
$stuff =~ s/\%/%/g;
$stuff =~ s/\|/|/g;
$stuff =~ s/\"/"/g;
$stuff =~ s//>/g;
$stuff =~ s/\$/\\\$/g;
$stuff =~ s/\@/\\\@/g;
$stuff;
}
sub perl_unescape {
my($stuff) = $_[0];
# Just a quick routine to translate the stuff back to what it was before
$stuff =~ s/%/\%/g;
$stuff =~ s/|/\|/g;
$stuff =~ s/"/\"/g;
$stuff =~ s/<//g;
$stuff =~ s/\\\$/\$/g;
$stuff =~ s/\\\@/\@/g;
$stuff;
}
sub unpipe_for_html {
# This should be used on stuff before it gets passed through
# another html form
my($stuff) = $_[0];
# Just a quick routine to get rid of things that could hurt
# our program...
$stuff =~ s/\%/%/g;
$stuff =~ s/\|/|/g;
$stuff =~ s/\"/"/g;
$stuff =~ s//>/g;
$stuff =~ s/#/#/g;
$stuff;
}
sub unpipe {
# This should be used on stuff before it gets written to a file
my($stuff) = $_[0];
# Just a quick routine to get rid of things that could hurt
# our program...
$stuff =~ s/\%/%/sg;
$stuff =~ s/\|/|/sg;
$stuff =~ s/\"/"/sg;
$stuff =~ s//>/sg;
$stuff =~ s/#/KPHHASH/sg;
$stuff =~ s/#/KPHHASH/sg;
$stuff;
}
sub repipe {
my($stuff) = $_[0];
# Just a quick routine to put things back to normal for mail
# or display. That stupid # sign is a real problem. Grr.
$stuff =~ s/KPHHASH/#/g;
$stuff =~ s/%/\%/g;
$stuff =~ s/¦/\|/g;
$stuff =~ s/"/\"/g;
$stuff =~ s/<//g;
$stuff;
}
sub view_results {
$html = &find_quizzes("option");
if($data{'FA2'} ne "View"){
print "$header
If you delete this quiz ($data{'DeleteQuiz'}),
it will remove the quiz, the answers, and all
the student scores and results. You may wish to
\"Get Statistics\" first, so that you may print out the
results of this quiz for your records before deleting it,
or \"View Quiz\" to make sure this is the quiz you wish to
delete. Please confirm
that you wish to delete this quiz:
$admformtop
$footer";
exit();
}
if($data{'FA2'} eq "Confirm"){
# Really delete the quiz.
$quiz = &repipe($data{'DeleteQuiz'});
$quiz =~ tr/[A-Z]/[a-z]/; $quiz =~ s/\W+//g;
$quizdir = "$basedir/$quiz";
# This was going to open up the quiz directory, get a list of all the
# files, and get rid of them all. However, for safety's sake, I decided
# to only remove the files that I (the script) know about, or, in other
# words, the ones I know the script has created. There shouldn't be
# anything else in there, but, heck, you never know. So, this line
# is commented out for now.
# opendir(DIR, $quizdir); @files = readdir(DIR); closedir(DIR);
if(-f "$quizdir/quizdb"){ unlink("$quizdir/quizdb"); }
if(-f "$quizdir/header"){ unlink("$quizdir/header"); }
if(-f "$quizdir/footer"){ unlink("$quizdir/footer"); }
if(-f "$quizdir/config"){ unlink("$quizdir/config"); }
if(-f "$quizdir/timing"){ unlink("$quizdir/timing"); }
if(-f "$quizdir/endmessage"){ unlink("$quizdir/endmessage"); }
if(-f "$quizdir/results.data"){ unlink("$quizdir/results.data"); }
if(-f "$quizdir/results.data-detailed"){ unlink("$quizdir/results.data-detailed"); }
if(-f "$quizdir/answerfile"){ unlink("$quizdir/answerfile"); }
if(-d $quizdir){ rmdir($quizdir) || &debug("Could not remove $quizdir: $!"); }
# Remove from users file
&remove_quiz_from_users("$data{'DeleteQuiz'}");
# Remove from instructor file
open(FILE, "+<$instructors_file") ||
&debug("Could not open $instructors_file (instructors file): $!");
if($opsys eq "unix"){ flock(FILE, 2); }
else { binmode(FILE); }
@lines = ;
undef $newfile;
foreach $line (@lines){
chomp($line);
# split up all the quizzes.
($dinsid,$dinspw,$dinsna,$dinsquizzes) = split(/\|/, $line);
# Go through each quiz and compare it to the one to delete.
# if it matches, then just don't put it back. Otherwise, tack
# it on to the list of stuff to put back in the file.
undef $quizzes;
foreach $dinsq (split(/\%/, $dinsquizzes)){
if($dinsq ne $data{'DeleteQuiz'} && $dinsq ne "" &&
$dinsq ne &unpipe($data{'DeleteQuiz'})){
$quizzes .= "%$dinsq";
}
}
$line = "$dinsid|$dinspw|$dinsna|$quizzes";
$line =~ s/%%/%/g;
$newfile .= "$line\n";
$quizzes = "";
}
truncate(FILE, length($newfile));
seek(FILE,0,0);
print FILE $newfile;
close(FILE);
$data{'FA2'} = "";
$message = "$data{'DeleteQuiz'} Deleted. Delete another quiz:
";
&deletequiz;
exit();
}
# Find all the quizzes for this instructor.
# or, if it's the main instructor, find all
# quizzes.
$html = &find_quizzes("option");
print "$header
$message
Select a quiz to delete:
$admformtop
$footer";
exit();
}
sub find_quizzes {
my($html,$quizzes,$file,@files,$title,$instr,@stuff);
my($opt) = $_[0];
if($auth == 1){
undef $quizzes;
undef $html;
open(F, "<$instructors_file") ||
&debug("Could not open instructors file: $! (This may be okay if you
have not yet set up any quizzes.)");
foreach $line (){
($id,$pw,$name,$quizname) = split(/\|/, $line);
@quizzes = sort({lc($a) cmp lc($b)} split(/%/,$quizname));
if($id ne ""){
foreach $quiz (@quizzes){
$quiz =~ s/\s+$//sg;
if($lastquiz eq $quiz){ next; }
$quizzes .= $quiz . "\n";
$lastquiz = $quiz;
}
}
}
close(F);
if($quizzes eq ""){
$html = "---NO QUIZZES FOUND--\n" if $opt eq "checkbox";
$html = "\n"
if $opt eq "option";
}
else {
foreach $quiz (split(/\n/, $quizzes)){
$quiz =~ s/^\s+//g; $quiz =~ s/\s+$//g;
if($quiz eq ""){ next; }
$title = repipe($quiz);
$title1 = &unpipe($title);
$html .="$title \n"
if $title ne "" && $opt eq "checkbox";
$html .= "\n"
if $title ne "" && $opt eq "option";
} # end foreach
} # end else (if quizzes eq ""
} # end if auth == 1
else {
open(FILE, "<$instructors_file") ||
&debug("could not read instructors file $instructors_file: $!");
$insline = (grep(/^$data{'admlogin'}\|/, ))[0];
close(FILE);
($ins,$pw,$name,$quizzes) = split(/\|/, $insline);
chomp($quizzes);
foreach $quiz (split(/%/,$quizzes)){
$html .= "$quiz \n"
if $quiz ne "" && $opt eq "checkbox";
$html .= "\n"
if $quiz ne "" && $opt eq "option";
}
}
$select_all_quizzes_html = "
(Select all Quizzes)
(Unselect all Quizzes) ";
$html;
}
sub show_student_login {
print "$header
$error
Please Login to take the quiz:
$footer";
exit();
}
sub check_student_auth {
# If there is no authorized users setting, then they are just
# authorized by default.
if($authorized_users eq "no" && $overall_quiz_password eq "no"){
$auth = 1;
return $auth;
}
elsif($data{'student'} eq "" || $data{'studpass'} eq ""){ $auth = 0; }
else {
open(FILE, "<$authorized_users_file") ||
&debug("Could not read authorized_users_file $authorized_users_file: $!");
($student,$studpass,$studname,$studquizzes) =
split(/\|/, (grep(/^$data{'student'}\|/, ))[0]);
close(FILE);
chomp($studpass);
if($student eq &unpipe($data{'student'}) &&
$studpass eq &unpipe($data{'studpass'})){
# Check to see if they can take this particular quiz
chomp($studquizzes);
@s_quizzes = split(/%/, $studquizzes);
# They are authorized for no quizzes.
if($#s_quizzes < 0){
$auth = -1;
}
elsif(-f "$basedir/$quizdir/quizdb"){
open(FILE, "<$basedir/$quizdir/quizdb") ||
&debug("Could not read quizdb file $basedir/$quizdir/quizdb: $!");
$quiztitle = (split(/\|/, ))[0];
close(FILE);
}
foreach $s_quiz (@s_quizzes){
if ($quiz eq $s_quiz || $quiztitle eq $s_quiz){ $auth = 1; last; }
else { $auth = -1; }
}
}
}
if($auth != 1){
# First, check to see if global pw is enabled.
if($overall_quiz_password eq "yes" &&
$data{'overall_quiz_password_text'} eq $overall_quiz_password_text &&
$overall_quiz_password_text ne ""){
$auth = 1;
}
else {
# Check to see if it's an instructor trying out the quiz.
$data{'admlogin'} = &unpipe($data{'admlogin'});
$data{'admpass'} = &unpipe($data{'admpass'});
open(FILE, "<$instructors_file") ||
&debug("Could not read instructors file $instructors_file: $!");
($instructor,$inspass) =
(split(/\|/, (grep(/^$data{'admlogin'}\|/, ))[0]))[0,1];
close(FILE);
chomp($inspass);
if($instructor eq $data{'admlogin'} && $inspass eq $data{'admpass'}
&& $data{'admlogin'} ne "" && $data{'admpass'} ne ""){
$auth = 2;
}
}
}
$auth;
}
sub show_quiz {
$quizname = &unpipe($data{'QuizName'});
if($ENV{'QUERY_STRING'} eq ""){
$quiz = $quizname;
$quizdir = $quiz;
$quizdir =~ s/\W+//g; $quizdir =~ tr/[A-Z]/[a-z]/;
# Try both using kphhash and quot and without it, as though we
# made the quiz just stripping the " and # etc.
unless(-d "$basedir/$quizdir"){
$quizname = $data{'QuizName'};
$quiz = $quizname;
$quizdir = $quiz;
$quizdir =~ s/\W+//g; $quizdir =~ tr/[A-Z]/[a-z]/;
}
}
else {
$quiz = $ENV{'QUERY_STRING'};
$quizdir = $quiz;
$quizdir =~ s/\W+//g; $quizdir =~ tr/[A-Z]/[a-z]/;
unless(-d "$basedir/$quizdir"){
$quizname = $ENV{'QUERY_STRING'};
$quiz = $quizname;
$quizdir = $quiz;
$quizdir =~ s/\W+//g; $quizdir =~ tr/[A-Z]/[a-z]/;
}
}
&get_quiz_config("$basedir/$quizdir/config");
if(-f "$basedir/$quizdir/header"){
undef $/; open(F, "<$basedir/$quizdir/header");
if($opsys ne "unix"){ binmode(F); }
$header = ; close(F);
$/ = "\n";
}
if(-f "$basedir/$quizdir/footer"){
undef $/; open(F, "<$basedir/$quizdir/footer");
if($opsys ne "unix"){ binmode(F); }
$footer = ; close(F);
$/ = "\n";
}
$header = "$header\n";
$formtop = "
$footer";
exit();
}
sub grade_quiz {
# See if they're allowed to take it...
$quiz = $data{'Lessondir'};
$quiz =~ s/\W+//g; $quiz =~ tr/[A-Z]/[a-z]/;
$quiz =~ /^(\w+)$/; $quiz = $1;
$quizdir = $quiz;
$quizdir =~ s/\W+//g; $quizdir =~ tr/[A-Z]/[a-z]/;
$quizdir =~ /^(\w+)$/; $quizdir = $1;
unless(-d "$basedir/$quizdir"){
$quizname = unpipe($data{'Lesson'});
$quiz = $quizname;
$quizdir = $quiz;
$quizdir =~ s/\W+//g; $quizdir =~ tr/[A-Z]/[a-z]/;
}
unless(-d "$basedir/$quizdir"){
$quizname = repipe($data{'Lesson'});
$quiz = $quizname;
$quizdir = $quiz;
$quizdir =~ s/\W+//g; $quizdir =~ tr/[A-Z]/[a-z]/;
}
# Get the header, footer, and endmessage
if(-f "$basedir/$quizdir/header"){
undef $/;
open(HEADER, "<$basedir/$quizdir/header");
if($opsys ne "unix"){ binmode(HEADER); }
$header = ;
close(HEADER);
$/ = "\n";
}
if(-f "$basedir/$quizdir/footer"){
undef $/;
open(FOOTER, "<$basedir/$quizdir/footer");
if($opsys ne "unix"){ binmode(FOOTER); }
$footer =
\n";
$i = 0;
foreach $ans (@ans){
$q = "q-$i";
# This was really silly. I'm sure I must have had a reason for doing
# this, but I'll bet I did this at about 2am under coffee deprivation.
# It seems to just muck things up, so we'll leave it out for now.
# undef ${$q};
${$q} .= "$ans|";
my $pans = unpipe_for_html(repipe($ans));
if($pans eq "" || $pans =~ /^\s+$/){
$pans = "(Did not answer)";
}
$html .= "
$pans
\n";
$i++;
}
$html .= "
\n";
}
# Now $q-0 has all the answers for the first question,
# $q-1 has them for the second, etc. So...let's grab 'em.
print "
$footer";
exit();
}
print "$header
$admformtop
Select a quiz to analyze:
$footer";
exit();
}
sub get_students_as_options {
my($students) = "";
$num_students = 0;
if(-f "$authorized_users_file"){
open(AU, "<$authorized_users_file") ||
&debug("could not read authorized users file: $!");
if($opsys ne "unix"){ binmode(AU); }
while(){
($studentid,$pw,$name,$squizzes) = split(/\|/, $_);
if($studentid eq $laststudentid){ next; }
$students .= "\n"
if $studentid ne "";
$laststudentid = $studentid;
$num_students++ if $studentid ne "";
}
close(AU);
}
else {
$students .= "\n";
}
$students;
}
sub get_students_as_checkboxes {
my($editq) = $_[0];
my($students) = "";
$num_students = 0;
if(-f "$authorized_users_file"){
open(AU, "<$authorized_users_file") ||
&debug("could not read authorized users file: $!");
if($opsys ne "unix"){ binmode(AU); }
while(){
($studentid,$pw,$name,$squizzes) = split(/\|/, $_);
if($studentid eq $laststudentid){ next; }
if($editq ne "" && $squizzes =~ /\Q$editq\E/){
$ck = " CHECKED";
}
else{
$ck = "";
}
$students .= "
$name ($studentid) \n" if $studentid ne "";
$num_students++ if $studentid ne "";
$laststudentid = $studentid;
}
close(AU);
}
else {
$students .= "ERROR: No students found.\n";
}
$select_all_students_html = "
(Select all $num_students students)
(Unselect all $num_students students) ";
$students;
}
sub get_instructors_as_options {
my($instructors) = "";
if(-f "$instructors_file"){
open(AU, "<$instructors_file") ||
&debug("2801: Could not read instructors file: $!");
if($opsys ne "unix"){ binmode(AU); }
while(){
chomp($_);
($instructor,$pw,$name,$quizzes) = split(/\|/, $_);
$instructors .= "\n" unless $instructor eq "";
}
close(AU);
}
if($instructors eq ""){
$instructors .= "\n";
}
$instructors;
}
sub delete_student {
$students = &get_students_as_options;
if($data{'FA2'} eq "Delete"){
# Print the delete confirm form for that student...
if($data{'ID'} eq "" || $data{'ID'} =~ /ERROR: No Students Found/){
print "$header Error: no students found. $footer";
exit();
}
print "$header
WARNING! You are about to delete student \"$data{'ID'}\".
This is the final confirmation. Are you sure you want to
delete this student?
$admformtop
$footer";
}
elsif($data{'FA2'} eq "Really Delete"){
# Do the delete
open(AU, "+<$authorized_users_file") ||
&debug("Could not open $authorized_users_file (authorized users file): $!");
if($opsys eq "unix"){ flock(AU, 2); }
else { binmode(AU); }
@lines = ;
$newfile = "";
foreach $line (@lines){
if($line !~ /^$data{'ID'}\|/){
$newfile .= $line;
}
# If it's this student but not the instructor who added him/her, and
# if it's not admin, refuse to delete it.
elsif($line =~ /^$data{'ID'}\|/ && $line !~ /$data{'admlogin'}$/ &&
$data{'admlogin'} ne $overall_admin){
$newfile .= $line;
$delmsg = "Sorry, only the instructor who added this student or the
overall administrator $overall_admin may delete a student.
If you added
this student, and are getting this message, it probably
means you added the student before this safety check was
written into this software. Please ask the administrator
to delete the student for you.";
}
}
truncate(AU, length($newfile));
seek(AU,0,0);
print AU $newfile;
close(AU);
# Get rid of file if no more students.
if(length($newfile) == 0){ unlink($authorized_users_file); }
$data{'FA2'} = "";
if($delmsg){$message = "$delmsg
";}
elsif($!){ $message = "Possible error: The system said $!. Student may
not have been deleted.
Quiz(zes) for this Student$select_all_quizzes_html
$error
Student Name:
Student ID/Email:
Student Password:
Student Password again:
$html
$footer";
}
elsif($data{'FA2'} eq "Really Edit"){
# Do the edit
if(($data{'SPassword'} ne $data{'SPassword2'}) ||
$data{'SPassword'} eq "" || $data{'SPassword2'} eq ""){
$error = "Error: Passwords do not match or are blank.";
$data{'FA2'} = "Edit";
&edit_student;
}
$data{'ID'} = &unpipe(&fixmac($data{'ID'}));
$data{'Name'} = &unpipe(&fixmac($data{'Name'}));
$data{'SPassword'} = &unpipe(&fixmac($data{'SPassword'}));
# First, get quizzes associated with this instructor, so we don't
# take them away from a previous instructor. Only the instructor who
# "owns" the quiz can add it or take it away. Otherwise, everything
# in the student's list should stay exactly the same. Unless of
# course, this is admin. In which case, we do whatever they want. :-)
open(INS, "<$instructors_file") ||
&debug("3981: Could not read instructors file: $!");
if($opsys ne "unix"){binmode(INS);}
@otherins = ;
close(INS);
# Now, we saved the student's old login (in case the instructor
# modified it) in OldID. So let's get the quizzes from that as well
# so that we have a list of all quizzes the student was allowed to
# take.
open(AU, "<$authorized_users_file") ||
&debug("Could not read authorized users file: $!");
if($opsys ne "unix"){binmode(AU);}
($oid,$opw,$oname,$oquizzes,$o_sins) =
split(/\|/, (grep(/^$data{'OldID'}\|/, ))[0]);
chomp($o_sins);
if($o_sins eq ""){$o_sins = $overall_admin; }
close(AU);
$oquizzes =~ s/%%/%/g;
@oquizzes = split(/\%/, $oquizzes);
if($data{'FA3'} eq "Reset Quiz Times"){
foreach $oquiz (@oquizzes){
my($resetquiz) = $oquiz;
$resetquiz =~ s/\W+//sg;
$resetquiz =~ tr/[A-Z]/[a-z]/;
if(-f "$basedir/$resetquiz/timing"){
open(TIM, "+<$basedir/$resetquiz/timing") ||
&debug("Could not open timing file
($basedir/$resetquiz/timing) to
reset timing results for student: $!");
@timlines = ;
undef $timfile;
foreach $timline (@timlines) {
$timline =~ s/\s+$//sg;
if($timline !~ /^$oid\|\d+$/ &&
$timline !~ /^$oid\|\d+\|$/){
$timfile .= "$timline\n";
}
}
truncate(TIM, length($timfile));
seek(TIM, 0, 0);
print TIM $timfile;
close(TIM);
}
}
}
# Go through each instructor line unless this is our admin person...
if($data{'admlogin'} ne $quizresultsemail){
foreach $ins (@otherins){
chomp($ins);
($oin,$oiqs) = (split(/\|/, $ins))[0,3];
# If this is a different instructor, than the one who is
# currently doing the edit...
if($oin ne $data{'admlogin'}){
# We need to check and see if other instructors had authorized
# this student to take their quiz(zes) so we need to
# go through each of the student's previous quizzes. If one of
# them belongs to a different instructor, pre-add it to their
# list of quizzes so they don't get removed from the file.
foreach $oq (@oquizzes){
chomp($oq);
if($oq ne "" &&
($oiqs =~ /\b$oq\b/)){
$quizzes .= "%$oq";
}
}
}
}
}
# Now we'll add the old quizzes and the new ones to the
# authorized users file.
open(AU, "+<$authorized_users_file") ||
&debug("Could not open $authorized_users_file (authorized users): $!");
if($opsys eq "unix"){ flock(AU, 2); }
else { binmode(AU); }
@lines = ;
undef $newfile;
foreach $line (@lines){
if($line =~ /^$data{'OldID'}\|/){
@s_quizzes = split(/\0/, $data{'QuizName'});
foreach $s (@s_quizzes){ $quizzes .= "%$s"; }
$quizzes =~ s/%$//;
$quizzes =~ s/%%/%/g;
# Just to make sure we didn't duplicate a quiz. This needs
# to be rewritten and done better eventually.
@quizzes = sort(split(/%/, $quizzes));
$quizzes = "";
foreach $sortquiz (@quizzes){
chomp($sortquiz);
if($sortquiz ne $lastquiz && $sortquiz ne ""){
$quizzes .= "$sortquiz%";
}
$lastquiz = $sortquiz;
}
$quizzes =~ s/%$//;
# The instructor that does not own this student can add/subtract quizzes
# but cannot change the username or password.
if($data{admlogin} ne $o_sins && $data{admlogin} ne $overall_admin){
$newfile .= "$oid|$opw|$oname|$quizzes|$o_sins\n";
$edmsg = "NOTE:
Student ID, password, and name can only be changed by
the instructor who added the student, or by the overall
admin, $overall_admin . If you are getting this message
and you did add this student, it's probably because you
added the student before the software added this safety
feature. Please ask the administrator to associate you
with this student as his/her instructor, or to make the
changes for you.";
}
else {
$newfile .= "$data{'ID'}|$data{'SPassword'}|$data{'Name'}|$quizzes|$o_sins\n";
}
}
else {
$newfile .= $line;
}
}
truncate(AU, length($newfile));
seek(AU,0,0);
print AU $newfile;
close(AU);
$data{'FA2'} = "";
if($edmsg){ $message = "$edmsg
";
$data{'FA2'} = ""; $data{'ID'} = ""; $data{'Password'} = "";
$data{'Password2'} = "";$data{'Name'} = "";
&add_instructor;
exit();
}
sub delete_instructor {
if($data{'Name'} eq ""){
open(INS, "<$instructors_file") ||
&debug("4168: Could not read instructors file $instructors_file: $!");
if($opsys ne "unix"){
binmode(INS);
}
$name = (split(/\|/,(grep(/^$data{'ID'}\|/, ))[0]))[2];
close(INS);
$data{'Name'} = $name;
}
$instructors = &get_instructors_as_options;
if($data{'FA2'} eq "Delete"){
# Print the delete confirm form for that student...
if($data{'ID'} eq "ERROR: No Instructors Found"){
print "$header
Error: No instructors found
$footer";
exit();
}
print "$header
WARNING! You are about to delete instructors $data{'Name'}
(\"$data{'ID'}\").
This is the final confirmation. Are you sure you want to
delete this instructor?
$admformtop
$footer";
}
elsif($data{'FA2'} eq "Really Delete"){
# Do the delete
open(AU, "+<$instructors_file") ||
&debug("Could not open instructors file $instructors_file: $!");
if($opsys eq "unix"){ flock(AU, 2); }
else { binmode(AU); }
@lines = ;
undef $newfile;
# Once through to get the old quizzes for this
# instructor so we can add them to the overall admin...
foreach $line (@lines){
if($line =~ /^$data{'ID'}\|/){
($oldun,$oldpw,$oldname,$oldquizzes) =
split(/\|/, $line);
last;
}
}
# Now, go through and add those quizzes to admin,
# and remove the instructor.
foreach $line (@lines){
if($line =~ /^$overall_admin\|/){
chomp($line);
chomp($oldquizzes);
if($line =~ /%$/ && $oldquizzes =~ /^%/){
$oldquizzes =~ s/^%//;
}
$newfile .= "$line$oldquizzes\n";
}
elsif($line !~ /^$data{'ID'}\|/){
$newfile .= $line;
}
}
truncate(AU, length($newfile));
seek(AU,0,0);
print AU $newfile;
close(AU);
# Be tidy and get rid of the file if there are no more instructors.
if(length($newfile) == 0){ unlink($instructors_file); }
$data{'FA2'} = "";
$message = "Instructor $data{'Name'} (\"$data{'ID'}\") successfully
deleted. Delete another instructor:
";
&delete_instructor;
exit();
}
else {
print "$header
$message
$admformtop
$footer";
}
exit();
}
sub edit_instructor {
$instructors = &get_instructors_as_options;
if($data{'FA2'} eq "Edit"){
# Print the edit form for that instructor...
if($data{'ID'} eq "ERROR: No Instructors Found"){
print "$header
Error: No instructors found
$footer";
exit();
}
if($data{'OldID'} ne ""){ $oldid = $data{'OldID'}; }
else { $oldid = $data{'ID'}; }
open(INS, "<$instructors_file") ||
&debug("could not read instructors file $instructors_file: $!");
if($opsys ne "unix"){
binmode(INS);
}
if($data{'Name'} eq ""){
($id,$pw,$name,$quizzes) = split(/\|/,(grep(/^$oldid\|/, ))[0]);
$data{'Name'} = &repipe($name);
}
else {
($id,$pw,$name,$quizzes) = split(/\|/,(grep(/^$oldid\|/, ))[0]);
}
close(INS);
if($data{'Password'} eq ""){$data{'Password'} = &repipe($pw);}
if($data{'Password2'} eq ""){$data{'Password2'} = &repipe($pw);}
$select_all_students_html = "
(Select all $num_students students)
(Unselect all $num_students students) ";
print "$header
$message
NOTES:
To assign a student to this instructor, check the box to the left
of the
student ID.
Students with an [X] are already assigned to this
instructor.
Students with a * to the right of the student ID are assigned
to another instructor. Checking their box will reassign the student
away from their current instructor!
$error
$admformtop
Instructor Information
Student List$select_all_students_html
Instructor Name:
Instructor ID/Email:
Instructor Password:
Instructor Password again:
";
# Get the list of all students
open(F, "<$authorized_users_file") ||
&debug("Could not open authorized_users_file to find students! $!");
while(){
($oid,$oins) = (split(/\|/, $_))[0,4];
# If this instructor already has this student, ignore.
chomp($oins);
if($oins ne $oldid){
if($oins ne $overall_admin){ $star = "*"; }
print " $oid$star ";
}
else {
print "[X]$oid ";
}
} # end of while()
close(F);
print "
$footer";
exit();
}
elsif($data{'FA2'} eq "Really Edit"){
# Do the edit
if(($data{'Password'} ne $data{'Password2'}) ||
$data{'Password'} eq "" || $data{'Password2'} eq ""){
$error = "Error: Passwords do not match or are blank.";
$data{'FA2'} = "Edit";
&edit_instructor;
}
$data{'ID'} = &unpipe(&fixmac($data{'ID'}));
$data{'Name'} = &unpipe(&fixmac($data{'Name'}));
$data{'Password'} = &unpipe(&fixmac($data{'Password'}));
open(AU, "+<$instructors_file") ||
&debug("Could not read/write to instructors file ($instructors_file): $!");
if($opsys eq "unix"){ flock(AU, 2); }
else { binmode(AU); }
@lines = ;
undef $newfile;
foreach $line (@lines){
$quizzes = "";
if($line =~ /^$data{'OldID'}\|/){
$line =~ s/\s+$//sg; $line =~ s/^\s+//sg;
# oldid, oldpw, oldname, quizzes
($oldid,$quizzes) = (split(/\|/, $line))[0,3];
$quizzes =~ s/%%/%/g; @quizzes = sort(split(/%/, $quizzes));
foreach $oldquiz (@quizzes){
if($lastquiz ne $oldquiz){
if($oldquiz ne ""){
$quizzes .= "%$oldquiz";
}
}
$lastquiz = $oldquiz;
}
$newfile .= "$data{'ID'}|$data{'Password'}|$data{'Name'}|$quizzes\n";
}
else {
$newfile .= $line;
}
}
truncate(AU, length($newfile));
seek(AU,0,0);
print AU $newfile;
close(AU);
if($data{'AssignStudent'} =~ /\0/){
@a_stu = split(/\0/, $data{'AssignStudent'});
}
else {
@a_stu = ($data{'AssignStudent'});
}
# Assign the students to this instructor
$assignmsg = &assign_students_to_instructor($data{'ID'},@a_stu);
# 1 is success so we don't need to show it. Anything else is an
# error.
if($assignmsg == 1){ $assignmsg = ""; }
$message = "Instructor $data{'Name'} ($data{'ID'}) updated. $assignmsg
Edit another instructor:
";
$data{'FA2'} = ""; $data{'ID'} = ""; $data{'Password'} = "";
$data{'Password2'} = "";$data{'Name'} = "";
&edit_instructor;
exit();
}
else {
print "$header
$message
$admformtop
$footer";
}
exit();
}
sub reset_quiz {
if($data{'FA2'} eq "Reset"){
if($data{'QuizName'} =~ /NO QUIZZES FOUND/ || $data{'QuizName'} eq ""){
print "$header Error: No quizzes found. $footer";
exit();
}
# Confirm
print "$header
$admformtop
Please confirm that you wish to delete the results
databases for this quiz ($data{'QuizName'}) and start over.
This will also remove this quiz from any students who are
currently allowed to take it.
You may wish to run \"Get Statistics\",
and print that page first, so that you may have a record
of this quiz's results.
$footer";
exit();
}
elsif($data{'FA2'} eq "Really Reset"){
# Truncate results.data and results.data-detailed
$quizdir = $data{'QuizName'};
$quizdir =~ s/\W+//g; $quizdir =~ tr/[A-Z]/[a-z]/;
if(-d "$basedir/$quizdir"){
open(RD, ">$basedir/$quizdir/results.data") ||
&debug("Could not reset results file $basedir/$quizdir/results.data: $!");
print RD "";
close(RD);
open(RD, ">$basedir/$quizdir/results.data-detailed") ||
&debug("Could not reset detailed
results file $basedir/$quizdir/results.data-detailed: $!");
print RD "";
close(RD);
open(RD, ">$basedir/$quizdir/timing") ||
&debug("Could not reset timing
results file $basedir/$quizdir/timing: $!");
print RD "";
close(RD);
}
&remove_quiz_from_users("$data{'QuizName'}");
print "$header
Results Reset for quiz $data{'QuizName'}
$footer";
exit();
}
else {
# Get quizzes.
$html = &find_quizzes("option");
print "$header
Please choose a quiz to reset. This will remove all the
results for this quiz, so that you can start over with a new
class or group of students.
$admformtop
$footer";
exit();
}
}
sub remove_quiz_from_users {
my ($line,@lines,$sid,$spw,$sname,$quizzes,$squiz,$squizzes,@quizzes,$newfile);
my ($quiz_to_find) = &unpipe($_[0]);
open(AU, "+<$authorized_users_file") ||
&debug("Could not open authorized users file ($authorized_users_file): $!");
if($opsys eq "unix"){ flock(AU, 2); }
else { binmode(AU); }
@lines = ;
undef $newfile;
foreach $line (@lines){
chomp($line);
if($line =~ /\Q$quiz_to_find\E/){
($sid,$spw,$sname,$quizzes,$sins) = split(/\|/, $line);
if($sins eq ""){$sins = $overall_admin; }
@quizzes = split(/%/, $quizzes);
undef $squizzes;
foreach $squiz (@quizzes){
if($squiz ne $quiz_to_find){
$squizzes .= "$squiz%";
}
}
$squizzes =~ s/%$//;
$squizzes =~ s/%%/%/g;
@squizzes = sort(split(/%/, $squizzes));
$squizzes = "";
foreach $squiz (@squizzes){
if($lastquiz ne $squiz){
$squizzes .= "%$squiz";
}
$lastquiz = $squiz;
}
$newfile .= "$sid|$spw|$sname|$squizzes|$sins\n";
}
else {
$newfile .= "$line\n";
}
}
truncate(AU, length($newfile));
seek(AU,0,0);
print AU $newfile;
close(AU);
}
sub view_quiz {
if($data{'QuizName'} eq ""){
$html = &find_quizzes("option");
print "$header
$admformtop
Please choose a quiz to view:
$footer";
exit();
}
$data{'FA2'} = "Show";
&show_quiz;
}
sub validate_quiz {
my $i;
# kph
for($i = 0; $i <= $#afl; $i++){
#@afl
# We make them allow incomplete quizzes if $time_quiz is on.
if($data{$i + 1} eq "" && ($auto_submit_timed_quiz eq "no" || $time_quiz eq "no")){
$error = "Error! Incomplete Quiz!
Number of scores to show (if the above is \"Yes\"):
Show the Grading Scale:
In the textarea, you may modify the grading scale:
Text for the \"Grade Quiz\" button on the quiz:
Short-Answer Question Scoring
options
Ignore case? NOTE: If you enable this, then \"No,\" \"no,\" and \"NO\" will all be counted as the same thing.
Ignore punctuation? NOTE: Don't enable this for math
quizzes, since 1/4 and 14 will both be viewed as correct.
Ignore spaces? NOTE: This will allow students to enter
extra spaces but will also count \"Internet\" and \"Inter net\" or
\"allright\" and \"all right\" as
the same answer.
Ignore non-word characters? NOTE: This will ignore both punctuation and spaces.
Use multiple answers? NOTE: This will allow you to enter
multiple possible correct answers, and the students will be marked
correct if they enter any of them.
Accept partially correct answer? NOTE: For example, if the correct answer is \"there are four people\" and the student types \"four\" or \"four people\" or \"there are four\" (or even \"there\" or \"there are\"), that will be counted as correct.
Mark ALL short answers as correct? NOTE: this will
simply count all short answers as correct.
";
$quizoptform;
}
sub mail_student_results {
my $message = &repipe($data{'mailres'});
$message =~ s/\D+//g;
my $msg = "";
if(-f "$basedir/mresults.$message"){
(open(MSG, "<$basedir/mresults.$message")) ||
&debug("could not open results file: $!");
while(){
if($html_mail eq "yes"){
$_ =~ s/\r\n/ /g;
$_ =~ s/\r/ /g;
$_ =~ s/\n/ /g;
}
$msg .= $_;
}
close(MSG);
unlink("$basedir/mresults.$message");
}
my $toemail = $data{'StudEmail'};
my $fromemail = $data{'InsEmail'};
my $subject = "Results of Quiz";
$message = &repipe($msg);
$toemail =~ s/[^A-Za-z0-9\.\@\-_]//g;
$fromemail =~ s/[^A-Za-z0-9\.\@\-_]//g;
if($msg eq ""){
$error = " Sorry, your results could not be found for
mailing. Please contact your instructor
for the results of this quiz.
";
}
elsif(&bad_email($toemail) != 1){
&send_mail($toemail,$toemail,$fromemail,$fromemail,
$replytoemail,$replytoname,$subject,
$message,$mail_server_hostname,
$this_server_hostname,$opsys,$html_mail,$smtp_auth,
$pop_un,$pop_pw);
$error = " Your results have been emailed to $toemail.
";
}
else {
$error = " Sorry, the email address you entered does not
appear to be correct. Please contact your instructor
for the results, hit the \"Back\" button on your
browser and correct the address, or Try this
link if you have JavaScript enabled.
$data{'OldTitle'} has been copied to $data{'NewTitle'} along
with all the student results data, but without a list
of authorized students. If you are using the authorized students
feature, you (or the new instructor), must login to the \"Edit
Quiz\" screen and select the students to authorize.
$footer";
exit();
}
else {
# Need new title
# Copy for which instructor
$h_oldtitle = unpipe_for_html($data{'OldTitle'});
print "$header
Copying Quiz
$error
$admformtop
Title for New Quiz
Assign copy to Instructor:
$footer";
exit();
}
}
sub start_time {
# &start_time($data{'student'},$quizdir);
my($stu,$quiz) = @_;
if($time_quiz eq "yes"){
if($time_limit eq "" || $time_limit <= 0){$time_limit = 1;}
$force_complete_quiz = "no";
if($auto_submit_timed_quiz eq "yes"){
$scode = "if(sec <= 0 && min <= 0){
document.QuizTest.submit();
}\n";
}
else {
$scode = "
if(sec <= 0 && min <= 0){
if(stoptime !=1){
alert(\"Your time is up!\");
stoptime = 1;
stuff = setTimeout(\"CountDown();\", 0);
}
else {
stuff = setTimeout(\"CountDown();\", 0);
}
}\n";
}
$timesofar = $data{'TimeTaken'};
$timetakenfield = "\n";
# Get the time limit for the Javascript countdown...
if($time_limit =~ /\./){
($min,$sec) = split(/\./, $time_limit);
}
else {
$min = $time_limit;
$sec = 0;
}
# Only if we are using authorized students.
if($authorized_users eq "yes"){
unless(-f "$basedir/$quiz/timing") {
open(FILE, ">>$basedir/$quiz/timing");
print FILE "";
close(FILE);
}
# First, see if this student has already started the quiz,
# such as, if they're trying to reload the page. We don't want
# to update the time unless they have had the quiz graded.
open(FILE, "+<$basedir/$quiz/timing") ||
&debug("Could not read quiz timing file '$basedir/$quiz/timing': $!");
if($opsys eq "unix"){ flock(FILE, 2); }
else { binmode(FILE); }
@started = ;
# A completed time record is student|start|stop. If there is
# only student|start, do not update. If there is no student,
# add the start time.
undef $newrecs;
foreach $rec (@started){
if($rec =~ /^$stu\|\d+$/){
($r_stu,$r_start) = split(/\|/, $rec);
chomp($r_start);
$min = int((($time_limit * 60) - (time - $r_start)) / 60);
if($min < 0){ $min = 0; }
$sec = (($time_limit * 60) - (time - $r_start)) % 60;
if($sec < 0){ $sec = 0; }
$newrecs .= $rec;
$nostart = 1;
}
else {
$newrecs .= $rec;
}
}
if($nostart != 1){
$newrecs .= "$stu|" . time . "\n";
}
truncate(FILE, length($newrecs));
seek(FILE, 0, 0);
print FILE $newrecs;
close(FILE);
} # end if authorized users
$min = sprintf("%0.2d", $min);
$sec = sprintf("%0.2d", $sec);
$header =~ s/";
}
$javascript = "
\n\n";
$header = "$header$javascript";
$timeoutfield = "
Time Remaining:
$timetakenfield";
}
# $time_allowed = time + ($time_limit * 60);
}
sub end_time {
# &start_time($data{'student'},$quizdir);
my($stu,$quiz) = @_;
if($time_quiz eq "yes"){
# First, see if this student has already started the quiz,
# such as, if they're trying to reload the page. We don't want
# to update the time unless they have had the quiz graded.
if($authorized_users eq "yes"){
open(FILE, "+<$basedir/$quiz/timing") ||
&debug("Could not read quiz timing file: $!");
if($opsys eq "unix"){ flock(FILE, 2); }
else { binmode(FILE); }
@started = ;
# A completed time record is student|start|stop. If there is
# only student|start, update.
undef $newrecs;
foreach $rec (@started){
if($rec =~ /^$stu\|\d+$/){
chomp($rec);
($r_stu,$r_start) = split(/\|/, $rec);
$e_time = time;
$totaltime = sprintf("%.2f", ($e_time - $r_start) / 60);
$newrecs .= "$rec|$e_time\n";
$nostart = 1;
}
else {
$newrecs .= $rec;
}
}
truncate(FILE, length($newrecs));
seek(FILE, 0, 0);
print FILE $newrecs;
close(FILE);
$totaltime;
}
}
# $time_allowed = time + ($time_limit * 60);
}
sub show_high_scores_only {
my($quiz,$path_to_results_dat,$sc,$fn,$sn,$em,$ln,$da,$quiz_friendly_name);
my($qconfig);
$quiz = $data{'Quiz'};
$quiz =~ s/\W+//g;
$quiz = lc($quiz);
$path_to_results_dat = "$basedir/$quiz/results.data";
$quiz_friendly_name = $data{'QuizFname'};
$qconfig = "$basedir/$quiz/config";
# Get the config to see if the instructor wants the scores shown:
open(QC, "<$qconfig") ||
&debug("Could not open quiz config $qconfig to show scores $!");
while(){
if($_ =~ /show_other_scores/ &&
$_ !~ /show_other_scores = Yes/){
print "$header
Sorry, Not Authorized
The instructor of this quiz has set it to not show
the high scores list.
$footer";
close(QC);
exit();
}
}
close(QC);
# Show high scorers if we want to:
open(FILE, "<$path_to_results_dat");
print "$header
$footer\n";
exit();
}
# Okay. Let's do this like "add_quiz_to_students." We'll take
# instructor_id,@students as arguments like this:
# &assign_students_to_instructor($instructor,@students);
sub assign_students_to_instructor {
my($nins,@students) = @_;
my($newfile,$oid,$opw,$oname,$quizzes,$oins,$student,$n_student);
my(@all_students);
# First, get the student file
open(F, "+<$authorized_users_file") ||
&debug("Could not open authorized users file to assign students to $instructor.
The server returned: $!");
if($!){ return "Error: Could not open students file to assign instructor."; }
if($opsys eq "unix"){ flock(F, 2); }
else { binmode(F); }
@all_students = ;
undef $newfile;
foreach $student (@all_students){
chomp($student);
($oid,$opw,$oname,$quizzes,$oins) = split(/\|/, $student);
foreach $n_student (@students){
# Reassign the instructor to the new one.
if(&unpipe($oid) eq $n_student){ $oins = $nins; }
}
$newfile .= "$oid|$opw|$oname|$quizzes|$oins\n";
}
truncate(F, length($newfile));
seek(F, 0, 0);
print F $newfile;
close(F);
return 1;
}
sub clear_all {
undef %data;
undef $qscomp;
undef $header;
undef $formtop;
undef $d_quiz_time;
undef $m_quiz_time;
undef $detailedresults;
undef $showres;
undef $mailres;
undef $instrres;
undef $time_results;
undef $message;
undef $scorefreqtable;
undef $html;
undef $lastquiz;
undef $quiz;
undef $html2;
undef $pdist;
undef $quizzes;
undef $rdebug;
undef $admlogin;
undef $admpass;
undef $error;
undef @variables;
undef $auth_from_address;
undef $pop_un;
undef $pop_pw;
}
sub no_basedir_error {
unless(-w $basedir){
print "$header FATAL ERROR! Your directory \$basedir ($basedir)
is not writeable, or does not exist, or your web server doesn't
recognize what you have put in there as being something it can
find! This means that QuizTest cannot create quizzes,
add instructors, etc.
If you're sure the path is correct, you might want to try
chmod 777 $basedir or, if you have another way of
setting permissions, make sure that read, write, and execute
permissions are set for everyone.
If you're not completely certain that the path is correct, you
should probably ask your web hosting provider \"What is the
full system path to files on my website,\" and the answer they
give you should give you a place to start.
The FAQ has
information about \"chmod\" and permissions. If you're not
sure what that means, check it out and read up on it a bit.
The following information might be helpful in troubleshooting
this:
";
print "Web Server software is $ENV{'SERVER_SOFTWARE'} \n"
if $ENV{'SERVER_SOFTWARE'};
print "Base path to website files is $ENV{'DOCUMENT_ROOT'} \n"
if $ENV{'DOCUMENT_ROOT'};
print "Base path translated is $ENV{'PATH_TRANSLATED'} \n"
if $ENV{'PATH_TRANSLATED'};
print "Script filename is $ENV{'SCRIPT_FILENAME'} \n"
if $ENV{'SCRIPT_FILENAME'};
print "Server O/S is $^O \n" if $^O;
print "
$footer";
exit();
}
}
sub isme {
if($ENV{'REMOTE_ADDR'} eq "207.228.46.235"){
return 1;
}
}
#&send_mail("to_email","to_name","from_email","from_name","replyto_email",
# "replyto_name","subject","message","mail_server_hostname",
# "this_server_hostname",$opsys,$htmlmail,$smtp_auth,
# $pop_un,$pop_pw);
sub send_mail {
local($toemail,$toname,$fromemail,$fromname,
$replytoemail,$replytoname,$subject,
$message,$mail_server_hostname,$this_server_hostname,$opsys,
$htmlmail,$smtp_auth,$pop_un,$pop_pw) = @_;
my @headervars = ('toemail','toname','fromemail','fromname',
'replytoemail','replytoname','subject');
$CRLF = "\015\012"; # Make sure we have the correct line endings
# Basically, we're taking out any newlines or extraneous spaces
# plus any ", <>, commas, or single quotes as well before we
# attempt to send.
my ($hvar);
foreach $hvar (@headervars){
${$hvar} =~ s/\s+/ /sg;
${$hvar} =~ s/[\"<>,']//sg;
}
# Also, the message needs to have CRLF on the end of each line or
# qmail will be unhappy.
$message =~ s/\r\n/\n/sg;
$message =~ s/\r/\n/sg;
$message =~ s/\n/$CRLF/sg;
&debug("Attempting to send message \"$subject\" to $toemail");
my($boundary) = crypt("blah",time.$$).time.$$;
# I don't want my demo to mail.
if(($ENV{'SERVER_NAME'} =~ /linguistic-funland.com$/i ||
$ENV{'SERVER_NAME'} =~ /tesol.net$/i)){
print "Email has been disabled in this demo. "; return;
}
if($opsys eq "win"){
my($port,$child,$proto);
# Switch to $auth_from_address if there is one.
if(($smtp_auth eq "POP" || $smtp_auth eq "SMTP") &&
$auth_from_address){
$fromemail = $auth_from_address;
}
# Do pop-before-smtp auth if necessary.
if($smtp_auth eq "POP"){
&do_pop_auth($this_server_hostname,$mail_server_hostname,$pop_un,$pop_pw);
}
my $port = 25;
use Socket;
$SIG{'INT'} = 'dokill';
sub dokill {
kill 9,$child if $child;
}
my $proto = 6; # tcp
$this = pack_sockaddr_in(0, inet_aton($this_server_hostname));
$that = pack_sockaddr_in($port, inet_aton($mail_server_hostname));
if (socket(S, AF_INET, SOCK_STREAM, $proto)) {
&debug("Created socket.");
}
else { &debug("Could not create socket for mail: $!"); }
if (connect(S,$that)) {
&debug("Connected to socket.");
}
else { &debug("Could not connect to socket: $!"); }
# Unbuffer the output for socket and stdout
select(S); $| = 1; select(STDOUT); $| = 1;
&debug("Server responded: " . read_response()) if $no_more !=1;
# SMTP auth is done in the same socket connection, so let's do it now.
if($smtp_auth eq "SMTP"){
&do_smtp_auth($pop_un,$pop_pw);
}
# We don't need HELO with SMTP auth because we already did EHLO
else {
&debug("I sent: HELO $this_server_hostname\\r\\n") if $no_more !=1;
print S "HELO $this_server_hostname$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
}
&debug("I sent: MAIL FROM:<$fromemail>\\r\\n") if $no_more !=1;
print S "MAIL FROM:<$fromemail>$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
&debug("I sent: RCPT TO:<$toemail>\\r\\n") if $no_more !=1;
print S "RCPT TO:<$toemail>$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
&debug("I sent: DATA\\r\\n") if $no_more !=1;
print S "DATA$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
&debug("I sent: To: $toname <$toemail>\\r\\n") if $no_more !=1;
print S "To: $toname <$toemail>$CRLF";
&debug("I sent: From: $fromname <$fromemail>\\r\\n") if $no_more !=1;
print S "From: $fromname <$fromemail>$CRLF";
if($replytoemail ne ""){
&debug("I sent: Reply-to: $replytoname <$replytoemail>\\r\\n") if $no_more !=1;
print S "Reply-to: $replytoname <$replytoemail>$CRLF";
}
if(!$x_auth_header){ $x_auth_header = "X-Auth-Type: None"; }
print S "$x_auth_header$CRLF";
print S "X-Mailer: $0 http://tesol.net/scripts/$CRLF";
&debug("I sent: Subject: $subject\\r\\n") if $no_more !=1;
print S "Subject: $subject$CRLF";
if($htmlmail eq "yes"){
&debug("Putting in HTML message\\r\\n") if $no_more !=1;
print S "MIME-Version: 1.0$CRLF";
print S "Content-type: MULTIPART/MIXED; BOUNDARY=\"$boundary\"$CRLF";
print S "--$boundary$CRLF";
print S "Content-type: text/html;$CRLF$CRLF";
print S "$message$CRLF";
print S "$CRLF$CRLF";
print S "--$boundary$CRLF";
print S "Content-type: TEXT/PLAIN; charset=US-ASCII$CRLF$CRLF";
print S "$message--$boundary--$CRLF";
}
else {
&debug("Putting in plain text message\\r\\n") if $no_more !=1;
print S "$CRLF";
print S "$message$CRLF";
}
&debug("I sent: .\\r\\n") if $no_more !=1;
print S ".$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
&debug("I sent: QUIT\\r\\n") if $no_more !=1;
print S "QUIT$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
&debug("Sending mail done.") if $no_more !=1;
}
elsif($opsys eq "unix"){
# Allow for qmail-inject ~sigh~
# Most other mailer thingies do use the -t option like
# sendmail in order to be compatible, but apparently
# qmail-inject does not. Oh well...
if($path_to_sendmail !~ /qmail-inject/){
$path_to_sendmail = "$path_to_sendmail -t";
}
open(MAIL, "|$path_to_sendmail") ||
&debug("Could not open sendmail: $!");
print MAIL "To: \"$toname\" <$toemail>\n";
print MAIL "From: \"$fromname\" <$fromemail>\n";
if($replytoemail ne ""){
print MAIL "Reply-to: \"$replytoname\" <$replytoemail>\n";
}
print MAIL "Subject: $subject\n";
if($htmlmail eq "yes"){
print MAIL "MIME-Version: 1.0\n";
print MAIL "Content-type: MULTIPART/MIXED; BOUNDARY=\"$boundary\"\n";
print MAIL "--$boundary\n";
print MAIL "Content-type: text/html;\n\n";
print MAIL "$message\n";
print MAIL "\n\n";
print MAIL "--$boundary\n";
print MAIL "Content-type: TEXT/PLAIN; charset=US-ASCII\n\n";
print MAIL "$message--$boundary--\n";
}
else {
print MAIL "\n";
print MAIL "$message\n";
}
close(MAIL) || &debug("Sending mail got an error: $! $?");
&debug("Sending mail done.");
}
else {
&debug("Cannot send mail. '$opsys' is not a valid operating sytem.
Please set \$opsys to either 'unix' or 'win' in the script
and try this again.");
}
}
# Usage: do_pop_auth(local_server_hostname,mail_server_hostname,username,pw);
# Opens a socket connection to the pop server to do POP-before-SMTP
# authentication.
sub do_pop_auth {
my($this_server_hostname,$mail_server_hostname,$username,$password) = @_;
use Socket;
$port = 110;
$x_auth_header = "X-Auth-Type: POP-BEFORE-SMTP";
my $CRLF = "\r\n";
$SIG{'INT'} = 'dokill';
sub dokill {
kill 9,$child if $child;
}
my $proto = 6;
$this = pack_sockaddr_in(0, inet_aton($this_server_hostname));
$that = pack_sockaddr_in($port, inet_aton($mail_server_hostname));
if (socket(S, AF_INET, SOCK_STREAM, $proto)) {
&debug("Created S socket for pop auth.");
}
else { &debug("Could not create socket for pop auth: $!"); }
if (connect(S, $that)){
&debug("Connected to S socket for pop auth.");
}
else { &debug("Could not connect to socket for pop auth: $!"); }
select(S); $| = 1; select(STDOUT); $| = 1;
&debug("Server responded: " . read_response()) if $no_more !=1;
&debug("I sent: USER $username\\r\\n") if $no_more !=1;
print S "USER $username$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
&debug("I sent: PASS <password>\\r\\n") if $no_more !=1;
print S "PASS $password$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
if($_ !~ /OK/){ &debug("Ooops. Username/PW incorrect."); }
else {
&debug("I sent: QUIT\\r\\n") if $no_more !=1;
print S "QUIT$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
}
close(S) || &debug("Could not close S socket: $!\n");
&debug("POP before SMTP attempt complete.");
}
# Usage: do_smtp_auth($username,$password);
# Assumes that your socket connection to the SMTP port of the mail server
# is already open from sub send_mail above.
sub do_smtp_auth {
my($username,$password) = @_;
$x_auth_header = "X-Auth-Type: SMTP-AUTH-LOGIN";
&debug("I sent: EHLO $this_server_hostname\\r\\n") if $no_more !=1;
print S "EHLO $this_server_hostname\r\n";
&debug("Server responded: " . read_response()) if $no_more !=1;
&debug("I sent: AUTH LOGIN\\r\\n") if $no_more !=1;
print S "AUTH LOGIN\015\012";
&debug("Server responded: " . read_response()) if $no_more !=1;
# AUTH LOGIN requires username/pw encoded in Base64. However, we don't
# know if the user will have the Base64 module available, so we'll do it
# manually.
$b64_u = join '', map( pack('u',$_)=~ /^.(\S*)/, ($username=~/(.{1,45})/gs));
$b64_u =~ tr|` -_|AA-Za-z0-9+/|;
&debug("I sent: '$b64_u'\\r\\n") if $no_more !=1;
print S "$b64_u$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
$b64_p= join '', map( pack('u',$_)=~ /^.(\S*)/, ($password=~/(.{1,45})/gs));
$b64_p=~ tr|` -_|AA-Za-z0-9+/|;
&debug("I sent: '$b64_p'\\r\\n") if $no_more !=1;
print S "$b64_p$CRLF";
&debug("Server responded: " . read_response()) if $no_more !=1;
if($_ !~ /^235/){
&debug("ERROR: SMTP authentication failed. Mail may not be sent.");
}
&debug("SMTP auth attempt complete.");
}
# Read multi-line responses from our socket connection. Only if
# using a Windows server for mail.
sub read_response {
my ($socket_says);
# If we've hit a 500 error, we're not going any further, so go ahead
# and quit the connection.
if($no_more == 1){ return; }
do {
$_ = ; chomp($_);
$socket_says .= $_ . "\n";
if(/^5/){
&debug("\nERROR: Something went wrong." .
"Anything beyond this won't work. $server_says ");
print S "QUIT$CRLF";
$no_more = 1;
}
} while (/^[\d]+-/);
$socket_says;
}
sub fixmac {
# Grr. Some Macs add an extra CR, LF, or both. Get rid of 'em.
my($stuff) = $_[0];
$stuff =~ s/\r\n/ /sg; $stuff =~ s/\r/ /sg; $stuff =~ s/\n/ /sg;
$stuff =~ s/\s+$//sg; $stuff =~ s/^\s+//sg;
$stuff;
}
![](\"http://www.gotacres.com/images/auctionbanner.jpg\")
![](\"http://www.gotacres.com/auction/images/misc/bullet.gif\")