[LON-CAPA-cvs] cvs: loncom / lond /homework grades.pm structuretags.pm /interface lontrackstudent.pm /lonnet/perl lonnet.pm /metadata_database parse_activity_log.pl
raeburn
raeburn at source.lon-capa.org
Sun Nov 23 21:36:35 EST 2014
raeburn Mon Nov 24 02:36:35 2014 EDT
Modified files:
/loncom lond
/loncom/lonnet/perl lonnet.pm
/loncom/homework structuretags.pm grades.pm
/loncom/interface lontrackstudent.pm
/loncom/metadata_database parse_activity_log.pl
Log:
- Bug 6740 Out-of-order recording of submissions (by time).
- Check for new transactions made immediately before call to lonnet::cstore()
&Apache::inputtags::hidealldata() called if correct then incorrect,
where awarded >= 1 when correct (feedback on correctness enabled).
- Check for transactions made immediately after call to lonnet::cstore()
if reply from lond::store_handler() is delay:N (where N s the number of
transactions between the last retrieved in &initialize_storage() and the
last stored immediately before permanent storage of the current transaction.
&Apache::grades::makehidden() called if correct then incorrect,
where awarded >= 1 when correct (feedback on correctness enabled).
-------------- next part --------------
Index: loncom/lond
diff -u loncom/lond:1.511 loncom/lond:1.512
--- loncom/lond:1.511 Sun Jun 29 03:22:43 2014
+++ loncom/lond Mon Nov 24 02:36:16 2014
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.511 2014/06/29 03:22:43 raeburn Exp $
+# $Id: lond,v 1.512 2014/11/24 02:36:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,7 +61,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.511 $'; #' stupid emacs
+my $VERSION='$Revision: 1.512 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -3322,6 +3322,9 @@
# namespace - Name of the database being modified
# rid - Resource keyword to modify.
# what - new value associated with rid.
+# laststore - (optional) version=timestamp
+# for most recent transaction for rid
+# in namespace, when cstore was called
#
# $client - Socket open on the client.
#
@@ -3330,23 +3333,45 @@
# 1 (keep on processing).
# Side-Effects:
# Writes to the client
+# Successful storage will cause either 'ok', or, if $laststore was included
+# in the tail of the request, and the version number for the last transaction
+# is larger than the version in $laststore, delay:$numtrans , where $numtrans
+# is the number of store evevnts recorded for rid in namespace since
+# lonnet::store() was called by the client.
+#
sub store_handler {
my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail";
-
- my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail);
+ chomp($tail);
+ my ($udom,$uname,$namespace,$rid,$what,$laststore) =split(/:/,$tail);
if ($namespace ne 'roles') {
- chomp($what);
my @pairs=split(/\&/,$what);
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_WRCREAT(), "S",
"$rid:$what");
if ($hashref) {
my $now = time;
- my @previouskeys=split(/&/,$hashref->{"keys:$rid"});
- my $key;
+ my $numtrans;
+ if ($laststore) {
+ my ($previousversion,$previoustime) = split(/\=/,$laststore);
+ my ($lastversion,$lasttime) = (0,0);
+ $lastversion = $hashref->{"version:$rid"};
+ if ($lastversion) {
+ $lasttime = $hashref->{"$lastversion:$rid:timestamp"};
+ }
+ if (($previousversion) && ($previousversion !~ /\D/)) {
+ if (($lastversion > $previousversion) && ($lasttime >= $previoustime)) {
+ $numtrans = $lastversion - $previousversion;
+ }
+ } elsif ($lastversion) {
+ $numtrans = $lastversion;
+ }
+ if ($numtrans) {
+ $numtrans =~ s/D//g;
+ }
+ }
$hashref->{"version:$rid"}++;
my $version=$hashref->{"version:$rid"};
my $allkeys='';
@@ -3359,7 +3384,11 @@
$allkeys.='timestamp';
$hashref->{"$version:keys:$rid"}=$allkeys;
if (&untie_user_hash($hashref)) {
- &Reply($client, "ok\n", $userinput);
+ my $msg = 'ok';
+ if ($numtrans) {
+ $msg = 'delay:'.$numtrans;
+ }
+ &Reply($client, "$msg\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting store\n", $userinput);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1268 loncom/lonnet/perl/lonnet.pm:1.1269
--- loncom/lonnet/perl/lonnet.pm:1.1268 Fri Oct 24 00:20:15 2014
+++ loncom/lonnet/perl/lonnet.pm Mon Nov 24 02:36:21 2014
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1268 2014/10/24 00:20:15 raeburn Exp $
+# $Id: lonnet.pm,v 1.1269 2014/11/24 02:36:21 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -4853,7 +4853,7 @@
# ----------------------------------------------------------------------- Store
sub store {
- my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
+ my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_;
my $home='';
if ($stuname) { $home=&homeserver($stuname,$domain); }
@@ -4883,13 +4883,13 @@
}
$namevalue=~s/\&$//;
&courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
- return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
+ return reply("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");
}
# -------------------------------------------------------------- Critical Store
sub cstore {
- my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
+ my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_;
my $home='';
if ($stuname) { $home=&homeserver($stuname,$domain); }
@@ -4920,7 +4920,7 @@
$namevalue=~s/\&$//;
&courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
return critical
- ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
+ ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");
}
# --------------------------------------------------------------------- Restore
@@ -5818,7 +5818,7 @@
# --------------------------------------------------------- putstore interface
sub putstore {
- my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;
+ my ($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog)=@_;
if (!$udomain) { $udomain=$env{'user.domain'}; }
if (!$uname) { $uname=$env{'user.name'}; }
my $uhome=&homeserver($uname,$udomain);
@@ -5832,6 +5832,17 @@
my $reply =
&reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items",
$uhome);
+ if (($tolog) && ($reply eq 'ok')) {
+ my $namevalue='';
+ foreach my $key (keys(%{$storehash})) {
+ $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';
+ }
+ $namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}).
+ '&host='.&escape($perlvar{'lonHostID'}).
+ '&version='.$esc_v.
+ '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
+ &Apache::lonnet::courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);
+ }
if ($reply eq 'unknown_cmd') {
# gfall back to way things use to be done
return &old_putstore($namespace,$symb,$version,$storehash,$udomain,
@@ -6036,7 +6047,6 @@
return $code;
}
-
# -------------------------------------------------- portfolio access checking
sub portfolio_access {
@@ -12589,7 +12599,7 @@
Calling convention:
my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname);
- &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname);
+ &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$laststore);
For more detailed information, see lonnet specific documentation.
@@ -13226,15 +13236,21 @@
=item *
-store($storehash,$symb,$namespace,$udom,$uname) : stores hash permanently
-for this url; hashref needs to be given and should be a \%hashname; the
-remaining args aren't required and if they aren't passed or are '' they will
-be derived from the env
+store($storehash,$symb,$namespace,$udom,$uname,$laststore) : stores hash
+permanently for this url; hashref needs to be given and should be a \%hashname;
+the remaining args aren't required and if they aren't passed or are '' they will
+be derived from the env (with the exception of $laststore, which is an
+optional arg used when a user's submission is stored in grading).
+$laststore is $version=$timestamp, where $version is the most recent version
+number retrieved for the corresponding $symb in the $namespace db file, and
+$timestamp is the timestamp for that transaction (UNIX time).
+$laststore is currently only passed when cstore() is called by
+structuretags::finalize_storage().
=item *
-cstore($storehash,$symb,$namespace,$udom,$uname) : same as store but
-uses critical subroutine
+cstore($storehash,$symb,$namespace,$udom,$uname,$laststore) : same as store
+but uses critical subroutine
=item *
@@ -13257,10 +13273,11 @@
=item *
-putstore($namespace,$symb,$version,$storehash,$udomain,$uname) :
+putstore($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog) :
replaces a &store() version of data with a replacement set of data
for a particular resource in a namespace passed in the $storehash hash
-reference
+reference. If $tolog is true, the transaction is logged in the courselog
+with an action=PUTSTORE.
=item *
Index: loncom/homework/structuretags.pm
diff -u loncom/homework/structuretags.pm:1.523 loncom/homework/structuretags.pm:1.524
--- loncom/homework/structuretags.pm:1.523 Fri Nov 21 18:04:57 2014
+++ loncom/homework/structuretags.pm Mon Nov 24 02:36:26 2014
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# definition of tags that give a structure to a document
#
-# $Id: structuretags.pm,v 1.523 2014/11/21 18:04:57 raeburn Exp $
+# $Id: structuretags.pm,v 1.524 2014/11/24 02:36:26 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -897,12 +897,37 @@
=item finalize_storage()
- Stores away the result hash to a student's environment
+ Stores away the result hash to a student's environment;
checks form.grade_ for specific values, otherwise stores
to the running user's environment.
- Will increment totals for attempts, students, and corrects
- if running user has student role.
-
+
+ &check_correctness_changes() is called in two circumstances
+ in which the results hash is to be stored permanently, for
+ grading triggered by a student's submission, where feedback on
+ correctness is to be provided to the student.
+
+ 1. Immediately prior to storing the results hash
+
+ To handle the case where a student's submission (and award) were
+ stored after history was retrieved in &initialize_storage(), e.g.,
+ if a student submitted answers in quick succession (e.g., from
+ multiple tabs). &Apache::inputtags::hidealldata() is called for
+ any parts with out-of-order storage (i.e., correct then incorrect,
+ where awarded >= 1 when correct).
+
+ 2. Immediately after storing the results hash
+
+ To handle the case where lond on the student's homeserver returns
+ delay:N -- where N is the number of transactions between the last
+ retrieved in &initialize_storage() and the last stored immediately
+ before permanent storage of the current transaction via
+ lond::store_handler(). &Apache::grades::makehidden() is called
+ for any parts with out-of-order storage (i.e., correct then incorrect,
+ where awarded >= 1 when correct).
+
+ Will call &store_aggregates() to increment totals for attempts,
+ students, and corrects, if running user has student role.
+
=cut
@@ -923,8 +948,92 @@
$namespace,'',$domain,$name);
&Apache::lonxml::debug('Construct Store return message:'.$result);
} else {
+ my ($laststore,$checkedparts, at parts,%postcorrect);
+ if (($env{'user.name'} eq $name) && ($env{'user.domain'} eq $domain) &&
+ (!$Apache::lonhomework::scantronmode) && (!defined($env{'form.grade_symb'})) &&
+ (!defined($env{'form.grade_courseid'}))) {
+ if ($Apache::lonhomework::history{'version'}) {
+ $laststore = $Apache::lonhomework::history{'version'}.'='.
+ $Apache::lonhomework::history{'timestamp'};
+ } else {
+ $laststore = '0=0';
+ }
+ my %record = &Apache::lonnet::restore($symb,$courseid,$domain,$name);
+ if ($record{'version'}) {
+ my ($newversion,$oldversion,$oldtimestamp);
+ if ($Apache::lonhomework::history{'version'}) {
+ $oldversion = $Apache::lonhomework::history{'version'};
+ $oldtimestamp = $Apache::lonhomework::history{'timestamp'};
+ } else {
+ $oldversion = 0;
+ $oldtimestamp = 0;
+ }
+ if ($record{'version'} > $oldversion) {
+ if ($record{'timestamp'} >= $oldtimestamp) {
+ $laststore = $record{'version'}.'='.$record{'timestamp'};
+ $newversion = $record{'version'} + 1;
+ $checkedparts = 1;
+ foreach my $key (keys(%Apache::lonhomework::results)) {
+ if ($key =~ /^resource\.([^\.]+)\.solved$/) {
+ my $part = $1;
+ if ($Apache::lonhomework::results{$key} eq 'incorrect_attempted') {
+ push(@parts,$part);
+ }
+ }
+ }
+ if (@parts) {
+ my @parts_to_hide = &check_correctness_changes($symb,$courseid,$domain,$name,
+ \%record,\@parts,$newversion,
+ $oldversion);
+ if (@parts_to_hide) {
+ foreach my $part (@parts_to_hide) {
+ $postcorrect{$part} = 1;
+ &Apache::inputtags::hidealldata($part);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
$result=&Apache::lonnet::cstore(\%Apache::lonhomework::results,
- $symb,$courseid,$domain,$name);
+ $symb,$courseid,$domain,$name,$laststore);
+ if ($result =~ /^delay\:(\d+)$/) {
+ my $numtrans = $1;
+ my ($oldversion) = split(/=/,$laststore);
+ if ($numtrans) {
+ my $newversion = $oldversion + 1 + $numtrans;
+ my @possparts;
+ if ($checkedparts) {
+ foreach my $part (@parts) {
+ unless ($postcorrect{$part}) {
+ push(@possparts,$part);
+ }
+ }
+ } else {
+ foreach my $key (keys(%Apache::lonhomework::results)) {
+ if ($key =~ /^resource\.([^\.]+)\.solved$/) {
+ my $part = $1;
+ unless ($postcorrect{$part}) {
+ if ($Apache::lonhomework::results{$key} eq 'incorrect_attempted') {
+ push(@possparts,$part);
+ }
+ }
+ }
+ }
+ }
+ if (@possparts) {
+ my %newrecord = &Apache::lonnet::restore($symb,$courseid,$domain,$name);
+ my @parts_to_hide = &check_correctness_changes($symb,$courseid,$domain,$name,
+ \%newrecord,\@possparts,$newversion,
+ $oldversion);
+ if (@parts_to_hide) {
+ my $partslist = join(',', at parts_to_hide);
+ &Apache::grades::makehidden($newversion,$partslist,\%newrecord,$symb,$domain,$name,1);
+ }
+ }
+ }
+ }
&Apache::lonxml::debug('Store return message:'.$result);
&store_aggregates($symb,$courseid);
}
@@ -936,6 +1045,62 @@
=pod
+=item check_correctness_changes()
+
+ For all parts for which current results contain a solved status
+ of "incorrect_attempted", check if there was a transaction in which
+ solved was set to "correct_by_student" in the time since the last
+ transaction (retrieved when &initialize_storage() was called i.e.,
+ when &start_problem() was called), unless:
+ (a) questiontype parameter is set to survey or anonymous survey (+/- credit)
+ (b) problemstatus is set to no or no_feedback_ever
+ If such a transaction exists, and did not occur after "reset status"
+ by a user with grading privileges, then the current transaction is an
+ example of an out-of-order transaction (i.e., incorrect occurring after
+ correct). Accordingly, the current transaction should be hidden.
+
+=cut
+
+
+sub check_correctness_changes {
+ my ($symb,$courseid,$domain,$name,$record,$parts,$newversion,$oldversion) = @_;
+ my @parts_to_hide;
+ unless ((ref($record) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
+ return @parts_to_hide;
+ }
+ if (@{$parts}) {
+ my $usec;
+ if (($env{'user.name'} eq $name) && ($env{'user.domain'} eq $domain) &&
+ ($env{'request.course.id'} eq $courseid)) {
+ $usec = $env{'request.course.sec'};
+ } else {
+ $usec = &Apache::lonnet::getsection($domain,$name,$courseid);
+ }
+ foreach my $id (@{$parts}) {
+ next if (($Apache::lonhomework::results{'resource.'.$id.'.type'} =~ /survey/) ||
+ (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
+ $domain,$name,$usec,undef,$courseid) =~ /^no/));
+ my $reset;
+ for (my $i=$newversion-1; $i>=$oldversion; $i--) {
+ if (($record->{$i.':resource.'.$id.'.regrader'}) &&
+ ($record->{$i.':resource.'.$id.'.tries'} eq '') &&
+ ($record->{$i.':resource.'.$id.'.award'} eq '')) {
+ $reset = 1;
+ } elsif (($record->{$i.":resource.$id.solved"} eq 'correct_by_student') &&
+ ($record->{$i.":resource.$id.awarded"} >= 1)) {
+ unless ($reset) {
+ push(@parts_to_hide,$id);
+ last;
+ }
+ }
+ }
+ }
+ }
+ return @parts_to_hide;
+}
+
+=pod
+
item store_aggregates()
Sends hash of values to be incremented in nohist_resourcetracker.db
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.727 loncom/homework/grades.pm:1.728
--- loncom/homework/grades.pm:1.727 Fri Nov 21 17:59:11 2014
+++ loncom/homework/grades.pm Mon Nov 24 02:36:26 2014
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.727 2014/11/21 17:59:11 raeburn Exp $
+# $Id: grades.pm,v 1.728 2014/11/24 02:36:26 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3020,7 +3020,7 @@
my $aggregateflag = 0;
if ($env{'form.HIDE'.$newflg}) {
my ($version,$parts) = split(/:/,$env{'form.HIDE'.$newflg},2);
- my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname);
+ my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1);
$totchg += $numchgs;
}
my @parts = split(/:/,$env{'form.partlist'.$newflg});
@@ -3129,7 +3129,7 @@
}
sub makehidden {
- my ($version,$parts,$record,$symb,$domain,$stuname) = @_;
+ my ($version,$parts,$record,$symb,$domain,$stuname,$tolog) = @_;
return unless (ref($record) eq 'HASH');
my %modified;
my $numchanged = 0;
@@ -3150,7 +3150,7 @@
}
if (keys(%modified)) {
if (&Apache::lonnet::putstore($env{'request.course.id'},$symb,$version,\%modified,
- $domain,$stuname) eq 'ok') {
+ $domain,$stuname,$tolog) eq 'ok') {
$numchanged ++;
}
}
@@ -5064,7 +5064,7 @@
if ($env{'form.HIDE'.$prob}) {
my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);
my ($version,$parts) = split(/:/,$env{'form.HIDE'.$prob},2);
- my $numchgs = &makehidden($version,$parts,\%record,$symbx,$udom,$uname);
+ my $numchgs = &makehidden($version,$parts,\%record,$symbx,$udom,$uname,1);
$hideflag += $numchgs;
}
foreach my $partid (@{$parts}) {
Index: loncom/interface/lontrackstudent.pm
diff -u loncom/interface/lontrackstudent.pm:1.37 loncom/interface/lontrackstudent.pm:1.38
--- loncom/interface/lontrackstudent.pm:1.37 Tue Apr 15 12:05:41 2014
+++ loncom/interface/lontrackstudent.pm Mon Nov 24 02:36:30 2014
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lontrackstudent.pm,v 1.37 2014/04/15 12:05:41 bisitz Exp $
+# $Id: lontrackstudent.pm,v 1.38 2014/11/24 02:36:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -432,7 +432,7 @@
sub display_values {
my ($action,$values)=@_;
my $result='<table>';
- if ($action eq 'CSTORE') {
+ if (($action eq 'CSTORE') || ($action eq 'PUTSTORE')) {
my $is_anon;
my %values=map {split('=',$_,-1)} split(/\&/,$values);
foreach my $key (sort(keys(%values))) {
Index: loncom/metadata_database/parse_activity_log.pl
diff -u loncom/metadata_database/parse_activity_log.pl:1.24 loncom/metadata_database/parse_activity_log.pl:1.25
--- loncom/metadata_database/parse_activity_log.pl:1.24 Sat Apr 8 07:10:10 2006
+++ loncom/metadata_database/parse_activity_log.pl Mon Nov 24 02:36:34 2014
@@ -2,7 +2,7 @@
#
# The LearningOnline Network
#
-# $Id: parse_activity_log.pl,v 1.24 2006/04/08 07:10:10 albertel Exp $
+# $Id: parse_activity_log.pl,v 1.25 2014/11/24 02:36:34 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -481,6 +481,8 @@
# %3aPOST%3a(name)%3d(value)%3a(name)%3d(value)
# or
# %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value)
+ # or
+ # %3aPUTSTORE%3a(name)%3d(value)%26(name)%3d(value)
#
# get delimiter between timestamped entries to be &&&
$log=~s/\%26(\d{9,10})\%3a/\&\&\&$1\%3a/g;
@@ -511,7 +513,7 @@
if (! defined($action) || $action eq '') {
$action = 'VIEW';
}
- if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE)$/) {
+ if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE|PUTSTORE)$/) {
$warningflag .= 'action';
print $error_fh 'full log entry:'.$log.$/;
print $error_fh 'error on chunk (saving)'.$/;
More information about the LON-CAPA-cvs
mailing list