--- loncom/homework/inputtags.pm 2000/07/25 21:27:30 1.1 +++ loncom/homework/inputtags.pm 2003/09/23 16:00:49 1.114.2.3 @@ -1,38 +1,686 @@ # The LearningOnline Network with CAPA # input definitons +# +# $Id: inputtags.pm,v 1.114.2.3 2003/09/23 16:00:49 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; -sub BEGIN { - &Apache::lonxml::register('Apache::inputtags',('textline','answergroup')); +BEGIN { + &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline')); } + sub initialize_inputtags { - $Apache::inputtags::curvalue=0; + # 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,$parstack,$parser,$safeeval)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result = ""; - $Apache::inputtags::curvalue++; if ($target eq 'web') { - $result= ''; + $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,$parstack,$parser,$safeeval)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; + if ($target eq 'web') { $Apache::lonxml::evaluate++; } + elsif ($target eq 'edit') { return ('','no'); } + return ""; } -sub start_answergroup { +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_answergroup { - return ' '#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; + if (lc($Apache::lonhomework::problemstatus) eq 'no') { + $Apache::lonhomework::results{"resource.$id.awarded"} = 0; + } + $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; + $Apache::lonhomework::results{"resource.$id.awarded"} = 0; + } + } + + # 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__