--- loncom/homework/grades.pm 2007/07/19 09:52:59 1.422 +++ loncom/homework/grades.pm 2007/11/16 07:56:15 1.492 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.422 2007/07/19 09:52:59 foxr Exp $ +# $Id: grades.pm,v 1.492 2007/11/16 07:56:15 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,6 +35,7 @@ use Apache::loncommon; use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; +use Apache::lonpickcode; use Apache::loncoursedata; use Apache::lonmsg(); use Apache::Constants qw(:common); @@ -45,36 +46,104 @@ 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 from the metadata file.--- sub getpartlist { my ($symb) = @_; - my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); - my $partorder = &Apache::lonnet::metadata($url, 'partorder'); - my @parts; - if ($partorder) { - for my $part (split (/,/,$partorder)) { - if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) { - push(@parts, $part); - } - } - } else { - my $metadata = &Apache::lonnet::metadata($url, 'packages'); - foreach (split(/\,/,$metadata)) { - if ($_ =~ /^part_(.*)$/) { - if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) { - push(@parts, $1); - } - } - } - } + + 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 (@parts) { - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $part (@{ $partlist }) { foreach my $key (@metakeys) { if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } } @@ -102,7 +171,7 @@ sub get_symb { 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.')').')'; @@ -185,32 +254,64 @@ sub showResourceInfo { $partsseen{$partID}=1; } my $display_part=&get_display_part($partID,$symb); - $result.='Part: '.$display_part.' '. + $result.=''.&mt('Part: [_1]',$display_part).' '. $resID.''. - 'Type: '.$responsetype.''; -# 'Handgrade: '.$handgrade.''; + ''.&mt('Type: [_1]',$responsetype).''; +# ''.&mt('Handgrade: [_1]',$handgrade).''; } } $result.=''."\n"; return $result,$responseType,$hdgrade,$partlist,$handgrade; } +sub reset_caches { + &reset_analyze_cache(); + &reset_perm(); +} + +{ + my %analyze_cache; -sub get_order { - my ($partid,$respid,$symb,$uname,$udom)=@_; - my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); - $url=&Apache::lonnet::clutter($url); - my $subresult=&Apache::lonnet::ssi($url, - ('grade_target' => 'analyze'), - ('grade_domain' => $udom), - ('grade_symb' => $symb), - ('grade_courseid' => - $env{'request.course.id'}), - ('grade_username' => $uname)); - (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); - my %analyze=&Apache::lonnet::str2hash($subresult); - return ($analyze{"$partid.$respid.shown"}); + sub reset_analyze_cache { + undef(%analyze_cache); + } + + sub get_analyze { + my ($symb,$uname,$udom)=@_; + 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=&Apache::lonnet::ssi($url, + ('grade_target' => 'analyze'), + ('grade_domain' => $udom), + ('grade_symb' => $symb), + ('grade_courseid' => + $env{'request.course.id'}), + ('grade_username' => $uname)); + (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); + return $analyze->{"$partid.$respid.shown"}; + } + + sub get_radiobutton_correct_foil { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my $analyze = &get_analyze($symb,$uname,$udom); + foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) { + if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { + return $foil; + } + } + } } + #--- Clean response type for display #--- Currently filters option/rank/radiobutton/match/essay/Task # response types only. @@ -231,8 +332,8 @@ sub cleanRecord { $bottomrow.=''.$grayFont.$foil.' '; } return '
'. - ''.$toprow.''. - ''. + ''.$toprow.''. + ''. $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'.&mt('Answer').'
'.$grayFont.&mt('Option ID').'
'; } elsif ($response eq 'match') { my %answer=&Apache::lonnet::str2hash($answer); @@ -251,31 +352,31 @@ sub cleanRecord { $bottomrow.=''.$grayFont.$foil.' '; } return '
'. - ''.$toprow.''. - ''. + ''.$toprow.''. + ''. $middlerow.''. - ''. + ''. $bottomrow.''.'
Answer
'.$grayFont.'Item ID
'.&mt('Answer').'
'.$grayFont.&mt('Item ID').'
'.$grayFont.'Option ID
'.$grayFont.&mt('Option ID').'
'; } elsif ($response eq 'radiobutton') { my %answer=&Apache::lonnet::str2hash($answer); my ($toprow,$bottomrow); - my $correct=($order->[0])+1; - for (my $i=1;$i<=$#$order;$i++) { - my $foil=$order->[$i]; + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { if (exists($answer{$foil})) { - if ($i == $correct) { - $toprow.='true'; + if ($foil eq $correct) { + $toprow.=''.&mt('true').''; } else { - $toprow.='true'; + $toprow.=''.&mt('true').''; } } else { - $toprow.='false'; + $toprow.=''.&mt('false').''; } $bottomrow.=''.$grayFont.$foil.' '; } return '
'. - ''.$toprow.''. - ''. + ''.$toprow.''. + ''. $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'.&mt('Answer').'
'.$grayFont.&mt('Option ID').'
'; } elsif ($response eq 'essay') { if (! exists ($env{'form.'.$symb})) { @@ -327,7 +428,10 @@ sub cleanRecord { $result.=''; return $result; } - + } elsif ( $response =~ m/(?:numerical|formula)/) { + $answer = + &Apache::loncommon::format_previous_attempt_value('submission', + $answer); } return $answer; } @@ -371,8 +475,10 @@ COMMONJSFUNCTIONS #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { - my ($getsec,$filterlist) = @_; + my ($getsec,$filterlist,$getgroup) = @_; my @getsec; + my @getgroup; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); if (!ref($getsec)) { if ($getsec ne '' && $getsec ne 'all') { @getsec=($getsec); @@ -381,10 +487,19 @@ sub getclasslist { @getsec=@{$getsec}; } if (grep(/^all$/,@getsec)) { undef(@getsec); } + if (!ref($getgroup)) { + if ($getgroup ne '' && $getgroup ne 'all') { + @getgroup=($getgroup); + } + } else { + @getgroup=@{$getgroup}; + } + if (grep(/^all$/,@getgroup)) { undef(@getgroup); } - my $classlist=&Apache::loncoursedata::get_classlist(); + my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist return if (! defined($classlist)); + &Apache::loncoursedata::get_group_memberships($classlist,$keylist); # my %sections; my %fullnames; @@ -401,18 +516,40 @@ sub getclasslist { $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; my $status = $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; + my $group = + $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; # filter students according to status selected - if ($filterlist && $env{'form.Status'} ne 'Any') { - if ($env{'form.Status'} ne $status) { - delete ($classlist->{$student}); + if ($filterlist && (!($stu_status =~ /Any/))) { + if (!($stu_status =~ $status)) { + delete($classlist->{$student}); next; } } + # filter students according to groups selected + my @stu_groups = split(/,/,$group); + if (@getgroup) { + my $exclude = 1; + foreach my $grp (@getgroup) { + foreach my $stu_group (@stu_groups) { + if ($stu_group eq $grp) { + $exclude = 0; + } + } + if (($grp eq 'none') && !$group) { + $exclude = 0; + } + } + if ($exclude) { + delete($classlist->{$student}); + } + } $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { $sections{$section}++; - $fullnames{$student}=$fullname; + if ($classlist->{$student}) { + $fullnames{$student}=$fullname; + } } else { delete($classlist->{$student}); } @@ -485,6 +622,7 @@ sub student_gradeStatus { # Shows a student's view of problem and submission sub jscriptNform { my ($symb) = @_; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); my $jscript=' -
- $default_form_data - - - - File to upload: + + '.$default_form_data.' + + + + '.&mt('File to upload: [_1]','').'
- +
-UPLOAD +'); - $r->print(<print(' - - - - -SCANTRONFORM + '.&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(< -
- - $default_form_data - - - - - - - - - - - -
-  Download a scoring office file -
Filename of scoring office file: $file_selector
- -
- -
- -SCANTRONFORM - - $r->print(< -$grading_menu_button -SCANTRONFORM + $r->print(' +
+
+ '.$default_form_data.' + + '.&Apache::loncommon::start_data_table('LC_scantron_action').' + '.&Apache::loncommon::start_data_table_header_row().' + +  '.&mt('Download a scoring office file').' + + '.&Apache::loncommon::end_data_table_header_row().' + '.&Apache::loncommon::start_data_table_row().' + '.&mt('Filename of scoring office file: [_1]',$file_selector).' +
+ + '.&Apache::loncommon::end_data_table_row().' + '.&Apache::loncommon::end_data_table().' +
+
+'); + &Apache::lonpickcode::code_list($r,2); + $r->print($grading_menu_button); return } -# Parse and return the scantron configuration line selected as a -# hash of configuration file fields. -# -# Parameters: -# which - the name of the configuration to parse from the file. -# If the named configuration is not in the file, an empty -# hash is returned. +=pod + +=item get_scantron_config + + Parse and return the scantron configuration line selected as a + hash of configuration file fields. + + Arguments: + which - the name of the configuration to parse from the file. + + + Returns: + If the named configuration is not in the file, an empty + hash is returned. + a hash with the fields + name - internal name for the this configuration setup + description - text to display to operator that describes this config + CODElocation - if 0 or the string 'none' + - no CODE exists for this config + if -1 || the string 'letter' + - a CODE exists for this config and is + a string of letters + Unsupported value (but planned for future support) + if a positive integer + - The CODE exists as the first n items from + the question section of the form + if the string 'number' + - The CODE exists for this config and is + a string of numbers + CODEstart - (only matter if a CODE exists) column in the line where + the CODE starts + CODElength - length of the CODE + IDstart - column where the student ID number starts + IDlength - length of the student ID info + Qstart - column where the information from the bubbled + 'questions' start + Qlength - number of columns comprising a single bubble line from + the sheet. (usually either 1 or 10) + Qon - either a single character representing the character used + to signal a bubble was chosen in the positional setup, or + the string 'letter' if the letter of the chosen bubble is + in the final, or 'number' if a number representing the + chosen bubble is in the file (1->A 0->J) + Qoff - the character used to represent that a bubble was + left blank + PaperID - if the scanning process generates a unique number for each + sheet scanned the column that this ID number starts in + PaperIDlength - number of columns that comprise the unique ID number + for the sheet of paper + FirstName - column that the first name starts in + FirstNameLength - number of columns that the first name spans + + LastName - column that the last name starts in + LastNameLength - number of columns that the last name spans + +=cut sub get_scantron_config { my ($which) = @_; @@ -4661,15 +5112,25 @@ sub get_scantron_config { return %config; } -# creates a hash keyed by student id that conains -# the corresponding student username:domain. -# Parameters: -# reference to the class list hash. This is a hash -# keyed by student name:domain whose elements are references -# to arrays containng various chunks of information -# about the student. (See loncoursedata for more info). -# -# +=pod + +=item username_to_idmap + + creates a hash keyed by student id with values of the corresponding + student username:domain. + + Arguments: + + $classlist - reference to the class list hash. This is a hash + keyed by student name:domain whose elements are references + to arrays containing various chunks of information + about the student. (See loncoursedata for more info). + + Returns + %idmap - the constructed hash + +=cut + sub username_to_idmap { my ($classlist)= @_; my %idmap; @@ -4679,22 +5140,52 @@ sub username_to_idmap { } return %idmap; } -# -# Make a correction in a scantron line? -# Parameters: -# scantron_config - Format of the scantron file -# scan_data - Hash of line by line info about the scan(?). -# line - Scantron line to edit? -# whichline -# field -# args - Keyword/value hash of additional parameters. -# + +=pod + +=item scantron_fixup_scanline + + Process a requested correction to a scanline. + + Arguments: + $scantron_config - hash from &get_scantron_config() + $scan_data - hash of correction information + (see &scantron_getfile()) + $line - existing scanline + $whichline - line number of the passed in scanline + $field - type of change to process + (either + 'ID' -> correct the student ID number + 'CODE' -> correct the CODE + 'answer' -> fixup the submitted answers) + + $args - hash of additional info, + - 'ID' + 'newid' -> studentID to use in replacement + of existing one + - 'CODE' + 'CODE_ignore_dup' - set to true if duplicates + should be ignored. + 'CODE' - is new code or 'use_unfound' + if the existing unfound code should + be used as is + - 'answer' + 'response' - new answer or 'none' if blank + 'question' - the bubble line to change + + Returns: + $line - the modified scanline + + Side effects: + $scan_data - may be updated + +=cut + sub scantron_fixup_scanline { my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; - # - # ID field, args->{'newid'} is the new value of the ID field. - # + + if ($field eq 'ID') { if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { return ($line,1,'New value too large'); @@ -4709,11 +5200,6 @@ sub scantron_fixup_scanline { &scan_data($scan_data,"$whichline.user", $args->{'username'}.':'.$args->{'domain'}); } - # CODE Field, - # args->{CODE_ignore_dup} is true if duplicates should be ignored. - # args->{CODE} is new code or 'use_unfound' if an unfound code should - # be used as is? - # } elsif ($field eq 'CODE') { if ($args->{'CODE_ignore_dup'}) { &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); @@ -4729,47 +5215,82 @@ sub scantron_fixup_scanline { substr($line,$$scantron_config{'CODEstart'}-1, $$scantron_config{'CODElength'})=$args->{'CODE'}; } - # - # Edit the answer field. - # args->{'response'} - new answer or 'none' if blank. - # args->{'question'} - the question (number?)?. - # } elsif ($field eq 'answer') { - my $length=$scantron_config->{'Qlength'}; + &scantron_get_maxbubble(); # Need the bubble counter info. + my $length =$scantron_config->{'Qlength'}; my $off=$scantron_config->{'Qoff'}; my $on=$scantron_config->{'Qon'}; - my $answer=${off}x$length; - if ($args->{'response'} eq 'none') { - &scan_data($scan_data, - "$whichline.no_bubble.".$args->{'question'},'1'); - } else { - if ($on eq 'letter') { - my @alphabet=('A'..'Z'); - $answer=$alphabet[$args->{'response'}]; - } elsif ($on eq 'number') { - $answer=$args->{'response'}+1; - if ($answer == 10) { $answer = '0'; } + my $question_number = $args->{'question'} -1; + my $first_position = $first_bubble_line{$question_number}; + my $bubble_count = $bubble_lines_per_response{$question_number}; + my $bubbles_per_line= $$scantron_config{'Qlength'}; + my $answer=${off}x($bubbles_per_line*$bubble_count); + my $final_answer; + if ($$scantron_config{'Qon'} eq 'letter' || + $$scantron_config{'Qon'} eq 'number') { + $bubbles_per_line = 10; + } + if (defined $args->{'response'}) { + + if ($args->{'response'} eq 'none') { + &scan_data($scan_data, + "$whichline.no_bubble.".$args->{'question'},'1'); } else { - substr($answer,$args->{'response'},1)=$on; + my ($bubble_line, $bubble_number) = split(/:/,$args->{'response'}); + if ($on eq 'letter') { + my @alphabet=('A'..'Z'); + $answer=$alphabet[$bubble_number]; + } elsif ($on eq 'number') { + $answer= $bubble_number+1; + if ($answer == 10) { $answer = '0'; } + } else { + substr($answer,$bubble_number+$bubble_line*$bubbles_per_line,1)=$on; + $final_answer = $answer; + } + &scan_data($scan_data, + "$whichline.no_bubble.".$args->{'question'},undef,'1'); + + # Positional notation already has the right final answer length.. + + if (($on eq 'letter') || ($on eq 'number')) { + for (my $l = 0; $l < $bubble_count; $l++) { + if ($l eq $bubble_line) { + $final_answer .= $answer; + } else { + $final_answer .= ' '; + } + } + } } - &scan_data($scan_data, - "$whichline.no_bubble.".$args->{'question'},undef,'1'); + # $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; + #substr($line,$where-1,$length)=$answer; + substr($line, + $scantron_config->{'Qstart'}+$first_position-1, + $bubbles_per_line*$length) = $final_answer; } - my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; - substr($line,$where-1,$length)=$answer; } return $line; } -# Edit or look up an item in the scan_data hash. -# Parameters: -# scan_data - The hash. -# key - shorthand of the key to edit (actual key is -# scatronfilename_key. -# data - New value of the hash entry. -# delete - If defined, the entry is removed from the table. -# Returns: -# The new value of the hash table field (undefined if deleted). -# + +=pod + +=item scan_data + + Edit or look up an item in the scan_data hash. + + Arguments: + $scan_data - The hash (see scantron_getfile) + $key - shorthand of the key to edit (actual key is + scantronfilename_key). + $data - New value of the hash entry. + $delete - If true, the entry is removed from the hash. + + Returns: + The new value of the hash table field (undefined if deleted). + +=cut + + sub scan_data { my ($scan_data,$key,$value,$delete)=@_; my $filename=$env{'form.scantron_selectfile'}; @@ -4779,20 +5300,67 @@ sub scan_data { if ($delete) { delete($scan_data->{$filename.'_'.$key}); } return $scan_data->{$filename.'_'.$key}; } -# -# Decode a line on the uploaded scantron file: -# Arguments: -# line - The text of the scantron file line to process -# whichline - Line number(?) -# scantron_config - Hash describing the format of the scantron lines. -# scan_data - Hash being built up of the entire scantron file. -# justHeader - True if should not process question answers but only -# the stuff to the left of the answers. -# Returns: -# Hash of data from the line? -# + +=pod + +=item scantron_parse_scanline + + Decodes a scanline from the selected scantron file + + Arguments: + line - The text of the scantron file line to process + whichline - Line number + scantron_config - Hash describing the format of the scantron lines. + scan_data - Hash of extra information about the scanline + (see scantron_getfile for more information) + just_header - True if should not process question answers but only + the stuff to the left of the answers. + Returns: + Hash containing the result of parsing the scanline + + Keys are all proceeded by the string 'scantron.' + + CODE - the CODE in use for this scanline + useCODE - 1 if the CODE is invalid but it usage has been forced + by the operator + CODE_ignore_dup - 1 if the CODE is a duplicated use when unique + CODEs were selected, but the usage has been + forced by the operator + ID - student ID + PaperID - if used, the ID number printed on the sheet when the + paper was scanned + FirstName - first name from the sheet + LastName - last name from the sheet + + if just_header was not true these key may also exist + + missingerror - a list of bubble ranges that are considered to be answers + to a single question that don't have any bubbles filled in. + Of the form questionnumber:firstbubblenumber:count. + doubleerror - a list of bubble ranges that are considered to be answers + to a single question that have more than one bubble filled in. + Of the form questionnumber::firstbubblenumber:count + + In the above, count is the number of bubble responses in the + input line needed to represent the possible answers to the question. + e.g. a radioresponse with 15 choices in an answer sheet with 10 choices + per line would have count = 2. + + maxquest - the number of the last bubble line that was parsed + + ( starts at 1) + .answer - zero or more letters representing the selected + letters from the scanline for the bubble line + . + if blank there was either no bubble or there where + multiple bubbles, (consult the keys missingerror and + doubleerror if this is an error condition) + +=cut + sub scantron_parse_scanline { - my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_; + my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_; + my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); # Answers my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff @@ -4825,72 +5393,171 @@ sub scantron_parse_scanline { $record{'scantron.LastName'}= substr($data,$$scantron_config{'LastName'}-1, $$scantron_config{'LastNamelength'}); - if ($justHeader) { return \%record; } + if ($just_header) { return \%record; } my @alphabet=('A'..'Z'); my $questnum=0; - while ($questions) { + my $ansnum =1; # Multiple 'answer lines'/question. + + chomp($questions); # Get rid of any trailing \n. + $questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads). + while (length($questions)) { + my $answers_needed = $bubble_lines_per_response{$questnum}; + my $answer_length = $$scantron_config{'Qlength'} * $answers_needed; + + $questnum++; - my $currentquest=substr($questions,0,$$scantron_config{'Qlength'}); - substr($questions,0,$$scantron_config{'Qlength'})=''; - if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } + my $currentquest = substr($questions,0,$answer_length); + $questions = substr($questions,$answer_length); + if (length($currentquest) < $answer_length) { next; } + + # Qon letter implies for each slot in currentquest we have: + # ? or * for doubles a letter in A-Z for a bubble and + # about anything else (esp. a value of Qoff for missing + # bubbles. + + if ($$scantron_config{'Qon'} eq 'letter') { - if ($currentquest eq '?' - || $currentquest eq '*') { + if ($currentquest =~ /\?/ + || $currentquest =~ /\*/ + || (&occurence_count($currentquest, "[A-Z]") > 1)) { push(@{$record{'scantron.doubleerror'}},$questnum); - $record{"scantron.$questnum.answer"}=''; + for (my $ans = 0; $ans < $answers_needed; $ans++) { + my $bubble = substr($currentquest, $ans, 1); + if ($bubble =~ /[A-Z]/ ) { + $record{"scantron.$ansnum.answer"} = $bubble; + } else { + $record{"scantron.$ansnum.answer"}=''; + } + $ansnum++; + } + } elsif (!defined($currentquest) - || $currentquest eq $$scantron_config{'Qoff'} - || $currentquest !~ /^[A-Z]$/) { - $record{"scantron.$questnum.answer"}=''; + || (&occurence_count($currentquest, $$scantron_config{'Qoff'}) == length($currentquest)) + || (&occurence_count($currentquest, "[A-Z]") == 0)) { + for (my $ans = 0; $ans < $answers_needed; $ans++ ) { + $record{"scantron.$ansnum.answer"}=''; + $ansnum++; + + } if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); + # $ansnum += $answers_needed; } } else { - $record{"scantron.$questnum.answer"}=$currentquest; + for (my $ans = 0; $ans < $answers_needed; $ans++) { + my $bubble = substr($currentquest, $ans, 1); + $record{"scantron.$ansnum.answer"} = $bubble; + $ansnum++; + } } + + # Qon 'number' implies each slot gives a digit that indexes the + # the bubbles filled or Qoff or a non number for unbubbled lines. + # and *? for double bubbles on a line. + # these answers are also stored as letters. + } elsif ($$scantron_config{'Qon'} eq 'number') { - if ($currentquest eq '?' - || $currentquest eq '*') { + if ($currentquest =~ /\?/ + || $currentquest =~ /\*/ + || (&occurence_count($currentquest, '\d') > 1)) { push(@{$record{'scantron.doubleerror'}},$questnum); - $record{"scantron.$questnum.answer"}=''; + for (my $ans = 0; $ans < $answers_needed; $ans++) { + my $bubble = substr($currentquest, $ans, 1); + if ($bubble =~ /\d/) { + $record{"scantron.$ansnum.answer"} = $alphabet[$bubble]; + } else { + $record{"scantron.$ansnum.answer"}=' '; + } + $ansnum++; + } + } elsif (!defined($currentquest) - || $currentquest eq $$scantron_config{'Qoff'} - || $currentquest !~ /^\d$/) { - $record{"scantron.$questnum.answer"}=''; + || (&occurence_count($currentquest,$$scantron_config{'Qoff'}) == length($currentquest)) + || (&occurence_count($currentquest, '\d') == 0)) { + for (my $ans = 0; $ans < $answers_needed; $ans++ ) { + $record{"scantron.$ansnum.answer"}=''; + $ansnum++; + + } if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); + $ansnum += $answers_needed; } + } else { - # wrap zero back to J - if ($currentquest eq '0') { - $record{"scantron.$questnum.answer"}= - $alphabet[9]; - } else { - $record{"scantron.$questnum.answer"}= - $alphabet[$currentquest-1]; + $currentquest = &digits_to_letters($currentquest); + for (my $ans =0; $ans < $answers_needed; $ans++) { + $record{"scantron.$ansnum.answer"} = substr($currentquest, $ans, 1); + $ansnum++; } } } else { + + # Otherwise there's a positional notation; + # each bubble line requires Qlength items, and there are filled in + # bubbles for each case where there 'Qon' characters. + # + my @array=split($$scantron_config{'Qon'},$currentquest,-1); - if (length($array[0]) eq $$scantron_config{'Qlength'}) { - $record{"scantron.$questnum.answer"}=''; + + # If the split only giveas us one element.. the full length of the + # answser string, no bubbles are filled in: + + if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { + for (my $ans = 0; $ans < $answers_needed; $ans++ ) { + $record{"scantron.$ansnum.answer"}=''; + $ansnum++; + + } if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); } - } else { - $record{"scantron.$questnum.answer"}= - $alphabet[length($array[0])]; + + + + } elsif (scalar(@array) eq 2) { + + my $location = length($array[0]); + my $line_num = int($location / $$scantron_config{'Qlength'}); + my $bubble = $alphabet[$location % $$scantron_config{'Qlength'}]; + + + for (my $ans = 0; $ans < $answers_needed; $ans++) { + if ($ans eq $line_num) { + $record{"scantron.$ansnum.answer"} = $bubble; + } else { + $record{"scantron.$ansnum.answer"} = ' '; + } + $ansnum++; + } } - if (scalar(@array) gt 2) { + # If there's more than one instance of a bubble character + # That's a double bubble; with positional notation we can + # record all the bubbles filled in as well as the + # fact this response consists of multiple bubbles. + # + else { push(@{$record{'scantron.doubleerror'}},$questnum); + + my $first_answer = $ansnum; + for (my $ans =0; $ans < $answers_needed; $ans++) { + my $item = $first_answer+$ans; + $record{"scantron.$item.answer"} = ''; + } + my @ans=@array; - my $i=length($ans[0]);shift(@ans); + my $i=0; + my $increment = 0; while ($#ans) { - $i+=length($ans[0])+1; - $record{"scantron.$questnum.answer"}.=$alphabet[$i]; + $i+=length($ans[0]) + $increment; + my $line = int($i/$$scantron_config{'Qlength'} + $first_answer); + my $bubble = $i%$$scantron_config{'Qlength'}; + $record{"scantron.$line.answer"}.=$alphabet[$bubble]; shift(@ans); + $increment = 1; } + $ansnum += $answers_needed; } } } @@ -4898,6 +5565,24 @@ sub scantron_parse_scanline { return \%record; } +=pod + +=item scantron_add_delay + + Adds an error message that occurred during the grading phase to a + queue of messages to be shown after grading pass is complete + + Arguments: + $delayqueue - arrary ref of hash ref of error messages + $scanline - the scanline that caused the error + $errormesage - the error message + $errorcode - a numeric code for the error + + Side Effects: + updates the $delayqueue to have a new hash ref of the error + +=cut + sub scantron_add_delay { my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; push(@$delayqueue, @@ -4906,6 +5591,24 @@ sub scantron_add_delay { ); } +=pod + +=item scantron_find_student + + Finds the username for the current scanline + + Arguments: + $scantron_record - hash result from scantron_parse_scanline + $scan_data - hash of correction information + (see &scantron_getfile() form more information) + $idmap - hash from &username_to_idmap() + $line - number of current scanline + + Returns: + Either 'username:domain' or undef if unknown + +=cut + sub scantron_find_student { my ($scantron_record,$scan_data,$idmap,$line)=@_; my $scanID=$$scantron_record{'scantron.ID'}; @@ -4920,6 +5623,15 @@ sub scantron_find_student { 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)=@_; @@ -4936,6 +5648,15 @@ sub scantron_filter { return 0; } +=pod + +=item scantron_process_corrections + + Gets correction information out of submitted form data and corrects + the scanline + +=cut + sub scantron_process_corrections { my ($r) = @_; my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); @@ -4993,12 +5714,30 @@ sub scantron_process_corrections { } } +=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_ file) + +=cut + sub reset_skipping_status { my ($scanlines,$scan_data)=&scantron_getfile(); &scan_data($scan_data,'remember_skipping',undef,1); &scantron_putfile(undef,$scan_data); } +=pod + +=item start_skipping + + Marks a scanline to be skipped. + +=cut + sub start_skipping { my ($scan_data,$i)=@_; my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); @@ -5010,6 +5749,14 @@ sub start_skipping { &scan_data($scan_data,'remember_skipping',join(':',%remembered)); } +=pod + +=item should_be_skipped + + Checks whether a scanline should be skipped. + +=cut + sub should_be_skipped { my ($scanlines,$scan_data,$i)=@_; if ($env{'form.scantron_options_redo'} !~ /^redo_/) { @@ -5025,6 +5772,15 @@ sub should_be_skipped { return 1; } +=pod + +=item remember_current_skipped + + Discovers what scanlines are in the scantron_skipped_ + file and remembers them into scan_data for later use. + +=cut + sub remember_current_skipped { my ($scanlines,$scan_data)=&scantron_getfile(); my %to_remember; @@ -5038,13 +5794,32 @@ sub remember_current_skipped { &scantron_putfile(undef,$scan_data); } +=pod + +=item check_for_error + + Checks if there was an error when attempting to remove a specific + scantron_.. bubble sheet data file. Prints out an error if + something went wrong. + +=cut + sub check_for_error { my ($r,$result)=@_; if ($result ne 'ok' && $result ne 'not_found' ) { - $r->print("An error occurred ($result) when trying to Remove the existing corrections."); + $r->print(&mt("An error occurred ([_1]) when trying to remove the existing corrections.",$result)); } } +=pod + +=item scantron_warning_screen + + Interstitial screen to make sure the operator has selected the + correct options before we start the validation phase. + +=cut + sub scantron_warning_screen { my ($button_text)=@_; my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); @@ -5056,27 +5831,36 @@ sub scantron_warning_screen { $CODElist=$env{'form.scantron_CODElist'}; if ($env{'form.scantron_CODElist'} eq '') { $CODElist='None'; } $CODElist= - 'List of CODES to validate against:'. + ''.&mt('List of CODES to validate against:').''. $env{'form.scantron_CODElist'}.''; } - return (< -Please double check the information - below before clicking on '$button_text' + +'.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).'

- - -$CODElist + + +'.$CODElist.'
Sequence to be Graded:$title
Data File that will be used:$env{'form.scantron_selectfile'}
'.&mt('Sequence to be Graded:').''.$title.'
'.&mt('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.

+

'.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'

+

'.&mt('If something is incorrect, please click the \'Grading Menu\' button to start over.').'


-STUFF +'); } +=pod + +=item scantron_do_warning + + Check if the operator has picked something for all required + fields. Error out if something is missing. + +=cut + sub scantron_do_warning { my ($r)=@_; my ($symb)=&get_symb($r); @@ -5086,28 +5870,36 @@ sub scantron_do_warning { if ( $env{'form.selectpage'} eq '' || $env{'form.scantron_selectfile'} eq '' || $env{'form.scantron_format'} eq '' ) { - $r->print("

You have forgetten to specify some information. Please go Back and try again.

"); + $r->print("

".&mt('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

'); + $r->print('

'.&mt('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.

'); + $r->print('

'.&mt('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.

'); + $r->print('

'.&mt('You have not selected a the format of the student\'s response data.').'

