--- loncom/homework/grades.pm 2003/02/27 22:39:11 1.69 +++ loncom/homework/grades.pm 2007/10/09 10:31:21 1.448 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.69 2003/02/27 22:39:11 albertel Exp $ +# $Id: grades.pm,v 1.448 2007/10/09 10:31:21 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,15 +25,6 @@ # # http://www.lon-capa.org/ # -# 2/9,2/13 Guy Albertelli -# 6/8 Gerd Kortemeyer -# 7/26 H.K. Ng -# 8/20 Gerd Kortemeyer -# Year 2002 -# June-August H.K. Ng -# Year 2003 -# February H.K. Ng -# package Apache::grades; use strict; @@ -41,151 +32,551 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; use Apache::loncoursedata; -use Apache::lonmsg qw(:user_normal_msg); +use Apache::lonmsg(); use Apache::Constants qw(:common); +use Apache::lonlocal; +use Apache::lonenc; +use String::Similarity; +use LONCAPA; + +use POSIX qw(floor); + + +my %perm=(); +my %bubble_lines_per_response = (); # no. bubble lines for each response. + # index is "symb.part_id" + +my %first_bubble_line = (); # First bubble line no. for each bubble. + +# Save and restore the bubble lines array to the form env. + + +sub save_bubble_lines { + &Apache::lonnet::logthis("Saving bubble_lines..."); + foreach my $line (keys(%bubble_lines_per_response)) { + &Apache::lonnet::logthis("Saving form.scantron.bubblelines.$line value: $bubble_lines_per_response{$line}"); + $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; + $env{"form.scantron.first_bubble_line.$line"} = + $first_bubble_line{$line}; + } +} + + +sub restore_bubble_lines { + my $line = 0; + %bubble_lines_per_response = (); + while ($env{"form.scantron.bubblelines.$line"}) { + my $value = $env{"form.scantron.bubblelines.$line"}; + &Apache::lonnet::logthis("Restoring form.scantron.bubblelines.$line value: $value"); + $bubble_lines_per_response{$line} = $value; + $first_bubble_line{$line} = + $env{"form.scantron.first_bubble_line.$line"}; + $line++; + } + +} + +# Given the parsed scanline, get the response for +# 'answer' number n: + +sub get_response_bubbles { + my ($parsed_line, $response) = @_; + + my $bubble_line = $first_bubble_line{$response}; + my $bubble_lines= $bubble_lines_per_response{$response}; + my $selected = ""; + + for (my $bline = 0; $bline < $bubble_lines; $bline++) { + $selected .= $$parsed_line{"scantron.$bubble_line.answer"}; + $bubble_line++; + } + return $selected; +} + # ----- These first few routines are general use routines.---- + +# Return the number of occurences of a pattern in a string. + +sub occurence_count { + my ($string, $pattern) = @_; + + my @matches = ($string =~ /$pattern/g); + + return scalar(@matches); +} + + +# Take a string known to have digits and convert all the +# digits into letters in the range J,A..I. + +sub digits_to_letters { + my ($input) = @_; + + my @alphabet = ('J', 'A'..'I'); + + my @input = split(//, $input); + my $output =''; + for (my $i = 0; $i < scalar(@input); $i++) { + if ($input[$i] =~ /\d/) { + $output .= $alphabet[$input[$i]]; + } else { + $output .= $input[$i]; + } + } + return $output; +} + # -# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +# --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_(\w+)_.*/) { - push(@parts,$key); + my ($symb) = @_; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my $url = $res->src(); + my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys')); + + my @stores; + foreach my $part (@{ $partlist }) { + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } } } - return @parts; + return @stores; } # --- Get the symbolic name of a problem and the url -sub get_symb_and_url { - my ($request) = @_; - (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - return ($symb,$url); -} - -# --- Retrieve the fullname for a user. Return lastname, first middle --- -# --- Generation is attached next to the lastname if it exists. --- -sub get_fullname { - my ($uname,$udom) = @_; - my %name=&Apache::lonnet::get('environment', ['lastname','generation', - 'firstname','middlename'], - $udom,$uname); - my $fullname; - my ($tmp) = keys(%name); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname = &Apache::loncoursedata::ProcessFullName - (@name{qw/lastname generation firstname middlename/}); +sub get_symb { + my ($request,$silent) = @_; + (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); + if ($symb eq '') { + if (!$silent) { + $request->print("Unable to handle ambiguous references:$url:."); + return (); + } + } + &Apache::lonenc::check_decrypt(\$symb); + return ($symb); +} + +#--- Format fullname, username:domain if different for display +#--- Use anywhere where the student names are listed +sub nameUserString { + my ($type,$fullname,$uname,$udom) = @_; + if ($type eq 'header') { + return ' Fullname (Username)'; } else { - &Apache::lonnet::logthis('grades.pm: no name data for '.$uname. - '@'.$udom.':'.$tmp); + return ' '.$fullname.' ('.$uname. + ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; } - return $fullname; } #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { - my ($url) = shift; - my $allkeys = &Apache::lonnet::metadata($url,'keys'); - my %seen = (); - my (@partlist,%handgrade); - foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_\w+.*/) { - my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); - $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); - next if ($seen{$partid} > 0); - $seen{$partid}++; - push @partlist,$partid; + my ($symb) = shift; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my %vPart = + map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + next if (%vPart && !exists($vPart{$part})); + + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + $response_types{$part}{$ids[$i]} = $types[$i]; + $handgrade{$part.'_'.$ids[$i]} = + &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. + '.handgrade',$symb); + } + } + return ($partlist,\%handgrade,\%response_types); +} + +sub flatten_responseType { + my ($responseType) = @_; + my @part_response_id = + map { + my $part = $_; + map { + [$part,$_] + } sort(keys(%{ $responseType->{$part} })); + } sort(keys(%$responseType)); + return @part_response_id; +} + +sub get_display_part { + my ($partID,$symb)=@_; + my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); + if (defined($display) and $display ne '') { + $display.= " (id $partID)"; + } else { + $display=$partID; + } + return $display; +} + +#--- Show resource title +#--- and parts and response type +sub showResourceInfo { + my ($symb,$probTitle,$checkboxes) = @_; + my $col=3; + if ($checkboxes) { $col=4; } + my $result = '
"; + } else { + $result.=" | "; + } + $partsseen{$partID}=1; + } + my $display_part=&get_display_part($partID,$symb); + $result.=' | Part: '.$display_part.' '. + $resID.' | '. + 'Type: '.$responsetype.' | Handgrade: '.$handgrade.' | '; + } + } + $result.='
'; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); + my ($toprow,$middlerow,$bottomrow); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.=''. + '
'. + ' Answer '.$toprow.''.' '.$grayFont.'Option ID '. + $grayFont.$bottomrow.'
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { + if (exists($answer{$foil})) { + if ($foil eq $correct) { + $toprow.=''. + '
'. + ' Answer '.$toprow.''. + ' '.$grayFont.'Item ID '. + $middlerow.''.' '.$grayFont.'Option ID '. + $bottomrow.'
'; + } elsif ($response eq 'essay') { + if (! exists ($env{'form.'.$symb})) { + my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; + $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. + } + $answer =~ s-\n-'. + '
'. + ' Answer '.$toprow.''.' '.$grayFont.'Option ID '. + $grayFont.$bottomrow.'
'.&keywords_highlight($answer).''; + } elsif ( $response eq 'organic') { + my $result='Smile representation: "'.$answer.'"'; + my $jme=$record->{$version."resource.$partid.$respid.molecule"}; + $result.=&Apache::chemresponse::jme_img($jme,$answer,400); + return $result; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'
'; + + $result .= ''. + 'Part: '.$display_part.' Points: | '."\n";
+ my $ctr = 0;
+ my $thisweight = 0;
+ my $increment = &get_increment();
+ $result.='
| or | '."\n"; + $result.=''."\n"; + $result.=' | /'.$wgt.' '.$wgtmsg. + ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : ''). + ' | '."\n"; + $result.=''."\n"; + $result.=" \n"; + $result.=''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + $result.=' |
';
- $result.='
'; - $request->print($result); + return $result; +} + +sub files_exist { + my ($r, $symb) = @_; + my @students = &Apache::loncommon::get_env_multiple('form.stuinfo'); + + foreach my $student (@students) { + my ($uname,$udom,$fullname) = split(/:/,$student); + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, + $udom,$uname); + my ($string,$timestamp)= &get_last_submission(\%record); + foreach my $submission (@$string) { + my ($partid,$respid) = + ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); + my $files=&get_submitted_files($udom,$uname,$partid,$respid, + \%record); + return 1 if (@$files); + } + } + return 0; +} + +sub download_all_link { + my ($r,$symb) = @_; + my $all_students = + join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo')); + + my $parts = + join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); + + my $identifier = &Apache::loncommon::get_cgi_id(); + &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students, + 'cgi.'.$identifier.'.symb' => $symb, + 'cgi.'.$identifier.'.parts' => $parts,); + $r->print(''. + &mt('Download All Submitted Documents').''); + return +} + +sub build_section_inputs { + my $section_inputs; + if ($env{'form.section'} eq '') { + $section_inputs .= ''."\n"; + } else { + my @sections = &Apache::loncommon::get_env_multiple('form.section'); + foreach my $section (@sections) { + $section_inputs .= ''."\n"; + } + } + return $section_inputs; } # --------------------------- show submissions of a student, option to grade sub submission { my ($request,$counter,$total) = @_; - (my $url=$ENV{'form.url'})=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; -# if ($ENV{'form.student'} eq '') { &moreinfo($request,'Need student login id'); return ''; } - my ($uname,$udom) = ($ENV{'form.student'},$ENV{'form.userdom'}); - ($uname,$udom) = &finduser($uname) if $udom eq ''; - $ENV{'form.fullname'} = &get_fullname ($uname,$udom) if $ENV{'form.fullname'} eq ''; -# if ($uname eq '') { &moreinfo($request,'Unable to find student'); return ''; } - - my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); -# $ENV{'form.vProb'} = $ENV{'form.vProb'} ne '' ? $ENV{'form.vProb'} : 'yes'; + my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); + $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student? + my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); + $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq ''; + my $symb = &get_symb($request); + if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } + + if (!&canview($usec)) { + $request->print('Unable to view requested student.('. + $uname.':'.$udom.' in section '.$usec.' in course id '. + $env{'request.course.id'}.')'); + $request->print(&show_grading_menu_form($symb)); + return; + } + + if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; } + if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; } + if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; } + my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); + my $checkIcon = ''; + my %old_essays; # header info if ($counter == 0) { &sub_page_js($request); - $request->print(' Submission Record'."\n". - ' Resource: '.$url.''."\n"); + &sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes'); + $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? + &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; + if ($env{'form.handgrade'} eq 'yes' && &files_exist($request, $symb)) { + &download_all_link($request, $symb); + } + $request->print('Submission Record'."\n". + 'Resource: '.$env{'form.probTitle'}.''."\n"); + + if ($env{'form.handgrade'} eq 'no') { + my $checkMark='Note: Part(s) graded correct by the computer is marked with a '. + $checkIcon.' symbol.'."\n"; + $request->print($checkMark); + } # option to display problem, only once else it cause problems # with the form later since the problem has a form. - if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) { - &show_problem($request,$symb,$uname,$udom,0); + if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') { + my $mode; + if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') { + $mode='both'; + } elsif ($env{'form.vProb'} eq 'yes') { + $mode='text'; + } elsif ($env{'form.vAns'} eq 'yes') { + $mode='answer'; + } + &Apache::lonxml::clear_problem_counter(); + $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); } - + # kwclr is the only variable that is guaranteed to be non blank # if this subroutine has been called once. my %keyhash = (); - if ($ENV{'form.kwclr'} eq '') { + if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') { %keyhash = &Apache::lonnet::dump('nohist_handgrade', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - - my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; - $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; - $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; - $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; - $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; - $ENV{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? - $keyhash{$symb.'_subject'} : &Apache::lonnet::metadata($url,'title'); - $ENV{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); - } - - $request->print(' +Highlight Attribute KEYWORDS +# +# Load the other essays for similarity check +# + my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); + my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); + $apath=&escape($apath); + $apath=~s/\W/\_/gs; + %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); } } - if ($ENV{'form.vProb'} eq 'all') { - $request->print(' '); - &show_problem($request,$symb,$uname,$udom,1); +# This is where output for one specific student would start + my $bgcolor='#DDEEDD'; + if (int($counter/2) eq $counter) { $bgcolor='#DDDDEE'; } + $request->print("\n\n". + '
'."\n".
- ' '.
- 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').''.
- ' | (Message will be sent when you click on Save & Next below.)'."\n" - if ($ENV{'form.handgrade'} eq 'yes'); - $request->print($result); + # essay grading message center + if ($env{'form.handgrade'} eq 'yes') { + my ($lastname,$givenn) = split(/,/,$env{'form.fullname'}); + my $msgfor = $givenn.' '.$lastname; + if (scalar(@col_fullnames) > 0) { + my $lastone = pop @col_fullnames; + $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; + } + $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript + $result=''."\n". + ''."\n"; + $result.=' '. + &mt('Compose message to student').(scalar(@col_fullnames) >= 1 ? 's' : '').')'. + ''."\n". + ' ('. + &mt('Message will be sent when you click on Save & Next below.').")\n"; + $request->print($result); + } + if ($perm{'vgr'}) { + $request->print(' '. + &Apache::loncommon::track_student_link(&mt('View recent activity'), + $uname,$udom,'check')); + } + if ($perm{'opa'}) { + $request->print(' '. + &Apache::loncommon::pprmlink(&mt('Set/Change parameters'), + $uname,$udom,$symb,'check')); + } my %seen = (); my @partlist; - for (sort keys(%$handgrade)) { - my ($partid,$respid) = split(/_/); + my @gradePartRespid; + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($partid,$respid) = @{ $part_response_id }; + my $part_resp = join('_',@{ $part_response_id }); next if ($seen{$partid} > 0); $seen{$partid}++; - next if ($$handgrade{$_} =~ /:no$/); + next if ($$handgrade{$part_resp} ne 'yes' + && $env{'form.lastSub'} eq 'hdgrade'); push @partlist,$partid; - my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); - my $wgtmsg = ($wgt > 0 ? '(problem weight)' : - 'problem weight assigned by computer'); - $wgt = ($wgt > 0 ? $wgt : '1'); - my $score = ($record{'resource.'.$partid.'.awarded'} eq '' ? - '' : $record{'resource.'.$partid.'.awarded'}*$wgt); - $result=''; - $result.='
|
'. - ''."\n"; - if ($ENV{'form.handgrade'} eq 'yes') { - $endform.=' '."\n"; - my $ntstu =''."\n"; - my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1'); - $ntstu =~ s/ |