--- loncom/homework/grades.pm 2007/06/11 21:36:18 1.401 +++ loncom/homework/grades.pm 2007/10/26 00:39:09 1.467 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.401 2007/06/11 21:36:18 albertel Exp $ +# $Id: grades.pm,v 1.467 2007/10/26 00:39:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,47 +35,115 @@ use Apache::loncommon; use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; +use Apache::lonpickcode; use Apache::loncoursedata; use Apache::lonmsg(); use Apache::Constants qw(:common); use Apache::lonlocal; use Apache::lonenc; use String::Similarity; -use lib '/home/httpd/lib/perl'; use LONCAPA; use POSIX qw(floor); -my %oldessays=(); + 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 { + foreach my $line (keys(%bubble_lines_per_response)) { + $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"}; + $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-1} +1; + my $bubble_lines= $bubble_lines_per_response{$response-1}; + + 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 from the metadata file.--- sub getpartlist { my ($symb) = @_; - my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); - my $partorder = &Apache::lonnet::metadata($url, 'partorder'); - my @parts; - if ($partorder) { - for my $part (split (/,/,$partorder)) { - if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) { - push(@parts, $part); - } - } - } else { - my $metadata = &Apache::lonnet::metadata($url, 'packages'); - foreach (split(/\,/,$metadata)) { - if ($_ =~ /^part_(.*)$/) { - if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) { - push(@parts, $1); - } - } - } - } + + 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 (@parts) { - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $part (@{ $partlist }) { foreach my $key (@metakeys) { if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } } @@ -94,6 +162,7 @@ sub get_symb { return (); } } + &Apache::lonenc::check_decrypt(\$symb); return ($symb); } @@ -195,22 +264,54 @@ sub showResourceInfo { return $result,$responseType,$hdgrade,$partlist,$handgrade; } +sub reset_caches { + &reset_analyze_cache(); + &reset_perm(); +} + +{ + my %analyze_cache; -sub get_order { - my ($partid,$respid,$symb,$uname,$udom)=@_; - my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); - $url=&Apache::lonnet::clutter($url); - my $subresult=&Apache::lonnet::ssi($url, - ('grade_target' => 'analyze'), - ('grade_domain' => $udom), - ('grade_symb' => $symb), - ('grade_courseid' => - $env{'request.course.id'}), - ('grade_username' => $uname)); - (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); - my %analyze=&Apache::lonnet::str2hash($subresult); - return ($analyze{"$partid.$respid.shown"}); + sub reset_analyze_cache { + undef(%analyze_cache); + } + + sub get_analyze { + my ($symb,$uname,$udom)=@_; + my $key = "$symb\0$uname\0$udom"; + return $analyze_cache{$key} if (exists($analyze_cache{$key})); + + my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); + $url=&Apache::lonnet::clutter($url); + my $subresult=&Apache::lonnet::ssi($url, + ('grade_target' => 'analyze'), + ('grade_domain' => $udom), + ('grade_symb' => $symb), + ('grade_courseid' => + $env{'request.course.id'}), + ('grade_username' => $uname)); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + my %analyze=&Apache::lonnet::str2hash($subresult); + return $analyze_cache{$key} = \%analyze; + } + + sub get_order { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my $analyze = &get_analyze($symb,$uname,$udom); + return $analyze->{"$partid.$respid.shown"}; + } + + sub get_radiobutton_correct_foil { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my $analyze = &get_analyze($symb,$uname,$udom); + foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) { + if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { + return $foil; + } + } + } } + #--- Clean response type for display #--- Currently filters option/rank/radiobutton/match/essay/Task # response types only. @@ -231,8 +332,8 @@ sub cleanRecord { $bottomrow.='
'; } elsif ($response eq 'match') { my %answer=&Apache::lonnet::str2hash($answer); @@ -251,31 +352,31 @@ sub cleanRecord { $bottomrow.=''. - '
'. - ' Answer '.$toprow.''.$grayFont.'Option ID '. + ''. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. $grayFont.$bottomrow.'
'; } elsif ($response eq 'radiobutton') { my %answer=&Apache::lonnet::str2hash($answer); my ($toprow,$bottomrow); - my $correct=($order->[0])+1; - for (my $i=1;$i<=$#$order;$i++) { - my $foil=$order->[$i]; + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { if (exists($answer{$foil})) { - if ($i == $correct) { - $toprow.=''. - '
'. - ' Answer '.$toprow.''.$grayFont.'Item ID '. + ''. + ' '.&mt('Answer').' '.$toprow.''. - ' '.$grayFont.&mt('Item ID').' '. $middlerow.''.$grayFont.'Option ID '. + ''.' '.$grayFont.&mt('Option ID').' '. $bottomrow.'
'; } elsif ($response eq 'essay') { if (! exists ($env{'form.'.$symb})) { @@ -327,7 +428,10 @@ sub cleanRecord { $result.=''; return $result; } - + } elsif ( $response =~ m/(?:numerical|formula)/) { + $answer = + &Apache::loncommon::format_previous_attempt_value('submission', + $answer); } return $answer; } @@ -371,8 +475,10 @@ COMMONJSFUNCTIONS #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { - my ($getsec,$filterlist) = @_; + my ($getsec,$filterlist,$getgroup) = @_; my @getsec; + my @getgroup; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); if (!ref($getsec)) { if ($getsec ne '' && $getsec ne 'all') { @getsec=($getsec); @@ -381,10 +487,19 @@ sub getclasslist { @getsec=@{$getsec}; } if (grep(/^all$/,@getsec)) { undef(@getsec); } + if (!ref($getgroup)) { + if ($getgroup ne '' && $getgroup ne 'all') { + @getgroup=($getgroup); + } + } else { + @getgroup=@{$getgroup}; + } + if (grep(/^all$/,@getgroup)) { undef(@getgroup); } - my $classlist=&Apache::loncoursedata::get_classlist(); + my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist return if (! defined($classlist)); + &Apache::loncoursedata::get_group_memberships($classlist,$keylist); # my %sections; my %fullnames; @@ -401,18 +516,40 @@ sub getclasslist { $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; my $status = $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; + my $group = + $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; # filter students according to status selected - if ($filterlist && $env{'form.Status'} ne 'Any') { - if ($env{'form.Status'} ne $status) { - delete ($classlist->{$student}); + if ($filterlist && (!($stu_status =~ /Any/))) { + if (!($stu_status =~ $status)) { + delete($classlist->{$student}); next; } } + # filter students according to groups selected + my @stu_groups = split(/,/,$group); + if (@getgroup) { + my $exclude = 1; + foreach my $grp (@getgroup) { + foreach my $stu_group (@stu_groups) { + if ($stu_group eq $grp) { + $exclude = 0; + } + } + if (($grp eq 'none') && !$group) { + $exclude = 0; + } + } + if ($exclude) { + delete($classlist->{$student}); + } + } $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { $sections{$section}++; - $fullnames{$student}=$fullname; + if ($classlist->{$student}) { + $fullnames{$student}=$fullname; + } } else { delete($classlist->{$student}); } @@ -485,6 +622,7 @@ sub student_gradeStatus { # Shows a student's view of problem and submission sub jscriptNform { my ($symb) = @_; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); my $jscript=''."\n"; $jscript.= ''."\n"; + 'onClick="javascript:submit();" target="_self" />'."\n"; if (scalar(%$fullname) eq 0) { my $colspan=3+scalar(@parts); - $result='There are no students in section "'.$env{'form.section'}. - '" with enrollment status "'.$env{'form.Status'}.'" to modify or grade.'; + my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); + my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status')); + $result=''. + &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade', + $section_display, $stu_status). + ''; } $result.=&show_grading_menu_form($symb); return $result; @@ -3108,7 +3275,7 @@ sub viewstudentgrade { ''. "\n".$ctr.''. - '
'. - ' Answer '.$toprow.''.$grayFont.'Option ID '. + ''. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. $grayFont.$bottomrow.'
'."\n";
$result.= '
Gathering neccessary info. ");$r->rflush(); + $r->print("Gathering necessary info. ");$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); my $max_bubble=&scantron_get_maxbubble(); @@ -5090,6 +5836,7 @@ sub scantron_validate_file { } my $currentphase=$env{'form.validatepass'}; + my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { $r->print("Validating ".$validate_phases[$currentphase]." "); @@ -5130,6 +5877,17 @@ STUFF return ''; } + +=pod + +=item scantron_remove_file + + Removes the requested bubble sheet data file, makes sure that + scantron_original_Please indicate which bubble should be used for grading "); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; - &scantron_bubble_selector($r,$scan_config,$question,split('',$selected)); + my $selected = &get_response_bubbles($scan_record, $question); + my @select_array = split(/:/,$selected); + &scantron_bubble_selector($r,$scan_config,$question, + @select_array); } } elsif ($error eq 'missingbubble') { $r->print("There have been no bubbles scanned for some question(s) \n"); @@ -5479,7 +6459,7 @@ ENDSCRIPT $r->print(''); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; + my $selected = &get_response_bubbles($scan_record, $question); &scantron_bubble_selector($r,$scan_config,$question); } } else { @@ -5489,32 +6469,98 @@ ENDSCRIPT } +=pod + +=item scantron_bubble_selector + + Generates the html radiobuttons to correct a single bubble line + possibly showing the existing the selected bubbles if known + + Arguments: + $r - Apache request object + $scan_config - hash from &get_scantron_config() + $quest - number of the bubble line to make a corrector for + $lines - array of answer lines. + +=cut + sub scantron_bubble_selector { - my ($r,$scan_config,$quest,@selected)=@_; + my ($r,$scan_config,$quest,@lines)=@_; my $max=$$scan_config{'Qlength'}; + my $scmode=$$scan_config{'Qon'}; + + my $bubble_length = scalar(@lines); + + if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } + my $response = $quest-1; + my $lines = $bubble_lines_per_response{$response}; + + my $total_lines = $lines*2; my @alphabet=('A'..'Z'); - $r->print("
| |||||
'."\n".
- '
| |||||||||||||||||||||||||||||||||||||||||||||||||||
'."\n";
+# Attempt to restore parameters from last session, set defaults if not present
+ my %Saveable_Parameters=&clicker_grading_parameters();
+ &Apache::loncommon::restore_course_settings('grades_clicker',
+ \%Saveable_Parameters);
+ if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; }
+ if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; }
+ if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; }
+ if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
+
+ my %checked;
+ foreach my $gradingmechanism ('attendance','personnel','specific') {
+ if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
+ $checked{$gradingmechanism}="checked='checked'";
+ }
+ }
+
my $upload=&mt("Upload File");
my $type=&mt("Type");
- my $selectform=&Apache::loncommon::select_form('iclicker','upfiletype',
- ('iclicker' => 'iClicker'));
-
+ my $attendance=&mt("Award points just for participation");
+ my $personnel=&mt("Correctness determined from response by course personnel");
+ my $specific=&mt("Correctness determined from response with clicker ID(s)");
+ my $pcorrect=&mt("Percentage points for correct solution");
+ my $pincorrect=&mt("Percentage points for incorrect solution");
+ my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
+ ('iclicker' => 'i>clicker',
+ 'interwrite' => 'interwrite PRS'));
+ $symb = &Apache::lonenc::check_encrypt($symb);
$result.=< '.$key.' - '.$clickerids{$key}; + if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { + $result.=''.&mt('You need to specify a clicker ID for the correct answer').''; + return $result.&show_grading_menu_form($symb); + } + my %clicker_ids=&gather_clicker_ids(); + my %correct_ids; + if ($env{'form.gradingmechanism'} eq 'personnel') { + %correct_ids=&gather_adv_clicker_ids(); + } + if ($env{'form.gradingmechanism'} eq 'specific') { + foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; + $correct_id=~tr/a-z/A-Z/; + $correct_id=~s/\s//gs; + $correct_id=~s/^[\#0]+//; + $correct_id=~s/[\-\:]//g; + if ($correct_id) { + $correct_ids{$correct_id}='specified'; + } + } } - return $result; + if ($env{'form.gradingmechanism'} eq 'attendance') { + $result.=&mt('Score based on attendance only'); + } else { + my $number=0; + $result.=' '.&mt('Correctness determined by the following IDs').'';
+ foreach my $id (sort(keys(%correct_ids))) {
+ $result.='
'."\n"; + return $result.&show_grading_menu_form($symb); +} + +sub iclicker_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[0] eq 'Question') { + for (my $i=3;$i<$#entries;$i+=6) { + $$questiontitles[$number]=$entries[$i]; + $number++; + } + } + if ($entries[0]=~/^\#/) { + my $id=$entries[0]; + my @idresponses; + $id=~s/^[\#0]+//; + for (my $i=0;$i<$number;$i++) { + my $idx=3+$i*6; + push(@idresponses,$entries[$idx]); + } + $$responses{$id}=join(',',@idresponses); + } + } + return ($errormsg,$number); +} + +sub interwrite_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + my $skipline=1; + my $questionnumber=0; + my %idresponses=(); + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[1] eq 'Time') { $skipline=0; next; } + if ($entries[1] eq 'Response') { $skipline=1; } + next if $skipline; + if ($entries[0]!=$questionnumber) { + $questionnumber=$entries[0]; + $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); + $number++; + } + my $id=$entries[4]; + $id=~s/^[\#0]+//; + $id=~s/^v\d*\://i; + $id=~s/[\-\:]//g; + $idresponses{$id}[$number]=$entries[6]; + } + foreach my $id (keys %idresponses) { + $$responses{$id}=join(',',@{$idresponses{$id}}); + $$responses{$id}=~s/^\s*\,//; + } + return ($errormsg,$number); +} + +sub assign_clicker_grades { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} +# See which part we are saving to + my ($partlist,$handgrade,$responseType) = &response_type($symb); +# FIXME: This should probably look for the first handgradeable part + my $part=$$partlist[0]; +# Start screen output + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + + my $heading=&mt('Assigning grades based on clicker file'); + $result.=(<
'."\n"; + return $result.&show_grading_menu_form($symb); } sub handler { my $request=$_[0]; - - &reset_perm(); + &reset_caches(); if ($env{'browser.mathml'}) { &Apache::loncommon::content_type($request,'text/xml'); } else { @@ -6219,9 +8001,12 @@ sub handler { my $symb=&get_symb($request,1); my @commands=&Apache::loncommon::get_env_multiple('form.command'); my $command=$commands[0]; + if ($#commands > 0) { &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); } + + $request->print(&Apache::loncommon::start_page('Grading')); if ($symb eq '' && $command eq '') { if ($env{'user.adv'}) { @@ -6262,7 +8047,9 @@ sub handler { } elsif ($command eq 'processGroup' && $perm{'vgr'}) { &processGroup($request); } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) { - $request->print(&gradingmenu($request)); + $request->print(&grading_menu($request)); + } elsif ($command eq 'submit_options' && $perm{'vgr'}) { + $request->print(&submit_options($request)); } elsif ($command eq 'viewgrades' && $perm{'vgr'}) { $request->print(&viewgrades($request)); } elsif ($command eq 'handgrade' && $perm{'mgr'}) { @@ -6275,6 +8062,8 @@ sub handler { $request->print(&process_clicker($request)); } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { $request->print(&process_clicker_file($request)); + } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) { + $request->print(&assign_clicker_grades($request)); } elsif ($command eq 'csvform' && $perm{'mgr'}) { $request->print(&upcsvScores_form($request)); } elsif ($command eq 'csvupload' && $perm{'mgr'}) { @@ -6318,6 +8107,7 @@ sub handler { } } $request->print(&Apache::loncommon::end_page()); + &reset_caches(); return ''; } |