Annotation of loncom/homework/optionresponse.pm, revision 1.27

1.22      albertel    1: # The LearningOnline Network with CAPA
                      2: # option list style responses
1.27    ! albertel    3: #
        !             4: # $Id: gplheader.pl,v 1.1 2001/11/29 18:19:27 www Exp $
        !             5: #
        !             6: # Copyright Michigan State University Board of Trustees
        !             7: #
        !             8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
        !             9: #
        !            10: # LON-CAPA is free software; you can redistribute it and/or modify
        !            11: # it under the terms of the GNU General Public License as published by
        !            12: # the Free Software Foundation; either version 2 of the License, or
        !            13: # (at your option) any later version.
        !            14: #
        !            15: # LON-CAPA is distributed in the hope that it will be useful,
        !            16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            18: # GNU General Public License for more details.
        !            19: #
        !            20: # You should have received a copy of the GNU General Public License
        !            21: # along with LON-CAPA; if not, write to the Free Software
        !            22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
        !            23: #
        !            24: # /home/httpd/html/adm/gpl.txt
        !            25: #
        !            26: # http://www.lon-capa.org/
        !            27: #
1.22      albertel   28: # 2/21 Guy
1.1       albertel   29: package Apache::optionresponse;
                     30: use strict;
1.6       albertel   31: use Apache::response;
1.1       albertel   32: 
                     33: sub BEGIN {
                     34:   &Apache::lonxml::register('Apache::optionresponse',('optionresponse'));
                     35: }
                     36: 
                     37: sub start_optionresponse {
1.22      albertel   38:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                     39:   my $result='';
                     40:   #when in a radiobutton response use these
                     41:   &Apache::lonxml::register('Apache::optionresponse',('foilgroup','foil','conceptgroup'));
                     42:   push (@Apache::lonxml::namespace,'optionresponse');
                     43:   my $id = &Apache::response::start_response($parstack,$safeeval);
                     44:   if ($target eq 'edit') {
1.23      albertel   45:     $result.=&Apache::edit::start_table($token).
                     46:       "<tr><td>Multiple Option Response Question</td><td>Delete:".
                     47: 	&Apache::edit::deletelist($target,$token)
                     48: 	  ."</td><td>&nbsp;</td></tr><tr><td colspan=\"3\">\n";
                     49:     $result.=&Apache::edit::text_arg('Max Number Of Foils:','max',$token,'4').
                     50:       "</td></tr>";
1.22      albertel   51:     $result.="<tr><td colspan=\"3\">\n";
                     52:   }
                     53:   if ($target eq 'modified') {
1.23      albertel   54:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,
                     55: 						 $safeeval,'max');
1.22      albertel   56:     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
1.23      albertel   57:   }
                     58:   if ($target eq 'meta') {
                     59:     $result=&Apache::response::meta_package_write('optionresponse');
1.22      albertel   60:   }
                     61:   return $result;
1.1       albertel   62: }
                     63: 
                     64: sub end_optionresponse {
1.22      albertel   65:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                     66:   &Apache::response::end_response;
                     67:   pop @Apache::lonxml::namespace;
                     68:   my $result;
                     69:   if ($target eq 'edit') { $result=&Apache::edit::end_table(); }
                     70:   return $result;
1.1       albertel   71: }
                     72: 
