--- loncom/homework/grades.pm 2008/03/04 11:23:12 1.513 +++ loncom/homework/grades.pm 2008/06/25 11:59:59 1.525 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.513 2008/03/04 11:23:12 foxr Exp $ +# $Id: grades.pm,v 1.525 2008/06/25 11:59:59 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -73,7 +73,7 @@ my $ssi_error_message; # the number of times requested by the caller. # If we still have a proble, no text is appended to the # output and we set some global variables. -# to indicate to the caller an SSI error occured. +# to indicate to the caller an SSI error occurred. # All of this is supposed to deal with the issues described # in LonCAPA BZ 5631 see: # http://bugs.lon-capa.org/show_bug.cgi?id=5631 @@ -89,13 +89,13 @@ my $ssi_error_message; # On success, returns the rendered resource identified by the resource parameter. # Side Effects: # The following global variables can be set: -# ssi_error - If an unrecoverable error occured this becomes true. +# ssi_error - If an unrecoverable error occurred this becomes true. # It is up to the caller to initialize this to false # if desired. -# ssi_last_error_resource - If an unrecoverable error occured, this is the value +# ssi_error_resource - If an unrecoverable error occurred, this is the value # of the resource that could not be rendered by the ssi # call. -# ssi_last_error - The error string fetched from the ssi response +# ssi_error_message - The error string fetched from the ssi response # in the event of an error. # sub ssi_with_retries { @@ -116,11 +116,20 @@ sub ssi_with_retries { sub ssi_print_error { my ($r) = @_; - $r->print('

Unrecoverable network error

'); - $r->print('

Unable to perform a resource fetch from a server:
'); - $r->print("Resource: $ssi_error_resource
"); - $r->print("Error: $ssi_error_message
Try again later."); - $r->print('If errors persist, contact LonCAPA support for assistance

