Annotation of loncom/homework/inputtags.pm, revision 1.41
1.41 ! harris41 1: # The LON-CAPA input tags
! 2: #
! 3: # Input definitions.
! 4: #
! 5: # YEAR=2000
! 6: # 7/25,9/11,9/19,10/2,10/11,11/21,11/28,12/1,12/4,12/8,12/11 Guy Albertelli
! 7: # 12/12 Guy Albertelli
! 8: # 12/12 Gerd Kortemeyer
! 9: # 12/12,12/15,12/21 Guy Albertelli
! 10: # YEAR=2001
! 11: # 1/4,1/5,1/6,1/10,1/15,1/24,2/19 Guy Albertelli
1.1 albertel 12:
13: package Apache::inputtags;
14: use strict;
15:
1.41 ! harris41 16: # ======================================================================= BEGIN
1.1 albertel 17: sub BEGIN {
1.41 ! harris41 18: &Apache::lonxml::register('Apache::inputtags',
! 19: ('textarea','textline','datasubmission'));
1.1 albertel 20: }
21:
1.41 ! harris41 22: # ======================================================= Initialize input tags
1.1 albertel 23: sub initialize_inputtags {
1.41 ! harris41 24: # list of current input ids
! 25: @Apache::inputtags::input = ();
! 26: # list of all input ids seen in this problem
! 27: @Apache::inputtags::inputlist = ();
! 28: # list of all current response ids
! 29: @Apache::inputtags::response = ();
! 30: # list of all response ids seen in this problem
! 31: @Apache::inputtags::responselist = ();
! 32: # list of whether or not a specific response was previously used
! 33: @Apache::inputtags::previous = ();
! 34: # id of current part, 0 means no part is current (inside <problem> only
! 35: $Apache::inputtags::part = '';
! 36: # list of problem date statuses, the first element is for <problem>
! 37: #if there is a second element it is for the current <part>
! 38: @Apache::inputtags::status = ();
! 39: #hash of defined params for the current response
! 40: %Apache::inputtags::params = ();
1.1 albertel 41: }
42:
1.41 ! harris41 43: # ========================================== Start input (return scalar string)
1.14 albertel 44: sub start_input {
1.41 ! harris41 45: my ($parstack,$safeeval) = @_;
! 46: my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval);
! 47: if ($id eq '') { $id = $Apache::lonxml::curdepth; }
! 48: push (@Apache::inputtags::input,$id);
! 49: push (@Apache::inputtags::inputlist,$id);
! 50: return $id;
1.14 albertel 51: }
52:
1.41 ! harris41 53: # =================================================================== End input
1.14 albertel 54: sub end_input {
1.41 ! harris41 55: pop @Apache::inputtags::input;
! 56: return '';
1.14 albertel 57: }
58:
1.41 ! harris41 59: # ====================================== Start text area (return scalar string)
1.6 albertel 60: sub start_textarea {
1.41 ! harris41 61: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
! 62: my $result = "";
! 63: my $id = &start_input($parstack,$safeeval);
! 64: if ($target eq 'web') {
! 65: my $oldresponse = $Apache::lonhomework::history{'resource.'.
! 66: $Apache::inputtags::part.'.'.
! 67: $Apache::inputtags::response['-1'].'.submission'};
! 68: my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
! 69: if ( $cols eq '') { $cols = 80; }
! 70: my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
! 71: if ( $rows eq '') { $rows = 10; }
! 72: $result= '<textarea name="HWVAL'.$Apache::inputtags::response['-1'].
! 73: '" '."rows=\"$rows\" cols=\"$cols\">".$oldresponse;
! 74: if ($oldresponse ne '') {
! 75: #get rid of any startup text if the user has already responded
! 76: &Apache::lonxml::get_all_text("/textarea",$$parser[$#$parser]);
! 77: }
1.30 albertel 78: }
1.41 ! harris41 79: return $result;
1.6 albertel 80: }
81:
1.41 ! harris41 82: # ======================================== End text area (return scalar string)
1.6 albertel 83: sub end_textarea {
1.41 ! harris41 84: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
! 85: if ($target eq 'web') {
! 86: return "</textarea>";
! 87: }
! 88: &end_input;
! 89: return '';
1.6 albertel 90: }
91:
1.41 ! harris41 92: # ====================================== Start text line (return scalar string)
1.1 albertel 93: sub start_textline {
1.41 ! harris41 94: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
! 95: my $result = "";
! 96: if ($target eq 'web') {
! 97: my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
! 98: if ($size eq '') { $size=20; }
! 99: my $oldresponse = $Apache::lonhomework::history{'resource.'.
! 100: $Apache::inputtags::part.'.'.
! 101: $Apache::inputtags::response['-1'].'.submission'};
! 102: $result = '<input type="text" name="HWVAL'.
! 103: $Apache::inputtags::response['-1'].
! 104: '" value="'.$oldresponse.'" size="'.$size.'" />';
! 105: }
! 106: if ($target eq 'edit') {
! 107: $result .= &Apache::edit::tag_start($target,$token,
! 108: &Apache::lonxml::description($token));
! 109: $result .= &Apache::edit::text_arg('Size:','size',$token,'5').
! 110: '</td></tr>';
! 111: $result .= &Apache::edit::end_table;
! 112: }
! 113: if ($target eq 'modified') {
! 114: my $constructtag = &Apache::edit::get_new_args($token,$parstack,
! 115: $safeeval,'size');
! 116: if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
! 117: }
! 118: return $result;
1.1 albertel 119: }
120:
1.41 ! harris41 121: # =============================================================== End text line
1.1 albertel 122: sub end_textline {
1.41 ! harris41 123: my ($target,$token,$tagstack,$parstack,$parser,$safeeval) = @_;
! 124: if ($target eq 'edit') { return ('','no'); }
! 125: return "";
1.1 albertel 126: }
127:
1.41 ! harris41 128: # ======================================================= Start data submission
1.6 albertel 129: sub start_datasubmission {
1.41 ! harris41 130: return '';
1.6 albertel 131: }
132:
1.41 ! harris41 133: # ========================================================= End data submission
1.6 albertel 134: sub end_datasubmission {
1.41 ! harris41 135: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
! 136: if ( $target == 'web' ) {
! 137: return '<input type="submit" name="submit" value="Submit All Data" />';
! 138: }
! 139: return '';
1.9 albertel 140: }
141:
1.41 ! harris41 142: # ============================================================= Finalize awards
1.9 albertel 143: sub finalizeawards {
1.41 ! harris41 144: my $result='';
! 145: my $award;
! 146: if ($#_ == '-1') { $result = "NO_RESPONSE"; }
! 147: if ($result eq '' ) {
! 148: foreach $award (@_) { if ($award eq '') {$result='MISSING_ANSWER';
! 149: last;}}
! 150: }
! 151: if ($result eq '' ) {
! 152: foreach $award (@_) { if ($award eq 'ERROR') {$result='ERROR'; last;}}
! 153: }
! 154: if ($result eq '' ) {
! 155: foreach $award (@_) { if ($award eq 'NO_RESPONSE') {
! 156: $result='NO_RESPONSE'; last;} }
! 157: }
! 158: if ($result eq '' ) {
! 159: foreach $award (@_) {
! 160: if ($award eq 'UNIT_FAIL' ||
! 161: $award eq 'NO_UNIT' ||
! 162: $award eq 'UNIT_NOTNEEDED') {
! 163: $result=$award; last;
! 164: }
! 165: }
! 166: }
! 167: if ($result eq '' ) {
! 168: foreach $award (@_) {
! 169: if ($award eq 'WANTED_NUMERIC' ||
! 170: $award eq 'BAD_FORMULA') {$result=$award; last;}
! 171: }
! 172: }
! 173: if ($result eq '' ) {
! 174: foreach $award (@_) { if ($award eq 'SIG_FAIL') {
! 175: $result=$award; last;} }
! 176: }
! 177: if ($result eq '' ) {
! 178: foreach $award (@_) { if ($award eq 'INCORRECT') {$result=$award;
! 179: last;} }
! 180: }
! 181: if ($result eq '' ) {
! 182: foreach $award (@_) { if ($award eq 'SUBMITTED') {$result=$award;
! 183: last;} }
! 184: }
! 185: if ($result eq '' ) {
! 186: foreach $award (@_) { if ($award eq 'APPROX_ANS') {$result=$award;
! 187: last;} }
! 188: }
! 189: if ($result eq '' ) { $result='EXACT_ANS'; }
! 190: return $result;
1.9 albertel 191: }
192:
1.41 ! harris41 193: # ====================================== Decide output (return 3 element array)
1.10 albertel 194: sub decideoutput {
1.41 ! harris41 195: my ($award,$solved,$previous)=@_;
! 196: my $message='';
! 197: my $button=0;
! 198: my $previousmsg;
! 199:
! 200: if ($previous) { $previousmsg='You have entered that answer before'; }
! 201:
! 202: if ($solved =~ /^correct/) {
! 203: $message = "<b>You are correct.</b> Your receipt is ".
! 204: &Apache::lonnet::receipt;
! 205: $button=0;
! 206: $previousmsg='';
! 207: } elsif ($solved =~ /^excused/) {
! 208: $message = "<b>You are excused from the problem.</b>";
! 209: $button=0;
! 210: $previousmsg='';
! 211: } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
! 212: if ($solved =~ /^incorrect/ || $solved eq '') {
! 213: $message = "Incorrect";
! 214: $button=1;
! 215: } else {
! 216: $message = "<b>You are correct.</b> Your receipt is ".
! 217: &Apache::lonnet::receipt;
! 218: $button=0;
! 219: $previousmsg='';
! 220: }
! 221: } elsif ($award eq 'NO_RESPONSE') {
! 222: $message = '';
! 223: $button=1;
! 224: } elsif ($award eq 'MISSING_ANSWER') {
! 225: $message = 'Some parts were not submitted';
! 226: $button = 1;
! 227: } elsif ($award eq 'WANTED_NUMERIC') {
! 228: $message = "This question expects a numeric answer";
! 229: $button=1;
! 230: } elsif ($award eq 'SIG_FAIL') {
! 231: $message = "Please adjust significant figures.";# you provided %s significant figures";
! 232: $button=1;
! 233: } elsif ($award eq 'UNIT_FAIL') {
! 234: $message = "Units incorrect."; #Computer reads units as %s";
! 235: $button=1;
! 236: } elsif ($award eq 'UNIT_NOTNEEDED') {
! 237: $message = "Only a number required.";# Computer reads units of %s";
! 238: $button=1;
! 239: } elsif ($award eq 'NO_UNIT') {
! 240: $message = "Units required";
! 241: $button=1;
! 242: } elsif ($award eq 'BAD_FORMULA') {
! 243: $message = "Unable to understand formula";
! 244: $button=1;
! 245: } elsif ($award eq 'INCORRECT') {
! 246: $message = "Incorrect";
! 247: $button=1;
! 248: } elsif ($award eq 'SUBMITTED') {
! 249: $message = "Your submission has been recorded.";
! 250: $button=1;
1.37 albertel 251: } else {
1.41 ! harris41 252: $message = "Unknown message: $award";
! 253: $button=1;
! 254: }
! 255: return ($button,$message,$previousmsg);
1.12 albertel 256: }
257:
1.41 ! harris41 258: # ============================================================== Set grade data
1.12 albertel 259: sub setgradedata {
1.41 ! harris41 260: my ($award,$id,$previously_used) = @_;
! 261: # if the student already has it correct, don't modify the status
! 262: if ( $Apache::lonhomework::history{"resource.$id.solved"} !~ /^correct/ ) {
! 263: #handle assignment of tries and solved status
! 264: if ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
! 265: $Apache::lonhomework::results{"resource.$id.tries"} =
! 266: $Apache::lonhomework::history{"resource.$id.tries"} + 1;
! 267: $Apache::lonhomework::results{"resource.$id.solved"} =
! 268: 'correct_by_student';
! 269: $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
! 270: } elsif ( $award eq 'INCORRECT' ) {
! 271: $Apache::lonhomework::results{"resource.$id.tries"} =
! 272: $Apache::lonhomework::history{"resource.$id.tries"} + 1;
! 273: $Apache::lonhomework::results{"resource.$id.solved"} =
! 274: 'incorrect_attempted';
! 275: } elsif ( $award eq 'SUBMITTED' ) {
! 276: $Apache::lonhomework::results{"resource.$id.tries"} =
! 277: $Apache::lonhomework::history{"resource.$id.tries"} + 1;
! 278: $Apache::lonhomework::results{"resource.$id.solved"} =
! 279: 'ungraded_attempted';
! 280: } elsif ( $award eq 'NO_RESPONSE' ) {
! 281: return '';
! 282: } else {
! 283: $Apache::lonhomework::results{"resource.$id.solved"} =
! 284: 'incorrect_attempted';
! 285: }
! 286:
! 287: # check if this was a previous submission if it was delete the
! 288: # unneeded data and update the previously_used attribute
! 289: if ( $previously_used eq 'PREVIOUSLY_USED') {
! 290: delete($Apache::lonhomework::results{"resource.$id.tries"});
! 291: $Apache::lonhomework::results{"resource.$id.previous"} = '1';
! 292: } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {
! 293: #delete all data as they student didn't do anything
! 294: foreach my $key (keys(%Apache::lonhomework::results)) {
! 295: if ($key =~ /^resource\.$id\./) {
! 296: &Apache::lonxml::debug("Removing $key");
! 297: delete($Apache::lonhomework::results{$key});
! 298: }
! 299: }
! 300: #and since they didn't do anything we were never here
! 301: return '';
! 302: } else {
! 303: $Apache::lonhomework::results{"resource.$id.previous"} = '0';
! 304: }
1.40 albertel 305: }
1.41 ! harris41 306: $Apache::lonhomework::results{"resource.$id.award"} = $award;
1.10 albertel 307: }
308:
1.41 ! harris41 309: # ======================================================================= Grade
1.9 albertel 310: sub grade {
1.41 ! harris41 311: my ($target) = @_;
! 312: my $id = $Apache::inputtags::part;
! 313: my $response = '';
! 314: if ( defined $ENV{'form.submitted'}) {
! 315: my @awards = ();
! 316: foreach $response (@Apache::inputtags::responselist) {
! 317: &Apache::lonxml::debug("looking for response.$id.$response.".
! 318: "awarddetail");
! 319: my $value=$Apache::lonhomework::results{"resource.$id.$response.".
! 320: "awarddetail"};
! 321: if ( $value ne '' ) {
! 322: &Apache::lonxml::debug("keeping $value from $response for".
! 323: " $id");
! 324: push (@awards,$value);
! 325: } else {
! 326: &Apache::lonxml::debug("skipping $value from $response for".
! 327: " $id");
! 328: }
! 329: }
! 330: my $finalaward = &finalizeawards(@awards);
! 331: my $previously_used;
! 332: if ( $#Apache::inputtags::previous eq $#awards ) {
! 333: $previously_used = 'PREVIOUSLY_LAST';
! 334: foreach my $value (@Apache::inputtags::previous) {
! 335: if ($value eq 'PREVIOUSLY_USED' ) {
! 336: $previously_used = $value;
! 337: last;
! 338: }
! 339: }
! 340: }
! 341: &Apache::lonxml::debug("final award $finalaward, $previously_used");
! 342: &setgradedata($finalaward,$id,$previously_used);
! 343: }
! 344: return '';
1.1 albertel 345: }
346:
1.41 ! harris41 347: # ========================================= Grade status (return scalar string)
1.11 albertel 348: sub gradestatus {
1.41 ! harris41 349: my ($id) = @_;
! 350: my $showbutton = 1;
! 351: my $message = '';
! 352: my $trystr = '';
! 353: my $button = '';
! 354: my $previousmsg = '';
! 355:
! 356: my $status = $Apache::inputtags::status['-1'];
! 357: &Apache::lonxml::debug("gradestatus has :$status:");
! 358: if ( $status ne 'CLOSED' ) {
! 359: my $award = $Apache::lonhomework::history{"resource.$id.award"};
! 360: my $solved = $Apache::lonhomework::history{"resource.$id.solved"};
! 361: my $previous = $Apache::lonhomework::history{"resource.$id.previous"};
! 362: &Apache::lonxml::debug("Found Award |$award|$solved|");
! 363: if ( $award ne '' ) {
! 364: &Apache::lonxml::debug('Getting message');
! 365: ($showbutton,$message,$previousmsg) =
! 366: &decideoutput($award,$solved,$previous);
! 367: $message = "<td bgcolor=\"#aaffaa\">$message</td>";
! 368: if ($previousmsg) {
! 369: $previousmsg = "<td bgcolor=\"#ffaaaa\">$previousmsg</td>";
! 370: }
! 371: }
! 372: my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
! 373: my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
! 374: &Apache::lonxml::debug("got maxtries of :$maxtries:");
! 375: if ( $tries eq '' ) { $tries = '0'; }
! 376: if ( $maxtries eq '' ) { $maxtries = '2'; }
! 377: if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; }
! 378: if ( $showbutton ) {
! 379: $trystr = "<td>Tries $tries/$maxtries</td>";
! 380: }
! 381: if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {
! 382: $showbutton = 0;}
! 383: if ( $showbutton ) {
! 384: $button = '<br /><input type="submit" name="submit" value='.
! 385: '"Submit All Answers" />';
! 386: }
! 387: }
! 388: my $output= $previousmsg.$message.$trystr;
! 389: if ($output =~ /^\s*$/) {
! 390: return $button;
! 391: } else {
! 392: return $button.'<table><tr>'.$previousmsg.$message.$trystr.
! 393: '</tr></table>';
! 394: }
1.11 albertel 395: }
1.41 ! harris41 396:
1.1 albertel 397: 1;
1.41 ! harris41 398:
1.1 albertel 399: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to inputtags.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework