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

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: # option list style responses
1.4       albertel    3: # 2/21 Guy
1.1       albertel    4: package Apache::optionresponse;
                      5: use strict;
1.6       albertel    6: use Apache::response;
1.1       albertel    7: 
                      8: sub BEGIN {
                      9:   &Apache::lonxml::register('Apache::optionresponse',('optionresponse'));
                     10: }
                     11: 
                     12: sub start_optionresponse {
1.11      albertel   13:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.9       albertel   14:   my $result='';
1.1       albertel   15:   #when in a radiobutton response use these
1.2       albertel   16:   &Apache::lonxml::register('Apache::optionresponse',('foilgroup','foil','conceptgroup'));
1.7       albertel   17:   push (@Apache::lonxml::namespace,'optionresponse');
1.1       albertel   18:   my $id = &Apache::response::start_response($parstack,$safeeval);
1.9       albertel   19:   if ($target eq 'edit') {
                     20:     $result.="<table width=\"100%\" border=\"2\"><tr><td>Multiple Option Response Question</td>
                     21: <td>Delete:".
                     22:   &Apache::edit::deletelist($target,$token)
                     23: ."</td></tr><tr><td colspan=\"3\">\n";
                     24:   }
                     25: 
                     26:   return $result;
1.1       albertel   27: }
                     28: 
                     29: sub end_optionresponse {
                     30:   &Apache::response::end_response;
1.7       albertel   31:   pop @Apache::lonxml::namespace;
1.1       albertel   32:   return '';
                     33: }
                     34: 
1.7       albertel   35: sub insert_optionresponse {
                     36:   return '
                     37: <optionresponse max="10">
                     38:     <foilgroup options=\"\">
                     39:     </foilgroup>
                     40: </optionresponse>';
                     41: }
                     42: 
