--- loncom/homework/grades.pm 2007/06/15 22:16:13 1.409
+++ loncom/homework/grades.pm 2007/11/06 10:12:27 1.481
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.409 2007/06/15 22:16:13 albertel Exp $
+# $Id: grades.pm,v 1.481 2007/11/06 10:12:27 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -35,6 +35,7 @@ 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);
@@ -45,36 +46,104 @@ 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); }
}
@@ -93,6 +162,7 @@ sub get_symb {
return ();
}
}
+ &Apache::lonenc::check_decrypt(\$symb);
return ($symb);
}
@@ -194,22 +264,54 @@ sub showResourceInfo {
return $result,$responseType,$hdgrade,$partlist,$handgrade;
}
+sub reset_caches {
+ &reset_analyze_cache();
+ &reset_perm();
+}
-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"});
+{
+ my %analyze_cache;
+
+ 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.
@@ -230,8 +332,8 @@ sub cleanRecord {
$bottomrow.='
'.$grayFont.$foil.'
';
}
return '
'.
- '
Answer
'.$toprow.'
'.
- '
'.$grayFont.'Option ID
'.
+ '
'.&mt('Answer').'
'.$toprow.'
'.
+ '
'.$grayFont.&mt('Option ID').'
'.
$grayFont.$bottomrow.'
'.'
';
} elsif ($response eq 'match') {
my %answer=&Apache::lonnet::str2hash($answer);
@@ -250,31 +352,31 @@ sub cleanRecord {
$bottomrow.='
'.$grayFont.$foil.'
';
}
return '
'.
- '
Answer
'.$toprow.'
'.
- '
'.$grayFont.'Item ID
'.
+ '
'.&mt('Answer').'
'.$toprow.'
'.
+ '
'.$grayFont.&mt('Item ID').'
'.
$middlerow.'
'.
- '
'.$grayFont.'Option ID
'.
+ '
'.$grayFont.&mt('Option ID').'
'.
$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.='
true
';
+ if ($foil eq $correct) {
+ $toprow.='
'.&mt('true').'
';
} else {
- $toprow.='
true
';
+ $toprow.='
'.&mt('true').'
';
}
} else {
- $toprow.='
false
';
+ $toprow.='
'.&mt('false').'
';
}
$bottomrow.='
'.$grayFont.$foil.'
';
}
return '
'.
- '
Answer
'.$toprow.'
'.
- '
'.$grayFont.'Option ID
'.
+ '
'.&mt('Answer').'
'.$toprow.'
'.
+ '
'.$grayFont.&mt('Option ID').'
'.
$grayFont.$bottomrow.'
'.'
';
} elsif ($response eq 'essay') {
if (! exists ($env{'form.'.$symb})) {
@@ -326,7 +428,10 @@ sub cleanRecord {
$result.='';
return $result;
}
-
+ } elsif ( $response =~ m/(?:numerical|formula)/) {
+ $answer =
+ &Apache::loncommon::format_previous_attempt_value('submission',
+ $answer);
}
return $answer;
}
@@ -370,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);
@@ -380,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;
@@ -400,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});
}
@@ -484,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.= '
+ '.&mt('Grade Complete Folder for One Student').'
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ';
return $result;
}
@@ -6136,15 +7587,17 @@ sub gather_clicker_ids {
# Set up a couple variables.
my $username_idx = &Apache::loncoursedata::CL_SNAME();
my $domain_idx = &Apache::loncoursedata::CL_SDOM();
+ my $status_idx = &Apache::loncoursedata::CL_STATUS();
foreach my $student (keys(%$classlist)) {
-
+ if ($classlist->{$student}->[$status_idx] ne 'Active') { next; }
my $username = $classlist->{$student}->[$username_idx];
my $domain = $classlist->{$student}->[$domain_idx];
my $clickers =
(&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1];
foreach my $id (split(/\,/,$clickers)) {
- $id=~s/^0+//;
+ $id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
if (exists($clicker_ids{$id})) {
$clicker_ids{$id}.=','.$username.':'.$domain;
} else {
@@ -6166,7 +7619,8 @@ sub gather_adv_clicker_ids {
my $clickers =
(&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
foreach my $id (split(/\,/,$clickers)) {
- $id=~s/^0+//;
+ $id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
if (exists($clicker_ids{$id})) {
$clicker_ids{$id}.=','.$puname.':'.$pudom;
} else {
@@ -6178,6 +7632,14 @@ sub gather_adv_clicker_ids {
return %clicker_ids;
}
+sub clicker_grading_parameters {
+ return ('gradingmechanism' => 'scalar',
+ 'upfiletype' => 'scalar',
+ 'specificid' => 'scalar',
+ 'pcorrect' => 'scalar',
+ 'pincorrect' => 'scalar');
+}
+
sub process_clicker {
my ($r)=@_;
my ($symb)=&get_symb($r);
@@ -6191,16 +7653,33 @@ sub process_clicker {
$result.=' '.&mt('Specify a file containing the clicker information for this resource').
'.'."\n";
$result.='
'."\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 $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");
+ 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('iclicker','upfiletype',
- ('iclicker' => 'i>clicker'));
-
+ my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
+ ('iclicker' => 'i>clicker',
+ 'interwrite' => 'interwrite PRS'));
+ $symb = &Apache::lonenc::check_encrypt($symb);
$result.=<
function sanitycheck() {
@@ -6248,13 +7727,13 @@ function sanitycheck() {
-
-
-
-
-
-
-
+
+
+
+
+
+
+
ENDUPFORM
@@ -6268,6 +7747,11 @@ sub process_clicker_file {
my ($r)=@_;
my ($symb)=&get_symb($r);
if (!$symb) {return '';}
+
+ my %Saveable_Parameters=&clicker_grading_parameters();
+ &Apache::loncommon::store_course_settings('grades_clicker',
+ \%Saveable_Parameters);
+
my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) {
$result.=''.&mt('You need to specify a clicker ID for the correct answer').'';
@@ -6279,28 +7763,32 @@ sub process_clicker_file {
%correct_ids=&gather_adv_clicker_ids();
}
if ($env{'form.gradingmechanism'} eq 'specific') {
- my $correct_id=$env{'form.specificid'};
- $correct_id=~tr/a-z/A-Z/;
- $correct_id=~s/\s//gs;
- $correct_id=~s/^0+//;
- $correct_ids{$correct_id}='specified';
+ 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';
+ }
+ }
}
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').'
';
+ $result.='
'.&mt('Correctness determined by the following IDs').'';
foreach my $id (sort(keys(%correct_ids))) {
- $result.=''.$id.' - ';
+ $result.=' '.$id.' - ';
if ($correct_ids{$id} eq 'specified') {
$result.=&mt('specified');
} else {
my ($uname,$udom)=split(/\:/,$correct_ids{$id});
$result.=&Apache::loncommon::plainname($uname,$udom);
}
- $result.=' ';
$number++;
}
+ $result.="
\n";
if ($number==0) {
$result.=''.&mt('No IDs found to determine correct answer').'';
return $result.&show_grading_menu_form($symb);
@@ -6313,6 +7801,25 @@ sub process_clicker_file {
''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'');
return $result.&show_grading_menu_form($symb);
}
+
+# Were able to get all the info needed, now analyze the file
+
+ $result.=&Apache::loncommon::studentbrowser_javascript();
+ $symb = &Apache::lonenc::check_encrypt($symb);
+ my $heading=&mt('Scanning clicker file');
+ $result.=(<
+
+$heading
+
+
+
+
+
+
+
+
+ENDHEADER
my %responses;
my @questiontitles;
my $errormsg='';
@@ -6320,10 +7827,76 @@ sub process_clicker_file {
if ($env{'form.upfiletype'} eq 'iclicker') {
($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
}
- $result.=' '.&mt('Found [_1] questions',$number).' ';
+ if ($env{'form.upfiletype'} eq 'interwrite') {
+ ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
+ }
+ $result.=' '.&mt('Found [_1] question(s)',$number).' '.
+ ''.
+ &mt('Awarding [_1] percent for corrion(s)',$number).' '.
+ ''.
+ &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
+ $env{'form.pcorrect'},$env{'form.pincorrect'}).
+ ' ';
+# Remember Question Titles
+# FIXME: Possibly need delimiter other than ":"
+ for (my $i=0;$i<$number;$i++) {
+ $result.='').'" />';
+ }
+ my $correct_count=0;
+ my $student_count=0;
+ my $unknown_count=0;
+# Match answers with usernames
+# FIXME: Possibly need delimiter other than ":"
foreach my $id (keys(%responses)) {
- $result.=' '.$id.' - '.$responses{$id};
+ if ($correct_ids{$id}) {
+ $result.="\n".'';
+ $correct_count++;
+ } elsif ($clicker_ids{$id}) {
+ if ($clicker_ids{$id}=~/\,/) {
+# More than one user with the same clicker!
+ $result.="\n".&mt('Clicker registered more than once').": ".$id." ";
+ $result.="\n".''.
+ "";
+ foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) {
+ $result.="';
+ }
+ $result.='';
+ $unknown_count++;
+ } else {
+# Good: found one and only one user with the right clicker
+ $result.="\n".'';
+ $student_count++;
+ }
+ } else {
+ $result.="\n".&mt('Unregistered Clicker')." ".$id." ";
+ $result.="\n".''.
+ "\n".&mt("Username").": ".
+ "\n".&mt("Domain").": ".
+ &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '.
+ &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id);
+ $unknown_count++;
+ }
+ }
+ $result.=''.
+ &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
+ if ($env{'form.gradingmechanism'} ne 'attendance') {
+ if ($correct_count==0) {
+ $errormsg.="Found no correct answers answers for grading!";
+ } elsif ($correct_count>1) {
+ $result.=' '.&mt("Found [_1] entries for grading!",$correct_count).'';
+ }
+ }
+ if ($number<1) {
+ $errormsg.="Found no questions.";
}
+ if ($errormsg) {
+ $result.=' '.&mt($errormsg).'';
+ } else {
+ $result.=' ';
+ }
+ $result.='
'."\n".
+ '
'."\n";
return $result.&show_grading_menu_form($symb);
}
@@ -6332,14 +7905,8 @@ sub iclicker_eval {
my $number=0;
my $errormsg='';
foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
- chomp($line);
- foreach my $quoted ($line=~/\,\s*\"([^\"]*)\"\s*\,/g) {
- my $replace=$quoted;
- $replace=~s/\,//g;
- &Apache::lonnet::logthis($quoted.' - '.$replace.' ');
- $line=~s/\,\s*\"\Q$quoted\E\"\s*\,/,$replace,/gs;
- }
- my @entries=split(/\,/,$line);
+ 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];
@@ -6360,10 +7927,144 @@ sub iclicker_eval {
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.=(<
+
+$heading
+ENDHEADER
+# Get correct result
+# FIXME: Possibly need delimiter other than ":"
+ my @correct=();
+ my $gradingmechanism=$env{'form.gradingmechanism'};
+ my $number=$env{'form.number'};
+ if ($gradingmechanism ne 'attendance') {
+ foreach my $key (keys(%env)) {
+ if ($key=~/^form\.correct\:/) {
+ my @input=split(/\,/,$env{$key});
+ for (my $i=0;$i<=$#input;$i++) {
+ if (($correct[$i]) && ($input[$i]) &&
+ ($correct[$i] ne $input[$i])) {
+ $result.=' '.
+ &mt('More than one correct result given for question "[_1]": [_2] versus [_3].',
+ $env{'form.question:'.$i},$correct[$i],$input[$i]).'';
+ } elsif ($input[$i]) {
+ $correct[$i]=$input[$i];
+ }
+ }
+ }
+ }
+ for (my $i=0;$i<$number;$i++) {
+ if (!$correct[$i]) {
+ $result.=' '.
+ &mt('No correct result given for question "[_1]"!',
+ $env{'form.question:'.$i}).'';
+ }
+ }
+ $result.=' '.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct));
+ }
+# Start grading
+ my $pcorrect=$env{'form.pcorrect'};
+ my $pincorrect=$env{'form.pincorrect'};
+ my $storecount=0;
+ foreach my $key (keys(%env)) {
+ my $user='';
+ if ($key=~/^form\.student\:(.*)$/) {
+ $user=$1;
+ }
+ if ($key=~/^form\.unknown\:(.*)$/) {
+ my $id=$1;
+ if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {
+ $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};
+ } elsif ($env{'form.multi'.$id}) {
+ $user=$env{'form.multi'.$id};
+ }
+ }
+ if ($user) {
+ my @answer=split(/\,/,$env{$key});
+ my $sum=0;
+ for (my $i=0;$i<$number;$i++) {
+ if ($answer[$i]) {
+ if ($gradingmechanism eq 'attendance') {
+ $sum+=$pcorrect;
+ } else {
+ if ($answer[$i] eq $correct[$i]) {
+ $sum+=$pcorrect;
+ } else {
+ $sum+=$pincorrect;
+ }
+ }
+ }
+ }
+ my $ave=$sum/(100*$number);
+# Store
+ my ($username,$domain)=split(/\:/,$user);
+ my %grades=();
+ $grades{"resource.$part.solved"}='correct_by_override';
+ $grades{"resource.$part.awarded"}=$ave;
+ $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
+ my $returncode=&Apache::lonnet::cstore(\%grades,$symb,
+ $env{'request.course.id'},
+ $domain,$username);
+ if ($returncode ne 'ok') {
+ $result.=" Failed to save student $username:$domain. Message when trying to save was ($returncode)";
+ } else {
+ $storecount++;
+ }
+ }
+ }
+# We are done
+ $result.=' '.&mt('Successfully stored grades for [_1] student(s).',$storecount).
+ '