--- loncom/homework/grades.pm 2003/09/27 01:59:10 1.130.2.1.2.4 +++ loncom/homework/grades.pm 2007/11/13 01:47:36 1.489 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.130.2.1.2.4 2003/09/27 01:59:10 albertel Exp $ +# $Id: grades.pm,v 1.489 2007/11/13 01:47:36 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,16 +25,6 @@ # # http://www.lon-capa.org/ # -# 2/9,2/13 Guy Albertelli -# 6/8 Gerd Kortemeyer -# 7/26 H.K. Ng -# 8/20 Gerd Kortemeyer -# Year 2002 -# June-August H.K. Ng -# Year 2003 -# February, March H.K. Ng -# July, H. K. Ng -# package Apache::grades; use strict; @@ -45,55 +35,135 @@ use Apache::loncommon; use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; +use Apache::lonpickcode; use Apache::loncoursedata; -use Apache::lonmsg qw(:user_normal_msg); +use Apache::lonmsg(); use Apache::Constants qw(:common); +use Apache::lonlocal; +use Apache::lonenc; use String::Similarity; +use LONCAPA; + +use POSIX qw(floor); + -my %oldessays=(); my %perm=(); +my %bubble_lines_per_response = (); # no. bubble lines for each response. + # index is "symb.part_id" + +my %first_bubble_line = (); # First bubble line no. for each bubble. + +# Save and restore the bubble lines array to the form env. + + +sub save_bubble_lines { + foreach my $line (keys(%bubble_lines_per_response)) { + $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; + $env{"form.scantron.first_bubble_line.$line"} = + $first_bubble_line{$line}; + } +} + + +sub restore_bubble_lines { + my $line = 0; + %bubble_lines_per_response = (); + while ($env{"form.scantron.bubblelines.$line"}) { + my $value = $env{"form.scantron.bubblelines.$line"}; + $bubble_lines_per_response{$line} = $value; + $first_bubble_line{$line} = + $env{"form.scantron.first_bubble_line.$line"}; + $line++; + } + +} + +# Given the parsed scanline, get the response for +# 'answer' number n: + +sub get_response_bubbles { + my ($parsed_line, $response) = @_; + + + my $bubble_line = $first_bubble_line{$response-1} +1; + my $bubble_lines= $bubble_lines_per_response{$response-1}; + + my $selected = ""; + + for (my $bline = 0; $bline < $bubble_lines; $bline++) { + $selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; + $bubble_line++; + } + return $selected; +} + # ----- These first few routines are general use routines.---- + +# Return the number of occurences of a pattern in a string. + +sub occurence_count { + my ($string, $pattern) = @_; + + my @matches = ($string =~ /$pattern/g); + + return scalar(@matches); +} + + +# Take a string known to have digits and convert all the +# digits into letters in the range J,A..I. + +sub digits_to_letters { + my ($input) = @_; + + my @alphabet = ('J', 'A'..'I'); + + my @input = split(//, $input); + my $output =''; + for (my $i = 0; $i < scalar(@input); $i++) { + if ($input[$i] =~ /\d/) { + $output .= $alphabet[$input[$i]]; + } else { + $output .= $input[$i]; + } + } + return $output; +} + # -# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +# --- Retrieve the parts 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); + my ($symb) = @_; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my $url = $res->src(); + my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys')); + + my @stores; + foreach my $part (@{ $partlist }) { + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } } } - return @parts; + return @stores; } # --- 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); - my $fullname; - my ($tmp) = keys(%name); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname = &Apache::loncoursedata::ProcessFullName - (@name{qw/lastname generation firstname middlename/}); - } else { - &Apache::lonnet::logthis('grades.pm: no name data for '.$uname. - '@'.$udom.':'.$tmp); +sub get_symb { + my ($request,$silent) = @_; + (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 '') { + if (!$silent) { + $request->print("Unable to handle ambiguous references:$url:."); + return (); + } } - return $fullname; + &Apache::lonenc::check_decrypt(\$symb); + return ($symb); } #--- Format fullname, username:domain if different for display @@ -101,91 +171,267 @@ sub get_fullname { sub nameUserString { my ($type,$fullname,$uname,$udom) = @_; if ($type eq 'header') { - return ' Fullname (Username) '; + return ' '.&mt('Fullname').' ('.&mt('Username').')'; } else { - return ' '.$fullname.' ('.$uname. - ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; + return ' '.$fullname.' ('.$uname. + ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; } } #--- 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,$symb) = shift; - $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq ''); - 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); - $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! - my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); - $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no'); - next if ($seen{$partid} > 0); - $seen{$partid}++; - push @partlist,$partid; - } + my ($symb) = shift; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my %vPart = + map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + next if (%vPart && !exists($vPart{$part})); + + 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 { + my ($partID,$symb)=@_; + my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); + if (defined($display) and $display ne '') { + $display.= " (id $partID)"; + } else { + $display=$partID; } - return \@partlist,\%handgrade; + return $display; } #--- Show resource title #--- and parts and response type sub showResourceInfo { - my ($url,$probTitle) = @_; - my $result ='
Current Resource: '.$probTitle.' |
Part '.$partID.' | '. - 'Type: '.$responsetype.' | Handgrade: '.$handgrade.' | '; + my %partsseen; + 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.='|
"; + } else { + $result.=" | "; + } + $partsseen{$partID}=1; + } + my $display_part=&get_display_part($partID,$symb); + $result.=' | '.&mt('Part: [_1]',$display_part).' '. + $resID.' | '. + ''.&mt('Type: [_1]',$responsetype).' | '.&mt('Handgrade: [_1]',$handgrade).' | '; + } } $result.='
'; - } - if ($response eq 'essay') { - if (! exists ($ENV{'form.'.$symb})) { + ''. - '
'. - ' Answer '. - (join ' ',@ans).' '. - ' '.$grayFont.'Option ID '.$grayFont. - (join ' '.$grayFont,@IDs).'
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { + if (exists($answer{$foil})) { + if ($foil eq $correct) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''. + ' '.$grayFont.&mt('Item ID').' '. + $middlerow.''.' '.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'; + } elsif ($response eq 'essay') { + if (! exists ($env{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); - my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; - $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; - $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; - $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; - $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; - $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. - } - return ''. + '
'. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. + $grayFont.$bottomrow.'
'.&keywords_highlight($answer).''; + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; + $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. + } + $answer =~ s-\n-
'.&keywords_highlight($answer).''; + } elsif ( $response eq 'organic') { + my $result='Smile representation: "'.$answer.'"'; + my $jme=$record->{$version."resource.$partid.$respid.molecule"}; + $result.=&Apache::chemresponse::jme_img($jme,$answer,400); + return $result; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'
'; + + $result .= ''."\n";
- $result.='
'."\n"; - $result.=&show_grading_menu_form($symb,$url); + $result.=&show_grading_menu_form($symb); return $result; } sub csvuploadmap { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); if (!$symb) {return '';} my $datatoken; - if (!$ENV{'form.datatoken'}) { + if (!$env{'form.datatoken'}) { $datatoken=&Apache::loncommon::upfile_store($request); } else { - $datatoken=$ENV{'form.datatoken'}; + $datatoken=$env{'form.datatoken'}; &Apache::loncommon::load_tmp_file($request); } my @records=&Apache::loncommon::upfile_record_sep(); - &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); + if ($env{'form.noFirstLine'}) { shift(@records); } + &csvuploadmap_header($request,$symb,$datatoken,$#records+1); my ($i,$keyfields); if (@records) { - my @fields=&csvupload_fields($url); + my @fields=&csvupload_fields($symb); - if ($ENV{'form.upfile_associate'} eq 'reverse') { + if ($env{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($request,\@records); $i=&Apache::loncommon::csv_print_select_table($request,\@records, \@fields); @@ -2611,47 +3885,122 @@ sub csvuploadmap { unshift(@fields,['none','']); $i=&Apache::loncommon::csv_samples_select_table($request,\@records, \@fields); - my %sone=&Apache::loncommon::record_sep($records[0]); - $keyfields=join(',',sort(keys(%sone))); + foreach my $rec (@records) { + my %temp = &Apache::loncommon::record_sep($rec); + if (%temp) { + $keyfields=join(',',sort(keys(%temp))); + last; + } + } } } &csvuploadmap_footer($request,$i,$keyfields); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(&show_grading_menu_form($symb)); return ''; } -sub csvuploadassign { +sub csvuploadoptions { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - &Apache::loncommon::load_tmp_file($request); - my @gradedata = &Apache::loncommon::upfile_record_sep(); - my @keyfields = split(/\,/,$ENV{'form.keyfields'}); - my %fields=(); - for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) { - if ($ENV{'form.upfile_associate'} eq 'reverse') { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$keyfields[$i]}=$ENV{'form.f'.$i}; + my ($symb)=&get_symb($request); + my $checked=(($env{'form.noFirstLine'})?'1':'0'); + my $ignore=&mt('Ignore First Line'); + $request->print(< Uploading Class Grade Options+ + ++ + +ENDPICK + my %fields=&get_fields(); + if (!defined($fields{'domain'})) { + my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); + $request->print("\nUsers are in domain: ".$domform." \n"); + } + foreach my $key (sort(keys(%env))) { + if ($key !~ /^form\.(.*)$/) { next; } + my $cleankey=$1; + if ($cleankey eq 'command') { next; } + $request->print(''."\n"); + } + # FIXME do a check for any duplicated user ids... + # FIXME do a check for any invalid user ids?... + $request->print('+ '."\n"); + $request->print(&show_grading_menu_form($symb)); + return ''; +} + +sub get_fields { + my %fields; + my @keyfields = split(/\,/,$env{'form.keyfields'}); + for (my $i=0; $i<=$env{'form.nfields'}; $i++) { + if ($env{'form.upfile_associate'} eq 'reverse') { + if ($env{'form.f'.$i} ne 'none') { + $fields{$keyfields[$i]}=$env{'form.f'.$i}; } } else { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$ENV{'form.f'.$i}}=$keyfields[$i]; + if ($env{'form.f'.$i} ne 'none') { + $fields{$env{'form.f'.$i}}=$keyfields[$i]; } } } + return %fields; +} + +sub csvuploadassign { + my ($request)= @_; + my ($symb)=&get_symb($request); + if (!$symb) {return '';} + my $error_msg = ''; + &Apache::loncommon::load_tmp_file($request); + my @gradedata = &Apache::loncommon::upfile_record_sep(); + if ($env{'form.noFirstLine'}) { shift(@gradedata); } + my %fields=&get_fields(); $request->print(' Assigning Grades'); - my $courseid=$ENV{'request.course.id'}; + my $courseid=$env{'request.course.id'}; my ($classlist) = &getclasslist('all',0); my @notallowed; my @skipped; my $countdone=0; foreach my $grade (@gradedata) { my %entries=&Apache::loncommon::record_sep($grade); + my $domain; + if ($entries{$fields{'domain'}}) { + $domain=$entries{$fields{'domain'}}; + } else { + $domain=$env{'form.default_domain'}; + } + $domain=~s/\s//g; my $username=$entries{$fields{'username'}}; - my $domain=$entries{$fields{'domain'}}; + $username=~s/\s//g; + if (!$username) { + my $id=$entries{$fields{'ID'}}; + $id=~s/\s//g; + my %ids=&Apache::lonnet::idget($domain,$id); + $username=$ids{$id}; + } if (!exists($$classlist{"$username:$domain"})) { - push(@skipped,"$username:$domain"); + my $id=$entries{$fields{'ID'}}; + $id=~s/\s//g; + if ($id) { + push(@skipped,"$id:$domain"); + } else { + push(@skipped,"$username:$domain"); + } next; } my $usec=$classlist->{"$username:$domain"}[5]; @@ -2659,34 +4008,70 @@ sub csvuploadassign { push(@notallowed,"$username:$domain"); next; } + my %points; my %grades; foreach my $dest (keys(%fields)) { - if ($dest eq 'username' || $dest eq 'domain') { next; } - if ($entries{$fields{$dest}} eq '') { next; } - my $store_key=$dest; - $store_key=~s/^stores/resource/; - $store_key=~s/_/\./g; - $grades{$store_key}=$entries{$fields{$dest}}; - } - $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}"; - &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'}, - $domain,$username); - $request->print('.'); + if ($dest eq 'ID' || $dest eq 'username' || + $dest eq 'domain') { next; } + if ($entries{$fields{$dest}} =~ /^\s*$/) { next; } + if ($dest=~/stores_(.*)_points/) { + my $part=$1; + my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', + $symb,$domain,$username); + if ($wgt) { + $entries{$fields{$dest}}=~s/\s//g; + my $pcr=$entries{$fields{$dest}} / $wgt; + my $award=($pcr == 0) ? 'incorrect_by_override' + : 'correct_by_override'; + $grades{"resource.$part.awarded"}=$pcr; + $grades{"resource.$part.solved"}=$award; + $points{$part}=1; + } else { + $error_msg = "" . + &mt("Some point values were assigned" + ." for problems with a weight " + ."of zero. These values were " + ."ignored."); + } + } else { + if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } + if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } + my $store_key=$dest; + $store_key=~s/^stores/resource/; + $store_key=~s/_/\./g; + $grades{$store_key}=$entries{$fields{$dest}}; + } + } + if (! %grades) { push(@skipped,"$username:$domain no data to save"); } + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $result=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($result eq 'ok') { + $request->print('.'); + } else { + $request->print(" + + Failed to save student $username:$domain. + Message when trying to save was ($result) + + " ); + } $request->rflush(); $countdone++; } - $request->print("Stored $countdone students\n"); + $request->print(" Saved $countdone students\n"); if (@skipped) { - $request->print(' Skipped Students '); + $request->print('Skipped Students'); foreach my $student (@skipped) { $request->print("$student\n"); } } if (@notallowed) { - $request->print(' Students Not Allowed to Modify '); + $request->print('Students Not Allowed to Modify '); foreach my $student (@notallowed) { $request->print("$student\n"); } } $request->print(" \n"); - $request->print(&show_grading_menu_form($symb,$url)); - return ''; + $request->print(&show_grading_menu_form($symb)); + return $error_msg; } #------------- end of section for handling csv file upload --------- # @@ -2715,27 +4100,31 @@ function checkPickOne(formname) { LISTJAVASCRIPT &commonJSfunctions($request); - my ($symb,$url) = &get_symb_and_url($request); - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; - my $result=' '. - 'Manual Grading by Page or Sequence'; + my $result=''. + &mt('Manual Grading by Page or Sequence').''; $result.='\n"; + $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -2746,78 +4135,95 @@ LISTJAVASCRIPT $result.=''."\n". ''."\n"; - $result.=' View Problems Text: no '."\n". - ' yes '." \n"; - - $result.=' Submission Details: '. - ' none'."\n". - ' by dates and submissions'."\n". - ' all details'."\n"; - - $result.=''."\n". - ''."\n". + my $options = + ''."\n". + ''." \n"; + $result.=' '.&mt('View Problems Text: [_1]',$options); + + $options = + ''."\n". + ''."\n". + ''."\n"; + $result.=' '.&mt('Submission Details: [_1]',$options); + + $result.=&build_section_inputs(); + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + $result.=''."\n". ''."\n". - ''."\n". - ''."\n". - ''." \n"; + ''."\n". + ''." \n"; + + $result.=' '.&mt('Use CODE: [_1] ', + ''). + ' '."\n"; $result.=' " /> '."\n"; + 'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next->').'" /> '."\n"; $request->print($result); - my $studentTable.=' Select a student you wish to grade and then click on the Next button. '. - '
| '. + &Apache::loncommon::end_data_table_row(); + } + $studentTable.=&Apache::loncommon::end_data_table()."\n"; $studentTable.='" />'."\n"; + 'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next->').'" />'."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; } sub getSymbMap { - my ($request) = @_; - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db'); -# $navmap->init(); + my $navmap = Apache::lonnavmaps::navmap->new(); my %symbx = (); my @titles = (); my $minder = 0; # Gather every sequence that has problems. - my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 1); + my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, + 1,0,1); for my $sequence ($navmap->getById('0.0'), @sequences) { if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { - my $title = $minder.'.'.$sequence->compTitle(); - push @titles, $title; # minder in case two titles are identical - $symbx{$title} = $sequence->symb(); + my $title = $minder.'.'. + &HTML::Entities::encode($sequence->compTitle(),'"\'&'); + push(@titles, $title); # minder in case two titles are identical + $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); $minder++; } } - - $navmap->untieHashes(); return \@titles,\%symbx; } @@ -2826,55 +4232,75 @@ sub getSymbMap { sub displayPage { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; - my $pageTitle = $ENV{'form.page'}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $pageTitle = $env{'form.page'}; my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); - my ($uname,$udom) = split(/:/,$ENV{'form.student'}); - my $usec=$classlist->{$ENV{'form.student'}}[5]; + my ($uname,$udom) = split(/:/,$env{'form.student'}); + my $usec=$classlist->{$env{'form.student'}}[5]; + + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $env{'course.'.$env{'request.course.id'}.'.num'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + if (!&canview($usec)) { - $request->print('Unable to view requested student.('.$ENV{'form.student'}.')'); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(''.&mt('Unable to view requested student. ([_1])',$env{'form.student'}).''); + $request->print(&show_grading_menu_form($symb)); return; } - my $result=' | Prob. | '. + ''.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').' | '. + &Apache::loncommon::end_data_table_header_row(); - $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. - ' symbol.'."\n". - '
---|
'.
- '
'.$ENV{'form.title'}.''; - $result.=' Student: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom).
+ my $result=' |
+ '.&Apache::loncommon::end_data_table_row().'
+ '.&Apache::loncommon::end_data_table().'
+');
+ }
+
+ # Chunk of the form that prompts to view a scoring office file,
+ # corrected file, skipped records in a file.
+
+ $r->print('
+
'.
- '
|
-
|
-
checking studnet -'.$id.'- againt -'.$scanID.'-'); - if (lc($id) eq lc($scanID)) { - #Apache->request->print('success'); - return $$idmap{$id}; - } + if (lc($id) eq lc($scanID)) { + return $$idmap{$id}; + } } return undef; } +=pod + +=item scantron_filter + + Filter sub for lonnavmaps, filters out hidden resources if ignore + hidden resources was selected + +=cut + sub scantron_filter { my ($curres)=@_; - if (ref($curres) && $curres->is_problem() && !$curres->randomout) { + + if (ref($curres) && $curres->is_problem()) { + # if the user has asked to not have either hidden + # or 'randomout' controlled resources to be graded + # don't include them + if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' + && $curres->randomout) { + return 0; + } return 1; } return 0; } -#FIXME I think I am doing this in the wrong order, I think it would be -#better to make a several passes analyzing all of the lines in the -#file for common errors wrong/invalid PID/username duplicated -#PID/username, missing bubbles, double bubbles, missing/invalid CODE -#and then get the instructor to fix all of these errors, then grade -#the corrected one, I'll still need to catch error conditions, but -#maybe most will taken care even before we start +=pod + +=item scantron_process_corrections + + Gets correction information out of submitted form data and corrects + the scanline + +=cut sub scantron_process_corrections { my ($r) = @_; - if ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my $scanlines=&scantron_getfile(); - my $classlist=&Apache::loncoursedata::get_classlist(); - my $which=$ENV{'form.scantron_line'}; - my $line=&scantron_get_line($scanlines,$which); - my ($skip,$err,$errmsg); - if ($ENV{'form.scantron_skip_record'}) { - $skip=1; - } else { - my $newstudent=$ENV{'form.scantron_username'}.':'. - $ENV{'form.scantron_domain'}; - my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my ($scanlines,$scan_data)=&scantron_getfile(); + my $classlist=&Apache::loncoursedata::get_classlist(); + my $which=$env{'form.scantron_line'}; + my $line=&scantron_get_line($scanlines,$scan_data,$which); + my ($skip,$err,$errmsg); + if ($env{'form.scantron_skip_record'}) { + $skip=1; + } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { + my $newstudent=$env{'form.scantron_username'}.':'. + $env{'form.scantron_domain'}; + my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, + 'ID',{'newid'=>$newid, + 'username'=>$env{'form.scantron_username'}, + 'domain'=>$env{'form.scantron_domain'}}); + } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { + my $resolution=$env{'form.scantron_CODE_resolution'}; + my $newCODE; + my %args; + if ($resolution eq 'use_unfound') { + $newCODE='use_unfound'; + } elsif ($resolution eq 'use_found') { + $newCODE=$env{'form.scantron_CODE_selectedvalue'}; + } elsif ($resolution eq 'use_typed') { + $newCODE=$env{'form.scantron_CODE_newvalue'}; + } elsif ($resolution =~ /^use_closest_(\d+)/) { + $newCODE=$env{"form.scantron_CODE_closest_$1"}; + } + if ($env{'form.scantron_corrections'} eq 'duplicateCODE') { + $args{'CODE_ignore_dup'}=1; + } + $args{'CODE'}=$newCODE; + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, + 'CODE',\%args); + } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { + foreach my $question (split(',',$env{'form.scantron_questions'})) { ($line,$err,$errmsg)= - &scantron_fixup_scanline(\%scantron_config,$line,'ID',$newid); + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, + $which,'answer', + { 'question'=>$question, + 'response'=>$env{"form.scantron_correct_Q_$question"}}); + if ($err) { last; } } - if ($err) { - $r->print("Unable to accept last correction, an error occurred :$errmsg:"); - } else { - &scantron_put_line($scanlines,$which,$line,$skip); - &scantron_putfile($scanlines); + } + if ($err) { + $r->print("Unable to accept last correction, an error occurred :$errmsg:"); + } else { + &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); + &scantron_putfile($scanlines,$scan_data); + } +} + +=pod + +=item reset_skipping_status + + Forgets the current set of remember skipped scanlines (and thus + reverts back to considering all lines in the + scantron_skipped_
Sequence to be Graded: | $title |
Data File that will be used: | $env{'form.scantron_selectfile'} |
If this information is correct, please click on '$button_text'.
+If something is incorrect, please click the 'Grading Menu' button to start over.
+ +You have forgetten to specify some information. Please go Back and try again.
"); + if ( $env{'form.selectpage'} eq '') { + $r->print('You have not selected a Sequence to grade
'); + } + if ( $env{'form.scantron_selectfile'} eq '') { + $r->print('You have not selected a file that contains the student\'s response data.
'); + } + if ( $env{'form.scantron_format'} eq '') { + $r->print('You have not selected a the format of the student\'s response data.
'); + } + } else { + my $warning=&scantron_warning_screen('Grading: Validate Records'); + $r->print(<Gathering necessary info.
");$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $result= <Validating ".$validate_phases[$currentphase]."
"); + $r->rflush(); my $which="scantron_validate_".$validate_phases[$currentphase]; { no strict 'refs'; ($stop,$currentphase)=&$which($r,$currentphase); } } - $r->print(""); + if (!$stop) { + my $warning=&scantron_warning_screen('Start Grading'); + $r->print(<Or click the 'Grading Menu' button to start over.
"); + } else { + $r->print(''); + $r->print(' using corrected info".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."
"); + return (1,$currentphase); + } + } + + return (0,$currentphase+1); +} + +=pod + +=item scantron_validate_ID + + Validates all scanlines in the selected file to not have any + invalid or underspecified student IDs + +=cut + sub scantron_validate_ID { my ($r,$currentphase) = @_; @@ -3535,102 +6406,464 @@ sub scantron_validate_ID { my %idmap=&username_to_idmap($classlist); #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my $scanlines=&scantron_getfile(); + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my ($scanlines,$scan_data)=&scantron_getfile(); + + &scantron_get_maxbubble(); # parse needs the bubble_lines.. array. my %found=('ids'=>{},'usernames'=>{}); for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$i); - if (!$line) { next; } - my $scan_record=&scantron_parse_scanline($line,\%scantron_config); + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); my $id=$$scan_record{'scantron.ID'}; - $r->print("Checking ID ".$$scan_record{'scantron.ID'}. - " on paper ID ".$$scan_record{'scantron.PaperID'}."
\n"); my $found; foreach my $checkid (keys(%idmap)) { - if (lc($checkid) eq lc($id)) { - if ($checkid ne $id) { - $r->print("Using $checkid for encoded $id
\n"); - } - $found=$checkid;last; - } + if (lc($checkid) eq lc($id)) { $found=$checkid;last; } } if ($found) { + my $username=$idmap{$found}; if ($found{'ids'}{$found}) { - #FIXME store away line we prviously saw the ID on - &scantron_get_correction($r,$i,$scan_record,$line, - 'duplicateID',$found); - return(1); + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$found); + return(1,$currentphase); + } elsif ($found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$username); + return(1,$currentphase); + } + #FIXME store away line we previously saw the ID on to use above + $found{'ids'}{$found}++; + $found{'usernames'}{$username}++; + } else { + if ($id =~ /^\s*$/) { + my $username=&scan_data($scan_data,"$i.user"); + if (defined($username) && $found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateID',$username); + return(1,$currentphase); + } elsif (!defined($username)) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectID'); + return(1,$currentphase); + } + $found{'usernames'}{$username}++; } else { - $found{'ids'}{$found}++; + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'incorrectID'); + return(1,$currentphase); } - } else { - &scantron_get_correction($r,$i,$scan_record,$line, - 'incorrectID'); - return(1); } } return (0,$currentphase+1); } +=pod + +=item scantron_get_correction + + Builds the interface screen to interact with the operator to fix a + specific error condition in a specific scanline + + Arguments: + $r - Apache request object + $i - number of the current scanline + $scan_record - hash ref as returned from &scantron_parse_scanline() + $scan_config - hash ref as returned from &get_scantron_config() + $line - full contents of the current scanline + $error - error condition, valid values are + 'incorrectCODE', 'duplicateCODE', + 'doublebubble', 'missingbubble', + 'duplicateID', 'incorrectID' + $arg - extra information needed + For errors: + - duplicateID - paper number that this studentID was seen before on + - duplicateCODE - array ref of the paper numbers this CODE was + seen on before + - incorrectCODE - current incorrect CODE + - doublebubble - array ref of the bubble lines that have double + bubble errors + - missingbubble - array ref of the bubble lines that have missing + bubble errors + +=cut + sub scantron_get_correction { - my ($r,$i,$scan_record,$line,$error,$arg)=@_; + my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; -#FIXME in the case of a duplicated ID the previous line, probaly need +#FIXME in the case of a duplicated ID the previous line, probably need #to show both the current line and the previous one and allow skipping #the previous one or the current one - $r->print("This scantron record has an error."); - if ( defined($$scan_record{'scantron.PaperID'}) ) { - $r->print("The current PaperID is ". + $r->print("
An error was detected ($error)"); + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { + $r->print(" for PaperID ". $$scan_record{'scantron.PaperID'}." \n"); } else { - $r->print("The current scanline is
". + $r->print(" in scanline $i". $line."\n"); } + my $message="The ID on the form is ". + $$scan_record{'scantron.ID'}."
"; + $r->print(''."\n"); $r->print(''."\n"); if ($error =~ /ID$/) { - if ($error eq 'unknownID') { + if ($error eq 'incorrectID') { $r->print("The encoded ID is not in the classlist\n"); } elsif ($error eq 'duplicateID') { $r->print("The encoded ID has also been used by a previous paper $arg\n"); } - $r->print("
\n". + "The name on the paper is ". + $$scan_record{'scantron.LastName'}.",". + $$scan_record{'scantron.FirstName'}."Original ID is ".$$scan_record{'scantron.ID'}. - "
"); - $r->print("
\n"); - $r->print("Name on paper is ".$$scan_record{'scantron.LastName'}.",". - $$scan_record{'scantron.FirstName'}."Please correct
\n"); - $r->print("\n
How should I handle this?
\n");
+ $r->print("\n
The encoded CODE is not in the list of possible CODEs
\n"); + } elsif ($error eq 'duplicateCODE') { + $r->print("The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique
\n"); + } + $r->print("The CODE on the form is '".
+ $$scan_record{'scantron.CODE'}."'
\n");
+ $r->print($message);
+ $r->print("
How should I handle this? There have been multiple bubbles scanned for a some question(s) Please indicate which bubble should be used for grading There have been no bubbles scanned for some question(s) Please indicate which bubble should be used for grading For question $question, selected bubbles were".
- join(" ",split('',$selected)).
- " Please pick which one should be used for grading");
- #FIXMENEXT need to have radio buttons to chose which one to use
+ my $selected = &get_response_bubbles($scan_record, $question);
+ my @select_array = split(/:/,$selected); # ought to be an array of empties.
+ &scantron_bubble_selector($r,$scan_config,$question, @select_array);
+ }
+ } else {
+ $r->print("\n
\n");
+ $r->print("\n
");
+ my $i=0;
+ if ($error eq 'incorrectCODE'
+ && $$scan_record{'scantron.CODE'}=~/\S/ ) {
+ my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'});
+ if ($closest > 0) {
+ foreach my $testcode (@{$closest}) {
+ my $checked='';
+ if (!$i) { $checked=' checked="checked" '; }
+ $r->print("");
+ $r->print("\n
");
+ $i++;
+ }
+ }
+ }
+ if ($$scan_record{'scantron.CODE'}=~/\S/ ) {
+ my $checked; if (!$i) { $checked=' checked="checked" '; }
+ $r->print("");
+ $r->print("\n
");
+ }
+
+ $r->print(<
");
+ }
+ $r->print(" as the CODE.");
+ $r->print("\n
");
} elsif ($error eq 'doublebubble') {
- $r->print("There have been muttiple bubbles scanned for a single question\n");
+ $r->print("");
+ }
+ $r->print("\n
$quest | "); + + for (my $l = 0; $l < $lines; $l++) { + if ($l != 0) { + $r->print('|
'); + if ($selected[0] eq $alphabet[$i]) { + $r->print('X'); + shift(@selected) ; + } else { + $r->print(' '); + } + $r->print(' | '); } + + if ($l == 0) { + my $lspan = $total_lines * 2; # 2 table rows per bubble line. + + $r->print(''); + + } + + $r->print(' |
"); + } + $r->print(' |
line is'.$line.''); + my $i=-1; + my ($uname,$udom,$started); - chomp($line); - my $scan_record=&scantron_parse_scanline($line,\%scantron_config); - my ($uname,$udom); - unless ($uname=&scantron_find_student($scan_record,\%idmap)) { - &scantron_add_delay(\@delayqueue,$line, - 'Unable to find a student that matches',1); - next; - } - if (exists $completedstudents{$uname}) { - &scantron_add_delay(\@delayqueue,$line, - 'Student '.$uname.' has multiple sheets',2); - next; + &scantron_get_maxbubble(); # Need the bubble lines array to parse. + + while ($i<$scanlines->{'count'}) { + ($uname,$udom)=('',''); + $i++; + my $line=&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=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + unless ($uname=&scantron_find_student($scan_record,$scan_data, + \%idmap,$i)) { + &scantron_add_delay(\@delayqueue,$line, + 'Unable to find a student that matches',1); + next; + } + if (exists $completedstudents{$uname}) { + &scantron_add_delay(\@delayqueue,$line, + 'Student '.$uname.' has multiple sheets',2); + next; + } + ($uname,$udom)=split(/:/,$uname); + + &Apache::lonxml::clear_problem_counter(); + &Apache::lonnet::appenv(%$scan_record); + + if (&scantron_clear_skip($scanlines,$scan_data,$i)) { + &scantron_putfile($scanlines,$scan_data); } - $r->print('
doing studnet'.$uname.''); - ($uname,$udom)=split(/:/,$uname); - &Apache::lonnet::delenv('form.counter'); - &Apache::lonnet::appenv(%$scan_record); -# &Apache::lonhomework::showhash(%ENV); -# $Apache::lonxml::debug=1; -# &Apache::lonxml::debug("line is $line"); - my $i=0; + my $i=0; foreach my $resource (@resources) { $i++; - my $result=&Apache::lonnet::ssi($resource->src(), - ('submitted' =>'scantron', - 'grade_target' =>'grade', - 'grade_username'=>$uname, - 'grade_domain' =>$udom, - 'grade_courseid'=>$ENV{'request.course.id'}, - 'grade_symb' =>$resource->symb())); -# my %score=&Apache::lonnet::restore($resource->symb(), -# $ENV{'request.course.id'}, -# $udom,$uname); -# foreach my $part ($resource->{PARTS}) { -# if ($score{'resource.'.$part.'.solved'} =~ /^correct/) { -# $studentcorrect++; -# $totalcorrect++; -# } else { -# $studentincorrect++; -# $totalincorrect++; -# } -# } -# $r->print('
'. -# $resource->symb().'-'. -# $resource->src().'-'.'result is'.$result); -# &Apache::lonhomework::showhash(%score); - # if ($i eq 3) {last;} + my %form=('submitted' =>'scantron', + 'grade_target' =>'grade', + 'grade_username'=>$uname, + 'grade_domain' =>$udom, + 'grade_courseid'=>$env{'request.course.id'}, + 'grade_symb' =>$resource->symb()); + if (exists($scan_record->{'scantron.CODE'}) + && + &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) { + $form{'CODE'}=$scan_record->{'scantron.CODE'}; + } else { + $form{'CODE'}=''; + } + my $result=&Apache::lonnet::ssi($resource->src(),%form); + if ($result ne '') { + } + if (&Apache::loncommon::connection_aborted($r)) { last; } } $completedstudents{$uname}={'line'=>$line}; + if (&Apache::loncommon::connection_aborted($r)) { last; } } continue { - &Apache::lonnet::delenv('form.counter'); + &Apache::lonxml::clear_problem_counter(); &Apache::lonnet::delenv('scantron\.'); - &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, - 'last student'); - #last; - #FIXME - #get iterator for $sequence - #foreach question 'submit' the students answer to the server - # through grade target { - # generate data to pass back that includes grade recevied - #} } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); - my $lasttime = &Time::HiRes::time()-$start; - $r->print("
took $lasttime
"); +# my $lasttime = &Time::HiRes::time()-$start; +# $r->print("took $lasttime
"); - #$Apache::lonxml::debug=0; - foreach my $delay (@delayqueue) { - #FIXME - #print out each delayed student with interface to select how - # to repair student provided info - #Expected errors include - # 1 bad/no stuid/username - # 2 invalid bubblings - + $r->print(""); + $r->print(&show_grading_menu_form($symb)); + return ''; +} + +=pod + +=item scantron_upload_scantron_data + + Creates the screen for adding a new bubble sheet data file to a course. + +=cut + +sub scantron_upload_scantron_data { + my ($r)=@_; + $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'})); + my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', + 'domainid', + 'coursename'); + my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, + 'domainid'); + my $default_form_data=&defaultFormData(&get_symb($r,1)); + $r->print(<$select_link | |
Course ID: | |
Course Name: | |
Domain: | $domsel |
File to upload: |
+ Corrections, a file of corrected records that were used in grading. +
++ Skipped, a file of records that were skipped. +
+DOWNLOAD + $r->print(&show_grading_menu_form(&get_symb($r,1))); + return ''; +} + +=pod + +=back + +=cut + #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- - #-------------------------- Menu interface ------------------------- # #--- Show a Grading Menu button - Calls the next routine --- sub show_grading_menu_form { - my ($symb,$url)=@_; + my ($symb)=@_; my $result.=''."\n".
- '
|
'."\n";
+ $result.='
|
'.&mt('Correctness determined by the following IDs').'';
+ foreach my $id (sort(keys(%correct_ids))) {
+ $result.='
'.$id.' - ';
+ if ($correct_ids{$id} eq 'specified') {
+ $result.=&mt('specified');
+ } else {
+ my ($uname,$udom)=split(/\:/,$correct_ids{$id});
+ $result.=&Apache::loncommon::plainname($uname,$udom);
+ }
+ $number++;
+ }
+ $result.="
+
|
+
|