--- loncom/homework/grades.pm 2002/10/04 06:22:12 1.54 +++ loncom/homework/grades.pm 2002/12/02 17:28:51 1.63 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.54 2002/10/04 06:22:12 albertel Exp $ +# $Id: grades.pm,v 1.63 2002/12/02 17:28:51 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); @@ -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; } @@ -107,62 +111,32 @@ sub response_type { #--- 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'}); - my ($tmp) = keys(%classlist); + my $classlist=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist - return if ($tmp =~ /^(con_lost|error|no_such_host)/i); - - # 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{$_}); + 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 @@ -263,8 +237,8 @@ sub verifyreceipt { 'Resource: '.$ENV{'form.url'}.'

'."\n"; my ($string,$contents,$matches) = ('','',0); - my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist('all','0'); - + 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 @@ -365,8 +339,9 @@ LISTJAVASCRIPT my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked'; my $gradeTable='
'."\n". - ' View Problem: no '."\n". - ' yes
'."\n". + ' View Problem: no '."\n". + ' one student '."\n". + ' all students
'."\n". ' Submissions: '."\n"; if ($ENV{'form.handgrade'} eq 'yes') { $gradeTable.=' handgrade only'."\n"; @@ -377,8 +352,8 @@ LISTJAVASCRIPT ''."\n". ''."\n". ''."\n". - '
'."\n". - '
'."\n". + '
'."\n". + '
'."\n". ''."\n". ''."\n". 'To '.lc($viewgrade).' a submission, click on the check box next to the student\'s name. Then '."\n". @@ -389,7 +364,7 @@ LISTJAVASCRIPT 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 'value="'.$viewgrade.'" />'."\n"; - my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($getsec,'0'); + my (undef,undef,$fullname) = &getclasslist($getsec,'0'); $gradeTable.=''."\n"; $result.= ''."\n"; $ctsparts++; @@ -1678,7 +1699,7 @@ sub viewgrades { #get info for each student #list all the students - with points and grade status - my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0'); + my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); my $ctr = 0; foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { my ($uname,$udom) = split(/:/); @@ -1704,8 +1725,8 @@ sub viewstudentgrade { ''.$fullname.''. ''."\n"; - foreach my $part (@$parts) { - my ($part,$type) = &split_part_type($part); + foreach my $apart (@$parts) { + my ($part,$type) = &split_part_type($apart); my $score=$record{"resource.$part.$type"}; if ($type eq 'awarded') { my $pts = $score eq '' ? '' : $score*$$weight{$part}; @@ -1763,7 +1784,7 @@ sub editgrades { 'ungraded' =>'ungraded_attempted', 'nothing' => '', ); - my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0'); + my ($classlist,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); my (@partid); my %weight = (); @@ -2181,7 +2202,7 @@ 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.='
'. ''. @@ -697,21 +672,21 @@ sub sub_page_js { pWin.document.write(""); pWin.document.write(""); pWin.document.write(""); - pWin.document.write(""); + pWin.document.write(""); } function displaySavedMsg(ctr,msg,shwsel) { pWin.document.write(""); pWin.document.write(""); pWin.document.write(""); - pWin.document.write(""); + pWin.document.write(""); } function newMsg(newmsg,shwsel) { pWin.document.write(""); pWin.document.write(""); pWin.document.write(""); - pWin.document.write(""); + pWin.document.write(""); } function msgTail() { @@ -821,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.='
Subject
"+ctr+"
New
'; + $result.='
'; + $result.=' View of the problem - '.$ENV{'form.fullname'}. + '
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + $result.='
'; + $result.='

'; + $request->print($result); +} + # --------------------------- show submissions of a student, option to grade sub submission { my ($request,$counter,$total) = @_; @@ -835,8 +836,7 @@ 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) { @@ -847,18 +847,7 @@ sub submission { # 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 - '.$ENV{'form.fullname'}. - '
'.$rendered.'
'; - $result.='Correct answer:
'.$companswer; - $result.='
'; - $result.='

'; - $request->print($result); + &show_problem($request,$symb,$uname,$udom,0); } # kwclr is the only variable that is guaranteed to be non blank @@ -921,6 +910,11 @@ 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); @@ -937,49 +931,61 @@ KEYWORDS # If this is handgraded, then check for collaborators 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; - } - push @col_list, $collaborator; - my ($lastname,$givenn) = split(/,/,$$fullname{$collaborator.':'.$udom}); - push @col_fullnames, $givenn.' '.$lastname; - $result.=$$fullname{$collaborator.':'.$udom}.'     '; - } - $result.='
'."\n"; - $result.='
'. - 'This student has submitted '. - (scalar (@badcollaborators) > 1 ? '' : 'an'). - ' invalid collaborator'.(scalar (@badcollaborators) > 1 ? 's. ' : '. '). - (join ', ',@badcollaborators).'
' - if (scalar(@badcollaborators) > 0); - - $result.='
'. - 'This student has submitted too many collaborators. Maximum is '. - $ncol.'.
' if (scalar(@collaborators) > $ncol); - $result.=''."\n"; - } - } - } + '.maxcollaborators', + $symb,$udom,$uname); + next if ($ncol <= 0); + s/\_/\./g; + next if ($record{'resource.'.$_.'.collaborators'} eq ''); + my (@collaborators) = split(/,?\s+/, + $record{'resource.'.$_.'.collaborators'}); + my (@badcollaborators); + if (scalar(@collaborators) != 0) { + $result.='Collaborators: '; + foreach my $collaborator (@collaborators) { + my ($co_name,$co_dom) = split /\@|:/,$collaborator; + $co_dom = $udom if (! defined($co_dom)); + next if ($co_name eq $uname && $co_dom eq $udom); + # Doing this grep allows 'fuzzy' specification + my @Matches = grep /^$co_name:$co_dom/i, + keys %$classlist; + if (! scalar(@Matches)) { + push @badcollaborators,$collaborator; + next; + } + push @col_list, @Matches; + foreach (@Matches) { + my ($lastname,$givenn) = split(/,/,$$fullname{$_}); + push @col_fullnames, $givenn.' '.$lastname; + $result.=$$fullname{$_}.'     '; + } + } + $result.='
'."\n"; + if (scalar(@badcollaborators) > 0) { + $result.='
'; + $result.='This student has submitted '; + if (scalar(@badcollaborators) == 1) { + $result .= 'an invalid collaborator'; + } else { + $result .= 'invalid collaborators'; + } + $result .= ': '.join(', ',@badcollaborators); + + } + if (scalar(@collaborators > $ncol)) { + $result .= '
'; + $result .= 'This student has sumbitted too many '. + 'collaborators. Maximum is '.$ncol; + $result .= '
'; + } + $result.=''."\n"; + } } } $request->print($result."\n"); @@ -1103,9 +1109,15 @@ 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.='
'."\n"; $request->print($result); @@ -1161,9 +1173,9 @@ sub get_last_submission { for ($version=1;$version<=$returnhash{'version'};$version++) { foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { $lasthash{$_}=$returnhash{$version.':'.$_}; - if ($returnhash{$version.':'.$_} =~ /(SUBMITTED|DRAFT)$/) { +# if ($returnhash{$version.':'.$_} =~ /(SUBMITTED|DRAFT)$/) { $timestamp = scalar(localtime($returnhash{$version.':timestamp'})); - } +# } } } foreach ((keys %lasthash)) { @@ -1187,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; } @@ -1209,7 +1226,7 @@ sub processHandGrade { 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) { @@ -1297,7 +1314,7 @@ 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 {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { @@ -1359,8 +1376,12 @@ 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.'_'.$_} : @@ -1636,7 +1657,7 @@ sub viewgrades { $weight{$partid}.' (problem weight)
'.$uname.''.$udom.'
'."\n"; $result.=''."\n";
'."\n"; $result.=' Grade Entire Section or Class