--- loncom/homework/grades.pm 2007/06/13 17:20:12 1.399.2.1
+++ loncom/homework/grades.pm 2007/09/05 00:22:20 1.428.2.2
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.399.2.1 2007/06/13 17:20:12 albertel Exp $
+# $Id: grades.pm,v 1.428.2.2 2007/09/05 00:22:20 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -41,13 +41,11 @@ 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 %perm;
# ----- These first few routines are general use routines.----
#
@@ -94,6 +92,7 @@ sub get_symb {
return ();
}
}
+ &Apache::lonenc::check_decrypt(\$symb);
return ($symb);
}
@@ -180,7 +179,7 @@ sub showResourceInfo {
if (exists($partsseen{$partID})) {
$result.="
";
} else {
- $result.="
";
+ $result.="
";
}
$partsseen{$partID}=1;
}
@@ -195,22 +194,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.
@@ -259,11 +290,11 @@ sub cleanRecord {
} 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) {
+ if ($foil eq $correct) {
$toprow.='
true
';
} else {
$toprow.='
true
';
@@ -493,7 +524,7 @@ sub jscriptNform {
' }'."\n".
''."\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'}.
@@ -3108,7 +3133,7 @@ sub viewstudentgrade {
''.
"\n".$ctr.'
'."\n";
$student=~s/:/_/; # colon doen't work in javascript for names
foreach my $apart (@$parts) {
@@ -3146,8 +3171,8 @@ sub viewstudentgrade {
$result.=' \n";
} else {
@@ -3472,6 +3497,7 @@ sub csvuploadmap_header {
my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
my $ignore=&mt('Ignore First Line');
+ $symb = &Apache::lonenc::check_encrypt($symb);
$request->print(<
Uploading Class Grades
@@ -3566,6 +3592,7 @@ sub upcsvScores_form {
my $upload=&mt("Upload Scores");
my $upfile_select=&Apache::loncommon::upfile_select_html();
my $ignore=&mt('Ignore First Line');
+ $symb = &Apache::lonenc::check_encrypt($symb);
$result.=<
@@ -3840,7 +3867,7 @@ LISTJAVASCRIPT
$result.=''."\n".
+ $result.=''."\n".
''."\n".
- ''."\n";
+ ''."\n";
return $result;
}
@@ -6125,10 +7064,491 @@ sub init_perm {
}
}
+sub gather_clicker_ids {
+ my %clicker_ids;
+
+ my $classlist = &Apache::loncoursedata::get_classlist();
+
+ # 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/[\-\:]//g;
+ if (exists($clicker_ids{$id})) {
+ $clicker_ids{$id}.=','.$username.':'.$domain;
+ } else {
+ $clicker_ids{$id}=$username.':'.$domain;
+ }
+ }
+ }
+ return %clicker_ids;
+}
+
+sub gather_adv_clicker_ids {
+ my %clicker_ids;
+ my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum);
+ foreach my $element (sort(keys(%coursepersonnel))) {
+ foreach my $person (split(/\,/,$coursepersonnel{$element})) {
+ my ($puname,$pudom)=split(/\:/,$person);
+ my $clickers =
+ (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
+ foreach my $id (split(/\,/,$clickers)) {
+ $id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
+ if (exists($clicker_ids{$id})) {
+ $clicker_ids{$id}.=','.$puname.':'.$pudom;
+ } else {
+ $clicker_ids{$id}=$puname.':'.$pudom;
+ }
+ }
+ }
+ }
+ 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);
+ if (!$symb) {return '';}
+ my $result=&checkforfile_js();
+ $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
+ my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
+ $result.=$table;
+ $result.='
'."\n";
+ $result.='
'."\n";
+ $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(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.=<
+function sanitycheck() {
+// Accept only integer percentages
+ document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value);
+ document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value);
+// Find out grading choice
+ for (i=0; i
+
+ENDUPFORM
+ $result.='
'."\n".
+ '
'."\n";
+ $result.=&show_grading_menu_form($symb);
+ return $result;
+}
+
+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').'';
+ 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';
+ }
+ }
+ }
+ 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.=' '.$id.' - ';
+ if ($correct_ids{$id} eq 'specified') {
+ $result.=&mt('specified');
+ } else {
+ my ($uname,$udom)=split(/\:/,$correct_ids{$id});
+ $result.=&Apache::loncommon::plainname($uname,$udom);
+ }
+ $number++;
+ }
+ $result.="
\n";
+ if ($number==0) {
+ $result.=''.&mt('No IDs found to determine correct answer').'';
+ return $result.&show_grading_menu_form($symb);
+ }
+ }
+ if (length($env{'form.upfile'}) < 2) {
+ $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.',
+ '',
+ '',
+ ''.&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
+
'."\n".
+ '
'."\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.=(<
+
+$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).
+ '