'); } } else { my $warning=&scantron_warning_screen('Grading: Validate Records'); - $r->print(< + $r->print(' +'.$warning.' + -STUFF +'); } $r->print("
".&show_grading_menu_form($symb)); return ''; } +=pod + +=item scantron_form_start + + html hidden input for remembering all selected grading options + +=cut + sub scantron_form_start { my ($max_bubble)=@_; my $result= < SCANTRONFORM + + my $line = 0; + while (defined($env{"form.scantron.bubblelines.$line"})) { + my $chunk = + ''."\n"; + $chunk .= + ''."\n"; + $result .= $chunk; + $line++; + } return $result; } +=pod + +=item scantron_validate_file + + Dispatch routine for doing validation of a bubble sheet data file. + + Also processes any necessary information resets that need to + occur before validation begins (ignore previous corrections, + restarting the skipped records processing) + +=cut + sub scantron_validate_file { my ($r) = @_; my ($symb)=&get_symb($r); @@ -5132,7 +5946,7 @@ sub scantron_validate_file { my $default_form_data=&defaultFormData($symb); # do the detection of only doing skipped records first befroe we delete - # them when doing the corrections reset + # them when doing the corrections reset if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') { &reset_skipping_status(); } @@ -5151,7 +5965,7 @@ sub scantron_validate_file { if ($env{'form.scantron_corrections'}) { &scantron_process_corrections($r); } - $r->print("

