--- loncom/homework/grades.pm 2003/06/13 21:29:30 1.97
+++ loncom/homework/grades.pm 2003/07/23 17:33:59 1.123
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.97 2003/06/13 21:29:30 albertel Exp $
+# $Id: grades.pm,v 1.123 2003/07/23 17:33:59 ng Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -41,6 +41,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 +50,7 @@ use Apache::Constants qw(:common);
use String::Similarity;
my %oldessays=();
+my %perm=();
# ----- These first few routines are general use routines.----
#
@@ -104,6 +106,7 @@ sub response_type {
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!!
$handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no');
next if ($seen{$partid} > 0);
$seen{$partid}++;
@@ -113,10 +116,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 = (); #,$hdgrade)=('','no');
+ 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 +226,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
@@ -288,7 +393,7 @@ sub verifyreceipt {
my $title.='