--- loncom/homework/grades.pm 2002/10/04 06:22:12 1.54 +++ loncom/homework/grades.pm 2007/10/24 09:51:47 1.462 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.54 2002/10/04 06:22:12 albertel Exp $ +# $Id: grades.pm,v 1.462 2007/10/24 09:51:47 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,13 +25,6 @@ # # http://www.lon-capa.org/ # -# 2/9,2/13 Guy Albertelli -# 6/8 Gerd Kortemeyer -# 7/26 H.K. Ng -# 8/20 Gerd Kortemeyer -# Year 2002 -# June-August H.K. Ng -# package Apache::grades; use strict; @@ -39,176 +32,583 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonhtmlcommon; +use Apache::lonnavmaps; use Apache::lonhomework; -use Apache::lonmsg qw(:user_normal_msg); +use Apache::lonpickcode; +use Apache::loncoursedata; +use Apache::lonmsg(); use Apache::Constants qw(:common); +use Apache::lonlocal; +use Apache::lonenc; +use String::Similarity; +use LONCAPA; + +use POSIX qw(floor); + + +my %perm=(); +my %bubble_lines_per_response = (); # no. bubble lines for each response. + # index is "symb.part_id" + +my %first_bubble_line = (); # First bubble line no. for each bubble. + +# Save and restore the bubble lines array to the form env. + + +sub save_bubble_lines { + foreach my $line (keys(%bubble_lines_per_response)) { + $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; + $env{"form.scantron.first_bubble_line.$line"} = + $first_bubble_line{$line}; + } +} + + +sub restore_bubble_lines { + my $line = 0; + %bubble_lines_per_response = (); + while ($env{"form.scantron.bubblelines.$line"}) { + my $value = $env{"form.scantron.bubblelines.$line"}; + $bubble_lines_per_response{$line} = $value; + $first_bubble_line{$line} = + $env{"form.scantron.first_bubble_line.$line"}; + $line++; + } + +} + +# Given the parsed scanline, get the response for +# 'answer' number n: + +sub get_response_bubbles { + my ($parsed_line, $response) = @_; + + + my $bubble_line = $first_bubble_line{$response-1} +1; + my $bubble_lines= $bubble_lines_per_response{$response-1}; + + my $selected = ""; + + for (my $bline = 0; $bline < $bubble_lines; $bline++) { + $selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; + $bubble_line++; + } + return $selected; +} + + +# ----- These first few routines are general use routines.---- + +# Return the number of occurences of a pattern in a string. + +sub occurence_count { + my ($string, $pattern) = @_; + + my @matches = ($string =~ /$pattern/g); + + return scalar(@matches); +} + + +# Take a string known to have digits and convert all the +# digits into letters in the range J,A..I. + +sub digits_to_letters { + my ($input) = @_; + + my @alphabet = ('J', 'A'..'I'); + + my @input = split(//, $input); + my $output =''; + for (my $i = 0; $i < scalar(@input); $i++) { + if ($input[$i] =~ /\d/) { + $output .= $alphabet[$input[$i]]; + } else { + $output .= $input[$i]; + } + } + return $output; +} -# ----- These first few routines are general use routines.----- # -# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +# --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_(\w+)_.*/) { - push(@parts,$key); + my ($symb) = @_; + + 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 (@{ $partlist }) { + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } } } - return @parts; + return @stores; } # --- Get the symbolic name of a problem and the url -sub get_symb_and_url { - my ($request) = @_; - (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - return ($symb,$url); -} - -# --- Retrieve the fullname for a user. Return lastname, first middle --- -# --- Generation is attached next to the lastname if it exists. --- -sub get_fullname { - my ($uname,$udom) = @_; - my %name=&Apache::lonnet::get('environment', ['lastname','generation', - 'firstname','middlename'],$udom,$uname); - my $fullname; - my ($tmp) = keys(%name); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname=$name{'lastname'}.$name{'generation'}; - if ($fullname =~ /[^\s]+/) { $fullname.=', '; } - $fullname.=$name{'firstname'}.' '.$name{'middlename'}; +sub get_symb { + my ($request,$silent) = @_; + (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); + if ($symb eq '') { + if (!$silent) { + $request->print("Unable to handle ambiguous references:$url:."); + return (); + } + } + &Apache::lonenc::check_decrypt(\$symb); + return ($symb); +} + +#--- Format fullname, username:domain if different for display +#--- Use anywhere where the student names are listed +sub nameUserString { + my ($type,$fullname,$uname,$udom) = @_; + if ($type eq 'header') { + return ' Fullname (Username)'; + } else { + return ' '.$fullname.' ('.$uname. + ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; } - return $fullname; } #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { - my ($url) = shift; - my $allkeys = &Apache::lonnet::metadata($url,'keys'); - my %seen = (); - my (@partlist,%handgrade); - foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_\w+.*/) { - my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); - $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); - next if ($seen{$partid} > 0); - $seen{$partid}++; - push @partlist,$partid; + my ($symb) = shift; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my %vPart = + map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + next if (%vPart && !exists($vPart{$part})); + + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + $response_types{$part}{$ids[$i]} = $types[$i]; + $handgrade{$part.'_'.$ids[$i]} = + &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. + '.handgrade',$symb); + } + } + return ($partlist,\%handgrade,\%response_types); +} + +sub flatten_responseType { + my ($responseType) = @_; + my @part_response_id = + map { + my $part = $_; + map { + [$part,$_] + } sort(keys(%{ $responseType->{$part} })); + } sort(keys(%$responseType)); + return @part_response_id; +} + +sub get_display_part { + my ($partID,$symb)=@_; + my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); + if (defined($display) and $display ne '') { + $display.= " (id $partID)"; + } else { + $display=$partID; + } + return $display; +} + +#--- Show resource title +#--- and parts and response type +sub showResourceInfo { + my ($symb,$probTitle,$checkboxes) = @_; + my $col=3; + if ($checkboxes) { $col=4; } + my $result = '
'. + 'Answer'.$toprow.''. + ''.$grayFont.'Option ID'. + $grayFont.$bottomrow.''.'
'. + 'Answer'.$toprow.''. + ''.$grayFont.'Item ID'. + $middlerow.''. + ''.$grayFont.'Option ID'. + $bottomrow.''.'
'.&keywords_highlight($answer).'
' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'
'. + &keywords_highlight($oessay). + '
+ + + Overwrite any existing score + +
Users are in domain: ".$domform."
+ + Failed to save student $username:$domain. + Message when trying to save was ($result) + +
Students Not Allowed to Modify
If this information is correct, please click on '$button_text'.
If something is incorrect, please click the 'Grading Menu' button to start over.
You have forgetten to specify some information. Please go Back and try again.
You have not selected a Sequence to grade
You have not selected a file that contains the student\'s response data.
You have not selected a the format of the student\'s response data.
Gathering necessary info.
Validating ".$validate_phases[$currentphase]."
Or click the 'Grading Menu' button to start over.
".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."
An error was detected ($error)"); + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { + $r->print(" for PaperID ". + $$scan_record{'scantron.PaperID'}." \n"); + } else { + $r->print(" in scanline $i
". + $line."
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'}."
How should I handle this? \n"); + $r->print("\n
The encoded CODE is not in the list of possible CODEs
The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique
The CODE on the form is '". + $$scan_record{'scantron.CODE'}."'\n"); + $r->print($message); + $r->print("
How should I handle this? \n"); + $r->print("\n "); + my $i=0; + if ($error eq 'incorrectCODE' + && $$scan_record{'scantron.CODE'}=~/\S/ ) { + my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); + if ($closest > 0) { + foreach my $testcode (@{$closest}) { + my $checked=''; + if (!$i) { $checked=' checked="checked" '; } + $r->print(" Use the similar CODE ".$testcode." instead."); + $r->print("\n"); + $i++; + } + } + } + if ($$scan_record{'scantron.CODE'}=~/\S/ ) { + my $checked; if (!$i) { $checked=' checked="checked" '; } + $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error."); + $r->print("\n"); + } + + $r->print(< +function change_radio(field) { + var slct=document.scantronupload.scantron_CODE_resolution; + var i; + for (i=0;i +ENDSCRIPT + my $href="/adm/pickcode?". + "form=".&escape("scantronupload"). + "&scantron_format=".&escape($env{'form.scantron_format'}). + "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). + "&curCODE=".&escape($$scan_record{'scantron.CODE'}). + "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); + if ($env{'form.scantron_CODElist'} =~ /\S/) { + $r->print(" Select a CODE from the list of all CODEs and use it. Selected CODE is "); + $r->print("\n"); + } + $r->print(" Use as the CODE."); + $r->print("\n"); + } elsif ($error eq 'doublebubble') { + $r->print("There have been multiple bubbles scanned for a some question(s)\n"); + $r->print(''); + $r->print($message); + $r->print("Please indicate which bubble should be used for grading"); + foreach my $question (@{$arg}) { + my $selected = &get_response_bubbles($scan_record, $question); + my @select_array = split(/:/,$selected); + &scantron_bubble_selector($r,$scan_config,$question, + @select_array); + } + } elsif ($error eq 'missingbubble') { + $r->print("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(''); + foreach my $question (@{$arg}) { + my $selected = &get_response_bubbles($scan_record, $question); + &scantron_bubble_selector($r,$scan_config,$question); + } + } else { + $r->print("\n"); + } + $r->print("\n"); + +} + +=pod + +=item scantron_bubble_selector + + Generates the html radiobuttons to correct a single bubble line + possibly showing the existing the selected bubbles if known + + Arguments: + $r - Apache request object + $scan_config - hash from &get_scantron_config() + $quest - number of the bubble line to make a corrector for + $lines - array of answer lines. + +=cut + +sub scantron_bubble_selector { + my ($r,$scan_config,$quest,@lines)=@_; + my $max=$$scan_config{'Qlength'}; + + + my $scmode=$$scan_config{'Qon'}; + + my $bubble_length = scalar(@lines); + + + if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } + + my $response = $quest-1; + my $lines = $bubble_lines_per_response{$response}; + + my $total_lines = $lines*2; + my @alphabet=('A'..'Z'); + $r->print("$quest"); + + for (my $l = 0; $l < $lines; $l++) { + if ($l != 0) { + $r->print(''); + } + my @selected = split(//,$lines[$l]); + for (my $i=0;$i<$max;$i++) { + $r->print("\n".''); + if ($selected[0] eq $alphabet[$i]) { + $r->print('X'); + shift(@selected) ; + } else { + $r->print(' '); + } + $r->print(''); + + } + + if ($l == 0) { + my $lspan = $total_lines * 2; # 2 table rows per bubble line. + + $r->print(' No bubble '); + + } + + $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". + ''.$alphabet[$i].""); + } + $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); + my @orig=split(//,$orig); + my $same=0; + for (my $i=0;$i{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $CODE=$$scan_record{'scantron.CODE'}; + my $error=0; + if (!&Apache::lonnet::validCODE($CODE)) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectCODE',\%allcodes); + return(1,$currentphase); + } + if (%allcodes && !exists($allcodes{$CODE}) + && !$$scan_record{'scantron.useCODE'}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectCODE',\%allcodes); + return(1,$currentphase); + } + if (exists($usedCODEs{$CODE}) + && $env{'form.scantron_CODEunique'} eq 'yes' + && !$$scan_record{'scantron.CODE_ignore_dup'}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateCODE',$usedCODEs{$CODE}); + return(1,$currentphase); + } + push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); + } + 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 + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&username_to_idmap($classlist); + + #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; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + if (!defined($$scan_record{'scantron.doubleerror'})) { next; } + &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, + 'doublebubble', + $$scan_record{'scantron.doubleerror'}); + return (1,$currentphase); + } + 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 (undef, undef, $sequence) = + &Apache::lonnet::decode_symb($env{'form.selectpage'}); + + my $navmap=Apache::lonnavmaps::navmap->new(); + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + + &Apache::lonxml::clear_problem_counter(); + + my $uname = $env{'form.student'}; + my $udom = $env{'form.userdom'}; + my $cid = $env{'request.course.id'}; + my $total_lines = 0; + %bubble_lines_per_response = (); + %first_bubble_line = (); + + + my $response_number = 0; + my $bubble_line = 0; + foreach my $resource (@resources) { + my $symb = $resource->symb(); + &Apache::lonxml::clear_bubble_lines_for_part(); + my $result=&Apache::lonnet::ssi($resource->src(), + ('symb' => $resource->symb()), + ('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\.'); + + &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 + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&username_to_idmap($classlist); + + #get scantron line setup + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my ($scanlines,$scan_data)=&scantron_getfile(); + my $max_bubble=&scantron_get_maxbubble(); + if (!$max_bubble) { $max_bubble=2**31; } + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + if (!defined($$scan_record{'scantron.missingerror'})) { next; } + my @to_correct; + foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { + if ($missing > $max_bubble) { next; } + push(@to_correct,$missing); + } + if (@to_correct) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'missingbubble',\@to_correct); + return (1,$currentphase); + } + + } + 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'}); + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb); + + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my ($scanlines,$scan_data)=&scantron_getfile(); + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&username_to_idmap($classlist); + my $navmap=Apache::lonnavmaps::navmap->new(); + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); +# $r->print("geto ".scalar(@resources).""); + my $result= < + + $default_form_data +SCANTRONFORM + $r->print($result); + + my @delayqueue; + my %completedstudents; + + my $count=&get_todo_count($scanlines,$scan_data); + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', + 'Scantron Progress',$count, + 'inline',undef,'scantronupload'); + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, + 'Processing first student'); + 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++; + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + if ($started) { + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + 'last student'); + } + $started=1; + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + unless ($uname=&scantron_find_student($scan_record,$scan_data, + \%idmap,$i)) { + &scantron_add_delay(\@delayqueue,$line, + 'Unable to find a student that matches',1); + next; + } + if (exists $completedstudents{$uname}) { + &scantron_add_delay(\@delayqueue,$line, + 'Student '.$uname.' has multiple sheets',2); + next; + } + ($uname,$udom)=split(/:/,$uname); + + &Apache::lonxml::clear_problem_counter(); + &Apache::lonnet::appenv(%$scan_record); + + if (&scantron_clear_skip($scanlines,$scan_data,$i)) { + &scantron_putfile($scanlines,$scan_data); + } + + my $i=0; + foreach my $resource (@resources) { + $i++; + my %form=('submitted' =>'scantron', + 'grade_target' =>'grade', + 'grade_username'=>$uname, + 'grade_domain' =>$udom, + 'grade_courseid'=>$env{'request.course.id'}, + 'grade_symb' =>$resource->symb()); + if (exists($scan_record->{'scantron.CODE'}) + && + &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) { + $form{'CODE'}=$scan_record->{'scantron.CODE'}; + } else { + $form{'CODE'}=''; + } + my $result=&Apache::lonnet::ssi($resource->src(),%form); + if ($result ne '') { + } + if (&Apache::loncommon::connection_aborted($r)) { last; } + } + $completedstudents{$uname}={'line'=>$line}; + if (&Apache::loncommon::connection_aborted($r)) { last; } + } continue { + &Apache::lonxml::clear_problem_counter(); + &Apache::lonnet::delenv('scantron\.'); + } + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); +# my $lasttime = &Time::HiRes::time()-$start; +# $r->print("took $lasttime"); + + $r->print(""); + $r->print(&show_grading_menu_form($symb)); + 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'})); + my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', + 'domainid', + 'coursename'); + my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, + 'domainid'); + my $default_form_data=&defaultFormData(&get_symb($r,1)); + $r->print(< + function checkUpload(formname) { + if (formname.upfile.value == "") { + alert("Please use the browse button to select a file from your local directory."); + return false; + } + formname.submit(); + } + + + +$default_form_data + +$select_link +Course ID: +Course Name: +Domain: $domsel +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"; + 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."); + if ($symb) { + $r->print(&show_grading_menu_form($symb)); + } else { + $r->print($doanotherupload); + } + return ''; + } + my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); + $r->print("Doing upload to ".$coursedata{'description'}." "); + my $fname=$env{'form.upfile.filename'}; + #FIXME + #copied from lonnet::userfileupload() + #make that function able to target a specified course + # Replace Windows backslashes by forward slashes + $fname=~s/\\/\//g; + # Get rid of everything but the actual filename + $fname=~s/^.*\/([^\/]+)$/$1/; + # Replace spaces by underscores + $fname=~s/\s+/\_/g; + # Replace all other weird characters by nothing + $fname=~s/[^\w\.\-]//g; + # See if there is anything left + unless ($fname) { return 'error: no uploaded file'; } + 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."); + } 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.""); + } else { + $r->print("Error: An error (".$result.") occurred when attempting to upload the file, ".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').""); + } + } + if ($symb) { + $r->print(&scantron_selectphase($r,$uploadedfile)); + } else { + $r->print($doanotherupload); + } + 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())) { + if ($requested_file eq $filename) { return 1; } + } + 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)); + my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; + my $file=$env{'form.scantron_selectfile'}; + if (! &valid_file($file)) { + $r->print(< + The requested file name was invalid. +
There have been multiple bubbles scanned for a some question(s)
Please indicate which bubble should be used for grading
There have been no bubbles scanned for some question(s)
took $lasttime
+ Corrections, a file of corrected records that were used in grading. +
+ Skipped, a file of records that were skipped. +
'.&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.="