--- loncom/homework/grades.pm 2006/09/14 17:52:22 1.374 +++ loncom/homework/grades.pm 2006/10/13 21:53:34 1.379 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.374 2006/09/14 17:52:22 albertel Exp $ +# $Id: grades.pm,v 1.379 2006/10/13 21:53:34 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.=''; - if ($checkboxes) { - if (exists($partsseen{$partID})) { - $result.=" "; - } else { - $result.=""; + foreach my $partID (sort keys(%$responseType)) { + foreach my $resID (sort keys(%{ $responseType->{$partID} })) { + my $handgrade=$$handgrade{$partID.'_'.$resID}; + my $responsetype = $responseType->{$partID}->{$resID}; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=" "; + } else { + $result.=""; + } + $partsseen{$partID}=1; } - $partsseen{$partID}=1; - } - my $display_part=&get_display_part($partID,$symb); - $result.='Part: '.$display_part.' '. - $resID.''. - 'Type: '.$responsetype.''; + my $display_part=&get_display_part($partID,$symb); + $result.='Part: '.$display_part.' '. + $resID.''. + 'Type: '.$responsetype.''; # 'Handgrade: '.$handgrade.''; + } } $result.=''."\n"; return $result,$responseType,$hdgrade,$partlist,$handgrade; @@ -589,7 +588,7 @@ sub verifyreceipt { my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $symb = &Apache::lonnet::symbread(); + my ($symb) = &get_symb($request); my $title.='

Verifying Submission Receipt '. $receipt.'

'."\n". @@ -1538,10 +1537,11 @@ sub handback_box { my ($symb,$uname,$udom,$counter,$partid,$record) = @_; my ($partlist,$handgrade,$responseType) = &response_type($symb); my (@respids); - foreach my $part_resp (sort(keys(%$handgrade))) { - my ($part,$resp) = split(/_/,$part_resp); + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($part,$resp) = @{ $part_response_id }; if ($part eq $partid) { - push @respids,$resp; + push(@respids,$resp); } } my $result; @@ -1858,8 +1858,9 @@ KEYWORDS $lastsubonly.=''.$$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; } @@ -1883,7 +1884,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=''; @@ -1903,7 +1904,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. @@ -1993,8 +1994,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)$/); @@ -2440,8 +2443,11 @@ 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; @@ -2874,16 +2880,18 @@ sub viewgrades { '
'; #radio buttons/text box for assigning points for a section or class. #handles different parts of a problem - my ($partlist,$handgrade) = &response_type($symb); + my ($partlist,$handgrade,$responseType) = &response_type($symb); my %weight = (); my $ctsparts = 0; $result.=''; my %seen = (); - for (sort keys(%$handgrade)) { - my ($partid,$respid) = split (/_/,$_,2); + 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}; $seen{$partid}++; - my $handgrade=$$handgrade{$_}; + my $handgrade=$$handgrade{$part_resp}; my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); $weight{$partid} = $wgt eq '' ? '1' : $wgt; @@ -4426,6 +4434,7 @@ SCANTRONFORM
+ $default_form_data @@ -4772,21 +4781,29 @@ sub reset_skipping_status { &scantron_putfile(undef,$scan_data); } -sub allow_skipping { +sub start_skipping { my ($scan_data,$i)=@_; my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); - delete($remembered{$i}); + if ($env{'form.scantron_options_redo'} =~ /^redo_/) { + $remembered{$i}=2; + } else { + $remembered{$i}=1; + } &scan_data($scan_data,'remember_skipping',join(':',%remembered)); } sub should_be_skipped { - my ($scan_data,$i)=@_; + my ($scanlines,$scan_data,$i)=@_; if ($env{'form.scantron_options_redo'} !~ /^redo_/) { # not redoing old skips + if ($scanlines->{'skipped'}[$i]) { return 1; } return 0; } my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); - if (exists($remembered{$i})) { return 0; } + + if (exists($remembered{$i}) && $remembered{$i} != 2 ) { + return 0; + } return 1; } @@ -4798,6 +4815,7 @@ sub remember_current_skipped { $to_remember{$i}=1; } } + &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); &scantron_putfile(undef,$scan_data); } @@ -4903,7 +4921,6 @@ sub scantron_validate_file { } if ($env{'form.scantron_options_redo'} eq 'redo_skipped') { &remember_current_skipped(); - &scantron_remove_file('skipped'); $env{'form.scantron_options_redo'}='redo_skipped_ready'; } @@ -5073,8 +5090,8 @@ sub scantron_putfile { sub scantron_get_line { my ($scanlines,$scan_data,$i)=@_; - if (&should_be_skipped($scan_data,$i)) { return undef; } - if ($scanlines->{'skipped'}[$i]) { return undef; } + if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } + #if ($scanlines->{'skipped'}[$i]) { return undef; } if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} return $scanlines->{'orig'}[$i]; } @@ -5094,12 +5111,21 @@ sub scantron_put_line { my ($scanlines,$scan_data,$i,$newline,$skip)=@_; if ($skip) { $scanlines->{'skipped'}[$i]=$newline; - &allow_skipping($scan_data,$i); + &start_skipping($scan_data,$i); return; } $scanlines->{'corrected'}[$i]=$newline; } +sub scantron_clear_skip { + my ($scanlines,$scan_data,$i)=@_; + if (exists($scanlines->{'skipped'}[$i])) { + undef($scanlines->{'skipped'}[$i]); + return 1; + } + return 0; +} + sub scantron_filter_not_exam { my ($curres)=@_; @@ -5586,6 +5612,10 @@ SCANTRONFORM &Apache::lonxml::clear_problem_counter(); &Apache::lonnet::appenv(%$scan_record); + + if (&scantron_clear_skip($scanlines,$scan_data,$i)) { + &scantron_putfile($scanlines,$scan_data); + } my $i=0; foreach my $resource (@resources) {