--- loncom/homework/grades.pm 2002/05/24 21:45:22 1.27 +++ loncom/homework/grades.pm 2002/07/18 21:27:57 1.39 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.27 2002/05/24 21:45:22 albertel Exp $ +# $Id: grades.pm,v 1.39 2002/07/18 21:27:57 ng Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,6 +29,9 @@ # 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; @@ -37,7 +40,9 @@ 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) = @_; @@ -50,6 +55,7 @@ sub moreinfo { if ($ENV{'form.symb'}) { $request->print(''."\n"); } +# $request->print(''."\n"); $request->print(''."\n"); $request->print("Student:".''."
\n"); $request->print("Domain:".''."
\n"); @@ -62,8 +68,8 @@ sub moreinfo { sub verifyreceipt { my $request=shift; my $courseid=$ENV{'request.course.id'}; - my $cdom=$ENV{"course.$courseid.domain"}; - my $cnum=$ENV{"course.$courseid.num"}; +# 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; @@ -74,8 +80,8 @@ sub verifyreceipt { 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 ($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)) { @@ -83,89 +89,176 @@ sub verifyreceipt { $matches++; } } - $request->print('

'.$matches.' match(es)

'); + $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 $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( - ''); - } + 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(< -

Show Student Submissions on Assessment

- - + + View Problem: no + yes
Submissions: + last sub only + last sub & parts info + all details + + + + + 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 ($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='
UsernameDomainName 
'. + ''. + ''. + ''; + 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' ) { - $request->print("\n".''."'. + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + foreach (sort keys(%status)) { + $result.=''."\n"; } - $request->print( - ''); - $request->print( - ''); - $request->print( - ''); - $request->print( - ''); - $request->print(''); + $request->print($result.''."\n"); } } - $request->print('
 Select  Username  Fullname  Domain  Part ID '.$_.' Status 
$sname$sdom$fullname". - ''); - if ($ENV{'form.url'}) { - $request->print( - ''); - } - if ($ENV{'form.symb'}) { - $request->print( - ''); + $result='
 '.$uname.'  '.$$fullname{$student}.'  '.$udom.'  '.$status{$_}.' 
'); + $request->print('
'); + $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 ''; } +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' ) { - #get classlist - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - #print "Found $cdom:$cnum
"; - my (%classlist) = &getclasslist($cdom,$cnum,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - my ($posname,$posdomain) = split(/:/,$student); + my ($classlist) = &getclasslist('all','0'); + foreach ( sort(@{ $$classlist{'all'} }) ) { + my ($posname,$posdomain) = split(/:/); if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } } return ($name,$domain); @@ -175,20 +268,32 @@ sub finduser { } sub getclasslist { - my ($coursedomain,$coursenum,$hideexpired) = @_; - my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum); - my $now = time; - 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; - } - #print "record=$record
"; - push( @{ $classlist{'allids'} }, $student); - } - 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 { @@ -196,7 +301,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); } } @@ -205,59 +310,49 @@ sub getpartlist { sub viewstudentgrade { my ($url,$symb,$courseid,$student,@parts) = @_; - my $result =''; my $cellclr = '"#ffffdd"'; - my ($stuname,$domain) = split(/:/,$student); + my ($username,$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"; + 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/