'); + my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk'); + $r->print(' +
+

'.&mt('An unrecoverable network error occurred:').'

+

+'.&mt('Unable to retrieve a resource from a server:').'
+'.&mt('Resource:').' '.$ssi_error_resource.'
+'.&mt('Error:').' '.$ssi_error_message.' +

+

'. +&mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'
'. +&mt('If the error persists, please contact the [_1] for assistance.',$helpurl). +'

'); + return; } # @@ -231,8 +240,8 @@ sub showResourceInfo { my %resptype = (); my $hdgrade='no'; my %partsseen; - foreach my $partID (sort keys(%$responseType)) { - foreach my $resID (sort keys(%{ $responseType->{$partID} })) { + 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'); @@ -269,27 +278,28 @@ sub reset_caches { } sub get_analyze { - my ($symb,$uname,$udom)=@_; + my ($symb,$uname,$udom,$no_increment)=@_; my $key = "$symb\0$uname\0$udom"; return $analyze_cache{$key} if (exists($analyze_cache{$key})); my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); $url=&Apache::lonnet::clutter($url); my $subresult=&ssi_with_retries($url, $ssi_retries, - ('grade_target' => 'analyze'), - ('grade_domain' => $udom), - ('grade_symb' => $symb), - ('grade_courseid' => - $env{'request.course.id'}), - ('grade_username' => $uname)); + ('grade_target' => 'analyze', + 'grade_domain' => $udom, + 'grade_symb' => $symb, + 'grade_courseid' => + $env{'request.course.id'}, + 'grade_username' => $uname, + 'grade_noincrement' => $no_increment)); (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); my %analyze=&Apache::lonnet::str2hash($subresult); return $analyze_cache{$key} = \%analyze; } sub get_order { - my ($partid,$respid,$symb,$uname,$udom)=@_; - my $analyze = &get_analyze($symb,$uname,$udom); + my ($partid,$respid,$symb,$uname,$udom,$no_increment)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,$no_increment); return $analyze->{"$partid.$respid.shown"}; } @@ -1021,7 +1031,7 @@ LISTJAVASCRIPT ' '.$section.($group ne '' ?'/'.$group:'').''."\n"; if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { - foreach (sort keys(%status)) { + foreach (sort(keys(%status))) { next if ($_ =~ /^resource.*?submitted_by$/); $gradeTable.=' '.&mt($status{$_}).' '."\n"; } @@ -1833,9 +1843,9 @@ sub download_all_link { join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); my $identifier = &Apache::loncommon::get_cgi_id(); - &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students, - 'cgi.'.$identifier.'.symb' => $symb, - 'cgi.'.$identifier.'.parts' => $parts,); + &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, + 'cgi.'.$identifier.'.symb' => $symb, + 'cgi.'.$identifier.'.parts' => $parts,}); $r->print(''. &mt('Download All Submitted Documents').''); return @@ -2216,8 +2226,8 @@ KEYWORDS $seen{$partid}++; next if ($$handgrade{$part_resp} ne 'yes' && $env{'form.lastSub'} eq 'hdgrade'); - push @partlist,$partid; - push @gradePartRespid,$partid.'.'.$respid; + push(@partlist,$partid); + push(@gradePartRespid,$partid.'.'.$respid); $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); } $request->print(''); @@ -2544,7 +2554,7 @@ sub processHandGrade { my (@parsedlist,@nextlist); my ($nextflg) = 0; - foreach (sort + foreach my $item (sort { if (lc($$fullname{$a}) ne lc($$fullname{$b})) { return (lc($$fullname{$a}) cmp lc($$fullname{$b})); @@ -2552,12 +2562,12 @@ sub processHandGrade { return $a cmp $b; } (keys(%$fullname))) { if ($nextflg == 1 && $button =~ /Next$/) { - push @parsedlist,$_; + push(@parsedlist,$item); } - $nextflg = 1 if ($_ eq $laststu); + $nextflg = 1 if ($item eq $laststu); if ($button eq 'Previous') { - last if ($_ eq $firststu); - push @parsedlist,$_; + last if ($item eq $firststu); + push(@parsedlist,$item); } } $ctr = 0; @@ -2580,11 +2590,11 @@ sub processHandGrade { my $submitted = 0; my $ungraded = 0; my $incorrect = 0; - foreach (keys(%status)) { - $submitted = 1 if ($status{$_} ne 'nothing'); - $ungraded = 1 if ($status{$_} =~ /^ungraded/); - $incorrect = 1 if ($status{$_} =~ /^incorrect/); - my ($foo,$partid,$foo1) = split(/\./,$_); + foreach my $item (keys(%status)) { + $submitted = 1 if ($status{$item} ne 'nothing'); + $ungraded = 1 if ($status{$item} =~ /^ungraded/); + $incorrect = 1 if ($status{$item} =~ /^incorrect/); + my ($foo,$partid,$foo1) = split(/\./,$item); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; } @@ -2595,7 +2605,7 @@ sub processHandGrade { next if (!$ungraded && ($submitonly eq 'graded')); next if (!$incorrect && $submitonly eq 'incorrect'); } - push @nextlist,$student if ($ctr < $ntstu); + push(@nextlist,$student) if ($ctr < $ntstu); last if ($ctr == $ntstu); $ctr++; } @@ -2603,7 +2613,7 @@ sub processHandGrade { $ctr = 0; my $total = scalar(@nextlist)-1; - foreach (sort @nextlist) { + foreach (sort(@nextlist)) { my ($uname,$udom,$submitter) = split(/:/); $env{'form.student'} = $uname; $env{'form.userdom'} = $udom; @@ -2649,7 +2659,7 @@ sub saveHandGrade { } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts - foreach my $key (keys (%record)) { + foreach my $key (keys(%record)) { if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } } $newrecord{'resource.'.$new_part.'.regrader'}= @@ -2684,7 +2694,7 @@ sub saveHandGrade { &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); next; } else { - push @parts_graded, $new_part; + push(@parts_graded,$new_part); } if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { $newrecord{'resource.'.$new_part.'.awarded'} = $partial; @@ -2711,7 +2721,7 @@ sub saveHandGrade { $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' || $dropMenu eq 'reset status') { - push (@version_parts,$new_part); + push(@version_parts,$new_part); } } my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; @@ -2759,7 +2769,7 @@ sub check_and_remove_from_queue { sub handback_files { my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; - my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio'; + my $portfolio_root = '/userfiles/portfolio'; my ($partlist,$handgrade,$responseType) = &response_type($symb); my @part_response_id = &flatten_responseType($responseType); @@ -2777,7 +2787,8 @@ sub handback_files { my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file); my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); - my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root); + my $getpropath = 1; + my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath); my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); # fix file name my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); @@ -2883,7 +2894,7 @@ sub decrement_aggs { if ($aggtries == $totaltries) { $decrement{'users'} = 1; } - foreach my $type (keys (%decrement)) { + foreach my $type (keys(%decrement)) { $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type}; } return; @@ -2913,8 +2924,7 @@ sub version_portfiles { my $version_parts = join('|',@$v_flag); my @returned_keys; my $parts = join('|', @$parts_graded); - my $portfolio_root = &propath($domain,$stu_name). - '/userfiles/portfolio'; + my $portfolio_root = '/userfiles/portfolio'; foreach my $key (keys(%$record)) { my $new_portfiles; if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { @@ -2925,7 +2935,8 @@ sub version_portfiles { my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file); - my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root); + my $getpropath = 1; + my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath); my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); if ($new_answer ne 'problem getting file') { @@ -3284,7 +3295,7 @@ sub viewgrades { $display =~ s|^Number of Attempts|Tries
|; # makes the column narrower if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } my ($partid) = &split_part_type($part); - push(@partids, $partid); + push(@partids,$partid); my $display_part=&get_display_part($partid,$symb); if ($display =~ /^Partial Credit Factor/) { $result.=''. @@ -3438,7 +3449,7 @@ sub editgrades { my $header; while ($ctr < $env{'form.totalparts'}) { my $partid = $env{'form.partid_'.$ctr}; - push @partid,$partid; + push(@partid,$partid); $weight{$partid} = $env{'form.weight_'.$partid}; $ctr++; } @@ -4400,6 +4411,7 @@ sub displaySubByDates { } my $interaction; + my $no_increment = 1; for ($version=1;$version<=$$record{'version'};$version++) { my $timestamp = &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'}); @@ -4443,7 +4455,8 @@ sub displaySubByDates { if (!exists($orders{$partid})) { $orders{$partid}={}; } if (!exists($orders{$partid}->{$responseId})) { $orders{$partid}->{$responseId}= - &get_order($partid,$responseId,$symb,$uname,$udom); + &get_order($partid,$responseId,$symb,$uname,$udom, + $no_increment); } $displaySub[0].='  '. &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'
'; @@ -4825,8 +4838,9 @@ sub get_response_bubbles { sub scantron_filenames { my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $getpropath = 1; my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, - &propath($cdom,$cname)); + $getpropath); my @possiblenames; foreach my $filename (sort(@files)) { ($filename)=split(/&/,$filename); @@ -4869,19 +4883,76 @@ sub scantron_uploads { =cut sub scantron_scantab { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my $result=''."\n"; - return $result; } +=pod + +=item get_scantronformat_file + + Returns an array containing lines from the scantron format file for + the domain of the course. + + If a url for a custom.tab file is listed in domain's configuration.db, + lines are from this file. + + Otherwise, if a default.tab has been published in RES space by the + domainconfig user, lines are from this file. + + Otherwise, fall back to getting lines from the legacy file on the + local server: /home/httpd/lonTabs/default_scantronformat.tab + +=cut + +sub get_scantronformat_file { + my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; + my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom); + my $gottab = 0; + my @lines; + if (ref($domconfig{'scantron'}) eq 'HASH') { + if ($domconfig{'scantron'}{'scantronformat'} ne '') { + my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'}); + if ($formatfile ne '-1') { + @lines = split("\n",$formatfile,-1); + $gottab = 1; + } + } + } + if (!$gottab) { + my $confname = $cdom.'-domainconfig'; + my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab'; + my $formatfile = &Apache::lonnet::getfile($default); + if ($formatfile ne '-1') { + @lines = split("\n",$formatfile,-1); + $gottab = 1; + } + } + if (!$gottab) { + my @domains = &Apache::lonnet::current_machine_domains(); + if (grep(/^\Q$cdom\E$/,@domains)) { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); + @lines = <$fh>; + close($fh); + } else { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab'); + @lines = <$fh>; + close($fh); + } + } + return @lines; +} + =pod =item scantron_CODElist @@ -5077,8 +5148,37 @@ sub scantron_selectphase { '); &Apache::lonpickcode::code_list($r,2); + + $r>print('
'. + $default_form_data."\n". + &Apache::loncommon::start_data_table('LC_scantron_action')."\n". + &Apache::loncommon::start_data_table_header_row()."\n". + ' +  '.&mt('Review scantron data and submissions for a previously graded folder/sequence')."\n". + ''."\n". + &Apache::loncommon::end_data_table_header_row()."\n". + &Apache::loncommon::start_data_table_row()."\n". + ' '.&mt('Graded folder/sequence:').' '."\n". + ' '.$sequence_selector.' '. + &Apache::loncommon::end_data_table_row()."\n". + &Apache::loncommon::start_data_table_row()."\n". + ' '.&mt('Filename of scoring office file:').' '."\n". + ' '.$file_selector.' '."\n". + &Apache::loncommon::end_data_table_row()."\n". + &Apache::loncommon::start_data_table_row()."\n". + ' '.&mt('Format of data file:').' '."\n". + ' '.$format_selector.' '."\n". + &Apache::loncommon::end_data_table_row()."\n". + &Apache::loncommon::start_data_table_row()."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + &Apache::loncommon::end_data_table_row()."\n". + &Apache::loncommon::end_data_table()."\n". + '

'); $r->print($grading_menu_button); - return + return; } =pod @@ -5140,10 +5240,10 @@ sub scantron_selectphase { sub get_scantron_config { my ($which) = @_; - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); + my @lines = &get_scantronformat_file(); my %config; #FIXME probably should move to XML it has already gotten a bit much now - foreach my $line (<$fh>) { + foreach my $line (@lines) { my ($name,$descrip)=split(/:/,$line); if ($name ne $which ) { next; } chomp($line); @@ -6750,7 +6850,7 @@ ENDSCRIPT foreach my $question (@{$arg}) { my @linenums = &prompt_for_corrections($r,$question,$scan_config, $scan_record, $error); - push (@lines_to_correct,@linenums); + push(@lines_to_correct,@linenums); } $r->print(&verify_bubbles_checked(@lines_to_correct)); } elsif ($error eq 'missingbubble') { @@ -6770,7 +6870,7 @@ ENDSCRIPT foreach my $question (@{$arg}) { my @linenums = &prompt_for_corrections($r,$question,$scan_config, $scan_record, $error); - push (@lines_to_correct,@linenums); + push(@lines_to_correct,@linenums); } $r->print(&verify_bubbles_checked(@lines_to_correct)); } else { @@ -6928,7 +7028,7 @@ sub prompt_for_corrections { my $selected = $$scan_record{"scantron.$current_line.answer"}; &scantron_bubble_selector($r,$scan_config,$current_line, $questionnum,$error,split('', $selected)); - push (@linenums,$current_line); + push(@linenums,$current_line); $current_line++; } if ($lines > 1) { @@ -7144,7 +7244,7 @@ sub scantron_validate_CODE { $line,'duplicateCODE',$usedCODEs{$CODE}); return(1,$currentphase); } - push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); + push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); } return (0,$currentphase+1); } @@ -7231,47 +7331,60 @@ sub scantron_get_maxbubble { my $response_number = 0; my $bubble_line = 0; foreach my $resource (@resources) { + my $symb = $resource->symb(); + + my (@parts,@allparts,@possible_parts); + # Need to retrieve part IDs and response IDs because essayresponse, # reactionresponse and organicresponse items are not included in # $analysis{'parts'} from lonnet::ssi. - my %possible_part_ids; - if (ref($resource->parts()) eq 'ARRAY') { + if (ref($resource->parts()) eq 'ARRAY') { foreach my $part (@{$resource->parts()}) { - my @resp_ids = $resource->responseIds($part); - foreach my $id (@resp_ids) { - $possible_part_ids{$part.'.'.$id} = 1; + if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) { + my @resp_ids = $resource->responseIds($part); + foreach my $id (@resp_ids) { + my $part_id = $part.'.'.$id; + push(@possible_parts,$part_id); + } } } } - my $result=&ssi_with_retries($resource->src(), $ssi_retries, - ('symb' => $resource->symb()), - ('grade_target' => 'analyze'), - ('grade_courseid' => $cid), - ('grade_domain' => $udom), - ('grade_username' => $uname)); - my (undef, $an) = - split(/_HASH_REF__/,$result, 2); - my @parts; + my $result=&ssi_with_retries($resource->src(), $ssi_retries, + ('symb' => $symb, + 'grade_target' => 'analyze', + 'grade_courseid' => $cid, + 'grade_domain' => $udom, + 'grade_username' => $uname)); + my (undef, $an) = + split(/_HASH_REF__/,$result, 2); my %analysis = &Apache::lonnet::str2hash($an); if (ref($analysis{'parts'}) eq 'ARRAY') { - @parts = @{$analysis{'parts'}}; + foreach my $part (@{$analysis{'parts'}}) { + my ($id,$respid) = split(/\./,$part); + if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { + push(@parts,$part); + } + } } - # Add part_ids for any essayresponse items. - foreach my $part_id (keys(%possible_part_ids)) { - if (($analysis{$part_id.'.type'} eq 'essayresponse') || - ($analysis{$part_id.'.type'} eq 'reactionresponse') || - ($analysis{$part_id.'.type'} eq 'organicresponse')) { - if (!grep(/^\Q$part_id\E$/,@parts)) { - push (@parts,$part_id); + # Add part_ids for any essayresponse, reactionresponse or + # organicresponse items. + foreach my $part_id (@possible_parts) { + if (grep(/^\Q$part_id\E$/,@parts)) { + push(@allparts,$part_id); + } else { + if (($analysis{$part_id.'.type'} eq 'essayresponse') || + ($analysis{$part_id.'.type'} eq 'reactionresponse') || + ($analysis{$part_id.'.type'} eq 'organicresponse')) { + push(@allparts,$part_id); } } } - foreach my $part_id (@parts) { - my $lines = $analysis{"$part_id.bubble_lines"}; + foreach my $part_id (@allparts) { + my $lines; # TODO - make this a persistent hash not an array. @@ -7298,8 +7411,8 @@ sub scantron_get_maxbubble { $numshown = scalar(@{$analysis{$part_id.'.shown'}}); } my $bubbles_per_line = 10; - my $inner_bubble_lines = int($numshown/$bubbles_per_line); - if (($numshown % $bubbles_per_line) != 0) { + my $inner_bubble_lines = int($numbub/$bubbles_per_line); + if (($numbub % $bubbles_per_line) != 0) { $inner_bubble_lines++; } for (my $i=0; $i<$numshown; $i++) { @@ -7307,6 +7420,9 @@ sub scantron_get_maxbubble { $inner_bubble_lines.','; } $subdivided_bubble_lines{$response_number} =~ s/,$//; + $lines = $numshown * $inner_bubble_lines; + } else { + $lines = $analysis{"$part_id.bubble_lines"}; } $first_bubble_line{$response_number} = $bubble_line; @@ -7443,6 +7559,7 @@ SCANTRONFORM my @delayqueue; my %completedstudents; + my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam')); my $count=&get_todo_count($scanlines,$scan_data); my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', 'Scantron Progress',$count, @@ -7463,6 +7580,7 @@ SCANTRONFORM $r->print(""); &ssi_print_error($r); $r->print(&show_grading_menu_form($symb)); + &Apache::lonnet::remove_lock($lock); return ''; # Dunno why the other returns return '' rather than just returning. } @@ -7492,7 +7610,7 @@ SCANTRONFORM ($uname,$udom)=split(/:/,$uname); &Apache::lonxml::clear_problem_counter(); - &Apache::lonnet::appenv(%$scan_record); + &Apache::lonnet::appenv($scan_record); if (&scantron_clear_skip($scanlines,$scan_data,$i)) { &scantron_putfile($scanlines,$scan_data); @@ -7520,6 +7638,7 @@ SCANTRONFORM $r->print(""); &ssi_print_error($r); $r->print(&show_grading_menu_form($symb)); + &Apache::lonnet::remove_lock($lock); return ''; # Why return ''? Beats me. } @@ -7532,6 +7651,7 @@ SCANTRONFORM &Apache::lonnet::delenv('scantron\.'); } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + &Apache::lonnet::remove_lock($lock); # my $lasttime = &Time::HiRes::time()-$start; # $r->print("

took $lasttime

"); @@ -7722,6 +7842,271 @@ sub scantron_download_scantron_data { return ''; } +sub checkscantron_results { + my ($r) = @_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + my $grading_menu_button=&show_grading_menu_form($symb); + my $cid = $env{'request.course.id'}; + my %lettdig = ( + A => 1, + B => 2, + C => 3, + D => 4, + E => 5, + F => 6, + G => 7, + H => 8, + I => 9, + J => 0, + ); + my $numletts = scalar(keys(%lettdig)); + my $cnum = $env{'course.'.$cid.'.num'}; + my $cdom = $env{'course.'.$cid.'.domain'}; + my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); + my %record; + my %scantron_config = + &Apache::grades::get_scantron_config($env{'form.scantron_format'}); + my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile(); + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&Apache::grades::username_to_idmap($classlist); + my $navmap=Apache::lonnavmaps::navmap->new(); + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,undef,1,0); + my (%scandata,%lastname,%bylast); + $r->print(' +
'."\n"); + + my @delayqueue; + my %completedstudents; + + my $count=&Apache::grades::get_todo_count($scanlines,$scan_data); + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron/Submissions Comparison Status', + 'Progress of Scantron Data/Submission Records Comparison',$count, + 'inline',undef,'checkscantron'); + my ($username,$domain,$uname,$started); + + &Apache::grades::scantron_get_maxbubble(); # Need the bubble lines array to parse. + + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, + 'Processing first student'); + my $start=&Time::HiRes::time(); + my $i=-1; + + while ($i<$scanlines->{'count'}) { + ($username,$domain,$uname)=('','',''); + $i++; + my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + if ($started) { + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + 'last student'); + } + $started=1; + my $scan_record= + &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data, + \%idmap,$i)) { + &Apache::grades::scantron_add_delay(\@delayqueue,$line, + 'Unable to find a student that matches',1); + next; + } + if (exists $completedstudents{$uname}) { + &Apache::grades::scantron_add_delay(\@delayqueue,$line, + 'Student '.$uname.' has multiple sheets',2); + next; + } + my $pid = $scan_record->{'scantron.ID'}; + $lastname{$pid} = $scan_record->{'scantron.LastName'}; + push(@{$bylast{$lastname{$pid}}},$pid); + my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; + $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos); + chomp($scandata{$pid}); + $scandata{$pid} =~ s/\r$//; + ($username,$domain)=split(/:/,$uname); + my $counter = -1; + my (%expected,%startpos); + foreach my $resource (@resources) { + next if (!$resource->is_problem()); + my $symb = $resource->symb(); + my $partsref = $resource->parts(); + my @parts; + my @part_ids = (); + if (ref($partsref) eq 'ARRAY') { + @parts = @{$partsref}; + foreach my $part (@parts) { + my @resp_ids = $resource->responseIds($part); + foreach my $resp (@resp_ids) { + $counter ++; + my $part_id = $part.'.'.$resp; + $expected{$part_id} = 0; + push(@part_ids,$part_id); + if ($env{"form.scantron.sub_bubblelines.$counter"}) { + my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"}); + foreach my $item (@sub_lines) { + $expected{$part_id} += $item; + } + } else { + $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"}; + } + $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"}; + } + } + } + if ($symb) { + my %recorded; + my (%returnhash) = + &Apache::lonnet::restore($symb,$cid,$domain,$username); + if ($returnhash{'version'}) { + my %lasthash=(); + my $version; + for ($version=1;$version<=$returnhash{'version'};$version++) { + foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) { + $lasthash{$key}=$returnhash{$version.':'.$key}; + } + } + foreach my $key (keys(%lasthash)) { + if ($key =~ /\.scantron$/) { + my $value = &unescape($lasthash{$key}); + my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/); + if ($value eq '') { + for (my $i=0; $i<$expected{$part_id}; $i++) { + for (my $j=0; $j<$scantron_config{'length'}; $j++) { + $recorded{$part_id} .= $; + } + } + } else { + my @tocheck; + my @items = split(//,$value); + if (($scantron_config{'Qon'} eq 'letter') || + ($scantron_config{'Qon'} eq 'number')) { + if (@items < $expected{$part_id}) { + my $fragment = substr($scandata{$pid},$startpos{$part_id},$expected{$part_id}); + my @singles = split(//,$fragment); + foreach my $pos (@singles) { + if ($pos eq ' ') { + push(@tocheck,$pos); + } else { + my $next = shift(@items); + push(@tocheck,$next); + } + } + } else { + @tocheck = @items; + } + foreach my $letter (@tocheck) { + if ($scantron_config{'Qon'} eq 'letter') { + if ($letter !~ /^[A-J]$/) { + $letter = $scantron_config{'Qoff'}; + } + $recorded{$part_id} .= $letter; + } elsif ($scantron_config{'Qon'} eq 'number') { + my $digit; + if ($letter !~ /^[A-J]$/) { + $digit = $scantron_config{'Qoff'}; + } else { + $digit = $lettdig{$letter}; + } + $recorded{$part_id} .= $digit; + } + } + } else { + @tocheck = @items; + for (my $i=0; $i<$expected{$part_id}; $i++) { + my $curr_sub = shift(@tocheck); + my $digit; + if ($curr_sub =~ /^[A-J]$/) { + $digit = $lettdig{$curr_sub}-1; + } + if ($curr_sub eq 'J') { + $digit += scalar($numletts); + } + for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) { + if ($j == $digit) { + $recorded{$part_id} .= $scantron_config{'Qon'}; + } else { + $recorded{$part_id} .= $scantron_config{'Qoff'}; + } + } + } + } + } + } + } + } + foreach my $part_id (@part_ids) { + if ($recorded{$part_id} eq '') { + for (my $i=0; $i<$expected{$part_id}; $i++) { + for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) { + $recorded{$part_id} .= $scantron_config{'Qoff'}; + } + } + } + $record{$pid} .= $recorded{$part_id}; + } + } + } + } + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + $r->print('
'); + my ($okstudents,$badstudents,$numstudents,$passed,$failed); + $passed = 0; + $failed = 0; + $numstudents = 0; + foreach my $last (sort(keys(%bylast))) { + if (ref($bylast{$last}) eq 'ARRAY') { + foreach my $pid (sort(@{$bylast{$last}})) { + my $showscandata = $scandata{$pid}; + my $showrecord = $record{$pid}; + $showscandata =~ s/\s/ /g; + $showrecord =~ s/\s/ /g; + if ($scandata{$pid} eq $record{$pid}) { + my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row'; + $okstudents .= ''. +''.&mt('Scantron').''.$showscandata.''.$last.''.$pid.''."\n". +''."\n". +''."\n". +'Submissions'.$showrecord.''."\n"; + $passed ++; + } else { + my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row'; + $badstudents .= ''.&mt('Scantron').''.$scandata{$pid}.''.$last.''.$pid.''."\n". +''."\n". +''."\n". +'Submissions'.$record{$pid}.''."\n". +''."\n"; + $failed ++; + } + $numstudents ++; + } + } + } + $r->print('

'.&mt('Comparison of scantron data (including corrections) with corresponding submission records (most recent submission) for [quant,_1,student] ([_2] scantron lines/student).',$numstudents,$env{'form.scantron_maxbubble'}).'

'); + $r->print('

'.&mt('Exact matches for [quant,_1,student].',$passed).'
'.&mt('Discrepancies detected for [quant,_1,student].',$failed).'

'); + if ($passed) { + $r->print(&mt('Students with exact correspondence between scantron data and submissions are as follows:').'

'); + $r->print(&Apache::loncommon::start_data_table()."\n". + &Apache::loncommon::start_data_table_header_row()."\n". + ''.&mt('Source').''.&mt('Bubble records').''.&mt('Name').''.&mt('ID').''. + &Apache::loncommon::end_data_table_header_row()."\n". + $okstudents."\n". + &Apache::loncommon::end_data_table().'
'); + } + if ($failed) { + $r->print(&mt('Students with differences between scantron data and submissions are as follows:').'

'); + $r->print(&Apache::loncommon::start_data_table()."\n". + &Apache::loncommon::start_data_table_header_row()."\n". + ''.&mt('Source').''.&mt('Bubble records').''.&mt('Name').''.&mt('ID').''. + &Apache::loncommon::end_data_table_header_row()."\n". + $badstudents."\n". + &Apache::loncommon::end_data_table()).'
'. + &mt('Differences can occur if submissions were modified using manual grading after a scantron grading pass.').'
'.&mt('If unexpected discrepancies were detected, it is recommended that you inspect the original scantron sheets.'); + } + $r->print('

'.$grading_menu_button); + return; +} + =pod =back @@ -7781,25 +8166,25 @@ sub grading_menu { }); $fields{'command'} = 'csvform'; $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); - push (@menu, { url => $url, + push(@menu, { url => $url, name => &mt('Upload Scores'), short_description => &mt('Specify a file containing the class scores for current resource.')}); $fields{'command'} = 'processclicker'; $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); - push (@menu, { url => $url, + push(@menu, { url => $url, name => &mt('Process Clicker'), short_description => &mt('Specify a file containing the clicker information for this resource.')}); $fields{'command'} = 'scantron_selectphase'; $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); - push (@menu, { url => $url, - name => &mt('Grade/Manage Scantron Forms'), + push(@menu, { url => $url, + name => &mt('Grade/Manage/Review Scantron Forms'), short_description => - &mt('')}); + &mt('Grade scantron exams, upload/download scantron data files, and review previously graded scantron exams.')}); $fields{'command'} = 'verify'; $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); - push (@menu, { url => "", + push(@menu, { url => "", name => &mt('Verify Receipt'), short_description => &mt('')}); @@ -7955,7 +8340,7 @@ GRADINGMENUJS
$personnel
+
+
    +

@@ -8240,6 +8630,19 @@ sub process_clicker_file { $result.=''.&mt('You need to specify a clicker ID for the correct answer').''; return $result.&show_grading_menu_form($symb); } + if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\S/)) { + $result.=''.&mt('You need to specify the correct answer').''; + return $result.&show_grading_menu_form($symb); + } + my $foundgiven=0; + if ($env{'form.gradingmechanism'} eq 'given') { + $env{'form.givenanswer'}=~s/^\s*//gs; + $env{'form.givenanswer'}=~s/\s*$//gs; + $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-]+/\,/g; + $env{'form.givenanswer'}=uc($env{'form.givenanswer'}); + my @answers=split(/\,/,$env{'form.givenanswer'}); + $foundgiven=$#answers+1; + } my %clicker_ids=&gather_clicker_ids(); my %correct_ids; if ($env{'form.gradingmechanism'} eq 'personnel') { @@ -8258,6 +8661,8 @@ sub process_clicker_file { } if ($env{'form.gradingmechanism'} eq 'attendance') { $result.=&mt('Score based on attendance only'); + } elsif ($env{'form.gradingmechanism'} eq 'given') { + $result.=&mt('Score based on [_1] ([_2] answers)',''.$env{'form.givenanswer'}.'',$foundgiven); } else { my $number=0; $result.='

'.&mt('Correctness determined by the following IDs').''; @@ -8303,6 +8708,9 @@ sub process_clicker_file { ENDHEADER + if ($env{'form.gradingmechanism'} eq 'given') { + $result.=''; + } my %responses; my @questiontitles; my $errormsg=''; @@ -8318,6 +8726,10 @@ ENDHEADER &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', $env{'form.pcorrect'},$env{'form.pincorrect'}). '
'; + if (($env{'form.gradingmechanism'} eq 'given') && ($number!=$foundgiven)) { + $result.=''.&mt('Number of given answers does not agree with number of questions in file.').''; + return $result.&show_grading_menu_form($symb); + } # Remember Question Titles # FIXME: Possibly need delimiter other than ":" for (my $i=0;$i<$number;$i++) { @@ -8361,7 +8773,7 @@ ENDHEADER } $result.='

'. &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); - if ($env{'form.gradingmechanism'} ne 'attendance') { + if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) { if ($correct_count==0) { $errormsg.="Found no correct answers answers for grading!"; } elsif ($correct_count>1) { @@ -8432,7 +8844,7 @@ sub interwrite_eval { $id=~s/[\-\:]//g; $idresponses{$id}[$number]=$entries[6]; } - foreach my $id (keys %idresponses) { + foreach my $id (keys(%idresponses)) { $$responses{$id}=join(',',@{$idresponses{$id}}); $$responses{$id}=~s/^\s*\,//; } @@ -8506,10 +8918,15 @@ ENDHEADER if ($user) { my @answer=split(/\,/,$env{$key}); my $sum=0; + my $realnumber=$number; for (my $i=0;$i<$number;$i++) { if ($answer[$i]) { if ($gradingmechanism eq 'attendance') { $sum+=$pcorrect; + } elsif ($answer[$i] eq '*') { + $sum+=$pcorrect; + } elsif ($answer[$i] eq '-') { + $realnumber--; } else { if ($answer[$i] eq $correct[$i]) { $sum+=$pcorrect; @@ -8519,7 +8936,7 @@ ENDHEADER } } } - my $ave=$sum/(100*$number); + my $ave=$sum/(100*$realnumber); # Store my ($username,$domain)=split(/\:/,$user); my %grades=(); @@ -8658,6 +9075,8 @@ sub handler { } elsif ($command eq 'scantron_download' && &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { $request->print(&scantron_download_scantron_data($request)); + } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) { + $request->print(&checkscantron_results($request)); } elsif ($command) { $request->print("Access Denied ($command)"); } 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.