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

View of /trunk/pg/macros/PGtextevaluators.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6058 - (download) (as text) (annotate)
Thu Jun 25 23:28:44 2009 UTC (10 years, 6 months ago) by gage
File size: 11658 byte(s)
syncing pg HEAD with pg2.4.7 on 6/25/2009

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader$
    5 #
    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
    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.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 =head1 NAME
   18 
   19 PGtextevaluators.pl - Macros that generate answer evaluators that handle
   20 questionnaires.
   21 
   22 =head1 SYNOPSIS
   23 
   24   BEGIN_TEXT
   25   WeBWorK is great.
   26   \{ ans_radio_buttons(1=>"Agree",2=>"Disagree") \}
   27   $PAR
   28   If you disagree, why?
   29   \{ ans_rule() \}
   30   END_TEXT
   31 
   32   ANS(ansradio(1));
   33   ANS(anstext(2));
   34 
   35   # FIXME show how to make a grader that sends email here!
   36 
   37 =head1 DESCRIPTION
   38 
   39 This file contians macros for handling questionnaires. Questionnaires can
   40 consist of textual answers and radio buttons, and responses are reported
   41 via email.
   42 
   43 =cut
   44 
   45 BEGIN { be_strict() }
   46 
   47 # Until we get the PG cacheing business sorted out, we need to use
   48 # PG_restricted_eval to get the correct values for some(?) PG environment
   49 # variables. We do this once here and place the values in lexicals for later
   50 # access.
   51 my $BR;
   52 my $PAR;
   53 my $QUESTIONNAIRE_ANSWERS;
   54 my $rh_envir;
   55 sub _PGtextevaluators_init {
   56   $BR                    = PG_restricted_eval(q/$BR/);
   57   $PAR                   = PG_restricted_eval(q/$PAR/);
   58   $QUESTIONNAIRE_ANSWERS = '';
   59   $rh_envir              = PG_restricted_eval(q/\%envir/);
   60 }
   61 
   62 =head1 ANSWER EVALUATORS
   63 
   64 =cut
   65 
   66 # these next three subroutines show how to modify the "store_ans_at()" answer
   67 # evaluator to add extra information before storing the info
   68 # They provide a good model for how to tweak answer evaluators in special cases.
   69 
   70 =head2 anstext
   71 
   72   ANS(anstext($num))
   73 
   74 anstext() returns an answer evaluator which records the student's answer to a
   75 free-response question in the variable $QUESTIONNAIRE_ANSWERS for later
   76 retrieval. A header is added to the answer before it is added. The header format
   77 is:
   78 
   79   "\n${setNumber}_${courseName}_$psvnNumber-Problem-$probNum-Question-$num:\n"
   80 
   81 Where $num is the argument passed to anstext().
   82 
   83 To send the accumulated answers to the instructor via email, use
   84 mail_answers_to2().
   85 
   86 =cut
   87 
   88 sub anstext {
   89   my $num = shift;
   90   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
   91   my $psvnNumber  = PG_restricted_eval(q!$main::psvnNumber!);
   92   my $probNum     = PG_restricted_eval(q!$main::probNum!);
   93   my $courseName  = PG_restricted_eval(q!$main::courseName!);
   94   my $setNumber     = PG_restricted_eval(q!$main::setNumber!);
   95 
   96   my $ans_eval    = sub {
   97          my $text = shift;
   98          $text = '' unless defined($text);
   99          my $new_text = "\n${setNumber}_${courseName}_$psvnNumber-Problem-$probNum-Question-$num:\n $text "; #  modify entered text
  100          my $out = &$ans_eval_template($new_text);       # standard evaluator
  101          #warn "$QUESTIONNAIRE_ANSWERS";
  102          $out->{student_ans} = escapeHTML($text);  #  restore original entered text
  103          $out->{correct_ans} = "Question  $num answered";
  104          $out->{original_student_ans} = escapeHTML($text);
  105          $out;
  106     };
  107    $ans_eval;
  108 }
  109 
  110 =head2 anstext
  111 
  112   ANS(anstext_non_anonymous($num))
  113 
  114 anstext_non_anonymous() works like anstext(), except that the header added to the
  115 student's answer includes personally identifying information:
  116 
  117   \n$psvnNumber-Problem-$probNum-Question-$num:\n
  118   $studentLogin $studentID $studentName\n
  119 
  120 Where $num is the argument passed to anstext_non_anonymous().
  121 
  122 =cut
  123 
  124 sub anstext_non_anonymous {
  125   ## this emails identifying information
  126   my $num          = shift;
  127     my $psvnNumber   = PG_restricted_eval(q!$main::psvnNumber!);
  128   my $probNum      = PG_restricted_eval(q!$main::probNum!);
  129     my $studentLogin = PG_restricted_eval(q!$main::studentLogin!);
  130   my $studentID    = PG_restricted_eval(q!$main::studentID!);
  131     my $studentName  = PG_restricted_eval(q!$main::studentName!);
  132 
  133 
  134   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
  135   my $ans_eval = sub {
  136          my $text = shift;
  137          $text = '' unless defined($text);
  138          my $new_text = "\n$psvnNumber-Problem-$probNum-Question-$num:\n$studentLogin $main::studentID $studentName\n$text "; # modify entered text
  139          my $out = &$ans_eval_template($new_text);       # standard evaluator
  140          #warn "$QUESTIONNAIRE_ANSWERS";
  141          $out->{student_ans} = escapeHTML($text);  #  restore original entered text
  142          $out->{correct_ans} = "Question  $num answered";
  143          $out->{original_student_ans} = escapeHTML($text);
  144          $out;
  145     };
  146    $ans_eval;
  147 }
  148 
  149 =head2 ansradio
  150 
  151   ANS(ansradio($num))
  152 
  153 ansradio() returns an answer evaluator which records the student's answer to a
  154 multiple-choice question in the variable $QUESTIONNAIRE_ANSWERS for later
  155 retrieval. A header is added to the answer before it is added. The header format
  156 is:
  157 
  158   "\n$psvnNumber-Problem-$probNum-RADIO-$num:\n"
  159 
  160 Where $num is the question number passed to ansradio().
  161 
  162 To send the accumulated answers to the instructor via email, use
  163 mail_answers_to2().
  164 
  165 =cut
  166 
  167 sub ansradio {
  168   my $num = shift;
  169   my $psvnNumber  = PG_restricted_eval(q!$main::psvnNumber!);
  170   my $probNum  = PG_restricted_eval(q!$main::probNum!);
  171 
  172   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
  173   my $ans_eval = sub {
  174          my $text = shift;
  175          $text = '' unless defined($text);
  176          my $new_text = "\n$psvnNumber-Problem-$probNum-RADIO-$num:\n $text ";       # modify entered text
  177          my $out = $ans_eval_template->($new_text);       # standard evaluator
  178          $out->{student_ans} =escapeHTML($text);  # restore original entered text
  179          $out->{original_student_ans} = escapeHTML($text);
  180          $out;
  181    };
  182 
  183    $ans_eval;
  184 }
  185 
  186 =head2 store_ans_at
  187 
  188   $answer = "";
  189   ANS(store_ans_at(\$answer));
  190   TEXT("Stored answer: '$answer');
  191 
  192 Generates an answer evaluator which appends the student's answer to a scalar
  193 variable. In addition, the score for the answer is always set to 1. This macro
  194 is used internally by anstext(), anstest_non_anonymous(), and ans_radio().
  195 
  196 =cut
  197 
  198 sub store_ans_at {
  199   my $answerStringRef = shift;
  200   my %options = @_;
  201   my $ans_eval= '';
  202   if ( ref($answerStringRef) eq 'SCALAR' ) {
  203     $ans_eval= sub {
  204       my $text = shift;
  205       $text = '' unless defined($text);
  206       $$answerStringRef = $$answerStringRef  . $text;
  207       my $ans_hash = new AnswerHash(
  208                'score'      =>  1,
  209                'correct_ans'      =>  '',
  210                'student_ans'      =>  $text,
  211                'ans_message'      =>  '',
  212                'type'       =>  'store_ans_at',
  213                'original_student_ans'   =>  $text,
  214                'preview_text_string'    =>  ''
  215       );
  216 
  217     return $ans_hash;
  218     };
  219   }
  220   else {
  221     die "Syntax error: \n The argument to store_ans_at() must be a pointer to a scalar.\n(e.g.  store_ans_at(~~\$MSG) )\n\n";
  222   }
  223 
  224   return $ans_eval;
  225 }
  226 
  227 =head2 [DEPRECATED] mail_answers_to
  228 
  229   ANS(mail_answers_to($to_address))
  230 
  231 Returns an answer evaluator which accepts the last answer and then mails the
  232 answer to $to_address. It is unsupported and may not even work.
  233 
  234 Use a normal textans() answer evaluator and mail_answers_to2() instead.
  235 
  236 =cut
  237 
  238 #  This is another example of how to modify an  answer evaluator to obtain
  239 #  the desired behavior in a special case.  Here the object is to have
  240 #  have the last answer trigger the send_mail_to subroutine which mails
  241 #  all of the answers to the designated address.
  242 #  (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.)
  243 
  244 # Fix me?? why is the body hard wired to the string QUESTIONNAIRE_ANSWERS?
  245 
  246 sub mail_answers_to {  #accepts the last answer and mails off the result
  247   my $user_address = shift;
  248   my $ans_eval = sub {
  249 
  250     # then mail out all of the answers, including this last one.
  251 
  252     # this is the old mechanism for sending mail (via IO.pl)
  253     #send_mail_to(  $user_address,
  254     #     'subject'       =>  "$main::courseName WeBWorK questionnaire",
  255     #     'body'          =>  $QUESTIONNAIRE_ANSWERS,
  256     #     'ALLOW_MAIL_TO'   =>  $rh_envir->{ALLOW_MAIL_TO}
  257     #);
  258 
  259     # DelayedMailer is the new method (for now)
  260     $rh_envir->{mailer}->add_message(
  261       to => $user_address,
  262       subject => "$main::courseName WeBWorK questionnaire",
  263       msg => $QUESTIONNAIRE_ANSWERS,
  264     );
  265 
  266     my $ans_hash = new AnswerHash(  'score'   =>  1,
  267             'correct_ans' =>  '',
  268             'student_ans' =>  'Answer recorded',
  269             'ans_message' =>  '',
  270             'type'    =>  'send_mail_to',
  271     );
  272 
  273     return $ans_hash;
  274   };
  275 
  276   return $ans_eval;
  277 }
  278 
  279 =head2 [DEPRECATED] save_answer_to_file
  280 
  281 Returns an answer evaluator which accepts the last answer and then stores the
  282 answer to a file. It is unsupported and may not even work.
  283 
  284 =cut
  285 
  286 sub save_answer_to_file {  #accepts the last answer and mails off the result
  287   my $fileID = shift;
  288   my $ans_eval = new AnswerEvaluator;
  289   $ans_eval->install_evaluator(
  290       sub {
  291          my $rh_ans = shift;
  292 
  293              unless ( defined( $rh_ans->{student_ans} ) ) {
  294               $rh_ans->throw_error("save_answers_to_file","{student_ans} field not defined");
  295               return $rh_ans;
  296             }
  297 
  298         my $error;
  299         my $string = '';
  300         $string = qq![[<$main::studentLogin> $main::studentName /!. time() . qq!/]]\n!.
  301           $rh_ans->{student_ans}. qq!\n\n============================\n\n!;
  302 
  303         if ($error = AnswerIO::saveAnswerToFile('preflight',$string) ) {
  304           $rh_ans->throw_error("save_answers_to_file","Error:  $error");
  305         } else {
  306           $rh_ans->{'student_ans'} = 'Answer saved';
  307           $rh_ans->{'score'} = 1;
  308         }
  309         $rh_ans;
  310       }
  311   );
  312 
  313   return $ans_eval;
  314 }
  315 
  316 =head1 OTHER MACROS
  317 
  318 =head2 mail_answers_to2
  319 
  320   mail_answers_to2($to, $subject);
  321 
  322 Sends the text accumulated in $QUESTIONNAIRE_ANSWERS to the address specified in
  323 $to. The email is given the subject line $subject.
  324 
  325 The mail message is not sent right away; instead, the message is recorded and
  326 sent by WeBWorK after PG rendering has completed.
  327 
  328 =cut
  329 
  330 sub mail_answers_to2 {
  331   my ($to, $subject, $ra_allow_mail_to) = @_;
  332 
  333   $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject;
  334   warn "The third argument (ra_allow_mail_to) to mail_answers_to2() is ignored. The list of allowed addresses is fixed."
  335     if defined $ra_allow_mail_to;
  336 
  337   $rh_envir->{mailer}->add_message(
  338     to => $to,
  339     subject => $subject,
  340     msg => $QUESTIONNAIRE_ANSWERS,
  341   );
  342 
  343   return;
  344 }
  345 
  346 =head2 escapeHTML
  347 
  348   escapeHTML($string)
  349 
  350 The misnamed macro returns a copy of $string in which each newline has been replaced with
  351 an HTML BR element.
  352 
  353 =cut
  354 
  355 sub escapeHTML {
  356   my $string = shift;
  357   $string =~ s/\n/$BR/ge;
  358   $string;
  359 }
  360 
  361 =head2 [DEPRECATED] save_questionnaire_answers_to
  362 
  363 =cut
  364 
  365 sub save_questionnaire_answers_to {
  366   my $fileName =shift;
  367   SaveFile::printAnswerFile($fileName,[$QUESTIONNAIRE_ANSWERS]);
  368 }
  369 
  370 #### subroutines used in producing a questionnaire
  371 #### these are at least good models for other answers of this type
  372 
  373 # my $QUESTIONNAIRE_ANSWERS=''; #  stores the answers until it is time to send them
  374        #  this must be initialized before the answer evaluators are run
  375        #  but that happens long after all of the text in the problem is
  376        #  evaluated.
  377 # this is a utility script for cleaning up the answer output for display in
  378 #the answers.
  379 
  380 =head2 [DEPRECATED] DUMMY_ANSWER
  381 
  382 =cut
  383 
  384 sub DUMMY_ANSWER {
  385   my $num = shift;
  386   qq{<INPUT TYPE="HIDDEN" NAME="answer$num" VALUE="">}
  387 }
  388 
  389 =head1 SEE ALSO
  390 
  391 L<PGanswermacros.pl>, L<MathObjects>.
  392 
  393 =cut
  394 
  395 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9