1.22      albertel   73: %Apache::response::foilgroup={};
1.1       albertel   74: sub start_foilgroup {
1.22      albertel   75:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                     76: 
                     77:   my $result='';
                     78:   %Apache::response::foilgroup={};
                     79:   $Apache::optionresponse::conceptgroup=0;
                     80:   &Apache::response::setrandomnumber();
                     81:   if ($target eq 'edit') {
                     82:     my $optionlist="<option></option>\n";
                     83:     my $option;
                     84:     my @opt;
                     85:     eval '@opt ='. &Apache::lonxml::get_param('options',$parstack,$safeeval);
                     86:     my $count=1;
                     87:     foreach $option (@opt) {
                     88:       $optionlist.="<option value=\"$count\">$option</option>\n";
                     89:       $count++;
                     90:     }
                     91:     my $insertlist=&Apache::edit::insertlist($target,$token);
                     92:     $result.=&Apache::edit::start_table($token);
                     93:     $result.= (<<ENDTABLE);
                     94:       <tr><td>Select Options</td>
1.13      albertel   95:         <td>
                     96: 	  Add new Option: <input type="text" name="$Apache::lonxml::curdepth.options" />
                     97:         </td>
                     98:         <td>Delete an Option:
                     99: 	  <select name="$Apache::lonxml::curdepth.deleteopt">$optionlist</select>
                    100:         </td>
                    101:      </tr>
                    102:      <tr><td colspan="3">$insertlist<br />
                    103: ENDTABLE
1.22      albertel  104:   }
                    105:   if ($target eq 'modified') {
                    106:     my @options;
                    107:     my $optchanged=0;
                    108:     eval '@options ='.&Apache::lonxml::get_param('options',$parstack,$safeeval);
                    109:     if ($ENV{"form.$Apache::lonxml::curdepth.deleteopt"}) {
                    110:       my $delopt=$ENV{"form.$Apache::lonxml::curdepth.deleteopt"};
                    111:       &Apache::lonxml::debug("Deleting :$delopt:");
                    112:       splice(@options,$delopt-1,1);
                    113:       $optchanged=1;
                    114:     }
                    115:     if ($ENV{"form.$Apache::lonxml::curdepth.options"}) {
                    116:       my $newopt = $ENV{"form.$Apache::lonxml::curdepth.options"};
                    117:       if ($options[0]) {
                    118: 	push(@options,$newopt);
                    119:       } else {
                    120: 	$options[0]=$newopt;
                    121:       }
                    122:       $optchanged=1;
                    123:     }
                    124:     if ($optchanged) {
                    125:       $result = "<foilgroup options=\"(";
                    126:       foreach my $option (@options) {
                    127: 	$option=~s/\'/\\\'/;
                    128: 	&Apache::lonxml::debug("adding option :$option:");
                    129: 	$result .="'".$option."',";
                    130:       }
                    131:       chop $result;
                    132:       $result.=')">';
                    133:     } # else nothing changed so just use the default mechanism
                    134:   }
                    135:   return $result;
1.1       albertel  136: }
                    137: 
                    138: sub end_foilgroup {
1.22      albertel  139:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    140:   
                    141:   my $result;
1.25      albertel  142:   if ($target eq 'grade' || $target eq 'web' || $target eq 'answer') {
1.22      albertel  143:     my $name;
                    144:     my ($count,$max) = &getfoilcounts($parstack,$safeeval);
                    145:     if ($count>$max) { $count=$max } 
                    146:     &Apache::lonxml::debug("Count is $count from $max");
                    147:     my @opt;
                    148:     eval '@opt ='.&Apache::lonxml::get_param('options',$parstack,$safeeval);
                    149:     &Apache::lonxml::debug("Options are $#opt");
                    150:     if ($target eq 'web') {
1.25      albertel  151:       $result.=&displayfoils($count,@opt);
                    152:     } elsif ( $target eq 'answer') {
                    153:       $result.=&displayanswers($count,@opt);
1.22      albertel  154:     } elsif ( $target eq 'grade') {
                    155:       if ( defined $ENV{'form.submitted'}) {
                    156: 	my @whichopt = &whichfoils($count);
                    157: 	my $temp=1;my $name;
1.26      albertel  158: 	my %responsehash;
1.22      albertel  159: 	my $right=0;
                    160: 	my $wrong=0;
                    161: 	my $ignored=0;
                    162: 	foreach $name (@whichopt) {
                    163: 	  my $response = $ENV{'form.HWVAL_'.$Apache::inputtags::response['-1'].":$temp"};
1.26      albertel  164: 	  $responsehash{$name}=$response;
1.22      albertel  165: 	  if ( $response =~ /[^\s]/) {
                    166: 	    &Apache::lonxml::debug("submitted a $response<br />\n");
                    167: 	    my $value=$Apache::response::foilgroup{$name.'.value'};
                    168: 	    if ($value eq $response) {$right++;} else {$wrong++;}
                    169: 	  } else {
                    170: 	    $ignored++;
                    171: 	  }
                    172: 	  $temp++;
                    173: 	}
                    174: 	my $id = $Apache::inputtags::response['-1'];
1.26      albertel  175: 	$Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}=&Apache::lonnet::hash2str(%responsehash);
1.22      albertel  176: 	&Apache::lonxml::debug("Got $right right and $wrong wrong, and $ignored were ignored");
                    177: 	if ($wrong==0 && $ignored==0) {
                    178: 	  $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}='EXACT_ANS';
                    179: 	} else {
                    180: 	  $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}='INCORRECT';
1.1       albertel  181: 	}
1.22      albertel  182:       }
1.1       albertel  183:     }
1.25      albertel  184:   } elsif ($target eq 'edit') {
1.22      albertel  185:     $result.=&Apache::edit::end_table();
                    186:   }
                    187:   return $result;
