Hello,
I have moved my script from my personal windows web server up to a company
wide windows NT server with a IIS web server. I am getting an error "undef
at unkown location!" that I was not getting before. The script seems to
connect to the SQL server (where database is) just fine but when it reaches
the part of the script that must go out to a fold (at the same hierarchial
level) it disconnects. I have set up the directories the same but for some
reason it is not finding the files. Any ideas? My script and dbitrace are
as follows.
Thanks much for your help. I am baffled on this one.
Michelle
dbitrace ********************************************
prepare for DBD::ODBC::db (DBI::db=HASH(0x17d8a54)~0x17d9e50 ' SELECT
ans.ExamID, ans.QnAIndex, que.QtnText, que.ExamQnAType,
ans.QnAOrder, ans.QnASubOrder, ans.AnsText, ans.CorrectAns,
que.RatSurl, que.DepSurl, que.InstId, inst.InstText
FROM
ExamQuestionInfo que
LEFT OUTER JOIN ExamAnswerInfo ans on que.QnAIndex = ans.QnAIndex
AND que.ExamID = ans.ExamId
LEFT OUTER JOIN ExamInstGrpInfo inst on que.ExamID = inst.ExamId
AND que.InstI...')
dbd_st_prepare'd sql f27918988
SELECT
ans.ExamID, ans.QnAIndex, que.QtnText, que.ExamQnAType,
ans.QnAOrder, ans.QnASubOrder, ans.AnsText, ans.CorrectAns,
que.RatSurl, que.DepSurl, que.InstId, inst.InstText
FROM
ExamQuestionInfo que
LEFT OUTER JOIN ExamAnswerInfo ans on que.QnAIndex = ans.QnAIndex
AND que.ExamID = ans.ExamId
LEFT OUTER JOIN ExamInstGrpInfo inst on que.ExamID = inst.ExamId
AND que.InstId = inst.InstId
WHERE que.ExamId = 401
ORDER BY que.ExamID, que.QnAIndex, ans.QnAOrder, inst.InstId
<- prepare= DBI::st=HASH(0x17d8bf8) at indquiz5.pl line 74.
-> execute for DBD::ODBC::st (DBI::st=HASH(0x17d8bf8)~0x182b628)
dbd_st_execute (for sql f27918988 after)...
dbd_describe sql 27918988: num_fields=12
col 1: INTEGER len= 4 disp= 12, prec= 10 scale=0
col 2: INTEGER len= 4 disp= 12, prec= 10 scale=0
col 3: LONG VARCHAR len=2147483647 disp=10001, prec=2147483647
scale=0
col 4: INTEGER len= 4 disp= 12, prec= 10 scale=0
col 5: INTEGER len= 4 disp= 12, prec= 10 scale=0
col 6: INTEGER len= 4 disp= 12, prec= 10 scale=0
col 7: LONG VARCHAR len=2147483647 disp=10001, prec=2147483647
scale=0
col 8: CHAR len= 1 disp= 2, prec= 1 scale=0
col 9: VARCHAR len=255 disp=256, prec=255 scale=0
col 10: VARCHAR len=255 disp=256, prec=255 scale=0
col 11: INTEGER len= 4 disp= 12, prec= 10 scale=0
col 12: LONG VARCHAR len=2147483647 disp=10001, prec=2147483647
scale=0
col 1: 'ExamID' sqltype=INTEGER, ctype=SQL_C_CHAR, maxlen=12
col 2: 'QnAIndex' sqltype=INTEGER, ctype=SQL_C_CHAR, maxlen=12
col 3: 'QtnText' sqltype=LONG VARCHAR, ctype=SQL_C_CHAR, maxlen=10001
col 4: 'ExamQnAType' sqltype=INTEGER, ctype=SQL_C_CHAR, maxlen=12
col 5: 'QnAOrder' sqltype=INTEGER, ctype=SQL_C_CHAR, maxlen=12
col 6: 'QnASubOrder' sqltype=INTEGER, ctype=SQL_C_CHAR, maxlen=12
col 7: 'AnsText' sqltype=LONG VARCHAR, ctype=SQL_C_CHAR, maxlen=10001
col 8: 'CorrectAns' sqltype=CHAR, ctype=SQL_C_CHAR, maxlen=2
col 9: 'RatSurl' sqltype=VARCHAR, ctype=SQL_C_CHAR, maxlen=256
col 10: 'DepSurl' sqltype=VARCHAR, ctype=SQL_C_CHAR, maxlen=256
col 11: 'InstId' sqltype=INTEGER, ctype=SQL_C_CHAR, maxlen=12
col 12: 'InstText' sqltype=LONG VARCHAR, ctype=SQL_C_CHAR,
maxlen=10001
<- execute= -1 at indquiz5.pl line 93.
-> bind_columns for DBD::ODBC::st (DBI::st=HASH(0x17d8bf8)~0x182b628
SCALAR(0x1802688) SCALAR(0x1802664) SCALAR(0x180264c) SCALAR(0x1801a88)
SCALAR(0x1801734) SCALAR(0x18016f8) SCALAR(0x1801710) SCALAR(0x1800584)
SCALAR(0x18017f4) SCALAR(0x18017b8) SCALAR(0x18017d0) SCALAR(0x1801908))
<- bind_columns= 1 at indquiz5.pl line 97.
-> fetch for DBD::ODBC::st (DBI::st=HASH(0x17d8bf8)~0x182b628)
<- fetch= [ '401' '1' 'Write out the inequality <img
src="media/qq040101.gif" border="0"
align="absmiddle"> in sentence form, as you would say it out
loud. Spell out numbers and be sure to type a period at the end of the
sentence. ' '3' '1' '0' 'm is greater than or equal to five.' 'N'
'040101.htm' ' ' '0' undef ] at indquiz5.pl line 101.
-> fetch for DBD::ODBC::st (DBI::st=HASH(0x17d8bf8)~0x182b628)
<- fetch= [ '401' '2' 'Write out the inequality <img
src="media/qq040102.gif" border="0"
align="absmiddle"> in sentence form, as you would say it out
loud. <b>Spell out</b> numbers and be sure to type a
<b>period</b> at the end of the sentence. ' '3' '1' '0' 'x is
not equal to ten.' 'N' '040102.htm' ' ' '0' undef ] at indquiz5.pl line 101.
-> errstr in DBD::_::common for DBD::ODBC::db
(DBI::db=HASH(0x17d8a54)~0x17d9e50)
<- errstr= ( undef ) [1 items] at indquiz5.pl line 242.
-> DESTROY for DBD::ODBC::st (DBI::st=HASH(0x17d9e08)~INNER)
<- DESTROY= undef at unknown location!
-> DESTROY for DBD::ODBC::st (DBI::st=HASH(0x182b628)~INNER)
<- DESTROY= undef at unknown location!
-- DBI::END
-> disconnect_all for DBD::ODBC::dr (DBI::dr=HASH(0x1831450)~0x17d8aa8)
<- disconnect_all= '' at DBI.pm line 450.
-> DESTROY for DBD::ODBC::db (DBI::db=HASH(0x17d9e50)~INNER)
<- DESTROY= undef during global destruction.
-> DESTROY in DBD::_::common for DBD::ODBC::dr
(DBI::dr=HASH(0x17d8aa8)~INNER)
<- DESTROY= undef during global destruction.
script********************************************
#!/usr/local/bin/perl
use warnings;
use strict;
use DBI;
# open dat file and write header. Change Course and title value in
subroutine.
open (XML, ">res00001.dat") or die "could not open file for writing: $!\n";
&header;
#remove any old trace files
unlink 'dbitrace.log' if -e 'dbitrace.log';
# using ODBC driver to open the database
my $dsn = 'driver={SQL
Server};Server=***.*******;database=**********;uid=****;pwd=*****;';
my $dbh = DBI->connect("dbi:ODBC:$dsn") or
die ( "Could not make connections to database: $DBI::errstr" );
#Set the tracing level to 1 and prepare()
DBI->trace( 2, 'dbitrace.log' );
# setting parameters to not truncate and allow long lines of 5000 length
$dbh->{LongTruncOk} = 0;
$dbh->{LongReadLen} = 10000;
# identify variables
my ($selectexam, $QI, $FBurl, $Qtype, $FB, $CA, $ExamId, $QtnText,
$QnAIndex, $ExamQnAType, $QnAOrder, $QnASubOrder, $AnsText, $CorrectAns,
$RatSurl, $DepSurl, $InstId, $InstText);
#statement handle to query table data
my $sth2 = $dbh->prepare(qq{ SELECT
ans.ExamID, ans.QnAIndex, que.QtnText, que.ExamQnAType,
ans.QnAOrder, ans.QnASubOrder, ans.AnsText, ans.CorrectAns,
que.RatSurl, que.DepSurl, que.InstId, inst.InstText
FROM
ExamQuestionInfo que
LEFT OUTER JOIN ExamAnswerInfo ans on que.QnAIndex = ans.QnAIndex
AND que.ExamID = ans.ExamId
LEFT OUTER JOIN ExamInstGrpInfo inst on que.ExamID = inst.ExamId
AND que.InstId = inst.InstId
WHERE que.ExamId = $selectexam
ORDER BY que.ExamID, que.QnAIndex, ans.QnAOrder, inst.InstId }) or
die ( "Cannot prepare statement: ", $dbh->errstr(), "\n" );
$sth2->execute() or
die ( "Cannot execute statement: ", $sth2->errstr(), "\n" );
#associate Perl variables to output columns
my $rv2 = $sth2->bind_columns(\( $ExamId, $QnAIndex, $QtnText, $ExamQnAType,
$QnAOrder, $QnASubOrder, $AnsText, $CorrectAns, $RatSurl, $DepSurl, $InstId,
$InstText));
my $QE = 1;
#loop queried data
EXAM: while ($sth2->fetch){
$QI = $QnAIndex;
#check if new question than print feedback from previous question
if (($QE != $QI) && ($FBurl == '')) {
&feedbacknorational();
}
elsif ($QE != $QI){
&feedbackrational();
}
#set variables to hold feedback and answer info
$FBurl = $RatSurl;
$Qtype = $ExamQnAType;
if ($CorrectAns eq "Y") {$CA = $QnAOrder
}
#print question
if ($ExamQnAType eq 1 && $QnAOrder eq 1) {
print XML qq '\n\t<QUESTION_TRUEFALSE id="q' . $QnAIndex . '">';
print XML qq '\n\t\t<BODY>';
print XML qq '\n\t\t\t<TEXT> '. $InstText . '<p>'. $QtnText . '
</TEXT>';
print XML qq '\n\t\t</BODY>';
&flags;
print XML qq '\n\t\t<ANSWER id="q' . $QnAIndex . '_a'.$QnAOrder.'"
position="'.$QnAIndex.'">';
print XML qq '\n\t\t\t<TEXT> '. $AnsText . ' </TEXT>';
print XML qq '\n\t\t</ANSWER>';
$QE = $QI;
next EXAM;
}
elsif ($ExamQnAType eq 1 && $QnAOrder > 1) {
&answerloop();
$QE = $QI;
next EXAM;
}
if ($ExamQnAType eq 2 && $QnAOrder eq 1) {
print XML qq '\n\t<QUESTION_MULTIPLECHOICE id="q' . $QnAIndex . '">';
print XML qq '\n\t\t<BODY>';
print XML qq '\n\t\t\t<TEXT> '. $InstText . '<p>'. $QtnText .
'</TEXT>';
print XML qq '\n\t\t</BODY>';
&flags;
print XML qq '\n\t\t<ANSWER id="q' . $QnAIndex . '_a'.$QnAOrder.'"
position="'.$QnAIndex.'">';
print XML qq '\n\t\t\t<TEXT> '. $AnsText . ' </TEXT>';
print XML qq '\n\t\t</ANSWER>';
$QE = $QI;
next EXAM;
}
elsif ($ExamQnAType eq 2 && $QnAOrder > 1) {
&answerloop();
$QE = $QI;
next EXAM;
}
if ($ExamQnAType eq 3 && $QnAOrder eq 1) {
print XML qq '\n\t<QUESTION_FILLINBLANK id="q' . $QnAIndex . '">';
print XML qq '\n\t\t<BODY>';
print XML qq '\n\t\t\t<TEXT> '. $InstText . '<p>'. $QtnText .
'</TEXT>';
print XML qq '\n\t\t</BODY>';
&flags;
print XML qq '\n\t\t<ANSWER id="q' . $QnAIndex . '_a'.$QnAOrder.'"
position="'.$QnAIndex.'">';
print XML qq '\n\t\t\t<TEXT> '. $AnsText . ' </TEXT>';
print XML qq '\n\t\t</ANSWER>';
$QE = $QI;
next EXAM;
}
elsif ($ExamQnAType eq 3 && $QnAOrder > 1) {
&answerloop();
$QE = $QI;
next EXAM;
}
if ($ExamQnAType eq 4 && $QnAOrder eq 1) {print XML qq
'\n\t<QUESTION_MATCHING id="q' . $QnAIndex . '">';
print XML qq '\n\t\t<BODY>';
print XML qq '\n\t\t\t<TEXT> '. $InstText . '<p>'. $QtnText .
'</TEXT>';
$QE = $QI;
next EXAM;
}
elsif ($ExamQnAType eq 4 && $QnAOrder > 1) {
&answerloop();
$QE = $QI;
next EXAM;
}
if ($ExamQnAType eq 5 && $QnAOrder eq 1) {print XML qq
'\n\t<QUESTION_ESSAY id="q' . $QnAIndex . '">';
print XML qq '\n\t\t<BODY>';
print XML qq '\n\t\t\t<TEXT> '. $InstText . '<p>'. $QtnText . '
</TEXT>';
$QE = $QI;
next EXAM;
}
elsif ($ExamQnAType eq 5 && $QnAOrder > 1) {
&answerloop();
$QE = $QI;
next EXAM;
}
}
if ($FBurl == '') {
&feedbacknorational();
}
else{
feedbackrational();
}
print XML "\n</POOL>";
#close second statment handle
$sth2->finish;
doPrepare();
$dbh->disconnect or warn "Disconnection falied: $DBI::errstr\n";
close (XML);
#******************************* SUBROUTINES
******************************************
sub answerloop {
print XML qq '\n\t\t<ANSWER id="q' . $QnAIndex . '_a'.$QnAOrder.'"
position="'.$QnAIndex.'">';
print XML qq '\n\t\t\t<TEXT> '. $AnsText . ' </TEXT>';
print XML qq '\n\t\t</ANSWER>';
}
sub feedbackrational {
open(IN, qq '<../0003exam/htmdocs/010101.htm') or die ( "Cannot open file:
", $dbh->errstr(), "\n" );
undef $/;
while(<IN>){
my $lines =/<body>(.*?)<\/body>/sm;
$FB=$1;
}
close IN;
if ($Qtype eq 1){
print XML qq '\n\t\t<GRADABLE>';
print XML qq
'\n\t\t\t<FEEDBACK_WHEN_CORRECT>'.$FB.'</FEEDBACK_WHEN_CORRECT>';
print XML qq
'\n\t\t\t<FEEDBACK_WHEN_INCORRECT>'.$FB.'</FEEDBACK_WHEN_INCORRECT>';
print XML qq '\n\t\t\t<CORRECTANSWER answer_id = "q' . $QE . '_a' .$CA.
'"/>';
print XML qq '\n\t\t</GRADABLE>';
print XML qq '\n\t</QUESTION_TRUEFALSE>';
}
if ($Qtype eq 2){
print XML qq '\n\t\t<GRADABLE>';
print XML qq
'\n\t\t\t<FEEDBACK_WHEN_CORRECT>'.$FB.'</FEEDBACK_WHEN_CORRECT>';
print XML qq
'\n\t\t\t<FEEDBACK_WHEN_INCORRECT>'.$FB.'</FEEDBACK_WHEN_INCORRECT>';
print XML qq '\n\t\t\t<CORRECTANSWER answer_id = "q' . $QE . '_a' .$CA.
'"/>';
print XML qq '\n\t\t</GRADABLE>';
print XML qq '\n\t</QUESTION_MULTIPLECHOICE>';
}
if ($Qtype eq 3){
print XML qq '\n\t\t<GRADABLE>';
print XML qq
'\n\t\t\t<FEEDBACK_WHEN_CORRECT>'.$FB.'</FEEDBACK_WHEN_CORRECT>';
print XML qq
'\n\t\t\t<FEEDBACK_WHEN_INCORRECT>'.$FB.'</FEEDBACK_WHEN_INCORRECT>';
print XML qq '\n\t\t</GRADABLE>';
print XML qq '\n\t</QUESTION_FILLINBLANK>';
}
if ($Qtype eq 4){
print XML qq '\n\t\t<GRADABLE>';
print XML qq
'\n\t\t\t<FEEDBACK_WHEN_CORRECT>'.$FB.'</FEEDBACK_WHEN_CORRECT>';
print XML qq
'\n\t\t\t<FEEDBACK_WHEN_INCORRECT>'.$FB.'</FEEDBACK_WHEN_INCORRECT>';
print XML qq '\n\t\t</GRADABLE>';
print XML qq '\n\t</QUESTION_MATCHING>';
}
if ($Qtype eq 5){
print XML qq '\n\t</QUESTION_ESSAY>';
}
$QE =$QI;
}
sub feedbacknorational {
if ($Qtype eq 1){
print XML qq '\n\t\t<GRADABLE>';
print XML qq '\n\t\t\t<CORRECTANSWER answer_id = "q' . $QE . '_a' .$CA.
'"/>';
print XML qq '\n\t\t</GRADABLE>';
print XML qq '\n\t</QUESTION_TRUEFALSE>';
}
if ($Qtype eq 2){
print XML qq '\n\t\t<GRADABLE>';
print XML qq '\n\t\t\t<CORRECTANSWER answer_id = "q' . $QE . '_a' .$CA.
'"/>';
print XML qq '\n\t\t</GRADABLE>';
print XML qq '\n\t</QUESTION_MULTIPLECHOICE>';
}
if ($Qtype eq 3){
print XML qq '\n\t\t<GRADABLE>';
print XML qq '\n\t\t</GRADABLE>';
print XML qq '\n\t</QUESTION_FILLINBLANK>';
}
if ($Qtype eq 4){
print XML qq '\n\t\t<GRADABLE>';
print XML qq '\n\t\t</GRADABLE>';
print XML qq '\n\t</QUESTION_MATCHING>';
}
if ($Qtype eq 5){
print XML qq '\n\t</QUESTION_ESSAY>';
}
$QE =$QI;
}
sub flags {
print XML "\n\t\t\t<FLAGS>\n";
print XML qq '\t\t\t\t<ISHTML value="true"/>\n';
print XML qq '\t\t\t\t<ISNEWLINELITERAL value="false"/>\n';
print XML "\t\t\t</FLAGS>\n";
}
###### change name of course (COURSEID value), name of question pool (TITLE)
and exam id (selectexam)
sub header {
print "Content-type: text/xml\n\n";
print XML qq '<?xml version="1.0" encoding="UTF-8"?>\n';
print XML "<POOL>\n";
print XML qq '\t<COURSEID value="c3039alg1"/>\n';
print XML qq '\t<TITLE value="Unit 4, Lesson 1 Quiz Pool"/>\n';
$selectexam = 401
}
