[LON-CAPA-cvs] cvs: loncom / lond /homework grades.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Fri, 03 Jun 2005 18:23:21 -0000
This is a MIME encoded message
--raeburn1117823001
Content-Type: text/plain
raeburn Fri Jun 3 14:23:21 2005 EDT
Modified files:
/loncom lond
/loncom/homework grades.pm
Log:
Unescape value passed to lond's increment function so that negative increments can be passed. Include functionality in grades.pm so that iuse of "reset status" causes aggregate totals to be decremented appropriately.
--raeburn1117823001
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20050603142321.txt"
Index: loncom/lond
diff -u loncom/lond:1.283 loncom/lond:1.284
--- loncom/lond:1.283 Mon May 2 19:34:41 2005
+++ loncom/lond Fri Jun 3 14:23:19 2005
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.283 2005/05/02 23:34:41 albertel Exp $
+# $Id: lond,v 1.284 2005/06/03 18:23:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,7 +58,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.283 $'; #' stupid emacs
+my $VERSION='$Revision: 1.284 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -2445,11 +2445,17 @@
my @pairs=split(/\&/,$what);
foreach my $pair (@pairs) {
my ($key,$value)=split(/=/,$pair);
+ $value = &unescape($value);
# We could check that we have a number...
if (! defined($value) || $value eq '') {
$value = 1;
}
$hashref->{$key}+=$value;
+ if ($namespace eq 'nohist_resourcetracker') {
+ if ($hashref->{$key} < 0) {
+ $hashref->{$key} = 0;
+ }
+ }
}
if (untie(%$hashref)) {
&Reply( $client, "ok\n", $userinput);
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.268 loncom/homework/grades.pm:1.269
--- loncom/homework/grades.pm:1.268 Thu May 26 17:26:24 2005
+++ loncom/homework/grades.pm Fri Jun 3 14:23:19 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.268 2005/05/26 21:26:24 albertel Exp $
+# $Id: grades.pm,v 1.269 2005/06/03 18:23:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -152,6 +152,7 @@
}
return $display;
}
+
#--- Show resource title
#--- and parts and response type
sub showResourceInfo {
@@ -1351,6 +1352,15 @@
my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
my $display_part=&get_display_part($partid,undef,$symb);
+ my @partids = ("$partid");
+ my %last_resets = ();
+ &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids);
+ my $aggtries;
+ if ($last_resets{$partid}) {
+ $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
+ } else {
+ $aggtries = $$record{'resource.'.$partid.'.tries'};
+ }
$result.='<table border="0"><tr><td>'.
'<b>Part: </b>'.$display_part.' <b>Points: </b></td><td>'."\n";
@@ -1389,7 +1399,11 @@
$result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".
'<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n".
'<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'.
- $$record{'resource.'.$partid.'.solved'}.'" />'."\n";
+ $$record{'resource.'.$partid.'.solved'}.'" />'."\n".
+ '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'.
+ $$record{'resource.'.$partid.'.tries'}.'" />'."\n".
+ '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'.
+ $aggtries.'" />'."\n";
$result.='</td></tr></table>'."\n";
return $result;
}
@@ -1598,7 +1612,6 @@
}
my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
-
my ($partlist,$handgrade,$responseType) = &response_type($url,$symb);
# Display student info
@@ -2122,6 +2135,8 @@
my @parts_graded;
my %newrecord = ();
my ($pts,$wgt) = ('','');
+ my %aggregate = ();
+ my $aggregateflag = 0;
foreach my $new_part (split(/:/,$env{'form.partlist'.$newflg})) {
#collaborator may vary for different parts
if ($submitter && $new_part ne $part) { next; }
@@ -2141,6 +2156,21 @@
}
$newrecord{'resource.'.$new_part.'.regrader'}=
"$env{'user.name'}:$env{'user.domain'}";
+ my @partids = ("$new_part");
+ my %last_resets = ();
+ &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids);
+ my ($totaltries,$aggtries,$solvedstatus);
+ $totaltries = $record{'resource.'.$part.'.tries'};
+ if ($last_resets{$new_part}) {
+ $aggtries = &get_num_tries(\%record,$last_resets{$new_part},$new_part);
+ } else {
+ $aggtries = $totaltries;
+ }
+ $solvedstatus = $record{'resource.'.$new_part.'.solved'};
+ if ($aggtries > 0) {
+ &decrement($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus);
+ $aggregateflag = 1;
+ }
} elsif ($dropMenu eq '') {
$pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ?
$env{'form.GD_BOX'.$newflg.'_'.$new_part} :
@@ -2189,9 +2219,75 @@
&Apache::lonnet::cstore(\%newrecord,$symb,
$env{'request.course.id'},$domain,$stuname);
}
+ if ($aggregateflag) {
+ &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ }
return '',$pts,$wgt;
}
+# ----------- Provides number of tries since last reset.
+sub get_num_tries {
+ my ($record,$last_reset,$part) = @_;
+ my $timestamp = '';
+ my $num_tries = 0;
+ if ($$record{'version'}) {
+ for (my $version=$$record{'version'};$version>=1;$version--) {
+ if (exists($$record{$version.':resource.'.$part.'.solved'})) {
+ $timestamp = $$record{$version.':timestamp'};
+ if ($timestamp > $last_reset) {
+ $num_tries ++;
+ } else {
+ last;
+ }
+ }
+ }
+ }
+ return $num_tries;
+}
+
+# ----------- Determine decrements required in aggregate totals
+sub decrement_aggs {
+ my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_;
+ my %decrement = (
+ attempts => 0,
+ users => 0,
+ correct => 0
+ );
+ $decrement{'attempts'} = $aggtries;
+ if ($solvedstatus =~ /^correct/) {
+ $decrement{'correct'} = 1;
+ }
+ if ($aggtries == $totaltries) {
+ $decrement{'users'} = 1;
+ }
+ foreach my $type (keys (%decrement)) {
+ $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type};
+ }
+ return;
+}
+
+# ----------- Determine timestamps for last reset of aggregate totals for parts
+sub get_last_resets {
+ my ($symb,$courseid,$last_resets,$partids) =@_;
+ my $cdom = $env{'course.'.$courseid.'.domain'};
+ my $cname = $env{'course.'.$courseid.'.num'};
+ my %resethash = &Apache::lonnet::restore($symb,'nohist_resourcetracker',$cdom,$cname);
+ if ($resethash{'version'}) {
+ foreach my $part (@{$partids}) {
+ $$last_resets{$part} = '';
+ for (my $version=$resethash{'version'};$version>=1;$version--) {
+ if (exists($resethash{$version.':'.$part."\0".'prev_attempts'})) {
+ $$last_resets{$part} = $resethash{$version.':timestamp'};
+ last;
+ }
+ }
+ }
+ }
+ return;
+}
+
# ----------- Handles creating versions for portfolio files as answers
sub version_portfiles {
my ($record, $parts_graded, $courseid, $symb, $domain, $stuname, $v_flag) = @_;
@@ -2381,7 +2477,7 @@
if (selval[2].selected) {
document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0";
}
- }
+ }
}
function resetEntry(numpart) {
@@ -2514,11 +2610,13 @@
'<table border=0><tr bgcolor="#deffff"><td> <b>No.</b> </td>'.
'<td>'.&nameUserString('header')."</td>\n";
my (@parts) = sort(&getpartlist($url,$symb));
+ my @partids = ();
foreach my $part (@parts) {
my $display=&Apache::lonnet::metadata($url,$part.'.display');
$display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower
if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
my ($partid) = &split_part_type($part);
+ push(@partids, $partid);
my $display_part=&get_display_part($partid,$url,$symb);
if ($display =~ /^Partial Credit Factor/) {
$result.='<td><b>Score Part:</b> '.$display_part.
@@ -2532,6 +2630,10 @@
}
$result.='</tr>';
+ # retrieve last reset information
+ my %last_resets = ();
+ &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids);
+
#get info for each student
#list all the students - with points and grade status
my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');
@@ -2539,7 +2641,7 @@
foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
$ctr++;
$result.=&viewstudentgrade($url,$symb,$env{'request.course.id'},
- $_,$$fullname{$_},\@parts,\%weight,$ctr);
+ $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets);
}
$result.='</table></td></tr></table>';
$result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n";
@@ -2556,10 +2658,11 @@
#--- call by previous routine to display each student
sub viewstudentgrade {
- my ($url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr) = @_;
+ my ($url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_;
my ($uname,$udom) = split(/:/,$student);
$student=~s/:/_/;
my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
+ my %aggregates = ();
my $result='<tr bgcolor="#ffffdd"><td align="right">'.
'<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.
"\n".$ctr.' </td><td> '.
@@ -2569,7 +2672,21 @@
foreach my $apart (@$parts) {
my ($part,$type) = &split_part_type($apart);
my $score=$record{"resource.$part.$type"};
- $result.='<td align="middle">';
+ $result.='<td align="middle">';
+ my ($aggtries,$totaltries);
+ unless (exists($aggregates{$part})) {
+ $totaltries = $record{'resource.'.$part.'.tries'};
+ if ($$last_resets{$part}) {
+ $aggtries = &get_num_tries(\%record,$$last_resets{$part},$part);
+ } else {
+ $aggtries = $totaltries;
+ }
+ $result.='<input type="hidden" name="'.
+ 'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n";
+ $result.='<input type="hidden" name="'.
+ 'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n";
+ $aggregates{$part} = 1;
+ }
if ($type eq 'awarded') {
my $pts = $score eq '' ? '' : $score*$$weight{$part};
$result.='<input type="hidden" name="'.
@@ -2684,12 +2801,13 @@
$noupdate.=$line."<td colspan=\"$numcols\"><font color=\"red\">Not allowed to modify student</font></td></tr>";
next;
}
+ my %aggregate = ();
+ my $aggregateflag = 0;
foreach (@partid) {
my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
my $old_part = $old_aw eq '' ? '' : $old_part_pcr;
my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
-
my $awarded = $env{'form.GD_'.$user.'_'.$_.'_awarded'};
my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
my $partial = $awarded eq '' ? '' : $pcr;
@@ -2712,6 +2830,13 @@
$newrecord{'resource.'.$_.'.awarded'} = 0;
$newrecord{'resource.'.$_.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
$updateflag = 1;
+ if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) {
+ my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'};
+ my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'};
+ my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'};
+ &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus);
+ $aggregateflag = 1;
+ }
} elsif (!($old_part eq $partial && $old_score eq $score)) {
$updateflag = 1;
$newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne '';
@@ -2751,6 +2876,11 @@
$noupdate.='<tr bgcolor="#ffffde"><td align="right"> '.$noupdateCtr.' </td>'.$line;
$noupdateCtr++;
}
+ if ($aggregateflag) {
+ &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ }
}
if ($noupdate) {
# my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
@@ -3571,6 +3701,8 @@
my %newrecord=();
my @displayPts=();
+ my %aggregate = ();
+ my $aggregateflag = 0;
foreach my $partid (@{$parts}) {
my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};
my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};
@@ -3597,6 +3729,14 @@
$newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}";
$changeflag++;
$newpts = '';
+
+ my $aggtries = $env{'form.aggtries'.$question.'_'.$partid};
+ my $totaltries = $env{'form.totaltries'.$question.'_'.$partid};
+ my $solvedstatus = $env{'form.solved'.$question.'_'.$partid};
+ if ($aggtries > 0) {
+ &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus);
+ $aggregateflag = 1;
+ }
}
my $display_part=&get_display_part($partid,undef,
$curRes->symb());
@@ -3622,6 +3762,11 @@
&Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'},
$udom,$uname);
}
+ if ($aggregateflag) {
+ &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ }
$studentTable.='<td valign="top">'.$displayPts[0].'</td>'.
'<td valign="top">'.$displayPts[1].'</td>'.
--raeburn1117823001--