--- loncom/homework/grades.pm 2001/04/17 21:07:38 1.6 +++ loncom/homework/grades.pm 2002/07/19 20:42:18 1.40 @@ -1,5 +1,37 @@ +# The LearningOnline Network with CAPA # The LON-CAPA Grading handler +# +# $Id: grades.pm,v 1.40 2002/07/19 20:42:18 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, July 2002 H.K. Ng +# package Apache::grades; use strict; @@ -8,51 +40,261 @@ use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; use Apache::lonhomework; +use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); +#use Time::HiRes qw( gettimeofday tv_interval ); sub moreinfo { my ($request,$reason) = @_; $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(''."\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,$partlist) = @_; + 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); + my %partstatus = (); + foreach (@$partlist) { + my ($status,$foo)=split(/_/,$record{"resource.$_.solved"},2); + $status = 'nothing' if ($status eq ''); + $partstatus{$_} = $status; + } + return %partstatus; +} + +sub get_fullname { + my ($uname,$udom) = @_; + my %name=&Apache::lonnet::get('environment', ['lastname','generation', + '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'}; + } + return $fullname; +} + +sub response_type { + my ($url) = shift; + my $allkeys = &Apache::lonnet::metadata($url,'keys'); + my %seen = (); + my (@partlist,%handgrade); + foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { + if (/^\w+response_\d{1,2}.*/) { + my ($responsetype,$part) = split(/_/,$_,2); + my ($partid,$respid) = split(/_/,$part); + $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); + next if ($seen{$partid} > 0); + $seen{$partid}++; + push @partlist,$partid; + } + } + return \@partlist,\%handgrade; +} + + +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'}; + + my $result='

 View Submissions for a Student or a Group of Students

'; + $result.=''; + $result.=''; + my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); + for (sort keys(%$handgrade)) { + my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + $result.=''. + ''. + ''; + } + $result.='
Resource: '.$ENV{'form.url'}.'
Part id: '.$_.'Type: '.$responsetype.'Handgrade: '.$handgrade.'
'; + $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"); + } + if ($ENV{'form.symb'}) { + $request->print(''."\n"); + } + $request->print(''."\n"); + + my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($getsec,'0'); + + $result='
'. + ''. + ''. + ''; + foreach (sort(@$partlist)) { + $result.=''; + } + $request->print($result.''."\n"); + + foreach my $student (sort(@{ $$classlist{$getsec} }) ) { + my ($uname,$udom) = split(/:/,$student); + my (%status) = &student_gradeStatus($ENV{'form.url'},$udom,$uname,$partlist); + my $statusflg = ''; + foreach (keys(%status)) { + $statusflg = 1 if ($status{$_} ne 'nothing'); + } + next if ($statusflg eq '' && $submitonly eq 'yes'); + + if ( $Apache::grades::viewgrades eq 'F' ) { + $result=''. + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + foreach (sort keys(%status)) { + $result.=''."\n"; + } + $request->print($result.''."\n"); + } + } + $request->print('
 Select  Username  Fullname  Domain  Part ID '.$_.' Status 
 '.$uname.'  '.$$fullname{$student}.'  '.$udom.'  '.$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; + 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; + $ENV{'form.fullname'} = $fullname; + &submission($request,$ctr,$total); + $ctr++; + } + return ''; +} -#FIXME - needs to be much smarter +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 ''; +} + +#FIXME - needs to handle multiple matches sub finduser { my ($name) = @_; - + my $domain = ''; if ( $Apache::grades::viewgrades eq 'F' ) { - return ($name,$ENV{'user.domain'}); + my ($classlist) = &getclasslist('all','0'); + foreach ( sort(@{ $$classlist{'all'} }) ) { + my ($posname,$posdomain) = split(/:/); + if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } + } + return ($name,$domain); } else { return ($ENV{'user.name'},$ENV{'user.domain'}); } } sub getclasslist { - my ($coursedomain,$coursenum,$coursehome,$hideexpired) = @_; - my $classlist=&Apache::lonnet::reply("dump:$coursedomain:$coursenum:classlist",$coursehome); - my %classlist=(); - my $now = time; - foreach my $record (split /&/, $classlist) { - my ($name,$value)=split(/=/,&Apache::lonnet::unescape($record)); - my ($end,$start)=split(/:/,$value); - # still a student? - if (($hideexpired) && ($end) && ($end < $now)) { - print "Skipping:$name:$end:$now
\n"; - next; - } - push( @{ $classlist{'allids'} }, $name); - } - return (%classlist); + my ($getsec,$hideexpired) = @_; + my %classlist=&Apache::lonnet::dump('classlist', + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + my $now = time; + my (@holdsec,@sections,%allids,%stusec,%fullname); + foreach (keys(%classlist)) { + my ($end,$start,$id,$section,$fullname)=split(/:/,$classlist{$_}); + # still a student? + if (($hideexpired) && ($end) && ($end < $now)) { + 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; + } + } + my %seen = (); + foreach my $item (@holdsec) { + push (@sections, $item) unless $seen{$item}++; + } + return (\%classlist,\@sections,\%allids,\%stusec,\%fullname); } sub getpartlist { @@ -60,7 +302,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); } } @@ -69,60 +311,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, - &Apache::lonnet::homeserver($stuname,$domain)); + my $fullname = &get_fullname($username,$domain); + my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); - $result.="$stuname$domain\n"; + my $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/