--- loncom/homework/grades.pm 2006/06/21 20:18:43 1.364 +++ loncom/homework/grades.pm 2006/10/23 22:32:09 1.381 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.364 2006/06/21 20:18:43 banghart Exp $ +# $Id: grades.pm,v 1.381 2006/10/23 22:32:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -112,36 +112,34 @@ sub nameUserString { #--- Indicate if a response type is coded handgraded or not. --- sub response_type { my ($symb) = shift; - my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); - my $allkeys = &Apache::lonnet::metadata($url,'keys'); - my %vPart; - foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { - $vPart{$partid}=1; - } - my %seen = (); - my (@partlist,%handgrade,%responseType); - foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_.*/ || /^Task_/) { - my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); - if ($responsetype eq 'Task') { $respid='0'; } - if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { - next; - } - if (%vPart && !exists($vPart{$partid})) { - next; - } - $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! - my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); - $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); - if (!exists($responseType{$partid})) { $responseType{$partid}={}; } - $responseType{$partid}->{$respid}=$responsetype; - next if ($seen{$partid} > 0); - $seen{$partid}++; - push @partlist,$partid; - } - } - return (\@partlist,\%handgrade,\%responseType); + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + $response_types{$part}{$ids[$i]} = $types[$i]; + $handgrade{$part.'_'.$ids[$i]} = + &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. + '.handgrade',$symb); + } + } + return ($partlist,\%handgrade,\%response_types); +} + +sub flatten_responseType { + my ($responseType) = @_; + my @part_response_id = + map { + my $part = $_; + map { + [$part,$_] + } sort(keys(%{ $responseType->{$part} })); + } sort(keys(%$responseType)); + return @part_response_id; } sub get_display_part { @@ -168,25 +166,26 @@ sub showResourceInfo { my %resptype = (); my $hdgrade='no'; my %partsseen; - for my $part_resID (sort keys(%$handgrade)) { - my $handgrade=$$handgrade{$part_resID}; - my ($partID,$resID) = split(/_/,$part_resID); - my $responsetype = $responseType->{$partID}->{$resID}; - $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.='
'.$$string[0]; } else { my %seenparts; - for my $part (sort keys(%$handgrade)) { - my ($partid,$respid) = split(/_/,$part); + my @part_response_id = &flatten_responseType($responseType); + foreach my $part (@part_response_id) { + my ($partid,$respid) = @{ $part }; my $display_part=&get_display_part($partid,$symb); if ($env{"form.$uname:$udom:$partid:submitted_by"}) { if (exists($seenparts{$partid})) { next; } @@ -1880,7 +1886,7 @@ KEYWORDS } foreach (@$string) { my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; - if ($part ne ($partid.'_'.$respid)) { next; } + if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; } my ($ressub,$subval) = split(/:/,$_,2); # Similarity check my $similar=''; @@ -1900,7 +1906,7 @@ KEYWORDS my $order=&get_order($partid,$respid,$symb,$uname,$udom); if ($env{'form.lastSub'} eq 'lastonly' || ($env{'form.lastSub'} eq 'hdgrade' && - $$handgrade{$part} eq 'yes')) { + $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) { my $display_part=&get_display_part($partid,$symb); $lastsubonly.=' | ||||||
Part: '.
$display_part.' ( ID '.$respid.
@@ -1990,8 +1996,10 @@ KEYWORDS
my %seen = ();
my @partlist;
my @gradePartRespid;
- for my $part_resp (sort(keys(%$handgrade))) {
- my ($partid,$respid) = split(/_/, $part_resp);
+ my @part_response_id = &flatten_responseType($responseType);
+ foreach my $part_response_id (@part_response_id) {
+ my ($partid,$respid) = @{ $part_response_id };
+ my $part_resp = join('_',@{ $part_response_id });
next if ($seen{$partid} > 0);
$seen{$partid}++;
next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/);
@@ -2390,7 +2398,6 @@ sub saveHandGrade {
}
$newrecord{'resource.'.$new_part.'.regrader'}=
"$env{'user.name'}:$env{'user.domain'}";
- &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
}
# unless problem has been graded, set flag to version the submitted files
unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ ||
@@ -2408,20 +2415,15 @@ sub saveHandGrade {
my @changed_keys = &version_portfiles(\%record, \@parts_graded,
$env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts);
@newrecord{@changed_keys} = @record{@changed_keys};
+ foreach my $new_part (@version_parts) {
+ &handback_files($request,$symb,$stuname,$domain,$newflg,
+ $new_part,\%newrecord);
+ }
}
&Apache::lonnet::cstore(\%newrecord,$symb,
$env{'request.course.id'},$domain,$stuname);
- my @ungraded_parts;
- foreach my $part (@parts) {
- if ( !defined($record{'resource.'.$part.'.awarded'})
- && !defined($newrecord{'resource.'.$part.'.awarded'}) ) {
- push(@ungraded_parts, $part);
- }
- }
- if ( !@ungraded_parts ) {
- &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,
- $cnum,$domain,$stuname);
- }
+ &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb,
+ $cdom,$cnum,$domain,$stuname);
}
if ($aggregateflag) {
&Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
@@ -2430,15 +2432,37 @@ sub saveHandGrade {
return ('',$pts,$wgt);
}
+sub check_and_remove_from_queue {
+ my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_;
+ my @ungraded_parts;
+ foreach my $part (@{$parts}) {
+ if ( $record->{ 'resource.'.$part.'.awarded'} eq ''
+ && $record->{ 'resource.'.$part.'.solved' } ne 'excused'
+ && $newrecord->{'resource.'.$part.'.awarded'} eq ''
+ && $newrecord->{'resource.'.$part.'.solved' } ne 'excused'
+ ) {
+ push(@ungraded_parts, $part);
+ }
+ }
+ if ( !@ungraded_parts ) {
+ &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,
+ $cnum,$domain,$stuname);
+ }
+}
+
sub handback_files {
my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio';
my ($partlist,$handgrade,$responseType) = &response_type($symb);
- foreach my $part_resp (sort(keys(%$handgrade))) {
- my ($part_id, $resp_id) = split(/_/,$part_resp);
+
+ my @part_response_id = &flatten_responseType($responseType);
+ foreach my $part_response_id (@part_response_id) {
+ my ($part_id,$resp_id) = @{ $part_response_id };
+ my $part_resp = join('_',@{ $part_response_id });
if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) {
# if multiple files are uploaded names will be 'returndoc2','returndoc3'
my $file_counter = 1;
+ my $file_msg;
while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {
my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};
my ($directory,$answer_file) =
@@ -2459,23 +2483,29 @@ sub handback_files {
} else {
# mark the file as read only
my @files = ($save_file_name);
- my @what = ($symb,'handback');
+ my @what = ($symb,$env{'request.course.id'},'handback');
&Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what);
- $$newrecord{"resource.$new_part.$resp_id.handback"} = $save_file_name;
- my $subject = "File Handed Back by Instructor ";
- my $message = "A file has been returned that was originally submitted in reponse to: "; - $message .= "".&Apache::lonnet::gettitle($symb)." "; - $message .= " The returned file is named: ".$save_file_name." "; - $message .= " and can be found in your portfolio space."; - my $url = (&Apache::lonnet::decode_symb($symb))[2]; - $url = &Apache::lonnet::declutter($url); - my $msgstatus = &Apache::lonmsg::user_normal_msg($stuname,$domain, - $subject.' (File Returned) ['.$url.']',$message); + if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) { + $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; + } + $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; + $file_msg.= "\n".' '.$save_file_name." "; + } $request->print(" ".$fname." will be the uploaded file name"); $request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter}); $file_counter++; } + my $subject = "File Handed Back by Instructor "; + my $message = "A file has been returned that was originally submitted in reponse to: "; + $message .= "".&Apache::lonnet::gettitle($symb)." "; + $message .= ' The returned file(s) are named: '. $file_msg; + $message .= " and can be found in your portfolio space."; + my $url = (&Apache::lonnet::decode_symb($symb))[2]; + $url = &Apache::lonnet::declutter($url); + my $msgstatus = &Apache::lonmsg::user_normal_msg($stuname,$domain, + $subject.' (File Returned) ['.$url.']',$message); + } } return; @@ -2567,7 +2597,7 @@ sub version_portfiles { my $new_portfiles; if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { my @versioned_portfiles; - my @portfiles = split(/,/,$$record{$key}); + my @portfiles = split(/\s*,\s*/,$$record{$key}); foreach my $file (@portfiles) { &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file); my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); @@ -2579,7 +2609,7 @@ sub version_portfiles { if ($new_answer ne 'problem getting file') { push(@versioned_portfiles, $directory.$new_answer); &Apache::lonnet::mark_as_readonly($domain,$stu_name, - ['/portfolio'.$directory.$new_answer], + [$directory.$new_answer], [$symb,$env{'request.course.id'},'graded']); } } @@ -2861,16 +2891,18 @@ sub viewgrades { '
|