--- loncom/homework/grades.pm 2007/07/04 20:28:44 1.420 +++ loncom/homework/grades.pm 2007/07/24 21:21:31 1.423 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.420 2007/07/04 20:28:44 www Exp $ +# $Id: grades.pm,v 1.423 2007/07/24 21:21:31 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 +4459,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 exisiting 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 +4554,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.= < @@ -4511,6 +4609,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 +4656,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 +4694,62 @@ 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 charater 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 buble 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 firs tname 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 +4782,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 containng 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 +4811,50 @@ sub username_to_idmap { return %idmap; } +=pod + +=item scatron_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 exisiting one + - 'CODE' + 'CODE_ignore_dup' - set to true if duplicates + should be ignored. + 'CODE' - is new code or 'use_unfound' + if the exisitng 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 +4911,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 + scatronfilename_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 +4940,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 +5026,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 +5099,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 erro messages + $scanline - the scanline that caused the error + $errormesage - the error message + $errorcode - a numeric code for the error + + Side Effects: + updates the $dealyqueue to have a new hash ref of the error + +=cut + sub scantron_add_delay { my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; push(@$delayqueue, @@ -4815,6 +5125,12 @@ sub scantron_add_delay { ); } +=pod + +=item scantron_find_student + +=cut + sub scantron_find_student { my ($scantron_record,$scan_data,$idmap,$line)=@_; my $scanID=$$scantron_record{'scantron.ID'}; @@ -4829,6 +5145,12 @@ sub scantron_find_student { return undef; } +=pod + +=item scantron_filter + +=cut + sub scantron_filter { my ($curres)=@_; @@ -4845,6 +5167,12 @@ sub scantron_filter { return 0; } +=pod + +=item scantron_process_corrections + +=cut + sub scantron_process_corrections { my ($r) = @_; my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); @@ -4902,12 +5230,24 @@ sub scantron_process_corrections { } } +=pod + +=item reset_skipping_status + +=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 + +=cut + sub start_skipping { my ($scan_data,$i)=@_; my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); @@ -4919,6 +5259,12 @@ sub start_skipping { &scan_data($scan_data,'remember_skipping',join(':',%remembered)); } +=pod + +=item should_be_skipped + +=cut + sub should_be_skipped { my ($scanlines,$scan_data,$i)=@_; if ($env{'form.scantron_options_redo'} !~ /^redo_/) { @@ -4934,6 +5280,12 @@ sub should_be_skipped { return 1; } +=pod + +=item remember_current_skipped + +=cut + sub remember_current_skipped { my ($scanlines,$scan_data)=&scantron_getfile(); my %to_remember; @@ -4947,6 +5299,12 @@ sub remember_current_skipped { &scantron_putfile(undef,$scan_data); } +=pod + +=item check_for_error + +=cut + sub check_for_error { my ($r,$result)=@_; if ($result ne 'ok' && $result ne 'not_found' ) { @@ -4954,6 +5312,12 @@ sub check_for_error { } } +=pod + +=item scantron_warning_screen + +=cut + sub scantron_warning_screen { my ($button_text)=@_; my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); @@ -4986,6 +5350,12 @@ $CODElist STUFF } +=pod + +=item scantron_do_warning + +=cut + sub scantron_do_warning { my ($r)=@_; my ($symb)=&get_symb($r); @@ -5017,6 +5387,12 @@ STUFF return ''; } +=pod + +=item scantron_form_start + +=cut + sub scantron_form_start { my ($max_bubble)=@_; my $result= <{'orig'}[$i]; } +=pod + +=item scantron_todo_count + +=cut + sub get_todo_count { my ($scanlines,$scan_data)=@_; my $count=0; @@ -5233,6 +5660,12 @@ sub get_todo_count { return $count; } +=pod + +=item scantron_put_line + +=cut + sub scantron_put_line { my ($scanlines,$scan_data,$i,$newline,$skip)=@_; if ($skip) { @@ -5243,6 +5676,12 @@ sub scantron_put_line { $scanlines->{'corrected'}[$i]=$newline; } +=pod + +=item scantron_clear_skip + +=cut + sub scantron_clear_skip { my ($scanlines,$scan_data,$i)=@_; if (exists($scanlines->{'skipped'}[$i])) { @@ -5252,6 +5691,12 @@ sub scantron_clear_skip { return 0; } +=pod + +=item scantron_filter_not_exam + +=cut + sub scantron_filter_not_exam { my ($curres)=@_; @@ -5268,6 +5713,12 @@ sub scantron_filter_not_exam { return 0; } +=pod + +=item scantron_validate_sequence + +=cut + sub scantron_validate_sequence { my ($r,$currentphase) = @_; @@ -5291,6 +5742,12 @@ sub scantron_validate_sequence { return (0,$currentphase+1); } +=pod + +=item scantron_validate_ID + +=cut + sub scantron_validate_ID { my ($r,$currentphase) = @_; @@ -5353,6 +5810,12 @@ sub scantron_validate_ID { return (0,$currentphase+1); } +=pod + +=item scantron_get_correction + +=cut + sub scantron_get_correction { my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; @@ -5456,7 +5919,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 +5940,89 @@ ENDSCRIPT } +=pod + +=item scantron_bubble_selector + + Generates the html radiobuttons to correct a single bubble line + possibly showing the exisiting 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 + +=cut + sub num_matches { my ($orig,$code) = @_; my @code=split(//,$code); @@ -5513,6 +6034,12 @@ sub num_matches { return $same; } +=pod + +=item scantron_get_closely_matching_CODEs + +=cut + sub scantron_get_closely_matching_CODEs { my ($allcodes,$CODE)=@_; my @CODEs; @@ -5523,6 +6050,12 @@ sub scantron_get_closely_matching_CODEs return ($#CODEs,$CODEs[-1]); } +=pod + +=item get_codes + +=cut + sub get_codes { my ($old_name, $cdom, $cnum) = @_; if (!$old_name) { @@ -5545,6 +6078,12 @@ sub get_codes { return %allcodes; } +=pod + +=item scantron_validate_CODE + +=cut + sub scantron_validate_CODE { my ($r,$currentphase) = @_; my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); @@ -5596,6 +6135,12 @@ sub scantron_validate_CODE { return (0,$currentphase+1); } +=pod + +=item scantron_validate_doublebubble + +=cut + sub scantron_validate_doublebubble { my ($r,$currentphase) = @_; #get student info @@ -5619,6 +6164,12 @@ sub scantron_validate_doublebubble { return (0,$currentphase+1); } +=pod + +=item scantron_get_maxbubble + +=cut + sub scantron_get_maxbubble { if (defined($env{'form.scantron_maxbubble'}) && $env{'form.scantron_maxbubble'}) { @@ -5645,6 +6196,12 @@ sub scantron_get_maxbubble { return $env{'form.scantron_maxbubble'}; } +=pod + +=item scantron_validate_missingbubbles + +=cut + sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info @@ -5677,6 +6234,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 +6362,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 +6406,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 +6470,14 @@ sub scantron_upload_scantron_data_save { return ''; } +=pod + +=item valid_file + + Vaildates that the requested bubble data file has exists in the course. + +=cut + sub valid_file { my ($requested_file)=@_; foreach my $filename (sort(&scantron_filenames())) { @@ -5880,6 +6486,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 +6532,12 @@ DOWNLOAD return ''; } +=pod + +=back + +=cut + #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -6133,6 +6755,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 +6778,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 { @@ -6301,6 +6925,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'; } @@ -6462,6 +7087,8 @@ sub interwrite_eval { } 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) {