--- loncom/homework/grades.pm 2002/08/02 21:10:03 1.44
+++ loncom/homework/grades.pm 2002/11/27 16:39:37 1.62
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.44 2002/08/02 21:10:03 ng Exp $
+# $Id: grades.pm,v 1.62 2002/11/27 16:39:37 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -40,6 +40,7 @@ use Apache::lonxml;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhomework;
+use Apache::loncoursedata;
use Apache::lonmsg qw(:user_normal_msg);
use Apache::Constants qw(:common);
@@ -51,7 +52,7 @@ sub getpartlist {
my @parts =();
my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
foreach my $key (@metakeys) {
- if ( $key =~ m/stores_([0-9]+)_.*/) {
+ if ( $key =~ m/stores_(\w+)_.*/) {
push(@parts,$key);
}
}
@@ -72,13 +73,16 @@ sub get_symb_and_url {
sub get_fullname {
my ($uname,$udom) = @_;
my %name=&Apache::lonnet::get('environment', ['lastname','generation',
- 'firstname','middlename'],$udom,$uname);
+ 'firstname','middlename'],
+ $udom,$uname);
my $fullname;
my ($tmp) = keys(%name);
if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- $fullname=$name{'lastname'}.$name{'generation'};
- if ($fullname =~ /[^\s]+/) { $fullname.=', '; }
- $fullname.=$name{'firstname'}.' '.$name{'middlename'};
+ $fullname = &Apache::loncoursedata::ProcessFullName
+ (@name{qw/lastname generation firstname middlename/});
+ } else {
+ &Apache::lonnet::logthis('grades.pm: no name data for '.$uname.
+ '@'.$udom.':'.$tmp);
}
return $fullname;
}
@@ -91,7 +95,7 @@ sub response_type {
my %seen = ();
my (@partlist,%handgrade);
foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
- if (/^\w+response_\d+.*/) {
+ if (/^\w+response_\w+.*/) {
my ($responsetype,$part) = split(/_/,$_,2);
my ($partid,$respid) = split(/_/,$part);
$handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no');
@@ -103,73 +107,36 @@ sub response_type {
return \@partlist,\%handgrade;
}
-#--- Prints a message on screen if a user did something wrong
-#--- Operator error ---
-sub userError {
- my ($request, $reason, $step) = @_;
- $request->print('
LON-CAPA User Error
'."\n");
- $request->print('Reason: '.$reason.'
'."\n");
- $request->print('Step: '.($step ne '' ? $step : 'Use your browser back button to correct')
- .'
'."\n");
- return '';
-}
-
#--- Dumps the class list with usernames,list of sections,
#--- section, ids and fullnames for each user.
sub getclasslist {
my ($getsec,$hideexpired) = @_;
- my $now = time;
- my %classlist=&Apache::lonnet::dump('classlist',
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
- # codes to check for fields in the classlist
- # should contain end:start:id:section:fullname
- for (keys %classlist) {
- my (@fields) = split(/:/,$classlist{$_});
- %classlist = &reformat_classlist(\%classlist) if (scalar(@fields) <= 2);
- last;
- }
-
- my (@holdsec,@sections,%allids,%stusec,%fullname);
- foreach (keys(%classlist)) {
- my ($end,$start,$id,$section,$fullname)=split(/:/,$classlist{$_});
+ 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->{$_}};
# still a student?
- if (($hideexpired) && ($end) && ($end < $now)) {
- next;
- }
+ if (($hideexpired) && ($status ne 'Active')) {
+ delete ($classlist->{$_});
+ next;
+ }
$section = ($section ne '' ? $section : 'no');
- push @holdsec,$section;
if ($getsec eq 'all' || $getsec eq $section) {
- push (@{ $classlist{$getsec} }, $_);
- $allids{$_} =$id;
- $stusec{$_} =$section;
- $fullname{$_}=$fullname;
- }
+ $sections{$section}++;
+ $fullnames{$_}=$fullname;
+ } else {
+ delete($classlist->{$_});
+ }
}
my %seen = ();
- foreach my $item (@holdsec) {
- push (@sections, $item) unless $seen{$item}++;
- }
- return (\%classlist,\@sections,\%allids,\%stusec,\%fullname);
-}
-
-# add id, section and fullname to the classlist.db
-# done to maintain backward compatibility with older versions
-sub reformat_classlist {
- my ($classlist) = shift;
- foreach (sort keys(%$classlist)) {
- my ($unam,$udom) = split(/:/);
- my $section = &Apache::lonnet::usection($udom,$unam,$ENV{'request.course.id'});
- my $fullname = &get_fullname ($unam,$udom);
- my %userid = &Apache::lonnet::idrget($udom,($unam));
- $$classlist{$_} = $$classlist{$_}.':'.$userid{$unam}.':'.$section.':'.$fullname;
- }
- my $putresult = &Apache::lonnet::put
- ('classlist',\%$classlist,
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
-
- return %$classlist;
+ my @sections = sort(keys(%sections));
+ return ($classlist,\@sections,\%fullnames);
}
#find user domain
@@ -224,11 +191,33 @@ sub student_gradeStatus {
return %partstatus;
}
+# hidden form and javascript that calls the form
+# Use by verifyscript and viewgrades
+# Shows a student's view of problem and submission
+sub jscriptNform {
+ my ($url,$symb) = @_;
+ my $jscript=''."\n";
+ $jscript.= ''."\n";
+ return $jscript;
+}
#------------------ End of general use routines --------------------
#-------------------------------------------------------------------
#------------------------------------ Receipt Verification Routines
+#
#--- Check whether a receipt number is valid.---
sub verifyreceipt {
my $request = shift;
@@ -243,29 +232,14 @@ sub verifyreceipt {
$symb = &Apache::lonnet::symbread($url);
}
- my $jscript=''."\n";
- $jscript.= ''."\n";
-
- my $title.='
Verifying Submission Receipt '.
- $receipt.'
'."\n".
+ my $title.='
Verifying Submission Receipt '.
+ $receipt.'
'."\n".
'Resource: '.$ENV{'form.url'}.'
'."\n";
my ($string,$contents,$matches) = ('','',0);
- my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist('all','0');
-
- foreach (sort {$$fullname{$a} cmp $$fullname{$b} } keys %$fullname) {
+ my (undef,undef,$fullname) = &getclasslist('all','0');
+
+ foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
my ($uname,$udom)=split(/\:/);
if ($receipt eq
&Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) {
@@ -281,7 +255,7 @@ sub verifyreceipt {
if ($matches == 0) {
$string = $title.'No match found for the above receipt.';
} else {
- $string = $jscript.$title.
+ $string = &jscriptNform($url,$symb).$title.
'The above receipt matches the following student'.
($matches <= 1 ? '.' : 's.')."\n".
'
'."\n".
@@ -292,7 +266,7 @@ sub verifyreceipt {
$contents.
'
'."\n";
}
- return $string.&show_grading_menu_form ($symb,$url);
+ return $string.&show_grading_menu_form($symb,$url);
}
#--- This is called by a number of programs.
@@ -301,17 +275,15 @@ sub verifyreceipt {
# on the problem page.
sub listStudents {
my ($request) = shift;
+
+ my ($symb,$url) = &get_symb_and_url();
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 $submitonly= $ENV{'form.submitonly'} eq '' ? 'all' : $ENV{'form.submitonly'};
- my $result='
'.
- 'View Submissions for a Student or a Group of Students
';
- $result.='
';
- $result.='
'.
- 'Resource: '.$ENV{'form.url'}.'
';
- my ($partlist,$handgrade) = &response_type($ENV{'form.url'});
+ my $result;
+ my ($partlist,$handgrade) = &response_type($url);
for (sort keys(%$handgrade)) {
my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});
$ENV{'form.handgrade'} = 'yes' if ($handgrade eq 'yes');
@@ -320,62 +292,109 @@ sub listStudents {
'
Handgrade: '.$handgrade.'
';
}
$result.='
';
- $request->print($result);
- $request->print(<
- View Problem: no
- yes
- Submissions:
- handgrade only
- last sub only
- last sub & parts info
- all details
-
-
-
-
-
-
-ENDTABLEST
- if ($ENV{'form.url'}) {
- $request->print(''."\n");
+ my $viewgrade;
+ if ($ENV{'form.handgrade'} eq 'yes') {
+ $viewgrade = 'View/Grade';
+ } else {
+ $viewgrade = 'View';
}
- if ($ENV{'form.symb'}) {
- $request->print(''."\n");
+
+ $result='
'.
+ $viewgrade.
+ ' Submissions for a Student or a Group of Students
'.
+ '
'.
+ 'Resource: '.$url.'
'.$result;
+
+ $request->print(<
+ function checkSelect(checkBox) {
+ var ctr=0;
+ var sense="";
+ if (checkBox.length > 1) {
+ for (var i=0; iprint(''."\n");
+ document.gradesub.submit();
+ }
+
+LISTJAVASCRIPT
+
+ $request->print($result);
+
+ my $checkhdgrade = $ENV{'form.handgrade'} eq 'yes' ? 'checked' : '';
+ my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked';
- my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($getsec,'0');
+ my $gradeTable='
'.
+ ''."\n";
+ if ($ctr == 0) {
+ $gradeTable=' '.
+ 'No submission found for this resource. ';
+ } elsif ($ctr == 1) {
+ $gradeTable =~ s/type=checkbox/type=checkbox checked/;
+ }
+ $gradeTable.=&show_grading_menu_form($symb,$url);
+ $request->print($gradeTable);
return '';
}
@@ -402,10 +431,7 @@ sub processGroup {
my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}}
: ($ENV{'form.stuinfo'}));
my $total = scalar(@stuchecked)-1;
- if ($stuchecked[0] eq '') {
- &userError($request,'No student was selected for viewing/grading.');
- return;
- }
+
foreach (@stuchecked) {
my ($uname,$udom,$fullname) = split(/:/);
$ENV{'form.student'} = $uname;
@@ -489,6 +515,30 @@ sub sub_page_js {
return;
}
+//=================== Check that a point is assigned for all the parts ==============
+ function checksubmit(val,total,parttot) {
+ document.SCORE.gradeOpt.value = val;
+ if (val == "Save & Next") {
+ for (i=0;i<=total;i++) {
+ for (j=0;j");
pWin.document.write("
Subject
");
pWin.document.write("
");
- pWin.document.write("
");
+ pWin.document.write("
");
}
function displaySavedMsg(ctr,msg,shwsel) {
pWin.document.write("
");
pWin.document.write("
"+ctr+"
");
pWin.document.write("
");
- pWin.document.write("
");
+ pWin.document.write("
");
}
function newMsg(newmsg,shwsel) {
pWin.document.write("
");
pWin.document.write("
New
");
pWin.document.write("
");
- pWin.document.write("
");
+ pWin.document.write("
");
}
function msgTail() {
@@ -746,6 +796,32 @@ SUBJAVASCRIPT
}
+sub show_problem {
+ my ($request,$symb,$uname,$udom,$removeform) = @_;
+ my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
+ $ENV{'request.course.id'});
+ if ($removeform) {
+ $rendered=~s|||g;
+ $rendered=~s|||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'});
+ if ($removeform) {
+ $companswer=~s|||g;
+ $companswer=~s|||g;
+ $rendered=~s|name="submit"|name="would_have_been_submit"|g;
+ }
+ my $result.='
';
+ $result.='
';
+ $result.=' View of the problem - '.$ENV{'form.fullname'}.
+ '
';
+ $request->print($result);
+}
+
# --------------------------- show submissions of a student, option to grade
sub submission {
my ($request,$counter,$total) = @_;
@@ -760,30 +836,18 @@ sub submission {
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 ''; }
my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');
- $ENV{'form.vProb'} = $ENV{'form.vProb'} ne '' ? $ENV{'form.vProb'} : 'yes';
- my ($classlist,$seclist,$ids,$stusec,$fullname);
+# $ENV{'form.vProb'} = $ENV{'form.vProb'} ne '' ? $ENV{'form.vProb'} : 'yes';
# header info
if ($counter == 0) {
&sub_page_js($request);
- $request->print('
Submission Record
'.
- ' Resource: '.$url.'');
+ $request->print('
Submission Record
'."\n".
+ ' Resource: '.$url.''."\n");
# 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') {
- my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
- $ENV{'request.course.id'});
- my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
- $ENV{'request.course.id'});
- my $result.='
';
- $result.='
';
- $result.=' View of the problem for '.$ENV{'form.fullname'}.
- '
';
- $request->print($result);
+ &show_problem($request,$symb,$uname,$udom,0);
}
# kwclr is the only variable that is guaranteed to be non blank
@@ -846,63 +910,82 @@ KEYWORDS
}
}
+ if ($ENV{'form.vProb'} eq 'all') {
+ $request->print('
');
+ &show_problem($request,$symb,$uname,$udom,1);
+ }
+
my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
my ($partlist,$handgrade) = &response_type($url);
# Display student info
$request->print(($counter == 0 ? '' : ' '));
- my $result='
'.
- '
';
+ my $result='
'."\n".
+ '
'."\n";
-# $result.='
Fullname: '.$ENV{'form.fullname'}.
$result.='Fullname: '.$ENV{'form.fullname'}.
' Username: '.$uname.''.
- ' Domain: '.$udom.' ';
+ ' Domain: '.$udom.' '."\n";
+ $result.=''."\n";
# If this is handgraded, then check for collaborators
- my $col_flag = 0;
+ my @col_fullnames;
+ my ($classlist,$fullname);
if ($ENV{'form.handgrade'} eq 'yes') {
my @col_list;
- ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist('all','0');
+ ($classlist,undef,$fullname) = &getclasslist('all','0');
for (keys (%$handgrade)) {
my $ncol = &Apache::lonnet::EXT('resource.'.$_.
- '.maxcollaborators',$symb,$udom,$uname);
- if ($ncol > 0) {
- s/\_/\./g;
- if ($record{'resource.'.$_.'.collaborators'} ne '') {
- my (@collaborators) = split(/,?\s+/,
- $record{'resource.'.$_.'.collaborators'});
- my (@badcollaborators);
- if (scalar(@collaborators) != 0) {
- $result.='Collaborators: ';
- foreach my $collaborator (@collaborators) {
- $collaborator = $collaborator =~ /\@|:/ ?
- (split(/@|:/,$collaborator))[0] : $collaborator;
- next if ($collaborator eq $uname);
- if (!grep /^$collaborator:/i,keys %$classlist) {
- push @badcollaborators,$collaborator;
- next;
- }
- $col_flag++;
- push @col_list, $collaborator;
- $result.=$$fullname{$collaborator.':'.$udom}.' ';
- }
- $result.=' '."\n";
- $result.='
'."\n";
$request->print($lastsubonly);
}
} else {
@@ -959,17 +1042,25 @@ KEYWORDS
# return if view submission with no grading option
if ($ENV{'form.showgrading'} eq '') {
- $request->print('
');
+ $request->print('
'."\n");
return;
}
# Grading options
$result=''."\n".
''."\n".
- ''."\n";
- $result.=' '.
- 'Compose Message to student'.($col_flag > 1 ? 's' : '').''.
+ ''."\n";
+ 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.'.';
+ }
+ $result.='
'."\n".
+ ' '.
+ 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').''.
' (Message will be sent when you click on Save & Next below.)'."\n"
if ($ENV{'form.handgrade'} eq 'yes');
$request->print($result);
@@ -1018,30 +1109,55 @@ KEYWORDS
'onChange="javascript:clearRadBox(this.form.RADVAL'.$counter.'_'.$partid.
',this.form.GD_BOX'.$counter.'_'.$partid.
',this.form.GD_SEL'.$counter.'_'.$partid.
- ',this.form.stores'.$counter.'_'.$partid.')" />'."\n".
- ''.
- ''." \n";
+ ',this.form.stores'.$counter.'_'.$partid.')" >'."\n";
+ if ($record{'resource.'.$partid.'.solved'} eq 'excused') {
+ $result.=''.
+ '';
+ } else {
+ $result.=''.
+ '';
+ }
+ $result.=" \n";
$result.='';
- $result.='
';
+ $result.='
'."\n";
$request->print($result);
}
- $request->print(''."\n");
- $request->print(''."\n");
+ $result=''."\n";
+ my $ctr = 0;
+ while ($ctr < scalar(@partlist)) {
+ $result.=''."\n";
+ $ctr++;
+ }
+ $request->print($result.''."\n");
# print end of form
if ($counter == $total) {
- my $endform.='
';
- my $ntstu =''."\n";
- my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1');
- $ntstu =~ s/
';
+ my $endform='
'.
+ ''."\n";
+ if ($ENV{'form.handgrade'} eq 'yes') {
+ $endform.=' '."\n";
+ my $ntstu =''."\n";
+ my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1');
+ $ntstu =~ s/
';
+ $endform.=&show_grading_menu_form($symb,$url);
$request->print($endform);
}
return '';
@@ -1049,31 +1165,30 @@ KEYWORDS
#--- Retrieve the last submission for all the parts
sub get_last_submission {
- my ($symb,$username,$domain,$course)=@_;
- if ($symb) {
- my (@string,$timestamp);
- my (%returnhash)=&Apache::lonnet::restore($symb,$course,$domain,$username);
- if ($returnhash{'version'}) {
- my %lasthash=();
- my ($version);
- for ($version=1;$version<=$returnhash{'version'};$version++) {
- foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
- $lasthash{$_}=$returnhash{$version.':'.$_};
- }
- }
- foreach ((keys %lasthash)) {
- if ($_ =~ /\.submission$/) {
- my ($partid,$foo) = split(/submission$/,$_);
- my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?
- 'Draft Copy ' : '';
- push @string, (join(':',$_,$draft.$lasthash{$_}));
- }
- if ($_ =~ /timestamp/) {$timestamp = scalar(localtime($lasthash{$_}))};
+ my (%returnhash)=@_;
+ my (@string,$timestamp);
+ if ($returnhash{'version'}) {
+ my %lasthash=();
+ my ($version);
+ for ($version=1;$version<=$returnhash{'version'};$version++) {
+ foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
+ $lasthash{$_}=$returnhash{$version.':'.$_};
+# if ($returnhash{$version.':'.$_} =~ /(SUBMITTED|DRAFT)$/) {
+ $timestamp = scalar(localtime($returnhash{$version.':timestamp'}));
+# }
+ }
+ }
+ foreach ((keys %lasthash)) {
+ if ($_ =~ /\.submission$/) {
+ my ($partid,$foo) = split(/submission$/,$_);
+ my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?
+ 'Draft Copy ' : '';
+ push @string, (join(':',$_,$draft.$lasthash{$_}));
}
}
- @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string;
- return \@string,\$timestamp;
}
+ @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string;
+ return \@string,\$timestamp;
}
#--- High light keywords, with style choosen by user.
@@ -1084,8 +1199,13 @@ sub keywords_highlight {
(my $styleoff = $styleon) =~ s/\$styleon$_$styleoff\<\/font\>/gi;
+ $string =~ s/\b\Q$_\E(\b|\.)/\$styleon$_$styleoff\<\/font\>/gi;
}
+ # This is not really the right place to do this, but I cannot find a
+ # better one at this time. So here we go - the m in the s:::mg causes
+ # ^ to match the beginning of a new line. So we replace(???) the beginning
+ # of the line with to make things formatted a little better.
+ $string =~ s:^: :mg;
return $string;
}
@@ -1102,12 +1222,11 @@ sub processHandGrade {
my $ctr = 0;
while ($ctr < $ngrade) {
my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr});
- my ($errorflg) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr);
- return '' if ($errorflg eq 'error');
+ my ($errorflag) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr);
my $includemsg = $ENV{'form.includemsg'.$ctr};
my ($subject,$message,$msgstatus) = ('','','');
- if ($includemsg =~ /savemsg|new$ctr/) {
+ if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
$subject = $ENV{'form.msgsub'} if ($includemsg =~ /^msgsub/);
my (@msgnum) = split(/,/,$includemsg);
foreach (@msgnum) {
@@ -1195,10 +1314,10 @@ sub processHandGrade {
$laststu = $firststu if ($ctr > $ngrade);
}
- my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0');
+ my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0');
my (@parsedlist,@nextlist);
my ($nextflg) = 0;
- foreach (sort {$$fullname{$a} cmp $$fullname{$b} } keys %$fullname) {
+ foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
if ($nextflg == 1 && $button =~ /Next$/) {
push @parsedlist,$_;
}
@@ -1257,17 +1376,16 @@ sub saveHandGrade {
my %newrecord;
foreach (split(/:/,$ENV{'form.partlist'.$newflg})) {
if ($ENV{'form.GD_SEL'.$newflg.'_'.$_} eq 'excused') {
- $newrecord{'resource.'.$_.'.solved'} = 'excused'
- if ($record{'resource.'.$_.'.solved'} ne 'excused');
+ if ($record{'resource.'.$_.'.solved'} ne 'excused') {
+ $newrecord{'resource.'.$_.'.solved'} = 'excused';
+ if (exists($record{'resource.'.$_.'.awarded'})) {
+ $newrecord{'resource.'.$_.'.awarded'} = '';
+ }
+ }
} else {
my $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ?
$ENV{'form.GD_BOX'.$newflg.'_'.$_} :
$ENV{'form.RADVAL'.$newflg.'_'.$_});
- if ($pts eq '') {
- &userError($request,'No point was assigned for part '.$_.
- ' and for username '.$stuname.'.');
- return 'error';
- }
my $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 :
$ENV{'form.WGT'.$newflg.'_'.$_};
my $partial= $pts/$wgt;
@@ -1304,13 +1422,7 @@ sub viewgrades_js {
$request->print(<
- function viewOneStudent(user,domain) {
- document.onestudent.student.value = user;
- document.onestudent.userdom.value = domain;
- document.onestudent.submit();
- }
-
- function writePoint(partid,weight,point) {
+ function writePoint(partid,weight,point) {
var radioButton = eval("document.classgrade.RADVAL_"+partid);
var textbox = eval("document.classgrade.TEXTVAL_"+partid);
if (point == "textval") {
@@ -1350,10 +1462,10 @@ sub viewgrades_js {
for (i=0;i'."\n";
#view individual student submission form - called using Javascript viewOneStudent
- $result.= ''."\n";
+ $result.=&jscriptNform($url,$symb);
#beginning of class grading form
$result.= '';
+ $result.=''."\n";
$result.=&show_grading_menu_form($symb,$url);
return $result;
}
@@ -1601,30 +1726,36 @@ sub viewstudentgrade {
'\')"; TARGET=_self>'.$fullname.''.
'
'.$uname.'
'.$udom.'
'."\n";
foreach my $part (@$parts) {
- my ($temp,$part,$type)=split(/_/,$part);
+ my ($part,$type) = &split_part_type($part);
my $score=$record{"resource.$part.$type"};
- next if $type eq 'tries';
if ($type eq 'awarded') {
my $pts = $score eq '' ? '' : $score*$$weight{$part};
$result.=''."\n";
+ 'GD_'.$uname.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
$result.='
Part '.$partid.
+ ' (Weight = '.$weight{$partid}.')
';
+
+ }
+ $result .= '
';
+ $result .= $header;
$result .= '
'."\n";
for ($i=0; $i<$ENV{'form.total'}; $i++) {
@@ -1678,38 +1829,54 @@ sub editgrades {
my %newrecord;
my $updateflag = 0;
my @userdom = grep /^$user:/,keys %$classlist;
- my ($foo,$udom) = split(/:/,$userdom[0]);
+ my (undef,$udom) = split(/:/,$userdom[0]);
$result .= '
'.$user.'
'.
$$fullname{$userdom[0]}.'
';
-
foreach (@partid) {
- my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_aw_s'};
- my $old_part = $old_aw eq '' ? '' : $old_aw/$weight{$_};
- my $old_score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_sv_s'}};
-
- my $awarded = $ENV{'form.GD_'.$user.'_'.$_.'_aw'};
- my $partial = $awarded eq '' ? '' : $awarded/$weight{$_};
+ my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'};
+ my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
+ my $old_part = $old_aw eq '' ? '' : $old_part_pcr;
+ my $old_score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_solved_s'}};
+
+ my $awarded = $ENV{'form.GD_'.$user.'_'.$_.'_awarded'};
+ my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
+ my $partial = $awarded eq '' ? '' : $pcr;
my $score;
if ($partial eq '') {
- $score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_sv_s'}};
+ $score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_solved_s'}};
} elsif ($partial > 0) {
$score = 'correct_by_override';
} elsif ($partial == 0) {
$score = 'incorrect_by_override';
}
- $score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_sv'} eq 'excused') &&
+ $score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_solved'} eq 'excused') &&
($score ne 'excused'));
$result .= '
'.$old_aw.'
'.
'
'.$awarded.
($score eq 'excused' ? $score : '').'
';
- next if ($old_part eq $partial && $old_score eq $score);
-
- $updateflag = 1;
- $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne '';
- $newrecord{'resource.'.$_.'.solved'} = $score;
- $rec_update++;
+ if (!($old_part eq $partial && $old_score eq $score)) {
+ $updateflag = 1;
+ $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne '';
+ $newrecord{'resource.'.$_.'.solved'} = $score;
+ $rec_update++;
+ }
+
+ my $partid=$_;
+ foreach my $stores (@parts) {
+ my ($part,$type) = &split_part_type($stores);
+ if ($part !~ m/^\Q$partid\E/) { next;}
+ if ($type eq 'awarded' || $type eq 'solved') { next; }
+ my $old_aw = $ENV{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'};
+ my $awarded = $ENV{'form.GD_'.$user.'_'.$part.'_'.$type};
+ if ($awarded ne '' && $awarded ne $old_aw) {
+ $newrecord{'resource.'.$part.'.'.$type}= $awarded;
+ $updateflag=1;
+ }
+ $result .= '
'.$old_aw.'
'.
+ '
'.$awarded.'
';
+ }
}
$result .= '
'."\n";
if ($updateflag) {
@@ -1725,6 +1892,15 @@ sub editgrades {
'Total number of students = '.$ENV{'form.total'}.' ';
return $title.$msg.$result;
}
+
+sub split_part_type {
+ my ($partstr) = @_;
+ my ($temp,@allparts)=split(/_/,$partstr);
+ my $type=pop(@allparts);
+ my $part=join('.',@allparts);
+ return ($part,$type);
+}
+
#------------- end of section for handling grading by section/class ---------
#
#----------------------------------------------------------------------------
@@ -1810,16 +1986,30 @@ ENDPICK
sub csvuploadmap_header {
my ($request,$symb,$url,$datatoken,$distotal)= @_;
- my $result;
my $javascript;
if ($ENV{'form.upfile_associate'} eq 'reverse') {
$javascript=&csvupload_javascript_reverse_associate();
} else {
$javascript=&csvupload_javascript_forward_associate();
}
+
+ my $result='
';
+ $result.='
Resource: '.$url.'
';
+ my ($partlist,$handgrade) = &response_type($url);
+ my ($resptype,$hdgrade)=('','no');
+ for (sort keys(%$handgrade)) {
+ my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});
+ $resptype = $responsetype;
+ $hdgrade = $handgrade if ($handgrade eq 'yes');
+ $result.='
Part '.(split(/_/))[0].'
'.
+ '
Type: '.$responsetype.'
'.
+ '
Handgrade: '.$handgrade.'
';
+ }
+ $result.='
';
$request->print(<
-
Uploading Class Grades for resource $url
+
Uploading Class Grades
+$result
Identify fields
Total number of records found in file: $distotal
@@ -1887,6 +2077,7 @@ sub csvuploadmap {
my ($i,$keyfields);
if (@records) {
my @fields=&csvupload_fields($url);
+
if ($ENV{'form.upfile_associate'} eq 'reverse') {
&Apache::loncommon::csv_print_samples($request,\@records);
$i=&Apache::loncommon::csv_print_select_table($request,\@records,
@@ -1926,8 +2117,6 @@ sub csvuploadassign {
}
$request->print('
Assigning Grades
');
my $courseid=$ENV{'request.course.id'};
-# my $cdom=$ENV{"course.$courseid.domain"};
-# my $cnum=$ENV{"course.$courseid.num"};
my ($classlist) = &getclasslist('all','1');
my @skipped;
my $countdone=0;
@@ -1987,7 +2176,7 @@ sub gradingmenu {
my ($request) = @_;
my ($symb,$url)=&get_symb_and_url($request);
if (!$symb) {return '';}
- my $result='
Select a Grading Method
';
+ my $result='
Select a Grading Method
';
$result.='
';
$result.='
Resource: '.$url.'
';
my ($partlist,$handgrade) = &response_type($url);
@@ -2013,21 +2202,23 @@ sub gradingmenu {
#--- Menu for grading a section or the whole class ---
sub view_edit_entire_class_form {
my ($symb,$url)=@_;
- my ($classlist,$sections) = &getclasslist('all','0');
+ my ($classlist,$sections,undef) = &getclasslist('all','0');
my $result.='
'."\n";
return $result;
@@ -2037,7 +2228,17 @@ sub view_edit_entire_class_form {
sub upcsvScores_form {
my ($symb,$url) = @_;
if (!$symb) {return '';}
- my $result.='
'."\n";
+ my $result = ''."\n";
+
+ $result.='
'."\n";
$result.='
'."\n";
$result.=' Specify a file containing the class scores for above resource
'."\n";
$result.=''."\n";
+ if (ref($sections)) {
+ $result.=' (Section "no" implies the students were not assigned a section.) '
+ if (grep /no/,@$sections);
+ }
+
+
+ $result.=' '."\n";
$result.='
'."\n";
$result.='
'."\n";
return $result;
@@ -2093,17 +2308,27 @@ sub viewGradeaStu_form {
#--- Form to input a receipt number ---
sub verifyReceipt_form {
my ($symb,$url) = @_;
- my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"};
- my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"};
+ my $result = ''."\n";
+
my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'});
- my $result.='
'."\n";
+ $result.='
'."\n";
$result.='
'."\n";
$result.=' Verify a Submission Receipt Issued by this Server