--- loncom/homework/grades.pm 2003/10/14 22:52:24 1.130.2.1.2.10
+++ loncom/homework/grades.pm 2008/04/21 16:30:47 1.518
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.130.2.1.2.10 2003/10/14 22:52:24 albertel Exp $
+# $Id: grades.pm,v 1.518 2008/04/21 16:30:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,16 +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
-# Year 2003
-# February, March H.K. Ng
-# July, H. K. Ng
-#
package Apache::grades;
use strict;
@@ -45,55 +35,136 @@ use Apache::loncommon;
use Apache::lonhtmlcommon;
use Apache::lonnavmaps;
use Apache::lonhomework;
+use Apache::lonpickcode;
use Apache::loncoursedata;
-use Apache::lonmsg qw(:user_normal_msg);
+use Apache::lonmsg();
use Apache::Constants qw(:common);
+use Apache::lonlocal;
+use Apache::lonenc;
use String::Similarity;
+use LONCAPA;
+
+use POSIX qw(floor);
+
+
-my %oldessays=();
my %perm=();
-# ----- These first few routines are general use routines.----
+# These variables are used to recover from ssi errors
+
+my $ssi_retries = 5;
+my $ssi_error;
+my $ssi_error_resource;
+my $ssi_error_message;
+
+
+# Do an ssi with retries:
+# While I'd love to factor out this with the vesrion in lonprintout,
+# that would either require a data coupling between modules, which I refuse to perpetuate
+# (there's quite enough of that already), or would require the invention of another infrastructure
+# I'm not quite ready to invent (e.g. an ssi_with_retry object).
+#
+# At least the logic that drives this has been pulled out into loncommon.
+
+
+#
+# ssi_with_retries - Does the server side include of a resource.
+# if the ssi call returns an error we'll retry it up to
+# the number of times requested by the caller.
+# If we still have a proble, no text is appended to the
+# output and we set some global variables.
+# to indicate to the caller an SSI error occurred.
+# All of this is supposed to deal with the issues described
+# in LonCAPA BZ 5631 see:
+# http://bugs.lon-capa.org/show_bug.cgi?id=5631
+# by informing the user that this happened.
+#
+# Parameters:
+# resource - The resource to include. This is passed directly, without
+# interpretation to lonnet::ssi.
+# form - The form hash parameters that guide the interpretation of the resource
+#
+# retries - Number of retries allowed before giving up completely.
+# Returns:
+# On success, returns the rendered resource identified by the resource parameter.
+# Side Effects:
+# The following global variables can be set:
+# ssi_error - If an unrecoverable error occurred this becomes true.
+# It is up to the caller to initialize this to false
+# if desired.
+# ssi_error_resource - If an unrecoverable error occurred, this is the value
+# of the resource that could not be rendered by the ssi
+# call.
+# ssi_error_message - The error string fetched from the ssi response
+# in the event of an error.
+#
+sub ssi_with_retries {
+ my ($resource, $retries, %form) = @_;
+ my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form);
+ if ($response->is_error) {
+ $ssi_error = 1;
+ $ssi_error_resource = $resource;
+ $ssi_error_message = $response->code . " " . $response->message;
+ }
+
+ return $content;
+
+}
#
-# --- Retrieve the parts that matches stores_\d+ from the metadata file.---
+# Prodcuces an ssi retry failure error message to the user:
+#
+
+sub ssi_print_error {
+ my ($r) = @_;
+ my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk');
+ $r->print('
+
+
+'.&mt('Unable to retrieve a resource from a server:').'
+'.&mt('Resource:').' '.$ssi_error_resource.'
+'.&mt('Error:').' '.$ssi_error_message.'
+
'.
+&mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'
'.
+&mt('If the error persists, please contact the [_1] for assistance.',$helpurl).
+'
Current Resource: '.$probTitle.' |
Part '.$partID.' | '. - 'Type: '.$responsetype.' | Handgrade: '.$handgrade.' | '; + my %partsseen; + foreach my $partID (sort keys(%$responseType)) { + foreach my $resID (sort keys(%{ $responseType->{$partID} })) { + my $handgrade=$$handgrade{$partID.'_'.$resID}; + my $responsetype = $responseType->{$partID}->{$resID}; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.='|
"; + } else { + $result.=" | "; + } + $partsseen{$partID}=1; + } + my $display_part=&get_display_part($partID,$symb); + $result.=' | '.&mt('Part: [_1]',$display_part).' '. + $resID.' | '. + ''.&mt('Type: [_1]',$responsetype).' | '.&mt('Handgrade: [_1]',$handgrade).' | '; + } } $result.='
'; - } - if ($response eq 'essay') { - if (! exists ($ENV{'form.'.$symb})) { + ''. - '
'. - ' Answer '. - (join ' ',@ans).' '. - ' '.$grayFont.'Option ID '.$grayFont. - (join ' '.$grayFont,@IDs).'
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { + if (exists($answer{$foil})) { + if ($foil eq $correct) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''. + ' '.$grayFont.&mt('Item ID').' '. + $middlerow.''.' '.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'; + } elsif ($response eq 'essay') { + if (! exists ($env{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); - my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; - $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; - $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; - $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; - $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; - $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. - } - return ''. + '
'. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. + $grayFont.$bottomrow.'
'.&keywords_highlight($answer).''; + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; + $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. + } + $answer =~ s-\n-
'.&keywords_highlight($answer).''; + } elsif ( $response eq 'organic') { + my $result='Smile representation: "'.$answer.'"'; + my $jme=$record->{$version."resource.$partid.$respid.molecule"}; + $result.=&Apache::chemresponse::jme_img($jme,$answer,400); + return $result; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'
'; + + $result .= ''."\n";
- $result.='
'."\n"; - $result.=&show_grading_menu_form($symb,$url); + $result.=&show_grading_menu_form($symb); return $result; } sub csvuploadmap { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); if (!$symb) {return '';} my $datatoken; - if (!$ENV{'form.datatoken'}) { + if (!$env{'form.datatoken'}) { $datatoken=&Apache::loncommon::upfile_store($request); } else { - $datatoken=$ENV{'form.datatoken'}; + $datatoken=$env{'form.datatoken'}; &Apache::loncommon::load_tmp_file($request); } my @records=&Apache::loncommon::upfile_record_sep(); - &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); + if ($env{'form.noFirstLine'}) { shift(@records); } + &csvuploadmap_header($request,$symb,$datatoken,$#records+1); my ($i,$keyfields); if (@records) { - my @fields=&csvupload_fields($url); + my @fields=&csvupload_fields($symb); - if ($ENV{'form.upfile_associate'} eq 'reverse') { + if ($env{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($request,\@records); $i=&Apache::loncommon::csv_print_select_table($request,\@records, \@fields); @@ -2611,47 +3887,122 @@ sub csvuploadmap { unshift(@fields,['none','']); $i=&Apache::loncommon::csv_samples_select_table($request,\@records, \@fields); - my %sone=&Apache::loncommon::record_sep($records[0]); - $keyfields=join(',',sort(keys(%sone))); + foreach my $rec (@records) { + my %temp = &Apache::loncommon::record_sep($rec); + if (%temp) { + $keyfields=join(',',sort(keys(%temp))); + last; + } + } } } &csvuploadmap_footer($request,$i,$keyfields); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(&show_grading_menu_form($symb)); return ''; } -sub csvuploadassign { +sub csvuploadoptions { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - &Apache::loncommon::load_tmp_file($request); - my @gradedata = &Apache::loncommon::upfile_record_sep(); - my @keyfields = split(/\,/,$ENV{'form.keyfields'}); - my %fields=(); - for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) { - if ($ENV{'form.upfile_associate'} eq 'reverse') { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$keyfields[$i]}=$ENV{'form.f'.$i}; + my ($symb)=&get_symb($request); + my $checked=(($env{'form.noFirstLine'})?'1':'0'); + my $ignore=&mt('Ignore First Line'); + $request->print(< Uploading Class Grade Options+ + ++ + +ENDPICK + my %fields=&get_fields(); + if (!defined($fields{'domain'})) { + my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); + $request->print("\nUsers are in domain: ".$domform." \n"); + } + foreach my $key (sort(keys(%env))) { + if ($key !~ /^form\.(.*)$/) { next; } + my $cleankey=$1; + if ($cleankey eq 'command') { next; } + $request->print(''."\n"); + } + # FIXME do a check for any duplicated user ids... + # FIXME do a check for any invalid user ids?... + $request->print('+ '."\n"); + $request->print(&show_grading_menu_form($symb)); + return ''; +} + +sub get_fields { + my %fields; + my @keyfields = split(/\,/,$env{'form.keyfields'}); + for (my $i=0; $i<=$env{'form.nfields'}; $i++) { + if ($env{'form.upfile_associate'} eq 'reverse') { + if ($env{'form.f'.$i} ne 'none') { + $fields{$keyfields[$i]}=$env{'form.f'.$i}; } } else { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$ENV{'form.f'.$i}}=$keyfields[$i]; + if ($env{'form.f'.$i} ne 'none') { + $fields{$env{'form.f'.$i}}=$keyfields[$i]; } } } + return %fields; +} + +sub csvuploadassign { + my ($request)= @_; + my ($symb)=&get_symb($request); + if (!$symb) {return '';} + my $error_msg = ''; + &Apache::loncommon::load_tmp_file($request); + my @gradedata = &Apache::loncommon::upfile_record_sep(); + if ($env{'form.noFirstLine'}) { shift(@gradedata); } + my %fields=&get_fields(); $request->print(' Assigning Grades'); - my $courseid=$ENV{'request.course.id'}; + my $courseid=$env{'request.course.id'}; my ($classlist) = &getclasslist('all',0); my @notallowed; my @skipped; my $countdone=0; foreach my $grade (@gradedata) { my %entries=&Apache::loncommon::record_sep($grade); + my $domain; + if ($entries{$fields{'domain'}}) { + $domain=$entries{$fields{'domain'}}; + } else { + $domain=$env{'form.default_domain'}; + } + $domain=~s/\s//g; my $username=$entries{$fields{'username'}}; - my $domain=$entries{$fields{'domain'}}; + $username=~s/\s//g; + if (!$username) { + my $id=$entries{$fields{'ID'}}; + $id=~s/\s//g; + my %ids=&Apache::lonnet::idget($domain,$id); + $username=$ids{$id}; + } if (!exists($$classlist{"$username:$domain"})) { - push(@skipped,"$username:$domain"); + my $id=$entries{$fields{'ID'}}; + $id=~s/\s//g; + if ($id) { + push(@skipped,"$id:$domain"); + } else { + push(@skipped,"$username:$domain"); + } next; } my $usec=$classlist->{"$username:$domain"}[5]; @@ -2659,34 +4010,70 @@ sub csvuploadassign { push(@notallowed,"$username:$domain"); next; } + my %points; my %grades; foreach my $dest (keys(%fields)) { - if ($dest eq 'username' || $dest eq 'domain') { next; } - if ($entries{$fields{$dest}} eq '') { next; } - my $store_key=$dest; - $store_key=~s/^stores/resource/; - $store_key=~s/_/\./g; - $grades{$store_key}=$entries{$fields{$dest}}; - } - $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}"; - &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'}, - $domain,$username); - $request->print('.'); - $request->rflush(); - $countdone++; + if ($dest eq 'ID' || $dest eq 'username' || + $dest eq 'domain') { next; } + if ($entries{$fields{$dest}} =~ /^\s*$/) { next; } + if ($dest=~/stores_(.*)_points/) { + my $part=$1; + my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', + $symb,$domain,$username); + if ($wgt) { + $entries{$fields{$dest}}=~s/\s//g; + my $pcr=$entries{$fields{$dest}} / $wgt; + my $award=($pcr == 0) ? 'incorrect_by_override' + : 'correct_by_override'; + $grades{"resource.$part.awarded"}=$pcr; + $grades{"resource.$part.solved"}=$award; + $points{$part}=1; + } else { + $error_msg = "" . + &mt("Some point values were assigned" + ." for problems with a weight " + ."of zero. These values were " + ."ignored."); + } + } else { + if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } + if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } + my $store_key=$dest; + $store_key=~s/^stores/resource/; + $store_key=~s/_/\./g; + $grades{$store_key}=$entries{$fields{$dest}}; + } + } + if (! %grades) { + push(@skipped,&mt("[_1]: no data to save","$username:$domain")); + } else { + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $result=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($result eq 'ok') { + $request->print('.'); + } else { + $request->print(" ". + &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", + "$username:$domain",$result)." "); + } + $request->rflush(); + $countdone++; + } } - $request->print("Stored $countdone students\n"); + $request->print(' '.&mt("Saved [_1] students",$countdone)."\n"); if (@skipped) { - $request->print(' Skipped Students '); + $request->print(''.&mt('Skipped Students').' '); foreach my $student (@skipped) { $request->print("$student\n"); } } if (@notallowed) { - $request->print(' Students Not Allowed to Modify '); + $request->print(''.&mt('Students Not Allowed to Modify').' '); foreach my $student (@notallowed) { $request->print("$student\n"); } } $request->print(" \n"); - $request->print(&show_grading_menu_form($symb,$url)); - return ''; + $request->print(&show_grading_menu_form($symb)); + return $error_msg; } #------------- end of section for handling csv file upload --------- # @@ -2715,27 +4102,31 @@ function checkPickOne(formname) { LISTJAVASCRIPT &commonJSfunctions($request); - my ($symb,$url) = &get_symb_and_url($request); - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; - my $result=' '. - 'Manual Grading by Page or Sequence'; + my $result=''. + &mt('Manual Grading by Page or Sequence').''; $result.='\n"; + $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -2746,78 +4137,95 @@ LISTJAVASCRIPT $result.=''."\n". ''."\n"; - $result.=' View Problems Text: no '."\n". - ' yes '." \n"; - - $result.=' Submission Details: '. - ' none'."\n". - ' by dates and submissions'."\n". - ' all details'."\n"; - - $result.=''."\n". - ''."\n". + my $options = + ''."\n". + ''." \n"; + $result.=' '.&mt('View Problems Text: [_1]',$options); + + $options = + ''."\n". + ''."\n". + ''."\n"; + $result.=' '.&mt('Submission Details: [_1]',$options); + + $result.=&build_section_inputs(); + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + $result.=''."\n". ''."\n". - ''."\n". - ''."\n". - ''." \n"; + ''."\n". + ''." \n"; + + $result.=' '.&mt('Use CODE: [_1] ', + ''). + ' '."\n"; $result.=' " /> '."\n"; + 'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next->').'" /> '."\n"; $request->print($result); - my $studentTable.=' Select a student you wish to grade and then click on the Next button. '. - '
| '. + &Apache::loncommon::end_data_table_row(); + } + $studentTable.=&Apache::loncommon::end_data_table()."\n"; $studentTable.='" />'."\n"; + 'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next->').'" />'."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; } sub getSymbMap { - my ($request) = @_; - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db'); -# $navmap->init(); + my $navmap = Apache::lonnavmaps::navmap->new(); my %symbx = (); my @titles = (); my $minder = 0; # Gather every sequence that has problems. - my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 1); + my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, + 1,0,1); for my $sequence ($navmap->getById('0.0'), @sequences) { if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { - my $title = $minder.'.'.$sequence->compTitle(); - push @titles, $title; # minder in case two titles are identical - $symbx{$title} = $sequence->symb(); + my $title = $minder.'.'. + &HTML::Entities::encode($sequence->compTitle(),'"\'&'); + push(@titles, $title); # minder in case two titles are identical + $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); $minder++; } } - - $navmap->untieHashes(); return \@titles,\%symbx; } @@ -2826,55 +4234,76 @@ sub getSymbMap { sub displayPage { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; - my $pageTitle = $ENV{'form.page'}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $pageTitle = $env{'form.page'}; my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); - my ($uname,$udom) = split(/:/,$ENV{'form.student'}); - my $usec=$classlist->{$ENV{'form.student'}}[5]; + my ($uname,$udom) = split(/:/,$env{'form.student'}); + my $usec=$classlist->{$env{'form.student'}}[5]; + + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $env{'course.'.$env{'request.course.id'}.'.num'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + if (!&canview($usec)) { - $request->print('Unable to view requested student.('.$ENV{'form.student'}.')'); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(''.&mt('Unable to view requested student. ([_1])',$env{'form.student'}).''); + $request->print(&show_grading_menu_form($symb)); return; } - my $result=' | Prob. | '. + ''.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').' | '. + &Apache::loncommon::end_data_table_header_row(); - $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. - ' symbol.'."\n". - '
---|
'.
- '
'.$ENV{'form.title'}.''; - $result.=' Student: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom).
+ my $result=' |
+ '.&Apache::loncommon::end_data_table_row().'
+ '.&Apache::loncommon::end_data_table().'
+');
+ }
+
+ # Chunk of the form that prompts to view a scoring office file,
+ # corrected file, skipped records in a file.
+
+ $r->print('
+
'.
- '
|
-
|
-
+ +'.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).' +
+'.&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 click the \'Grading Menu\' button to start over.').'
+ +".&mt('You have forgetten to specify some information. Please go Back and try again.')."
"); + if ( $env{'form.selectpage'} eq '') { + $r->print(''.&mt('You have not selected a Sequence to grade').'
'); + } + if ( $env{'form.scantron_selectfile'} eq '') { + $r->print(''.&mt('You have not selected a file that contains the student\'s response data.').'
'); + } + if ( $env{'form.scantron_format'} eq '') { + $r->print(''.&mt('You have not selected a the format of the student\'s response data.').'
'); + } + } else { + my $warning=&scantron_warning_screen('Grading: Validate Records'); + $r->print(' +'.$warning.' + + +'); + } + $r->print("'.&mt('Gathering necessary information.').'
');$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $result= <Validating ".$validate_phases[$currentphase]."
"); + $r->print(&mt('Validating '.$validate_phases[$currentphase]).'".&mt("Or click the 'Grading Menu' button to start over.")."
"); + } else { + if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') { + $r->print(''); + } else { + $r->print(''); + } + $r->print(' '.&mt('using corrected info').'".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."
"); + return (1,$currentphase); + } + } + + 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) = @_; @@ -3597,12 +6589,14 @@ sub scantron_validate_ID { my %idmap=&username_to_idmap($classlist); #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); + + &scantron_get_maxbubble(); # parse needs the bubble_lines.. array. my %found=('ids'=>{},'usernames'=>{}); for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$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); @@ -3616,13 +6610,13 @@ sub scantron_validate_ID { if ($found{'ids'}{$found}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$found); - return(1); + return(1,$currentphase); } elsif ($found{'usernames'}{$username}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } - #FIXME store away line we prviously saw the ID on to use above + #FIXME store away line we previously saw the ID on to use above $found{'ids'}{$found}++; $found{'usernames'}{$username}++; } else { @@ -3632,18 +6626,18 @@ sub scantron_validate_ID { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } elsif (!defined($username)) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } $found{'usernames'}{$username}++; } else { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } } } @@ -3651,35 +6645,72 @@ sub scantron_validate_ID { return (0,$currentphase+1); } +=pod + +=item scantron_get_correction + + Builds the interface screen to interact with the operator to fix a + specific error condition in a specific scanline + + Arguments: + $r - Apache request object + $i - number of the current scanline + $scan_record - hash ref as returned from &scantron_parse_scanline() + $scan_config - hash ref as returned from &get_scantron_config() + $line - full contents of the current scanline + $error - error condition, valid values are + 'incorrectCODE', 'duplicateCODE', + 'doublebubble', 'missingbubble', + 'duplicateID', 'incorrectID' + $arg - extra information needed + For errors: + - duplicateID - paper number that this studentID was seen before on + - duplicateCODE - array ref of the paper numbers this CODE was + seen on before + - incorrectCODE - current incorrect CODE + - doublebubble - array ref of the bubble lines that have double + bubble errors + - missingbubble - array ref of the bubble lines that have missing + bubble errors + +=cut + sub scantron_get_correction { my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; - -#FIXME in the case of a duplicated ID the previous line, probaly need +#FIXME in the case of a duplicated ID the previous line, probably need #to show both the current line and the previous one and allow skipping #the previous one or the current one - $r->print("An error was detected ($error) "); - if ( defined($$scan_record{'scantron.PaperID'}) ) { - $r->print(" for PaperID ". - $$scan_record{'scantron.PaperID'}." \n"); + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { + $r->print("
".&mt("An error was detected ($error)". + " for PaperID [_1]", + $$scan_record{'scantron.PaperID'})."
\n"); } else { - $r->print(" in scanline $i". - $line."\n"); - } + $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'})."
".&mt("The encoded ID is not in the classlist"). + "
\n"); } elsif ($error eq 'duplicateID') { - $r->print("The encoded ID has also been used by a previous paper $arg\n"); + $r->print("".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."
\n"); } - $r->print("The ID on the form is ".
- $$scan_record{'scantron.ID'}."
\n");
- $r->print("The name on the paper is ".
- $$scan_record{'scantron.LastName'}.",".
- $$scan_record{'scantron.FirstName'}."
How should I handle this?
\n");
+ $r->print($message);
+ $r->print("
".&mt("How should I handle this?")."
\n");
$r->print("\n
".&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 CODE on the form is '[_1]'",
+ $$scan_record{'scantron.CODE'})."
\n");
+ $r->print($message);
+ $r->print("
".&mt("How should I handle this?")." There have been multiple bubbles scanned for a some question(s) ".&mt("There have been multiple bubbles scanned for some question(s)")." Please indicate which bubble should be used for grading ".&mt("Please indicate which bubble should be used for grading")." There have been no bubbles scanned for some question(s) Please indicate which bubble should be used for grading ".&mt("There have been no bubbles scanned for some question(s)")." ".&mt("Please indicate which bubble should be used for grading.")." took $lasttime took $lasttime Done
+ '.&mt('The requested file name was invalid.').'
+
+ '.&mt('[_1]Original[_2] file as uploaded by the scantron office.',
+ '','').'
+
+ '.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.',
+ '','').'
+
+ '.&mt('[_1]Skipped[_2], a file of records that were skipped.',
+ '','').'
+ '.&mt('Correctness determined by the following IDs').'';
+ foreach my $id (sort(keys(%correct_ids))) {
+ $result.='
\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("
+
+ ");
+ $r->print("\n
");
+ $i++;
+ }
+ }
+ }
+ if ($$scan_record{'scantron.CODE'}=~/\S/ ) {
+ my $checked; if (!$i) { $checked=' checked="checked" '; }
+ $r->print("
+ ");
+ $r->print("\n
");
+ }
+
+ $r->print(<
");
+ }
+ $r->print("
+ "));
+ $r->print("\n
");
} elsif ($error eq 'doublebubble') {
-#FIXME Need to print out who this is along with the paper info
- $r->print("");
}
$r->print("\n
");
+}
+sub verify_bubbles_checked {
+ my (@ansnums) = @_;
+ my $ansnumstr = join('","',@ansnums);
+ my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines.");
+ my $output = (<
');
+ if (($responsetype_per_response{$question-1} eq 'essayresponse') ||
+ ($responsetype_per_response{$question-1} eq 'formularesponse') ||
+ ($responsetype_per_response{$question-1} eq 'stringresponse') ||
+ ($responsetype_per_response{$question-1} eq 'imageresponse') ||
+ ($responsetype_per_response{$question-1} eq 'reactionresponse') ||
+ ($responsetype_per_response{$question-1} eq 'organicresponse')) {
+ $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their scantron sheets.",$lines).'
'.&mt('A non-zero score can be assigned to the student during scantron grading by selecting a bubble in at least one line.').'
'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'
'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'
');
+ } else {
+ $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."
");
+ }
+ }
+ for (my $i =0; $i < $lines; $i++) {
+ my $selected = $$scan_record{"scantron.$current_line.answer"};
+ &scantron_bubble_selector($r,$scan_config,$current_line,
+ $questionnum,$error,split('', $selected));
+ push (@linenums,$current_line);
+ $current_line++;
+ }
+ if ($lines > 1) {
+ $r->print("
");
+ }
+ return @linenums;
+}
+
+=pod
+
+=item scantron_bubble_selector
+
+ Generates the html radiobuttons to correct a single bubble line
+ possibly showing the existing the selected bubbles if known
+
+ Arguments:
+ $r - Apache request object
+ $scan_config - hash from &get_scantron_config()
+ $line - Number of the line being displayed.
+ $questionnum - Question number (may include subquestion)
+ $error - Type of error.
+ @selected - Array of bubbles picked on this line.
+
+=cut
sub scantron_bubble_selector {
- my ($r,$scan_config,$quest,@selected)=@_;
+ my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_;
my $max=$$scan_config{'Qlength'};
+
+ my $scmode=$$scan_config{'Qon'};
+ if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }
+
my @alphabet=('A'..'Z');
- $r->print("
');
+ if (!$cdom) {
+ $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'};
+ }
+ if (!$cnum) {
+ $cnum =$env{'course.'.$env{'request.course.id'}.'.num'};
+ }
+ my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"],
+ $cdom,$cnum);
+ my %allcodes;
+ if ($result{"type\0$old_name"} eq 'number') {
+ %allcodes=map {($_,1)} split(',',$result{$old_name});
+ } else {
+ %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name});
+ }
+ 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) = @_;
- #FIXME doesn't do anything yet
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ if ($scantron_config{'CODElocation'} &&
+ $scantron_config{'CODEstart'} &&
+ $scantron_config{'CODElength'}) {
+ if (!defined($env{'form.scantron_CODElist'})) {
+ &FIXME_blow_up()
+ }
+ } else {
+ return (0,$currentphase+1);
+ }
+
+ my %usedCODEs;
+
+ my %allcodes=&get_codes();
+
+ &scantron_get_maxbubble(); # parse needs the lines per response array.
+
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ my $line=&scantron_get_line($scanlines,$scan_data,$i);
+ 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
@@ -3751,10 +7226,12 @@ sub scantron_validate_doublebubble {
my %idmap=&username_to_idmap($classlist);
#get scantron line setup
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ 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,$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);
@@ -3767,6 +7244,169 @@ sub scantron_validate_doublebubble {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_get_maxbubble
+
+ Returns the maximum number of bubble lines that are expected to
+ occur. Does this by walking the selected sequence rendering the
+ resource and then checking &Apache::lonxml::get_problem_counter()
+ for what the current value of the problem counter is.
+
+ Caches the results to $env{'form.scantron_maxbubble'},
+ $env{'form.scantron.bubble_lines.n'},
+ $env{'form.scantron.first_bubble_line.n'} and
+ $env{"form.scantron.sub_bubblelines.n"}
+ which are the total number of bubble, lines, the number of bubble
+ lines for response n and number of the first bubble line for response n,
+ and a comma separated list of numbers of bubble lines for sub-questions
+ (for optionresponse, matchresponse, and rankresponse items), 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 = ();
+ %subdivided_bubble_lines = ();
+ %responsetype_per_response = ();
+
+ my $response_number = 0;
+ my $bubble_line = 0;
+ foreach my $resource (@resources) {
+ my $symb = $resource->symb();
+ # Need to retrieve part IDs and response IDs because essayresponse,
+ # reactionresponse and organicresponse items are not included in
+ # $analysis{'parts'} from lonnet::ssi.
+ my %possible_part_ids;
+ if (ref($resource->parts()) eq 'ARRAY') {
+ foreach my $part (@{$resource->parts()}) {
+ if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {
+ my @resp_ids = $resource->responseIds($part);
+ foreach my $id (@resp_ids) {
+ $possible_part_ids{$part.'.'.$id} = 1;
+ }
+ }
+ }
+ }
+ my $result=&ssi_with_retries($resource->src(), $ssi_retries,
+ ('symb' => $symb,
+ 'grade_target' => 'analyze',
+ 'grade_courseid' => $cid,
+ 'grade_domain' => $udom,
+ 'grade_username' => $uname));
+ my (undef, $an) =
+ split(/_HASH_REF__/,$result, 2);
+
+ my @parts;
+
+ my %analysis = &Apache::lonnet::str2hash($an);
+
+ if (ref($analysis{'parts'}) eq 'ARRAY') {
+ foreach my $part (@{$analysis{'parts'}}) {
+ my ($id,$respid) = split(/\./,$part);
+ if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) {
+ push(@parts,$part);
+ }
+ }
+ }
+ # Add part_ids for any essayresponse items.
+ foreach my $part_id (keys(%possible_part_ids)) {
+ if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
+ ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
+ ($analysis{$part_id.'.type'} eq 'organicresponse')) {
+ if (!grep(/^\Q$part_id\E$/,@parts)) {
+ push (@parts,$part_id);
+ }
+ }
+ }
+
+ foreach my $part_id (@parts) {
+ my $lines = $analysis{"$part_id.bubble_lines"};
+
+ # TODO - make this a persistent hash not an array.
+
+ # optionresponse, matchresponse and rankresponse type items
+ # render as separate sub-questions in exam mode.
+ if (($analysis{$part_id.'.type'} eq 'optionresponse') ||
+ ($analysis{$part_id.'.type'} eq 'matchresponse') ||
+ ($analysis{$part_id.'.type'} eq 'rankresponse')) {
+ my ($numbub,$numshown);
+ if ($analysis{$part_id.'.type'} eq 'optionresponse') {
+ if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis{$part_id.'.options'}});
+ }
+ } elsif ($analysis{$part_id.'.type'} eq 'matchresponse') {
+ if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis{$part_id.'.items'}});
+ }
+ } elsif ($analysis{$part_id.'.type'} eq 'rankresponse') {
+ if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis{$part_id.'.foils'}});
+ }
+ }
+ if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') {
+ $numshown = scalar(@{$analysis{$part_id.'.shown'}});
+ }
+ my $bubbles_per_line = 10;
+ my $inner_bubble_lines = int($numshown/$bubbles_per_line);
+ if (($numshown % $bubbles_per_line) != 0) {
+ $inner_bubble_lines++;
+ }
+ for (my $i=0; $i<$numshown; $i++) {
+ $subdivided_bubble_lines{$response_number} .=
+ $inner_bubble_lines.',';
+ }
+ $subdivided_bubble_lines{$response_number} =~ s/,$//;
+ }
+
+ $first_bubble_line{$response_number} = $bubble_line;
+ $bubble_lines_per_response{$response_number} = $lines;
+ $responsetype_per_response{$response_number} =
+ $analysis{$part_id.'.type'};
+ $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
@@ -3774,19 +7414,40 @@ sub scantron_validate_missingbubbles {
my %idmap=&username_to_idmap($classlist);
#get scantron line setup
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&scantron_getfile();
- my $max_bubble=$ENV{'form.scantron_maxbubble'};
+ 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,$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;
+
+ # Probably here's where the error is...
+
foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
- if ($missing > $max_bubble) { next; }
+ my $lastbubble;
+ if ($missing =~ /^(\d+)\.(\d+)$/) {
+ my $question = $1;
+ my $subquestion = $2;
+ if (!defined($first_bubble_line{$question -1})) { next; }
+ my $first = $first_bubble_line{$question-1};
+ my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
+ my $subcount = 1;
+ while ($subcount<$subquestion) {
+ $first += $subans[$subcount-1];
+ $subcount ++;
+ }
+ my $count = $subans[$subquestion-1];
+ $lastbubble = $first + $count;
+ } else {
+ if (!defined($first_bubble_line{$missing - 1})) { next; }
+ $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1};
+ }
+ if ($lastbubble > $max_bubble) { next; }
push(@to_correct,$missing);
}
if (@to_correct) {
@@ -3799,18 +7460,45 @@ 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)=split(/___/,$ENV{'form.selectpage'});
- my ($symb,$url)=&get_symb_and_url($r);
- if (!$symb) {return '';}
- my $default_form_data=&defaultFormData($symb,$url);
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ 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($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1);
+ 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)."$quest ");
+ $r->print(&Apache::loncommon::start_data_table().
+ &Apache::loncommon::start_data_table_row());
+ $r->print(''.$line.' ');
for (my $i=0;$i<$max+1;$i++) {
- $r->print('');
+ $r->print("\n".' ');
if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
else { $r->print(' '); }
$r->print(' ');
}
- $r->print('');
+ $r->print(&Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::start_data_table_row());
for (my $i=0;$i<$max;$i++) {
- $r->print(' '.$alphabet[$i]." ");
+ $r->print("\n".
+ '");
+ }
+ my $nobub_checked = ' ';
+ if ($error eq 'missingbubble') {
+ $nobub_checked = ' checked = "checked" ';
+ }
+ $r->print("\n".' '."\n".' ');
+ $r->print(&Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::end_data_table());
+}
+
+=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 No bubble ');
- $r->print('
");
@@ -3824,113 +7512,121 @@ SCANTRONFORM
my @delayqueue;
my %completedstudents;
+ my $count=&get_todo_count($scanlines,$scan_data);
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
- 'Scantron Progress',$scanlines->{'count'});
+ '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);
+ my ($uname,$udom,$started);
+
+ &scantron_get_maxbubble(); # Need the bubble lines array to parse.
+
+
+ # If an ssi failed in scantron_get_maxbubble, put an error message out to
+ # the user and return.
+
+ if ($ssi_error) {
+ $r->print("");
+ &ssi_print_error($r);
+ $r->print(&show_grading_menu_form($symb));
+ return ''; # Dunno why the other returns return '' rather than just returning.
+ }
+
while ($i<$scanlines->{'count'}) {
- ($uname,$udom)=('','');
- $i++;
- my $line=&scantron_get_line($scanlines,$i);
-# $r->print('line is'.$line.'
');
- if ($line=~/^[\s\cz]*$/) { next; }
- 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)=('','');
+ $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);
}
-# $r->print('doing studnet'.$uname.'
');
- ($uname,$udom)=split(/:/,$uname);
- &Apache::lonnet::delenv('form.counter');
- &Apache::lonnet::appenv(%$scan_record);
-# &Apache::lonhomework::showhash(%ENV);
-# $Apache::lonxml::debug=1;
-# &Apache::lonxml::debug("line is $line");
- my $i=0;
+ my $i=0;
foreach my $resource (@resources) {
$i++;
- my $result=&Apache::lonnet::ssi($resource->src(),
- ('submitted' =>'scantron',
- 'grade_target' =>'grade',
- 'grade_username'=>$uname,
- 'grade_domain' =>$udom,
- 'grade_courseid'=>$ENV{'request.course.id'},
- 'grade_symb' =>$resource->symb()));
-# my %score=&Apache::lonnet::restore($resource->symb(),
-# $ENV{'request.course.id'},
-# $udom,$uname);
-# foreach my $part ($resource->{PARTS}) {
-# if ($score{'resource.'.$part.'.solved'} =~ /^correct/) {
-# $studentcorrect++;
-# $totalcorrect++;
-# } else {
-# $studentincorrect++;
-# $totalincorrect++;
-# }
-# }
-# $r->print(''.
-# $resource->symb().'-'.
-# $resource->src().'-'.'
result is'.$result);
-# &Apache::lonhomework::showhash(%score);
- # if ($i eq 3) {last;}
+ 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=&ssi_with_retries($resource->src(), $ssi_retries, %form);
+ if ($ssi_error) {
+ $ssi_error = 0; # So end of handler error message does not trigger.
+ $r->print("");
+ &ssi_print_error($r);
+ $r->print(&show_grading_menu_form($symb));
+ return ''; # Why return ''? Beats me.
+ }
+
+ if (&Apache::loncommon::connection_aborted($r)) { last; }
}
$completedstudents{$uname}={'line'=>$line};
+ if (&Apache::loncommon::connection_aborted($r)) { last; }
} continue {
- &Apache::lonnet::delenv('form.counter');
+ &Apache::lonxml::clear_problem_counter();
&Apache::lonnet::delenv('scantron\.');
- &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,$uname);
- #last;
- #FIXME
- #get iterator for $sequence
- #foreach question 'submit' the students answer to the server
- # through grade target {
- # generate data to pass back that includes grade recevied
- #}
}
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
- my $lasttime = &Time::HiRes::time()-$start;
- #$r->print("
-
-File to upload:
-
-
+
+
+
+
+'.$select_link.'
+'.&mt('Course ID:').'
+
+'.&mt('Course Name:').'
+
+'.&mt('Domain:').'
+ '.$domsel.'
+'.&mt('File to upload:').'
+
");
+ 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(&mt("Doing upload to [_1]",$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(&mt("Error: The file you attempted to upload, [_1] contained no information. Please check that you entered the correct filename.",''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').""));
+ } else {
+ my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname);
+ if ($result =~ m|^/uploaded/|) {
+ $r->print(&mt("Success: Successfully uploaded [_1] bytes of data into location [_2]",
+ (length($env{'form.upfile'})-1),
+ ''.$result.""));
+ } else {
+ $r->print(&mt("Error: An error ([_1]) occurred when attempting to upload the file, [_2]",
+ $result,
+ ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').""));
+
+ }
+ }
+ if ($symb) {
+ $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('
+ '.&mt('Please select a grading task').'
';
+ $Str .= '{'jscript'}.
+ ' href="'.
+ $menudata->{'url'}.'" >'.
+ $menudata->{'name'}."
\n";
+ } else {
+ $Str .='
{'jscript'}.
+ ' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '.
+ ' /> '.
+ &Apache::lonnet::recprefix($env{'request.course.id'}).
+ '-';
+ }
+ $Str .= ' '.(' 'x8).$menudata->{'short_description'}.
+ "\n";
+ }
+ $Str .=" Manual Grading/View Submission
';
- my ($table,undef,$hdgrade) = &showResourceInfo($url,$probTitle);
- $result.=$table;
+ my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
+ my $result;
my (undef,$sections) = &getclasslist('all','0');
my $savedState = &savedState();
my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'});
@@ -4053,8 +7999,7 @@ GRADINGMENUJS
my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
$result.='
'."\n";
+sub clicker_grading_parameters {
+ return ('gradingmechanism' => 'scalar',
+ 'upfiletype' => 'scalar',
+ 'specificid' => 'scalar',
+ 'pcorrect' => 'scalar',
+ 'pincorrect' => 'scalar');
+}
+
+sub process_clicker {
+ my ($r)=@_;
+ my ($symb)=&get_symb($r);
+ if (!$symb) {return '';}
+ my $result=&checkforfile_js();
+ $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
+ my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
+ $result.=$table;
+ $result.=''."\n".
- '
'."\n".
- ' '."\n".
- ''."\n".
- ' Select a Grading/Viewing Option '."\n";
-
- $result.=' ';
- $result.='
'."\n";
-
- $result.=' ';
+ return %clicker_ids;
+}
- $result.=''."\n".
- ' Select Section:
+ '.&mt('Grade Current Resource').'
+
+
+ '.&mt('Grade Complete Folder for One Student').'
+
+
'
- if (grep /no/,@$sections);
+ my $classlist = &Apache::loncoursedata::get_classlist();
+
+ # Set up a couple variables.
+ my $username_idx = &Apache::loncoursedata::CL_SNAME();
+ my $domain_idx = &Apache::loncoursedata::CL_SDOM();
+ my $status_idx = &Apache::loncoursedata::CL_STATUS();
+
+ foreach my $student (keys(%$classlist)) {
+ if ($classlist->{$student}->[$status_idx] ne 'Active') { next; }
+ my $username = $classlist->{$student}->[$username_idx];
+ my $domain = $classlist->{$student}->[$domain_idx];
+ my $clickers =
+ (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1];
+ foreach my $id (split(/\,/,$clickers)) {
+ $id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
+ if (exists($clicker_ids{$id})) {
+ $clicker_ids{$id}.=','.$username.':'.$domain;
+ } else {
+ $clicker_ids{$id}=$username.':'.$domain;
+ }
+ }
}
- $result.=' '."\n";
-
- $result.=''.
- ' '.'Current Resource: For one or more students'.
- '
-->For students with '.
- ' submissions or '.
- ' for all '."\n";
-
- $result.=''.
- ' '.
- 'Current Resource: For all students in selected section or course '."\n";
-
- $result.=''.
- ' '.
- 'The complete set/page/sequence: For one student
'.
- ''.
- '';
-
- $result.=' ';
- $result.='
'."\n".
- ' '."\n";
-
- $result.=''.
- ''.
- ' scores from file '."\n";
-
- if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) {
- $result.=''.
- ' scantron forms '."\n";
- }
+sub gather_adv_clicker_ids {
+ my %clicker_ids;
+ my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum);
+ foreach my $element (sort(keys(%coursepersonnel))) {
+ foreach my $person (split(/\,/,$coursepersonnel{$element})) {
+ my ($puname,$pudom)=split(/\:/,$person);
+ my $clickers =
+ (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
+ foreach my $id (split(/\,/,$clickers)) {
+ $id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
+ if (exists($clicker_ids{$id})) {
+ $clicker_ids{$id}.=','.$puname.':'.$pudom;
+ } else {
+ $clicker_ids{$id}=$puname.':'.$pudom;
+ }
+ }
+ }
+ }
+ return %clicker_ids;
+}
- $result.=''.
- ''.
- ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).
- '-'.
- ' '."\n";
+ $result.='
'."\n".
+ ' '."\n";
+ $result.=''."\n";
+ $result.=' '.&mt('Specify a file containing the clicker information for this resource').
+ '. '."\n";
+# Attempt to restore parameters from last session, set defaults if not present
+ my %Saveable_Parameters=&clicker_grading_parameters();
+ &Apache::loncommon::restore_course_settings('grades_clicker',
+ \%Saveable_Parameters);
+ if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; }
+ if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; }
+ if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; }
+ if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
+
+ my %checked;
+ foreach my $gradingmechanism ('attendance','personnel','specific') {
+ if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
+ $checked{$gradingmechanism}="checked='checked'";
+ }
+ }
+
+ my $upload=&mt("Upload File");
+ my $type=&mt("Type");
+ my $attendance=&mt("Award points just for participation");
+ my $personnel=&mt("Correctness determined from response by course personnel");
+ my $specific=&mt("Correctness determined from response with clicker ID(s)");
+ my $pcorrect=&mt("Percentage points for correct solution");
+ my $pincorrect=&mt("Percentage points for incorrect solution");
+ my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
+ ('iclicker' => 'i>clicker',
+ 'interwrite' => 'interwrite PRS'));
+ $symb = &Apache::lonenc::check_encrypt($symb);
+ $result.=<
+
+
+
+
+
+
+
+
+
'."\n";
+ $result.=&show_grading_menu_form($symb);
return $result;
}
+sub process_clicker_file {
+ my ($r)=@_;
+ my ($symb)=&get_symb($r);
+ if (!$symb) {return '';}
+
+ my %Saveable_Parameters=&clicker_grading_parameters();
+ &Apache::loncommon::store_course_settings('grades_clicker',
+ \%Saveable_Parameters);
+
+ my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
+ if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) {
+ $result.=''.&mt('You need to specify a clicker ID for the correct answer').'';
+ return $result.&show_grading_menu_form($symb);
+ }
+ my %clicker_ids=&gather_clicker_ids();
+ my %correct_ids;
+ if ($env{'form.gradingmechanism'} eq 'personnel') {
+ %correct_ids=&gather_adv_clicker_ids();
+ }
+ if ($env{'form.gradingmechanism'} eq 'specific') {
+ foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {;
+ $correct_id=~tr/a-z/A-Z/;
+ $correct_id=~s/\s//gs;
+ $correct_id=~s/^[\#0]+//;
+ $correct_id=~s/[\-\:]//g;
+ if ($correct_id) {
+ $correct_ids{$correct_id}='specified';
+ }
+ }
+ }
+ if ($env{'form.gradingmechanism'} eq 'attendance') {
+ $result.=&mt('Score based on attendance only');
+ } else {
+ my $number=0;
+ $result.='
'.$id.' - ';
+ if ($correct_ids{$id} eq 'specified') {
+ $result.=&mt('specified');
+ } else {
+ my ($uname,$udom)=split(/\:/,$correct_ids{$id});
+ $result.=&Apache::loncommon::plainname($uname,$udom);
+ }
+ $number++;
+ }
+ $result.="
+
'."\n".
+ '
+$heading
+
'.&mt('Found [_1] question(s)',$number).'
'.
+ ''.
+ &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
+ $env{'form.pcorrect'},$env{'form.pincorrect'}).
+ '
';
+# Remember Question Titles
+# FIXME: Possibly need delimiter other than ":"
+ for (my $i=0;$i<$number;$i++) {
+ $result.='').'" />';
+ }
+ my $correct_count=0;
+ my $student_count=0;
+ my $unknown_count=0;
+# Match answers with usernames
+# FIXME: Possibly need delimiter other than ":"
+ foreach my $id (keys(%responses)) {
+ if ($correct_ids{$id}) {
+ $result.="\n".'';
+ $correct_count++;
+ } elsif ($clicker_ids{$id}) {
+ if ($clicker_ids{$id}=~/\,/) {
+# More than one user with the same clicker!
+ $result.="\n
".&mt('Clicker registered more than once').": ".$id."
";
+ $result.="\n".''.
+ "
".&mt('Unregistered Clicker')." ".$id."
";
+ $result.="\n".''.
+ "\n".&mt("Username").": ".
+ "\n".&mt("Domain").": ".
+ &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '.
+ &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id);
+ $unknown_count++;
+ }
+ }
+ $result.='
'.
+ &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
+ if ($env{'form.gradingmechanism'} ne 'attendance') {
+ if ($correct_count==0) {
+ $errormsg.="Found no correct answers answers for grading!";
+ } elsif ($correct_count>1) {
+ $result.='
'.&mt("Found [_1] entries for grading!",$correct_count).'';
+ }
+ }
+ if ($number<1) {
+ $errormsg.="Found no questions.";
+ }
+ if ($errormsg) {
+ $result.='
'.&mt($errormsg).'';
+ } else {
+ $result.='
';
+ }
+ $result.='
'."\n";
+ return $result.&show_grading_menu_form($symb);
+}
+
+sub iclicker_eval {
+ my ($questiontitles,$responses)=@_;
+ my $number=0;
+ my $errormsg='';
+ foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
+ my %components=&Apache::loncommon::record_sep($line);
+ my @entries=map {$components{$_}} (sort(keys(%components)));
+ if ($entries[0] eq 'Question') {
+ for (my $i=3;$i<$#entries;$i+=6) {
+ $$questiontitles[$number]=$entries[$i];
+ $number++;
+ }
+ }
+ if ($entries[0]=~/^\#/) {
+ my $id=$entries[0];
+ my @idresponses;
+ $id=~s/^[\#0]+//;
+ for (my $i=0;$i<$number;$i++) {
+ my $idx=3+$i*6;
+ push(@idresponses,$entries[$idx]);
+ }
+ $$responses{$id}=join(',',@idresponses);
+ }
+ }
+ return ($errormsg,$number);
+}
+
+sub interwrite_eval {
+ my ($questiontitles,$responses)=@_;
+ my $number=0;
+ my $errormsg='';
+ my $skipline=1;
+ my $questionnumber=0;
+ my %idresponses=();
+ foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
+ my %components=&Apache::loncommon::record_sep($line);
+ my @entries=map {$components{$_}} (sort(keys(%components)));
+ if ($entries[1] eq 'Time') { $skipline=0; next; }
+ if ($entries[1] eq 'Response') { $skipline=1; }
+ next if $skipline;
+ if ($entries[0]!=$questionnumber) {
+ $questionnumber=$entries[0];
+ $$questiontitles[$number]=&mt('Question [_1]',$questionnumber);
+ $number++;
+ }
+ my $id=$entries[4];
+ $id=~s/^[\#0]+//;
+ $id=~s/^v\d*\://i;
+ $id=~s/[\-\:]//g;
+ $idresponses{$id}[$number]=$entries[6];
+ }
+ foreach my $id (keys %idresponses) {
+ $$responses{$id}=join(',',@{$idresponses{$id}});
+ $$responses{$id}=~s/^\s*\,//;
+ }
+ return ($errormsg,$number);
+}
+
+sub assign_clicker_grades {
+ my ($r)=@_;
+ my ($symb)=&get_symb($r);
+ if (!$symb) {return '';}
+# See which part we are saving to
+ my ($partlist,$handgrade,$responseType) = &response_type($symb);
+# FIXME: This should probably look for the first handgradeable part
+ my $part=$$partlist[0];
+# Start screen output
+ my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
+
+ my $heading=&mt('Assigning grades based on clicker file');
+ $result.=(<
+
'."\n".
+ '
+$heading
+ENDHEADER
+# Get correct result
+# FIXME: Possibly need delimiter other than ":"
+ my @correct=();
+ my $gradingmechanism=$env{'form.gradingmechanism'};
+ my $number=$env{'form.number'};
+ if ($gradingmechanism ne 'attendance') {
+ foreach my $key (keys(%env)) {
+ if ($key=~/^form\.correct\:/) {
+ my @input=split(/\,/,$env{$key});
+ for (my $i=0;$i<=$#input;$i++) {
+ if (($correct[$i]) && ($input[$i]) &&
+ ($correct[$i] ne $input[$i])) {
+ $result.='
'.
+ &mt('More than one correct result given for question "[_1]": [_2] versus [_3].',
+ $env{'form.question:'.$i},$correct[$i],$input[$i]).'';
+ } elsif ($input[$i]) {
+ $correct[$i]=$input[$i];
+ }
+ }
+ }
+ }
+ for (my $i=0;$i<$number;$i++) {
+ if (!$correct[$i]) {
+ $result.='
'.
+ &mt('No correct result given for question "[_1]"!',
+ $env{'form.question:'.$i}).'';
+ }
+ }
+ $result.='
'.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct));
+ }
+# Start grading
+ my $pcorrect=$env{'form.pcorrect'};
+ my $pincorrect=$env{'form.pincorrect'};
+ my $storecount=0;
+ foreach my $key (keys(%env)) {
+ my $user='';
+ if ($key=~/^form\.student\:(.*)$/) {
+ $user=$1;
+ }
+ if ($key=~/^form\.unknown\:(.*)$/) {
+ my $id=$1;
+ if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {
+ $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};
+ } elsif ($env{'form.multi'.$id}) {
+ $user=$env{'form.multi'.$id};
+ }
+ }
+ if ($user) {
+ my @answer=split(/\,/,$env{$key});
+ my $sum=0;
+ for (my $i=0;$i<$number;$i++) {
+ if ($answer[$i]) {
+ if ($gradingmechanism eq 'attendance') {
+ $sum+=$pcorrect;
+ } else {
+ if ($answer[$i] eq $correct[$i]) {
+ $sum+=$pcorrect;
+ } else {
+ $sum+=$pincorrect;
+ }
+ }
+ }
+ }
+ my $ave=$sum/(100*$number);
+# Store
+ my ($username,$domain)=split(/\:/,$user);
+ my %grades=();
+ $grades{"resource.$part.solved"}='correct_by_override';
+ $grades{"resource.$part.awarded"}=$ave;
+ $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
+ my $returncode=&Apache::lonnet::cstore(\%grades,$symb,
+ $env{'request.course.id'},
+ $domain,$username);
+ if ($returncode ne 'ok') {
+ $result.="
Failed to save student $username:$domain. Message when trying to save was ($returncode)";
+ } else {
+ $storecount++;
+ }
+ }
+ }
+# We are done
+ $result.='
'.&mt('Successfully stored grades for [_1] student(s).',$storecount).
+ '
'."\n";
+ return $result.&show_grading_menu_form($symb);
+}
+
sub handler {
my $request=$_[0];
-
- undef(%perm);
- if ($ENV{'browser.mathml'}) {
- $request->content_type('text/xml');
+ &reset_caches();
+ if ($env{'browser.mathml'}) {
+ &Apache::loncommon::content_type($request,'text/xml');
} else {
- $request->content_type('text/html');
+ &Apache::loncommon::content_type($request,'text/html');
}
$request->send_http_header;
return '' if $request->header_only;
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
- my $url=$ENV{'form.url'};
- my $symb=$ENV{'form.symb'};
- my $command=$ENV{'form.command'};
- if (!$url) {
- my ($temp1,$temp2);
- ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb);
- $url = $ENV{'form.url'};
- }
- &send_header($request);
- if ($url eq '' && $symb eq '' && $command eq '') {
- if ($ENV{'user.adv'}) {
- if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&
- ($ENV{'form.codethree'})) {
- my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'.
- $ENV{'form.codethree'};
+ my $symb=&get_symb($request,1);
+ my @commands=&Apache::loncommon::get_env_multiple('form.command');
+ my $command=$commands[0];
+
+ if ($#commands > 0) {
+ &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
+ }
+
+ $ssi_error = 0;
+ $request->print(&Apache::loncommon::start_page('Grading'));
+ if ($symb eq '' && $command eq '') {
+ if ($env{'user.adv'}) {
+ if (($env{'form.codeone'}) && ($env{'form.codetwo'}) &&
+ ($env{'form.codethree'})) {
+ my $token=$env{'form.codeone'}.'*'.$env{'form.codetwo'}.'*'.
+ $env{'form.codethree'};
my ($tsymb,$tuname,$tudom,$tcrsid)=
&Apache::lonnet::checkin($token);
if ($tsymb) {
- my ($map,$id,$url)=split(/\_\_\_/,$tsymb);
+ my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);
if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
- $request->print(&Apache::lonnet::ssi_body('/res/'.$url,
+ $request->print(&ssi_with_retries('/res/'.$url, $ssi_retries,
('grade_username' => $tuname,
'grade_domain' => $tudom,
'grade_courseid' => $tcrsid,
@@ -4180,22 +8660,9 @@ sub handler {
}
}
} else {
- if (!($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}))) {
- if ($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
- $perm{'vgr_section'}=$ENV{'request.course.sec'};
- } else {
- delete($perm{'vgr'});
- }
- }
- if (!($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}))) {
- if ($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
- $perm{'mgr_section'}=$ENV{'request.course.sec'};
- } else {
- delete($perm{'mgr'});
- }
- }
+ &init_perm();
if ($command eq 'submission' && $perm{'vgr'}) {
- ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
+ ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
&pickStudentPage($request);
} elsif ($command eq 'displayPage' && $perm{'vgr'}) {
@@ -4205,7 +8672,9 @@ sub handler {
} elsif ($command eq 'processGroup' && $perm{'vgr'}) {
&processGroup($request);
} elsif ($command eq 'gradingmenu' && $perm{'vgr'}) {
- $request->print(&gradingmenu($request));
+ $request->print(&grading_menu($request));
+ } elsif ($command eq 'submit_options' && $perm{'vgr'}) {
+ $request->print(&submit_options($request));
} elsif ($command eq 'viewgrades' && $perm{'vgr'}) {
$request->print(&viewgrades($request));
} elsif ($command eq 'handgrade' && $perm{'mgr'}) {
@@ -4214,62 +8683,62 @@ sub handler {
$request->print(&editgrades($request));
} elsif ($command eq 'verify' && $perm{'vgr'}) {
$request->print(&verifyreceipt($request));
+ } elsif ($command eq 'processclicker' && $perm{'mgr'}) {
+ $request->print(&process_clicker($request));
+ } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) {
+ $request->print(&process_clicker_file($request));
+ } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) {
+ $request->print(&assign_clicker_grades($request));
} elsif ($command eq 'csvform' && $perm{'mgr'}) {
$request->print(&upcsvScores_form($request));
} elsif ($command eq 'csvupload' && $perm{'mgr'}) {
$request->print(&csvupload($request));
} elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {
$request->print(&csvuploadmap($request));
- } elsif ($command eq 'csvuploadassign' && $perm{'mgr'}) {
- if ($ENV{'form.associate'} ne 'Reverse Association') {
- $request->print(&csvuploadassign($request));
+ } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) {
+ if ($env{'form.associate'} ne 'Reverse Association') {
+ $request->print(&csvuploadoptions($request));
} else {
- if ( $ENV{'form.upfile_associate'} ne 'reverse' ) {
- $ENV{'form.upfile_associate'} = 'reverse';
+ if ( $env{'form.upfile_associate'} ne 'reverse' ) {
+ $env{'form.upfile_associate'} = 'reverse';
} else {
- $ENV{'form.upfile_associate'} = 'forward';
+ $env{'form.upfile_associate'} = 'forward';
}
$request->print(&csvuploadmap($request));
}
+ } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
+ $request->print(&csvuploadassign($request));
} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
$request->print(&scantron_selectphase($request));
+ } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
+ $request->print(&scantron_do_warning($request));
} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {
$request->print(&scantron_validate_file($request));
} elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
$request->print(&scantron_process_students($request));
- } elsif ($command eq 'scantronupload' &&
- &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) {
- $request->print(&scantron_upload_scantron_data($request));
-
- } elsif ($command eq 'scantronupload_save' &&
- &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) {
- $request->print(&scantron_upload_scantron_data_save($request));
+ } elsif ($command eq 'scantronupload' &&
+ (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
+ $request->print(&scantron_upload_scantron_data($request));
+ } elsif ($command eq 'scantronupload_save' &&
+ (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
+ $request->print(&scantron_upload_scantron_data_save($request));
+ } elsif ($command eq 'scantron_download' &&
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
+ $request->print(&scantron_download_scantron_data($request));
} elsif ($command) {
- $request->print("$command ".join(':',%perm)."Access Denied");
+ $request->print("Access Denied ($command)");
}
}
- &send_footer($request);
+ if ($ssi_error) {
+ &ssi_print_error($request);
+ }
+ $request->print(&Apache::loncommon::end_page());
+ &reset_caches();
return '';
}
-sub send_header {
- my ($request)= @_;
- $request->print(&Apache::lontexconvert::header());
-# $request->print("
-#");
- $request->print(&Apache::loncommon::bodytag('Grading'));
- $request->rflush();
-}
-
-sub send_footer {
- my ($request)= @_;
- $request->print('