[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 1776 Revision 1980
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.113 2004/02/04 00:32:12 gage Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.121 2004/04/07 22:18:46 gage Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
… …
63sub templateName { 63sub templateName {
64 "problem"; 64 "problem";
65} 65}
66 66
67sub pre_header_initialize { 67sub pre_header_initialize {
68 my ($self, $setName, $problemNumber) = @_; 68 my ($self) = @_;
69 my $r = $self->{r}; 69 my $r = $self->r;
70 my $courseEnv = $self->{ce}; 70 my $ce = $r->ce;
71 my $db = $self->{db}; 71 my $db = $r->db;
72 my $urlpath = $r->urlpath;
73
74 my $setName = $urlpath->arg("setID");
75 my $problemNumber = $r->urlpath->arg("problemID");
72 my $userName = $r->param('user'); 76 my $userName = $r->param('user');
73 my $effectiveUserName = $r->param('effectiveUser'); 77 my $effectiveUserName = $r->param('effectiveUser');
74 my $key = $r->param('key'); 78 my $key = $r->param('key');
75 79
76 my $user = $db->getUser($userName); # checked 80 my $user = $db->getUser($userName); # checked
77 die "record for user $userName (real user) does not exist." 81 die "record for user $userName (real user) does not exist."
78 unless defined $user; 82 unless defined $user;
79 83
… …
164 $self->{editMode} = $editMode; 168 $self->{editMode} = $editMode;
165 169
166 ##### form processing ##### 170 ##### form processing #####
167 171
168 # set options from form fields (see comment at top of file for names) 172 # set options from form fields (see comment at top of file for names)
169 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 173 my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode};
170 my $redisplay = $r->param("redisplay"); 174 my $redisplay = $r->param("redisplay");
171 my $submitAnswers = $r->param("submitAnswers"); 175 my $submitAnswers = $r->param("submitAnswers");
172 my $checkAnswers = $r->param("checkAnswers"); 176 my $checkAnswers = $r->param("checkAnswers");
173 my $previewAnswers = $r->param("previewAnswers"); 177 my $previewAnswers = $r->param("previewAnswers");
174 178
175 # fields which may be defined when using Problem Editor
176 #my $override_seed = ($permissionLevel>=10) ? $r->param('problemSeed') : undef;
177 #my $override_problem_source = ($permissionLevel>=10) ? $r->param('sourceFilePath') : undef;
178 #my $editMode = undef;
179 #my $submit_button = $r->param('submit_button');
180 #if ( defined($submit_button ) ) {
181 # $editMode = "temporaryFile" if $submit_button eq 'Refresh';
182 # $editMode = 'savedFile' if $submit_button eq 'Save';
183 #}
184 #
185 ##override using the source file data from the form field
186 #$problem->source_file($override_problem_source) if defined($override_problem_source);
187 #$problem->problem_seed($override_seed) if defined($override_seed);
188 #
189 ## store path to source file for title.
190 #$self->{problem_source_name} = $problem->source_file;
191 #$self->{edit_mode} = $editMode;
192 #$self->{current_problem_source} = (defined($override_problem_source) ) ?
193
194 # coerce form fields into CGI::Vars format
195 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 179 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
196
197 180
198 $self->{displayMode} = $displayMode; 181 $self->{displayMode} = $displayMode;
199 $self->{redisplay} = $redisplay; 182 $self->{redisplay} = $redisplay;
200 $self->{submitAnswers} = $submitAnswers; 183 $self->{submitAnswers} = $submitAnswers;
201 $self->{checkAnswers} = $checkAnswers; 184 $self->{checkAnswers} = $checkAnswers;
… …
208 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0; 191 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
209 return unless $self->{isOpen}; 192 return unless $self->{isOpen};
210 193
211 # what does the user want to do? 194 # what does the user want to do?
212 my %want = ( 195 my %want = (
213 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 196 showOldAnswers => $r->param("showOldAnswers") || $ce->{pg}->{options}->{showOldAnswers},
214 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 197 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers},
215 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 198 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints},
216 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 199 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions},
217 recordAnswers => $submitAnswers, 200 recordAnswers => $submitAnswers,
218 checkAnswers => $checkAnswers, 201 checkAnswers => $checkAnswers,
219 ); 202 );
220 203
221 # are certain options enforced? 204 # are certain options enforced?
… …
237 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, 220 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
238 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), 221 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
239 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem 222 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem
240 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date), 223 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date),
241 ); 224 );
242 ######################################################### 225
243 # more complicated logic for showing check answer button: 226 # more complicated logic for showing check answer button:
244 #########################################################
245 # checkAnswers button shows up after due date -- once a student can't record anymore 227 # checkAnswers button shows up after due date -- once a student can't record anymore
246 # checkAnswers button always shows up when an instructor or TA is acting 228 # checkAnswers button always shows up when an instructor or TA is acting
247 # as someone else (the $user and $effectiveUserName aren't the same). 229 # as someone else (the $user and $effectiveUserName aren't the same).
248 $can{checkAnswers} = ($can{checkAnswers} && not $can{recordAnswers} ) || 230 $can{checkAnswers} = (
249 ( defined($userName) and defined($effectiveUserName) and 231 # $can{recordAnswers} will be false if the due date has passed OR the
250 ($userName ne $effectiveUserName) 232 # student has used up all of her attempts
251 ); 233 ($can{checkAnswers} and not $can{recordAnswers})
252 ######################################################### 234 or
235 (
236 # FIXME: this is not the right way to check for this.
237 # also, canCheckAnswers() will show this button if the permission
238 # level is positive, which is always true when an instructor is
239 # acting as a student
240 defined($userName)
241 and
242 defined($effectiveUserName)
243 and
244 ($userName ne $effectiveUserName)
245 )
246 );
247
253 # more complicated logif for showing "submit answer" button 248 # more complicated logif for showing "submit answer" button:
254 #########################################################
255 # We hide the submit answer button if someone is acting as a student 249 # We hide the submit answer button if someone is acting as a student
256 # This prevents errors where you accidently submit the answer for a student 250 # This prevents errors where you accidently submit the answer for a student
257 # Not sure whether this a feature or a bug 251 # Not sure whether this a feature or a bug
252 $can{recordAnswers} = (
253 $can{recordAnswers}
254 and not
255 (
256 # FIXME: this is not the right way to check for this.
257 defined($userName)
258 and
259 defined($effectiveUserName)
260 and
261 ($userName ne $effectiveUserName)
262 )
263 );
258 264
259 $can{recordAnswers} = ($can{recordAnswers} and not
260 ( defined($userName) and defined($effectiveUserName) and
261 ($userName ne $effectiveUserName)
262 )
263 );
264 # final values for options 265 # final values for options
265 my %will; 266 my %will;
266 foreach (keys %must) { 267 foreach (keys %must) {
267 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 268 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
268 } 269 }
… …
277 278
278 ##### translation ##### 279 ##### translation #####
279 280
280 $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer); 281 $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer);
281 my $pg = WeBWorK::PG->new( 282 my $pg = WeBWorK::PG->new(
282 $courseEnv, 283 $ce,
283 $effectiveUser, 284 $effectiveUser,
284 $key, 285 $key,
285 $set, 286 $set,
286 $problem, 287 $problem,
287 $set->psvn, # FIXME: this field should be removed 288 $set->psvn, # FIXME: this field should be removed
… …
309 $self->{can} = \%can; 310 $self->{can} = \%can;
310 $self->{will} = \%will; 311 $self->{will} = \%will;
311 $self->{pg} = $pg; 312 $self->{pg} = $pg;
312} 313}
313 314
314#sub if_warnings($$) {
315# my ($self, $arg) = @_;
316# return 0 unless $self->{isOpen};
317# return $self->{pg}->{warnings} ne "";
318#}
319
320sub if_errors($$) { 315sub if_errors($$) {
321 my ($self, $arg) = @_; 316 my ($self, $arg) = @_;
322 return 0 unless $self->{isOpen}; 317
318 if ($self->{isOpen}) {
323 return $self->{pg}->{flags}->{error_flag}; 319 return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg;
320 } else {
321 return !$arg;
322 }
324} 323}
325 324
326sub head { 325sub head {
327 my $self = shift; 326 my ($self) = @_;
327
328 return "" unless $self->{isOpen}; 328 return "" unless $self->{isOpen};
329 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 329 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
330} 330}
331 331
332sub options { 332sub options {
333 my $self = shift; 333 my ($self) = @_;
334
334 return join("", 335 return join("",
335 CGI::start_form("POST", $self->{r}->uri), 336 CGI::start_form("POST", $self->{r}->uri),
336 $self->hidden_authen_fields, 337 $self->hidden_authen_fields,
337 CGI::hr(), 338 CGI::hr(),
338 CGI::start_div({class=>"viewOptions"}), 339 CGI::start_div({class=>"viewOptions"}),
… …
340 CGI::end_div(), 341 CGI::end_div(),
341 CGI::end_form() 342 CGI::end_form()
342 ); 343 );
343} 344}
344 345
345sub path { 346#sub path {
346 my $self = shift; 347# my $self = shift;
347 my $args = $_[-1]; 348# my $args = $_[-1];
348 my $setName = $self->{set}->set_id; 349# my $setName = $self->{set}->set_id;
349 my $problemNumber = $self->{problem}->problem_id; 350# my $problemNumber = $self->{problem}->problem_id;
350 351#
351 my $ce = $self->{ce}; 352# my $ce = $self->{ce};
352 my $root = $ce->{webworkURLs}->{root}; 353# my $root = $ce->{webworkURLs}->{root};
353 my $courseName = $ce->{courseName}; 354# my $courseName = $ce->{courseName};
354 return $self->pathMacro($args, 355# return $self->pathMacro($args,
355 "Home" => "$root", 356# "Home" => "$root",
356 $courseName => "$root/$courseName", 357# $courseName => "$root/$courseName",
357 $setName => "$root/$courseName/$setName", 358# $setName => "$root/$courseName/$setName",
358 "Problem $problemNumber" => "", 359# "Problem $problemNumber" => "",
359 ); 360# );
360} 361#}
361 362
362sub siblings { 363sub siblings {
363 my $self = shift; 364 my ($self) = @_;
365 my $r = $self->r;
366 my $db = $r->db;
367 my $urlpath = $r->urlpath;
368
369 my $courseID = $urlpath->arg("courseID");
364 my $setName = $self->{set}->set_id; 370 my $setID = $self->{set}->set_id;
365 my $problemNumber = $self->{problem}->problem_id;
366
367 my $ce = $self->{ce};
368 my $db = $self->{db};
369 my $root = $ce->{webworkURLs}->{root};
370 my $courseName = $ce->{courseName};
371 print CGI::strong("Problems"), CGI::br();
372
373 my $effectiveUser = $self->{r}->param("effectiveUser"); 371 my $eUserID = $r->param("effectiveUser");
374 my @problemIDs = $db->listUserProblems($effectiveUser, $setName); 372 my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID);
373
374 print CGI::start_ul({class=>"LinksMenu"});
375 print CGI::start_li();
376 print CGI::span({style=>"font-size:larger"}, "Problems");
377 print CGI::start_ul();
378
375 foreach my $problem (sort { $a <=> $b } @problemIDs) { 379 foreach my $problemID (@problemIDs) {
376 print '&nbsp;&nbsp;'.CGI::a({-href=>"$root/$courseName/$setName/".$problem."/?" 380 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem",
377 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}}, 381 courseID => $courseID, setID => $setID, problemID => $problemID);
378 "Problem ".$problem), CGI::br(); 382 print CGI::li(CGI::a({href=>$self->systemLink($problemPage)}, "Problem $problemID"));
379 } 383 }
380 384
385 print CGI::end_ul();
386 print CGI::end_li();
387 print CGI::end_ul();
388
381 return ""; 389 return "";
382} 390}
383 391
384sub nav { 392sub nav {
385 $WeBWorK::timer->continue("begin nav subroutine") if defined($WeBWorK::timer); 393 my ($self, $args) = @_;
386 my $self = shift; 394 my $r = $self->r;
387 my $args = $_[-1]; 395 my $db = $r->db;
396 my $urlpath = $r->urlpath;
397
398 my $courseID = $urlpath->arg("courseID");
388 my $setName = $self->{set}->set_id; 399 my $setID = $self->{set}->set_id;
389 my $problemNumber = $self->{problem}->problem_id; 400 my $problemID = $self->{problem}->problem_id;
390
391 my $ce = $self->{ce};
392 my $db = $self->{db};
393 my $root = $ce->{webworkURLs}->{root};
394 my $courseName = $ce->{courseName};
395
396 my $wwdb = $self->{wwdb};
397 my $effectiveUser = $self->{r}->param("effectiveUser"); 401 my $eUserID = $r->param("effectiveUser");
402
403 my ($prevID, $nextID);
404
405 my @problemIDs = $db->listUserProblems($eUserID, $setID);
406 foreach my $id (@problemIDs) {
407 $prevID = $id if $id < $problemID
408 and (not defined $prevID or $id > $prevID);
409 $nextID = $id if $id > $problemID
410 and (not defined $nextID or $id < $nextID);
411 }
412
413 my @links;
414
415 if ($prevID) {
416 my $prevPage = $urlpath->newFromModule(__PACKAGE__,
417 courseID => $courseID, setID => $setID, problemID => $prevID);
418 push @links, "Previous Problem", $r->location . $prevPage->path, "navPrev";
419 } else {
420 push @links, "Previous Problem", "", "navPrev";
421 }
422
423 push @links, "Problem List", $r->location . $urlpath->parent->path, "navProbList";
424
425 if ($nextID) {
426 my $nextPage = $urlpath->newFromModule(__PACKAGE__,
427 courseID => $courseID, setID => $setID, problemID => $nextID);
428 push @links, "Next Problem", $r->location . $nextPage->path, "navNext";
429 } else {
430 push @links, "Next Problem", "", "navNext";
431 }
432
398 my $tail = "&displayMode=".$self->{displayMode}; 433 my $tail = "&displayMode=".$self->{displayMode};
399
400 my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList");
401
402 my @problemIDs = $db->listUserProblems($effectiveUser, $setName);
403 my ($prevID, $nextID);
404 foreach my $id (@problemIDs) {
405 $prevID = $id if $id < $problemNumber
406 and (not defined $prevID or $id > $prevID);
407 $nextID = $id if $id > $problemNumber
408 and (not defined $nextID or $id < $nextID);
409 }
410 unshift @links, "Previous Problem" , ($prevID
411 ? "$root/$courseName/$setName/".$prevID
412 : "") , "navPrev";
413 push @links, "Next Problem" , ($nextID
414 ? "$root/$courseName/$setName/".$nextID
415 : "") , "navNext";
416
417 my $result = $self->navMacro($args, $tail, @links); 434 return $self->navMacro($args, $tail, @links);
418 $WeBWorK::timer->continue("end nav subroutine") if defined($WeBWorK::timer);
419 return $result;
420} 435}
421 436
422sub title { 437sub title {
423 my $self = shift; 438 my ($self) = @_;
439
424 my $setName = $self->{set}->set_id; 440 my $setID = $self->{set}->set_id;
425 my $problemNumber = $self->{problem}->problem_id; 441 my $problemID = $self->{problem}->problem_id;
426 442
427 return "$setName : Problem $problemNumber"; 443 return "$setID : $problemID";
428} 444}
429 445
430sub body { 446sub body {
431 my $self = shift; 447 my $self = shift;
448 my $r = $self->r;
449 my $ce = $r->ce;
450 my $db = $r->db;
451 my $urlpath = $r->urlpath;
432 452
433 return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open."))
434 unless $self->{isOpen}; 453 unless ($self->{isOpen}) {
435 454 return CGI::div({class=>"ResultsWithError"},
455 CGI::p("This problem is not available because the problem set that contains it is not yet open."));
456 }
436 # unpack some useful variables 457 # unpack some useful variables
437 my $r = $self->{r};
438 my $db = $self->{db};
439 my $ce = $self->{ce};
440 my $root = $ce->{webworkURLs}->{root};
441 my $courseName = $ce->{courseName};
442 my $set = $self->{set}; 458 my $set = $self->{set};
443 my $problem = $self->{problem}; 459 my $problem = $self->{problem};
444 my $editMode = $self->{editMode}; 460 my $editMode = $self->{editMode};
445 my $permissionLevel = $self->{permissionLevel}; 461 my $permissionLevel = $self->{permissionLevel};
446 my $submitAnswers = $self->{submitAnswers}; 462 my $submitAnswers = $self->{submitAnswers};
… …
450 my %can = %{ $self->{can} }; 466 my %can = %{ $self->{can} };
451 my %must = %{ $self->{must} }; 467 my %must = %{ $self->{must} };
452 my %will = %{ $self->{will} }; 468 my %will = %{ $self->{will} };
453 my $pg = $self->{pg}; 469 my $pg = $self->{pg};
454 470
455 471 #my $root = $ce->{webworkURLs}->{root};
472 my $courseName = $urlpath->arg("courseID");
456 473
457 #####create Editor link ##### 474 #####create Editor link #####
458 # print editor link if the user is an instructor AND the file is not in temporary editing mode 475 ## print editor link if the user is an instructor AND the file is not in temporary editing mode
459 my $editorLinkMessage = ''; 476 #my $editorLinkMessage = '';
460 # and ( (not defined($self->{editMode})) or $self->{editMode} eq 'savedFile') # FIXME is this needed? 477 ## and ( (not defined($self->{editMode})) or $self->{editMode} eq 'savedFile') # FIXME is this needed?
461 if ($self->{permissionLevel}>=10 ) { 478 #if ($self->{permissionLevel}>=10 ) {
462 $editorLinkMessage = CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/". 479 # $editorLinkMessage = CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/".
463 $set->set_id.'/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem'); 480 # $set->set_id.'/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem');
464 } 481 #}
482
483 my $editorLink = "";
484 if ($self->{permissionLevel}>=10) {
485 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",
486 courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id);
487 my $editorURL = $self->systemLink($editorPage);
488 $editorLink = CGI::a({href=>$editorURL}, "Edit this problem");
489 }
490
465 ##### translation errors? ##### 491 ##### translation errors? #####
466 492
467 if ($pg->{flags}->{error_flag}) { 493 if ($pg->{flags}->{error_flag}) {
468 return $self->errorOutput($pg->{errors}, $pg->{body_text}.CGI::p($editorLinkMessage)); 494 print $self->errorOutput($pg->{errors}, $pg->{body_text});
495 print $editorLink;
496 return "";
469 } 497 }
470 498
471 ##### answer processing ##### 499 ##### answer processing #####
472 $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer); 500 $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer);
473 # if answers were submitted: 501 # if answers were submitted:
… …
480 # store answers in DB for sticky answers 508 # store answers in DB for sticky answers
481 my %answersToStore; 509 my %answersToStore;
482 my %answerHash = %{ $pg->{answers} }; 510 my %answerHash = %{ $pg->{answers} };
483 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!! 511 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!!
484 foreach (keys %answerHash); 512 foreach (keys %answerHash);
513
485 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating 514 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating
486 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs 515 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs
487 # however we need to store them. Fortunately they are still in the input form. 516 # however we need to store them. Fortunately they are still in the input form.
488 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}}; 517 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}};
489
490 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names); 518 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names);
491 519
492 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order 520 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order
493 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names); 521 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names);
494 my $answerString = encodeAnswers(%answersToStore, 522 my $answerString = encodeAnswers(%answersToStore,
… …
579 # custom message for editor 607 # custom message for editor
580 if ($permissionLevel >= 10 and defined $editMode) { 608 if ($permissionLevel >= 10 and defined $editMode) {
581 if ($editMode eq "temporaryFile") { 609 if ($editMode eq "temporaryFile") {
582 print CGI::p(CGI::i("Editing temporary file: ", $problem->source_file)); 610 print CGI::p(CGI::i("Editing temporary file: ", $problem->source_file));
583 } elsif ($editMode eq "savedFile") { 611 } elsif ($editMode eq "savedFile") {
612 if ( defined($r->param('submiterror')) and $r->param('submiterror') ) {
613 # FIXME The following line doesn't work because the submiterror hook has already been called.
614 # The actions below should take place during the initialization phase.
615 $self->{submiterror} .= $r->param('submiterror');
616 print CGI::p(CGI::div({class=>'ResultsWithError'},$self->{submiterror}));
617 } else {
584 print CGI::p(CGI::i("Problem saved to: ", $problem->source_file)); 618 print CGI::p(CGI::div({ class=>'ResultsWithoutError'}, "Problem saved to: ", $problem->source_file));
619 }
585 } 620 }
586 } 621 }
587 622 #FIXME we need error messages here if the problem was really not saved.
588 # attempt summary 623 # attempt summary
589 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 624 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
590 # until after the due date 625 # until after the due date
591 # do I need to check $wills{howCorrectAnswers} to make preflight work?? 626 # do I need to check $wills{howCorrectAnswers} to make preflight work??
592 if (($pg->{flags}->{showPartialCorrectAnswers}>= 0 and $submitAnswers) ) { 627 if (($pg->{flags}->{showPartialCorrectAnswers}>= 0 and $submitAnswers) ) {
… …
718 print CGI::endform(); 753 print CGI::endform();
719 754
720 755
721 print CGI::start_div({class=>"problemFooter"}); 756 print CGI::start_div({class=>"problemFooter"});
722 757
723 # arguments for answer inspection button 758 ## arguments for answer inspection button
724 my $prof_url = $ce->{webworkURLs}->{oldProf}; 759 #my $prof_url = $ce->{webworkURLs}->{oldProf};
725 my $webworkURL = $ce->{webworkURLs}->{root}; 760 #my $webworkURL = $ce->{webworkURLs}->{root};
726 my $cgi_url = $prof_url; 761 #my $cgi_url = $prof_url;
727 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl 762 #$cgi_url=~ s|/[^/]*$||; # clip profLogin.pl
728 my $authen_args = $self->url_authen_args(); 763 #my $authen_args = $self->url_authen_args();
729 my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; 764 #my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/";
730 765
766 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers",
767 courseID => $courseName);
768 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action
769
731 # print answer inspection button 770 # print answer inspection button
732 if ($self->{permissionLevel} > 0) { 771 if ($self->{permissionLevel} > 0) {
733 print "\n", 772 print "\n",
734 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", 773 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n",
735 $self->hidden_authen_fields,"\n", 774 $self->hidden_authen_fields,"\n",
736 CGI::hidden(-name => 'course', -value=>$courseName), "\n", 775 CGI::hidden(-name => 'courseID', -value=>$courseName), "\n",
737 CGI::hidden(-name => 'problemNumber', -value=>$problem->problem_id), "\n", 776 CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n",
738 CGI::hidden(-name => 'setName', -value=>$problem->set_id), "\n", 777 CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n",
739 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 778 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n",
740 CGI::p( {-align=>"left"}, 779 CGI::p( {-align=>"left"},
741 CGI::submit(-name => 'action', -value=>'Show Past Answers') 780 CGI::submit(-name => 'action', -value=>'Show Past Answers')
742 ), "\n", 781 ), "\n",
743 CGI::endform(); 782 CGI::endform();
744 } 783 }
745 784
746 #print CGI::end_div(); 785 ## arguments for feedback form
786 #my $feedbackURL = "$root/$courseName/feedback/";
747 # 787 #
748 #print CGI::start_div(); 788 ##print feedback form
749 789 #print
750 # arguments for feedback form 790 # CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
751 my $feedbackURL = "$root/$courseName/feedback/"; 791 # $self->hidden_authen_fields,"\n",
792 # CGI::hidden("module", __PACKAGE__),"\n",
793 # CGI::hidden("set", $set->set_id),"\n",
794 # CGI::hidden("problem", $problem->problem_id),"\n",
795 # CGI::hidden("displayMode", $self->{displayMode}),"\n",
796 # CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n",
797 # CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n",
798 # CGI::hidden("showHints", $will{showHints}),"\n",
799 # CGI::hidden("showSolutions", $will{showSolutions}),"\n",
800 # CGI::p({-align=>"left"},
801 # CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")
802 # ),
803 # CGI::endform(),"\n";
804
805 # feedback form url
806 my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback",
807 courseID => $courseName);
808 my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action
752 809
753 #print feedback form 810 #print feedback form
754 print 811 print
755 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 812 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
756 $self->hidden_authen_fields,"\n", 813 $self->hidden_authen_fields,"\n",
… …
764 CGI::hidden("showSolutions", $will{showSolutions}),"\n", 821 CGI::hidden("showSolutions", $will{showSolutions}),"\n",
765 CGI::p({-align=>"left"}, 822 CGI::p({-align=>"left"},
766 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 823 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")
767 ), 824 ),
768 CGI::endform(),"\n"; 825 CGI::endform(),"\n";
769 826
770 # FIXME print editor link 827 # FIXME print editor link
771 print $editorLinkMessage; #empty unless it is appropriate to have an editor link. 828 print $editorLink; #empty unless it is appropriate to have an editor link.
772 829
773 print CGI::end_div(); 830 print CGI::end_div();
774 831
775 # warning output 832 # warning output
776 #if ($pg->{warnings} ne "") { 833 #if ($pg->{warnings} ne "") {
… …
797 return ""; 854 return "";
798} 855}
799 856
800##### output utilities ##### 857##### output utilities #####
801 858
802sub attemptResults($$$$$$) { 859sub attemptResults {
803 my $self = shift; 860 my $self = shift;
804 my $pg = shift; 861 my $pg = shift;
805 my $showAttemptAnswers = shift; 862 my $showAttemptAnswers = shift;
806 my $showCorrectAnswers = shift; 863 my $showCorrectAnswers = shift;
807 my $showAttemptResults = $showAttemptAnswers && shift; 864 my $showAttemptResults = $showAttemptAnswers && shift;
808 my $showSummary = shift; 865 my $showSummary = shift;
809 my $showAttemptPreview = shift || 0; 866 my $showAttemptPreview = shift || 0;
867
810 my $ce = $self->{ce}; 868 my $ce = $self->r->ce;
869
811 my $problemResult = $pg->{result}; # the overall result of the problem 870 my $problemResult = $pg->{result}; # the overall result of the problem
812 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 871 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
813 872
814 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 873 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
815 874
… …
850 # of the answer names is changeable. this only fixes it for "AnSwEr" 909 # of the answer names is changeable. this only fixes it for "AnSwEr"
851 #$name =~ s/^AnSwEr//; 910 #$name =~ s/^AnSwEr//;
852 911
853 my $row; 912 my $row;
854 #$row .= CGI::td($name); 913 #$row .= CGI::td($name);
855 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : ""; 914 $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : "";
856 $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : ""; 915 $row .= $showAttemptPreview ? CGI::td($self->nbsp($preview)) : "";
857 $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : ""; 916 $row .= $showCorrectAnswers ? CGI::td($self->nbsp($correctAnswer)) : "";
858 $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : ""; 917 $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : "";
859 $row .= $showMessages ? CGI::td(nbsp($answerMessage)) : ""; 918 $row .= $showMessages ? CGI::td($self->nbsp($answerMessage)) : "";
860 push @tableRows, $row; 919 push @tableRows, $row;
861 } 920 }
862 921
863 # render equation images 922 # render equation images
864 $imgGen->render(refresh => 1); 923 $imgGen->render(refresh => 1);
… …
869# my $summary = "On this attempt, you answered $numCorrect out of " 928# my $summary = "On this attempt, you answered $numCorrect out of "
870# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 929# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
871 my $summary = ""; 930 my $summary = "";
872 if (scalar @answerNames == 1) { 931 if (scalar @answerNames == 1) {
873 if ($numCorrect == scalar @answerNames) { 932 if ($numCorrect == scalar @answerNames) {
874 $summary .= "The above answer is correct."; 933 $summary .= CGI::div({class=>"ResultsWithoutError"},"The above answer is correct.");
875 } else { 934 } else {
876 $summary .= "The above answer is NOT correct."; 935 $summary .= CGI::div({class=>"ResultsWithError"},"The above answer is NOT correct.");
877 } 936 }
878 } else { 937 } else {
879 if ($numCorrect == scalar @answerNames) { 938 if ($numCorrect == scalar @answerNames) {
880 $summary .= "All of the above answers are correct."; 939 $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the above answers are correct.");
881 } else { 940 } else {
882 $summary .= "At least one of the above answers is NOT correct."; 941 $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the above answers is NOT correct.");
883 } 942 }
884 } 943 }
885 #FIXME there must be a better way to force refresh. 944
886 #my $refresh_warning = 'Hold down shift and click "refresh" or "reload" to update answer preview images.';
887 #return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) .
888 #CGI::div({style=>'color:red; font-size:10pt'},$refresh_warning) .
889 #($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
890 # ... this has been fixed by equation caching.
891 return 945 return
892 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) 946 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
893 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 947 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
894} 948}
949
895sub nbsp { 950#sub nbsp {
896 my $str = shift; 951# my $str = shift;
897 ($str =~/\S/) ? $str : '&nbsp;' ; # returns non-breaking space for empty strings 952# ($str =~/\S/) ? $str : '&nbsp;' ; # returns non-breaking space for empty strings
898 # tricky cases: $str =0; 953# # tricky cases: $str =0;
899 # $str is a complex number 954# # $str is a complex number
900} 955#}
956
901sub viewOptions($) { 957sub viewOptions {
902 my $self = shift; 958 my ($self) = @_;
959
903 my $displayMode = $self->{displayMode}; 960 my $displayMode = $self->{displayMode};
904 my %must = %{ $self->{must} }; 961 my %must = %{ $self->{must} };
905 my %can = %{ $self->{can} }; 962 my %can = %{ $self->{can} };
906 my %will = %{ $self->{will} }; 963 my %will = %{ $self->{will} };
907 964
… …
932 $optionLine, 989 $optionLine,
933 CGI::submit(-name=>"redisplay", -label=>"Save Options"), 990 CGI::submit(-name=>"redisplay", -label=>"Save Options"),
934 ); 991 );
935} 992}
936 993
937sub previewAnswer($$) { 994sub previewAnswer {
938 my ($self, $answerResult, $imgGen) = @_; 995 my ($self, $answerResult, $imgGen) = @_;
939 my $ce = $self->{ce}; 996 my $ce = $self->r->ce;
940 my $effectiveUser = $self->{effectiveUser}; 997 my $effectiveUser = $self->{effectiveUser};
941 my $set = $self->{set}; 998 my $set = $self->{set};
942 my $problem = $self->{problem}; 999 my $problem = $self->{problem};
943 my $displayMode = $self->{displayMode}; 1000 my $displayMode = $self->{displayMode};
944 1001
… …
964 if ($?) { 1021 if ($?) {
965 return "<b>[tth failed: $? $@]</b>"; 1022 return "<b>[tth failed: $? $@]</b>";
966 } 1023 }
967 return $result; 1024 return $result;
968 } elsif ($displayMode eq "images") { 1025 } elsif ($displayMode eq "images") {
969 ## how are we going to name this?
970 #my $targetPathCommon = "/m2i/"
971 # . $effectiveUser->user_id . "."
972 # . $set->set_id . "."
973 # . $problem->problem_id . "."
974 # . $answerResult->{ans_name} . ".png";
975 #
976 ## figure out where to put things
977 #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng");
978 #my $latex = $ce->{externalPrograms}->{latex};
979 #my $dvipng = $ce->{externalPrograms}->{dvipng};
980 #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
981 # # should use surePathToTmpFile, but we have to
982 # # isolate it from the problem enivronment first
983 #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
984 #
985 ## call dvipng to generate a preview
986 #dvipng($wd, $latex, $dvipng, $tex, $targetPath);
987 #rmtree($wd, 0, 0);
988 #if (-e $targetPath) {
989 # return "<img src=\"$targetURL\" alt=\"$tex\" />";
990 #} else {
991 # return "<b>[math2img failed]</b>";
992 #}
993 $imgGen->add($answerResult->{preview_latex_string}); 1026 $imgGen->add($answerResult->{preview_latex_string});
994
995 } 1027 }
996} 1028}
997
998##### logging subroutine ####
999
1000
1001 1029
1002##### permission queries ##### 1030##### permission queries #####
1003 1031
1004# this stuff should be abstracted out into the permissions system 1032# this stuff should be abstracted out into the permissions system
1005# however, the permission system only knows about things in the 1033# however, the permission system only knows about things in the
1006# course environment and the username. hmmm... 1034# course environment and the username. hmmm...
1007 1035
1008# also, i should fix these so that they have a consistent calling 1036# also, i should fix these so that they have a consistent calling
1009# format -- perhaps: 1037# format -- perhaps:
1010# canPERM($courseEnv, $user, $set, $problem, $permissionLevel) 1038# canPERM($ce, $user, $set, $problem, $permissionLevel)
1011 1039
1012sub canShowCorrectAnswers($$) { 1040sub canShowCorrectAnswers($$) {
1013 my ($permissionLevel, $answerDate) = @_; 1041 my ($permissionLevel, $answerDate) = @_;
1014 return $permissionLevel > 0 || time > $answerDate; 1042 return $permissionLevel > 0 || time > $answerDate;
1015} 1043}
… …
1039sub mustRecordAnswers($) { 1067sub mustRecordAnswers($) {
1040 my ($permissionLevel) = @_; 1068 my ($permissionLevel) = @_;
1041 return $permissionLevel == 0; 1069 return $permissionLevel == 0;
1042} 1070}
1043 1071
1072
1073sub submiterror {
1074 my $self = shift;
1075 my $submiterror = (defined($self->{submiterror}) ) ? $self->{submiterror} : '';
1076 $submiterror;
1077}
10441; 10781;
Legend:
Removed from v.1776  
changed lines
  Added in v.1980
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9