--- loncom/homework/grades.pm 2007/06/22 23:45:19 1.418 +++ loncom/homework/grades.pm 2007/07/25 00:11:05 1.425 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.418 2007/06/22 23:45:19 albertel Exp $ +# $Id: grades.pm,v 1.425 2007/07/25 00:11:05 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3827,7 +3827,7 @@ LISTJAVASCRIPT $result.='
'."\n"; $result.=' Problems from: '."\n"; } +=pod + +=item getSequenceDropDown + + Return html dropdown of possible sequences to grade + + Arguments: + $symb - $symb of the current resource + +=cut + sub getSequenceDropDown { - my ($request,$symb)=@_; + my ($symb)=@_; my $result=''; @@ -4405,6 +4497,15 @@ sub scantron_uploads { return $result; } +=pod + +=item scantron_scantab + + Returns html drop down of the scantron formats in the scantronformat.tab + file. + +=cut + sub scantron_scantab { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my $result=' Yes + value="yes" checked="checked" />'.&mt('Yes').' + value="no" />'.&mt('No').' '; return $result; } +=pod + +=item scantron_selectphase + + Generates the initial screen to start the bubble sheet process. + Allows for - starting a grading run. + - downloading existing scan data (original, corrected + or skipped info) + + - uploading new scan data + + Arguments: + $r - The Apache request object + $file2grade - name of the file that contain the scanned data to score + +=cut + sub scantron_selectphase { my ($r,$file2grade) = @_; my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $sequence_selector=&getSequenceDropDown($r,$symb); + my $sequence_selector=&getSequenceDropDown($symb); my $default_form_data=&defaultFormData($symb); my $grading_menu_button=&show_grading_menu_form($symb); my $file_selector=&scantron_uploads($file2grade); @@ -4457,8 +4592,9 @@ sub scantron_selectphase { my $CODE_selector=&scantron_CODElist(); my $CODE_unique=&scantron_CODEunique(); my $result; - #FIXME allow instructor to be able to download the scantron file - # and to upload it, + + # Chunk of form to prompt for a file to grade and how: + $result.= < @@ -4491,7 +4627,7 @@ sub scantron_selectphase { Options:
-
+
@@ -4511,6 +4647,8 @@ SCANTRONFORM if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { + # Chunk of form to prompt for a scantron file upload. + $r->print(< @@ -4556,6 +4694,10 @@ UPLOAD SCANTRONFORM } + + # Chunk of the form that prompts to view a scoring office file, + # corrected file, skipped records in a file. + $r->print(< @@ -4590,6 +4732,63 @@ SCANTRONFORM 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'); @@ -4622,6 +4821,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; @@ -4632,8 +4850,50 @@ 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') { if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { return ($line,1,'New value too large'); @@ -4690,6 +4950,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'}; @@ -4700,11 +4979,63 @@ sub scan_data { return $scan_data->{$filename.'_'.$key}; } +=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 bubbled line numbers that had a blank bubble + that is considered an error (if the operator had already + okayed a blank bubble line as really being blank then + that bubble line number won't appear here. + doubleerror - a list of bubbled line numbers that had more than one + bubble filled in and has not been corrected by the + operator + 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 || @@ -4734,7 +5065,7 @@ 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; @@ -4807,6 +5138,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, @@ -4815,6 +5164,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'}; @@ -4829,6 +5196,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)=@_; @@ -4845,6 +5221,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'}); @@ -4902,12 +5287,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')); @@ -4919,6 +5322,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_/) { @@ -4934,6 +5345,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; @@ -4947,6 +5367,16 @@ 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' ) { @@ -4954,6 +5384,15 @@ sub check_for_error { } } +=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'}); @@ -4986,6 +5425,15 @@ $CODElist 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); @@ -5017,6 +5465,14 @@ STUFF 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= <print("

Gathering neccessary info.

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

Gathering necessary info.

");$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); my $max_bubble=&scantron_get_maxbubble(); @@ -5117,6 +5585,17 @@ STUFF 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'}; @@ -5131,6 +5610,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'}; @@ -5153,6 +5644,51 @@ sub scantron_remove_scan_data { 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'}; @@ -5185,6 +5721,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'}; @@ -5194,6 +5745,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 @@ -5214,6 +5781,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; } @@ -5222,6 +5811,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; @@ -5233,6 +5839,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) { @@ -5243,6 +5868,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])) { @@ -5252,6 +5892,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)=@_; @@ -5268,6 +5917,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) = @_; @@ -5291,6 +5949,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) = @_; @@ -5353,6 +6020,36 @@ 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)=@_; @@ -5456,7 +6153,8 @@ ENDSCRIPT $r->print("

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)); + &scantron_bubble_selector($r,$scan_config,$question, + split('',$selected)); } } elsif ($error eq 'missingbubble') { $r->print("

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

\n"); @@ -5476,32 +6174,99 @@ ENDSCRIPT } +=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 + $selected - array of letters of previously selected bubbles + $lines - if present, number of bubble lines to show + +=cut + sub scantron_bubble_selector { - my ($r,$scan_config,$quest,@selected)=@_; + my ($r,$scan_config,$quest,@selected, $lines)=@_; 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(""); - for (my $i=0;$i<$max+1;$i++) { - $r->print("\n".''); - } - $r->print(''); - for (my $i=0;$i<$max;$i++) { - $r->print("\n". - '"); + + if (!defined($lines)) { + $lines = 1; } - $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. + + for (my $i=0;$i<$max;$i++) { + $r->print("\n".''); + + } + + if ($l == 0) { + my $lspan = $total_lines * 2; # 2 table rows per bubble line. + + $r->print(''); - $r->print('
$quest'); - if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } - else { $r->print(' '); } - $r->print('
$quest
'); + if ($selected[0] eq $alphabet[$i]) { + $r->print('X'); + shift(@selected) ; + } else { + $r->print(' '); + } + $r->print('
'); + + } + + $r->print(''); + + # FIXME: This may have to be a bit more clever for + # multiline questions (different values e.g..). + + for (my $i=0;$i<$max;$i++) { + $r->print("\n". + '"); + } + $r->print(''); + + + } + $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); @@ -5513,6 +6278,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; @@ -5523,6 +6308,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) { @@ -5545,6 +6347,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'}); @@ -5596,6 +6408,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 @@ -5619,6 +6440,19 @@ 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 result to $env{'form.scantron_maxbubble'} + +=cut + sub scantron_get_maxbubble { if (defined($env{'form.scantron_maxbubble'}) && $env{'form.scantron_maxbubble'}) { @@ -5645,6 +6479,15 @@ sub scantron_get_maxbubble { return $env{'form.scantron_maxbubble'}; } +=pod + +=item scantron_validate_missingbubbles + + Validates all scanlines in the selected file to not have any + bubble lines with missing bubbles that haven't been verified as missing. + +=cut + sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info @@ -5677,6 +6520,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'}); @@ -5781,6 +6648,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'})); @@ -5817,6 +6692,15 @@ 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); @@ -5872,6 +6756,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())) { @@ -5880,6 +6772,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)); @@ -5916,6 +6818,12 @@ DOWNLOAD return ''; } +=pod + +=back + +=cut + #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -6133,6 +7041,7 @@ sub gather_clicker_ids { (&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 { @@ -6155,6 +7064,7 @@ sub gather_adv_clicker_ids { (&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 { @@ -6211,7 +7121,8 @@ sub process_clicker { 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')); + ('iclicker' => 'i>clicker', + 'interwrite' => 'interwrite PRS')); $symb = &Apache::lonenc::check_encrypt($symb); $result.=< @@ -6300,6 +7211,7 @@ sub process_clicker_file { $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'; } @@ -6359,6 +7271,9 @@ ENDHEADER 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', @@ -6438,6 +7353,37 @@ sub iclicker_eval { 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); @@ -6490,8 +7436,17 @@ ENDHEADER my $pincorrect=$env{'form.pincorrect'}; my $storecount=0; foreach my $key (keys(%env)) { + my $user=''; if ($key=~/^form\.student\:(.*)$/) { - my $user=$1; + $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}; + } + } + if ($user) { my @answer=split(/\,/,$env{$key}); my $sum=0; for (my $i=0;$i<$number;$i++) {