--- loncom/homework/grades.pm 2003/06/12 19:56:13 1.94
+++ loncom/homework/grades.pm 2003/08/18 18:24:32 1.134
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.94 2003/06/12 19:56:13 bowersj2 Exp $
+# $Id: grades.pm,v 1.134 2003/08/18 18:24:32 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,6 +33,7 @@
# June-August H.K. Ng
# Year 2003
# February, March H.K. Ng
+# July, H. K. Ng
#
package Apache::grades;
@@ -41,6 +42,7 @@ use Apache::style;
use Apache::lonxml;
use Apache::lonnet;
use Apache::loncommon;
+use Apache::lonhtmlcommon;
use Apache::lonnavmaps;
use Apache::lonhomework;
use Apache::loncoursedata;
@@ -49,6 +51,7 @@ use Apache::Constants qw(:common);
use String::Similarity;
my %oldessays=();
+my %perm=();
# ----- These first few routines are general use routines.----
#
@@ -93,10 +96,23 @@ sub get_fullname {
return $fullname;
}
+#--- Format fullname, username:domain if different for display
+#--- Use anywhere where the student names are listed
+sub nameUserString {
+ my ($type,$fullname,$uname,$udom) = @_;
+ if ($type eq 'header') {
+ return ' Fullname (Username) ';
+ } else {
+ 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) = shift;
+ 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);
@@ -104,7 +120,9 @@ sub response_type {
if (/^\w+response_\w+.*/) {
my ($responsetype,$part) = split(/_/,$_,2);
my ($partid,$respid) = split(/_/,$part);
- $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no');
+ $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;
@@ -113,10 +131,105 @@ sub response_type {
return \@partlist,\%handgrade;
}
+#--- 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 %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.'
';
+# '
Handgrade: '.$handgrade.'
';
+ }
+ $result.='
'."\n";
+ return $result,\%resptype,$hdgrade,$partlist,$handgrade;
+}
+
+#--- Clean response type for display
+#--- Currently filters option response type 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 $grayFont = '';
+ return '
'.
+ '
Answer
'.
+ (join '
',@ans).'
'.
+ '
'.$grayFont.'Option ID
'.$grayFont.
+ (join '
'.$grayFont,@IDs).'
'.
+ '
';
+ }
+ if ($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'});
+
+ 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.
+ }
+ return '
'.&keywords_highlight($answer).'
';
+ }
+ return $answer;
+}
+
+#-- A couple of common js functions
+sub commonJSfunctions {
+ my $request = shift;
+ $request->print(<
+ function radioSelection(radioButton) {
+ var selection=null;
+ if (radioButton.length > 1) {
+ for (var i=0; i 1) {
+ for (var i=0; i
+COMMONJSFUNCTIONS
+}
+
#--- Dumps the class list with usernames,list of sections,
#--- section, ids and fullnames for each user.
sub getclasslist {
my ($getsec,$filterlist) = @_;
+ $getsec = $getsec eq '' ? 'all' : $getsec;
my $classlist=&Apache::loncoursedata::get_classlist();
# Bail out if we were unable to get the classlist
return if (! defined($classlist));
@@ -128,60 +241,67 @@ sub getclasslist {
my (undef,undef,$end,$start,$id,$section,$fullname,$status)=
@{$classlist->{$_}};
# filter students according to status selected
- if ($filterlist && $ENV{'form.status'} ne 'Any') {
- if ($ENV{'form.status'} ne $status) {
+ if ($filterlist && $ENV{'form.Status'} ne 'Any') {
+ if ($ENV{'form.Status'} ne $status) {
delete ($classlist->{$_});
next;
}
}
$section = ($section ne '' ? $section : 'no');
- if ($getsec eq 'all' || $getsec eq $section) {
- $sections{$section}++;
- $fullnames{$_}=$fullname;
- } else {
- delete($classlist->{$_});
- }
+ if (&canview($section)) {
+ if ($getsec eq 'all' || $getsec eq $section) {
+ $sections{$section}++;
+ $fullnames{$_}=$fullname;
+ } else {
+ delete($classlist->{$_});
+ }
+ } else {
+ delete($classlist->{$_});
+ }
}
my %seen = ();
my @sections = sort(keys(%sections));
return ($classlist,\@sections,\%fullnames);
}
-#find user domain
-sub finduser {
- my ($name) = @_;
- my $domain = '';
- if ( $Apache::grades::viewgrades eq 'F' ) {
- my %classlist=&Apache::lonnet::dump('classlist',
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
- my (@fields) = grep /^$name:/, keys %classlist;
- ($name, $domain) = split(/:/,$fields[0]);
- return ($name,$domain);
- } else {
- return ($ENV{'user.name'},$ENV{'user.domain'});
+sub canmodify {
+ my ($sec)=@_;
+ if ($perm{'mgr'}) {
+ if (!defined($perm{'mgr_section'})) {
+ # can modify whole class
+ return 1;
+ } else {
+ if ($sec eq $perm{'mgr_section'}) {
+ #can modify the requested section
+ return 1;
+ } else {
+ # can't modify the request section
+ return 0;
+ }
+ }
}
+ #can't modify
+ return 0;
}
-#--- Prompts a user to enter a username.
-sub moreinfo {
- my ($request,$reason) = @_;
- $request->print("Unable to process request: $reason");
- if ( $Apache::grades::viewgrades eq 'F' ) {
- $request->print('');
+sub canview {
+ my ($sec)=@_;
+ if ($perm{'vgr'}) {
+ if (!defined($perm{'vgr_section'})) {
+ # can modify whole class
+ return 1;
+ } else {
+ if ($sec eq $perm{'vgr_section'}) {
+ #can modify the requested section
+ return 1;
+ } else {
+ # can't modify the request section
+ return 0;
+ }
+ }
}
- return '';
+ #can't modify
+ return 0;
}
#--- Retrieve the grade status of a student for all the parts
@@ -190,7 +310,7 @@ sub student_gradeStatus {
my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
my %partstatus = ();
foreach (@$partlist) {
- my ($status,$foo) = split(/_/,$record{"resource.$_.solved"},2);
+ my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2);
$status = 'nothing' if ($status eq '');
$partstatus{$_} = $status;
my $subkey = "resource.$_.submitted_by";
@@ -216,6 +336,7 @@ sub jscriptNform {
''."\n".
''."\n".
''."\n".
+ ''."\n".
''."\n".
''."\n".
''."\n".
@@ -288,7 +409,7 @@ sub verifyreceipt {
my $title.='
'."\n".
- ' '.
- 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').' '.
- ''."\n".
- ' (Message will be sent when you click on Save & Next below.)'."\n"
- if ($ENV{'form.handgrade'} eq 'yes');
- $request->print($result);
+ # essay grading message center
+ if ($ENV{'form.handgrade'} eq 'yes') {
+ my ($lastname,$givenn) = split(/,/,$ENV{'form.fullname'});
+ my $msgfor = $givenn.' '.$lastname;
+ if (scalar(@col_fullnames) > 0) {
+ my $lastone = pop @col_fullnames;
+ $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.';
+ }
+ $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript
+ $result=''."\n".
+ ''."\n";
+ $result.=' '.
+ 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').' '.
+ ''."\n".
+ ' (Message will be sent when you click on Save & Next below.)'."\n"
+ if ($ENV{'form.handgrade'} eq 'yes');
+ $request->print($result);
+ }
my %seen = ();
my @partlist;
+ my @gradePartRespid;
for (sort keys(%$handgrade)) {
my ($partid,$respid) = split(/_/);
next if ($seen{$partid} > 0);
$seen{$partid}++;
- next if ($$handgrade{$_} =~ /:no$/);
+ next if ($$handgrade{$_} =~ /:no$/ && $ENV{'form.lastSub'} =~ /^(hdgrade)$/);
push @partlist,$partid;
+ push @gradePartRespid,$partid.'.'.$respid;
$request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
}
$result=''."\n";
+ $result.=''."\n" if ($counter == 0);
my $ctr = 0;
while ($ctr < scalar(@partlist)) {
$result.='
'.
- ''."\n";
- if ($ENV{'form.handgrade'} eq 'yes') {
- $endform.=' '."\n";
- my $ntstu =''."\n";
- my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1');
- $ntstu =~ s/
.
- '/mailbkgrd.gif){kind=small}
'."\n".
- '.
+ '/mailbkgrd.gif){kind=small}
'."\n".
+ '