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

Diff of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

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

Revision 1841 Revision 1908
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.115 2004/03/04 04:36:08 gage Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.116 2004/03/04 21:05:54 sh002i 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.
… …
64 "problem"; 64 "problem";
65} 65}
66 66
67sub pre_header_initialize { 67sub pre_header_initialize {
68 my ($self) = @_; 68 my ($self) = @_;
69 my $r = $self->{r}; 69 my $r = $self->r;
70 my $ce = $r->ce;
71 my $db = $r->db;
72 my $urlpath = $r->urlpath;
73
70 my $setName = $r->urlpath->arg("setID"); 74 my $setName = $urlpath->arg("setID");
71 my $problemNumber = $r->urlpath->arg("problemID"); 75 my $problemNumber = $r->urlpath->arg("problemID");
72 my $courseEnv = $self->{ce};
73 my $db = $self->{db};
74 my $userName = $r->param('user'); 76 my $userName = $r->param('user');
75 my $effectiveUserName = $r->param('effectiveUser'); 77 my $effectiveUserName = $r->param('effectiveUser');
76 my $key = $r->param('key'); 78 my $key = $r->param('key');
77 79
78 my $user = $db->getUser($userName); # checked 80 my $user = $db->getUser($userName); # checked
79 die "record for user $userName (real user) does not exist." 81 die "record for user $userName (real user) does not exist."
80 unless defined $user; 82 unless defined $user;
81 83
… …
166 $self->{editMode} = $editMode; 168 $self->{editMode} = $editMode;
167 169
168 ##### form processing ##### 170 ##### form processing #####
169 171
170 # 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)
171 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 173 my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode};
172 my $redisplay = $r->param("redisplay"); 174 my $redisplay = $r->param("redisplay");
173 my $submitAnswers = $r->param("submitAnswers"); 175 my $submitAnswers = $r->param("submitAnswers");
174 my $checkAnswers = $r->param("checkAnswers"); 176 my $checkAnswers = $r->param("checkAnswers");
175 my $previewAnswers = $r->param("previewAnswers"); 177 my $previewAnswers = $r->param("previewAnswers");
176 178
177
178 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 179 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
179
180 180
181 $self->{displayMode} = $displayMode; 181 $self->{displayMode} = $displayMode;
182 $self->{redisplay} = $redisplay; 182 $self->{redisplay} = $redisplay;
183 $self->{submitAnswers} = $submitAnswers; 183 $self->{submitAnswers} = $submitAnswers;
184 $self->{checkAnswers} = $checkAnswers; 184 $self->{checkAnswers} = $checkAnswers;
… …
191 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0; 191 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
192 return unless $self->{isOpen}; 192 return unless $self->{isOpen};
193 193
194 # what does the user want to do? 194 # what does the user want to do?
195 my %want = ( 195 my %want = (
196 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 196 showOldAnswers => $r->param("showOldAnswers") || $ce->{pg}->{options}->{showOldAnswers},
197 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 197 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers},
198 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 198 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints},
199 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 199 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions},
200 recordAnswers => $submitAnswers, 200 recordAnswers => $submitAnswers,
201 checkAnswers => $checkAnswers, 201 checkAnswers => $checkAnswers,
202 ); 202 );
203 203
204 # are certain options enforced? 204 # are certain options enforced?
… …
220 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, 220 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
221 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), 221 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
222 # 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
223 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date), 223 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date),
224 ); 224 );
225 ######################################################### 225
226 # more complicated logic for showing check answer button: 226 # more complicated logic for showing check answer button:
227 #########################################################
228 # 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
229 # 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
230 # as someone else (the $user and $effectiveUserName aren't the same). 229 # as someone else (the $user and $effectiveUserName aren't the same).
231 $can{checkAnswers} = ($can{checkAnswers} && not $can{recordAnswers} ) || 230 $can{checkAnswers} = (
232 ( defined($userName) and defined($effectiveUserName) and 231 # $can{recordAnswers} will be false if the due date has passed OR the
233 ($userName ne $effectiveUserName) 232 # student has used up all of her attempts
234 ); 233 ($can{checkAnswers} and not $can{recordAnswers})
235 ######################################################### 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
236 # more complicated logif for showing "submit answer" button 248 # more complicated logif for showing "submit answer" button:
237 #########################################################
238 # 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
239 # 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
240 # 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 );
241 264
242 $can{recordAnswers} = ($can{recordAnswers} and not
243 ( defined($userName) and defined($effectiveUserName) and
244 ($userName ne $effectiveUserName)
245 )
246 );
247 # final values for options 265 # final values for options
248 my %will; 266 my %will;
249 foreach (keys %must) { 267 foreach (keys %must) {
250 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 268 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
251 } 269 }
… …
260 278
261 ##### translation ##### 279 ##### translation #####
262 280
263 $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer); 281 $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer);
264 my $pg = WeBWorK::PG->new( 282 my $pg = WeBWorK::PG->new(
265 $courseEnv, 283 $ce,
266 $effectiveUser, 284 $effectiveUser,
267 $key, 285 $key,
268 $set, 286 $set,
269 $problem, 287 $problem,
270 $set->psvn, # FIXME: this field should be removed 288 $set->psvn, # FIXME: this field should be removed
… …
292 $self->{can} = \%can; 310 $self->{can} = \%can;
293 $self->{will} = \%will; 311 $self->{will} = \%will;
294 $self->{pg} = $pg; 312 $self->{pg} = $pg;
295} 313}
296 314
297#sub if_warnings($$) {
298# my ($self, $arg) = @_;
299# return 0 unless $self->{isOpen};
300# return $self->{pg}->{warnings} ne "";
301#}
302
303sub if_errors($$) { 315sub if_errors($$) {
304 my ($self, $arg) = @_; 316 my ($self, $arg) = @_;
305 return 0 unless $self->{isOpen}; 317
318 if ($self->{isOpen}) {
306 return $self->{pg}->{flags}->{error_flag}; 319 return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg;
320 } else {
321 return !$arg;
322 }
307} 323}
308 324
309sub head { 325sub head {
310 my $self = shift; 326 my ($self) = @_;
327
311 return "" unless $self->{isOpen}; 328 return "" unless $self->{isOpen};
312 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 329 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
313} 330}
314 331
315sub options { 332sub options {
316 my $self = shift; 333 my ($self) = @_;
334
317 return join("", 335 return join("",
318 CGI::start_form("POST", $self->{r}->uri), 336 CGI::start_form("POST", $self->{r}->uri),
319 $self->hidden_authen_fields, 337 $self->hidden_authen_fields,
320 CGI::hr(), 338 CGI::hr(),
321 CGI::start_div({class=>"viewOptions"}), 339 CGI::start_div({class=>"viewOptions"}),
… …
323 CGI::end_div(), 341 CGI::end_div(),
324 CGI::end_form() 342 CGI::end_form()
325 ); 343 );
326} 344}
327 345
328sub path { 346#sub path {
329 my $self = shift; 347# my $self = shift;
330 my $args = $_[-1]; 348# my $args = $_[-1];
331 my $setName = $self->{set}->set_id; 349# my $setName = $self->{set}->set_id;
332 my $problemNumber = $self->{problem}->problem_id; 350# my $problemNumber = $self->{problem}->problem_id;
333 351#
334 my $ce = $self->{ce}; 352# my $ce = $self->{ce};
335 my $root = $ce->{webworkURLs}->{root}; 353# my $root = $ce->{webworkURLs}->{root};
336 my $courseName = $ce->{courseName}; 354# my $courseName = $ce->{courseName};
337 return $self->pathMacro($args, 355# return $self->pathMacro($args,
338 "Home" => "$root", 356# "Home" => "$root",
339 $courseName => "$root/$courseName", 357# $courseName => "$root/$courseName",
340 $setName => "$root/$courseName/$setName", 358# $setName => "$root/$courseName/$setName",
341 "Problem $problemNumber" => "", 359# "Problem $problemNumber" => "",
342 ); 360# );
343} 361#}
344 362
345sub siblings { 363sub siblings {
346 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");
347 my $setName = $self->{set}->set_id; 370 my $setID = $self->{set}->set_id;
348 my $problemNumber = $self->{problem}->problem_id;
349
350 my $ce = $self->{ce};
351 my $db = $self->{db};
352 my $root = $ce->{webworkURLs}->{root};
353 my $courseName = $ce->{courseName};
354 print CGI::strong("Problems"), CGI::br();
355
356 my $effectiveUser = $self->{r}->param("effectiveUser"); 371 my $eUserID = $r->param("effectiveUser");
357 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"}, "Problem Sets");
377 print CGI::start_ul();
378
358 foreach my $problem (sort { $a <=> $b } @problemIDs) { 379 foreach my $problemID (@problemIDs) {
359 print '&nbsp;&nbsp;'.CGI::a({-href=>"$root/$courseName/$setName/".$problem."/?" 380 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem",
360 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}}, 381 courseID => $courseID, setID => $setID, problemID => $problemID);
361 "Problem ".$problem), CGI::br(); 382 print CGI::li(CGI::a({href=>$self->systemLink($problemPage)}, "Problem $problemID"));
362 } 383 }
363 384
385 print CGI::end_ul();
386 print CGI::end_li();
387 print CGI::end_ul();
388
364 return ""; 389 return "";
365} 390}
366 391
367sub nav { 392sub nav {
368 $WeBWorK::timer->continue("begin nav subroutine") if defined($WeBWorK::timer); 393 my ($self, $args) = @_;
369 my $self = shift; 394 my $r = $self->r;
370 my $args = $_[-1]; 395 my $db = $r->db;
396 my $urlpath = $r->urlpath;
397
398 my $courseID = $urlpath->arg("courseID");
371 my $setName = $self->{set}->set_id; 399 my $setID = $self->{set}->set_id;
372 my $problemNumber = $self->{problem}->problem_id; 400 my $problemID = $self->{problem}->problem_id;
373
374 my $ce = $self->{ce};
375 my $db = $self->{db};
376 my $root = $ce->{webworkURLs}->{root};
377 my $courseName = $ce->{courseName};
378
379 my $wwdb = $self->{wwdb};
380 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
381 my $tail = "&displayMode=".$self->{displayMode}; 433 my $tail = "&displayMode=".$self->{displayMode};
382
383 my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList");
384
385 my @problemIDs = $db->listUserProblems($effectiveUser, $setName);
386 my ($prevID, $nextID);
387 foreach my $id (@problemIDs) {
388 $prevID = $id if $id < $problemNumber
389 and (not defined $prevID or $id > $prevID);
390 $nextID = $id if $id > $problemNumber
391 and (not defined $nextID or $id < $nextID);
392 }
393 unshift @links, "Previous Problem" , ($prevID
394 ? "$root/$courseName/$setName/".$prevID
395 : "") , "navPrev";
396 push @links, "Next Problem" , ($nextID
397 ? "$root/$courseName/$setName/".$nextID
398 : "") , "navNext";
399
400 my $result = $self->navMacro($args, $tail, @links); 434 return $self->navMacro($args, $tail, @links);
401 $WeBWorK::timer->continue("end nav subroutine") if defined($WeBWorK::timer);
402 return $result;
403} 435}
404 436
405sub title { 437sub title {
406 my $self = shift; 438 my ($self) = @_;
439
407 my $setName = $self->{set}->set_id; 440 my $setID = $self->{set}->set_id;
408 my $problemNumber = $self->{problem}->problem_id; 441 my $problemID = $self->{problem}->problem_id;
409 442
410 return "$setName : Problem $problemNumber"; 443 return "$setID : $problemID";
411} 444}
412 445
413sub body { 446sub body {
414 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;
415 452
416 return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open."))
417 unless $self->{isOpen}; 453 unless ($self->{isOpen}) {
418 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 }
419 # unpack some useful variables 457 # unpack some useful variables
420 my $r = $self->{r};
421 my $db = $self->{db};
422 my $ce = $self->{ce};
423 my $root = $ce->{webworkURLs}->{root};
424 my $courseName = $ce->{courseName};
425 my $set = $self->{set}; 458 my $set = $self->{set};
426 my $problem = $self->{problem}; 459 my $problem = $self->{problem};
427 my $editMode = $self->{editMode}; 460 my $editMode = $self->{editMode};
428 my $permissionLevel = $self->{permissionLevel}; 461 my $permissionLevel = $self->{permissionLevel};
429 my $submitAnswers = $self->{submitAnswers}; 462 my $submitAnswers = $self->{submitAnswers};
… …
433 my %can = %{ $self->{can} }; 466 my %can = %{ $self->{can} };
434 my %must = %{ $self->{must} }; 467 my %must = %{ $self->{must} };
435 my %will = %{ $self->{will} }; 468 my %will = %{ $self->{will} };
436 my $pg = $self->{pg}; 469 my $pg = $self->{pg};
437 470
438 471 #my $root = $ce->{webworkURLs}->{root};
472 my $courseName = $urlpath->arg("courseID");
439 473
440 #####create Editor link ##### 474 #####create Editor link #####
441 # 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
442 my $editorLinkMessage = ''; 476 #my $editorLinkMessage = '';
443 # 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?
444 if ($self->{permissionLevel}>=10 ) { 478 #if ($self->{permissionLevel}>=10 ) {
445 $editorLinkMessage = CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/". 479 # $editorLinkMessage = CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/".
446 $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');
447 } 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
448 ##### translation errors? ##### 491 ##### translation errors? #####
449 492
450 if ($pg->{flags}->{error_flag}) { 493 if ($pg->{flags}->{error_flag}) {
451 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 "";
452 } 497 }
453 498
454 ##### answer processing ##### 499 ##### answer processing #####
455 $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer); 500 $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer);
456 # if answers were submitted: 501 # if answers were submitted:
… …
463 # store answers in DB for sticky answers 508 # store answers in DB for sticky answers
464 my %answersToStore; 509 my %answersToStore;
465 my %answerHash = %{ $pg->{answers} }; 510 my %answerHash = %{ $pg->{answers} };
466 $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!!
467 foreach (keys %answerHash); 512 foreach (keys %answerHash);
513
468 # 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
469 # 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
470 # 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.
471 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}}; 517 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}};
472
473 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names); 518 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names);
474 519
475 # 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
476 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names); 521 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names);
477 my $answerString = encodeAnswers(%answersToStore, 522 my $answerString = encodeAnswers(%answersToStore,
… …
701 print CGI::endform(); 746 print CGI::endform();
702 747
703 748
704 print CGI::start_div({class=>"problemFooter"}); 749 print CGI::start_div({class=>"problemFooter"});
705 750
706 # arguments for answer inspection button 751 ## arguments for answer inspection button
707 my $prof_url = $ce->{webworkURLs}->{oldProf}; 752 #my $prof_url = $ce->{webworkURLs}->{oldProf};
708 my $webworkURL = $ce->{webworkURLs}->{root}; 753 #my $webworkURL = $ce->{webworkURLs}->{root};
709 my $cgi_url = $prof_url; 754 #my $cgi_url = $prof_url;
710 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl 755 #$cgi_url=~ s|/[^/]*$||; # clip profLogin.pl
711 my $authen_args = $self->url_authen_args(); 756 #my $authen_args = $self->url_authen_args();
712 my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; 757 #my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/";
713 758
759 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers",
760 courseID => $courseName);
761 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action
762
714 # print answer inspection button 763 # print answer inspection button
715 if ($self->{permissionLevel} > 0) { 764 if ($self->{permissionLevel} > 0) {
716 print "\n", 765 print "\n",
717 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", 766 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n",
718 $self->hidden_authen_fields,"\n", 767 $self->hidden_authen_fields,"\n",
… …
724 CGI::submit(-name => 'action', -value=>'Show Past Answers') 773 CGI::submit(-name => 'action', -value=>'Show Past Answers')
725 ), "\n", 774 ), "\n",
726 CGI::endform(); 775 CGI::endform();
727 } 776 }
728 777
729 #print CGI::end_div(); 778 ## arguments for feedback form
779 #my $feedbackURL = "$root/$courseName/feedback/";
730 # 780 #
731 #print CGI::start_div(); 781 ##print feedback form
732 782 #print
733 # arguments for feedback form 783 # CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
734 my $feedbackURL = "$root/$courseName/feedback/"; 784 # $self->hidden_authen_fields,"\n",
785 # CGI::hidden("module", __PACKAGE__),"\n",
786 # CGI::hidden("set", $set->set_id),"\n",
787 # CGI::hidden("problem", $problem->problem_id),"\n",
788 # CGI::hidden("displayMode", $self->{displayMode}),"\n",
789 # CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n",
790 # CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n",
791 # CGI::hidden("showHints", $will{showHints}),"\n",
792 # CGI::hidden("showSolutions", $will{showSolutions}),"\n",
793 # CGI::p({-align=>"left"},
794 # CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")
795 # ),
796 # CGI::endform(),"\n";
797
798 # feedback form url
799 my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback",
800 courseID => $courseName);
801 my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action
735 802
736 #print feedback form 803 #print feedback form
737 print 804 print
738 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 805 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
739 $self->hidden_authen_fields,"\n", 806 $self->hidden_authen_fields,"\n",
… …
747 CGI::hidden("showSolutions", $will{showSolutions}),"\n", 814 CGI::hidden("showSolutions", $will{showSolutions}),"\n",
748 CGI::p({-align=>"left"}, 815 CGI::p({-align=>"left"},
749 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 816 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")
750 ), 817 ),
751 CGI::endform(),"\n"; 818 CGI::endform(),"\n";
752 819
753 # FIXME print editor link 820 # FIXME print editor link
754 print $editorLinkMessage; #empty unless it is appropriate to have an editor link. 821 print $editorLink; #empty unless it is appropriate to have an editor link.
755 822
756 print CGI::end_div(); 823 print CGI::end_div();
757 824
758 # warning output 825 # warning output
759 #if ($pg->{warnings} ne "") { 826 #if ($pg->{warnings} ne "") {
… …
780 return ""; 847 return "";
781} 848}
782 849
783##### output utilities ##### 850##### output utilities #####
784 851
785sub attemptResults($$$$$$) { 852sub attemptResults {
786 my $self = shift; 853 my $self = shift;
787 my $pg = shift; 854 my $pg = shift;
788 my $showAttemptAnswers = shift; 855 my $showAttemptAnswers = shift;
789 my $showCorrectAnswers = shift; 856 my $showCorrectAnswers = shift;
790 my $showAttemptResults = $showAttemptAnswers && shift; 857 my $showAttemptResults = $showAttemptAnswers && shift;
791 my $showSummary = shift; 858 my $showSummary = shift;
792 my $showAttemptPreview = shift || 0; 859 my $showAttemptPreview = shift || 0;
860
793 my $ce = $self->{ce}; 861 my $ce = $self->r->ce;
862
794 my $problemResult = $pg->{result}; # the overall result of the problem 863 my $problemResult = $pg->{result}; # the overall result of the problem
795 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 864 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
796 865
797 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 866 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
798 867
… …
833 # of the answer names is changeable. this only fixes it for "AnSwEr" 902 # of the answer names is changeable. this only fixes it for "AnSwEr"
834 #$name =~ s/^AnSwEr//; 903 #$name =~ s/^AnSwEr//;
835 904
836 my $row; 905 my $row;
837 #$row .= CGI::td($name); 906 #$row .= CGI::td($name);
838 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : ""; 907 $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : "";
839 $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : ""; 908 $row .= $showAttemptPreview ? CGI::td($self->nbsp($preview)) : "";
840 $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : ""; 909 $row .= $showCorrectAnswers ? CGI::td($self->nbsp($correctAnswer)) : "";
841 $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : ""; 910 $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : "";
842 $row .= $showMessages ? CGI::td(nbsp($answerMessage)) : ""; 911 $row .= $showMessages ? CGI::td($self->nbsp($answerMessage)) : "";
843 push @tableRows, $row; 912 push @tableRows, $row;
844 } 913 }
845 914
846 # render equation images 915 # render equation images
847 $imgGen->render(refresh => 1); 916 $imgGen->render(refresh => 1);
… …
863 $summary .= "All of the above answers are correct."; 932 $summary .= "All of the above answers are correct.";
864 } else { 933 } else {
865 $summary .= "At least one of the above answers is NOT correct."; 934 $summary .= "At least one of the above answers is NOT correct.";
866 } 935 }
867 } 936 }
868 #FIXME there must be a better way to force refresh. 937
869 #my $refresh_warning = 'Hold down shift and click "refresh" or "reload" to update answer preview images.';
870 #return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) .
871 #CGI::div({style=>'color:red; font-size:10pt'},$refresh_warning) .
872 #($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
873 # ... this has been fixed by equation caching.
874 return 938 return
875 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) 939 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
876 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 940 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
877} 941}
942
878sub nbsp { 943#sub nbsp {
879 my $str = shift; 944# my $str = shift;
880 ($str =~/\S/) ? $str : '&nbsp;' ; # returns non-breaking space for empty strings 945# ($str =~/\S/) ? $str : '&nbsp;' ; # returns non-breaking space for empty strings
881 # tricky cases: $str =0; 946# # tricky cases: $str =0;
882 # $str is a complex number 947# # $str is a complex number
883} 948#}
949
884sub viewOptions($) { 950sub viewOptions {
885 my $self = shift; 951 my ($self) = @_;
952
886 my $displayMode = $self->{displayMode}; 953 my $displayMode = $self->{displayMode};
887 my %must = %{ $self->{must} }; 954 my %must = %{ $self->{must} };
888 my %can = %{ $self->{can} }; 955 my %can = %{ $self->{can} };
889 my %will = %{ $self->{will} }; 956 my %will = %{ $self->{will} };
890 957
… …
915 $optionLine, 982 $optionLine,
916 CGI::submit(-name=>"redisplay", -label=>"Save Options"), 983 CGI::submit(-name=>"redisplay", -label=>"Save Options"),
917 ); 984 );
918} 985}
919 986
920sub previewAnswer($$) { 987sub previewAnswer {
921 my ($self, $answerResult, $imgGen) = @_; 988 my ($self, $answerResult, $imgGen) = @_;
922 my $ce = $self->{ce}; 989 my $ce = $self->r->ce;
923 my $effectiveUser = $self->{effectiveUser}; 990 my $effectiveUser = $self->{effectiveUser};
924 my $set = $self->{set}; 991 my $set = $self->{set};
925 my $problem = $self->{problem}; 992 my $problem = $self->{problem};
926 my $displayMode = $self->{displayMode}; 993 my $displayMode = $self->{displayMode};
927 994
… …
947 if ($?) { 1014 if ($?) {
948 return "<b>[tth failed: $? $@]</b>"; 1015 return "<b>[tth failed: $? $@]</b>";
949 } 1016 }
950 return $result; 1017 return $result;
951 } elsif ($displayMode eq "images") { 1018 } elsif ($displayMode eq "images") {
952 ## how are we going to name this?
953 #my $targetPathCommon = "/m2i/"
954 # . $effectiveUser->user_id . "."
955 # . $set->set_id . "."
956 # . $problem->problem_id . "."
957 # . $answerResult->{ans_name} . ".png";
958 #
959 ## figure out where to put things
960 #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng");
961 #my $latex = $ce->{externalPrograms}->{latex};
962 #my $dvipng = $ce->{externalPrograms}->{dvipng};
963 #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
964 # # should use surePathToTmpFile, but we have to
965 # # isolate it from the problem enivronment first
966 #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
967 #
968 ## call dvipng to generate a preview
969 #dvipng($wd, $latex, $dvipng, $tex, $targetPath);
970 #rmtree($wd, 0, 0);
971 #if (-e $targetPath) {
972 # return "<img src=\"$targetURL\" alt=\"$tex\" />";
973 #} else {
974 # return "<b>[math2img failed]</b>";
975 #}
976 $imgGen->add($answerResult->{preview_latex_string}); 1019 $imgGen->add($answerResult->{preview_latex_string});
977
978 } 1020 }
979} 1021}
980
981##### logging subroutine ####
982
983
984 1022
985##### permission queries ##### 1023##### permission queries #####
986 1024
987# this stuff should be abstracted out into the permissions system 1025# this stuff should be abstracted out into the permissions system
988# however, the permission system only knows about things in the 1026# however, the permission system only knows about things in the
989# course environment and the username. hmmm... 1027# course environment and the username. hmmm...
990 1028
991# also, i should fix these so that they have a consistent calling 1029# also, i should fix these so that they have a consistent calling
992# format -- perhaps: 1030# format -- perhaps:
993# canPERM($courseEnv, $user, $set, $problem, $permissionLevel) 1031# canPERM($ce, $user, $set, $problem, $permissionLevel)
994 1032
995sub canShowCorrectAnswers($$) { 1033sub canShowCorrectAnswers($$) {
996 my ($permissionLevel, $answerDate) = @_; 1034 my ($permissionLevel, $answerDate) = @_;
997 return $permissionLevel > 0 || time > $answerDate; 1035 return $permissionLevel > 0 || time > $answerDate;
998} 1036}
Legend:
Removed from v.1841  
changed lines
  Added in v.1908
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9