Gathering neccessary info.

");$r->rflush(); + $r->print('

'.&mt('Gathering necessary info.').'

');$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); my $max_bubble=&scantron_get_maxbubble(); @@ -5168,9 +5982,10 @@ sub scantron_validate_file { } my $currentphase=$env{'form.validatepass'}; + my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { - $r->print("

Validating ".$validate_phases[$currentphase]."

"); + $r->print('

'.&mt('Validating '.$validate_phases[$currentphase]).'

'); $r->rflush(); my $which="scantron_validate_".$validate_phases[$currentphase]; { @@ -5180,12 +5995,12 @@ sub scantron_validate_file { } if (!$stop) { my $warning=&scantron_warning_screen('Start Grading'); - $r->print(< -$warning - + $r->print(' +'.&mt('Validation process complete.').'
+'.$warning.' + -STUFF +'); } else { $r->print(''); @@ -5193,21 +6008,32 @@ STUFF } if ($stop) { if ($validate_phases[$currentphase] eq 'sequence') { - $r->print(''); - $r->print(' this error
'); + $r->print(''); + $r->print(' '.&mt('this error').'
'); - $r->print("

Or click the 'Grading Menu' button to start over.

"); + $r->print("

".&mt("Or click the 'Grading Menu' button to start over.")."

"); } else { - $r->print(''); - $r->print(' using corrected info
'); - $r->print(""); - $r->print(" this scanline saving it for later."); + $r->print(''); + $r->print(' '.&mt('using corrected info').'
'); + $r->print(""); + $r->print(" ".&mt("this scanline saving it for later.")); } } $r->print("
".&show_grading_menu_form($symb)); return ''; } + +=pod + +=item scantron_remove_file + + Removes the requested bubble sheet data file, makes sure that + scantron_original_ is never removed + + +=cut + sub scantron_remove_file { my ($which)=@_; my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; @@ -5222,6 +6048,18 @@ sub scantron_remove_file { return &Apache::lonnet::removeuserfile($cname,$cdom,$file); } + +=pod + +=item scantron_remove_scan_data + + Removes all scan_data correction for the requested bubble sheet + data file. (In the case that both the are doing skipped records we need + to remember the old skipped lines for the time being so that element + persists for a while.) + +=cut + sub scantron_remove_scan_data { my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; @@ -5239,11 +6077,59 @@ sub scantron_remove_scan_data { } my $result; if (@todelete) { - $result=&Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname); + $result = &Apache::lonnet::del('nohist_scantrondata', + \@todelete,$cdom,$cname); + } else { + $result = 'ok'; } return $result; } + +=pod + +=item scantron_getfile + + Fetches the requested bubble sheet data file (all 3 versions), and + the scan_data hash + + Arguments: + None + + Returns: + 2 hash references + + - first one has + orig - + corrected - + skipped - each of which points to an array ref of the specified + file broken up into individual lines + count - number of scanlines + + - second is the scan_data hash possible keys are + ($number refers to scanline numbered $number and thus the key affects + only that scanline + $bubline refers to the specific bubble line element and the aspects + refers to that specific bubble line element) + + $number.user - username:domain to use + $number.CODE_ignore_dup + - ignore the duplicate CODE error + $number.useCODE + - use the CODE in the scanline as is + $number.no_bubble.$bubline + - it is valid that there is no bubbled in bubble + at $number $bubline + remember_skipping + - a frozen hash containing keys of $number and values + of either + 1 - we are on a 'do skipped records pass' and plan + on processing this line + 2 - we are on a 'do skipped records pass' and this + scanline has been marked to skip yet again + +=cut + sub scantron_getfile { #FIXME really would prefer a scantron directory my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; @@ -5276,6 +6162,21 @@ sub scantron_getfile { return (\%scanlines,\%scan_data); } +=pod + +=item lonnet_putfile + + Wrapper routine to call &Apache::lonnet::finishuserfileupload + + Arguments: + $contents - data to store + $filename - filename to store $contents into + + Returns: + result value from &Apache::lonnet::finishuserfileupload + +=cut + sub lonnet_putfile { my ($contents,$filename)=@_; my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; @@ -5285,6 +6186,22 @@ sub lonnet_putfile { } +=pod + +=item scantron_putfile + + Stores the current version of the bubble sheet data files, and the + scan_data hash. (Does not modify the original version only the + corrected and skipped versions. + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + +=cut + sub scantron_putfile { my ($scanlines,$scan_data) = @_; #FIXME really would prefer a scantron directory @@ -5305,6 +6222,28 @@ sub scantron_putfile { &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); } +=pod + +=item scantron_get_line + + Returns the correct version of the scanline + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + $i - number of the requested line (starts at 0) + + Returns: + A scanline, (either the original or the corrected one if it + exists), or undef if the requested scanline should be + skipped. (Either because it's an skipped scanline, or it's an + unskipped scanline and we are not doing a 'do skipped scanlines' + pass. + +=cut + sub scantron_get_line { my ($scanlines,$scan_data,$i)=@_; if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } @@ -5313,6 +6252,23 @@ sub scantron_get_line { return $scanlines->{'orig'}[$i]; } +=pod + +=item scantron_todo_count + + Counts the number of scanlines that need processing. + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + + Returns: + $count - number of scanlines to process + +=cut + sub get_todo_count { my ($scanlines,$scan_data)=@_; my $count=0; @@ -5324,6 +6280,25 @@ sub get_todo_count { return $count; } +=pod + +=item scantron_put_line + + Updates the 'corrected' or 'skipped' versions of the bubble sheet + data file. + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + $i - line number to update + $newline - contents of the updated scanline + $skip - if true make the line for skipping and update the + 'skipped' file + +=cut + sub scantron_put_line { my ($scanlines,$scan_data,$i,$newline,$skip)=@_; if ($skip) { @@ -5334,6 +6309,21 @@ sub scantron_put_line { $scanlines->{'corrected'}[$i]=$newline; } +=pod + +=item scantron_clear_skip + + Remove a line from the 'skipped' file + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + $i - line number to update + +=cut + sub scantron_clear_skip { my ($scanlines,$scan_data,$i)=@_; if (exists($scanlines->{'skipped'}[$i])) { @@ -5343,6 +6333,15 @@ sub scantron_clear_skip { return 0; } +=pod + +=item scantron_filter_not_exam + + Filter routine used by &Apache::lonnavmaps::retrieveResources(), to + filter out resources that are not marked as 'exam' mode + +=cut + sub scantron_filter_not_exam { my ($curres)=@_; @@ -5359,6 +6358,15 @@ sub scantron_filter_not_exam { return 0; } +=pod + +=item scantron_validate_sequence + + Validates the selected sequence, checking for resource that are + not set to exam mode. + +=cut + sub scantron_validate_sequence { my ($r,$currentphase) = @_; @@ -5382,6 +6390,15 @@ sub scantron_validate_sequence { 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) = @_; @@ -5392,6 +6409,8 @@ sub scantron_validate_ID { #get scantron line setup 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++) { @@ -5444,37 +6463,69 @@ sub scantron_validate_ID { 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,$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("

