--- loncom/homework/grades.pm 2011/10/09 23:23:03 1.657 +++ loncom/homework/grades.pm 2011/12/03 01:16:39 1.666 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.657 2011/10/09 23:23:03 raeburn Exp $ +# $Id: grades.pm,v 1.666 2011/12/03 01:16:39 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -341,7 +341,7 @@ sub cleanRecord { return '
'. ''.$toprow.''. ''. - $grayFont.$bottomrow.''.'
'.&mt('Answer').'
'.$grayFont.&mt('Option ID').'
'; + $bottomrow.''; } elsif ($response eq 'match') { my %answer=&Apache::lonnet::str2hash($answer); my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); @@ -363,7 +363,7 @@ sub cleanRecord { ''.$grayFont.&mt('Item ID').''. $middlerow.''. ''.$grayFont.&mt('Option ID').''. - $bottomrow.''.''; + $bottomrow.''; } elsif ($response eq 'radiobutton') { my %answer=&Apache::lonnet::str2hash($answer); my ($toprow,$bottomrow); @@ -384,7 +384,7 @@ sub cleanRecord { return '
'. ''.$toprow.''. ''. - $bottomrow.''.'
'.&mt('Answer').'
'.$grayFont.&mt('Option ID').'
'; + $bottomrow.''; } elsif ($response eq 'essay') { if (! exists ($env{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', @@ -2027,7 +2027,7 @@ sub submission { keyw => 'Keyword Options', list => 'List', past => 'Paste Selection to List', - high => 'Hightlight Attribute', + high => 'Highlight Attribute', ); # # Print out the keyword options line @@ -2905,8 +2905,10 @@ sub handback_files { &file_name_version_ext($answer_file); my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); my $getpropath = 1; - my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath); - my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); + my ($dir_list,$listerror) = + &Apache::lonnet::dirlist($portfolio_root.$portfolio_path, + $domain,$stuname,$getpropath); + my $version = &get_next_version($answer_name,$answer_ext,$dir_list); # fix file name my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, @@ -3067,8 +3069,10 @@ sub version_portfiles { my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file); my $getpropath = 1; - my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath); - my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); + my ($dir_list,$listerror) = + &Apache::lonnet::dirlist($portfolio_root.$directory,$domain, + $stu_name,$getpropath); + my $version = &get_next_version($answer_name,$answer_ext,$dir_list); my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); if ($new_answer ne 'problem getting file') { push(@versioned_portfiles, $directory.$new_answer); @@ -3087,21 +3091,24 @@ sub version_portfiles { sub get_next_version { my ($answer_name, $answer_ext, $dir_list) = @_; my $version; - foreach my $row (@$dir_list) { - my ($file) = split(/\&/,$row,2); - my ($file_name,$file_version,$file_ext) = - &file_name_version_ext($file); - if (($file_name eq $answer_name) && - ($file_ext eq $answer_ext)) { - # gets here if filename and extension match, regardless of version + if (ref($dir_list) eq 'ARRAY') { + foreach my $row (@{$dir_list}) { + my ($file) = split(/\&/,$row,2); + my ($file_name,$file_version,$file_ext) = + &file_name_version_ext($file); + if (($file_name eq $answer_name) && + ($file_ext eq $answer_ext)) { + # gets here if filename and extension match, + # regardless of version if ($file_version ne '') { - # a versioned file is found so save it for later - if ($file_version > $version) { - $version = $file_version; - } + # a versioned file is found so save it for later + if ($file_version > $version) { + $version = $file_version; + } + } } } - } + } $version ++; return($version); } @@ -4837,12 +4844,12 @@ sub updateGradeByPage { from the file that we are parsing that represents one entire sheet 'bubble line' refers to the data - representing the line of bubbles that are on the physical bubble sheet + representing the line of bubbles that are on the physical bubblesheet -The overall process is that a scanned in bubble sheet data is uploaded +The overall process is that a scanned in bubblesheet data is uploaded into a course. When a user wants to grade, they select a -sequence/folder of resources, a file of bubble sheet info, and pick +sequence/folder of resources, a file of bubblesheet info, and pick one of the predefined configurations for what each scanline looks like. @@ -4858,14 +4865,14 @@ username:domain. During the validation phase the instructor can choose to skip scanlines. -After the validation phase, there are now 3 bubble sheet files +After the validation phase, there are now 3 bubblesheet files scantron_original_filename (unmodified original file) scantron_corrected_filename (file where the corrected information has replaced the original information) scantron_skipped_filename (contains the exact text of scanlines that where skipped) Also there is a separate hash nohist_scantrondata that contains extra -correction information that isn't representable in the bubble sheet +correction information that isn't representable in the bubblesheet file (see &scantron_getfile() for more information) After all scanlines are either valid, marked as valid or skipped, then @@ -4999,14 +5006,16 @@ sub scantron_filenames { my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; my $getpropath = 1; - my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, - $getpropath); + my ($dirlist,$listerror) = &Apache::lonnet::dirlist('userfiles',$cdom, + $cname,$getpropath); my @possiblenames; - foreach my $filename (sort(@files)) { - ($filename)=split(/&/,$filename); - if ($filename!~/^scantron_orig_/) { next ; } - $filename=~s/^scantron_orig_//; - push(@possiblenames,$filename); + if (ref($dirlist) eq 'ARRAY') { + foreach my $filename (sort(@{$dirlist})) { + ($filename)=split(/&/,$filename); + if ($filename!~/^scantron_orig_/) { next ; } + $filename=~s/^scantron_orig_//; + push(@possiblenames,$filename); + } } return @possiblenames; } @@ -5160,7 +5169,7 @@ sub scantron_CODEunique { =item scantron_selectphase - Generates the initial screen to start the bubble sheet process. + Generates the initial screen to start the bubblesheet process. Allows for - starting a grading run. - downloading existing scan data (original, corrected or skipped info) @@ -6182,7 +6191,7 @@ sub remember_current_skipped { =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 + scantron_.. bubblesheet data file. Prints out an error if something went wrong. =cut @@ -6217,6 +6226,12 @@ sub scantron_warning_screen { ''.&mt('List of CODES to validate against:').''. $env{'form.scantron_CODElist'}.''; } + my $lastbubblepoints; + if ($env{'form.scantron_lastbubblepoints'} ne '') { + $lastbubblepoints = + ''.&mt('Hand-graded items: points from last bubble in row').''. + $env{'form.scantron_lastbubblepoints'}.''; + } return ('

