--- loncom/homework/grades.pm 2007/06/25 22:23:27 1.399.2.2 +++ loncom/homework/grades.pm 2008/01/09 14:16:52 1.502 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.399.2.2 2007/06/25 22:23:27 albertel Exp $ +# $Id: grades.pm,v 1.502 2008/01/09 14:16:52 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,47 +35,33 @@ 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); use Apache::lonlocal; use Apache::lonenc; use String::Similarity; -use lib '/home/httpd/lib/perl'; use LONCAPA; use POSIX qw(floor); -my %oldessays=(); + my %perm=(); -# ----- These first few routines are general use routines.---- # # --- 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); } } @@ -103,7 +89,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.')').')'; @@ -181,37 +167,69 @@ sub showResourceInfo { if (exists($partsseen{$partID})) { $result.=" "; } else { - $result.=""; + $result.=""; } $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(); +} -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"}); +{ + my %analyze_cache; + + 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. @@ -232,8 +250,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); @@ -252,31 +270,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})) { @@ -328,7 +346,10 @@ sub cleanRecord { $result.=''; return $result; } - + } elsif ( $response =~ m/(?:numerical|formula)/) { + $answer = + &Apache::loncommon::format_previous_attempt_value('submission', + $answer); } return $answer; } @@ -372,8 +393,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); @@ -382,10 +405,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; @@ -402,18 +434,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}); } @@ -486,6 +540,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 - } - $r->print(< -
- - $default_form_data - - - - - - - - - - - -
-  Download a scoring office file -
Filename of scoring office file: $file_selector
- -
- -
- -SCANTRONFORM - - $r->print(< -$grading_menu_button -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.' + + '.&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 } +=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) = @_; my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); @@ -4609,7 +5065,7 @@ sub get_scantron_config { $config{'IDstart'}=$config[5]; $config{'IDlength'}=$config[6]; $config{'Qstart'}=$config[7]; - $config{'Qlength'}=$config[8]; + $config{'Qlength'}=$config[8]; $config{'Qoff'}=$config[9]; $config{'Qon'}=$config[10]; $config{'PaperID'}=$config[11]; @@ -4623,6 +5079,25 @@ sub get_scantron_config { return %config; } +=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; @@ -4633,6 +5108,47 @@ sub username_to_idmap { return %idmap; } +=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)=@_; if ($field eq 'ID') { @@ -4691,6 +5207,25 @@ sub scantron_fixup_scanline { return $line; } +=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'}; @@ -4701,11 +5236,102 @@ sub scan_data { return $scan_data->{$filename.'_'.$key}; } +# ----- 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; +} + +=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); - my $data=substr($line,0,$$scantron_config{'Qstart'}-1); + my $questions=substr($line,$$scantron_config{'Qstart'}-1); # Answers + my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff if (!($$scantron_config{'CODElocation'} eq 0 || $$scantron_config{'CODElocation'} eq 'none')) { if ($$scantron_config{'CODElocation'} < 0 || @@ -4735,72 +5361,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) + || 1; + $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; } } } @@ -4808,6 +5533,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, @@ -4816,6 +5559,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'}; @@ -4830,6 +5591,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)=@_; @@ -4846,6 +5616,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'}); @@ -4891,7 +5670,7 @@ sub scantron_process_corrections { &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, $which,'answer', { 'question'=>$question, - 'response'=>$env{"form.scantron_correct_Q_$question"}}); + 'response'=>$env{"form.scantron_correct_Q_$question"}}); if ($err) { last; } } } @@ -4903,12 +5682,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')); @@ -4920,6 +5717,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_/) { @@ -4935,6 +5740,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; @@ -4948,13 +5762,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 occured ($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'}); @@ -4966,27 +5799,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); @@ -4996,28 +5838,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); @@ -5042,7 +5914,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(); } @@ -5061,7 +5933,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(); @@ -5078,9 +5950,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]; { @@ -5090,12 +5963,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(''); @@ -5103,21 +5976,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'}; @@ -5132,6 +6016,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'}; @@ -5149,11 +6045,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'}; @@ -5186,6 +6130,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'}; @@ -5195,6 +6154,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 @@ -5215,6 +6190,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; } @@ -5223,6 +6220,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; @@ -5234,6 +6248,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) { @@ -5244,6 +6277,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])) { @@ -5253,6 +6301,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)=@_; @@ -5269,6 +6326,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) = @_; @@ -5292,6 +6358,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) = @_; @@ -5302,6 +6377,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++) { @@ -5354,37 +6431,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 @@ -5397,14 +6506,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' @@ -5413,16 +6522,27 @@ sub scantron_get_correction { if ($closest > 0) { foreach my $testcode (@{$closest}) { my $checked=''; - if (!$i) { $checked=' checked="on" '; } - $r->print(""); + if (!$i) { $checked=' checked="checked" '; } + $r->print(" + + "); $r->print("\n
    "); $i++; } } } if ($$scan_record{'scantron.CODE'}=~/\S/ ) { - my $checked; if (!$i) { $checked=' checked="on" '; } - $r->print(""); + my $checked; if (!$i) { $checked=' checked="checked" '; } + $r->print(" + "); $r->print("\n
    "); } @@ -5444,48 +6564,152 @@ 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"); + + # The form field scantron_questions is acutally a list of line numbers. + # represented by this form so: + + my $line_list = &questions_to_line_list($arg); + $r->print(''); + $line_list.'" />'); $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"}; - &scantron_bubble_selector($r,$scan_config,$question,split('',$selected)); + &prompt_for_corrections($r, $question, $scan_config, $scan_record); } } 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"); + + # The form field scantron_questinos is actually a list of line numbers not + # a list of question numbers. Therefore: + # + + my $line_list = &questions_to_line_list($arg); + $r->print(''); + $line_list.'" />'); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; - &scantron_bubble_selector($r,$scan_config,$question); + &prompt_for_corrections($r, $question, $scan_config, $scan_record); } } else { $r->print("\n
      "); } $r->print("\n
    "); +} + +=pod + +=item questions_to_line_list + +Converts a list of questions into a string of comma separated +line numbers in the answer sheet used by the questions. This is +used to fill in the scantron_questions form field. + Arguments: + questions - Reference to an array of questions. + +=cut + + +sub questions_to_line_list { + my ($questions) = @_; + my @lines; + + foreach my $question (@{$questions}) { + my $first = $first_bubble_line{$question-1} + 1; + my $count = $bubble_lines_per_response{$question-1}; + my $last = $first+$count-1; + push(@lines, ($first..$last)); + } + return join(',', @lines); +} + +=pod + +=item prompt_for_corrections + +Prompts for a potentially multiline correction to the +user's bubbling (factors out common code from scantron_get_correction +for multi and missing bubble cases). + + Arguments: + $r - Apache request object. + $question - The question number to prompt for. + $scan_config - The scantron file configuration hash. + $scan_record - Reference to the hash that has the the parsed scanlines. + + Implicit inputs: + %bubble_lines_per_response - Starting line numbers for each question. + Numbered from 0 (but question numbers are from + 1. + %first_bubble_line - Starting bubble line for each question. + +=cut + +sub prompt_for_corrections { + my ($r, $question, $scan_config, $scan_record) = @_; + + my $lines = $bubble_lines_per_response{$question-1}; + my $current_line = $first_bubble_line{$question-1} + 1 ; + + if ($lines > 1) { + $r->print(&mt("The group of bubble lines below responds to a single question. Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."
    "); + } + for (my $i =0; $i < $lines; $i++) { + my $selected = $$scan_record{"scantron.$current_line.answer"}; + &scantron_bubble_selector($r, $scan_config, $current_line, + split('', $selected)); + $current_line++; + } + if ($lines > 1) { + $r->print("

    "); + } } +=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() + $line - Number of the line being displayed. + @selected - Array of bubbles picked on this line. + +=cut + sub scantron_bubble_selector { - my ($r,$scan_config,$quest,@selected)=@_; + my ($r,$scan_config,$line,@selected)=@_; my $max=$$scan_config{'Qlength'}; my $scmode=$$scan_config{'Qon'}; if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } my @alphabet=('A'..'Z'); - $r->print(""); + $r->print("
    $quest
    "); for (my $i=0;$i<$max+1;$i++) { $r->print("\n".'"); + $line.'" value="'.$i.'" />'.$alphabet[$i].""); } $r->print(''); + $line.'" value="none" /> No bubble '); $r->print('
    $line'); if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } @@ -5496,13 +6720,29 @@ sub scantron_bubble_selector { for (my $i=0;$i<$max;$i++) { $r->print("\n". '
    '); } +=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); @@ -5514,6 +6754,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; @@ -5524,6 +6784,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) { @@ -5546,6 +6823,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'}); @@ -5563,6 +6850,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); @@ -5597,6 +6886,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 @@ -5606,6 +6904,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; } @@ -5620,32 +6921,100 @@ 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(); 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 @@ -5664,6 +7033,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); @@ -5678,6 +7050,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'}); @@ -5712,6 +7108,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++; @@ -5762,8 +7161,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; } } @@ -5782,6 +7179,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'})); @@ -5791,7 +7196,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 { @@ -5838,7 +7256,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() @@ -5856,13 +7274,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) { @@ -5873,6 +7296,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())) { @@ -5881,6 +7312,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)); @@ -5888,11 +7329,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; } @@ -5902,21 +7343,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 ------- # #------------------------------------------------------------------- @@ -5930,7 +7380,7 @@ sub show_grading_menu_form { ''."\n". ''."\n". ''."\n". - ''."\n". + ''."\n". ''."\n"; return $result; } @@ -5947,8 +7397,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 '';} @@ -5991,9 +7561,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'}); @@ -6010,84 +7579,105 @@ 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"; - } - } - $result.= '   '; - - $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); - - $result.='
    '. - '
    '. - '

    '. - ''. - '
    '."\n"; - - $result.='    		'; - - $result.=''; - $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').'
    '. - ' scantron forms
    '. - ''. - ' '.&mt('receipt').': '. - &Apache::lonnet::recprefix($env{'request.course.id'}). - '-'. - '
    '. - ' access times.
    '. - ' saved CODEs.
    '."\n". - '
    '."\n". - '
    '."\n"; + foreach my $section (sort (@$sections)) { + $result.=''."\n"; + } + } + $result.= '   '; + $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').' +

    +
    +
    +
    + +
    +
    + +
    +
    +
    +
    + + '; + $result .= &show_grading_menu_form($symb); return $result; } @@ -6113,10 +7703,490 @@ sub init_perm { } } +sub gather_clicker_ids { + my %clicker_ids; + + my $classlist = &Apache::loncoursedata::get_classlist(); + + # 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 = + (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; + foreach my $id (split(/\,/,$clickers)) { + $id=~s/^[\#0]+//; + $id=~s/[\-\:]//g; + if (exists($clicker_ids{$id})) { + $clicker_ids{$id}.=','.$username.':'.$domain; + } else { + $clicker_ids{$id}=$username.':'.$domain; + } + } + } + return %clicker_ids; +} + +sub gather_adv_clicker_ids { + my %clicker_ids; + my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; + my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum); + foreach my $element (sort(keys(%coursepersonnel))) { + foreach my $person (split(/\,/,$coursepersonnel{$element})) { + my ($puname,$pudom)=split(/\:/,$person); + my $clickers = + (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; + foreach my $id (split(/\,/,$clickers)) { + $id=~s/^[\#0]+//; + $id=~s/[\-\:]//g; + if (exists($clicker_ids{$id})) { + $clicker_ids{$id}.=','.$puname.':'.$pudom; + } else { + $clicker_ids{$id}=$puname.':'.$pudom; + } + } + } + } + return %clicker_ids; +} + +sub clicker_grading_parameters { + return ('gradingmechanism' => 'scalar', + 'upfiletype' => 'scalar', + 'specificid' => 'scalar', + 'pcorrect' => 'scalar', + 'pincorrect' => 'scalar'); +} + +sub process_clicker { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + my $result=&checkforfile_js(); + $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb); + my ($table) = &showResourceInfo($symb,$env{'form.probTitle'}); + $result.=$table; + $result.='
    '."\n"; + $result.=''."\n"; + $result.='
    '."\n"; + $result.=' '.&mt('Specify a file containing the clicker information for this resource'). + '.
    '."\n"; +# Attempt to restore parameters from last session, set defaults if not present + my %Saveable_Parameters=&clicker_grading_parameters(); + &Apache::loncommon::restore_course_settings('grades_clicker', + \%Saveable_Parameters); + if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; } + if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; } + if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; } + if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; } + + my %checked; + foreach my $gradingmechanism ('attendance','personnel','specific') { + if ($env{'form.gradingmechanism'} eq $gradingmechanism) { + $checked{$gradingmechanism}="checked='checked'"; + } + } + + my $upload=&mt("Upload File"); + my $type=&mt("Type"); + my $attendance=&mt("Award points just for participation"); + my $personnel=&mt("Correctness determined from response by course personnel"); + my $specific=&mt("Correctness determined from response with clicker ID(s)"); + my $pcorrect=&mt("Percentage points for correct solution"); + my $pincorrect=&mt("Percentage points for incorrect solution"); + my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', + ('iclicker' => 'i>clicker', + 'interwrite' => 'interwrite PRS')); + $symb = &Apache::lonenc::check_encrypt($symb); + $result.=< +function sanitycheck() { +// Accept only integer percentages + document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value); + document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value); +// Find out grading choice + for (i=0; i +
    + + + + + +
    +
    +
    +
    + + +
    +
    +
    +
    +ENDUPFORM + $result.='
    '."\n". + '


    '."\n"; + $result.=&show_grading_menu_form($symb); + return $result; +} + +sub process_clicker_file { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + + my %Saveable_Parameters=&clicker_grading_parameters(); + &Apache::loncommon::store_course_settings('grades_clicker', + \%Saveable_Parameters); + + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { + $result.=''.&mt('You need to specify a clicker ID for the correct answer').''; + return $result.&show_grading_menu_form($symb); + } + my %clicker_ids=&gather_clicker_ids(); + my %correct_ids; + if ($env{'form.gradingmechanism'} eq 'personnel') { + %correct_ids=&gather_adv_clicker_ids(); + } + if ($env{'form.gradingmechanism'} eq 'specific') { + foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; + $correct_id=~tr/a-z/A-Z/; + $correct_id=~s/\s//gs; + $correct_id=~s/^[\#0]+//; + $correct_id=~s/[\-\:]//g; + if ($correct_id) { + $correct_ids{$correct_id}='specified'; + } + } + } + if ($env{'form.gradingmechanism'} eq 'attendance') { + $result.=&mt('Score based on attendance only'); + } else { + my $number=0; + $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.="

    \n"; + if ($number==0) { + $result.=''.&mt('No IDs found to determine correct answer').''; + return $result.&show_grading_menu_form($symb); + } + } + if (length($env{'form.upfile'}) < 2) { + $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.', + '', + '', + ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''); + return $result.&show_grading_menu_form($symb); + } + +# Were able to get all the info needed, now analyze the file + + $result.=&Apache::loncommon::studentbrowser_javascript(); + $symb = &Apache::lonenc::check_encrypt($symb); + my $heading=&mt('Scanning clicker file'); + $result.=(<
    +
    +$heading
    +
    + + + + + + + +ENDHEADER + my %responses; + my @questiontitles; + my $errormsg=''; + my $number=0; + if ($env{'form.upfiletype'} eq 'iclicker') { + ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); + } + if ($env{'form.upfiletype'} eq 'interwrite') { + ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); + } + $result.='
    '.&mt('Found [_1] question(s)',$number).'
    '. + ''. + &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', + $env{'form.pcorrect'},$env{'form.pincorrect'}). + '
    '; +# Remember Question Titles +# FIXME: Possibly need delimiter other than ":" + for (my $i=0;$i<$number;$i++) { + $result.='').'" />'; + } + my $correct_count=0; + my $student_count=0; + my $unknown_count=0; +# Match answers with usernames +# FIXME: Possibly need delimiter other than ":" + foreach my $id (keys(%responses)) { + if ($correct_ids{$id}) { + $result.="\n".''; + $correct_count++; + } elsif ($clicker_ids{$id}) { + 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".''. + "\n".&mt("Username").":  ". + "\n".&mt("Domain").": ". + &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '. + &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id); + $unknown_count++; + } + } + $result.='
    '. + &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); + if ($env{'form.gradingmechanism'} ne 'attendance') { + if ($correct_count==0) { + $errormsg.="Found no correct answers answers for grading!"; + } elsif ($correct_count>1) { + $result.='
    '.&mt("Found [_1] entries for grading!",$correct_count).''; + } + } + if ($number<1) { + $errormsg.="Found no questions."; + } + if ($errormsg) { + $result.='
    '.&mt($errormsg).''; + } else { + $result.='
    '; + } + $result.='
    '."\n". + '


    '."\n"; + return $result.&show_grading_menu_form($symb); +} + +sub iclicker_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[0] eq 'Question') { + for (my $i=3;$i<$#entries;$i+=6) { + $$questiontitles[$number]=$entries[$i]; + $number++; + } + } + if ($entries[0]=~/^\#/) { + my $id=$entries[0]; + my @idresponses; + $id=~s/^[\#0]+//; + for (my $i=0;$i<$number;$i++) { + my $idx=3+$i*6; + push(@idresponses,$entries[$idx]); + } + $$responses{$id}=join(',',@idresponses); + } + } + return ($errormsg,$number); +} + +sub interwrite_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + my $skipline=1; + my $questionnumber=0; + my %idresponses=(); + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[1] eq 'Time') { $skipline=0; next; } + if ($entries[1] eq 'Response') { $skipline=1; } + next if $skipline; + if ($entries[0]!=$questionnumber) { + $questionnumber=$entries[0]; + $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); + $number++; + } + my $id=$entries[4]; + $id=~s/^[\#0]+//; + $id=~s/^v\d*\://i; + $id=~s/[\-\:]//g; + $idresponses{$id}[$number]=$entries[6]; + } + foreach my $id (keys %idresponses) { + $$responses{$id}=join(',',@{$idresponses{$id}}); + $$responses{$id}=~s/^\s*\,//; + } + return ($errormsg,$number); +} + +sub assign_clicker_grades { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} +# See which part we are saving to + my ($partlist,$handgrade,$responseType) = &response_type($symb); +# FIXME: This should probably look for the first handgradeable part + my $part=$$partlist[0]; +# Start screen output + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + + my $heading=&mt('Assigning grades based on clicker file'); + $result.=(<
    +
    +$heading
    +ENDHEADER +# Get correct result +# FIXME: Possibly need delimiter other than ":" + my @correct=(); + my $gradingmechanism=$env{'form.gradingmechanism'}; + my $number=$env{'form.number'}; + if ($gradingmechanism ne 'attendance') { + foreach my $key (keys(%env)) { + if ($key=~/^form\.correct\:/) { + my @input=split(/\,/,$env{$key}); + for (my $i=0;$i<=$#input;$i++) { + if (($correct[$i]) && ($input[$i]) && + ($correct[$i] ne $input[$i])) { + $result.='
    '. + &mt('More than one correct result given for question "[_1]": [_2] versus [_3].', + $env{'form.question:'.$i},$correct[$i],$input[$i]).''; + } elsif ($input[$i]) { + $correct[$i]=$input[$i]; + } + } + } + } + for (my $i=0;$i<$number;$i++) { + if (!$correct[$i]) { + $result.='
    '. + &mt('No correct result given for question "[_1]"!', + $env{'form.question:'.$i}).''; + } + } + $result.='
    '.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct)); + } +# Start grading + my $pcorrect=$env{'form.pcorrect'}; + my $pincorrect=$env{'form.pincorrect'}; + my $storecount=0; + foreach my $key (keys(%env)) { + my $user=''; + if ($key=~/^form\.student\:(.*)$/) { + $user=$1; + } + if ($key=~/^form\.unknown\:(.*)$/) { + 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) { + my @answer=split(/\,/,$env{$key}); + my $sum=0; + for (my $i=0;$i<$number;$i++) { + if ($answer[$i]) { + if ($gradingmechanism eq 'attendance') { + $sum+=$pcorrect; + } else { + if ($answer[$i] eq $correct[$i]) { + $sum+=$pcorrect; + } else { + $sum+=$pincorrect; + } + } + } + } + my $ave=$sum/(100*$number); +# Store + my ($username,$domain)=split(/\:/,$user); + my %grades=(); + $grades{"resource.$part.solved"}='correct_by_override'; + $grades{"resource.$part.awarded"}=$ave; + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $returncode=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($returncode ne 'ok') { + $result.="
    Failed to save student $username:$domain. Message when trying to save was ($returncode)"; + } else { + $storecount++; + } + } + } +# We are done + $result.='
    '.&mt('Successfully stored grades for [_1] student(s).',$storecount). + '
    '."\n". + '


    '."\n"; + return $result.&show_grading_menu_form($symb); +} + sub handler { my $request=$_[0]; - - &reset_perm(); + &reset_caches(); if ($env{'browser.mathml'}) { &Apache::loncommon::content_type($request,'text/xml'); } else { @@ -6128,9 +8198,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'}) { @@ -6171,7 +8244,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'}) { @@ -6180,6 +8255,12 @@ sub handler { $request->print(&editgrades($request)); } elsif ($command eq 'verify' && $perm{'vgr'}) { $request->print(&verifyreceipt($request)); + } elsif ($command eq 'processclicker' && $perm{'mgr'}) { + $request->print(&process_clicker($request)); + } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { + $request->print(&process_clicker_file($request)); + } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) { + $request->print(&assign_clicker_grades($request)); } elsif ($command eq 'csvform' && $perm{'mgr'}) { $request->print(&upcsvScores_form($request)); } elsif ($command eq 'csvupload' && $perm{'mgr'}) { @@ -6223,6 +8304,7 @@ sub handler { } } $request->print(&Apache::loncommon::end_page()); + &reset_caches(); return ''; }