Return to response.pm CVS log

Up to [LON-CAPA] / loncom / homework

- <import> now puts info in .meta files abut what is being imported
- Apache::inputtags::import exists, list the <import> ids that we are in
- start_response, properly sets the Apache::inputtags::response id to the
   join() of Apache::inputtags::import and the id="" arg of the response
- <import> gets an id at publication time

    1: # The LearningOnline Network with CAPA
    2: # various response type definitons response definition
    3: 
    4: # 11/23,11/24,11/28 Gerd Kortemeyer
    5: # Guy Albertelli
    6: # 08/04,08/07 Gerd Kortemeyer
    7: 
    8: package Apache::response;
    9: use strict;
   10: 
   11: sub BEGIN {
   12:   &Apache::lonxml::register('Apache::response',('responseparam','caparesponse','numericalresponse','formularesponse','stringresponse','radiobuttonresponse','optionresponse','imageresponse','essayresponse','dataresponse'));
   13: }
   14: 
   15: sub start_response {
   16:   my ($parstack,$safeeval)=@_;
   17:   my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
   18:   if ($id eq '') { $id = $Apache::lonxml::curdepth; }
   19:   if ($#Apache::inputtags::import > -1) {
   20:     &Apache::lonxml::debug("Turning :$id: into");
   21:     $id = join('_',@Apache::inputtags::import).'_'.$id;
   22:     &Apache::lonxml::debug("New  :$id:");
   23:   }
   24:   push (@Apache::inputtags::response,$id);
   25:   push (@Apache::inputtags::responselist,$id);
   26:   @Apache::inputtags::inputlist=();
   27:   return $id;
   28: }
   29: 
   30: sub end_response {
   31:   pop @Apache::inputtags::response;
   32:   @Apache::inputtags::inputlist=();
   33:   return '';
   34: }
   35: 
   36: sub start_hintresponse {
   37:   my ($parstack,$safeeval)=@_;
   38:   my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
   39:   if ($id eq '') { $id = $Apache::lonxml::curdepth; }
   40:   push (@Apache::inputtags::response,$id);
   41:   return $id;
   42: }
   43: 
   44: sub end_hintresponse {
   45:   pop @Apache::inputtags::response;
   46:   return '';
   47: }
   48: 
   49: # used by response to set the non-safe space random number generator to something
   50: # that is stable and unique based on the part number and response number
   51: sub setrandomnumber {
   52:   my $rndseed;
   53:   if ($ENV{'request.state'} eq "construct") {
   54:     $rndseed=$ENV{'form.rndseed'};
   55:     if (!$rndseed) { $rndseed=time; }
   56:   } else {
   57:     $rndseed=&Apache::lonnet::rndseed();
   58:   }
   59:   &Apache::lonxml::debug("randseed $rndseed");
   60: #  $rndseed=unpack("%32i",$rndseed);
   61:   $rndseed=$rndseed
   62:     +(&Apache::lonnet::numval($Apache::inputtags::part) << 10);
   63:   if (defined($Apache::inputtags::response['-1'])) {
   64:     $rndseed=$rndseed
   65:       +&Apache::lonnet::numval($Apache::inputtags::response['-1']);
   66:   }
   67:   srand($rndseed);
   68:   &Apache::lonxml::debug("randseed $rndseed");
   69:   return '';
   70: }
   71: 
   72: sub meta_parameter_write {
   73:     my ($name,$type,$default,$display)=@_;
   74:     my $partref=$Apache::inputtags::part;
   75:     my $result='<parameter part="'.$Apache::inputtags::part.'"';
   76:     if (defined($Apache::inputtags::response[-1])) {
   77:       $result.=            ' id="'.$Apache::inputtags::response[-1].'"';
   78:       $partref.='_'.$Apache::inputtags::response[-1];
   79:     }
   80:     $result.=            ' name="'.$name.'"'.
   81:                          ' type="'.$type.'"'.
   82: ($default?' default="'.$default.'"':'').
   83: ($display?' display="'.$display.' [Part: '.$partref.']"':'')
   84:              .'></parameter>'
   85:              ."\n";
   86:     return $result;
   87: }
   88: 
   89: sub meta_package_write {
   90:     my $name=shift;
   91:     my $result = '<parameter part="'.$Apache::inputtags::part.'"';
   92:     if(defined($Apache::inputtags::response[-1])) {
   93:       $result.=              ' id="'.$Apache::inputtags::response[-1].'"';
   94:     }
   95:     $result.=' package="'.$name.'"></parameter>'."\n";
   96:     return $result;
   97: }
   98: 
   99: sub meta_stores_write {
  100:     my ($name,$type,$display)=@_;
  101:     my $partref=$Apache::inputtags::part;
  102:     my $result = '<stores part="'.$Apache::inputtags::part.'"';
  103:     if (defined($Apache::inputtags::response[-1])) {
  104:       $result.=           ' id="'.$Apache::inputtags::response[-1].'"';
  105:       $partref.='_'.$Apache::inputtags::response[-1];
  106:     }	
  107:     $result.=          ' name="'.$name.'"'.
  108:                        ' type="'.$type.'"'.
  109: 	            ' display="'.$display.' [Part: '.$partref.']"'.
  110: 		      "></stores>\n";
  111: }
  112: 
  113: sub mandatory_part_meta {
  114: #
  115: # Autogenerate metadata for mandatory
  116: # input (from RAT or lonparmset) and 
  117: # output (to lonspreadsheet)
  118: # of each part
  119: #
  120:  return
  121: #    &meta_parameter_write('opendate','date_start','',
  122: #                          'Opening Date').
  123: #    &meta_parameter_write('duedate','date_end','',
  124: #                          'Due Date').
  125: #    &meta_parameter_write('answerdate','date_start','',
  126: #                          'Show Answer Date').
  127: #    &meta_parameter_write('weight','int_zeropos','',
  128: #                          'Available Points').
  129: #    &meta_parameter_write('maxtries','int_pos','',
  130: #                          'Maximum Number of Tries').
  131:     &meta_package_write('part').
  132:     &meta_stores_write('solved','string',
  133:                           'Problem Status').
  134:     &meta_stores_write('tries','int_zeropos',
  135:                           'Number of Attempts').
  136:     &meta_stores_write('awarded','float',
  137: 		          'Partial Credit Factor');
  138: #
  139: # Note: responseid-specific data 'submission' and 'awarddetail'
  140: # not available to spreadsheet -> skip here
  141: #
  142: }
  143: 
  144: sub check_for_previous {
  145:   my ($curresponse,$partid,$id) = @_;
  146:   my %previous;
  147:   $previous{'used'} = 0;
  148:   foreach my $key (reverse(sort(keys(%Apache::lonhomework::history)))) {
  149:     if ($key =~ /resource\.$partid\.$id\.submission/) {
  150:       &Apache::lonxml::debug("Trying $key");
  151:       my $pastresponse=$Apache::lonhomework::history{$key};
  152:       if ($pastresponse eq $curresponse) {
  153: 	$previous{'used'} = 1;
  154: 	my $history;
  155: 	if ( $key =~ /^(\d+):/ ) {
  156: 	  $history=$1;
  157: 	  $previous{'award'} = $Apache::lonhomework::history{"$history:resource.$partid.$id.awarddetail"};
  158: 	  $previous{'last'}='0';
  159: 	} else {
  160: 	  $previous{'award'} = $Apache::lonhomework::history{"resource.$partid.$id.awarddetail"};
  161: 	  $previous{'last'}='1';
  162: 	}
  163: 	if (! $previous{'award'} ) { $previous{'award'} = 'UNKNOWN';	}
  164: 	&Apache::lonxml::debug("got a match :$previous{'award'}:$previous{'used'}:");
  165: 	last;
  166:       }
  167:     }
  168:   }
  169:   return %previous;
  170: }
  171: 
  172: sub start_caparesponse {
  173:   require Apache::caparesponse; 
  174:   import Apache::caparesponse; 
  175:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  176: #  print "\n<br />\nsimple caparesponse\n";
  177:   return &Apache::caparesponse::start_caparesponse($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  178: }
  179: 
  180: sub start_stringresponse {
  181:   require Apache::caparesponse;
  182:   import Apache::caparesponse;
  183:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  184:   return &Apache::caparesponse::start_stringresponse($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  185: }
  186: 
  187: sub start_formularesponse {
  188:   require Apache::caparesponse;
  189:   import Apache::caparesponse;
  190:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  191:   return &Apache::caparesponse::start_formularesponse($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  192: }
  193: 
  194: sub start_numericalresponse {
  195:   require Apache::caparesponse; 
  196:   import Apache::caparesponse; 
  197:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  198:   return &Apache::caparesponse::start_numericalresponse
  199:     ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  200: }
  201: 
  202: sub start_radiobuttonresponse {
  203:   require Apache::radiobuttonresponse; 
  204:   import Apache::radiobuttonresponse; 
  205:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  206:   return &Apache::radiobuttonresponse::start_radiobuttonresponse($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  207: }
  208: 
  209: sub start_optionresponse {
  210:   require Apache::optionresponse; 
  211:   import Apache::optionresponse; 
  212:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  213:   return &Apache::optionresponse::start_optionresponse($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  214: }
  215: 
  216: sub start_imageresponse {
  217:   require Apache::imageresponse; 
  218:   import Apache::imageresponse; 
  219:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  220:   return &Apache::imageresponse::start_imageresponse($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  221: }
  222: 
  223: sub start_essayresponse {
  224:   require Apache::essayresponse; 
  225:   import Apache::essayresponse; 
  226:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  227:   return &Apache::essayresponse::start_essayresponse($target,$token,$tagstack,$parstack,$parser,$safeeval,$style);
  228: }
  229: 
  230: sub view_or_modify {
  231:   my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
  232:   my $myself=0;
  233:   if ( ($name eq $ENV{'user.name'}) && ($domain eq $ENV{'user.domain'}) ) {
  234:     $myself=1;
  235:   }
  236:   my $vgr=&Apache::lonnet::allowed('vgr',$courseid);
  237:   my $mgr=&Apache::lonnet::allowed('vgr',$courseid);
  238:   if ($mgr) { return "M"; }
  239:   if ($vgr) { return "V"; }
  240:   if ($myself) { return "V"; }
  241:   return '';
  242: }
  243: 
  244: sub start_dataresponse {
  245:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  246:   my $id = &Apache::response::start_response($parstack,$safeeval);
  247:   my $result;
  248:   if ($target eq 'web') {
  249:     $result = $token->[2]->{'display'}.':';
  250:   } elsif ($target eq 'meta') {
  251:     $result = &Apache::response::meta_stores_write($token->[2]->{'name'},
  252: 						   $token->[2]->{'type'},
  253: 						   $token->[2]->{'display'});
  254:     $result .= &Apache::response::meta_package_write('dataresponse');
  255:   }
  256:   return $result;
  257: }
  258: 
  259: sub end_dataresponse {
  260:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  261:   my $result;
  262:   if ( $target eq 'web' ) {
  263:   } elsif ($target eq 'grade' ) {
  264:     if ( defined $ENV{'form.submitted'}) {
  265:       my ($symb,$courseid,$domain,$name)=&Apache::lonxml::whichuser();
  266:       my $allowed=&Apache::lonnet::allowed('mgr',$courseid);
  267:       if ($allowed) {
  268: 	&Apache::response::setup_params('datasubmission');
  269: 	my $partid = $Apache::inputtags::part;
  270: 	my $id = $Apache::inputtags::response['-1'];
  271: 	my $response = $ENV{'form.HWVAL'.$id};
  272: 	my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
  273: 	if ( $response =~ /[^\s]/) {
  274: 	  $Apache::lonhomework::results{"resource.$partid.$id.$name"}=
  275: 	    $response;
  276: 	  $Apache::lonhomework::results{
  277: 					"resource.$partid.$id.submission"}=
  278: 					  $response;
  279: 	  $Apache::lonhomework::results{
  280: 					"resource.$partid.$id.awarddetail"}=
  281: 					  'SUBMITTED';
  282: 	}
  283:       } else {
  284: 	$result='Not Permitted to change values.'
  285:       }
  286:     }
  287:   }
  288:   &Apache::response::end_response;
  289:   return $result;
  290: }
  291: 
  292: sub start_responseparam {
  293:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  294:   my $result='';
  295:   if ($target eq 'meta') {
  296:     $result = &meta_parameter_write($token->[2]->{'name'},
  297: 				    $token->[2]->{'type'},
  298: 				    $token->[2]->{'default'},
  299: 				    $token->[2]->{'description'});
  300:   } elsif ($target eq 'edit') {
  301:     $result.=&Apache::edit::tag_start($target,$token,
  302: 				      &Apache::lonxml::description($token));
  303:     $result.=&Apache::edit::text_arg('Name:','name',$token).
  304:       &Apache::edit::text_arg('Type:','type',$token).
  305: 	&Apache::edit::text_arg('Description:','description',$token).
  306: 	  &Apache::edit::text_arg('Default:','default',$token).
  307: 	    "</td></tr>";
  308:     $result.=&Apache::edit::end_table;
  309:   } elsif ($target eq 'modified') {
  310:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,
  311: 						 'name','type','description',
  312: 						 'default');
  313:     if ($constructtag) {
  314:       $result = &Apache::edit::rebuild_tag($token);
  315:       $result.=&Apache::edit::handle_insert();
  316:     }
  317:   }
  318:   return $result;
  319: }
  320: 
  321: sub end_responseparam {
  322:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  323:   if ($target eq 'edit') { return ('','no'); }
  324:   return '';
  325: }
  326: 
  327: sub setup_params {
  328:   my ($tag) = @_;
  329: 
  330:   @Apache::inputtags::params=();
  331:   my %paramlist=();
  332:   foreach my $key (keys(%Apache::lonnet::packagetab)) {
  333:     if ($key =~ /^$tag/) {
  334:       my ($package,$name) = split(/&/,$key);
  335:       $paramlist{$name}=1;
  336:     }
  337:   }
  338:   foreach my $key (keys(%paramlist)) {
  339:     my $entry= 'resource.'.$Apache::inputtags::part;
  340:     if (defined($Apache::inputtags::response[-1])) {
  341:       $entry.='_'.$Apache::inputtags::response[-1];
  342:     }
  343:     $entry.='.'.$key;
  344:     &Apache::lonxml::debug("looking for $entry");
  345:     my $value = &Apache::lonnet::EXT("$entry");
  346:     &Apache::lonxml::debug("$key has value :$value:");
  347:     if ($value eq 'con_lost' || $value =~ /^error:/) {
  348:       &Apache::lonxml::debug("using nothing");
  349:       $Apache::inputtags::params{$key}='';
  350:     } else {
  351:       &Apache::lonxml::debug("using value");
  352:       $Apache::inputtags::params{$key}=$value;
  353:     }
  354:   }
  355: }
  356: 
  357: sub answer_header {
  358:   my ($type) = @_;
  359:   my $result;
  360:   if ($type eq 'optionresponse' || $type eq 'radiobuttonresponse' ) {
  361:     $result = '<table border="1"><tr><th>Answer for Part:'.
  362:       $Apache::inputtags::part. '</th></tr><tr>'."\n";
  363:   } else {
  364:     $result = '<table border="1"><tr><td>Answer for Part:'.
  365:       $Apache::inputtags::part. '</td>'."\n";
  366:   }
  367:   return $result;
  368: }
  369: 
  370: sub answer_part {
  371:   my ($type,$answer) = @_;
  372:   my $result;
  373:   if ($type eq 'optionresponse' || $type eq 'radiobuttonresponse') {
  374:     $result = '<td>'.$answer.'</td>';
  375:   } else {
  376:     $result = '<td>'.$answer.'</td>';
  377:   }
  378:   return $result;
  379: }
  380: 
  381: sub answer_footer {
  382:   my ($type) = @_;
  383:   my $result;
  384:   if ($type eq 'optionresponse' || $type eq 'radiobuttonresponse') {
  385:     $result = '</tr></table>';
  386:   } else {
  387:     $result = '</tr></table>';
  388:   }
  389:   return $result;
  390: }
  391: 
  392: 1;
  393: __END__
  394: