--- loncom/homework/grades.pm 2003/09/22 20:48:21 1.142
+++ loncom/homework/grades.pm 2003/11/07 19:10:51 1.150
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.142 2003/09/22 20:48:21 albertel Exp $
+# $Id: grades.pm,v 1.150 2003/11/07 19:10:51 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -55,17 +55,35 @@ my %perm=();
# ----- These first few routines are general use routines.----
#
-# --- Retrieve the parts that matches stores_\d+ from the metadata file.---
+# --- Retrieve the parts from the metadata file.---
sub getpartlist {
- my ($url) = @_;
- my @parts =();
- my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
- foreach my $key (@metakeys) {
- if ( $key =~ m/stores_(\w+)_.*/) {
- push(@parts,$key);
+ my ($url,$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 @stores;
+ foreach my $part (@parts) {
+ my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
+ foreach my $key (@metakeys) {
+ if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
}
}
- return @parts;
+ return @stores;
}
# --- Get the symbolic name of a problem and the url
@@ -115,20 +133,25 @@ sub response_type {
$symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq '');
my $allkeys = &Apache::lonnet::metadata($url,'keys');
my %seen = ();
- my (@partlist,%handgrade);
+ my (@partlist,%handgrade,%responseType);
foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
- if (/^\w+response_\w+.*/) {
+ if (/^\w+response_.*/) {
my ($responsetype,$part) = split(/_/,$_,2);
my ($partid,$respid) = split(/_/,$part);
+ if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {
+ next;
+ }
$responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!!
my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb);
- $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no');
+ $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no');
+ if (!exists($responseType{$partid})) { $responseType{$partid}={}; }
+ $responseType{$partid}->{$respid}=$responsetype;
next if ($seen{$partid} > 0);
$seen{$partid}++;
push @partlist,$partid;
}
}
- return \@partlist,\%handgrade;
+ return \@partlist,\%handgrade,\%responseType;
}
#--- Show resource title
@@ -137,42 +160,104 @@ sub showResourceInfo {
my ($url,$probTitle) = @_;
my $result ='
'.
'
Current Resource: '.$probTitle.'
'."\n";
- my ($partlist,$handgrade) = &response_type($url);
+ my ($partlist,$handgrade,$responseType) = &response_type($url);
my %resptype = ();
my $hdgrade='no';
- for (sort keys(%$handgrade)) {
- my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});
- my $partID = (split(/_/))[0];
- $resptype{$partID} = $responsetype;
+ for my $part_resID (sort keys(%$handgrade)) {
+ my $handgrade=$$handgrade{$part_resID};
+ my ($partID,$resID) = split(/_/,$part_resID);
+ my $responsetype = $responseType->{$partID}->{$resID};
$hdgrade = $handgrade if ($handgrade eq 'yes');
- $result.='
Part '.$partID.'
'.
+ $result.='
Part '.$partID.' '.
+ $resID.'
'.
'
Type: '.$responsetype.'
';
# '
Handgrade: '.$handgrade.'
';
}
$result.='
'."\n";
- return $result,\%resptype,$hdgrade,$partlist,$handgrade;
+ return $result,$responseType,$hdgrade,$partlist,$handgrade;
}
+
+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"});
+}
#--- Clean response type for display
-#--- Currently filters option response type only.
+#--- Currently filters option/rank/radiobutton/match/essay response types only.
sub cleanRecord {
- my ($answer,$response,$symb) = @_;
- if ($response eq 'option') {
- my (@IDs,@ans);
- foreach (split(/\&/,&Apache::lonnet::unescape($answer))) {
- my ($optionID,$ans) = split(/=/);
- push @IDs,$optionID.'';
- push @ans,$ans;
+ my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_;
+ my $grayFont = '';
+ if ($response =~ /^(option|rank)$/) {
+ my %answer=&Apache::lonnet::str2hash($answer);
+ my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
+ my ($toprow,$bottomrow);
+ foreach my $foil (@$order) {
+ if ($grading{$foil} == 1) {
+ $toprow.='
'.$answer{$foil}.'
';
+ } else {
+ $toprow.='
'.$answer{$foil}.'
';
+ }
+ $bottomrow.='
'.$grayFont.$foil.'
';
}
- my $grayFont = '';
return '
'.
- '
Answer
'.
- (join '
',@ans).'
'.
- '
'.$grayFont.'Option ID
'.$grayFont.
- (join '
'.$grayFont,@IDs).'
'.
- '
';
- }
- if ($response eq 'essay') {
+ '
Answer
'.$toprow.'
'.
+ '
'.$grayFont.'Option ID
'.
+ $grayFont.$bottomrow.'
'.'';
+ } elsif ($response eq 'match') {
+ my %answer=&Apache::lonnet::str2hash($answer);
+ my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
+ my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"});
+ my ($toprow,$middlerow,$bottomrow);
+ foreach my $foil (@$order) {
+ my $item=shift(@items);
+ if ($grading{$foil} == 1) {
+ $toprow.='
'.$item.'
';
+ $middlerow.='
'.$grayFont.$answer{$foil}.'
';
+ } else {
+ $toprow.='
'.$item.'
';
+ $middlerow.='
'.$grayFont.$answer{$foil}.'
';
+ }
+ $bottomrow.='
'.$grayFont.$foil.'
';
+ }
+ return '
'.
+ '
Answer
'.$toprow.'
'.
+ '
'.$grayFont.'Item ID
'.
+ $middlerow.'
'.
+ '
'.$grayFont.'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];
+ if (exists($answer{$foil})) {
+ if ($i == $correct) {
+ $toprow.='
true
';
+ } else {
+ $toprow.='
true
';
+ }
+ } else {
+ $toprow.='
false
';
+ }
+ $bottomrow.='
'.$grayFont.$foil.'
';
+ }
+ return '
'.
+ '
Answer
'.$toprow.'
'.
+ '
'.$grayFont.'Option ID
'.
+ $grayFont.$bottomrow.'
'.'
';
+ } elsif ($response eq 'essay') {
if (! exists ($ENV{'form.'.$symb})) {
my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
@@ -185,7 +270,7 @@ sub cleanRecord {
$ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
$ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob.
}
- return '
'.&keywords_highlight($answer).'
';
+ return '
'.&keywords_highlight($answer).'
';
}
return $answer;
}
@@ -507,9 +592,12 @@ LISTJAVASCRIPT
my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : '';
my $checklastsub = $checkhdgrade eq '' ? 'checked' : '';
my $gradeTable='||g;
$rendered=~s|name="submit"|name="would_have_been_submit"|g;
}
- my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
- $ENV{'request.course.id'});
+ my $companswer;
+ if ($mode eq 'both' or $mode eq 'answer') {
+ $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
+ $ENV{'request.course.id'});
+ }
if ($removeform) {
$companswer=~s|||g;
- $rendered=~s|name="submit"|name="would_have_been_submit"|g;
+ $companswer=~s|name="submit"|name="would_have_been_submit"|g;
}
my $result.='
';
$result.='
';
- $result.='
View of the problem - '.$ENV{'form.fullname'}.
- '
';
return $result;
@@ -1265,8 +1376,16 @@ sub submission {
# option to display problem, only once else it cause problems
# with the form later since the problem has a form.
- if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) {
- $request->print(&show_problem($request,$symb,$uname,$udom,0,1));
+ if ($ENV{'form.vProb'} eq 'yes' or $ENV{'form.vAns'} eq 'yes') {
+ my $mode;
+ if ($ENV{'form.vProb'} eq 'yes' && $ENV{'form.vAns'} eq 'yes') {
+ $mode='both';
+ } elsif ($ENV{'form.vProb'} eq 'yes') {
+ $mode='text';
+ } elsif ($ENV{'form.vAns'} eq 'yes') {
+ $mode='answer';
+ }
+ $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));
}
# kwclr is the only variable that is guaranteed to be non blank
@@ -1301,6 +1420,7 @@ sub submission {
''."\n".
''."\n".
''."\n".
+ ''."\n".
''."\n".
''."\n".
''."\n".
@@ -1351,13 +1471,22 @@ KEYWORDS
}
}
- if ($ENV{'form.vProb'} eq 'all') {
+ if ($ENV{'form.vProb'} eq 'all' or $ENV{'form.vAns'} eq 'all') {
$request->print('
';
@@ -1431,25 +1562,29 @@ KEYWORDS
# (3) Last submission plus the parts info
# (4) The whole record for this student
if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) {
- if ($ENV{'form.'.$uname.':'.$udom.':submitted_by'}) {
- my $submitby=''.
- 'Collaborative submission by: '.
- ''.
- $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.'';
- $request->print($submitby);
- } else {
- my ($string,$timestamp)= &get_last_submission (\%record);
+ my ($string,$timestamp)= &get_last_submission(\%record);
my $lastsubonly=''.
($$timestamp eq '' ? '' : 'Date Submitted: '.
$$timestamp)."
\n";
if ($$timestamp eq '') {
$lastsubonly.='
'.$$string[0];
} else {
+ my %seenparts;
for my $part (sort keys(%$handgrade)) {
- my ($responsetype,$foo) = split(/:/,$$handgrade{$part});
my ($partid,$respid) = split(/_/,$part);
+ if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) {
+ if (exists($seenparts{$partid})) { next; }
+ $seenparts{$partid}=1;
+ my $submitby='Part '.$partid.
+ ' Collaborative submission by: '.
+ ''.
+ $$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.' ';
+ $request->print($submitby);
+ next;
+ }
+ my $responsetype = $responseType->{$partid}->{$respid};
if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) {
$lastsubonly.='
Part '.
$partid.' ( ID '.$respid.
@@ -1457,7 +1592,7 @@ KEYWORDS
'Nothing submitted - no attempts
';
} else {
foreach (@$string) {
- my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/;
+ my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/;
if ($part eq ($partid.'_'.$respid)) {
my ($ressub,$subval) = split(/:/,$_,2);
# Similarity check
@@ -1477,6 +1612,7 @@ KEYWORDS
&keywords_highlight($oessay).'';
}
}
+ my $order=&get_order($partid,$respid,$symb,$uname,$udom);
$lastsubonly.='
Part '.
$partid.' ( ID '.$respid.
' ) '.
@@ -1487,11 +1623,11 @@ KEYWORDS
'Like all files provided by users, '.
'this file may contain virusses ':'').
'Submitted Answer: '.
- &cleanRecord($subval,$responsetype,$symb).
+ &cleanRecord($subval,$responsetype,$symb,$partid,$respid,\%record,$order).
'