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

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 {
1.13    ! albertel   45:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
        !            46: 
        !            47:   my $result='';
1.1       albertel   48:   %Apache::response::foilgroup={};
1.9       albertel   49:   $Apache::optionresponse::conceptgroup=0;
1.6       albertel   50:   &Apache::response::setrandomnumber();
1.13    ! albertel   51:   if ($target eq 'edit') {
        !            52:     my $optionlist="<option></option>\n";
        !            53:     my $option;
        !            54:     my @opt;
        !            55:     eval '@opt ='. &Apache::lonxml::get_param('options',$parstack,$safeeval);
        !            56: 
        !            57:     foreach $option (@opt) {
        !            58:       $optionlist.="<option>$option</option>\n";
        !            59:     }
        !            60:     my $insertlist=&Apache::edit::insertlist($target,$token);
        !            61:     $result.= (<<ENDTABLE);
        !            62:     <table width="100%" border="2">
        !            63:       <tr><td>Select Options</td>
        !            64:         <td>
        !            65: 	  Add new Option: <input type="text" name="$Apache::lonxml::curdepth.options" />
        !            66:         </td>
        !            67:         <td>Delete an Option:
        !            68: 	  <select name="$Apache::lonxml::curdepth.deleteopt">$optionlist</select>
        !            69:         </td>
        !            70:      </tr>
        !            71:      <tr><td colspan="3">$insertlist<br />
        !            72: ENDTABLE
        !            73:   }
        !            74:   if ($target eq 'modified') {
        !            75:     my @options;
        !            76:     eval '@options ='.&Apache::lonxml::get_param('options',$parstack,$safeeval);
        !            77:     if ($ENV{"form.$Apache::lonxml::curdepth.options"}) {
        !            78:       my $newopt = $ENV{"form.$Apache::lonxml::curdepth.options"};
        !            79:       $newopt =~ s/\'/\\\'/g;
        !            80:       if ($options[0]) {
        !            81: 	push(@options,$ENV{"form.$Apache::lonxml::curdepth.options"});
        !            82:       } else {
        !            83: 	$options[0]=$ENV{"form.$Apache::lonxml::curdepth.options"};
        !            84:       }
        !            85:       $result = "<foilgroup options=\"(";
        !            86:       foreach my $option (@options) {
        !            87: 	&Apache::lonxml::debug("adding option :$option:");
        !            88: 	$result .="'".$option."',";
        !            89:       }
        !            90:       chop $result;
        !            91:       $result.=')">';
        !            92:     }
        !            93:   }
        !            94:   return $result;
1.1       albertel   95: }
                     96: 
                     97: sub end_foilgroup {
1.11      albertel   98:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel   99:   
                    100:   my $result;
                    101:   if ($target ne 'meta') {
                    102:     my $name;
                    103:     my ($count,$max) = &getfoilcounts($parstack,$safeeval);
                    104:     if ($count>$max) { $count=$max } 
                    105:     &Apache::lonxml::debug("Count is $count from $max");
                    106:     my @opt;
1.13    ! albertel  107:     eval '@opt ='.&Apache::lonxml::get_param('options',$parstack,$safeeval);
        !           108:     &Apache::lonxml::debug("Options are $#opt");
1.1       albertel  109:     if ($target eq 'web') {
                    110:       $result=&displayfoils($count,@opt);
                    111:     } elsif ( $target eq 'grade') {
                    112:       if ( defined $ENV{'form.submitted'}) {
                    113: 	my @whichopt = &whichfoils($count);
                    114: 	my $temp=1;my $name;
                    115: 	my $allresponse;
                    116: 	my $right=0;
                    117: 	my $wrong=0;
1.8       albertel  118: 	my $ignored=0;
1.1       albertel  119: 	foreach $name (@whichopt) {
                    120: 	  my $response = $ENV{'form.HWVAL_'.$Apache::inputtags::response['-1'].":$temp"};
                    121: 	  $allresponse.="$response:";
                    122: 	  if ( $response =~ /[^\s]/) {
1.3       albertel  123: 	    &Apache::lonxml::debug("submitted a $response<br />\n");
1.1       albertel  124: 	    my $value=$Apache::response::foilgroup{$name.'.value'};
                    125: 	    if ($value eq $response) {$right++;} else {$wrong++;}
1.8       albertel  126: 	  } else {
                    127: 	    $ignored++;
1.1       albertel  128: 	  }
                    129: 	  $temp++;
                    130: 	}
                    131: 	my $id = $Apache::inputtags::response['-1'];
                    132: 	$Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}=$allresponse;
1.8       albertel  133: 	&Apache::lonxml::debug("Got $right right and $wrong wrong, and $ignored were ignored");
                    134: 	if ($wrong==0 && $ignored==0) {
1.1       albertel  135: 	  $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}='EXACT_ANS';
                    136: 	} else {
                    137: 	  $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}='INCORRECT';
                    138: 	}
                    139:       }
                    140:     }
                    141:   }
                    142:   return $result;
                    143: }
                    144: 
                    145: sub getfoilcounts {
                    146:   my ($parstack,$safeeval)=@_;
1.10      albertel  147:   my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
1.9       albertel  148:   # +1 since instructors will count from 1
                    149:   my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
1.1       albertel  150:   return ($count,$max);
                    151: }
                    152: 
                    153: sub whichfoils {
                    154:   my ($max)=@_;
                    155:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    156:   my @whichopt =();
1.9       albertel  157:   while ((($#whichopt+1) < $max) && ($#names > -1)) {
                    158:     &Apache::lonxml::debug("Have $#whichopt max is $max");
                    159:     my $aopt=int(rand($#names+1));
1.6       albertel  160:     &Apache::lonxml::debug("From $#whichopt $max $#names elms, picking $aopt");
1.1       albertel  161:     $aopt=splice(@names,$aopt,1);
                    162:     &Apache::lonxml::debug("Picked $aopt");
                    163:     push (@whichopt,$aopt);
                    164:   }
                    165:   return @whichopt;
                    166: }
                    167: 
                    168: sub displayfoils {
                    169:   my ($max,@opt)=@_;
                    170:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    171:   my @truelist;
                    172:   my @falselist;
                    173:   my $result;
                    174:   my $name;
                    175:   my @whichopt = &whichfoils($max);
                    176:   my $optionlist="<option></option>\n";
                    177:   my $option;
                    178:   foreach $option (@opt) {
                    179:     $optionlist.="<option>$option</option>\n";
                    180:   }
                    181:   if ($Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"} =~ /^correct/ ) {
                    182:     foreach $name (@whichopt) {
                    183:       $result.="<br />".$Apache::response::foilgroup{$name.'.value'}.
                    184: 	":".$Apache::response::foilgroup{$name.'.text'}."\n";
                    185:     }
                    186:   } else {
                    187:     my $temp=1;
                    188:     foreach $name (@whichopt) {
                    189:       $result.="<br /><select name=\"HWVAL_$Apache::inputtags::response['-1']:$temp\">"
                    190: 	.$optionlist
                    191: 	  ."</select>\n".$Apache::response::foilgroup{$name.'.text'}."\n";
                    192:       $temp++;
                    193:     }
                    194:   }
                    195:   return $result."<br />";
                    196: }
                    197: 
1.5       albertel  198: 
1.2       albertel  199: sub start_conceptgroup {
1.5       albertel  200:   $Apache::optionresponse::conceptgroup=1;  
                    201:   %Apache::response::conceptgroup={};
                    202:   return '';
1.2       albertel  203: }
                    204: 
                    205: sub end_conceptgroup {
1.11      albertel  206:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.5       albertel  207:   $Apache::optionresponse::conceptgroup=0;  
                    208:   if ($target eq 'web' || $target eq 'grade') {
                    209:     my @names = @{ $Apache::response::conceptgroup{'names'} };
                    210:     my $pick=int rand $#names+1;
                    211:     my $name=$names[$pick];
                    212:     push @{ $Apache::response::foilgroup{'names'} }, $name;
                    213:     $Apache::response::foilgroup{"$name.value"} =  $Apache::response::conceptgroup{"$name.value"};
                    214:     $Apache::response::foilgroup{"$name.text"} =  $Apache::response::conceptgroup{"$name.text"};
1.10      albertel  215:     my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval);
1.5       albertel  216:     $Apache::response::foilgroup{"$name.concept"} = $concept;
                    217:     &Apache::lonxml::debug("Selecting $name in $concept");
                    218:   }
                    219:   return '';
1.2       albertel  220: }
                    221: 
1.1       albertel  222: sub start_foil {
1.11      albertel  223:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.13    ! albertel  224:   my $result='';
1.4       albertel  225:   if ($target eq 'web') { &Apache::lonxml::startredirection; }
1.13    ! albertel  226:   if ($target eq 'edit') {
        !           227:     $result=&Apache::edit::tag_start($target,$token,"Foil");
        !           228:     my $options= &Apache::lonxml::get_param('options',$parstack,$safeeval);
        !           229:     my @opt;
        !           230:     eval '@opt ='.$options;
        !           231:   }
        !           232:   return $result;
1.1       albertel  233: }
                    234: 
                    235: sub end_foil {
1.11      albertel  236:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.4       albertel  237:   my $text ='';
1.13    ! albertel  238:   my $result = '';
1.4       albertel  239:   if ($target eq 'web') { $text=&Apache::lonxml::endredirection; }
1.1       albertel  240:   if ($target eq 'web' || $target eq 'grade') {
1.10      albertel  241:     my $value = &Apache::lonxml::get_param('value',$parstack,$safeeval);
1.1       albertel  242:     if ($value ne 'unused') {
1.10      albertel  243:       my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
1.13    ! albertel  244:       if (!$name) { $name=$Apache::lonxml::curdepth; }
1.5       albertel  245:       if ( $Apache::optionresponse::conceptgroup ) {
                    246: 	push @{ $Apache::response::conceptgroup{'names'} }, $name;
                    247: 	$Apache::response::conceptgroup{"$name.value"} = $value;
                    248: 	$Apache::response::conceptgroup{"$name.text"} = $text;	
                    249:       } else {
                    250: 	push @{ $Apache::response::foilgroup{'names'} }, $name;
                    251: 	$Apache::response::foilgroup{"$name.value"} = $value;
                    252: 	$Apache::response::foilgroup{"$name.text"} = $text;
                    253:       }
1.2       albertel  254:     }
1.6       albertel  255:   }
                    256:   if ($target eq 'edit') {
1.13    ! albertel  257:     $result.= &Apache::edit::tag_end($target,$token,'');
1.1       albertel  258:   }
1.13    ! albertel  259:   return $result;
1.1       albertel  260: }
                    261: 
1.7       albertel  262: sub insert_foil {
                    263:   return '
                    264: <foil name="" value="">
1.13    ! albertel  265: <starttextarea />
        !           266: <endtextarea />
1.7       albertel  267: </foil>';
                    268: }
1.1       albertel  269: 1;
                    270: __END__
                    271:  

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