1.1       albertel  188: }
                    189: 
                    190: sub getfoilcounts {
1.22      albertel  191:   my ($parstack,$safeeval)=@_;
                    192:   my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
                    193:   # +1 since instructors will count from 1
                    194:   my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
                    195:   return ($count,$max);
1.1       albertel  196: }
                    197: 
                    198: sub whichfoils {
1.22      albertel  199:   my ($max)=@_;
                    200:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    201:   my @whichopt =();
                    202:   while ((($#whichopt+1) < $max) && ($#names > -1)) {
                    203:     &Apache::lonxml::debug("Have $#whichopt max is $max");
                    204:     my $aopt=int(rand($#names+1));
                    205:     &Apache::lonxml::debug("From $#whichopt $max $#names elms, picking $aopt");
                    206:     $aopt=splice(@names,$aopt,1);
                    207:     &Apache::lonxml::debug("Picked $aopt");
                    208:     push (@whichopt,$aopt);
                    209:   }
                    210:   return @whichopt;
1.1       albertel  211: }
                    212: 
1.25      albertel  213: sub displayanswers {
                    214:   my ($max,@opt)=@_;
                    215:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    216:   my @whichopt = &whichfoils($max);
                    217:   my $result=&Apache::response::answer_header('optionresponse');
                    218:   foreach my $name (@whichopt) {
                    219:     $result.=&Apache::response::answer_part('optionresponse',
                    220: 		     $Apache::response::foilgroup{$name.'.value'})
                    221:   }
                    222:   $result.=&Apache::response::answer_footer('optionresponse');
                    223:   return $result;
                    224: }
                    225: 
1.1       albertel  226: sub displayfoils {
1.22      albertel  227:   my ($max,@opt)=@_;
                    228:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    229:   my @truelist;
                    230:   my @falselist;
                    231:   my $result;
                    232:   my $name;
                    233:   my @whichopt = &whichfoils($max);
                    234:   my $optionlist="<option></option>\n";
                    235:   my $option;
                    236:   foreach $option (@opt) {
                    237:     $optionlist.="<option>$option</option>\n";
                    238:   }
1.24      albertel  239:   if (($Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"} =~ /^correct/)  || ($Apache::inputtags::status[-1] eq  'SHOW_ANSWER')) {
1.22      albertel  240:     foreach $name (@whichopt) {
                    241:       $result.="<br />".$Apache::response::foilgroup{$name.'.value'}.
                    242: 	":".$Apache::response::foilgroup{$name.'.text'}."\n";
                    243:     }
                    244:   } else {
                    245:     my $temp=1;
                    246:     foreach $name (@whichopt) {
                    247:       $result.="<br /><select name=\"HWVAL_$Apache::inputtags::response['-1']:$temp\">"
                    248: 	.$optionlist
                    249: 	  ."</select>\n".$Apache::response::foilgroup{$name.'.text'}."\n";
                    250:       $temp++;
1.1       albertel  251:     }
1.22      albertel  252:   }
                    253:   return $result."<br />";
1.1       albertel  254: }
                    255: 
1.22      albertel  256: 
1.2       albertel  257: sub start_conceptgroup {
1.22      albertel  258:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    259:   $Apache::optionresponse::conceptgroup=1;
                    260:   %Apache::response::conceptgroup={};
                    261:   my $result;
                    262:   if ($target eq 'edit') {
                    263:     $result.=&Apache::edit::tag_start($target,$token,"Concept Grouped Foils");
                    264:     $result.=&Apache::edit::text_arg('Concept:','concept',$token,'50')."</td></tr>";
                    265:     $result.="<tr><td colspan=\"3\">\n";
                    266:   }
                    267:   if ($target eq 'modified') {
                    268:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'concept');
                    269:     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
                    270:   }
                    271:   return $result;
1.2       albertel  272: }
                    273: 
                    274: sub end_conceptgroup {
1.22      albertel  275:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    276:   $Apache::optionresponse::conceptgroup=0;
                    277:   my $result='';
1.25      albertel  278:   if ($target eq 'web' || $target eq 'grade' || $target eq 'answer') {
1.22      albertel  279:     #if not there aren't any foils to display and thus no question
                    280:     if (defined(@{ $Apache::response::conceptgroup{'names'} })) {
                    281:       my @names = @{ $Apache::response::conceptgroup{'names'} };
                    282:       my $pick=int rand $#names+1;
                    283:       my $name=$names[$pick];
                    284:       push @{ $Apache::response::foilgroup{'names'} }, $name;
                    285:       $Apache::response::foilgroup{"$name.value"} =  $Apache::response::conceptgroup{"$name.value"};
                    286:       $Apache::response::foilgroup{"$name.text"} =  $Apache::response::conceptgroup{"$name.text"};
                    287:       my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval);
                    288:       $Apache::response::foilgroup{"$name.concept"} = $concept;
                    289:       &Apache::lonxml::debug("Selecting $name in $concept");
                    290:     }
                    291:   }
                    292:   if ($target eq 'edit') {
                    293:     $result=&Apache::edit::end_table();
                    294:   }
                    295:   return $result;
1.2       albertel  296: }
                    297: 
1.16      albertel  298: sub insert_conceptgroup {
1.22      albertel  299:   my $result="\n\t\t<conceptgroup concept=\"\">".&insert_foil()."\n\t\t</conceptgroup>\n";
                    300:   return $result;
1.16      albertel  301: }
                    302: 
1.1       albertel  303: sub start_foil {
1.22      albertel  304:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    305:   my $result='';
1.25      albertel  306:   if ($target eq 'web') {
                    307:     &Apache::lonxml::startredirection;
                    308:   } elsif ($target eq 'edit') {
1.22      albertel  309:     $result=&Apache::edit::tag_start($target,$token,"Foil");
                    310:     my $level='-2';
                    311:     if ($$tagstack['-2'] eq 'conceptgroup') { $level = '-3'; }
                    312:     my @opt;
                    313:     eval '@opt ='.&Apache::lonxml::get_param('options',$parstack,$safeeval,$level);
                    314:     $result.=&Apache::edit::text_arg('Name:','name',$token);
                    315:     $result.= &Apache::edit::select_or_text_arg('Correct Option:','value',['unused',(@opt)],$token,'15');
                    316:     $result .= '</td></tr><tr><td colspan="3">';
1.25      albertel  317:   } elsif ($target eq 'modified') {
1.22      albertel  318:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'value','name');
                    319:     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
                    320:   }
                    321:   return $result;
1.1       albertel  322: }
                    323: 
                    324: sub end_foil {
1.22      albertel  325:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    326:   my $text ='';
                    327:   my $result = '';
                    328:   if ($target eq 'web') { $text=&Apache::lonxml::endredirection; }
1.25      albertel  329:   if ($target eq 'web' || $target eq 'grade' || $target eq 'answer') {
1.22      albertel  330:     my $value = &Apache::lonxml::get_param('value',$parstack,$safeeval);
                    331:     if ($value ne 'unused') {
                    332:       my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
                    333:       &Apache::lonxml::debug("Got a name of :$name:");
                    334:       if (!$name) { $name=$Apache::lonxml::curdepth; }
                    335:       &Apache::lonxml::debug("Using a name of :$name:");
                    336:       if ( $Apache::optionresponse::conceptgroup ) {
                    337: 	push @{ $Apache::response::conceptgroup{'names'} }, $name;
                    338: 	$Apache::response::conceptgroup{"$name.value"} = $value;
                    339: 	$Apache::response::conceptgroup{"$name.text"} = $text;	
                    340:       } else {
                    341: 	push @{ $Apache::response::foilgroup{'names'} }, $name;
                    342: 	$Apache::response::foilgroup{"$name.value"} = $value;
                    343: 	$Apache::response::foilgroup{"$name.text"} = $text;
                    344:       }
                    345:     }
                    346:   }
                    347:   if ($target eq 'edit') {
                    348:     $result.= &Apache::edit::tag_end($target,$token,'');
                    349:   }
                    350:   return $result;
1.1       albertel  351: }
                    352: 
1.7       albertel  353: sub insert_foil {
1.22      albertel  354:   return '
1.15      albertel  355: <foil name="" value="unused">
1.14      albertel  356: <startouttext />
                    357: <endouttext />
1.7       albertel  358: </foil>';
                    359: }
1.1       albertel  360: 1;
                    361: __END__
                    362:  

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>