--- loncom/homework/grades.pm 2003/03/27 21:26:07 1.78
+++ loncom/homework/grades.pm 2003/06/20 21:28:18 1.104
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.78 2003/03/27 21:26:07 albertel Exp $
+# $Id: grades.pm,v 1.104 2003/06/20 21:28:18 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -46,6 +46,10 @@ use Apache::lonhomework;
use Apache::loncoursedata;
use Apache::lonmsg qw(:user_normal_msg);
use Apache::Constants qw(:common);
+use String::Similarity;
+
+my %oldessays=();
+my %perm=();
# ----- These first few routines are general use routines.----
#
@@ -132,53 +136,60 @@ sub getclasslist {
}
}
$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
@@ -221,6 +232,50 @@ sub jscriptNform {
}
#------------------ End of general use routines --------------------
+
+#
+# Find most similar essay
+#
+
+sub most_similar {
+ my ($uname,$udom,$uessay)=@_;
+
+# ignore spaces and punctuation
+
+ $uessay=~s/\W+/ /gs;
+
+# these will be returned. Do not care if not at least 50 percent similar
+ my $limit=0.6;
+ my $sname='';
+ my $sdom='';
+ my $scrsid='';
+ my $sessay='';
+# go through all essays ...
+ foreach my $tkey (keys %oldessays) {
+ my ($tname,$tdom,$tcrsid)=split(/\./,$tkey);
+# ... except the same student
+ if (($tname ne $uname) || ($tdom ne $udom)) {
+ my $tessay=$oldessays{$tkey};
+ $tessay=~s/\W+/ /gs;
+# String similarity gives up if not even limit
+ my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
+# Found one
+ if ($tsimilar>$limit) {
+ $limit=$tsimilar;
+ $sname=$tname;
+ $sdom=$tdom;
+ $scrsid=$tcrsid;
+ $sessay=$oldessays{$tkey};
+ }
+ }
+ }
+ if ($limit>0.6) {
+ return ($sname,$sdom,$scrsid,$sessay,$limit);
+ } else {
+ return ('','','','',0);
+ }
+}
+
#-------------------------------------------------------------------
#------------------------------------ Receipt Verification Routines
@@ -343,8 +398,8 @@ LISTJAVASCRIPT
my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked';
my $gradeTable=''."\n");
$request->print(&show_grading_menu_form($symb,$url))
if (($ENV{'form.command'} eq 'submission') ||
@@ -1226,10 +1322,13 @@ KEYWORDS
my $lastone = pop @col_fullnames;
$msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.';
}
+ $msgfor =~ s/\'/\\'/g; #' stupid emacs
$result.='
'."\n".
' '.
- 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').''.
+ '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);
@@ -1348,7 +1447,11 @@ sub processHandGrade {
$ctr++;
next;
}
-
+ if ($errorflag eq 'not_allowed') {
+ $request->print("Not allowed to modify grades for $uname:$udom");
+ $ctr++;
+ next;
+ }
my $includemsg = $ENV{'form.includemsg'.$ctr};
my ($subject,$message,$msgstatus) = ('','','');
if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
@@ -1357,21 +1460,27 @@ sub processHandGrade {
foreach (@msgnum) {
$message.=$ENV{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne '');
}
- $message =~ s/<([^>]|\n)*>//g; # removes html codes Or should this be lonnet::escape ??
+ $message =&Apache::lonfeedback::clear_out_html($message);
$message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt;
- $message.=" for $ENV{'form.probTitle'}";
+ $message.=" for $ENV{'form.probTitle'}";
$msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom,
$ENV{'form.msgsub'},$message);
}
if ($ENV{'form.collaborator'.$ctr}) {
my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr});
foreach (@collaborators) {
- &saveHandGrade($request,$url,$symb,$_,$udom,$ctr,
- $ENV{'form.unamedom'.$ctr});
- if ($message ne '') {
- $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom,
- $ENV{'form.msgsub'},
- $message);
+ my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$url,$symb,$_,$udom,$ctr,$ENV{'form.unamedom'.$ctr});
+ if ($errorflag eq 'not_allowed') {
+ $request->print("Not allowed to modify grades for $_:$udom");
+ next;
+ } else {
+ if ($message ne '') {
+ $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom,
+ $ENV{'form.msgsub'},
+ $message);
+ }
}
}
}
@@ -1420,12 +1529,20 @@ sub processHandGrade {
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
# Called by Save & Refresh from Highlight Attribute Window
+ my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0');
if ($ENV{'form.refresh'} eq 'on') {
- my $ctr = 0;
- $ENV{'form.NTSTU'}=$ngrade;
+ my ($ctr,$total) = (0,0);
while ($ctr < $ngrade) {
- ($ENV{'form.student'},$ENV{'form.userdom'}) = split(/:/,$ENV{'form.unamedom'.$ctr});
- &submission($request,$ctr,$ngrade-1);
+ $total++ if $ENV{'form.unamedom'.$ctr} ne '';
+ $ctr++;
+ }
+ $ENV{'form.NTSTU'}=$ngrade;
+ $ctr = 0;
+ while ($ctr < $total) {
+ my $processUser = $ENV{'form.unamedom'.$ctr};
+ ($ENV{'form.student'},$ENV{'form.userdom'}) = split(/:/,$processUser);
+ $ENV{'form.fullname'} = $$fullname{$processUser};
+ &submission($request,$ctr,$total-1);
$ctr++;
}
return '';
@@ -1441,7 +1558,6 @@ sub processHandGrade {
$laststu = $firststu if ($ctr > $ngrade);
}
- my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0');
my (@parsedlist,@nextlist);
my ($nextflg) = 0;
foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
@@ -1497,6 +1613,9 @@ sub processHandGrade {
#---- Save the score and award for each student, if changed
sub saveHandGrade {
my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_;
+ my $usec = &Apache::lonnet::getsection($domain,$stuname,
+ $ENV{'request.course.id'});
+ if (!&canmodify($usec)) { return('not_allowed'); }
my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname);
my %newrecord = ();
my ($pts,$wgt) = ('','');
@@ -1826,7 +1945,8 @@ sub viewgrades {
my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'1');
my $ctr = 0;
foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
- my ($uname,$udom) = split(/:/);
+ my $uname = $_;
+ $uname=~s/:/_/;
$result.=''."\n";
$result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},
$_,$$fullname{$_},\@parts,\%weight);
@@ -1836,6 +1956,10 @@ sub viewgrades {
$result.=''."\n";
$result.=''."\n";
+ if (scalar(%$fullname) eq 0) {
+ my $colspan=3+scalar(@parts);
+ $result='There are no students in section "'.$ENV{'form.section'}.'" with enrollment status "'.$ENV{'form.status'}.'" to modify or grade.';
+ }
$result.=&show_grading_menu_form($symb,$url);
return $result;
}
@@ -1844,6 +1968,7 @@ sub viewgrades {
sub viewstudentgrade {
my ($url,$symb,$courseid,$student,$fullname,$parts,$weight) = @_;
my ($uname,$udom) = split(/:/,$student);
+ $student=~s/:/_/;
my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
my $result='
'."\n";
}
}
@@ -1898,7 +2023,7 @@ sub editgrades {
$title.='Section: '.$ENV{'form.section'}.''."\n";
my $result= '
'."\n";
$result.= '
'.
- '
Username
Fullname
'."\n";
+ '
Username
Domain
Fullname
'."\n";
my %scoreptr = (
'correct' =>'correct_by_override',
@@ -1946,16 +2071,19 @@ sub editgrades {
$result .= '
';
$result .= $header;
$result .= '
'."\n";
-
+ my $noupdate;
for ($i=0; $i<$ENV{'form.total'}; $i++) {
+ my $line;
my $user = $ENV{'form.ctr'.$i};
+ my $usercolon = $user;
+ $usercolon =~s/_/:/;
+ my ($uname,$udom)=split(/_/,$user);
my %newrecord;
my $updateflag = 0;
- my @userdom = grep /^$user:/,keys %$classlist;
- my (undef,$udom) = split(/:/,$userdom[0]);
- $result .= '
'.$user.'
'.
- $$fullname{$userdom[0]}.'
';
+ $line .= '
'.$uname.'
'.
+ $udom.'
'.
+ $$fullname{$usercolon}.'
';
foreach (@partid) {
my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'};
my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
@@ -1975,7 +2103,7 @@ sub editgrades {
}
$score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_solved'} eq 'excused') &&
($score ne 'excused'));
- $result .= '
'."\n".
&show_grading_menu_form ($symb,$url);
my $msg = 'Number of records updated = '.$rec_update.
@@ -2187,6 +2321,48 @@ sub csvuploadmap_footer {
ENDPICK
}
+sub upcsvScores_form {
+ my ($request) = shift;
+ my ($symb,$url)=&get_symb_and_url($request);
+ if (!$symb) {return '';}
+ my $result =<
+ function checkUpload(formname) {
+ if (formname.upfile.value == "") {
+ alert("Please use the browse button to select a file from your local directory.");
+ return false;
+ }
+ formname.submit();
+ }
+
+CSVFORMJS
+ $ENV{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
+ $result.='
'."\n";
+ $result.='
'."\n";
+ $result.=' Specify a file containing the class scores for problem - '.$ENV{'form.probTitle'}.
+ '.
'."\n";
+ $result.=&show_grading_menu_form($symb,$url);
+
+ return $result;
+}
+
+
sub csvuploadmap {
my ($request)= @_;
my ($symb,$url)=&get_symb_and_url($request);
@@ -2246,7 +2422,7 @@ sub csvuploadassign {
}
$request->print('
Assigning Grades
');
my $courseid=$ENV{'request.course.id'};
- my ($classlist) = &getclasslist('all','1');
+ my ($classlist) = &getclasslist('all',0);
my @skipped;
my $countdone=0;
foreach my $grade (@gradedata) {
@@ -2278,7 +2454,6 @@ sub csvuploadassign {
$request->print(' Skipped Students ');
foreach my $student (@skipped) { $request->print(" $student"); }
}
- $request->print(&view_edit_entire_class_form($symb,$url));
$request->print(&show_grading_menu_form($symb,$url));
return '';
}
@@ -2343,7 +2518,7 @@ LISTJAVASCRIPT
my $result='
'.
'Manual Grading by Page or Sequence
';
- $result.='
'." \n";
+ $result.='
'."\n";
$result.=' Problems from:
';
- my ($depth,$ctr,$question) = (1,0,1);
+ my ($depth,$question) = (1,1);
$iterator->next(); # skip the first BEGIN_MAP
my $curRes = $iterator->next(); # for "current resource"
- while ($depth > 0 && $ctr < 100) { # ctr, just in case it never gets out of loop
+ while ($depth > 0) {
if($curRes == $iterator->BEGIN_MAP) { $depth++; }
- if($curRes == $iterator->END_MAP) { $depth++; }
+ if($curRes == $iterator->END_MAP) { $depth--; }
if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) {
my $parts = $curRes->parts();
- $parts = &temp_parts_fix($parts); # remove line when lonnavmap is fixed
my $title = $curRes->compTitle();
my $symbx = $curRes->symb();
$studentTable.='
'.$question.
@@ -2542,8 +2719,8 @@ sub displayPage {
} else {
my $companswer = &Apache::loncommon::get_student_answers(
$symbx,$uname,$udom,$ENV{'request.course.id'});
- $companswer=~s|
'."\n";
$request->print($result);
- my $navmap = Apache::lonnavmaps::navmap-> new($request,
- $ENV{'request.course.fn'}.'.db',
+ my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',
$ENV{'request.course.fn'}.'_parms.db',1, 1);
my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'});
my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
@@ -2668,14 +2841,13 @@ sub updateGradeByPage {
$iterator->next(); # skip the first BEGIN_MAP
my $curRes = $iterator->next(); # for "current resource"
- my ($depth,$ctr,$question,$changeflag)= (1,0,1,0);
- while ($depth > 0 && $ctr < 100) { # ctr, just in case it never gets out of loop
+ my ($depth,$question,$changeflag)= (1,1,0);
+ while ($depth > 0) {
if($curRes == $iterator->BEGIN_MAP) { $depth++; }
- if($curRes == $iterator->END_MAP) { $depth++; }
+ if($curRes == $iterator->END_MAP) { $depth--; }
if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) {
my $parts = $curRes->parts();
- $parts = &temp_parts_fix($parts); # remove line when lonnavmap is fixed
my $title = $curRes->compTitle();
my $symbx = $curRes->symb();
$studentTable.='