--- loncom/homework/grades.pm 2002/07/18 21:27:57 1.39 +++ loncom/homework/grades.pm 2003/02/27 21:05:58 1.68 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.39 2002/07/18 21:27:57 ng Exp $ +# $Id: grades.pm,v 1.68 2003/02/27 21:05:58 ng Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,7 +30,9 @@ # 7/26 H.K. Ng # 8/20 Gerd Kortemeyer # Year 2002 -# June, July 2002 H.K. Ng +# June-August H.K. Ng +# Year 2003 +# February H.K. Ng # package Apache::grades; @@ -39,1077 +41,427 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonnavmaps; use Apache::lonhomework; +use Apache::loncoursedata; 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('
'); - } - 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(''.$matches." match%s
",$matches <= 1 ? '' : 'es'); -# needs to print who is matched +# ----- These first few routines are general use routines.---- +# +# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +sub getpartlist { + my ($url) = @_; + my @parts =(); + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ( $key =~ m/stores_(\w+)_.*/) { + push(@parts,$key); + } } - return ''; + return @parts; } -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; +# --- Get the symbolic name of a problem and the url +sub get_symb_and_url { + my ($request) = @_; + (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); + if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } + return ($symb,$url); } +# --- Retrieve the fullname for a user. Return lastname, first middle --- +# --- Generation is attached next to the lastname if it exists. --- sub get_fullname { my ($uname,$udom) = @_; my %name=&Apache::lonnet::get('environment', ['lastname','generation', 'firstname','middlename'], - $udom,$uname); + $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'}; + $fullname = &Apache::loncoursedata::ProcessFullName + (@name{qw/lastname generation firstname middlename/}); + } else { + &Apache::lonnet::logthis('grades.pm: no name data for '.$uname. + '@'.$udom.':'.$tmp); } return $fullname; } +#--- 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{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; + 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_\w+.*/) { + 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='Resource: '.$ENV{'form.url'}.' | ||
Part id: '.$_.' | '. - 'Type: '.$responsetype.' | '. - 'Handgrade: '.$handgrade.' |
'.
- '
|
'."\n".
+ '
|
';
- $result.='
|
'. + 'Resource: '.$url.' |
Resource: '.$url.' | ||
Part id: '.$_.' | '. - 'Type: '.$responsetype.' | '. - 'Handgrade: '.$handgrade.' |
'."\n";
- $result.='
|
'.$_.' | '.$classlist{$_}.' |
'."\n";
- $result.='
|
'."\n";
- $result.='
|
'."\n";
- $result.='
|
'."\n";
- $result.='
|