[system] / trunk / pg / macros / PGanswermacros.pl Repository:
ViewVC logotype

Diff of /trunk/pg/macros/PGanswermacros.pl

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

Revision 1070 Revision 1071
1953 return $filteredAnswer; 1953 return $filteredAnswer;
1954} 1954}
1955 1955
1956sub ignore_case { 1956sub ignore_case {
1957 my $filteredAnswer = shift; 1957 my $filteredAnswer = shift;
1958
1959 $filteredAnswer = uc $filteredAnswer; 1958 #warn "filtered answer is ", $filteredAnswer;
1959 #$filteredAnswer = uc $filteredAnswer; # this didn't work on webwork xmlrpc, but does elsewhere ????
1960 $filteredAnswer =~ tr/a-z/A-Z/;
1960 1961
1961 return $filteredAnswer; 1962 return $filteredAnswer;
1962} 1963}
1963 1964
1964sub ignore_order { 1965sub ignore_order {
2295 2296
2296# added 6/14/2000 by David Etlinger 2297# added 6/14/2000 by David Etlinger
2297# because of the conversion of the answer 2298# because of the conversion of the answer
2298# string to an array, I thought it better not 2299# string to an array, I thought it better not
2299# to force STR_CMP() to work with this 2300# to force STR_CMP() to work with this
2301
2302#added 2/26/2003 by Mike Gage
2303# handled the case where multiple answers are passed as an array reference
2304# rather than as a \0 delimited string.
2300sub checkbox_cmp { 2305sub checkbox_cmp {
2301 my $correctAnswer = shift @_; 2306 my $correctAnswer = shift @_;
2302 $correctAnswer = str_filters( $correctAnswer, 'ignore_order' ); 2307 $correctAnswer = str_filters( $correctAnswer, 'ignore_order' );
2303 2308
2304 my $answer_evaluator = sub { 2309 my $answer_evaluator = sub {
2305 my $in = shift @_; 2310 my $in = shift @_;
2306 $in = '' unless defined $in; #in case no boxes checked 2311 $in = '' unless defined $in; #in case no boxes checked
2307 2312 # multiple answers could come in two forms
2313 # either a \0 delimited string or
2314 # an array reference. We handle both.
2315 if (ref($in) eq 'ARRAY') {
2316 $in = join("",@{$in}); # convert array to single no-delimiter string
2317 } else {
2308 my @temp = split( "\0", $in ); #convert "\0"-delimited string to array... 2318 my @temp = split( "\0", $in ); #convert "\0"-delimited string to array...
2309 $in = join( "", @temp ); #and then to a single no-delimiter string 2319 $in = join( "", @temp ); #and then to a single no-delimiter string
2310 2320 }
2311 my $original_student_ans = $in; #well, almost original 2321 my $original_student_ans = $in; #well, almost original
2312 $in = str_filters( $in, 'ignore_order' ); 2322 $in = str_filters( $in, 'ignore_order' );
2313 2323
2314 my $correctQ = ($in eq $correctAnswer) ? 1: 0; 2324 my $correctQ = ($in eq $correctAnswer) ? 1: 0;
2315 2325
2316 my $ans_hash = new AnswerHash( 2326 my $ans_hash = new AnswerHash(
2317 'score' => $correctQ, 2327 'score' => $correctQ,
2318 'correct_ans' => $correctAnswer, 2328 'correct_ans' => "$correctAnswer",
2319 'student_ans' => $in, 2329 'student_ans' => $in,
2320 'ans_message' => "", 2330 'ans_message' => "",
2321 'type' => "checkbox_cmp", 2331 'type' => "checkbox_cmp",
2322 'preview_text_string' => $in, 2332 'preview_text_string' => $in,
2323 'original_student_ans' => $original_student_ans 2333 'original_student_ans' => $original_student_ans
2449# the desired behavior in a special case. Here the object is to have 2459# the desired behavior in a special case. Here the object is to have
2450# have the last answer trigger the send_mail_to subroutine which mails 2460# have the last answer trigger the send_mail_to subroutine which mails
2451# all of the answers to the designated address. 2461# all of the answers to the designated address.
2452# (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.) 2462# (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.)
2453 2463
2464# Fix me?? why is the body hard wired to the string QUESTIONNAIRE_ANSWERS?
2465
2454sub mail_answers_to { #accepts the last answer and mails off the result 2466sub mail_answers_to { #accepts the last answer and mails off the result
2455 my $user_address = shift; 2467 my $user_address = shift;
2456 my $ans_eval = sub { 2468 my $ans_eval = sub {
2457 2469
2458 # then mail out all of the answers, including this last one. 2470 # then mail out all of the answers, including this last one.
2473 return $ans_hash; 2485 return $ans_hash;
2474 }; 2486 };
2475 2487
2476 return $ans_eval; 2488 return $ans_eval;
2477} 2489}
2490
2491sub save_answer_to_file { #accepts the last answer and mails off the result
2492 my $fileID = shift;
2493 my $ans_eval = new AnswerEvaluator;
2494 $ans_eval->install_evaluator(
2495 sub {
2496 my $rh_ans = shift;
2497
2498 unless ( defined( $rh_ans->{student_ans} ) ) {
2499 $rh_ans->throw_error("save_answers_to_file","{student_ans} field not defined");
2500 return $rh_ans;
2501 }
2502
2503 my $error;
2504 my $string = '';
2505 $string = qq![[<$main::studentLogin> $main::studentName /!. time() . qq!/]]\n!.
2506 $rh_ans->{student_ans}. qq!\n\n============================\n\n!;
2507
2508 if ($error = AnswerIO::saveAnswerToFile('preflight',$string) ) {
2509 $rh_ans->throw_error("save_answers_to_file","Error: $error");
2510 } else {
2511 $rh_ans->{'student_ans'} = 'Answer saved';
2512 $rh_ans->{'score'} = 1;
2513 }
2514 $rh_ans;
2515 }
2516 );
2517
2518 return $ans_eval;
2519}
2520
2478sub mail_answers_to2 { #accepts the last answer and mails off the result 2521sub mail_answers_to2 { #accepts the last answer and mails off the result
2479 my $user_address = shift; 2522 my $user_address = shift;
2480 my $subject = shift; 2523 my $subject = shift;
2481 $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject; 2524 $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject;
2482 2525

Legend:
Removed from v.1070  
changed lines
  Added in v.1071

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9