[system] / branches / gage_dev / webwork2 / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

Diff of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 6880 Revision 6885
… …
13# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 13# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14# Artistic License for more details. 14# Artistic License for more details.
15################################################################################ 15################################################################################
16 16
17package WeBWorK::ContentGenerator::Problem; 17package WeBWorK::ContentGenerator::Problem;
18use base qw(WeBWorK::ContentGenerator); 18use base qw(WeBWorK WeBWorK::ContentGenerator WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil);
19 19
20=head1 NAME 20=head1 NAME
21 21
22WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. 22WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.
23 23
… …
207 my @incorrect_ids = (); 207 my @incorrect_ids = ();
208 208
209 209
210 my $problemResult = $pg->{result}; # the overall result of the problem 210 my $problemResult = $pg->{result}; # the overall result of the problem
211 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 211 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
212 #warn "answer names are ", join(" ", @answerNames); 212
213 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 213 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
214 214
215 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 215 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
216 216
217 # to make grabbing these options easier, we'll pull them out now... 217 # to make grabbing these options easier, we'll pull them out now...
… …
261 my $resultString = $answerScore >= 1 ? CGI::span({class=>"ResultsWithoutError"}, "correct") : 261 my $resultString = $answerScore >= 1 ? CGI::span({class=>"ResultsWithoutError"}, "correct") :
262 $answerScore > 0 ? int($answerScore*100)."% correct" : 262 $answerScore > 0 ? int($answerScore*100)."% correct" :
263 CGI::span({class=>"ResultsWithError"}, "incorrect"); 263 CGI::span({class=>"ResultsWithError"}, "incorrect");
264 $fully = 'completely ' if $answerScore >0 and $answerScore < 1; 264 $fully = 'completely ' if $answerScore >0 and $answerScore < 1;
265 265
266 #warn "answer $name score $answerScore";
267 push @correct_ids, $name if $answerScore == 1; 266 push @correct_ids, $name if $answerScore == 1;
268 push @incorrect_ids, $name if $answerScore < 1; 267 push @incorrect_ids, $name if $answerScore < 1;
269 268
270 # need to capture auxiliary answers as well and identify their ids. 269 # need to capture auxiliary answers as well and identify their ids.
271 270
… …
875 my $problemID = $self->r->urlpath->arg("problemID"); 874 my $problemID = $self->r->urlpath->arg("problemID");
876 875
877 return "$setID: Problem $problemID"; 876 return "$setID: Problem $problemID";
878} 877}
879 878
879
880# now altered to outsource most output operations to the template, main functions now are simply error checking and answer processing - ghe3
881# sub body {
882# my $self = shift;
883# my $r = $self->r;
884# my $ce = $r->ce;
885# my $db = $r->db;
886# my $authz = $r->authz;
887# my $urlpath = $r->urlpath;
888# my $user = $r->param('user');
889# my $effectiveUser = $r->param('effectiveUser');
890# if ( $self->{invalidSet} ) {
891# return CGI::div({class=>"ResultsWithError"},
892# CGI::p("The selected problem set (" .
893# $urlpath->arg("setID") . ") is not " .
894# "a valid set for $effectiveUser:"),
895# CGI::p($self->{invalidSet}));
896# }
897#
898# if ($self->{invalidProblem}) {
899# return CGI::div({class=>"ResultsWithError"},
900# CGI::p("The selected problem (" . $urlpath->arg("problemID") . ") is not a valid problem for set " . $self->{set}->set_id . "."));
901# }
902#
903# # unpack some useful variables
904# my $set = $self->{set};
905# my $problem = $self->{problem};
906# my $editMode = $self->{editMode};
907# my $submitAnswers = $self->{submitAnswers};
908# my $checkAnswers = $self->{checkAnswers};
909# my $previewAnswers = $self->{previewAnswers};
910# my %want = %{ $self->{want} };
911# my %can = %{ $self->{can} };
912# my %must = %{ $self->{must} };
913# my %will = %{ $self->{will} };
914# my $pg = $self->{pg};
915#
916# my $courseName = $urlpath->arg("courseID");
917#
918# # FIXME: move editor link to top, next to problem number.
919# # format as "[edit]" like we're doing with course info file, etc.
920# # add edit link for set as well.
921# my $editorLink = "";
922# # if we are here without a real homework set, carry that through
923# my $forced_field = [];
924# $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if
925# ($set->set_id eq 'Undefined_Set');
926# if ($authz->hasPermissions($user, "modify_problem_sets")) {
927# my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",
928# courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id);
929# my $editorURL = $self->systemLink($editorPage, params=>$forced_field);
930# $editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, "Edit this problem"));
931# }
932#
933# ##### translation errors? #####
934#
935# if ($pg->{flags}->{error_flag}) {
936# if ($authz->hasPermissions($user, "view_problem_debugging_info")) {
937# print $self->errorOutput($pg->{errors}, $pg->{body_text});
938# } else {
939# print $self->errorOutput($pg->{errors}, "You do not have permission to view the details of this error.");
940# }
941# print $editorLink;
942# return "";
943# }
944#
945# ##### answer processing #####
946# debug("begin answer processing");
947# # if answers were submitted:
948# my $scoreRecordedMessage;
949# my $pureProblem;
950# if ($submitAnswers) {
951# # get a "pure" (unmerged) UserProblem to modify
952# # this will be undefined if the problem has not been assigned to this user
953# $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked
954# if (defined $pureProblem) {
955# # store answers in DB for sticky answers
956# my %answersToStore;
957# my %answerHash = %{ $pg->{answers} };
958# $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!!
959# foreach (keys %answerHash);
960#
961# # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating
962# # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs
963# # however we need to store them. Fortunately they are still in the input form.
964# my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}};
965# $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names);
966#
967# # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order
968# my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names);
969# my $answerString = encodeAnswers(%answersToStore,
970# @answer_order);
971#
972# # store last answer to database
973# $problem->last_answer($answerString);
974# $pureProblem->last_answer($answerString);
975# $db->putUserProblem($pureProblem);
976#
977# # store state in DB if it makes sense
978# if ($will{recordAnswers}) {
979# $problem->status($pg->{state}->{recorded_score});
980# $problem->sub_status($pg->{state}->{sub_recorded_score});
981# $problem->attempted(1);
982# $problem->num_correct($pg->{state}->{num_of_correct_ans});
983# $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
984# $pureProblem->status($pg->{state}->{recorded_score});
985# $pureProblem->sub_status($pg->{state}->{sub_recorded_score});
986# $pureProblem->attempted(1);
987# $pureProblem->num_correct($pg->{state}->{num_of_correct_ans});
988# $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
989# if ($db->putUserProblem($pureProblem)) {
990# $scoreRecordedMessage = "Your score was recorded.";
991# } else {
992# $scoreRecordedMessage = "Your score was not recorded because there was a failure in storing the problem record to the database.";
993# }
994# # write to the transaction log, just to make sure
995# writeLog($self->{ce}, "transaction",
996# $problem->problem_id."\t".
997# $problem->set_id."\t".
998# $problem->user_id."\t".
999# $problem->source_file."\t".
1000# $problem->value."\t".
1001# $problem->max_attempts."\t".
1002# $problem->problem_seed."\t".
1003# $pureProblem->status."\t".
1004# $pureProblem->attempted."\t".
1005# $pureProblem->last_answer."\t".
1006# $pureProblem->num_correct."\t".
1007# $pureProblem->num_incorrect
1008# );
1009# } else {
1010# if (before($set->open_date) or after($set->due_date)) {
1011# $scoreRecordedMessage = "Your score was not recorded because this homework set is closed.";
1012# } else {
1013# $scoreRecordedMessage = "Your score was not recorded.";
1014# }
1015# }
1016# } else {
1017# $scoreRecordedMessage = "Your score was not recorded because this problem has not been assigned to you.";
1018# }
1019# }
1020#
1021# # logging student answers
1022#
1023# my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'};
1024# if ( defined($answer_log ) and defined($pureProblem)) {
1025# if ($submitAnswers && !$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) {
1026# my $answerString = ""; my $scores = "";
1027# my %answerHash = %{ $pg->{answers} };
1028# # FIXME this is the line 552 error. make sure original student ans is defined.
1029# # The fact that it is not defined is probably due to an error in some answer evaluator.
1030# # But I think it is useful to suppress this error message in the log.
1031# foreach (sortByName(undef, keys %answerHash)) {
1032# my $orig_ans = $answerHash{$_}->{original_student_ans};
1033# my $student_ans = defined $orig_ans ? $orig_ans : '';
1034# $answerString .= $student_ans."\t";
1035# $scores .= $answerHash{$_}->{score} >= 1 ? "1" : "0";
1036# }
1037# $answerString = '' unless defined($answerString); # insure string is defined.
1038# writeCourseLog($self->{ce}, "answer_log",
1039# join("",
1040# '|', $problem->user_id,
1041# '|', $problem->set_id,
1042# '|', $problem->problem_id,
1043# '|', $scores, "\t",
1044# time(),"\t",
1045# $answerString,
1046# ),
1047# );
1048#
1049# }
1050# }
1051#
1052# debug("end answer processing");
1053# ##### javaScripts #############
1054# my $site_url = $ce->{webworkURLs}->{htdocs};
1055# print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script();
1056#
1057# ##### output #####
1058# # custom message for editor
1059# if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) {
1060# if ($editMode eq "temporaryFile") {
1061# print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file));
1062# } elsif ($editMode eq "savedFile") {
1063# # taken care of in the initialization phase
1064# }
1065# }
1066# print CGI::start_div({class=>"problemHeader"});
1067#
1068#
1069#
1070# # attempt summary
1071# #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
1072# # until after the due date
1073# # do I need to check $will{showCorrectAnswers} to make preflight work??
1074# if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) {
1075# # print this if user submitted answers OR requested correct answers
1076#
1077# print $self->attemptResults($pg, 1,
1078# $will{showCorrectAnswers},
1079# $pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
1080# } elsif ($checkAnswers) {
1081# # print this if user previewed answers
1082# print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br();
1083# print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1);
1084# # show attempt answers
1085# # show correct answers if asked
1086# # show attempt results (correctness)
1087# # show attempt previews
1088# } elsif ($previewAnswers) {
1089# # print this if user previewed answers
1090# print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1);
1091# # show attempt answers
1092# # don't show correct answers
1093# # don't show attempt results (correctness)
1094# # show attempt previews
1095# }
1096#
1097# print CGI::end_div();
1098#
1099#
1100# ###########################
1101# # print style sheet for correct and incorrect answers
1102# ###########################
1103# # always show colors for checkAnswers
1104# # show colors for submit answer if
1105# if (($self->{checkAnswers}) or ($self->{submitAnswers} and $pg->{flags}->{showPartialCorrectAnswers}) ) {
1106# print CGI::start_style({type=>"text/css"});
1107# #FIXME -- this hack is no longer needed?
1108# # my $string ="";
1109# # foreach my $ans_name (@{ $self->{correct_ids} }) {
1110# # $string .= '#'. ( $ans_name ). $ce->{pg}{options}{correct_answer}."\n";
1111# # }
1112# # print $string;
1113# # $string ="";
1114# # foreach my $ans_name (@{ $self->{incorrect_ids} }) {
1115# # $string .= '#'. ($ ans_name). $ce->{pg}{options}{incorrect_answer}."\n";
1116# # }
1117# # print $string;
1118# # the above method keeps one bad array ID from ruining all of the assignments.
1119# print '#'.join(', #', @{ $self->{correct_ids} }), $ce->{pg}{options}{correct_answer},"\n" if ref( $self->{correct_ids} )=~/ARRAY/; #correct green
1120# print '#'.join(', #', @{ $self->{incorrect_ids} }), $ce->{pg}{options}{incorrect_answer},"\n" if ref( $self->{incorrect_ids})=~/ARRAY/; #incorrect reddish
1121# print CGI::end_style();
1122# }
1123# ###########################
1124# # post_header material
1125# ###########################
1126# print CGI::p($pg->{post_header_text});
1127# ###########################
1128# # main form
1129# ###########################
1130# print "\n";
1131#
1132# print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()");
1133# print $self->hidden_authen_fields;
1134# print "\n";
1135# print CGI::start_div({class=>"problem"});
1136# print CGI::p($pg->{body_text});
1137# print CGI::p(CGI::b("Note: "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg};
1138# print $editorLink; # this is empty unless it is appropriate to have an editor link.
1139# print CGI::end_div();
1140#
1141# print CGI::start_p();
1142#
1143# if ($can{showCorrectAnswers}) {
1144# print CGI::checkbox(
1145# -name => "showCorrectAnswers",
1146# -checked => $will{showCorrectAnswers},
1147# -label => "Show correct answers",
1148# -value => 1,
1149# );
1150# }
1151# if ($can{showHints}) {
1152# print CGI::div({style=>"color:red"},
1153# CGI::checkbox(
1154# -name => "showHints",
1155# -checked => $will{showHints},
1156# -label => "Show Hints",
1157# -value =>1,
1158# )
1159# );
1160# }
1161# if ($can{showSolutions}) {
1162# print CGI::checkbox(
1163# -name => "showSolutions",
1164# -checked => $will{showSolutions},
1165# -label => "Show Solutions",
1166# -value => 1,
1167# );
1168# }
1169#
1170# if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) {
1171# print CGI::br();
1172# }
1173#
1174# print CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers");
1175# if ($can{checkAnswers}) {
1176# print CGI::submit(-name=>"checkAnswers", -label=>"Check Answers");
1177# }
1178# if ($can{getSubmitButton}) {
1179# if ($user ne $effectiveUser) {
1180# # if acting as a student, make it clear that answer submissions will
1181# # apply to the student's records, not the professor's.
1182# print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers for $effectiveUser");
1183# } else {
1184# #print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')");
1185# print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"");
1186# # FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger
1187# # WFT???
1188# }
1189# }
1190#
1191# print CGI::end_p();
1192#
1193# print CGI::start_div({class=>"scoreSummary"});
1194#
1195# # score summary
1196# my $attempts = $problem->num_correct + $problem->num_incorrect;
1197# my $attemptsNoun = $attempts != 1 ? "times" : "time";
1198# my $problem_status = $problem->status || 0;
1199# my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number
1200# my ($attemptsLeft, $attemptsLeftNoun);
1201# if ($problem->max_attempts == -1) {
1202# # unlimited attempts
1203# $attemptsLeft = "unlimited";
1204# $attemptsLeftNoun = "attempts";
1205# } else {
1206# $attemptsLeft = $problem->max_attempts - $attempts;
1207# $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
1208# }
1209#
1210# my $setClosed = 0;
1211# my $setClosedMessage;
1212# if (before($set->open_date) or after($set->due_date)) {
1213# $setClosed = 1;
1214# if (before($set->open_date)) {
1215# $setClosedMessage = "This homework set is not yet open.";
1216# } elsif (after($set->due_date)) {
1217# $setClosedMessage = "This homework set is closed.";
1218# }
1219# }
1220# #if (before($set->open_date) or after($set->due_date)) {
1221# # $setClosed = 1;
1222# # $setClosedMessage = "This homework set is closed.";
1223# # if ($authz->hasPermissions($user, "view_answers")) {
1224# # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded.";
1225# # } else {
1226# # $setClosedMessage .= " Additional attempts will not be recorded.";
1227# # }
1228# #}
1229# unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) {
1230# my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)";
1231# print CGI::p(join("",
1232# $submitAnswers ? $scoreRecordedMessage . CGI::br() : "",
1233# "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
1234# $submitAnswers ?"You received a score of ".sprintf("%.0f%%", $pg->{result}->{score} * 100)." for this attempt.".CGI::br():'',
1235# $problem->attempted
1236# ? "Your overall recorded score is $lastScore. $notCountedMessage" . CGI::br()
1237# : "",
1238# $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
1239# ));
1240# }else {
1241# print CGI::p($pg->{state}->{state_summary_msg});
1242# }
1243#
1244# print CGI::end_div();
1245# print CGI::start_div();
1246#
1247# my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} );
1248# my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} );
1249# my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} );
1250# my $pgerrordiv = $pgdebug||$pgwarning||$pginternalerrors; # is 1 if any of these are non-empty
1251#
1252# print CGI::p({style=>"color:red;"}, "Checking additional error messages") if $pgerrordiv ;
1253# print CGI::p("pg debug<br/> $pgdebug" ) if $pgdebug ;
1254# print CGI::p("pg warning<br/>$pgwarning" ) if $pgwarning ;
1255# print CGI::p("pg internal errors<br/> $pginternalerrors") if $pginternalerrors;
1256# print CGI::end_div() if $pgerrordiv ;
1257#
1258# # save state for viewOptions
1259# print CGI::hidden(
1260# -name => "showOldAnswers",
1261# -value => $will{showOldAnswers}
1262# ),
1263#
1264# CGI::hidden(
1265# -name => "displayMode",
1266# -value => $self->{displayMode}
1267# );
1268# print( CGI::hidden(
1269# -name => 'editMode',
1270# -value => $self->{editMode},
1271# )
1272# ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile';
1273#
1274# # this is a security risk -- students can use this to find the source code for the problem
1275#
1276# my $permissionLevel = $db->getPermissionLevel($user)->permission;
1277# my $professorPermissionLevel = $ce->{userRoles}->{professor};
1278# print( CGI::hidden(
1279# -name => 'sourceFilePath',
1280# -value => $self->{problem}->{source_file}
1281# )) if defined($self->{problem}->{source_file}) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors
1282#
1283# print( CGI::hidden(
1284# -name => 'problemSeed',
1285# -value => $r->param("problemSeed")
1286# )) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors
1287#
1288#
1289# # end of main form
1290# print CGI::endform();
1291#
1292# print CGI::start_div({class=>"problemFooter"});
1293#
1294#
1295# my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers",
1296# courseID => $courseName);
1297# my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action
1298#
1299# # print answer inspection button
1300# if ($authz->hasPermissions($user, "view_answers")) {
1301# print "\n",
1302# CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n",
1303# $self->hidden_authen_fields,"\n",
1304# CGI::hidden(-name => 'courseID', -value=>$courseName), "\n",
1305# CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n",
1306# CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n",
1307# CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n",
1308# CGI::p( {-align=>"left"},
1309# CGI::submit(-name => 'action', -value=>'Show Past Answers')
1310# ), "\n",
1311# CGI::endform();
1312# }
1313#
1314#
1315# print $self->feedbackMacro(
1316# module => __PACKAGE__,
1317# set => $self->{set}->set_id,
1318# problem => $problem->problem_id,
1319# displayMode => $self->{displayMode},
1320# showOldAnswers => $will{showOldAnswers},
1321# showCorrectAnswers => $will{showCorrectAnswers},
1322# showHints => $will{showHints},
1323# showSolutions => $will{showSolutions},
1324# pg_object => $pg,
1325# );
1326#
1327# print CGI::end_div();
1328#
1329# # debugging stuff
1330# if (0) {
1331# print
1332# CGI::hr(),
1333# CGI::h2("debugging information"),
1334# CGI::h3("form fields"),
1335# ref2string($self->{formFields}),
1336# CGI::h3("user object"),
1337# ref2string($self->{user}),
1338# CGI::h3("set object"),
1339# ref2string($set),
1340# CGI::h3("problem object"),
1341# ref2string($problem),
1342# CGI::h3("PG object"),
1343# ref2string($pg, {'WeBWorK::PG::Translator' => 1});
1344# }
1345# debug("leaving body of Problem.pm");
1346# return "";
1347# }
1348
1349# now altered to outsource most output operations to the template, main functions now are simply error checking and answer processing - ghe3
880sub body { 1350sub body {
881 my $self = shift; 1351 my $self = shift;
1352 my $set = $self->{set};
1353 my $problem = $self->{problem};
1354 my $pg = $self->{pg};
1355
1356 my $valid = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::check_invalid($self);
1357 unless($valid eq "valid"){
1358 return $valid;
1359 }
1360
1361 ####################################################
1362 # Move to header in new templates
1363 #print $self->output_tabber_JS();
1364 print $self->output_coloring_JS();
1365
1366 ##### javaScripts #############
1367 # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_JS($self);
1368 print $self->output_JS;
1369
1370 ####################################################
1371
1372 # my $editorLink = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_editorLink($self);
1373 # if($editorLink eq "permission_error"){
1374 # return "";
1375 # }
1376
1377
1378 ##### answer processing #####
1379 debug("begin answer processing");
1380 # if answers were submitted:
1381 my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self);
1382 debug("end answer processing");
1383
1384 ###########################
1385 # print style sheet for correct and incorrect answers
1386 ###########################
1387
1388 # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_CSS($self);
1389 print $self->output_CSS;
1390
1391 ##### output #####
1392 # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_summary($self);
1393 print $self->output_custom_edit_message();
1394 print $self->output_summary();
1395 print $self->output_form_start();
1396 print $self->output_problem_body();
1397 print $self->output_message();
1398 print $self->output_editorLink();
1399 print $self->output_checkboxes();
1400 print $self->output_submit_buttons();
1401 print $self->output_score_summary();
1402 print $self->output_misc();
1403 print "\n</form>\n";
1404
1405
1406 $self->output_email_instructor();
1407 $self->output_past_answer_button();
1408
1409
1410#
1411#
1412# ###########################
1413# # main form
1414# ###########################
1415#
1416# # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_main_form($self,$editorLink);
1417#
1418# # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_footer($self);
1419
1420 # debugging stuff
1421 if (0) {
1422 print
1423 CGI::hr(),
1424 CGI::h2("debugging information"),
1425 CGI::h3("form fields"),
1426 ref2string($self->{formFields}),
1427 CGI::h3("user object"),
1428 ref2string($self->{user}),
1429 CGI::h3("set object"),
1430 ref2string($set),
1431 CGI::h3("problem object"),
1432 ref2string($problem),
1433 CGI::h3("PG object"),
1434 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
1435 }
1436 debug("leaving body of Problem.pm");
1437 return "";
1438}
1439
1440# output_form_start subroutine
1441
1442# prints out the beginning of the main form, and the necessary hidden authentication fields
1443
1444sub output_form_start{
1445 my $self = shift;
882 my $r = $self->r; 1446 my $r = $self->r;
883 my $ce = $r->ce; 1447 print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()");
884 my $db = $r->db; 1448 print $self->hidden_authen_fields;
1449 return "";
1450}
1451
1452# output_problem_body subroutine
1453
1454# prints out the body of the current problem
1455
1456sub output_problem_body{
1457 my $self = shift;
1458 my $pg = $self->{pg};
1459
1460 print "\n";
1461 print CGI::p($pg->{body_text});
1462 return "";
1463}
1464
1465# output_message subroutine
1466
1467# prints out a message about the problem
1468
1469sub output_message{
1470 my $self = shift;
1471 my $pg = $self->{pg};
1472
1473 print CGI::p(CGI::b("Note: "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg};
1474 return "";
1475}
1476
1477# output_editorLink subroutine
1478
1479# processes and prints out the correct link to the editor of the current problem
1480
1481sub output_editorLink{
1482
1483 my $self = shift;
1484
1485 my $set = $self->{set};
1486 my $problem = $self->{problem};
1487 my $pg = $self->{pg};
1488
1489 my $r = $self->r;
1490
885 my $authz = $r->authz; 1491 my $authz = $r->authz;
886 my $urlpath = $r->urlpath; 1492 my $urlpath = $r->urlpath;
887 my $user = $r->param('user'); 1493 my $user = $r->param('user');
888 my $effectiveUser = $r->param('effectiveUser');
889 if ( $self->{invalidSet} ) {
890 return CGI::div({class=>"ResultsWithError"},
891 CGI::p("The selected problem set (" .
892 $urlpath->arg("setID") . ") is not " .
893 "a valid set for $effectiveUser:"),
894 CGI::p($self->{invalidSet}));
895 }
896
897 if ($self->{invalidProblem}) {
898 return CGI::div({class=>"ResultsWithError"},
899 CGI::p("The selected problem (" . $urlpath->arg("problemID") . ") is not a valid problem for set " . $self->{set}->set_id . "."));
900 }
901
902 # unpack some useful variables
903 my $set = $self->{set};
904 my $problem = $self->{problem};
905 my $editMode = $self->{editMode};
906 my $submitAnswers = $self->{submitAnswers};
907 my $checkAnswers = $self->{checkAnswers};
908 my $previewAnswers = $self->{previewAnswers};
909 my %want = %{ $self->{want} };
910 my %can = %{ $self->{can} };
911 my %must = %{ $self->{must} };
912 my %will = %{ $self->{will} };
913 my $pg = $self->{pg};
914 1494
915 my $courseName = $urlpath->arg("courseID"); 1495 my $courseName = $urlpath->arg("courseID");
916 1496
917 # FIXME: move editor link to top, next to problem number. 1497 # FIXME: move editor link to top, next to problem number.
918 # format as "[edit]" like we're doing with course info file, etc. 1498 # format as "[edit]" like we're doing with course info file, etc.
… …
935 if ($authz->hasPermissions($user, "view_problem_debugging_info")) { 1515 if ($authz->hasPermissions($user, "view_problem_debugging_info")) {
936 print $self->errorOutput($pg->{errors}, $pg->{body_text}); 1516 print $self->errorOutput($pg->{errors}, $pg->{body_text});
937 } else { 1517 } else {
938 print $self->errorOutput($pg->{errors}, "You do not have permission to view the details of this error."); 1518 print $self->errorOutput($pg->{errors}, "You do not have permission to view the details of this error.");
939 } 1519 }
1520 print "";
1521 }
1522 else{
940 print $editorLink; 1523 print $editorLink;
1524 }
941 return ""; 1525 return "";
942 } 1526}
943 1527
944 ##### answer processing ##### 1528# output_checkboxes subroutine
945 debug("begin answer processing"); 1529
946 # if answers were submitted: 1530# prints out the checkbox input elements that are available for the current problem
947 my $scoreRecordedMessage; 1531
948 my $pureProblem; 1532sub output_checkboxes{
949 if ($submitAnswers) { 1533 my $self = shift;
950 # get a "pure" (unmerged) UserProblem to modify 1534 my %can = %{ $self->{can} };
951 # this will be undefined if the problem has not been assigned to this user 1535 my %will = %{ $self->{will} };
952 $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked 1536
953 if (defined $pureProblem) { 1537 if ($can{showCorrectAnswers}) {
954 # store answers in DB for sticky answers 1538 print WeBWorK::CGI_labeled_input(
955 my %answersToStore; 1539 -type => "checkbox",
956 my %answerHash = %{ $pg->{answers} }; 1540 -id => "showCorrectAnswers_id",
957 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!! 1541 -label_text => "Show correct answers",
958 foreach (keys %answerHash); 1542 -input_attr => $will{showCorrectAnswers} ?
959 1543 {
960 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating 1544 -name => "showCorrectAnswers",
961 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs 1545 -checked => "checked",
962 # however we need to store them. Fortunately they are still in the input form. 1546 -value => 1,
963 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}};
964 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names);
965
966 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order
967 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names);
968 my $answerString = encodeAnswers(%answersToStore,
969 @answer_order);
970
971 # store last answer to database
972 $problem->last_answer($answerString);
973 $pureProblem->last_answer($answerString);
974 $db->putUserProblem($pureProblem);
975
976 # store state in DB if it makes sense
977 if ($will{recordAnswers}) {
978 $problem->status($pg->{state}->{recorded_score});
979 $problem->sub_status($pg->{state}->{sub_recorded_score});
980 $problem->attempted(1);
981 $problem->num_correct($pg->{state}->{num_of_correct_ans});
982 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
983 $pureProblem->status($pg->{state}->{recorded_score});
984 $pureProblem->sub_status($pg->{state}->{sub_recorded_score});
985 $pureProblem->attempted(1);
986 $pureProblem->num_correct($pg->{state}->{num_of_correct_ans});
987 $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
988 if ($db->putUserProblem($pureProblem)) {
989 $scoreRecordedMessage = "Your score was recorded.";
990 } else {
991 $scoreRecordedMessage = "Your score was not recorded because there was a failure in storing the problem record to the database.";
992 }
993 # write to the transaction log, just to make sure
994 writeLog($self->{ce}, "transaction",
995 $problem->problem_id."\t".
996 $problem->set_id."\t".
997 $problem->user_id."\t".
998 $problem->source_file."\t".
999 $problem->value."\t".
1000 $problem->max_attempts."\t".
1001 $problem->problem_seed."\t".
1002 $pureProblem->status."\t".
1003 $pureProblem->attempted."\t".
1004 $pureProblem->last_answer."\t".
1005 $pureProblem->num_correct."\t".
1006 $pureProblem->num_incorrect
1007 );
1008 } else {
1009 if (before($set->open_date) or after($set->due_date)) {
1010 $scoreRecordedMessage = "Your score was not recorded because this homework set is closed.";
1011 } else {
1012 $scoreRecordedMessage = "Your score was not recorded.";
1013 }
1014 } 1547 }
1015 } else { 1548 :
1016 $scoreRecordedMessage = "Your score was not recorded because this problem has not been assigned to you."; 1549 {
1017 } 1550 -name => "showCorrectAnswers",
1018 } 1551 -value => 1,
1019
1020 # logging student answers
1021
1022 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'};
1023 if ( defined($answer_log ) and defined($pureProblem)) {
1024 if ($submitAnswers && !$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) {
1025 my $answerString = ""; my $scores = "";
1026 my %answerHash = %{ $pg->{answers} };
1027 # FIXME this is the line 552 error. make sure original student ans is defined.
1028 # The fact that it is not defined is probably due to an error in some answer evaluator.
1029 # But I think it is useful to suppress this error message in the log.
1030 foreach (sortByName(undef, keys %answerHash)) {
1031 my $orig_ans = $answerHash{$_}->{original_student_ans};
1032 my $student_ans = defined $orig_ans ? $orig_ans : '';
1033 $answerString .= $student_ans."\t";
1034 $scores .= $answerHash{$_}->{score} >= 1 ? "1" : "0";
1035 } 1552 }
1036 $answerString = '' unless defined($answerString); # insure string is defined.
1037 writeCourseLog($self->{ce}, "answer_log",
1038 join("",
1039 '|', $problem->user_id,
1040 '|', $problem->set_id,
1041 '|', $problem->problem_id,
1042 '|', $scores, "\t",
1043 time(),"\t",
1044 $answerString,
1045 ),
1046 );
1047
1048 }
1049 }
1050
1051 debug("end answer processing");
1052 ##### javaScripts #############
1053 my $site_url = $ce->{webworkURLs}->{htdocs};
1054 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script();
1055
1056 ##### output #####
1057 # custom message for editor
1058 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) {
1059 if ($editMode eq "temporaryFile") {
1060 print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file));
1061 } elsif ($editMode eq "savedFile") {
1062 # taken care of in the initialization phase
1063 }
1064 }
1065 print CGI::start_div({class=>"problemHeader"});
1066
1067
1068
1069 # attempt summary
1070 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
1071 # until after the due date
1072 # do I need to check $will{showCorrectAnswers} to make preflight work??
1073 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) {
1074 # print this if user submitted answers OR requested correct answers
1075
1076 print $self->attemptResults($pg, 1,
1077 $will{showCorrectAnswers},
1078 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
1079 } elsif ($checkAnswers) {
1080 # print this if user previewed answers
1081 print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br();
1082 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1);
1083 # show attempt answers
1084 # show correct answers if asked
1085 # show attempt results (correctness)
1086 # show attempt previews
1087 } elsif ($previewAnswers) {
1088 # print this if user previewed answers
1089 print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1);
1090 # show attempt answers
1091 # don't show correct answers
1092 # don't show attempt results (correctness)
1093 # show attempt previews
1094 }
1095
1096 print CGI::end_div();
1097
1098
1099 ###########################
1100 # print style sheet for correct and incorrect answers
1101 ###########################
1102 # always show colors for checkAnswers
1103 # show colors for submit answer if
1104 if (($self->{checkAnswers}) or ($self->{submitAnswers} and $pg->{flags}->{showPartialCorrectAnswers}) ) {
1105 print CGI::start_style({type=>"text/css"});
1106 #FIXME -- this hack is no longer needed?
1107 # my $string ="";
1108# foreach my $ans_name (@{ $self->{correct_ids} }) {
1109# $string .= '#'. ( $ans_name ). $ce->{pg}{options}{correct_answer}."\n";
1110# }
1111# print $string;
1112# $string ="";
1113# foreach my $ans_name (@{ $self->{incorrect_ids} }) {
1114# $string .= '#'. ($ ans_name). $ce->{pg}{options}{incorrect_answer}."\n";
1115# }
1116# print $string;
1117 # the above method keeps one bad array ID from ruining all of the assignments.
1118 print '#'.join(', #', @{ $self->{correct_ids} }), $ce->{pg}{options}{correct_answer},"\n" if ref( $self->{correct_ids} )=~/ARRAY/; #correct green
1119 print '#'.join(', #', @{ $self->{incorrect_ids} }), $ce->{pg}{options}{incorrect_answer},"\n" if ref( $self->{incorrect_ids})=~/ARRAY/; #incorrect reddish
1120 print CGI::end_style();
1121 }
1122 ###########################
1123 # post_header material
1124 ###########################
1125 print CGI::p($pg->{post_header_text});
1126 ###########################
1127 # main form
1128 ###########################
1129 print "\n";
1130
1131 print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()");
1132 print $self->hidden_authen_fields;
1133 print "\n";
1134 print CGI::start_div({class=>"problem"});
1135 print CGI::p($pg->{body_text});
1136 print CGI::p(CGI::b("Note: "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg};
1137 print $editorLink; # this is empty unless it is appropriate to have an editor link.
1138 print CGI::end_div();
1139
1140 print CGI::start_p();
1141
1142 if ($can{showCorrectAnswers}) {
1143 print CGI::checkbox(
1144 -name => "showCorrectAnswers",
1145 -checked => $will{showCorrectAnswers},
1146 -label => "Show correct answers",
1147 -value => 1,
1148 ); 1553 );
1149 } 1554 }
1150 if ($can{showHints}) { 1555 if ($can{showHints}) {
1151 print CGI::div({style=>"color:red"}, 1556 print CGI::div({style=>"color:red"},
1152 CGI::checkbox( 1557 WeBWorK::CGI_labeled_input(
1558 -type => "checkbox",
1559 -id => "showHints_id",
1560 -label_text => "Show Hints",
1561 -input_attr => $will{showHints} ?
1562 {
1153 -name => "showHints", 1563 -name => "showHints",
1154 -checked => $will{showHints}, 1564 -checked => "checked",
1155 -label => "Show Hints",
1156 -value =>1, 1565 -value => 1,
1566 }
1567 :
1568 {
1569 -name => "showCorrectAnswers",
1570 -value => 1,
1571 }
1157 ) 1572 )
1158 ); 1573 );
1159 } 1574 }
1160 if ($can{showSolutions}) { 1575 if ($can{showSolutions}) {
1161 print CGI::checkbox( 1576 print WeBWorK::CGI_labeled_input(
1577 -type => "checkbox",
1578 -id => "showSolutions_id",
1579 -label_text => "Show Solutions",
1580 -input_attr => $will{showSolutions} ?
1581 {
1162 -name => "showSolutions", 1582 -name => "showSolutions",
1163 -checked => $will{showSolutions}, 1583 -checked => "checked",
1164 -label => "Show Solutions",
1165 -value => 1, 1584 -value => 1,
1585 }
1586 :
1587 {
1588 -name => "showCorrectAnswers",
1589 -value => 1,
1590 }
1166 ); 1591 );
1167 } 1592 }
1168 1593
1169 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { 1594 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) {
1170 print CGI::br(); 1595 print CGI::br();
1171 } 1596 }
1172 1597
1173 print CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers"); 1598 return "";
1599}
1600
1601# output_submit_buttons
1602
1603# prints out the submit button input elements that are available for the current problem
1604
1605sub output_submit_buttons{
1606 my $self = shift;
1607 my $r = $self->r;
1608 my %can = %{ $self->{can} };
1609
1610 my $user = $r->param('user');
1611 my $effectiveUser = $r->param('effectiveUser');
1612
1613 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"previewAnswers_id", -input_attr=>{-name=>"previewAnswers", -value=>"Preview Answers"});
1174 if ($can{checkAnswers}) { 1614 if ($can{checkAnswers}) {
1175 print CGI::submit(-name=>"checkAnswers", -label=>"Check Answers"); 1615 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"checkAnswers_id", -input_attr=>{-name=>"checkAnswers", -value=>"Check Answers"});
1176 } 1616 }
1177 if ($can{getSubmitButton}) { 1617 if ($can{getSubmitButton}) {
1178 if ($user ne $effectiveUser) { 1618 if ($user ne $effectiveUser) {
1179 # if acting as a student, make it clear that answer submissions will 1619 # if acting as a student, make it clear that answer submissions will
1180 # apply to the student's records, not the professor's. 1620 # apply to the student's records, not the professor's.
1181 print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers for $effectiveUser"); 1621 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>"submitAnswers", -value=>"Submit Answers for $effectiveUser"});
1182 } else { 1622 } else {
1183 #print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')"); 1623 #print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')");
1184 print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>""); 1624 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>""});
1185 # FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger 1625 # FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger
1186 # WFT??? 1626 # WFT???
1187 } 1627 }
1188 } 1628 }
1189 1629
1190 print CGI::end_p(); 1630 return "";
1191 1631}
1192 print CGI::start_div({class=>"scoreSummary"}); 1632
1633# output_score_summary subroutine
1634
1635# prints out a summary of the student's current progress and status on the current problem
1636
1637sub output_score_summary{
1638 my $self = shift;
1639 my $problem = $self->{problem};
1640 my $set = $self->{set};
1641 my $pg = $self->{pg};
1642 my $scoreRecordedMessage = "";
1643 unless(defined $self->{scoreRecordedMessage}){
1644 $scoreRecordedMessage = $self->{scoreRecordedMessage};
1645 }
1646 my $submitAnswers = $self->{submitAnswers};
1193 1647
1194 # score summary 1648 # score summary
1195 my $attempts = $problem->num_correct + $problem->num_incorrect; 1649 my $attempts = $problem->num_correct + $problem->num_incorrect;
1196 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 1650 my $attemptsNoun = $attempts != 1 ? "times" : "time";
1197 my $problem_status = $problem->status || 0; 1651 my $problem_status = $problem->status || 0;
… …
1237 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." 1691 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
1238 )); 1692 ));
1239 }else { 1693 }else {
1240 print CGI::p($pg->{state}->{state_summary_msg}); 1694 print CGI::p($pg->{state}->{state_summary_msg});
1241 } 1695 }
1696
1697 return "";
1698}
1242 1699
1243 print CGI::end_div(); 1700# output_misc subroutine
1701
1702# prints out other necessary elements
1703
1704sub output_misc{
1705
1706 my $self = shift;
1707 my $r = $self->r;
1708 my $ce = $r->ce;
1709 my $db = $r->db;
1710 my $pg = $self->{pg};
1711 my %will = %{ $self->{will} };
1712 my $user = $r->param('user');
1713
1244 print CGI::start_div(); 1714 print CGI::start_div();
1245 1715
1246 my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} ); 1716 my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} );
1247 my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} ); 1717 my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} );
1248 my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} ); 1718 my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} );
… …
1281 1751
1282 print( CGI::hidden( 1752 print( CGI::hidden(
1283 -name => 'problemSeed', 1753 -name => 'problemSeed',
1284 -value => $r->param("problemSeed") 1754 -value => $r->param("problemSeed")
1285 )) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1755 )) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors
1756
1757 return "";
1758}
1286 1759
1760# output_summary subroutine
1761
1762# prints out the summary of the questions that the student has answered for the current problem, along with available information about correctness
1763
1764sub output_summary{
1765
1766 my $self = shift;
1767
1768 my $editMode = $self->{editMode};
1769 my $problem = $self->{problem};
1770 my $pg = $self->{pg};
1771 my $submitAnswers = $self->{submitAnswers};
1772 my %will = %{ $self->{will} };
1773 my $checkAnswers = $self->{checkAnswers};
1774 my $previewAnswers = $self->{previewAnswers};
1775
1776 my $r = $self->r;
1777
1778 my $authz = $r->authz;
1779 my $user = $r->param('user');
1780
1781 # attempt summary
1782 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
1783 # until after the due date
1784 # do I need to check $will{showCorrectAnswers} to make preflight work??
1785 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) {
1786 # print this if user submitted answers OR requested correct answers
1287 1787
1288 # end of main form 1788 print $self->attemptResults($pg, 1,
1289 print CGI::endform(); 1789 $will{showCorrectAnswers},
1790 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
1791 } elsif ($checkAnswers) {
1792 # print this if user previewed answers
1793 print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br();
1794 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1);
1795 # show attempt answers
1796 # show correct answers if asked
1797 # show attempt results (correctness)
1798 # show attempt previews
1799 } elsif ($previewAnswers) {
1800 # print this if user previewed answers
1801 print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1);
1802 # show attempt answers
1803 # don't show correct answers
1804 # don't show attempt results (correctness)
1805 # show attempt previews
1806 }
1290 1807
1291 print CGI::start_div({class=>"problemFooter"}); 1808 return "";
1809}
1810
1811# output_custom_edit_message
1812
1813# prints out a custom edit message
1814
1815sub output_custom_edit_message{
1816 my $self = shift;
1817 my $r = $self->r;
1818 my $authz = $r->authz;
1819 my $user = $r->param('user');
1820 my $editMode = $self->{editMode};
1821 my $problem = $self->{problem};
1292 1822
1823 # custom message for editor
1824 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) {
1825 if ($editMode eq "temporaryFile") {
1826 print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file));
1827 } elsif ($editMode eq "savedFile") {
1828 # taken care of in the initialization phase
1829 }
1830 }
1293 1831
1832 return "";
1833}
1834
1835# output_JS subroutine
1836
1837# prints out the wz_tooltip.js script for the current site.
1838
1839sub output_JS{
1840
1841 my $self = shift;
1842 my $r = $self->r;
1843 my $ce = $r->ce;
1844
1845 my $site_url = $ce->{webworkURLs}->{htdocs};
1846 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script();
1847 return "";
1848}
1849
1850# output_CSS subroutine
1851
1852# prints the CSS scripts to page. Does some PERL trickery to form the styles for the correct answers and the incorrect answers (which may be substituted with JS sometime in the future).
1853
1854sub output_CSS{
1855
1856 my $self = shift;
1857 my $r = $self->r;
1858 my $ce = $r->ce;
1859 my $pg = $self->{pg};
1860
1861 # always show colors for checkAnswers
1862 # show colors for submit answer if
1863 if (($self->{checkAnswers}) or ($self->{submitAnswers} and $pg->{flags}->{showPartialCorrectAnswers}) ) {
1864 print CGI::start_style({type=>"text/css"});
1865 print '#'.join(', #', @{ $self->{correct_ids} }), $ce->{pg}{options}{correct_answer} if ref( $self->{correct_ids} )=~/ARRAY/; #correct green
1866 print '#'.join(', #', @{ $self->{incorrect_ids} }), $ce->{pg}{options}{incorrect_answer} if ref( $self->{incorrect_ids})=~/ARRAY/; #incorrect reddish
1867 print CGI::end_style();
1868 }
1869
1870 return "";
1871}
1872
1873# output_past_answer_button
1874
1875# prints out the "Show Past Answers" button
1876
1877sub output_past_answer_button{
1878 my $self = shift;
1879 my $r = $self->r;
1880 my $problem = $self->{problem};
1881
1882 my $authz = $r->authz;
1883 my $urlpath = $r->urlpath;
1884 my $user = $r->param('user');
1885
1886 my $courseName = $urlpath->arg("courseID");
1887
1294 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", 1888 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers",
1295 courseID => $courseName); 1889 courseID => $courseName);
1296 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action 1890 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action
1297 1891
1298 # print answer inspection button 1892 # print answer inspection button
… …
1308 CGI::submit(-name => 'action', -value=>'Show Past Answers') 1902 CGI::submit(-name => 'action', -value=>'Show Past Answers')
1309 ), "\n", 1903 ), "\n",
1310 CGI::endform(); 1904 CGI::endform();
1311 } 1905 }
1312 1906
1313 1907 return "";
1908}
1909
1910# output_email_instructor subroutine
1911
1912# prints out the "Email Instructor" button
1913
1914sub output_email_instructor{
1915 my $self = shift;
1916 my $problem = $self->{problem};
1917 my %will = %{ $self->{will} };
1918 my $pg = $self->{pg};
1919
1314 print $self->feedbackMacro( 1920 print $self->feedbackMacro(
1315 module => __PACKAGE__, 1921 module => __PACKAGE__,
1316 set => $self->{set}->set_id, 1922 set => $self->{set}->set_id,
1317 problem => $problem->problem_id, 1923 problem => $problem->problem_id,
1318 displayMode => $self->{displayMode}, 1924 displayMode => $self->{displayMode},
… …
1321 showHints => $will{showHints}, 1927 showHints => $will{showHints},
1322 showSolutions => $will{showSolutions}, 1928 showSolutions => $will{showSolutions},
1323 pg_object => $pg, 1929 pg_object => $pg,
1324 ); 1930 );
1325 1931
1326 print CGI::end_div();
1327
1328 # debugging stuff
1329 if (0) {
1330 print
1331 CGI::hr(),
1332 CGI::h2("debugging information"),
1333 CGI::h3("form fields"),
1334 ref2string($self->{formFields}),
1335 CGI::h3("user object"),
1336 ref2string($self->{user}),
1337 CGI::h3("set object"),
1338 ref2string($set),
1339 CGI::h3("problem object"),
1340 ref2string($problem),
1341 CGI::h3("PG object"),
1342 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
1343 }
1344 debug("leaving body of Problem.pm");
1345 return ""; 1932 return "";
1346} 1933}
1347 1934
1935sub output_hidden_info{
1936 my $self = shift;
1937
1938 if(defined $self->{correct_ids}){
1939 my $correctRef = $self->{correct_ids};
1940 my @correct = @$correctRef;
1941 foreach(@correct){
1942 print CGI::hidden(-name=>"correct_ids", -value=>$_."_val");
1943 }
1944 }
1945 if(defined $self->{incorrect_ids}){
1946 my $incorrectRef = $self->{incorrect_ids};
1947 my @incorrect = @$incorrectRef;
1948 foreach(@incorrect){
1949 print CGI::hidden(-name=>"incorrect_ids", -value=>$_."_val");
1950 }
1951 }
1952
1953 return "";
1954}
1955
1956sub output_coloring_JS{
1957 my $self = shift;
1958 my $r = $self->r;
1959 my $ce = $r->ce;
1960
1961 my $site_url = $ce->{webworkURLs}->{htdocs};
1962 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/color.js"}), CGI::end_script();
1963 return "";
1964}
1965
13481; 19661;
Legend:
Removed from v.6880  
changed lines
  Added in v.6885
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9