1.1       albertel   43: %Apache::response::foilgroup={};
                     44: sub start_foilgroup {
                     45:   %Apache::response::foilgroup={};
1.9       albertel   46:   $Apache::optionresponse::conceptgroup=0;
1.6       albertel   47:   &Apache::response::setrandomnumber();
1.1       albertel   48:   return '';
                     49: }
                     50: 
                     51: sub end_foilgroup {
1.11      albertel   52:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel   53:   
                     54:   my $result;
                     55:   if ($target ne 'meta') {
                     56:     my $name;
                     57:     my ($count,$max) = &getfoilcounts($parstack,$safeeval);
                     58:     if ($count>$max) { $count=$max } 
                     59:     &Apache::lonxml::debug("Count is $count from $max");
                     60:     my $args ='';
                     61:     if ( $#$parstack > 0 ) { $args=$$parstack['-1']; }
                     62:     my @opt;
                     63:     eval '@opt ='.&Apache::run::run("{$args;".'return $options}',$safeeval);
                     64:     if ($target eq 'web') {
                     65:       $result=&displayfoils($count,@opt);
                     66:     } elsif ( $target eq 'grade') {
                     67:       if ( defined $ENV{'form.submitted'}) {
                     68: 	my @whichopt = &whichfoils($count);
                     69: 	my $temp=1;my $name;
                     70: 	my $allresponse;
                     71: 	my $right=0;
                     72: 	my $wrong=0;
1.8       albertel   73: 	my $ignored=0;
1.1       albertel   74: 	foreach $name (@whichopt) {
                     75: 	  my $response = $ENV{'form.HWVAL_'.$Apache::inputtags::response['-1'].":$temp"};
                     76: 	  $allresponse.="$response:";
                     77: 	  if ( $response =~ /[^\s]/) {
1.3       albertel   78: 	    &Apache::lonxml::debug("submitted a $response<br />\n");
1.1       albertel   79: 	    my $value=$Apache::response::foilgroup{$name.'.value'};
                     80: 	    if ($value eq $response) {$right++;} else {$wrong++;}
1.8       albertel   81: 	  } else {
                     82: 	    $ignored++;
1.1       albertel   83: 	  }
                     84: 	  $temp++;
                     85: 	}
                     86: 	my $id = $Apache::inputtags::response['-1'];
                     87: 	$Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}=$allresponse;
1.8       albertel   88: 	&Apache::lonxml::debug("Got $right right and $wrong wrong, and $ignored were ignored");
                     89: 	if ($wrong==0 && $ignored==0) {
1.1       albertel   90: 	  $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}='EXACT_ANS';
                     91: 	} else {
                     92: 	  $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}='INCORRECT';
                     93: 	}
                     94:       }
                     95:     }
                     96:   }
                     97:   return $result;
                     98: }
                     99: 
                    100: sub getfoilcounts {
                    101:   my ($parstack,$safeeval)=@_;
1.10      albertel  102:   my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
1.9       albertel  103:   # +1 since instructors will count from 1
                    104:   my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
1.1       albertel  105:   return ($count,$max);
                    106: }
                    107: 
                    108: sub whichfoils {
                    109:   my ($max)=@_;
                    110:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    111:   my @whichopt =();
1.9       albertel  112:   while ((($#whichopt+1) < $max) && ($#names > -1)) {
                    113:     &Apache::lonxml::debug("Have $#whichopt max is $max");
                    114:     my $aopt=int(rand($#names+1));
1.6       albertel  115:     &Apache::lonxml::debug("From $#whichopt $max $#names elms, picking $aopt");
1.1       albertel  116:     $aopt=splice(@names,$aopt,1);
                    117:     &Apache::lonxml::debug("Picked $aopt");
                    118:     push (@whichopt,$aopt);
                    119:   }
                    120:   return @whichopt;
                    121: }
                    122: 
                    123: sub displayfoils {
                    124:   my ($max,@opt)=@_;
                    125:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    126:   my @truelist;
                    127:   my @falselist;
                    128:   my $result;
                    129:   my $name;
                    130:   my @whichopt = &whichfoils($max);
                    131:   my $optionlist="<option></option>\n";
                    132:   my $option;
                    133:   foreach $option (@opt) {
                    134:     $optionlist.="<option>$option</option>\n";
                    135:   }
                    136:   if ($Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"} =~ /^correct/ ) {
                    137:     foreach $name (@whichopt) {
                    138:       $result.="<br />".$Apache::response::foilgroup{$name.'.value'}.
                    139: 	":".$Apache::response::foilgroup{$name.'.text'}."\n";
                    140:     }
                    141:   } else {
                    142:     my $temp=1;
                    143:     foreach $name (@whichopt) {
                    144:       $result.="<br /><select name=\"HWVAL_$Apache::inputtags::response['-1']:$temp\">"
                    145: 	.$optionlist
                    146: 	  ."</select>\n".$Apache::response::foilgroup{$name.'.text'}."\n";
                    147:       $temp++;
                    148:     }
                    149:   }
                    150:   return $result."<br />";
                    151: }
                    152: 
1.5       albertel  153: 
1.2       albertel  154: sub start_conceptgroup {
1.5       albertel  155:   $Apache::optionresponse::conceptgroup=1;  
                    156:   %Apache::response::conceptgroup={};
                    157:   return '';
1.2       albertel  158: }
                    159: 
                    160: sub end_conceptgroup {
1.11      albertel  161:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.5       albertel  162:   $Apache::optionresponse::conceptgroup=0;  
                    163:   if ($target eq 'web' || $target eq 'grade') {
                    164:     my @names = @{ $Apache::response::conceptgroup{'names'} };
                    165:     my $pick=int rand $#names+1;
                    166:     my $name=$names[$pick];
                    167:     push @{ $Apache::response::foilgroup{'names'} }, $name;
                    168:     $Apache::response::foilgroup{"$name.value"} =  $Apache::response::conceptgroup{"$name.value"};
                    169:     $Apache::response::foilgroup{"$name.text"} =  $Apache::response::conceptgroup{"$name.text"};
1.10      albertel  170:     my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval);
1.5       albertel  171:     $Apache::response::foilgroup{"$name.concept"} = $concept;
                    172:     &Apache::lonxml::debug("Selecting $name in $concept");
                    173:   }
                    174:   return '';
1.2       albertel  175: }
                    176: 
1.1       albertel  177: sub start_foil {
1.11      albertel  178:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.4       albertel  179:   if ($target eq 'web') { &Apache::lonxml::startredirection; }
1.1       albertel  180:   return '';
                    181: }
                    182: 
                    183: sub end_foil {
1.11      albertel  184:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.4       albertel  185:   my $text ='';
                    186:   if ($target eq 'web') { $text=&Apache::lonxml::endredirection; }
1.1       albertel  187:   if ($target eq 'web' || $target eq 'grade') {
1.10      albertel  188:     my $value = &Apache::lonxml::get_param('value',$parstack,$safeeval);
1.1       albertel  189:     if ($value ne 'unused') {
1.10      albertel  190:       my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
1.5       albertel  191:       if ( $Apache::optionresponse::conceptgroup ) {
                    192: 	push @{ $Apache::response::conceptgroup{'names'} }, $name;
                    193: 	$Apache::response::conceptgroup{"$name.value"} = $value;
                    194: 	$Apache::response::conceptgroup{"$name.text"} = $text;	
                    195:       } else {
                    196: 	push @{ $Apache::response::foilgroup{'names'} }, $name;
                    197: 	$Apache::response::foilgroup{"$name.value"} = $value;
                    198: 	$Apache::response::foilgroup{"$name.text"} = $text;
                    199:       }
1.2       albertel  200:     }
1.6       albertel  201:   }
                    202:   if ($target eq 'edit') {
1.12    ! albertel  203:     my $args;
1.10      albertel  204:     my $options= &Apache::lonxml::get_param('options',$parstack,$safeeval);
1.6       albertel  205:     if (!$options && $#$parstack > 2 ) { $args=$$parstack['-2']; }
                    206:     my @opt;
                    207:     #eval '@opt ='.
1.1       albertel  208:   }
                    209:   return '';
                    210: }
                    211: 
1.7       albertel  212: sub insert_foil {
                    213:   return '
                    214: <foil name="" value="">
                    215: </foil>';
                    216: }
1.1       albertel  217: 1;
                    218: __END__
                    219:  

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