--- loncom/homework/grades.pm 2001/07/26 15:50:25 1.9 +++ loncom/homework/grades.pm 2002/07/01 21:20:29 1.34 @@ -1,6 +1,37 @@ +# The LearningOnline Network with CAPA # The LON-CAPA Grading handler +# +# $Id: grades.pm,v 1.34 2002/07/01 21:20:29 ng Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# # 2/9,2/13 Guy Albertelli # 6/8 Gerd Kortemeyer +# 7/26 H.K. Ng +# 8/20 Gerd Kortemeyer +# Year 2002 +# June 2002 H.K. Ng +# package Apache::grades; use strict; @@ -16,16 +47,152 @@ sub moreinfo { $request->print("Unable to process request: $reason"); if ( $Apache::grades::viewgrades eq 'F' ) { $request->print('
'."\n"); - $request->print(''."\n"); - $request->print(''."\n"); - $request->print("Student:".''."
\n"); - $request->print("Domain:".''."
\n"); - $request->print(''."
\n"); + if ($ENV{'form.url'}) { + $request->print(''."\n"); + } + if ($ENV{'form.symb'}) { + $request->print(''."\n"); + } + $request->print(''."\n"); + $request->print("Student:".''."
\n"); + $request->print("Domain:".''."
\n"); + $request->print(''."
\n"); $request->print('
'); } return ''; } +sub verifyreceipt { + my $request=shift; + my $courseid=$ENV{'request.course.id'}; +# my $cdom=$ENV{"course.$courseid.domain"}; +# my $cnum=$ENV{"course.$courseid.num"}; + my $receipt=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. + $ENV{'form.receipt'}; + $receipt=~s/[^\-\d]//g; + my $symb=$ENV{'form.symb'}; + unless ($symb) { + $symb=&Apache::lonnet::symbread($ENV{'form.url'}); + } + if ((&Apache::lonnet::allowed('mgr',$courseid)) && ($symb)) { + $request->print('

Verifying Submission Receipt '.$receipt.'

'); + my $matches=0; + my ($classlist) = &getclasslist('all','0'); + foreach my $student ( sort(@{ $$classlist{'all'} }) ) { + my ($uname,$udom)=split(/\:/,$student); + if ($receipt eq + &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { + $request->print('Matching '.$student.'
'); + $matches++; + } + } + $request->printf('

'.$matches." match%s

",$matches <= 1 ? '' : 'es'); +# needs to print who is matched + } + return ''; +} + +sub student_gradeStatus { + my ($url,$udom,$uname) = @_; + my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); + my %record= &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + foreach my $part (&getpartlist($url)) { + my ($temp,$part,$type)=split(/_/,$part); + if ($type eq 'solved') { + my ($status,$foo)=split(/_/,$record{"resource.$part.$type"},2); + $status = 'partial' if ($foo =~ /^partially/); + $status = 'nothing' if ($status eq ''); + return $type,$status; + } + } + return ''; +} + +sub get_fullname { + my ($sname,$sdom) = @_; + my %name=&Apache::lonnet::get('environment', ['lastname','generation', + 'firstname','middlename'], + $sdom,$sname); + 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'}; + } + return $fullname; +} + +sub listStudents { + my ($request) = shift; + my $cdom =$ENV{"course.$ENV{'request.course.id'}.domain"}; + my $cnum =$ENV{"course.$ENV{'request.course.id'}.num"}; + my $getsec =$ENV{'form.section'}; + my $submitonly=$ENV{'form.submitonly'}; + + $request->print(< View Submissions for a Student or a Group of StudentsResource: $ENV{'form.url'}

+
 View Options
View Problem: no + yes +   Submissions: last + all + + +
+ + + + +ENDTABLEST + if ($ENV{'form.url'}) { + $request->print(''."\n"); + } + if ($ENV{'form.symb'}) { + $request->print(''."\n"); + } + $request->print(''."\n"); + + my ($classlist) = &getclasslist($getsec,'0'); + foreach my $student ( sort(@{ $$classlist{$getsec} }) ) { + my ($sname,$sdom) = split(/:/,$student); + my ($type,$status) = &student_gradeStatus($ENV{'form.url'},$cdom,$sname); + next if ($status eq 'nothing' && $submitonly eq 'yes'); + + my $fullname = &get_fullname($sname,$sdom); + if ( $Apache::grades::viewgrades eq 'F' ) { + $request->print("\n".''. + ''."\n". + ''."\n". + ''."\n". + ''."\n"); + $request->print(''."\n"); + + $request->print(''); + } + } + $request->print('
 Select  Username  Fullname  Domain  Grade Status 
 '.$sname.'  '.$fullname.'  '.$sdom.'  '.$status.' 
'); + $request->print(''); +} + +sub processGroup { + my ($request) = shift; + my $ctr = 0; + my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} + : ($ENV{'form.stuinfo'}) ); + my $total = scalar(@stuchecked)-1; + foreach my $student (@stuchecked) { + my ($sname,$sdom,$fullname) = split(/:/,$student); + $ENV{'form.student'} = $sname; + $ENV{'form.fullname'} = $fullname; + &submission($request,$ctr,$total); + $ctr++; + } + + return 'The End'; +} #FIXME - needs to handle multiple matches sub finduser { @@ -34,11 +201,10 @@ sub finduser { if ( $Apache::grades::viewgrades eq 'F' ) { #get classlist - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - my $chome=$ENV{"course.$ENV{'request.course.id'}.home"}; - #print "Found $cdom:$cnum:$chome
"; - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { +# my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); + #print "Found $cdom:$cnum
"; + my ($classlist) = &getclasslist('all','0'); + foreach my $student ( sort(@{ $$classlist{'all'} }) ) { my ($posname,$posdomain) = split(/:/,$student); if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } } @@ -49,21 +215,27 @@ sub finduser { } sub getclasslist { - my ($coursedomain,$coursenum,$coursehome,$hideexpired) = @_; - my $classlist=&Apache::lonnet::reply("dump:$coursedomain:$coursenum:classlist",$coursehome); - my %classlist=(); + my ($getsec,$hideexpired) = @_; + my ($coursedomain,$coursenum) = split(/_/,$ENV{'request.course.id'}); + my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum); my $now = time; - foreach my $record (split /&/, $classlist) { - my ($name,$value)=split(/=/,&Apache::lonnet::unescape($record)); - my ($end,$start)=split(/:/,$value); + my (@holdsec,@sections); + foreach my $student (keys(%classlist)) { + my ($end,$start)=split(/:/,$classlist{$student}); # still a student? if (($hideexpired) && ($end) && ($end < $now)) { - print "Skipping:$name:$end:$now
\n"; next; } - push( @{ $classlist{'allids'} }, $name); + my ($unam,$udom) = split(/:/,$student,2); + my $section = &Apache::lonnet::usection($udom,$unam,$ENV{'request.course.id'}); + push @holdsec,$section; + push (@{ $classlist{$getsec} }, $student) if ($getsec eq 'all' or $getsec == $section); + } + my %seen = (); + foreach my $item (@holdsec) { + push (@sections, $item) unless $seen{$item}++; } - return (%classlist); + return (\%classlist,\@sections); } sub getpartlist { @@ -71,7 +243,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_([0-9]+)_.*/) { push(@parts,$key); } } @@ -81,58 +253,49 @@ sub getpartlist { sub viewstudentgrade { my ($url,$symb,$courseid,$student,@parts) = @_; my $result =''; + my $cellclr = '"#ffffdd"'; + my ($username,$domain) = split(/:/,$student); - my ($stuname,$domain) = split(/:/,$student); - - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname); + my $fullname = &get_fullname($username,$domain); + my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); - $result.="$stuname$domain\n"; + $result.="$username$fullname$domain\n"; foreach my $part (@parts) { my ($temp,$part,$type)=split(/_/,$part); - #print "resource.$part.$type = ".$record{"resource.$part.$type"}."
\n"; - if ($type eq 'awarded') { - my $score=$record{"resource.$part.$type"}; - $result.="\n"; - } elsif ($type eq 'tries') { - my $score=$record{"resource.$part.$type"}; - $result.="\n" + my $score=$record{"resource.$part.$type"}; + if ($type eq 'awarded' || $type eq 'tries') { + $result.=''."\n"; } elsif ($type eq 'solved') { - my $score=$record{"resource.$part.$type"}; - $result.="\n"; + my $optsel = ''. + ''."\n"; + $status = 'nothing' if ($status eq ''); + $optsel =~ s/