--- loncom/homework/grades.pm 2002/06/20 22:04:21 1.29 +++ loncom/homework/grades.pm 2002/09/20 23:41:47 1.50 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.29 2002/06/20 22:04:21 albertel Exp $ +# $Id: grades.pm,v 1.50 2002/09/20 23:41:47 albertel 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-August H.K. Ng +# package Apache::grades; use strict; @@ -37,453 +40,1788 @@ use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; use Apache::lonhomework; +use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); -sub moreinfo { - my ($request,$reason) = @_; - $request->print("Unable to process request: $reason"); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print('
'); - } - return ''; + return $fullname; } -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'}); +#--- Get the partlist and the response type for a given problem. --- +#--- Indicate if a response type is coded handgraded or not. --- +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+.*/) { + 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; + } } - if ((&Apache::lonnet::allowed('mgr',$courseid)) && ($symb)) { - $request->print(''.$matches.' match(es)
'); + return \@partlist,\%handgrade; +} + +#--- Dumps the class list with usernames,list of sections, +#--- 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); + # 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{$_}); + # 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); +} + +# 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; +} + +#find user domain +sub finduser { + my ($name) = @_; + my $domain = ''; + if ( $Apache::grades::viewgrades eq 'F' ) { + my %classlist=&Apache::lonnet::dump('classlist', + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + my (@fields) = grep /^$name:/, keys %classlist; + ($name, $domain) = split(/:/,$fields[0]); + return ($name,$domain); + } else { + return ($ENV{'user.name'},$ENV{'user.domain'}); + } +} + +#--- Prompts a user to enter a username. +sub moreinfo { + my ($request,$reason) = @_; + $request->print("Unable to process request: $reason"); + if ( $Apache::grades::viewgrades eq 'F' ) { + $request->print(''); } return ''; } +#--- Retrieve the grade status of a student for all the parts +sub student_gradeStatus { + my ($url,$symb,$udom,$uname,$partlist) = @_; + 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; + my $subkey = "resource.$_.submitted_by"; + $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); + } + return %partstatus; +} + +# hidden form and javascript that calls the form +# Use by verifyscript and viewgrades +# Shows a student's view of problem and submission +sub jscriptNform { + my ($url,$symb) = @_; + my $jscript=''."\n"; + $jscript.= ''."\n"; + return $jscript; +} + +#------------------ End of general use routines -------------------- +#------------------------------------------------------------------- + +#------------------------------------ Receipt Verification Routines +# +#--- Check whether a receipt number is valid.--- +sub verifyreceipt { + my $request = shift; + + my $courseid = $ENV{'request.course.id'}; + my $receipt = unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. + $ENV{'form.receipt'}; + $receipt =~ s/[^\-\d]//g; + my $url = $ENV{'form.url'}; + my $symb = $ENV{'form.symb'}; + unless ($symb) { + $symb = &Apache::lonnet::symbread($url); + } + + my $title.=''."\n".
+ '
|
'."\n";
- $result.='
|
'."\n".
- '
|
Part '.$partid.' Point: | ';
+ $result.='
| or /'. + $weight{$partid}.' (problem weight) | '."\n"; + $result.= ''. + ''. + ' |
'."\n".
+ '
|
-ENDUPFORM - return $result; + my $symb=$ENV{'form.symb'}; + my $url =$ENV{'form.url'}; + my $title='
'."\n";
+ $result.= '
|
Resource: '.$url.' | ||
Part '.(split(/_/))[0].' | '. + 'Type: '.$responsetype.' | '. + 'Handgrade: '.$handgrade.' |
'."\n";
+ $result.='
|
'."\n";
+ $result.='
|
'."\n";
+ $result.='
|
'."\n";
+ $result.='
|