![]() ![]() | ![]() |
- we want to save the exact bubbled letters
1: # The LearningOnline Network with CAPA 2: # various response type definitons response definition 3: # 4: # $Id: response.pm,v 1.178 2007/09/27 19:05:03 albertel 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: # 28: 29: package Apache::response; 30: use strict; 31: use Apache::lonlocal; 32: use Apache::lonnet; 33: use Apache::lonmaxima(); 34: 35: BEGIN { 36: &Apache::lonxml::register('Apache::response',('responseparam','parameter','dataresponse','customresponse','mathresponse')); 37: } 38: 39: sub start_response { 40: my ($parstack,$safeeval)=@_; 41: my $id = &Apache::lonxml::get_id($parstack,$safeeval); 42: if ($#Apache::inputtags::import > -1) { 43: &Apache::lonxml::debug("Turning :$id: into"); 44: $id = join('_',@Apache::inputtags::import).'_'.$id; 45: &Apache::lonxml::debug("New :$id:"); 46: } 47: push (@Apache::inputtags::response,$id); 48: push (@Apache::inputtags::responselist,$id); 49: @Apache::inputtags::inputlist=(); 50: if ($Apache::inputtags::part eq '' && 51: !$Apache::lonhomework::ignore_response_errors) { 52: &Apache::lonxml::error(&HTML::Entities::encode(&mt("Found a <*response> outside of a <part> in a <part>ed problem"),'<>&"')); 53: } 54: if ($Apache::inputtags::response_with_no_part && 55: $Apache::inputtags::part ne '0') { 56: &Apache::lonxml::error(&HTML::Entities::encode(&mt("<*response>s are both inside of <part> and outside of <part>, this is not a valid problem, errors in grading may occur."),'<>&"').'<br />'); 57: } 58: if ($Apache::inputtags::part eq '0') { 59: $Apache::inputtags::response_with_no_part=1; 60: } 61: return $id; 62: } 63: 64: sub end_response { 65: #pop @Apache::inputtags::response; 66: @Apache::inputtags::inputlist=(); 67: return ''; 68: } 69: 70: sub start_hintresponse { 71: my ($parstack,$safeeval)=@_; 72: my $id = &Apache::lonxml::get_id($parstack,$safeeval); 73: push (@Apache::inputtags::hint,$id); 74: push (@Apache::inputtags::hintlist,$id); 75: push (@Apache::inputtags::paramstack,[%Apache::inputtags::params]); 76: return $id; 77: } 78: 79: sub end_hintresponse { 80: pop @Apache::inputtags::hint; 81: if (defined($Apache::inputtags::paramstack[-1])) { 82: %Apache::inputtags::params= 83: @{ pop(@Apache::inputtags::paramstack) }; 84: } 85: return ''; 86: } 87: 88: my @randomseeds; 89: sub pushrandomnumber { 90: my $rand_alg=&Apache::lonnet::get_rand_alg(); 91: if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' || 92: $rand_alg eq '64bit2') { 93: # do nothing 94: } else { 95: my @seed=&Math::Random::random_get_seed(); 96: push(@randomseeds,\@seed); 97: } 98: &Apache::response::setrandomnumber(@_); 99: } 100: sub poprandomnumber { 101: my $rand_alg=&Apache::lonnet::get_rand_alg(); 102: if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' || 103: $rand_alg eq '64bit2') { 104: return; 105: } 106: my $seed=pop(@randomseeds); 107: if ($seed) { 108: &Math::Random::random_set_seed(@$seed); 109: } else { 110: &Apache::lonxml::error("Unable to restore random algorithm."); 111: } 112: } 113: 114: sub setrandomnumber { 115: my ($ignore_id2) = @_; 116: my $rndseed; 117: $rndseed=&Apache::structuretags::setup_rndseed(); 118: if (!defined($rndseed)) { $rndseed=&Apache::lonnet::rndseed(); } 119: &Apache::lonxml::debug("randseed $rndseed"); 120: # $rndseed=unpack("%32i",$rndseed); 121: my $rand_alg=&Apache::lonnet::get_rand_alg(); 122: my ($rndmod,$rndmod2); 123: 124: my ($id1,$id2,$shift_amt); 125: if ($Apache::lonhomework::parsing_a_problem) { 126: $id1=$Apache::inputtags::part; 127: if (defined($Apache::inputtags::response[-1])) { 128: $id2=$Apache::inputtags::response[-1]; 129: } 130: $shift_amt=scalar(@Apache::inputtags::responselist); 131: } elsif ($Apache::lonhomework::parsing_a_task) { 132: $id1=&Apache::bridgetask::get_dim_id(); 133: if (!$ignore_id2 && ref($Apache::bridgetask::instance{$id1})) { 134: $id2=$Apache::bridgetask::instance{$id1}[-1]; 135: $shift_amt=scalar(@{$Apache::bridgetask::instance{$id1}}); 136: } else { 137: $shift_amt=0; 138: } 139: } 140: &Apache::lonxml::debug("id1: $id1, id2: $id2, shift_amt: $shift_amt"); 141: if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' || 142: $rand_alg eq '64bit2') { 143: $rndmod=(&Apache::lonnet::numval($id1) << 10); 144: if (defined($id2)) { $rndmod+=&Apache::lonnet::numval($id2); } 145: } elsif ($rand_alg eq '64bit3') { 146: $rndmod=(&Apache::lonnet::numval2($id1) << 10); 147: if (defined($id2)) { $rndmod+=&Apache::lonnet::numval2($id2); } 148: } elsif ($rand_alg eq '64bit4') { 149: my $shift=(4*$shift_amt)%30; 150: $rndmod=(&Apache::lonnet::numval3($id1) << (($shift+15)%30)); 151: if (defined($id2)) { 152: $rndmod+=(&Apache::lonnet::numval3($id2) << $shift ); 153: } 154: } else { 155: ($rndmod,$rndmod2)=&Apache::lonnet::digest("$id1,$id2"); 156: } 157: 158: if ($rndseed =~/([,:])/) { 159: my $char=$1; 160: use integer; 161: my ($num1,$num2)=split(/\Q$char\E/,$rndseed); 162: $num1+=$rndmod; 163: $num2+= ((defined($rndmod2)) ? $rndmod2 : $rndmod); 164: if($Apache::lonnet::_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } 165: $rndseed=$num1.$char.$num2; 166: } else { 167: $rndseed+=$rndmod; 168: if($Apache::lonnet::_64bit) { 169: use integer; 170: $rndseed=(($rndseed<<32)>>32); 171: } 172: } 173: &Apache::lonxml::debug("randseed $rndmod $rndseed"); 174: &Apache::lonnet::setup_random_from_rndseed($rndseed); 175: return ''; 176: } 177: 178: sub meta_parameter_write { 179: my ($name,$type,$default,$display)=@_; 180: my $partref=$Apache::inputtags::part; 181: my $result='<parameter part="'.$Apache::inputtags::part.'"'; 182: if (defined($Apache::inputtags::response[-1])) { 183: $result.= ' id="'.$Apache::inputtags::response[-1].'"'; 184: $partref.='_'.$Apache::inputtags::response[-1]; 185: } 186: $result.= ' name="'.$name.'"'. 187: ' type="'.$type.'"'. 188: (defined($default)?' default="'.$default.'"':''). 189: (defined($display)?' display="'.$display.' [Part: '.$partref.']"':'') 190: .'></parameter>' 191: ."\n"; 192: return $result; 193: } 194: 195: sub meta_package_write { 196: my $name=shift; 197: my $result = '<parameter part="'.$Apache::inputtags::part.'"'; 198: if(defined($Apache::inputtags::response[-1])) { 199: $result.= ' id="'.$Apache::inputtags::response[-1].'"'; 200: } 201: $result.=' package="'.$name.'"></parameter>'."\n"; 202: return $result; 203: } 204: 205: sub meta_stores_write { 206: my ($name,$type,$display)=@_; 207: my $partref=$Apache::inputtags::part; 208: my $result = '<stores part="'.$Apache::inputtags::part.'"'; 209: if (defined($Apache::inputtags::response[-1])) { 210: $result.= ' id="'.$Apache::inputtags::response[-1].'"'; 211: $partref.='_'.$Apache::inputtags::response[-1]; 212: } 213: $result.= ' name="'.$name.'"'. 214: ' type="'.$type.'"'. 215: ' display="'.$display.' [Part: '.$partref.']"'. 216: "></stores>\n"; 217: } 218: 219: sub mandatory_part_meta { 220: # 221: # Autogenerate metadata for mandatory 222: # input (from RAT or lonparmset) and 223: # output (to lonspreadsheet) 224: # of each part 225: # 226: return 227: # &meta_parameter_write('opendate','date_start','', 228: # 'Opening Date'). 229: # &meta_parameter_write('duedate','date_end','', 230: # 'Due Date'). 231: # &meta_parameter_write('answerdate','date_start','', 232: # 'Show Answer Date'). 233: # &meta_parameter_write('weight','int_zeropos','', 234: # 'Available Points'). 235: # &meta_parameter_write('maxtries','int_pos','', 236: # 'Maximum Number of Tries'). 237: &meta_package_write('part'). 238: &meta_stores_write('solved','string', 239: 'Problem Status'). 240: &meta_stores_write('tries','int_zeropos', 241: 'Number of Attempts'). 242: &meta_stores_write('awarded','float', 243: 'Partial Credit Factor'); 244: # 245: # Note: responseid-specific data 'submission' and 'awarddetail' 246: # not available to spreadsheet -> skip here 247: # 248: } 249: 250: sub meta_part_order { 251: if (@Apache::inputtags::partlist) { 252: my @parts=@Apache::inputtags::partlist; 253: shift(@parts); 254: return '<partorder>'.join(',',@parts).'</partorder>'."\n"; 255: } else { 256: return '<partorder>0</partorder>'."\n"; 257: } 258: } 259: 260: sub meta_response_order { 261: if (@Apache::inputtags::responselist) { 262: return '<responseorder>'.join(',',@Apache::inputtags::responselist). 263: '</responseorder>'."\n"; 264: } 265: } 266: 267: sub check_for_previous { 268: my ($curresponse,$partid,$id,$last) = @_; 269: my %previous; 270: $previous{'used'} = 0; 271: foreach my $key (sort(keys(%Apache::lonhomework::history))) { 272: if ($key =~ /resource\.$partid\.$id\.submission$/) { 273: if ( $last && $key =~ /^(\d+):/ ) { 274: next if ($1 >= $last); 275: } 276: &Apache::lonxml::debug("Trying $key"); 277: my $pastresponse=$Apache::lonhomework::history{$key}; 278: if ($pastresponse eq $curresponse) { 279: $previous{'used'} = 1; 280: my $history; 281: if ( $key =~ /^(\d+):/ ) { 282: $history=$1; 283: $previous{'award'} = $Apache::lonhomework::history{"$history:resource.$partid.$id.awarddetail"}; 284: $previous{'last'}='0'; 285: push(@{ $previous{'version'} },$history); 286: } else { 287: $previous{'award'} = $Apache::lonhomework::history{"resource.$partid.$id.awarddetail"}; 288: $previous{'last'}='1'; 289: } 290: if (! $previous{'award'} ) { $previous{'award'} = 'UNKNOWN'; } 291: &Apache::lonxml::debug("got a match :$previous{'award'}:$previous{'used'}:"); 292: } 293: } 294: } 295: &Apache::lonhomework::showhash(%previous); 296: return %previous; 297: } 298: 299: sub handle_previous { 300: my ($previous,$ad)=@_; 301: if ($$previous{'used'} && ($$previous{'award'} eq $ad) ) { 302: if ($$previous{'last'}) { 303: push(@Apache::inputtags::previous,'PREVIOUSLY_LAST'); 304: push(@Apache::inputtags::previous_version,$$previous{'version'}); 305: } elsif ($Apache::lonhomework::type ne 'survey') { 306: push(@Apache::inputtags::previous,'PREVIOUSLY_USED'); 307: push(@Apache::inputtags::previous_version,$$previous{'version'}); 308: } 309: } 310: } 311: 312: sub view_or_modify { 313: my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser(); 314: my $myself=0; 315: if ( ($name eq $env{'user.name'}) && ($domain eq $env{'user.domain'}) ) { 316: $myself=1; 317: } 318: my $vgr=&Apache::lonnet::allowed('vgr',$courseid); 319: my $mgr=&Apache::lonnet::allowed('vgr',$courseid); 320: if ($mgr) { return "M"; } 321: if ($vgr) { return "V"; } 322: if ($myself) { return "V"; } 323: return ''; 324: } 325: 326: sub start_dataresponse { 327: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 328: my $id = &Apache::response::start_response($parstack,$safeeval); 329: my $result; 330: if ($target eq 'web') { 331: $result = $token->[2]->{'display'}.':'; 332: } elsif ($target eq 'meta') { 333: $result = &Apache::response::meta_stores_write($token->[2]->{'name'}, 334: $token->[2]->{'type'}, 335: $token->[2]->{'display'}); 336: $result .= &Apache::response::meta_package_write('dataresponse'); 337: } 338: return $result; 339: } 340: 341: sub end_dataresponse { 342: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 343: my $result; 344: if ( $target eq 'web' ) { 345: } elsif ($target eq 'grade' ) { 346: if ( defined $env{'form.submitted'}) { 347: my ($symb,$courseid,$domain,$name)=&Apache::lonnet::whichuser(); 348: my $allowed=&Apache::lonnet::allowed('mgr',$courseid); 349: if ($allowed) { 350: &Apache::response::setup_params('dataresponse',$safeeval); 351: my $partid = $Apache::inputtags::part; 352: my $id = $Apache::inputtags::response['-1']; 353: my $response = $env{'form.HWVAL_'.$id}; 354: my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval); 355: if ( $response =~ /[^\s]/) { 356: $Apache::lonhomework::results{"resource.$partid.$id.$name"}=$response; 357: $Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response; 358: $Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}='SUBMITTED'; 359: } 360: } else { 361: $result='Not Permitted to change values.' 362: } 363: } 364: } 365: &Apache::response::end_response; 366: return $result; 367: } 368: 369: sub start_customresponse { 370: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 371: my $id = &Apache::response::start_response($parstack,$safeeval); 372: push(@Apache::lonxml::namespace,'customresponse'); 373: my $result; 374: @Apache::response::custom_answer=(); 375: @Apache::response::custom_answer_type=(); 376: &Apache::lonxml::register('Apache::response',('answer')); 377: if ($target eq 'web') { 378: if ( &Apache::response::show_answer() ) { 379: my $answer = &Apache::lonxml::get_param('answerdisplay',$parstack, 380: $safeeval); 381: $Apache::inputtags::answertxt{$id}=[$answer]; 382: } 383: } elsif ($target eq 'edit') { 384: $result.=&Apache::edit::tag_start($target,$token); 385: $result.=&Apache::edit::text_arg('String to display for answer:', 386: 'answerdisplay',$token); 387: $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row(); 388: } elsif ($target eq 'modified') { 389: my $constructtag; 390: $constructtag=&Apache::edit::get_new_args($token,$parstack, 391: $safeeval,'answerdisplay'); 392: if ($constructtag) { 393: $result = &Apache::edit::rebuild_tag($token); 394: } 395: } elsif ($target eq 'answer' || $target eq 'grade') { 396: &Apache::response::reset_params(); 397: } elsif ($target eq 'meta') { 398: $result .= &Apache::response::meta_package_write('customresponse'); 399: } 400: return $result; 401: } 402: 403: sub end_customresponse { 404: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 405: my $result; 406: my $part=$Apache::inputtags::part; 407: my $id=$Apache::inputtags::response[-1]; 408: if ( $target eq 'grade' && &Apache::response::submitted() ) { 409: my $response = &Apache::response::getresponse(); 410: if ($Apache::lonhomework::type eq 'exam' || 411: &Apache::response::submitted('scantron')) { 412: &Apache::response::scored_response($part,$id); 413: } elsif ( $response =~ /[^\s]/ && 414: $Apache::response::custom_answer_type[-1] eq 'loncapa/perl') { 415: if (!$Apache::lonxml::default_homework_loaded) { 416: &Apache::lonxml::default_homework_load($safeeval); 417: } 418: my %previous = &Apache::response::check_for_previous($response, 419: $part,$id); 420: $Apache::lonhomework::results{"resource.$part.$id.submission"}= 421: $response; 422: my $error; 423: ${$safeeval->varglob('LONCAPA::customresponse_submission')}= 424: $response; 425: 426: my $award = &Apache::run::run('{ my $submission=$LONCAPA::customresponse_submission;'.$Apache::response::custom_answer[-1].'}',$safeeval); 427: if (!&Apache::inputtags::valid_award($award)) { 428: $error = $award; 429: $award = 'ERROR'; 430: } 431: &Apache::response::handle_previous(\%previous,$award); 432: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}= 433: $award; 434: if ($error) { 435: $Apache::lonhomework::results{"resource.$part.$id.awardmsg"}= 436: $error; 437: } 438: } 439: } elsif ( $target eq 'answer') { 440: $result = &Apache::response::answer_header('customresponse'); 441: my $answer = &Apache::lonxml::get_param('answerdisplay',$parstack, 442: $safeeval); 443: if ($env{'form.answer_output_mode'} ne 'tex') { 444: $answer = '<b>'.$answer.'</b>'; 445: } 446: $result .= &Apache::response::answer_part('customresponse',$answer); 447: $result .= &Apache::response::answer_footer('customresponse'); 448: } 449: if ($target eq 'web') { 450: &setup_prior_tries_hash(\&format_prior_response_math); 451: } 452: if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || 453: $target eq 'tex' || $target eq 'analyze') { 454: &Apache::lonxml::increment_counter(&Apache::response::repetition()); 455: } 456: pop(@Apache::lonxml::namespace); 457: pop(@Apache::response::custom_answer); 458: pop(@Apache::response::custom_answer_type); 459: &Apache::lonxml::deregister('Apache::response',('answer')); 460: &Apache::response::end_response(); 461: return $result; 462: } 463: 464: sub format_prior_response_custom { 465: my ($mode,$answer) =@_; 466: return '<span class="LC_prior_custom">'. 467: &HTML::Entities::encode($answer,'"<>&').'</span>'; 468: } 469: 470: sub start_mathresponse { 471: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 472: my $id = &Apache::response::start_response($parstack,$safeeval); 473: push(@Apache::lonxml::namespace,'mathresponse'); 474: my $result; 475: @Apache::response::custom_answer=(); 476: @Apache::response::custom_answer_type=(); 477: &Apache::lonxml::register('Apache::response',('answer')); 478: if ($target eq 'web') { 479: if ( &Apache::response::show_answer() ) { 480: my $answer = &Apache::lonxml::get_param('answerdisplay',$parstack, 481: $safeeval); 482: $Apache::inputtags::answertxt{$id}=[$answer]; 483: } 484: } elsif ($target eq 'edit') { 485: $result.=&Apache::edit::tag_start($target,$token); 486: $result.=&Apache::edit::text_arg('String to display for answer:', 487: 'answerdisplay',$token); 488: $result.=&Apache::edit::select_arg('Algebra System:', 489: 'cas', 490: ['maxima'], 491: $token); 492: $result.=&Apache::edit::text_arg('Argument Array:', 493: 'args',$token); 494: $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row(); 495: } elsif ($target eq 'modified') { 496: my $constructtag; 497: $constructtag=&Apache::edit::get_new_args($token,$parstack, 498: $safeeval,'answerdisplay','cas','args'); 499: if ($constructtag) { 500: $result = &Apache::edit::rebuild_tag($token); 501: } 502: } elsif ($target eq 'answer' || $target eq 'grade') { 503: &Apache::response::reset_params(); 504: } elsif ($target eq 'meta') { 505: $result .= &Apache::response::meta_package_write('mathresponse'); 506: } 507: return $result; 508: } 509: 510: sub end_mathresponse { 511: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 512: my $result; 513: my $part=$Apache::inputtags::part; 514: my $id=$Apache::inputtags::response[-1]; 515: if ( $target eq 'grade' && &Apache::response::submitted() ) { 516: my $response = &Apache::response::getresponse(); 517: if ( $response =~ /[^\s]/ ) { 518: if (!$Apache::lonxml::default_homework_loaded) { 519: &Apache::lonxml::default_homework_load($safeeval); 520: } 521: my %previous = &Apache::response::check_for_previous($response, 522: $part,$id); 523: $Apache::lonhomework::results{"resource.$part.$id.submission"}= 524: $response; 525: my $error; 526: my $award; 527: my $cas = &Apache::lonxml::get_param('cas',$parstack,$safeeval); 528: if ($cas eq 'maxima') { 529: my $args = [&Apache::lonxml::get_param_var('args',$parstack,$safeeval)]; 530: $award=&Apache::lonmaxima::maxima_run($Apache::response::custom_answer[-1],$response,$args); 531: } 532: if (!&Apache::inputtags::valid_award($award)) { 533: $error = $award; 534: $award = 'ERROR'; 535: } 536: &Apache::response::handle_previous(\%previous,$award); 537: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}= 538: $award; 539: if ($error) { 540: $Apache::lonhomework::results{"resource.$part.$id.awardmsg"}= 541: $error; 542: } 543: } 544: } 545: if ($target eq 'web') { 546: &setup_prior_tries_hash(\&format_prior_response_math); 547: } 548: 549: pop(@Apache::lonxml::namespace); 550: pop(@Apache::response::custom_answer); 551: pop(@Apache::response::custom_answer_type); 552: &Apache::lonxml::deregister('Apache::response',('answer')); 553: &Apache::response::end_response(); 554: return $result; 555: } 556: 557: sub format_prior_response_math { 558: my ($mode,$answer) =@_; 559: return '<span class="LC_prior_math">'. 560: &HTML::Entities::encode($answer,'"<>&').'</span>'; 561: } 562: 563: sub implicit_multiplication { 564: my ($expression)=@_; 565: # Escape scientific notation, so 3e8 does not become 3*e*8 566: # 3e8 -> 3&8; 3e-8 -> 3&-8; 3E+8 -> e&+8 567: $expression=~s/(\d+)e([\+\-]*\d+)/$1\&\($2\)/gsi; 568: # 3x10^8 -> 3&8; 3*10^-8 -> 3&-8 569: $expression=~s/(\d+)(?:x|\*)10(?:\^|\*\*)([\+\-]*\d+)/$1\&\($2\)/gsi; 570: # Fill in multiplication signs 571: # a b -> a*b;3 b -> 3*b;3 4 -> 3*4 572: $expression=~s/([A-Za-z0-9])\s+(?=[A-Za-z0-9])/$1\*/gs; 573: # )( -> )*(; ) ( -> )*( 574: $expression=~s/\)\s*\(/\)\*\(/gs; 575: # 3a -> 3*a; 3( -> 3*(; 3 ( -> 3*(; 3A -> 3*A 576: $expression=~s/(\d)\s*([a-zA-Z\(])/$1\*$2/gs; 577: # a ( -> a*( 578: $expression=~s/([A-Za-z0-9])\s+\(/$1\*\(/gs; 579: # )a -> )*a; )3 -> )*3; ) 3 -> )*3 580: $expression=~s/\)\s*([A-Za-z0-9])/\)\*$1/gs; 581: # 3&8 -> 3e8; 3&-4 -> 3e-4 582: $expression=~s/(\d+)\&\(([\+\-]*\d+)\)/$1e$2/gs; 583: return $expression; 584: } 585: 586: sub start_answer { 587: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 588: my $result; 589: push(@Apache::response::custom_answer, 590: &Apache::lonxml::get_all_text_unbalanced("/answer",$parser)); 591: push(@Apache::response::custom_answer_type, 592: lc(&Apache::lonxml::get_param('type',$parstack,$safeeval))); 593: $Apache::response::custom_answer_type[-1] =~ s/\s+//g; 594: if ($target eq "edit" ) { 595: $result=&Apache::edit::tag_start($target,$token,'Answer algorithm'); 596: $result.=&Apache::edit::editfield($token->[1], 597: $Apache::response::custom_answer[-1], 598: '',80,4); 599: } elsif ( $target eq "modified" ) { 600: $result=$token->[4].&Apache::edit::modifiedfield('/answer',$parser); 601: } 602: return $result; 603: } 604: 605: sub end_answer { 606: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 607: if ($target eq 'edit' ) { 608: return &Apache::edit::end_table(); 609: } 610: } 611: 612: sub decide_package { 613: my ($tagstack)=@_; 614: my $package; 615: if ($$tagstack[-1] eq 'parameter') { 616: $package='part'; 617: } else { 618: my $i=-1; 619: while (defined($$tagstack[$i])) { 620: if ($$tagstack[$i] =~ /(response|hint)$/) { 621: $package=$$tagstack[$i]; 622: last; 623: } 624: $i--; 625: } 626: } 627: return $package; 628: } 629: 630: sub start_responseparam { 631: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 632: my $result=''; 633: if ($target eq 'meta') { 634: $result = &meta_parameter_write($token->[2]->{'name'}, 635: $token->[2]->{'type'}, 636: $token->[2]->{'default'}, 637: $token->[2]->{'description'}); 638: } elsif ($target eq 'edit') { 639: $result.=&Apache::edit::tag_start($target,$token); 640: my $optionlist; 641: my $package=&decide_package($tagstack); 642: foreach my $key (sort(keys(%Apache::lonnet::packagetab))) { 643: if ($key =~ /^\Q$package\E&(.*)&display$/) { 644: $optionlist.='<option value="'.$1.'">'. 645: $Apache::lonnet::packagetab{$key}.'</option>'; 646: } 647: } 648: if (defined($optionlist)) { 649: $result.='Use template: <select name="'. 650: &Apache::edit::html_element_name('parameter_package').'">'. 651: '<option value=""></option>'.$optionlist.'</select><br />'; 652: } 653: $result.=&Apache::edit::text_arg('Name:','name',$token). 654: &Apache::edit::text_arg('Type:','type',$token). 655: &Apache::edit::text_arg('Description:','description',$token). 656: &Apache::edit::text_arg('Default:','default',$token). 657: "</td></tr>"; 658: $result.=&Apache::edit::end_table; 659: } elsif ($target eq 'modified') { 660: my $constructtag=&Apache::edit::get_new_args($token,$parstack, 661: $safeeval,'name','type', 662: 'description','default'); 663: my $element=&Apache::edit::html_element_name('parameter_package'); 664: if (defined($env{"form.$element"}) && $env{"form.$element"} ne '') { 665: my $name=$env{"form.$element"}; 666: my $tag=&decide_package($tagstack); 667: $token->[2]->{'name'}=$name; 668: $token->[2]->{'type'}= 669: $Apache::lonnet::packagetab{"$tag&$name&type"}; 670: $token->[2]->{'description'}= 671: $Apache::lonnet::packagetab{"$tag&$name&display"}; 672: $token->[2]->{'default'}= 673: $Apache::lonnet::packagetab{"$tag&$name&default"}; 674: $constructtag=1; 675: } 676: if ($constructtag) { 677: $result = &Apache::edit::rebuild_tag($token); 678: } 679: } elsif ($target eq 'grade' || $target eq 'answer' || $target eq 'web' || 680: $target eq 'tex' || $target eq 'analyze' ) { 681: if ($env{'request.state'} eq 'construct') { 682: my $name =&Apache::lonxml::get_param('name',$parstack,$safeeval); 683: my $default=&Apache::lonxml::get_param('default',$parstack, 684: $safeeval); 685: if ($name) {$Apache::inputtags::params{$name}=$default;} 686: } 687: } 688: return $result; 689: } 690: 691: sub end_responseparam { 692: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 693: if ($target eq 'edit') { return ('','no'); } 694: return ''; 695: } 696: 697: sub start_parameter { 698: return &start_responseparam(@_); 699: } 700: 701: sub end_parameter { 702: return &end_responseparam(@_); 703: } 704: 705: sub reset_params { 706: %Apache::inputtags::params=(); 707: } 708: 709: sub setup_params { 710: my ($tag,$safeeval) = @_; 711: 712: if ($env{'request.state'} eq 'construct') { return; } 713: my %paramlist=(); 714: foreach my $key (keys(%Apache::lonnet::packagetab)) { 715: if ($key =~ /^\Q$tag\E/) { 716: my ($package,$name) = split(/&/,$key); 717: $paramlist{$name}=1; 718: } 719: } 720: foreach my $key (keys(%paramlist)) { 721: my $entry= 'resource.'.$Apache::inputtags::part; 722: if (defined($Apache::inputtags::response[-1])) { 723: $entry.='_'.$Apache::inputtags::response[-1]; 724: } 725: $entry.='.'.$key; 726: &Apache::lonxml::debug("looking for $entry"); 727: my $value = &Apache::lonnet::EXT("$entry"); 728: &Apache::lonxml::debug("$key has value :$value:"); 729: if ($value eq 'con_lost' || $value =~ /^error:/) { 730: &Apache::lonxml::debug("using nothing"); 731: $Apache::inputtags::params{$key}=''; 732: } else { 733: my $string="{return qq\0".$value."\0}"; 734: my $newvalue=&Apache::run::run($string,$safeeval,1); 735: if (defined($newvalue)) { $value=$newvalue; } 736: $Apache::inputtags::params{$key}=$value; 737: } 738: } 739: } 740: 741: { 742: my @answer_bits; 743: my $need_row_start; 744: 745: sub answer_header { 746: my ($type,$increment,$rows) = @_; 747: my $result; 748: if ($env{'form.answer_output_mode'} eq 'tex') { 749: undef(@answer_bits); 750: my $bit; 751: if ($Apache::lonhomework::type eq 'exam') { 752: $bit = ($Apache::lonxml::counter+$increment).') '; 753: } else { 754: $bit .= ' Answer for Part: \verb|'. 755: $Apache::inputtags::part.'| '; 756: } 757: push(@answer_bits,$bit); 758: } else { 759: my $td = '<td '.(defined($rows)?'rowspan="'.$rows.'"':'').'>'; 760: $result = '<table border="1"><tr>'; 761: if ($Apache::lonhomework::type eq 'exam') { 762: $result .= $td.($Apache::lonxml::counter+$increment). ')</td>'; 763: } else { 764: $result .= $td.&mt('Answer for Part: [_1]', 765: $Apache::inputtags::part).'</td>'; 766: } 767: $result .= "\n"; 768: $need_row_start = 0; 769: } 770: return $result; 771: } 772: 773: sub next_answer { 774: my ($type) = @_; 775: my $result; 776: if ($env{'form.answer_output_mode'} eq 'tex') { 777: # FIXME ... need to do something with tex mode 778: } else { 779: $result .= "</tr>"; 780: $need_row_start = 1; 781: } 782: return $result; 783: } 784: 785: sub answer_part { 786: my ($type,$answer,$args) = @_; 787: my $result; 788: if ($env{'form.answer_output_mode'} eq 'tex') { 789: if (!$args->{'no_verbatim'}) { 790: my $to_use='|'; 791: foreach my $value (32..126) { 792: my $char=pack('c',$value); 793: if ($answer !~ /\Q$char\E/) { 794: $to_use=$char; 795: last; 796: } 797: } 798: if ($answer ne '') { 799: $answer = '\verb'.$to_use.$answer.$to_use; 800: } 801: } 802: if ($answer ne '') { 803: push(@answer_bits,$answer); 804: } 805: } else { 806: if ($need_row_start) { 807: $result .= '<tr>'; 808: $need_row_start = 0; 809: } 810: $result .= '<td>'.$answer.'</td>'; 811: } 812: return $result; 813: } 814: 815: sub answer_footer { 816: my ($type) = @_; 817: my $result; 818: if ($env{'form.answer_output_mode'} eq 'tex') { 819: my $columns = scalar(@answer_bits); 820: $result = ' \vskip 0 mm \noindent \begin{tabular}{|'.'c|'x$columns.'}\hline '; 821: $result .= join(' & ',@answer_bits); 822: $result .= ' \\\\ \\hline \end{tabular} \vskip 0 mm '; 823: } else { 824: $result = '</tr></table>'; 825: } 826: return $result; 827: } 828: 829: } 830: 831: sub showallfoils { 832: if (defined($env{'form.showallfoils'})) { 833: my ($symb)=&Apache::lonnet::whichuser(); 834: if (($env{'request.state'} eq 'construct') || 835: ($env{'user.adv'} && $symb eq '') || 836: ($Apache::lonhomework::viewgrades) ) { 837: return 1; 838: } 839: } 840: if ($Apache::lonhomework::type eq 'survey') { return 1; } 841: return 0; 842: } 843: 844: =pod 845: 846: =item &getresponse($offset,$resulttype); 847: 848: Retreives the current submitted response, helps out in the case of 849: scantron mode. 850: 851: Returns either the exact text of the submission, or a bubbled response 852: converted to something usable. 853: 854: Optional Arguments: 855: $offset - (defaults to 1) if a problem has more than one bubble 856: response, pass in the number of the bubble wanted, (the 857: first bubble associated with a problem has an offset of 1, 858: the second bubble is 2 859: 860: $resulttype - undef -> a number between 0 and 25 861: 'A is 1' -> a number between 1 and 26 862: 'letter' -> a letter between 'A' and 'Z' 863: $lines - undef problem only needs a single line of bubbles. 864: nonzero Problem wants the first nonempty response in 865: $lines lines of bubbles. 866: $bubbles_per_line - Must be provided if lines is defined.. number of 867: bubbles on a line. 868: 869: =cut 870: 871: sub getresponse { 872: my ($offset,$resulttype, $lines, $bubbles_per_line)=@_; 873: my $formparm='form.HWVAL_'.$Apache::inputtags::response['-1']; 874: my $response; 875: if (!defined($offset)) { 876: $offset=1; 877: } else { 878: $formparm.=":$offset"; 879: } 880: if (!defined($lines)) { 881: $lines = 1; 882: } 883: 884: my %let_to_num=('A'=>0,'B'=>1,'C'=>2,'D'=>3,'E'=>4,'F'=>5,'G'=>6,'H'=>7, 885: 'I'=>8,'J'=>9,'K'=>10,'L'=>11,'M'=>12,'N'=>13,'O'=>14, 886: 'P'=>15,'Q'=>16,'R'=>17,'S'=>18,'T'=>19,'U'=>20,'V'=>21, 887: 'W'=>22,'X'=>23,'Y'=>24,'Z'=>25); 888: if ($env{'form.submitted'} eq 'scantron') { 889: my $part = $Apache::inputtags::part; 890: my $id = $Apache::inputtags::response[-1]; 891: 892: my $line; 893: for ($line = 0; $line < $lines; $line++) { 894: $response = $env{'scantron.'. 895: ($Apache::lonxml::counter+$offset-1+$line). 896: '.answer'}; 897: if ($response ne "") { 898: last; 899: } 900: 901: } 902: 903: # save bubbled letter for later 904: $Apache::lonhomework::results{"resource.$part.$id.scantron"}.= 905: $response; 906: 907: if ($resulttype ne 'letter') { 908: if ($resulttype eq 'A is 1') { 909: $response = $let_to_num{$response}+1; 910: } else { 911: $response = $let_to_num{$response}; 912: } 913: if ($response ne "") { 914: $response += $line * $bubbles_per_line; 915: } 916: } else { 917: if ($response ne "") { 918: $response = chr(ord($response) + $line * $bubbles_per_line); 919: } 920: } 921: 922: } else { 923: $response = $env{$formparm}; 924: } 925: # 926: # If we have a nonempty answer, correct the numeric value 927: # of the answer for the line on which it was found. 928: # 929: 930: return $response; 931: } 932: 933: =pod 934: 935: =item &repetition(); 936: 937: Returns the number of lines that are required to encode the weight. 938: (Currently expects that there are 10 bubbles per line) 939: 940: =cut 941: 942: sub repetition { 943: my $id = $Apache::inputtags::part; 944: my $weight = &Apache::lonnet::EXT("resource.$id.weight"); 945: if (!defined($weight) || ($weight eq '')) { $weight=1; } 946: my $repetition = int($weight/10); 947: if ($weight % 10 != 0) { $repetition++; } 948: return $repetition; 949: } 950: 951: =pod 952: 953: =item &scored_response($part_id,$response_id); 954: 955: Sets the results hash elements 956: 957: resource.$part_id.$response_id.awarded - to the floating point 958: number between 0 and 1 that was awarded on the bubbled input 959: 960: resource.$part_id.$response_id.awarddetail - to 'ASSIGNED_SCORE' 961: 962: Returns 963: 964: the number of bubble sheet lines that were used (and likely need to 965: be passed to &Apache::lonxml::increment_counter() 966: 967: Arguments 968: 969: $part_id - id of the part to grade 970: $response_id - id of the response to grade 971: 972: 973: =cut 974: 975: sub scored_response { 976: my ($part,$id)=@_; 977: my $repetition=&repetition(); 978: my $score=0; 979: for (my $i=0;$i<$repetition;$i++) { 980: # A is 1, B is 2, etc. (get response return 0-9 and then we add 1) 981: my $increase=&Apache::response::getresponse($i+1); 982: if ($increase ne '') { $score+=$increase+1; } 983: } 984: my $weight = &Apache::lonnet::EXT("resource.$part.weight"); 985: if (!defined($weight) || $weight eq '' || $weight eq 0) { $weight = 1; } 986: my $pcr=$score/$weight; 987: $Apache::lonhomework::results{"resource.$part.$id.awarded"}=$pcr; 988: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}= 989: 'ASSIGNED_SCORE'; 990: return $repetition; 991: } 992: 993: sub whichorder { 994: my ($max,$randomize,$showall,$hash)=@_; 995: #&Apache::lonxml::debug("man $max randomize $randomize"); 996: if (!defined(@{ $$hash{'names'} })) { return; } 997: my @names = @{ $$hash{'names'} }; 998: my @whichopt =(); 999: my (%top,@toplist,%bottom,@bottomlist); 1000: if (!($showall || ($randomize eq 'no'))) { 1001: my $current=0; 1002: foreach my $name (@names) { 1003: $current++; 1004: if ($$hash{"$name.location"} eq 'top') { 1005: $top{$name}=$current; 1006: } elsif ($$hash{"$name.location"} eq 'bottom') { 1007: $bottom{$name}=$current; 1008: } 1009: } 1010: } 1011: my $topcount=0; 1012: my $bottomcount=0; 1013: while (((scalar(@whichopt)+$topcount+$bottomcount) < $max || $showall) 1014: && ($#names > -1)) { 1015: #&Apache::lonxml::debug("Have $#whichopt max is $max"); 1016: my $aopt; 1017: if ($showall || ($randomize eq 'no')) { 1018: $aopt=0; 1019: } else { 1020: $aopt=int(&Math::Random::random_uniform() * ($#names+1)); 1021: } 1022: #&Apache::lonxml::debug("From $#whichopt $max $#names elms, picking $aopt"); 1023: $aopt=splice(@names,$aopt,1); 1024: #&Apache::lonxml::debug("Picked $aopt"); 1025: if ($top{$aopt}) { 1026: $toplist[$top{$aopt}]=$aopt; 1027: $topcount++; 1028: } elsif ($bottom{$aopt}) { 1029: $bottomlist[$bottom{$aopt}]=$aopt; 1030: $bottomcount++; 1031: } else { 1032: push (@whichopt,$aopt); 1033: } 1034: } 1035: for (my $i=0;$i<=$#toplist;$i++) { 1036: if ($toplist[$i]) { unshift(@whichopt,$toplist[$i]) } 1037: } 1038: for (my $i=0;$i<=$#bottomlist;$i++) { 1039: if ($bottomlist[$i]) { push(@whichopt,$bottomlist[$i]) } 1040: } 1041: return @whichopt; 1042: } 1043: 1044: sub show_answer { 1045: my $part = $Apache::inputtags::part; 1046: my $award = $Apache::lonhomework::history{"resource.$part.solved"}; 1047: my $status = $Apache::inputtags::status[-1]; 1048: return ( ($award =~ /^correct/ 1049: && lc($Apache::lonhomework::problemstatus) ne 'no') 1050: || $status eq "SHOW_ANSWER"); 1051: } 1052: 1053: sub analyze_store_foilgroup { 1054: my ($shown,$attrs)=@_; 1055: my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]"; 1056: foreach my $name (@{ $Apache::response::foilgroup{'names'} }) { 1057: if (defined($Apache::lonhomework::analyze{"$part_id.foil.value.$name"})) { next; } 1058: push (@{ $Apache::lonhomework::analyze{"$part_id.foils"} },$name); 1059: foreach my $attr (@$attrs) { 1060: $Apache::lonhomework::analyze{"$part_id.foil.".$attr.".$name"} = 1061: $Apache::response::foilgroup{"$name.".$attr}; 1062: } 1063: } 1064: push (@{ $Apache::lonhomework::analyze{"$part_id.shown"} }, @{ $shown }); 1065: } 1066: 1067: sub check_if_computed { 1068: my ($token,$parstack,$safeeval,$name)=@_; 1069: my $value = &Apache::lonxml::get_param($name,$parstack,$safeeval); 1070: if (ref($token->[2]) eq 'HASH' && $value ne $token->[2]{$name}) { 1071: my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]"; 1072: $Apache::lonhomework::analyze{"$part_id.answercomputed"} = 1; 1073: } 1074: } 1075: 1076: sub pick_foil_for_concept { 1077: my ($target,$attrs,$hinthash,$parstack,$safeeval)=@_; 1078: if (not defined(@{ $Apache::response::conceptgroup{'names'} })) { return; } 1079: my @names = @{ $Apache::response::conceptgroup{'names'} }; 1080: my $pick=int(&Math::Random::random_uniform() * ($#names+1)); 1081: my $name=$names[$pick]; 1082: push @{ $Apache::response::foilgroup{'names'} }, $name; 1083: foreach my $attr (@$attrs) { 1084: $Apache::response::foilgroup{"$name.".$attr} = 1085: $Apache::response::conceptgroup{"$name.".$attr}; 1086: } 1087: my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval); 1088: $Apache::response::foilgroup{"$name.concept"} = $concept; 1089: &Apache::lonxml::debug("Selecting $name in $concept"); 1090: my $part_id="$Apache::inputtags::part.$Apache::inputtags::response[-1]"; 1091: if ($target eq 'analyze') { 1092: push (@{ $Apache::lonhomework::analyze{"$part_id.concepts"} }, 1093: $concept); 1094: $Apache::lonhomework::analyze{"$part_id.concept.$concept"}= 1095: $Apache::response::conceptgroup{'names'}; 1096: foreach my $name (@{ $Apache::response::conceptgroup{'names'} }) { 1097: push (@{ $Apache::lonhomework::analyze{"$part_id.foils"} }, 1098: $name); 1099: foreach my $attr (@$attrs) { 1100: $Apache::lonhomework::analyze{"$part_id.foil.$attr.$name"}= 1101: $Apache::response::conceptgroup{"$name.$attr"}; 1102: } 1103: } 1104: } 1105: push(@{ $hinthash->{"$part_id.concepts"} },$concept); 1106: $hinthash->{"$part_id.concept.$concept"}= 1107: $Apache::response::conceptgroup{'names'}; 1108: 1109: } 1110: #------------------------------------------------------------ 1111: # 1112: # Get a parameter associated with a problem. 1113: # Parameters: 1114: # $id - the id of the paramater, either a part id, 1115: # or a partid and responspe id joined by _ 1116: # $name - Name of the parameter to fetch 1117: # $default - Default value for the paramter. 1118: # 1119: # 1120: # 1121: sub get_response_param { 1122: my ($id,$name,$default)=@_; 1123: my $parameter; 1124: if ($env{'request.state'} eq 'construct' && 1125: defined($Apache::inputtags::params{$name})) { 1126: $parameter=$Apache::inputtags::params{$name}; 1127: } else { 1128: $parameter=&Apache::lonnet::EXT("resource.$id.$name"); 1129: } 1130: if (!defined($parameter) || $parameter eq '') { 1131: $parameter = $default; 1132: } 1133: return $parameter; 1134: } 1135: 1136: sub submitted { 1137: my ($who)=@_; 1138: 1139: # when scatron grading any submission is a submission 1140: if ($env{'form.submitted'} eq 'scantron') { return 1; } 1141: # if the caller only cared if this was a scantron submission 1142: if ($who eq 'scantron') { return 0; } 1143: # if the Submit Answer button for this particular part was pressed 1144: my $partid=$Apache::inputtags::part; 1145: if ($env{'form.submitted'} eq "part_$partid") { 1146: return 1; 1147: } 1148: if ($env{'form.submitted'} eq "yes" 1149: && defined($env{'form.submit_'.$partid})) { 1150: return 1; 1151: } 1152: # Submit All button on a .page was pressed 1153: if (defined($env{'form.all_submit'})) { return 1; } 1154: # otherwise no submission occured 1155: return 0; 1156: } 1157: 1158: sub add_to_gradingqueue { 1159: my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser(); 1160: if ( $courseid eq '' 1161: || $symb eq '' 1162: || $env{'request.state'} eq 'construct' 1163: || $Apache::lonhomework::type ne 'problem') { 1164: return; 1165: } 1166: 1167: my %queue_info = ( 'type' => 'problem', 1168: 'time' => time); 1169: 1170: if (exists($Apache::lonhomework::history{"resource.0.checkedin.slot"})) { 1171: $queue_info{'slot'}= 1172: $Apache::lonhomework::history{"resource.0.checkedin.slot"}; 1173: } 1174: 1175: my $result=&Apache::bridgetask::add_to_queue('gradingqueue',\%queue_info); 1176: if ($result ne 'ok') { 1177: &Apache::lonxml::error("add_to_queue said $result"); 1178: } 1179: } 1180: 1181: # basically undef and 0 (both false) mean that they still have work to do 1182: # and all true values mean that they can't do any more work 1183: # 1184: # a return of undef means it is unattempted 1185: # a return of 0 means it is attmpted and wrong but still has tries 1186: # a return of 1 means it is marked correct 1187: # a return of 2 means they have exceed maximum number of tries 1188: # a return of 3 means it after the answer date 1189: sub check_status { 1190: my ($id)=@_; 1191: if (!defined($id)) { $id=$Apache::inputtags::part; } 1192: my $curtime=&Apache::lonnet::EXT('system.time'); 1193: my $opendate=&Apache::lonnet::EXT("resource.$id.opendate"); 1194: my $duedate=&Apache::lonnet::EXT("resource.$id.duedate"); 1195: my $answerdate=&Apache::lonnet::EXT("resource.$id.answerdate"); 1196: if ( $opendate && $curtime > $opendate && 1197: $duedate && $curtime > $duedate && 1198: $answerdate && $curtime > $answerdate) { 1199: return 3; 1200: } 1201: my $status=&Apache::lonnet::EXT("user.resource.resource.$id.solved"); 1202: if ($status =~ /^correct/) { return 1; } 1203: if (!$status) { return undef; } 1204: my $maxtries=&Apache::lonnet::EXT("resource.$id.maxtries"); 1205: if ($maxtries eq '') { $maxtries=2; } 1206: my $curtries=&Apache::lonnet::EXT("user.resource.resource.$id.tries"); 1207: if ($curtries < $maxtries) { return 0; } 1208: return 2; 1209: } 1210: 1211: =pod 1212: 1213: =item setup_prior_tries_hash($func,$data) 1214: 1215: Foreach each past .submission $func is called with 3 arguments 1216: - the mode to set things up for (currently always 'grade') 1217: - the stored .submission string 1218: - The expansion of $data 1219: 1220: $data is an array ref containing elements that are either 1221: - scalars that are other elements of the history hash to pass to $func 1222: - ref to data to be passed untouched to $func 1223: 1224: =cut 1225: 1226: sub setup_prior_tries_hash { 1227: my ($func,$data) = @_; 1228: my $part = $Apache::inputtags::part; 1229: my $id = $Apache::inputtags::response[-1]; 1230: foreach my $i (1..$Apache::lonhomework::history{'version'}) { 1231: my $sub_key = "$i:resource.$part.$id.submission"; 1232: next if (!exists($Apache::lonhomework::history{$sub_key})); 1233: my @other_data; 1234: foreach my $datum (@{ $data }) { 1235: if (ref($datum)) { 1236: push(@other_data,$datum); 1237: } else { 1238: my $info_key = "$i:resource.$part.$id.$datum"; 1239: push(@other_data,$Apache::lonhomework::history{$info_key}); 1240: } 1241: } 1242: 1243: my $output = 1244: &$func('grade', 1245: $Apache::lonhomework::history{$sub_key}, 1246: \@other_data); 1247: if (defined($output)) { 1248: $Apache::inputtags::submission_display{$sub_key} = $output; 1249: } 1250: } 1251: } 1252: 1253: 1; 1254: __END__ 1255: