--- loncom/homework/grades.pm 2001/05/01 17:30:18 1.7 +++ loncom/homework/grades.pm 2002/06/26 21:25:31 1.32 @@ -1,5 +1,37 @@ +# The LearningOnline Network with CAPA # The LON-CAPA Grading handler +# +# $Id: grades.pm,v 1.32 2002/06/26 21:25:31 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; @@ -15,16 +47,156 @@ 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($cdom,$cnum,'0'); + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + 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'); + } + return ''; +} + +sub receiptInput { + my ($request) = shift; + my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"}; + my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"}; + my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}); + $request->print(<Verify a Submission Receipt Issued by this Server +
+$hostver- + + +ENDHEADER + if ($ENV{'form.url'}) { + $request->print( + ''); + } + if ($ENV{'form.symb'}) { + $request->print( + ''); + } +# $request->print(<print(''); + 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 = 'nothing' if ($status eq ''); + return $type,$status; + } + } + return ''; +} + +sub listStudents { + my ($request) = shift; + my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"}; + my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"}; + + $request->print(<Show Student Submissions on Assessment + +
+ + + + + +ENDTABLEST + my (%classlist) = &getclasslist($cdom,$cnum,'0'); + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + my ($sname,$sdom) = split(/:/,$student); + + 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'}; + } + if ( $Apache::grades::viewgrades eq 'F' ) { + $request->print("\n".''."". + ''); + if ($ENV{'form.url'}) { + $request->print( + ''); + } + if ($ENV{'form.symb'}) { + $request->print( + ''); + } + $request->print( + ''); + $request->print( + ''); + $request->print( + ''); + $request->print( + ''); + $request->print(''); + $request->print(''); + my ($type,$status) = &student_gradeStatus($ENV{'form.url'},$cdom,$sname); + $request->print( + ''); + $request->print( + ''); +# $request->print(''); + } + } + $request->print('
Resource: $ENV{'form.url'}
UsernameNameDomainView ProblemSubmissionsGrade StatusAction
$sname$fullname$sdom
'. + ' no '. + ' yes '. + ' last '. + ' all '.$status.' '); + $request->print('
'); +} + #FIXME - needs to handle multiple matches sub finduser { @@ -34,9 +206,8 @@ 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'); + #print "Found $cdom:$cnum
"; + my (%classlist) = &getclasslist($cdom,$cnum,'0'); foreach my $student ( sort(@{ $classlist{'allids'} }) ) { my ($posname,$posdomain) = split(/:/,$student); if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } @@ -48,19 +219,18 @@ sub finduser { } sub getclasslist { - my ($coursedomain,$coursenum,$coursehome,$hideexpired) = @_; - my $classlist=&Apache::lonnet::reply("dump:$coursedomain:$coursenum:classlist",$coursehome); - my %classlist=(); + my ($coursedomain,$coursenum,$hideexpired) = @_; + 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); + 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"; + #print "Skipping:$name:$end:$now
\n"; next; } - push( @{ $classlist{'allids'} }, $name); + #print "record=$record
"; + push( @{ $classlist{'allids'} }, $student); } return (%classlist); } @@ -70,7 +240,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); } } @@ -80,59 +250,54 @@ 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, - &Apache::lonnet::homeserver($stuname,$domain)); + my (@requests) = ('lastname','firstname','middlename','generation'); + my (%name) = &Apache::lonnet::get('environment',\@requests,$domain,$username); + my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); + + my $fullname=$name{'lastname'}.$name{'generation'}; + if ($fullname =~ /[^\s]+/) { $fullname.=', '; } + $fullname.=$name{'firstname'}.' '.$name{'middlename'}; - $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/