An error was detected ($error)"); if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { - $r->print(" for PaperID ". - $$scan_record{'scantron.PaperID'}." \n"); + $r->print("

".&mt("An error was detected ($error)". + " for PaperID [_1]", + $$scan_record{'scantron.PaperID'})."

\n"); } else { - $r->print(" in scanline $i 
".
-		  $line."
\n"); - } - my $message="

The ID on the form is ". - $$scan_record{'scantron.ID'}."
\n". - "The name on the paper is ". - $$scan_record{'scantron.LastName'}.",". - $$scan_record{'scantron.FirstName'}."

"; + $r->print("

".&mt("An error was detected ($error)". + " in scanline [_1] 

[_2]
", + $i,$line)."

\n"); + } + my $message="

".&mt("The ID on the form is [_1]
". + "The name on the paper is [_2],[_3]", + $$scan_record{'scantron.ID'}, + $$scan_record{'scantron.LastName'}, + $$scan_record{'scantron.FirstName'})."

"; $r->print(''."\n"); $r->print(''."\n"); if ($error =~ /ID$/) { if ($error eq 'incorrectID') { - $r->print("The encoded ID is not in the classlist

\n"); + $r->print("

".&mt("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("

".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."

\n"); } $r->print($message); - $r->print("

How should I handle this?
\n"); + $r->print("

".&mt("How should I handle this?")."
\n"); $r->print("\n

  • "); #FIXME it would be nice if this sent back the user ID and #could do partial userID matches @@ -5487,14 +6538,14 @@ sub scantron_get_correction { $r->print('
    • '); } elsif ($error =~ /CODE$/) { if ($error eq 'incorrectCODE') { - $r->print("

    The encoded CODE is not in the list of possible CODEs

    \n"); + $r->print("

    ".&mt("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("

    ".&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."

    \n"); } - $r->print("

    The CODE on the form is '". - $$scan_record{'scantron.CODE'}."'
    \n"); + $r->print("

    ".&mt("The CODE on the form is '[_1]'", + $$scan_record{'scantron.CODE'})."
    \n"); $r->print($message); - $r->print("

    How should I handle this?
    \n"); + $r->print("

    ".&mt("How should I handle this?")."
    \n"); $r->print("\n
    "); my $i=0; if ($error eq 'incorrectCODE' @@ -5504,7 +6555,13 @@ sub scantron_get_correction { foreach my $testcode (@{$closest}) { my $checked=''; if (!$i) { $checked=' checked="checked" '; } - $r->print(""); + $r->print(" + + "); $r->print("\n
    "); $i++; } @@ -5512,7 +6569,12 @@ sub scantron_get_correction { } if ($$scan_record{'scantron.CODE'}=~/\S/ ) { my $checked; if (!$i) { $checked=' checked="checked" '; } - $r->print(""); + $r->print(" + "); $r->print("\n
    "); } @@ -5534,32 +6596,44 @@ ENDSCRIPT "&curCODE=".&escape($$scan_record{'scantron.CODE'}). "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); if ($env{'form.scantron_CODElist'} =~ /\S/) { - $r->print(" Selected CODE is "); + $r->print(" + + ".&mt("Selected CODE is [_1]","")); $r->print("\n
    "); } - $r->print(" as the CODE."); + $r->print(" + ")); $r->print("\n

    "); } elsif ($error eq 'doublebubble') { - $r->print("

    There have been multiple bubbles scanned for a some question(s)

    \n"); + $r->print("

    ".&mt("There have been multiple bubbles scanned for a some question(s)")."

    \n"); $r->print(''); $r->print($message); - $r->print("

    Please indicate which bubble should be used for grading

    "); + $r->print("

    ".&mt("Please indicate which bubble should be used for grading")."

    "); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; + my $selected = &get_response_bubbles($scan_record, $question); + my @select_array = split(/:/,$selected); &scantron_bubble_selector($r,$scan_config,$question, - split('',$selected)); + @select_array); } } elsif ($error eq 'missingbubble') { - $r->print("

    There have been no bubbles scanned for some question(s)

    \n"); + $r->print("

    ".&mt("There have been no bubbles scanned for some question(s)")."

    \n"); $r->print($message); - $r->print("

    Please indicate which bubble should be used for grading

    "); - $r->print("Some questions have no scanned bubbles\n"); + $r->print("

    ".&mt("Please indicate which bubble should be used for grading.")."

    "); + $r->print(&mt("Some questions have no scanned bubbles")."\n"); $r->print(''); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; - &scantron_bubble_selector($r,$scan_config,$question); + 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
      "); @@ -5567,39 +6641,47 @@ ENDSCRIPT $r->print("\n
    "); } -# -# Ask the grader to select the actual bubble -# -# Arguments: -# r - Apache request. -# scan_config - Hash of the scantron format selected. -# quest - Question being evaluated -# selected - array of selected bubbles -# lines - if present, number of bubble lines in questions. + +=pod + +=item scantron_bubble_selector + + Generates the html radiobuttons to correct a single bubble line + possibly showing the existing the selected bubbles if known + + Arguments: + $r - Apache request object + $scan_config - hash from &get_scantron_config() + $quest - number of the bubble line to make a corrector for + @lines - array of answer lines. + +=cut + sub scantron_bubble_selector { - my ($r,$scan_config,$quest,@selected, $lines)=@_; + my ($r,$scan_config,$quest,@lines)=@_; my $max=$$scan_config{'Qlength'}; + my $scmode=$$scan_config{'Qon'}; + + my $bubble_length = scalar(@lines); + + if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } + my $response = $quest-1; + my $lines = $bubble_lines_per_response{$response}; - if (!defined($lines)) { - $lines = 1; - } my $total_lines = $lines*2; my @alphabet=('A'..'Z'); + $r->print(""); for (my $l = 0; $l < $lines; $l++) { if ($l != 0) { $r->print(''); } - - # FIXME: This loop probably has to be considerably more clever for - # multiline bubbles: User can multibubble by having bubbles in - # several lines. User can skip lines legitimately etc. etc. - + my @selected = split(//,$lines[$l]); for (my $i=0;$i<$max;$i++) { $r->print("\n".''); + $quest.'" value="none" /> '.&mt('No bubble').' '); } @@ -5626,9 +6708,10 @@ sub scantron_bubble_selector { # multiline questions (different values e.g..). for (my $i=0;$i<$max;$i++) { + my $value = "$l:$i"; # Relative bubble line #: Bubble in line. $r->print("\n". '"); + $quest.'" value="'.$value.'" />'.$alphabet[$i].""); } $r->print(''); @@ -5637,6 +6720,22 @@ sub scantron_bubble_selector { $r->print('
    $quest
    '); if ($selected[0] eq $alphabet[$i]) { @@ -5616,7 +6698,7 @@ sub scantron_bubble_selector { my $lspan = $total_lines * 2; # 2 table rows per bubble line. $r->print('
    '); } +=pod + +=item num_matches + + Counts the number of characters that are the same between the two arguments. + + Arguments: + $orig - CODE from the scanline + $code - CODE to match against + + Returns: + $count - integer count of the number of same characters between the + two arguments + +=cut + sub num_matches { my ($orig,$code) = @_; my @code=split(//,$code); @@ -5648,6 +6747,26 @@ sub num_matches { return $same; } +=pod + +=item scantron_get_closely_matching_CODEs + + Cycles through all CODEs and finds the set that has the greatest + number of same characters as the provided CODE + + Arguments: + $allcodes - hash ref returned by &get_codes() + $CODE - CODE from the current scanline + + Returns: + 2 element list + - first elements is number of how closely matching the best fit is + (5 means best set has 5 matching characters) + - second element is an arrary ref containing the set of valid CODEs + that best fit the passed in CODE + +=cut + sub scantron_get_closely_matching_CODEs { my ($allcodes,$CODE)=@_; my @CODEs; @@ -5658,6 +6777,23 @@ sub scantron_get_closely_matching_CODEs return ($#CODEs,$CODEs[-1]); } +=pod + +=item get_codes + + Builds a hash which has keys of all of the valid CODEs from the selected + set of remembered CODEs. + + Arguments: + $old_name - name of the set of remembered CODEs + $cdom - domain of the course + $cnum - internal course name + + Returns: + %allcodes - keys are the valid CODEs, values are all 1 + +=cut + sub get_codes { my ($old_name, $cdom, $cnum) = @_; if (!$old_name) { @@ -5680,6 +6816,16 @@ sub get_codes { return %allcodes; } +=pod + +=item scantron_validate_CODE + + Validates all scanlines in the selected file to not have any + invalid or underspecified CODEs and that none of the codes are + duplicated if this was requested. + +=cut + sub scantron_validate_CODE { my ($r,$currentphase) = @_; my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); @@ -5697,6 +6843,8 @@ sub scantron_validate_CODE { my %allcodes=&get_codes(); + &scantron_get_maxbubble(); # parse needs the lines per response array. + my ($scanlines,$scan_data)=&scantron_getfile(); for (my $i=0;$i<=$scanlines->{'count'};$i++) { my $line=&scantron_get_line($scanlines,$scan_data,$i); @@ -5731,6 +6879,15 @@ sub scantron_validate_CODE { return (0,$currentphase+1); } +=pod + +=item scantron_validate_doublebubble + + Validates all scanlines in the selected file to not have any + bubble lines with multiple bubbles marked. + +=cut + sub scantron_validate_doublebubble { my ($r,$currentphase) = @_; #get student info @@ -5740,6 +6897,9 @@ sub scantron_validate_doublebubble { #get scantron line setup my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); + + &scantron_get_maxbubble(); # parse needs the bubble line array. + for (my $i=0;$i<=$scanlines->{'count'};$i++) { my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } @@ -5754,32 +6914,101 @@ sub scantron_validate_doublebubble { return (0,$currentphase+1); } +=pod + +=item scantron_get_maxbubble + + Returns the maximum number of bubble lines that are expected to + occur. Does this by walking the selected sequence rendering the + resource and then checking &Apache::lonxml::get_problem_counter() + for what the current value of the problem counter is. + + Caches the results to $env{'form.scantron_maxbubble'}, + $env{'form.scantron.bubble_lines.n'} and + $env{'form.scantron.first_bubble_line.n'} + which are the total number of bubble, lines, the number of bubble + lines for reponse n and number of the first bubble line for response n. + +=cut + sub scantron_get_maxbubble { if (defined($env{'form.scantron_maxbubble'}) && $env{'form.scantron_maxbubble'}) { + &restore_bubble_lines(); return $env{'form.scantron_maxbubble'}; } - my $navmap=Apache::lonnavmaps::navmap->new(); - my (undef,undef,$sequence)= + my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); + my $navmap=Apache::lonnavmaps::navmap->new(); my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); &Apache::lonxml::clear_problem_counter(); + my $uname = $env{'form.student'}; + my $udom = $env{'form.userdom'}; + my $cid = $env{'request.course.id'}; + my $total_lines = 0; + %bubble_lines_per_response = (); + %first_bubble_line = (); + + + my $response_number = 0; + my $bubble_line = 0; foreach my $resource (@resources) { + my $symb = $resource->symb(); + &Apache::lonxml::clear_bubble_lines_for_part(); my $result=&Apache::lonnet::ssi($resource->src(), - ('symb' => $resource->symb())); + ('symb' => $resource->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); + + + + foreach my $part_id (@{$analysis{'parts'}}) { + + my $lines = $analysis{"$part_id.bubble_lines"};; + + + + # TODO - make this a persistent hash not an array. + + + $first_bubble_line{$response_number} = $bubble_line; + $bubble_lines_per_response{$response_number} = $lines; + $response_number++; + + $bubble_line += $lines; + $total_lines += $lines; + } + } &Apache::lonnet::delenv('scantron\.'); - $env{'form.scantron_maxbubble'} = - &Apache::lonxml::get_problem_counter()-1; + &save_bubble_lines(); + $env{'form.scantron_maxbubble'} = + $total_lines; return $env{'form.scantron_maxbubble'}; } +=pod + +=item scantron_validate_missingbubbles + + Validates all scanlines in the selected file to not have any + answers that don't have bubbles that have not been verified + to be bubble free. + +=cut + sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info @@ -5798,6 +7027,9 @@ sub scantron_validate_missingbubbles { $scan_data); if (!defined($$scan_record{'scantron.missingerror'})) { next; } my @to_correct; + + # Probably here's where the error is... + foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { if ($missing > $max_bubble) { next; } push(@to_correct,$missing); @@ -5812,6 +7044,30 @@ sub scantron_validate_missingbubbles { return (0,$currentphase+1); } +=pod + +=item scantron_process_students + + Routine that does the actual grading of the bubble sheet information. + + The parsed scanline hash is added to %env + + Then foreach unskipped scanline it does an &Apache::lonnet::ssi() + foreach resource , with the form data of + + 'submitted' =>'scantron' + 'grade_target' =>'grade', + 'grade_username'=> username of student + 'grade_domain' => domain of student + 'grade_courseid'=> of course + 'grade_symb' => symb of resource to grade + + This triggers a grading pass. The problem grading code takes care + of converting the bubbled letter information (now in %env) into a + valid submission. + +=cut + sub scantron_process_students { my ($r) = @_; my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); @@ -5846,6 +7102,9 @@ SCANTRONFORM my $start=&Time::HiRes::time(); my $i=-1; my ($uname,$udom,$started); + + &scantron_get_maxbubble(); # Need the bubble lines array to parse. + while ($i<$scanlines->{'count'}) { ($uname,$udom)=('',''); $i++; @@ -5896,8 +7155,6 @@ SCANTRONFORM } my $result=&Apache::lonnet::ssi($resource->src(),%form); if ($result ne '') { - &Apache::lonnet::logthis("scantron grading error -> $result"); - &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $env{'request.course.id'} url ".$resource->src()); } if (&Apache::loncommon::connection_aborted($r)) { last; } } @@ -5916,6 +7173,14 @@ SCANTRONFORM 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'})); @@ -5925,7 +7190,7 @@ sub scantron_upload_scantron_data { my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, 'domainid'); my $default_form_data=&defaultFormData(&get_symb($r,1)); - $r->print(<print(' -
    -$default_form_data + +'.$default_form_data.' - - - - - + + + + + + + + +
    $select_link
    Course ID:
    Course Name:
    Domain: $domsel
    File to upload:
    '.$select_link.'
    '.&mt('Course ID:').'
    '.&mt('Course Name:').'
    '.&mt('Domain:').' '.$domsel.'
    '.&mt('File to upload:').'
    - - + +
    -UPLOAD +'); return ''; } +=pod + +=item scantron_upload_scantron_data_save + + Adds a provided bubble information data file to the course if user + has the correct privileges to do so. + +=cut + sub scantron_upload_scantron_data_save { my($r)=@_; my ($symb)=&get_symb($r,1); my $doanotherupload= '
    '."\n". ''."\n". - ''."\n". + ''."\n". '
    '."\n"; if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && !&Apache::lonnet::allowed('usc', $env{'form.domainid'}.'_'.$env{'form.courseid'})) { - $r->print("You are not allowed to upload Scantron data to the requested course.
    "); + $r->print(&mt("You are not allowed to upload Scantron data to the requested course.")."
    "); if ($symb) { $r->print(&show_grading_menu_form($symb)); } else { @@ -5972,7 +7250,7 @@ sub scantron_upload_scantron_data_save { return ''; } my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); - $r->print("Doing upload to ".$coursedata{'description'}."
    "); + $r->print(&mt("Doing upload to [_1]",$coursedata{'description'})."
    "); my $fname=$env{'form.upfile.filename'}; #FIXME #copied from lonnet::userfileupload() @@ -5990,13 +7268,18 @@ sub scantron_upload_scantron_data_save { my $uploadedfile=$fname; $fname='scantron_orig_'.$fname; if (length($env{'form.upfile'}) < 2) { - $r->print("Error: The file you attempted to upload, ".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').", contained no information. Please check that you entered the correct filename."); + $r->print(&mt("Error: The file you attempted to upload, [_1] contained no information. Please check that you entered the correct filename.",''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."")); } else { my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname); if ($result =~ m|^/uploaded/|) { - $r->print("Success: Successfully uploaded ".(length($env{'form.upfile'})-1)." bytes of data into location ".$result.""); + $r->print(&mt("Success: Successfully uploaded [_1] bytes of data into location [_2]", + (length($env{'form.upfile'})-1), + ''.$result."")); } else { - $r->print("Error: An error (".$result.") occurred when attempting to upload the file, ".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').""); + $r->print(&mt("Error: An error ([_1]) occurred when attempting to upload the file, [_2]", + $result, + ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."")); + } } if ($symb) { @@ -6007,6 +7290,14 @@ sub scantron_upload_scantron_data_save { return ''; } +=pod + +=item valid_file + + Validates that the requested bubble data file exists in the course. + +=cut + sub valid_file { my ($requested_file)=@_; foreach my $filename (sort(&scantron_filenames())) { @@ -6015,6 +7306,16 @@ sub valid_file { return 0; } +=pod + +=item scantron_download_scantron_data + + Shows a list of the three internal files (original, corrected, + skipped) for a specific bubble sheet data file that exists in the + course. + +=cut + sub scantron_download_scantron_data { my ($r)=@_; my $default_form_data=&defaultFormData(&get_symb($r,1)); @@ -6022,11 +7323,11 @@ sub scantron_download_scantron_data { my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $file=$env{'form.scantron_selectfile'}; if (! &valid_file($file)) { - $r->print(<print('

    - The requested file name was invalid. + '.&mt('The requested file name was invalid.').'

    -ERROR +'); $r->print(&show_grading_menu_form(&get_symb($r,1))); return; } @@ -6036,21 +7337,30 @@ ERROR &Apache::lonnet::allowuploaded('/adm/grades',$orig); &Apache::lonnet::allowuploaded('/adm/grades',$corrected); &Apache::lonnet::allowuploaded('/adm/grades',$skipped); - $r->print(<print('

    - Original file as uploaded by the scantron office. + '.&mt('[_1]Original[_2] file as uploaded by the scantron office.', + '','').'

    - Corrections, a file of corrected records that were used in grading. + '.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.', + '','').'

    - Skipped, a file of records that were skipped. + '.&mt('[_1]Skipped[_2], 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 ------- # #------------------------------------------------------------------- @@ -6064,7 +7374,7 @@ sub show_grading_menu_form { ''."\n". ''."\n". ''."\n". - ''."\n". + ''."\n". ''."\n"; return $result; } @@ -6081,8 +7391,128 @@ sub savedState { return \%savedState; } -#--- Displays the main menu page ------- -sub gradingmenu { +sub grading_menu { + my ($request) = @_; + my ($symb)=&get_symb($request); + if (!$symb) {return '';} + my $probTitle = &Apache::lonnet::gettitle($symb); + my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); + + $request->print($table); + my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb), + 'handgrade'=>$hdgrade, + 'probTitle'=>$probTitle, + 'command'=>'submit_options', + 'saveState'=>"", + 'gradingMenu'=>1, + 'showgrading'=>"yes"); + my $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); + my @menu = ({ url => $url, + name => &mt('Manual Grading/View Submissions'), + short_description => + &mt('Start the process of hand grading submissions.'), + }); + $fields{'command'} = 'csvform'; + $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); + 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, + 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'), + short_description => + &mt('')}); + $fields{'command'} = 'verify'; + $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); + push (@menu, { url => "", + name => &mt('Verify Receipt'), + short_description => + &mt('')}); + # + # Create the menu + my $Str; + # $Str .= '

    '.&mt('Please select a grading task').'

    '; + $Str .= '
    '; + $Str .= ''. + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + foreach my $menudata (@menu) { + if ($menudata->{'name'} ne &mt('Verify Receipt')) { + $Str .='

    {'jscript'}. + ' href="'. + $menudata->{'url'}.'" >'. + $menudata->{'name'}."

    \n"; + } else { + $Str .='

    {'jscript'}. + ' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '. + ' />

    '; + $Str .= (' 'x8). + &mt(' receipt: [_1]', + &Apache::lonnet::recprefix($env{'request.course.id'}). + '-'); + } + $Str .= ' '.(' 'x8).$menudata->{'short_description'}. + "\n"; + } + $Str .="
    \n"; + $request->print(< + function checkChoice(formname,val,cmdx) { + if (val <= 2) { + var cmd = radioSelection(formname.radioChoice); + var cmdsave = cmd; + } else { + cmd = cmdx; + cmdsave = 'submission'; + } + formname.command.value = cmd; + if (val < 5) formname.submit(); + if (val == 5) { + if (!checkReceiptNo(formname,'notOK')) { + return false; + } else { + formname.submit(); + } + } + } + + function checkReceiptNo(formname,nospace) { + var receiptNo = formname.receipt.value; + var checkOpt = false; + if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;} + if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;} + if (checkOpt) { + alert("Please enter a receipt number given by a student in the receipt box."); + formname.receipt.value = ""; + formname.receipt.focus(); + return false; + } + return true; + } + +GRADINGMENUJS + &commonJSfunctions($request); + return $Str; +} + + +#--- Displays the submissions first page ------- +sub submit_options { my ($request) = @_; my ($symb)=&get_symb($request); if (!$symb) {return '';} @@ -6125,9 +7555,8 @@ sub gradingmenu { GRADINGMENUJS &commonJSfunctions($request); - my $result='

     Manual Grading/View Submission

    '; my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); - $result.=$table; + my $result; my (undef,$sections) = &getclasslist('all','0'); my $savedState = &savedState(); my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'}); @@ -6144,88 +7573,104 @@ GRADINGMENUJS ''."\n". ''."\n"; - $result.='
    '."\n". - ''."\n". - '
    '."\n". - ' Select a Grading/Viewing Option
    '."\n"; - - $result.=''; - $result.=''; - - $result.=''."\n"; - - $result.=''."\n"; - - $result.=''."\n"; - - $result.='
    '."\n". - ' '.&mt('Select Section').': '."\n"; if (ref($sections)) { - foreach (sort (@$sections)) { - $result.=''."\n"; + foreach my $section (sort (@$sections)) { + $result.=''."\n"; } } $result.= '   '; - - $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); - - $result.='
    '. - '
    '. - '

    '. - ''. - '
    '."\n"; - - $result.='    		'; - - $result.=''; - $result.=''."\n"; - - $result.=''."\n"; - - $result.=''."\n"; - - if ((&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) && ($symb)) { - $result.=''."\n"; - } - $result.=''."\n"; - $result.=''."\n"; - - $result.='
    '. - ''. - ' '.&mt('scores from file').'
    '. - ''. - ' '.&mt('clicker file').'
    '. - ' scantron forms
    '. - ''. - ' '.&mt('receipt').': '. - &Apache::lonnet::recprefix($env{'request.course.id'}). - '-'. - '
    '. - ' access times.
    '. - ' saved CODEs.
    '."\n". - '
    '."\n". - '
    '."\n"; + $result.=' + + +
    +
    + '.&mt('Groups').' +
    +
    + '.&Apache::lonstatistics::GroupSelect('group','multiple',5).' +
    +
    +
    +
    + '.&mt('Access Status').' +
    +
    + '.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,5,undef,'mult').' +
    +
    +
    +
    + '.&mt('Submission Status').' +
    +
    + +
    +
    +
    +
    + +
    +
    + +
    +
    + +
    +
    + + +
    +

    + '.&mt('Grade Complete Folder for One Student').' +

    +
    +
    +
    + +
    +
    + +
    +
    +
    +
    + + '; return $result; } @@ -6259,9 +7704,10 @@ sub gather_clicker_ids { # Set up a couple variables. my $username_idx = &Apache::loncoursedata::CL_SNAME(); my $domain_idx = &Apache::loncoursedata::CL_SDOM(); + my $status_idx = &Apache::loncoursedata::CL_STATUS(); foreach my $student (keys(%$classlist)) { - + if ($classlist->{$student}->[$status_idx] ne 'Active') { next; } my $username = $classlist->{$student}->[$username_idx]; my $domain = $classlist->{$student}->[$domain_idx]; my $clickers = @@ -6398,9 +7844,9 @@ function sanitycheck() {
    -
    -
    -
    +
    +
    +

    @@ -6503,6 +7949,8 @@ ENDHEADER } $result.='
    '.&mt('Found [_1] question(s)',$number).'
    '. ''. + &mt('Awarding [_1] percent for corrion(s)',$number).'
    '. + ''. &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', $env{'form.pcorrect'},$env{'form.pincorrect'}). '
    '; @@ -6522,8 +7970,21 @@ ENDHEADER $result.="\n".''; $correct_count++; } elsif ($clicker_ids{$id}) { - $result.="\n".''; - $student_count++; + if ($clicker_ids{$id}=~/\,/) { +# More than one user with the same clicker! + $result.="\n
    ".&mt('Clicker registered more than once').": ".$id."
    "; + $result.="\n".''. + "'; + $unknown_count++; + } else { +# Good: found one and only one user with the right clicker + $result.="\n".''; + $student_count++; + } } else { $result.="\n
    ".&mt('Unregistered Clicker')." ".$id."
    "; $result.="\n".''. @@ -6543,6 +8004,9 @@ ENDHEADER $result.='
    '.&mt("Found [_1] entries for grading!",$correct_count).''; } } + if ($number<1) { + $errormsg.="Found no questions."; + } if ($errormsg) { $result.='
    '.&mt($errormsg).''; } else { @@ -6671,6 +8135,8 @@ ENDHEADER my $id=$1; if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) { $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id}; + } elsif ($env{'form.multi'.$id}) { + $user=$env{'form.multi'.$id}; } } if ($user) { @@ -6715,8 +8181,7 @@ ENDHEADER sub handler { my $request=$_[0]; - - &reset_perm(); + &reset_caches(); if ($env{'browser.mathml'}) { &Apache::loncommon::content_type($request,'text/xml'); } else { @@ -6728,9 +8193,12 @@ sub handler { my $symb=&get_symb($request,1); my @commands=&Apache::loncommon::get_env_multiple('form.command'); my $command=$commands[0]; + if ($#commands > 0) { &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); } + + $request->print(&Apache::loncommon::start_page('Grading')); if ($symb eq '' && $command eq '') { if ($env{'user.adv'}) { @@ -6771,7 +8239,9 @@ sub handler { } elsif ($command eq 'processGroup' && $perm{'vgr'}) { &processGroup($request); } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) { - $request->print(&gradingmenu($request)); + $request->print(&grading_menu($request)); + } elsif ($command eq 'submit_options' && $perm{'vgr'}) { + $request->print(&submit_options($request)); } elsif ($command eq 'viewgrades' && $perm{'vgr'}) { $request->print(&viewgrades($request)); } elsif ($command eq 'handgrade' && $perm{'mgr'}) { @@ -6829,6 +8299,7 @@ sub handler { } } $request->print(&Apache::loncommon::end_page()); + &reset_caches(); return ''; }