@@ -6225,7 +6240,7 @@ sub scantron_warning_screen { -'.$CODElist.' +'.$CODElist.$lastbubblepoints.'
'.&mt('Sequence to be Graded:').''.$title.'
'.&mt('Data File that will be used:').''.$env{'form.scantron_selectfile'}.'

'.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'
'.&mt('If something is incorrect, please return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','','').'

@@ -6263,8 +6278,9 @@ sub scantron_do_warning { } } else { my $warning=&scantron_warning_screen('Grading: Validate Records',$symb); + my $bubbledbyhand=&hand_bubble_option(); $r->print(' -'.$warning.' +'.$warning.$bubbledbyhand.' '); @@ -6316,7 +6332,7 @@ SCANTRONFORM =item scantron_validate_file - Dispatch routine for doing validation of a bubble sheet data file. + Dispatch routine for doing validation of a bubblesheet data file. Also processes any necessary information resets that need to occur before validation begins (ignore previous corrections, @@ -6360,6 +6376,9 @@ sub scantron_validate_file { return ''; } my $result=&scantron_form_start($max_bubble).$default_form_data; + if ($env{'form.scantron_lastbubblepoints'} ne '') { + $result .= ''; + } $r->print($result); my @validate_phases=( 'sequence', @@ -6427,7 +6446,7 @@ sub scantron_validate_file { =item scantron_remove_file - Removes the requested bubble sheet data file, makes sure that + Removes the requested bubblesheet data file, makes sure that scantron_original_ is never removed @@ -6452,7 +6471,7 @@ sub scantron_remove_file { =item scantron_remove_scan_data - Removes all scan_data correction for the requested bubble sheet + Removes all scan_data correction for the requested bubblesheet 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.) @@ -6489,7 +6508,7 @@ sub scantron_remove_scan_data { =item scantron_getfile - Fetches the requested bubble sheet data file (all 3 versions), and + Fetches the requested bubblesheet data file (all 3 versions), and the scan_data hash Arguments: @@ -6589,7 +6608,7 @@ sub lonnet_putfile { =item scantron_putfile - Stores the current version of the bubble sheet data files, and the + Stores the current version of the bubblesheet data files, and the scan_data hash. (Does not modify the original version only the corrected and skipped versions. @@ -6683,7 +6702,7 @@ sub get_todo_count { =item scantron_put_line - Updates the 'corrected' or 'skipped' versions of the bubble sheet + Updates the 'corrected' or 'skipped' versions of the bubblesheet data file. Arguments: @@ -6872,19 +6891,28 @@ sub scantron_get_correction { #the previous one or the current one if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { - $r->print("

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

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

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

\n"); } else { - $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( + '

' + .&mt('An error was detected ([_1]) in scanline [_2] [_3]', + "$error", $i, "

$line
") + ."

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

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

'; $r->print(''."\n"); $r->print(''."\n"); @@ -6894,10 +6922,10 @@ sub scantron_get_correction { if ($error =~ /ID$/) { if ($error eq 'incorrectID') { - $r->print("

".&mt("The encoded ID is not in the classlist"). + $r->print('

'.&mt("The encoded ID is not in the classlist"). "

\n"); } elsif ($error eq 'duplicateID') { - $r->print("

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

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

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

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

".&mt("How should I handle this?")."
\n"); @@ -6913,14 +6941,15 @@ sub scantron_get_correction { $r->print(''); } elsif ($error =~ /CODE$/) { if ($error eq 'incorrectCODE') { - $r->print("

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

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

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

".&mt("The CODE on the form is '[_1]'", - $$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("

".&mt("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' @@ -6947,7 +6976,7 @@ sub scantron_get_correction { $r->print(" "); $r->print("\n
"); @@ -6985,7 +7014,7 @@ ENDSCRIPT "")); $r->print("\n

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

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

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

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

\n"); # The form field scantron_questions is acutally a list of line numbers. # represented by this form so: @@ -7003,7 +7032,7 @@ ENDSCRIPT } $r->print(&verify_bubbles_checked(@lines_to_correct)); } elsif ($error eq 'missingbubble') { - $r->print("

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

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

'.&mt("There have been [_1]no[_2] bubbles scanned for some question(s)",'','')."

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

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

"); $r->print(&mt("Some questions have no scanned bubbles.")."\n"); @@ -7622,6 +7651,41 @@ sub scantron_validate_missingbubbles { return (0,$currentphase+1); } +sub hand_bubble_option { + my (undef, undef, $sequence) = + &Apache::lonnet::decode_symb($env{'form.selectpage'}); + return if ($sequence eq ''); + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + return; + } + my $needs_hand_bubbles; + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + foreach my $res (@resources) { + if (ref($res)) { + if ($res->is_problem()) { + my $partlist = $res->parts(); + foreach my $part (@{ $partlist }) { + my @types = $res->responseType($part); + if (grep(/^(chem|essay|image|formula|math|string|functionplot)$/,@types)) { + $needs_hand_bubbles = 1; + last; + } + } + } + } + } + if ($needs_hand_bubbles) { + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); + return &mt('The sequence to be graded contains response types which are handgraded.').'

'. + &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?','
'). + ' '.&mt('or').' '. + '

'; + } + return; +} sub scantron_process_students { my ($r,$symb) = @_; @@ -7830,12 +7894,12 @@ SCANTRONFORM $studentrecord .= $recording; } if ($studentrecord ne $studentdata) { - $r->print('

'); + $r->print('

'); if ($scancode eq '') { - $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].', + $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2].', $uname.':'.$udom,$scan_record->{'scantron.ID'})); } else { - $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2] and CODE: [_3].', + $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2] and CODE: [_3].', $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode)); } $r->print('
'.&Apache::loncommon::start_data_table()."\n". @@ -7843,12 +7907,12 @@ SCANTRONFORM ''.&mt('Source').''.&mt('Bubbled responses').''. &Apache::loncommon::end_data_table_header_row()."\n". &Apache::loncommon::start_data_table_row(). - ''.&mt('Bubble Sheet').''. - ''.$studentdata.''. + ''.&mt('Bubblesheet').''. + ''.$studentdata.''. &Apache::loncommon::end_data_table_row(). &Apache::loncommon::start_data_table_row(). - 'Stored submissions'. - ''.$studentrecord.''."\n". + ''.&mt('Stored submissions').''. + ''.$studentrecord.''."\n". &Apache::loncommon::end_data_table_row(). &Apache::loncommon::end_data_table().'

'); } else { @@ -7913,6 +7977,9 @@ sub grade_student_bubbles { if ($bubbles_per_row ne '') { $form{'bubbles_per_row'} = $bubbles_per_row; } + if ($env{'form.scantron_lastbubblepoints'} ne '') { + $form{'scantron_lastbubblepoints'} = $env{'form.scantron_lastbubblepoints'}; + } if (ref($parts) eq 'HASH') { if (ref($parts->{$ressymb}) eq 'ARRAY') { foreach my $part (@{$parts->{$ressymb}}) { @@ -8846,7 +8913,8 @@ sub process_clicker { my $pincorrect=&mt("Percentage points for incorrect solution"); my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', {'iclicker' => 'i>clicker', - 'interwrite' => 'interwrite PRS'}); + 'interwrite' => 'interwrite PRS', + 'turning' => 'Turning Technologies'}); $symb = &Apache::lonenc::check_encrypt($symb); $result.= &Apache::lonhtmlcommon::scripttag(<'. ''. &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', @@ -9156,6 +9227,32 @@ sub interwrite_eval { return ($errormsg,$number); } +sub turning_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>$number) { $number=$#entries; } + my $id=$entries[0]; + my @idresponses; + $id=~s/^[\#0]+//; + unless ($id) { next; } + for (my $idx=1;$idx<=$#entries;$idx++) { + $entries[$idx]=~s/\,/\;/g; + $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+\;]+//g; + push(@idresponses,$entries[$idx]); + } + $$responses{$id}=join(',',@idresponses); + } + for (my $i=1; $i<=$number; $i++) { + $$questiontitles[$i]=&mt('Question [_1]',$i); + } + return ($errormsg,$number); +} + + sub assign_clicker_grades { my ($r,$symb)=@_; if (!$symb) {return '';} @@ -9321,23 +9418,25 @@ sub handler { } &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); +# see what command we need to execute + + my @commands=&Apache::loncommon::get_env_multiple('form.command'); + my $command=$commands[0]; + &init_perm(); if (!$env{'request.course.id'}) { - # Not in a course. - $env{'user.error.msg'}="/adm/grades::vgr:0:0:Cannot display grades page outside course context"; - return HTTP_NOT_ACCEPTABLE; + unless ((&Apache::lonnet::allowed('usc',$env{'request.role.domain'})) && + ($command =~ /^scantronupload/)) { + # Not in a course. + $env{'user.error.msg'}="/adm/grades::vgr:0:0:Cannot display grades page outside course context"; + return HTTP_NOT_ACCEPTABLE; + } } elsif (!%perm) { $request->internal_redirect('/adm/quickgrades'); } &Apache::loncommon::content_type($request,'text/html'); $request->send_http_header; - -# see what command we need to execute - - 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)); } @@ -9631,7 +9730,7 @@ ssi_with_retries() =item scantron_process_students() : - Routine that does the actual grading of the bubble sheet information. + Routine that does the actual grading of the bubblesheet information. The parsed scanline hash is added to %env @@ -9651,7 +9750,7 @@ ssi_with_retries() =item scantron_upload_scantron_data() : - Creates the screen for adding a new bubble sheet data file to a course. + Creates the screen for adding a new bubblesheet data file to a course. =item scantron_upload_scantron_data_save() : @@ -9665,7 +9764,7 @@ ssi_with_retries() =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 + skipped) for a specific bubblesheet data file that exists in the course. =item scantron_validate_ID() :