--- loncom/homework/grades.pm 2003/09/27 01:59:10 1.130.2.1.2.4
+++ loncom/homework/grades.pm 2007/06/14 21:36:12 1.404
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.130.2.1.2.4 2003/09/27 01:59:10 albertel Exp $
+# $Id: grades.pm,v 1.404 2007/06/14 21:36:12 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,16 +25,6 @@
#
# http://www.lon-capa.org/
#
-# 2/9,2/13 Guy Albertelli
-# 6/8 Gerd Kortemeyer
-# 7/26 H.K. Ng
-# 8/20 Gerd Kortemeyer
-# Year 2002
-# June-August H.K. Ng
-# Year 2003
-# February, March H.K. Ng
-# July, H. K. Ng
-#
package Apache::grades;
use strict;
@@ -46,54 +36,65 @@ use Apache::lonhtmlcommon;
use Apache::lonnavmaps;
use Apache::lonhomework;
use Apache::loncoursedata;
-use Apache::lonmsg qw(:user_normal_msg);
+use Apache::lonmsg();
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=();
# ----- 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 ($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 @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
-sub get_symb_and_url {
- my ($request) = @_;
- (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
- my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));
- if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
- return ($symb,$url);
-}
-
-# --- Retrieve the fullname for a user. Return lastname, first middle ---
-# --- Generation is attached next to the lastname if it exists. ---
-sub get_fullname {
- my ($uname,$udom) = @_;
- my %name=&Apache::lonnet::get('environment', ['lastname','generation',
- 'firstname','middlename'],
- $udom,$uname);
- my $fullname;
- my ($tmp) = keys(%name);
- if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- $fullname = &Apache::loncoursedata::ProcessFullName
- (@name{qw/lastname generation firstname middlename/});
- } else {
- &Apache::lonnet::logthis('grades.pm: no name data for '.$uname.
- '@'.$udom.':'.$tmp);
+sub get_symb {
+ my ($request,$silent) = @_;
+ (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
+ my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
+ if ($symb eq '') {
+ if (!$silent) {
+ $request->print("Unable to handle ambiguous references:$url:.");
+ return ();
+ }
}
- return $fullname;
+ return ($symb);
}
#--- Format fullname, username:domain if different for display
@@ -101,91 +102,232 @@ sub get_fullname {
sub nameUserString {
my ($type,$fullname,$uname,$udom) = @_;
if ($type eq 'header') {
- return ' Fullname (Username) ';
+ return ' Fullname (Username)';
} else {
- return ' '.$fullname.' ('.$uname.
- ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')';
+ return ' '.$fullname.' ('.$uname.
+ ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')';
}
}
#--- Get the partlist and the response type for a given problem. ---
#--- Indicate if a response type is coded handgraded or not. ---
sub response_type {
- my ($url,$symb) = shift;
- $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);
- foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
- if (/^\w+response_\w+.*/) {
- my ($responsetype,$part) = split(/_/,$_,2);
- my ($partid,$respid) = split(/_/,$part);
- $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');
- next if ($seen{$partid} > 0);
- $seen{$partid}++;
- push @partlist,$partid;
- }
+ my ($symb) = shift;
+
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my $res = $navmap->getBySymb($symb);
+ my $partlist = $res->parts();
+ my %vPart =
+ map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart'));
+ my (%response_types,%handgrade);
+ foreach my $part (@{ $partlist }) {
+ next if (%vPart && !exists($vPart{$part}));
+
+ my @types = $res->responseType($part);
+ my @ids = $res->responseIds($part);
+ for (my $i=0; $i < scalar(@ids); $i++) {
+ $response_types{$part}{$ids[$i]} = $types[$i];
+ $handgrade{$part.'_'.$ids[$i]} =
+ &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i].
+ '.handgrade',$symb);
+ }
+ }
+ return ($partlist,\%handgrade,\%response_types);
+}
+
+sub flatten_responseType {
+ my ($responseType) = @_;
+ my @part_response_id =
+ map {
+ my $part = $_;
+ map {
+ [$part,$_]
+ } sort(keys(%{ $responseType->{$part} }));
+ } sort(keys(%$responseType));
+ return @part_response_id;
+}
+
+sub get_display_part {
+ my ($partID,$symb)=@_;
+ my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb);
+ if (defined($display) and $display ne '') {
+ $display.= " (id $partID)";
+ } else {
+ $display=$partID;
}
- return \@partlist,\%handgrade;
+ return $display;
}
#--- Show resource title
#--- and parts and response type
sub showResourceInfo {
- my ($url,$probTitle) = @_;
- my $result ='
'.
- '
Current Resource: '.$probTitle.'
'."\n";
- my ($partlist,$handgrade) = &response_type($url);
+ my ($symb,$probTitle,$checkboxes) = @_;
+ my $col=3;
+ if ($checkboxes) { $col=4; }
+ my $result = '
'.&mt('Current Resource').': '.$probTitle.'
'."\n";
+ $result .='
';
+ my ($partlist,$handgrade,$responseType) = &response_type($symb);
my %resptype = ();
my $hdgrade='no';
- for (sort keys(%$handgrade)) {
- my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});
- my $partID = (split(/_/))[0];
- $resptype{$partID} = $responsetype;
- $hdgrade = $handgrade if ($handgrade eq 'yes');
- $result.='
Part '.$partID.'
'.
- '
Type: '.$responsetype.'
';
+ my %partsseen;
+ foreach my $partID (sort keys(%$responseType)) {
+ foreach my $resID (sort keys(%{ $responseType->{$partID} })) {
+ my $handgrade=$$handgrade{$partID.'_'.$resID};
+ my $responsetype = $responseType->{$partID}->{$resID};
+ $hdgrade = $handgrade if ($handgrade eq 'yes');
+ $result.='
';
+ if ($checkboxes) {
+ if (exists($partsseen{$partID})) {
+ $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/Task
+# 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,
+ $uname,$udom) = @_;
+ 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') {
- if (! exists ($ENV{'form.'.$symb})) {
+ '
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'},
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
- my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'};
- $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : '';
- $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red';
- $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0';
- $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.
+ my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
+ $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : '';
+ $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red';
+ $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0';
+ $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.
+ }
+ $answer =~ s-\n- -g;
+ return '
';
+ my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/,
+ keys(%{$record}));
+ foreach my $grade (sort(@grade)) {
+ my ($dim) = ($grade =~/[.]([^.]+)[.]status$/);
+ $result.= '
'.&mt("Dimension: [_1], status [_2] ",
+ $dim, $record->{$grade}).
+ '
';
+ }
+ $result.='
';
+ return $result;
}
- return '
'.&keywords_highlight($answer).'
';
+
}
return $answer;
}
@@ -218,7 +360,8 @@ sub commonJSfunctions {
}
}
} else {
- if (selectOne.selected) return selectOne.value;
+ // only one value it must be the selected one
+ return selectOne.value;
}
}
@@ -229,34 +372,52 @@ COMMONJSFUNCTIONS
#--- section, ids and fullnames for each user.
sub getclasslist {
my ($getsec,$filterlist) = @_;
- $getsec = $getsec eq '' ? 'all' : $getsec;
+ my @getsec;
+ if (!ref($getsec)) {
+ if ($getsec ne '' && $getsec ne 'all') {
+ @getsec=($getsec);
+ }
+ } else {
+ @getsec=@{$getsec};
+ }
+ if (grep(/^all$/,@getsec)) { undef(@getsec); }
+
my $classlist=&Apache::loncoursedata::get_classlist();
# Bail out if we were unable to get the classlist
return if (! defined($classlist));
#
my %sections;
my %fullnames;
- foreach (keys(%$classlist)) {
- # the following undefs are for 'domain', and 'username' respectively.
- my (undef,undef,$end,$start,$id,$section,$fullname,$status)=
- @{$classlist->{$_}};
+ foreach my $student (keys(%$classlist)) {
+ my $end =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_END()];
+ my $start =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_START()];
+ my $id =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_ID()];
+ my $section =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
+ my $fullname =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()];
+ my $status =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()];
# filter students according to status selected
- if ($filterlist && $ENV{'form.Status'} ne 'Any') {
- if ($ENV{'form.Status'} ne $status) {
- delete ($classlist->{$_});
+ if ($filterlist && $env{'form.Status'} ne 'Any') {
+ if ($env{'form.Status'} ne $status) {
+ delete ($classlist->{$student});
next;
}
}
- $section = ($section ne '' ? $section : 'no');
+ $section = ($section ne '' ? $section : 'none');
if (&canview($section)) {
- if ($getsec eq 'all' || $getsec eq $section) {
+ if (!@getsec || grep(/^\Q$section\E$/,@getsec)) {
$sections{$section}++;
- $fullnames{$_}=$fullname;
+ $fullnames{$student}=$fullname;
} else {
- delete($classlist->{$_});
+ delete($classlist->{$student});
}
} else {
- delete($classlist->{$_});
+ delete($classlist->{$student});
}
}
my %seen = ();
@@ -306,8 +467,8 @@ sub canview {
#--- Retrieve the grade status of a student for all the parts
sub student_gradeStatus {
- my ($url,$symb,$udom,$uname,$partlist) = @_;
- my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
+ my ($symb,$udom,$uname,$partlist) = @_;
+ my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
my %partstatus = ();
foreach (@$partlist) {
my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2);
@@ -323,7 +484,7 @@ sub student_gradeStatus {
# Use by verifyscript and viewgrades
# Shows a student's view of problem and submission
sub jscriptNform {
- my ($url,$symb) = @_;
+ my ($symb) = @_;
my $jscript=''."\n";
$jscript.= ''."\n";
- $studentTable.=&show_grading_menu_form($symb,$url);
+ $studentTable.=&show_grading_menu_form($symb);
$request->print($studentTable);
return '';
@@ -2798,26 +3923,24 @@ LISTJAVASCRIPT
sub getSymbMap {
my ($request) = @_;
- my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',
- $ENV{'request.course.fn'}.'_parms.db');
-# $navmap->init();
+ my $navmap = Apache::lonnavmaps::navmap->new();
my %symbx = ();
my @titles = ();
my $minder = 0;
# Gather every sequence that has problems.
- my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 1);
+ my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); },
+ 1,0,1);
for my $sequence ($navmap->getById('0.0'), @sequences) {
if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {
- my $title = $minder.'.'.$sequence->compTitle();
- push @titles, $title; # minder in case two titles are identical
- $symbx{$title} = $sequence->symb();
+ my $title = $minder.'.'.
+ &HTML::Entities::encode($sequence->compTitle(),'"\'&');
+ push(@titles, $title); # minder in case two titles are identical
+ $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&');
$minder++;
}
}
-
- $navmap->untieHashes();
return \@titles,\%symbx;
}
@@ -2826,45 +3949,65 @@ sub getSymbMap {
sub displayPage {
my ($request) = shift;
- my ($symb,$url) = &get_symb_and_url($request);
- my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"};
- my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"};
- my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'};
- my $pageTitle = $ENV{'form.page'};
+ my ($symb) = &get_symb($request);
+ my $cdom = $env{"course.$env{'request.course.id'}.domain"};
+ my $cnum = $env{"course.$env{'request.course.id'}.num"};
+ my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
+ my $pageTitle = $env{'form.page'};
my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
- my ($uname,$udom) = split(/:/,$ENV{'form.student'});
- my $usec=$classlist->{$ENV{'form.student'}}[5];
+ my ($uname,$udom) = split(/:/,$env{'form.student'});
+ my $usec=$classlist->{$env{'form.student'}}[5];
+
+ #need to make sure we have the correct data for later EXT calls,
+ #thus invalidate the cache
+ &Apache::lonnet::devalidatecourseresdata(
+ $env{'course.'.$env{'request.course.id'}.'.num'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'});
+ &Apache::lonnet::clear_EXT_cache_status();
+
if (!&canview($usec)) {
- $request->print('Unable to view requested student.('.$ENV{'form.student'}.')');
- $request->print(&show_grading_menu_form($symb,$url));
+ $request->print('Unable to view requested student.('.$env{'form.student'}.')');
+ $request->print(&show_grading_menu_form($symb));
return;
}
- my $result='
'.$ENV{'form.title'}.'
';
- $result.='
Student: '.&nameUserString(undef,$$fullname{$ENV{'form.student'}},$uname,$udom).
+ my $result='