# The LearningOnline Network with CAPA # input definitons # # $Id: inputtags.pm,v 1.114.2.1 2003/09/23 01:52:57 albertel Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # 2/19 Guy package Apache::inputtags; use HTML::Entities(); use strict; use Apache::loncommon; BEGIN { &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline')); } sub initialize_inputtags { # list of current input ids @Apache::inputtags::input=(); # list of all input ids seen in this problem @Apache::inputtags::inputlist=(); # list of all current response ids @Apache::inputtags::response=(); # list of all response ids seen in this problem @Apache::inputtags::responselist=(); # list of whether or not a specific response was previously used @Apache::inputtags::previous=(); # submission it was used in @Apache::inputtags::previous_version=(); # id of current part, 0 means that no part is current (inside only $Apache::inputtags::part=''; # list of all part ids seen @Apache::inputtags::partlist=(); # list of problem date statuses, the first element is for # if there is a second element it is for the current @Apache::inputtags::status=(); # hash of defined params for the current response %Apache::inputtags::params=(); # list of all ids, for , these get join()ed and prepended @Apache::inputtags::import=(); # list of all import ids seen @Apache::inputtags::importlist=(); } sub check_for_duplicate_ids { my %check; foreach my $id (@Apache::inputtags::partlist, @Apache::inputtags::responselist, @Apache::inputtags::importlist) { $check{$id}++; } my @duplicates; foreach my $id (sort(keys(%check))) { if ($check{$id} > 1) { push(@duplicates,$id); } } if (@duplicates) { &Apache::lonxml::error("Duplicated ids found, problem will operate incorrectly. Duplicated ids seen: ",join(', ',@duplicates)); } } sub start_input { my ($parstack,$safeeval)=@_; my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval); if ($id eq '') { $id = $Apache::lonxml::curdepth; } push (@Apache::inputtags::input,$id); push (@Apache::inputtags::inputlist,$id); return $id; } sub end_input { pop @Apache::inputtags::input; return ''; } sub start_textfield { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result = ""; my $id = &start_input($parstack,$safeeval); my $resid=$Apache::inputtags::response[-1]; if ($target eq 'web') { $Apache::lonxml::evaluate--; if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') { my $partid=$Apache::inputtags::part; my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"}); my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval); if ( $cols eq '') { $cols = 80; } my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval); if ( $rows eq '') { $rows = 10; } $result= '"; } } elsif ($target eq 'edit') { $result=&Apache::edit::end_table(); } &end_input; return $result; } sub start_textline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result = ""; if ($target eq 'web') { $Apache::lonxml::evaluate--; my $partid=$Apache::inputtags::part; my $id=$Apache::inputtags::response[-1]; if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') { my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval); my $maxlength; if ($size eq '') { $size=20; } else { if ($size < 20) { $maxlength=$size; } } my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"}); if ($Apache::lonhomework::type ne 'exam') { $result= ''; } } else { #right or wrong don't show what was last typed in. #$result=''.$oldresponse.''; $result=''; } } elsif ($target eq 'edit') { $result=&Apache::edit::tag_start($target,$token); $result.=&Apache::edit::text_arg('Size:','size',$token,'5').""; $result.=&Apache::edit::end_table; } elsif ($target eq 'modified') { my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'size'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } } elsif ($target eq 'tex' and $Apache::lonhomework::type ne 'exam') { my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval); if ($size != 0) {$size=$size*2; $size.=' mm';} else {$size='40 mm';} $result='\framebox['.$size.'][s]{\tiny\strut}'; } return $result; } sub end_textline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; if ($target eq 'web') { $Apache::lonxml::evaluate++; } elsif ($target eq 'edit') { return ('','no'); } return ""; } sub start_hiddenline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result = ""; if ($target eq 'web') { $Apache::lonxml::evaluate--; if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') { my $partid=$Apache::inputtags::part; my $id=$Apache::inputtags::response[-1]; my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"}); if ($Apache::lonhomework::type ne 'exam') { $result= ''; } } } elsif ($target eq 'edit') { $result=&Apache::edit::tag_start($target,$token); $result.=&Apache::edit::end_table; } return $result; } sub end_hiddenline { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; if ($target eq 'web') { $Apache::lonxml::evaluate++; } elsif ($target eq 'edit') { return ('','no'); } return ""; } sub finalizeawards { my $result=''; my $award; if ($#_ == '-1') { $result = "NO_RESPONSE"; } if ($result eq '' ) { my $blankcount; foreach $award (@_) { if ($award eq '') { $result='MISSING_ANSWER'; $blankcount++; } } if ($blankcount == ($#_ + 1)) { $result = 'NO_RESPONSE'; } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'MISSING_ANSWER') {$result='MISSING_ANSWER'; last;}} } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'ERROR') {$result='ERROR'; last;}} } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'NO_RESPONSE') {$result='NO_RESPONSE'; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'TOO_LONG') {$result='TOO_LONG'; last;}} } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'UNIT_FAIL' || $award eq 'NO_UNIT' || $award eq 'UNIT_NOTNEEDED') { $result=$award; last; } } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'WANTED_NUMERIC' || $award eq 'BAD_FORMULA') {$result=$award; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'SIG_FAIL') {$result=$award; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'INCORRECT') {$result=$award; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'MISORDERED_RANK') {$result=$award; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'INVALID_FILETYPE') {$result=$award; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'DRAFT') {$result=$award; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'SUBMITTED') {$result=$award; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'ASSIGNED_SCORE') {$result=$award; last;} } } if ($result eq '' ) { foreach $award (@_) { if ($award eq 'APPROX_ANS') {$result=$award; last;} } } if ($result eq '' ) { $result='EXACT_ANS'; } return $result } sub decideoutput { my ($award,$solved,$previous,$target)=@_; my $message=''; my $button=0; my $previousmsg; my $bgcolor='orange'; my %possiblecolors = ( 'correct' => '#aaffaa', 'charged_try' => '#ffaaaa', 'not_charged_try' => '#ffffaa', 'no_message' => '#fffff', ); if ($previous) { $previousmsg='You have entered that answer before'; } if ($solved =~ /^correct/) { if ($award eq 'ASSIGNED_SCORE') { $message = "A score has been assigned."; } else { if ($target eq 'tex') { $message = '\textbf{You are correct}.'; } else { $message = "You are correct."; } unless ($ENV{'course.'. $ENV{'request.course.id'}. '.disable_receipt_display'} eq 'yes') { $message.=(($target eq 'web')?'
':' '). 'Your receipt is '.&Apache::lonnet::receipt(). (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):''); } } $bgcolor=$possiblecolors{'correct'}; $button=0; $previousmsg=''; } elsif ($solved =~ /^excused/) { if ($target eq 'tex') { $message = ' \textbf{You are excused from the problem.} '; } else { $message = "You are excused from the problem."; } $bgcolor=$possiblecolors{'charged_try'}; $button=0; $previousmsg=''; } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) { if ($solved =~ /^incorrect/ || $solved eq '') { $message = "Incorrect"; $bgcolor=$possiblecolors{'charged_try'}; $button=1; } else { $message = "You are correct."; unless ($ENV{'course.'. $ENV{'request.course.id'}. '.disable_receipt_display'} eq 'yes') { $message.=(($target eq 'web')?'
':' '). 'Your receipt is '.&Apache::lonnet::receipt(). (($target eq 'web')?&Apache::loncommon::help_open_topic('Receipt'):''); } $bgcolor=$possiblecolors{'correct'}; $button=0; $previousmsg=''; } } elsif ($award eq 'NO_RESPONSE') { $message = ''; $bgcolor=$possiblecolors{'no_feedback'}; $button=1; } elsif ($award eq 'MISSING_ANSWER') { $message = 'Some parts were not submitted'; $bgcolor=$possiblecolors{'not_charged_try'}; $button = 1; } elsif ($award eq 'ERROR') { $message = 'An error occured while grading your answer.'; $bgcolor=$possiblecolors{'not_charged_try'}; $button = 1; } elsif ($award eq 'TOO_LONG') { $message = "The submitted answer was too long."; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'WANTED_NUMERIC') { $message = "This question expects a numeric answer"; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'MISORDERED_RANK') { $message = 'You have provided an invalid ranking'; if ($target ne 'tex') { $message.=', please refer to '.&Apache::loncommon::help_open_topic('Ranking_Problems','help on ranking problems').'.'; } $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'INVALID_FILETYPE') { $message = 'The filetype extension of the file you uploaded is not allowed.'; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'SIG_FAIL') { $message = "Please adjust significant figures.";# you provided %s significant figures"; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'UNIT_FAIL') { $message = "Units incorrect. "; if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units');} #Computer reads units as %s"; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'UNIT_NOTNEEDED') { $message = "Only a number required.";# Computer reads units of %s"; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'NO_UNIT') { $message = "Units required"; if ($target ne 'tex') {$message.=&Apache::loncommon::help_open_topic('Physical_Units')}; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'BAD_FORMULA') { $message = "Unable to understand formula"; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'INCORRECT') { $message = "Incorrect"; $bgcolor=$possiblecolors{'charged_try'}; $button=1; } elsif ($award eq 'SUBMITTED') { $message = "Your submission has been recorded."; $bgcolor=$possiblecolors{'correct'}; $button=1; } elsif ($award eq 'DRAFT') { $message = "A draft copy has been saved."; $bgcolor=$possiblecolors{'not_charged_try'}; $button=1; } elsif ($award eq 'ASSIGNED_SCORE') { $message = "A score has been assigned."; $bgcolor=$possiblecolors{'correct'}; $button=0; } else { $message = "Unknown message: $award"; $button=1; } if (lc($Apache::lonhomework::problemstatus) eq 'no' && $Apache::inputtags::status[-1] ne 'SHOW_ANSWER') { $message = "Answer Submitted"; $bgcolor=$possiblecolors{'correct'}; $button=1; } return ($button,$bgcolor,$message,$previousmsg); } sub removealldata { my ($id)=@_; foreach my $key (keys(%Apache::lonhomework::results)) { if (($key =~ /^resource\.\Q$id\E\./) && ($key !~ /\.collaborators$/)) { &Apache::lonxml::debug("Removing $key"); delete($Apache::lonhomework::results{$key}); } } } sub setgradedata { my ($award,$id,$previously_used) = @_; # if the student already has it correct, don't modify the status if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER' && $Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER') { $Apache::lonhomework::results{"resource.$id.afterduedate"}=$award; return ''; } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} !~ /^correct/ || $Apache::lonhomework::scantronmode || lc($Apache::lonhomework::problemstatus) eq 'no') { #handle assignment of tries and solved status my $solvemsg; if ($Apache::lonhomework::scantronmode) { $solvemsg='correct_by_scantron'; } else { $solvemsg='correct_by_student'; } if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) { $Apache::lonhomework::results{"resource.$id.afterduedate"}=''; } if ( $award eq 'ASSIGNED_SCORE') { $Apache::lonhomework::results{"resource.$id.tries"} = $Apache::lonhomework::history{"resource.$id.tries"} + 1; $Apache::lonhomework::results{"resource.$id.solved"} = $solvemsg; my $numawards=scalar(@Apache::inputtags::response); $Apache::lonhomework::results{"resource.$id.awarded"} = 0; foreach my $res (@Apache::inputtags::response) { $Apache::lonhomework::results{"resource.$id.awarded"}+= $Apache::lonhomework::results{"resource.$id.$res.awarded"}; } if ($numawards > 0) { $Apache::lonhomework::results{"resource.$id.awarded"}/= $numawards; } } elsif ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) { $Apache::lonhomework::results{"resource.$id.tries"} = $Apache::lonhomework::history{"resource.$id.tries"} + 1; $Apache::lonhomework::results{"resource.$id.solved"} = $solvemsg; $Apache::lonhomework::results{"resource.$id.awarded"} = '1'; } elsif ( $award eq 'INCORRECT' ) { $Apache::lonhomework::results{"resource.$id.tries"} = $Apache::lonhomework::history{"resource.$id.tries"} + 1; $Apache::lonhomework::results{"resource.$id.solved"} = 'incorrect_attempted' } elsif ( $award eq 'SUBMITTED' ) { $Apache::lonhomework::results{"resource.$id.tries"} = $Apache::lonhomework::history{"resource.$id.tries"} + 1; $Apache::lonhomework::results{"resource.$id.solved"} = 'ungraded_attempted'; } elsif ( $award eq 'DRAFT' ) { $Apache::lonhomework::results{"resource.$id.solved"} = ''; } elsif ( $award eq 'NO_RESPONSE' ) { #no real response so delete any data that got stored &removealldata($id); return ''; } else { $Apache::lonhomework::results{"resource.$id.solved"} = 'incorrect_attempted'; if (lc($Apache::lonhomework::problemstatus) eq 'no') { $Apache::lonhomework::results{"resource.$id.tries"} = $Apache::lonhomework::history{"resource.$id.tries"} + 1; } } # check if this was a previous submission if it was delete the # unneeded data and update the previously_used attribute if ( $previously_used eq 'PREVIOUSLY_USED') { if (lc($Apache::lonhomework::problemstatus) ne 'no') { delete($Apache::lonhomework::results{"resource.$id.tries"}); $Apache::lonhomework::results{"resource.$id.previous"} = '1'; } } elsif ( $previously_used eq 'PREVIOUSLY_LAST') { #delete all data as they student didn't do anything, but save #the list of collaborators. &removealldata($id); #and since they didn't do anything we were never here return ''; } else { $Apache::lonhomework::results{"resource.$id.previous"} = '0'; } } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} =~ /^correct/ ) { #delete all data as they student already has it correct &removealldata($id); #and since they didn't do anything we were never here return ''; } $Apache::lonhomework::results{"resource.$id.award"} = $award; } sub grade { my ($target) = @_; my $id = $Apache::inputtags::part; my $response=''; if ( defined $ENV{'form.submitted'}) { my @awards = (); foreach $response (@Apache::inputtags::response) { &Apache::lonxml::debug("looking for response.$id.$response.awarddetail"); my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"}; &Apache::lonxml::debug("keeping $value from $response for $id"); push (@awards,$value); } my $finalaward = &finalizeawards(@awards); my $previously_used; if ( $#Apache::inputtags::previous eq $#awards ) { my $match=0; my @matches; foreach my $versionar (@Apache::inputtags::previous_version) { foreach my $version (@$versionar) { $matches[$version]++; } } foreach my $elem (@matches) {if ($elem eq ($#awards+1)) {$match=1;}} if ($match) { $previously_used = 'PREVIOUSLY_LAST'; foreach my $value (@Apache::inputtags::previous) { if ($value eq 'PREVIOUSLY_USED' ) { $previously_used = $value; last; } } } } &Apache::lonxml::debug("final award $finalaward, $previously_used"); &setgradedata($finalaward,$id,$previously_used); } return ''; } sub gradestatus { my ($id,$target) = @_; my $showbutton = 1; my $bgcolor = ''; my $message = ''; my $latemessage = ''; my $trystr=''; my $button=''; my $previousmsg=''; my $status = $Apache::inputtags::status['-1']; &Apache::lonxml::debug("gradestatus has :$status:"); if ( $status ne 'CLOSED' && $status ne 'UNAVAILABLE') { my $award = $Apache::lonhomework::history{"resource.$id.award"}; my $solved = $Apache::lonhomework::history{"resource.$id.solved"}; my $previous = $Apache::lonhomework::history{"resource.$id.previous"}; &Apache::lonxml::debug("Found Award |$award|$solved|"); if ( $award ne '' || $solved ne '') { &Apache::lonxml::debug('Getting message'); ($showbutton,$bgcolor,$message,$previousmsg) = &decideoutput($award,$solved,$previous,$target); if ($target eq 'tex') { $message=' '.$message.' '; } else { $message="$message"; if ($previousmsg) { $previousmsg="$previousmsg"; } } } my $tries = $Apache::lonhomework::history{"resource.$id.tries"}; my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries"); &Apache::lonxml::debug("got maxtries of :$maxtries:"); if ( $tries eq '' ) { $tries = '0'; } if ( $maxtries eq '' ) { $maxtries = '2'; } if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } if ( $showbutton ) { if ($target eq 'tex') { if ($ENV{'request.state'} ne "construct" && $Apache::lonhomework::type ne 'exam') { $trystr = ' {\vskip 1 mm \small \textit{Tries} '.$tries.'/'.$maxtries.'} \vskip 2 mm '; } else { $trystr = '\vskip 0 mm '; } } else { $trystr = "Tries $tries/$maxtries"; } } if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;} if ( $showbutton ) { if ($target ne 'tex') { $button = '
'; } } if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) { #last submissions was after due date if ($target eq 'tex') { $latemessage=' The last submission was after the Due Date '; } else { $latemessage="The last submission was after the Due Date"; } } } my $output= $previousmsg.$latemessage.$message.$trystr; if ($output =~ /^\s*$/) { return $button; } else { if ($target eq 'tex') { return $button.' \vskip 0 mm '.$output.' '; } else { return $button.''.$output.'
'; } } } 1; __END__