'."\n".
- ''."\n".
- 'UserId Domain '."\n";
- foreach my $part (@parts) {
- my $display=&Apache::lonnet::metadata($url,$part.'.display');
- if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
- $result.=''.$display.' '."\n";
+sub checkforfile_js {
+ my $result =<
+ 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();
+ }
+
+CSVFORMJS
+ return $result;
+}
+
+sub upcsvScores_form {
+ my ($request) = shift;
+ my ($symb)=&get_symb($request);
+ 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";
+ $result.=''."\n";
+ $result.='
'."\n";
+ $result.=&show_grading_menu_form($symb);
+ return $result;
+}
+
+
+sub csvuploadmap {
+ my ($request)= @_;
+ my ($symb)=&get_symb($request);
+ if (!$symb) {return '';}
+
+ my $datatoken;
+ if (!$env{'form.datatoken'}) {
+ $datatoken=&Apache::loncommon::upfile_store($request);
+ } else {
+ $datatoken=$env{'form.datatoken'};
+ &Apache::loncommon::load_tmp_file($request);
+ }
+ my @records=&Apache::loncommon::upfile_record_sep();
+ if ($env{'form.noFirstLine'}) { shift(@records); }
+ &csvuploadmap_header($request,$symb,$datatoken,$#records+1);
+ my ($i,$keyfields);
+ if (@records) {
+ my @fields=&csvupload_fields($symb);
+
+ if ($env{'form.upfile_associate'} eq 'reverse') {
+ &Apache::loncommon::csv_print_samples($request,\@records);
+ $i=&Apache::loncommon::csv_print_select_table($request,\@records,
+ \@fields);
+ foreach (@fields) { $keyfields.=$_->[0].','; }
+ chop($keyfields);
+ } else {
+ unshift(@fields,['none','']);
+ $i=&Apache::loncommon::csv_samples_select_table($request,\@records,
+ \@fields);
+ 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));
+
+ return '';
+}
+
+sub csvuploadoptions {
+ my ($request)= @_;
+ my ($symb)=&get_symb($request);
+ my $checked=(($env{'form.noFirstLine'})?'1':'0');
+ my $ignore=&mt('Ignore First Line');
+ $request->print(<
+Uploading Class Grade Options
+
+
+
+
+
+ Overwrite any existing score
+
+
+ENDPICK
+ my %fields=&get_fields();
+ if (!defined($fields{'domain'})) {
+ my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain');
+ $request->print("\n Users 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];
+ }
+ }
+ }
+ 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 ($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'}};
+ $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"})) {
+ 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];
+ if (!&canmodify($usec)) {
+ push(@notallowed,"$username:$domain");
+ next;
+ }
+ my %points;
+ my %grades;
+ foreach my $dest (keys(%fields)) {
+ 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='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,"$username:$domain no data to save"); }
+ $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("
+
+ Failed to save student $username:$domain.
+ Message when trying to save was ($result)
+
+
" );
+ }
+ $request->rflush();
+ $countdone++;
+ }
+ $request->print(" Saved $countdone students\n");
+ if (@skipped) {
+ $request->print('
Skipped Students ');
+ foreach my $student (@skipped) { $request->print("$student \n"); }
+ }
+ if (@notallowed) {
+ $request->print('Students Not Allowed to Modify
');
+ foreach my $student (@notallowed) { $request->print("$student \n"); }
+ }
+ $request->print(" \n");
+ $request->print(&show_grading_menu_form($symb));
+ return $error_msg;
+}
+#------------- end of section for handling csv file upload ---------
+#
+#-------------------------------------------------------------------
+#
+#-------------- Next few routines handle grading by page/sequence
+#
+#--- Select a page/sequence and a student to grade
+sub pickStudentPage {
+ my ($request) = shift;
+
+ $request->print(<
+
+function checkPickOne(formname) {
+ if (radioSelection(formname.student) == null) {
+ alert("Please select the student you wish to grade.");
+ return;
+ }
+ ptr = pullDownSelection(formname.selectpage);
+ formname.page.value = formname["page"+ptr].value;
+ formname.title.value = formname["title"+ptr].value;
+ formname.submit();
+}
+
+
+LISTJAVASCRIPT
+ &commonJSfunctions($request);
+ 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 ';
+
+ $result.=''."\n";
+
+ $studentTable.=&show_grading_menu_form($symb);
+ $request->print($studentTable);
+
+ return '';
+}
+
+sub getSymbMap {
+ 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,0,1);
+ for my $sequence ($navmap->getById('0.0'), @sequences) {
+ if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {
+ 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++;
+ }
+ }
+ return \@titles,\%symbx;
+}
+
+#
+#--- Displays a page/sequence w/wo problems, w/wo submissions
+sub displayPage {
+ my ($request) = shift;
+
+ 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];
+
+ #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));
+ return;
+ }
+ my $result=' '.$env{'form.title'}.' ';
+ $result.=' Student: '.&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom).
+ ' '."\n";
+ if (&Apache::lonnet::validCODE($env{'form.CODE'})) {
+ $result.=' CODE: '.$env{'form.CODE'}.' '."\n";
+ } else {
+ delete($env{'form.CODE'});
+ }
+ &sub_page_js($request);
+ $request->print($result);
+
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'});
+ my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
+ if (!$map) {
+ $request->print('Unable to view requested sequence. ('.$resUrl.') ');
+ $request->print(&show_grading_menu_form($symb));
+ return;
+ }
+ my $iterator = $navmap->getIterator($map->map_start(),
+ $map->map_finish());
+
+ my $studentTable='';
+ return $result;
+}
+
+=pod
+
+=item scantron_validate_file
+
+ Dispatch routine for doing validation of a bubble sheet data file.
- return $result;
+ Also processes any necessary information resets that need to
+ occur before validation begins (ignore previous corrections,
+ restarting the skipped records processing)
+
+=cut
+
+sub scantron_validate_file {
+ my ($r) = @_;
+ my ($symb)=&get_symb($r);
+ if (!$symb) {return '';}
+ my $default_form_data=&defaultFormData($symb);
+
+ # do the detection of only doing skipped records first befroe we delete
+ # them when doing the corrections reset
+ if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') {
+ &reset_skipping_status();
+ }
+ if ($env{'form.scantron_options_redo'} eq 'redo_skipped') {
+ &remember_current_skipped();
+ $env{'form.scantron_options_redo'}='redo_skipped_ready';
+ }
+
+ if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') {
+ &check_for_error($r,&scantron_remove_file('corrected'));
+ &check_for_error($r,&scantron_remove_file('skipped'));
+ &check_for_error($r,&scantron_remove_scan_data());
+ $env{'form.scantron_options_ignore'}='done';
+ }
+
+ if ($env{'form.scantron_corrections'}) {
+ &scantron_process_corrections($r);
+ }
+ $r->print("Gathering necessary info.
");$r->rflush();
+ #get the student pick code ready
+ $r->print(&Apache::loncommon::studentbrowser_javascript());
+ my $max_bubble=&scantron_get_maxbubble();
+ my $result=&scantron_form_start($max_bubble).$default_form_data;
+ $r->print($result);
+
+ my @validate_phases=( 'sequence',
+ 'ID',
+ 'CODE',
+ 'doublebubble',
+ 'missingbubbles');
+ if (!$env{'form.validatepass'}) {
+ $env{'form.validatepass'} = 0;
+ }
+ my $currentphase=$env{'form.validatepass'};
+
+ &Apache::lonnet::logthis("Phase: $currentphase");
+
+ my $stop=0;
+ while (!$stop && $currentphase < scalar(@validate_phases)) {
+ $r->print(" Validating ".$validate_phases[$currentphase]."
");
+ $r->rflush();
+ my $which="scantron_validate_".$validate_phases[$currentphase];
+ {
+ no strict 'refs';
+ ($stop,$currentphase)=&$which($r,$currentphase);
+ }
+ }
+ if (!$stop) {
+ my $warning=&scantron_warning_screen('Start Grading');
+ $r->print(<
+$warning
+
+
+STUFF
+
+ } else {
+ $r->print(' ');
+ $r->print(" ");
+ }
+ if ($stop) {
+ if ($validate_phases[$currentphase] eq 'sequence') {
+ $r->print(' ');
+ $r->print(' this error ');
+
+ $r->print(" Or click the 'Grading Menu' button to start over.
");
+ } else {
+ $r->print(' ');
+ $r->print(' using corrected info ');
+ $r->print(" ");
+ $r->print(" this scanline saving it for later.");
+ }
+ }
+ $r->print(" ".&show_grading_menu_form($symb));
+ return '';
}
-sub editgrades {
- my ($request) = @_;
- my $result='';
- my $symb=$ENV{'form.symb'};
- if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }
- my $url=$ENV{'form.url'};
- #get classlist
- my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
- my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};
- #print "Found $cdom:$cnum:$chome ";
- my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0');
-
- #get list of parts for this problem
- my (@parts) = &getpartlist($url);
-
- $result.=''."\n".
- ' '."\n".
- ' '."\n".
- ' '."\n".
- ' '."\n";
-
- foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
- $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
- }
-
- $result.='
';
- return $result;
-}
-
-sub send_header {
- my ($request)= @_;
- $request->print(&Apache::lontexconvert::header());
-# $request->print("
-#");
- $request->print('');
-}
-
-sub send_footer {
- my ($request)= @_;
- $request->print('');
- $request->print(&Apache::lontexconvert::footer());
+=pod
+
+=item scantron_remove_file
+
+ Removes the requested bubble sheet data file, makes sure that
+ scantron_original_ is never removed
+
+
+=cut
+
+sub scantron_remove_file {
+ my ($which)=@_;
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $file='scantron_';
+ if ($which eq 'corrected' || $which eq 'skipped') {
+ $file.=$which.'_';
+ } else {
+ return 'refused';
+ }
+ $file.=$env{'form.scantron_selectfile'};
+ return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
}
-sub handler {
- my $request=$_[0];
- if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} else {$Apache::lonxml::debug=0;}
+=pod
+
+=item scantron_remove_scan_data
+
+ Removes all scan_data correction for the requested bubble sheet
+ data file. (In the case that both the are doing skipped records we need
+ to remember the old skipped lines for the time being so that element
+ persists for a while.)
+
+=cut
+
+sub scantron_remove_scan_data {
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname);
+ my @todelete;
+ my $filename=$env{'form.scantron_selectfile'};
+ foreach my $key (@keys) {
+ if ($key=~/^\Q$filename\E_/) {
+ if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' &&
+ $key=~/remember_skipping/) {
+ next;
+ }
+ push(@todelete,$key);
+ }
+ }
+ my $result;
+ if (@todelete) {
+ $result=&Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname);
+ }
+ return $result;
+}
+
+
+=pod
+
+=item scantron_getfile
+
+ Fetches the requested bubble sheet data file (all 3 versions), and
+ the scan_data hash
- if ($ENV{'browser.mathml'}) {
- $request->content_type('text/xml');
- } else {
- $request->content_type('text/html');
- }
- $request->send_http_header;
- return OK if $request->header_only;
- my $url=$ENV{'form.url'};
- my $symb=$ENV{'form.symb'};
- my $command=$ENV{'form.command'};
+ Arguments:
+ None
+
+ Returns:
+ 2 hash references
+
+ - first one has
+ orig -
+ corrected -
+ skipped - each of which points to an array ref of the specified
+ file broken up into individual lines
+ count - number of scanlines
+
+ - second is the scan_data hash possible keys are
+ ($number refers to scanline numbered $number and thus the key affects
+ only that scanline
+ $bubline refers to the specific bubble line element and the aspects
+ refers to that specific bubble line element)
+
+ $number.user - username:domain to use
+ $number.CODE_ignore_dup
+ - ignore the duplicate CODE error
+ $number.useCODE
+ - use the CODE in the scanline as is
+ $number.no_bubble.$bubline
+ - it is valid that there is no bubbled in bubble
+ at $number $bubline
+ remember_skipping
+ - a frozen hash containing keys of $number and values
+ of either
+ 1 - we are on a 'do skipped records pass' and plan
+ on processing this line
+ 2 - we are on a 'do skipped records pass' and this
+ scanline has been marked to skip yet again
+
+=cut
+
+sub scantron_getfile {
+ #FIXME really would prefer a scantron directory
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $lines;
+ $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
+ 'scantron_orig_'.$env{'form.scantron_selectfile'});
+ my %scanlines;
+ $scanlines{'orig'}=[(split("\n",$lines,-1))];
+ my $temp=$scanlines{'orig'};
+ $scanlines{'count'}=$#$temp;
+
+ $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
+ 'scantron_corrected_'.$env{'form.scantron_selectfile'});
+ if ($lines eq '-1') {
+ $scanlines{'corrected'}=[];
+ } else {
+ $scanlines{'corrected'}=[(split("\n",$lines,-1))];
+ }
+ $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
+ 'scantron_skipped_'.$env{'form.scantron_selectfile'});
+ if ($lines eq '-1') {
+ $scanlines{'skipped'}=[];
+ } else {
+ $scanlines{'skipped'}=[(split("\n",$lines,-1))];
+ }
+ my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname);
+ if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
+ my %scan_data = @tmp;
+ return (\%scanlines,\%scan_data);
+}
+
+=pod
+
+=item lonnet_putfile
+
+ Wrapper routine to call &Apache::lonnet::finishuserfileupload
+
+ Arguments:
+ $contents - data to store
+ $filename - filename to store $contents into
+
+ Returns:
+ result value from &Apache::lonnet::finishuserfileupload
+
+=cut
+
+sub lonnet_putfile {
+ my ($contents,$filename)=@_;
+ my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ $env{'form.sillywaytopassafilearound'}=$contents;
+ &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename);
+
+}
+
+=pod
+
+=item scantron_putfile
+
+ Stores the current version of the bubble sheet data files, and the
+ scan_data hash. (Does not modify the original version only the
+ corrected and skipped versions.
+
+ Arguments:
+ $scanlines - hash ref that looks like the first return value from
+ &scantron_getfile()
+ $scan_data - hash ref that looks like the second return value from
+ &scantron_getfile()
+
+=cut
+
+sub scantron_putfile {
+ my ($scanlines,$scan_data) = @_;
+ #FIXME really would prefer a scantron directory
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ if ($scanlines) {
+ my $prefix='scantron_';
+# no need to update orig, shouldn't change
+# &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
+# $env{'form.scantron_selectfile'});
+ &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
+ $prefix.'corrected_'.
+ $env{'form.scantron_selectfile'});
+ &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
+ $prefix.'skipped_'.
+ $env{'form.scantron_selectfile'});
+ }
+ &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
+}
+
+=pod
+
+=item scantron_get_line
+
+ Returns the correct version of the scanline
+
+ Arguments:
+ $scanlines - hash ref that looks like the first return value from
+ &scantron_getfile()
+ $scan_data - hash ref that looks like the second return value from
+ &scantron_getfile()
+ $i - number of the requested line (starts at 0)
+
+ Returns:
+ A scanline, (either the original or the corrected one if it
+ exists), or undef if the requested scanline should be
+ skipped. (Either because it's an skipped scanline, or it's an
+ unskipped scanline and we are not doing a 'do skipped scanlines'
+ pass.
+
+=cut
+
+sub scantron_get_line {
+ my ($scanlines,$scan_data,$i)=@_;
+ if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; }
+ #if ($scanlines->{'skipped'}[$i]) { return undef; }
+ if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
+ return $scanlines->{'orig'}[$i];
+}
+
+=pod
+
+=item scantron_todo_count
+
+ Counts the number of scanlines that need processing.
+
+ Arguments:
+ $scanlines - hash ref that looks like the first return value from
+ &scantron_getfile()
+ $scan_data - hash ref that looks like the second return value from
+ &scantron_getfile()
+
+ Returns:
+ $count - number of scanlines to process
+
+=cut
+
+sub get_todo_count {
+ my ($scanlines,$scan_data)=@_;
+ my $count=0;
+ for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ my $line=&scantron_get_line($scanlines,$scan_data,$i);
+ if ($line=~/^[\s\cz]*$/) { next; }
+ $count++;
+ }
+ return $count;
+}
+
+=pod
+
+=item scantron_put_line
+
+ Updates the 'corrected' or 'skipped' versions of the bubble sheet
+ data file.
+
+ Arguments:
+ $scanlines - hash ref that looks like the first return value from
+ &scantron_getfile()
+ $scan_data - hash ref that looks like the second return value from
+ &scantron_getfile()
+ $i - line number to update
+ $newline - contents of the updated scanline
+ $skip - if true make the line for skipping and update the
+ 'skipped' file
+
+=cut
+
+sub scantron_put_line {
+ my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
+ if ($skip) {
+ $scanlines->{'skipped'}[$i]=$newline;
+ &start_skipping($scan_data,$i);
+ return;
+ }
+ $scanlines->{'corrected'}[$i]=$newline;
+}
+
+=pod
+
+=item scantron_clear_skip
+
+ Remove a line from the 'skipped' file
+
+ Arguments:
+ $scanlines - hash ref that looks like the first return value from
+ &scantron_getfile()
+ $scan_data - hash ref that looks like the second return value from
+ &scantron_getfile()
+ $i - line number to update
+
+=cut
+
+sub scantron_clear_skip {
+ my ($scanlines,$scan_data,$i)=@_;
+ if (exists($scanlines->{'skipped'}[$i])) {
+ undef($scanlines->{'skipped'}[$i]);
+ return 1;
+ }
+ return 0;
+}
+
+=pod
+
+=item scantron_filter_not_exam
+
+ Filter routine used by &Apache::lonnavmaps::retrieveResources(), to
+ filter out resources that are not marked as 'exam' mode
+
+=cut
+
+sub scantron_filter_not_exam {
+ my ($curres)=@_;
+
+ if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) {
+ # if the user has asked to not have either hidden
+ # or 'randomout' controlled resources to be graded
+ # don't include them
+ if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
+ && $curres->randomout) {
+ return 0;
+ }
+ return 1;
+ }
+ return 0;
+}
+
+=pod
+
+=item scantron_validate_sequence
+
+ Validates the selected sequence, checking for resource that are
+ not set to exam mode.
+
+=cut
+
+sub scantron_validate_sequence {
+ my ($r,$currentphase) = @_;
+
+ my $navmap=Apache::lonnavmaps::navmap->new();
+ my (undef,undef,$sequence)=
+ &Apache::lonnet::decode_symb($env{'form.selectpage'});
+
+ my $map=$navmap->getResourceByUrl($sequence);
+
+ $r->print(' ');
+ if ($env{'form.validate_sequence_exam'} ne 'ignore') {
+ my @resources=
+ $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
+ if (@resources) {
+ $r->print("".&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) = @_;
+
+ #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_lines.. array.
+
+ my %found=('ids'=>{},'usernames'=>{});
+ 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 $id=$$scan_record{'scantron.ID'};
+ my $found;
+ foreach my $checkid (keys(%idmap)) {
+ if (lc($checkid) eq lc($id)) { $found=$checkid;last; }
+ }
+ if ($found) {
+ my $username=$idmap{$found};
+ if ($found{'ids'}{$found}) {
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ $line,'duplicateID',$found);
+ return(1,$currentphase);
+ } elsif ($found{'usernames'}{$username}) {
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ $line,'duplicateID',$username);
+ return(1,$currentphase);
+ }
+ #FIXME store away line we previously saw the ID on to use above
+ $found{'ids'}{$found}++;
+ $found{'usernames'}{$username}++;
+ } else {
+ if ($id =~ /^\s*$/) {
+ my $username=&scan_data($scan_data,"$i.user");
+ if (defined($username) && $found{'usernames'}{$username}) {
+ &scantron_get_correction($r,$i,$scan_record,
+ \%scantron_config,
+ $line,'duplicateID',$username);
+ return(1,$currentphase);
+ } elsif (!defined($username)) {
+ &scantron_get_correction($r,$i,$scan_record,
+ \%scantron_config,
+ $line,'incorrectID');
+ return(1,$currentphase);
+ }
+ $found{'usernames'}{$username}++;
+ } else {
+ &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ $line,'incorrectID');
+ return(1,$currentphase);
+ }
+ }
+ }
+
+ 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
+#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 ( $$scan_record{'scantron.PaperID'} =~ /\S/) {
+ $r->print(" for PaperID ".
+ $$scan_record{'scantron.PaperID'}." \n");
+ } else {
+ $r->print(" in scanline $i
".
+ $line." \n");
+ }
+ my $message="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'}."
";
+
+ $r->print(' '."\n");
+ $r->print(' '."\n");
+ if ($error =~ /ID$/) {
+ if ($error eq 'incorrectID') {
+ $r->print("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($message);
+ $r->print("How should I handle this? \n");
+ $r->print("\n
");
+ #FIXME it would be nice if this sent back the user ID and
+ #could do partial userID matches
+ $r->print(&Apache::loncommon::selectstudent_link('scantronupload',
+ 'scantron_username','scantron_domain'));
+ $r->print(": ");
+ $r->print("\n@".
+ &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));
+
+ $r->print(' ');
+ } elsif ($error =~ /CODE$/) {
+ if ($error eq 'incorrectCODE') {
+ $r->print("The encoded CODE is not in the list of possible CODEs
\n");
+ } elsif ($error eq 'duplicateCODE') {
+ $r->print("The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique
\n");
+ }
+ $r->print("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);
+ &scantron_bubble_selector($r,$scan_config,$question,
+ split('',$selected));
+ }
+ } elsif ($error eq 'missingbubble') {
+ $r->print("There have been no bubbles scanned for some question(s)
\n");
+ $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");
+
+}
+
+=pod
+
+=item scantron_bubble_selector
- &send_header($request);
- if ($url eq '' && $symb eq '') {
- $request->print("Non-Contextual Access Unsupported:$command:$url:");
- } else {
- $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
- if ($command eq 'submission') {
- $request->print(&listStudents($request)) if ($ENV{'form.student'} eq '');
- $request->print(&submission($request)) if ($ENV{'form.student'} ne '');
- } elsif ($command eq 'viewgrades') {
- $request->print(&viewgrades($request));
- } elsif ($command eq 'editgrades') {
- $request->print(&editgrades($request));
+ Generates the html radiobuttons to correct a single bubble line
+ possibly showing the existing the selected bubbles if known
+
+ Arguments:
+ $r - Apache request object
+ $scan_config - hash from &get_scantron_config()
+ $quest - number of the bubble line to make a corrector for
+ $selected - array of letters of previously selected bubbles
+
+=cut
+
+sub scantron_bubble_selector {
+ my ($r,$scan_config,$quest,@selected)=@_;
+ my $max=$$scan_config{'Qlength'};
+
+ my $scmode=$$scan_config{'Qon'};
+
+
+ if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }
+
+ my $response = $quest-1;
+ my $lines = $bubble_lines_per_response{$response};
+ &Apache::lonnet::logthis("Question $quest, lines: $lines");
+
+ my $total_lines = $lines*2;
+ my @alphabet=('A'..'Z');
+ $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;$iprint("Unknown action:$command:");
+ %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name});
}
- }
- &send_footer($request);
- return OK;
+ return %allcodes;
+}
+
+=pod
+
+=item scantron_validate_CODE
+
+ Validates all scanlines in the selected file to not have any
+ invalid or underspecified CODEs and that none of the codes are
+ duplicated if this was requested.
+
+=cut
+
+sub scantron_validate_CODE {
+ my ($r,$currentphase) = @_;
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ 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
+ 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 {
+ &Apache::lonnet::logthis("get_max_bubble");
+ if (defined($env{'form.scantron_maxbubble'}) &&
+ $env{'form.scantron_maxbubble'}) {
+ &Apache::lonnet::logthis("cached");
+ &restore_bubble_lines();
+ return $env{'form.scantron_maxbubble'};
+ }
+ &Apache::lonnet::logthis("computing");
+
+ 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 ($trash, $part) = split(/\./, $part_id);
+
+ my $lines = $analysis{"$part_id.bubble_lines"}[0];
+
+ # 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
+
+
+
+
+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.
+
+ERROR
+ $r->print(&show_grading_menu_form(&get_symb($r,1)));
+ return;
+ }
+ my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file;
+ my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file;
+ my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file;
+ &Apache::lonnet::allowuploaded('/adm/grades',$orig);
+ &Apache::lonnet::allowuploaded('/adm/grades',$corrected);
+ &Apache::lonnet::allowuploaded('/adm/grades',$skipped);
+ $r->print(<
+ Original file as uploaded by the scantron office.
+
+
+ Corrections , a file of corrected records that were used in grading.
+
+
+ Skipped , a file of records that were skipped.
+
+DOWNLOAD
+ $r->print(&show_grading_menu_form(&get_symb($r,1)));
+ return '';
+}
+
+=pod
+
+=back
+
+=cut
+
+#-------- end of section for handling grading scantron forms -------
+#
+#-------------------------------------------------------------------
+
+#-------------------------- Menu interface -------------------------
+#
+#--- Show a Grading Menu button - Calls the next routine ---
+sub show_grading_menu_form {
+ my ($symb)=@_;
+ my $result.=''."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n";
+ return $result;
+}
+
+# -- Retrieve choices for grading form
+sub savedState {
+ my %savedState = ();
+ if ($env{'form.saveState'}) {
+ foreach (split(/:/,$env{'form.saveState'})) {
+ my ($key,$value) = split(/=/,$_,2);
+ $savedState{$key} = $value;
+ }
+ }
+ return \%savedState;
+}
+
+sub grading_menu {
+ my ($request) = @_;
+ my ($symb)=&get_symb($request);
+ if (!$symb) {return '';}
+ my $probTitle = &Apache::lonnet::gettitle($symb);
+ my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
+
+ #
+ # Define menu data
+ $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
+ my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
+ $request->print($table);
+ my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb),
+ 'handgrade'=>$hdgrade,
+ 'probTitle'=>$probTitle,
+ 'command'=>'submit_options',
+ 'saveState'=>"",
+ 'gradingMenu'=>1,
+ 'showgrading'=>"yes");
+ my $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
+ my @menu = ({ url => $url,
+ name => &mt('Manual Grading/View Submissions'),
+ short_description =>
+ &mt('Start the process of hand grading submissions.'),
+ });
+ $fields{'command'} = 'csvform';
+ $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
+ push (@menu, { url => $url,
+ name => &mt('Upload Scores'),
+ short_description =>
+ &mt('Specify a file containing the class scores for current resource.')});
+ $fields{'command'} = 'processclicker';
+ $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
+ push (@menu, { url => $url,
+ name => &mt('Process Clicker'),
+ short_description =>
+ &mt('Specify a file containing the clicker information for this resource.')});
+ $fields{'command'} = 'scantron_selectphase';
+ $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
+ push (@menu, { url => $url,
+ name => &mt('Grade Scantron Forms'),
+ short_description =>
+ &mt('')});
+ $fields{'command'} = 'verify';
+ $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
+ push (@menu, { url => "",
+ jscript => ' onClick="javascript:checkChoice2(document.forms.gradingMenu,\'5\',\'verify\')" ',
+ name => &mt('Verify Receipt'),
+ short_description =>
+ &mt('')});
+ $fields{'command'} = 'manage';
+ $url = &Apache::lonhtmlcommon::build_url('/adm/helper/resettimes.helper',\%fields);
+ push (@menu, { url => $url,
+ name => &mt('Manage Access Times'),
+ short_description =>
+ &mt('')});
+ $fields{'command'} = 'view';
+ $url = &Apache::lonhtmlcommon::build_url('/adm/pickcode',\%fields);
+ push (@menu, { url => $url,
+ name => &mt('View Saved CODEs'),
+ short_description =>
+ &mt('')});
+
+ #
+ # Create the menu
+ my $Str;
+ # $Str .= ''.&mt('Please select a grading task').' ';
+ $Str .= '';
+ $Str .= ' '.
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n";
+
+ foreach my $menudata (@menu) {
+ if ($menudata->{'name'} ne &mt('Verify Receipt')) {
+ $Str .=' \n";
+ } else {
+ $Str .=' \n";
+ $Str .= (' 'x8).
+ ' receipt: '.&Apache::lonnet::recprefix($env{'request.course.id'}).
+ '- ';
+ }
+ $Str .= ' '.(' 'x8).$menudata->{'short_description'}.
+ "\n";
+ }
+ $Str .="\n";
+ $Str .=" \n";
+ $request->print(<
+ function checkChoice(formname,val,cmdx) {
+ if (val <= 2) {
+ var cmd = radioSelection(formname.radioChoice);
+ var cmdsave = cmd;
+ } else {
+ cmd = cmdx;
+ cmdsave = 'submission';
+ }
+ formname.command.value = cmd;
+ formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+
+ ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);
+ if (val < 5) formname.submit();
+ if (val == 5) {
+ if (!checkReceiptNo(formname,'notOK')) { return false;}
+ formname.submit();
+ }
+ if (val < 7) formname.submit();
+ }
+ function checkChoice2(formname,val,cmdx) {
+ if (val <= 2) {
+ var cmd = radioSelection(formname.radioChoice);
+ var cmdsave = cmd;
+ } else {
+ cmd = cmdx;
+ cmdsave = 'submission';
+ }
+ formname.command.value = cmd;
+ if (val < 5) formname.submit();
+ if (val == 5) {
+ if (!checkReceiptNo(formname,'notOK')) { return false;}
+ formname.submit();
+ }
+ if (val < 7) formname.submit();
+ }
+
+ function checkReceiptNo(formname,nospace) {
+ var receiptNo = formname.receipt.value;
+ var checkOpt = false;
+ if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;}
+ if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;}
+ if (checkOpt) {
+ alert("Please enter a receipt number given by a student in the receipt box.");
+ formname.receipt.value = "";
+ formname.receipt.focus();
+ return false;
+ }
+ return true;
+ }
+
+GRADINGMENUJS
+ &commonJSfunctions($request);
+ my $result=' Manual Grading/View Submission ';
+ $result.=$table;
+ my (undef,$sections) = &getclasslist('all','0');
+ my $savedState = &savedState();
+ my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'});
+ my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'});
+ my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'});
+ my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
+
+ $result.=''."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n";
+
+ $result.=''."\n".
+ ''."\n".
+ ' Select a Grading/Viewing Option '."\n".
+ ''."\n";
+
+ $result.='';
+ $result.=''."\n";
+ $result.=''.&mt('Sections').' ';
+# $result.='Groups ';
+ $result.=''.&mt('Access Status').' '."\n";
+ $result.=' ';
+ $result.=''."\n".
+ ' '."\n";
+ if (ref($sections)) {
+ foreach (sort (@$sections)) {
+ $result.=''.$_.' '."\n";
+ }
+ }
+ $result.= 'all ';
+ return $Str;
+}
+
+
+#--- Displays the submissions first page -------
+sub submit_options {
+ my ($request) = @_;
+ my ($symb)=&get_symb($request);
+ if (!$symb) {return '';}
+ my $probTitle = &Apache::lonnet::gettitle($symb);
+
+ $request->print(<
+ function checkChoice(formname,val,cmdx) {
+ if (val <= 2) {
+ var cmd = radioSelection(formname.radioChoice);
+ var cmdsave = cmd;
+ } else {
+ cmd = cmdx;
+ cmdsave = 'submission';
+ }
+ formname.command.value = cmd;
+ formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+
+ ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);
+ if (val < 5) formname.submit();
+ if (val == 5) {
+ if (!checkReceiptNo(formname,'notOK')) { return false;}
+ formname.submit();
+ }
+ if (val < 7) formname.submit();
+ }
+
+ function checkReceiptNo(formname,nospace) {
+ var receiptNo = formname.receipt.value;
+ var checkOpt = false;
+ if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;}
+ if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;}
+ if (checkOpt) {
+ alert("Please enter a receipt number given by a student in the receipt box.");
+ formname.receipt.value = "";
+ formname.receipt.focus();
+ return false;
+ }
+ return true;
+ }
+
+GRADINGMENUJS
+ &commonJSfunctions($request);
+ my $result=' Manual Grading/View Submission ';
+ my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
+ $result.=$table;
+ my (undef,$sections) = &getclasslist('all','0');
+ my $savedState = &savedState();
+ my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'});
+ my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'});
+ my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'});
+ my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
+
+ $result.=''."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n".
+ ' '."\n";
+
+ $result.=''."\n".
+ ''."\n".
+ ' Select a Grading/Viewing Option '."\n".
+ ''."\n";
+
+ $result.=''."\n";
+
+ $result.=' '; #';
+
+# $result.=''."\n".' ';
+ $result.= '
'."\n".
+ '
'."\n";
+ return $result;
+}
+
+sub reset_perm {
+ undef(%perm);
+}
+
+sub init_perm {
+ &reset_perm();
+ foreach my $test_perm ('vgr','mgr','opa') {
+
+ my $scope = $env{'request.course.id'};
+ if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) {
+
+ $scope .= '/'.$env{'request.course.sec'};
+ if ( $perm{$test_perm}=
+ &Apache::lonnet::allowed($test_perm,$scope)) {
+ $perm{$test_perm.'_section'}=$env{'request.course.sec'};
+ } else {
+ delete($perm{$test_perm});
+ }
+ }
+ }
+}
+
+sub gather_clicker_ids {
+ my %clicker_ids;
+
+ 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;
+ }
+ }
+ }
+ return %clicker_ids;
+}
+
+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;
+}
+
+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";
+ $result.=''."\n".
+ '
'."\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.=''.&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.="
\n";
+ if ($number==0) {
+ $result.=''.&mt('No IDs found to determine correct answer').' ';
+ return $result.&show_grading_menu_form($symb);
+ }
+ }
+ if (length($env{'form.upfile'}) < 2) {
+ $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.',
+ '',
+ ' ',
+ ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').' ');
+ return $result.&show_grading_menu_form($symb);
+ }
+
+# Were able to get all the info needed, now analyze the file
+
+ $result.=&Apache::loncommon::studentbrowser_javascript();
+ $symb = &Apache::lonenc::check_encrypt($symb);
+ my $heading=&mt('Scanning clicker file');
+ $result.=(<
+
+$heading
+
+
+
+
+
+
+
+
+ENDHEADER
+ my %responses;
+ my @questiontitles;
+ my $errormsg='';
+ my $number=0;
+ if ($env{'form.upfiletype'} eq 'iclicker') {
+ ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
+ }
+ if ($env{'form.upfiletype'} eq 'interwrite') {
+ ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
+ }
+ $result.=' '.&mt('Found [_1] question(s)',$number).' '.
+ ' '.
+ &mt('Awarding [_1] percent for corrion(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".' '.
+ "";
+ foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) {
+ $result.="".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.') ';
+ }
+ $result.=' ';
+ $unknown_count++;
+ } else {
+# Good: found one and only one user with the right clicker
+ $result.="\n".' ';
+ $student_count++;
+ }
+ } else {
+ $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".
+ '
'."\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.=(<
+
+$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".
+ '
'."\n";
+ return $result.&show_grading_menu_form($symb);
+}
+
+sub handler {
+ my $request=$_[0];
+
+ &reset_caches();
+ if ($env{'browser.mathml'}) {
+ &Apache::loncommon::content_type($request,'text/xml');
+ } else {
+ &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 $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));
+ }
+
+
+ $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)=&Apache::lonnet::decode_symb($tsymb);
+ if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
+ $request->print(&Apache::lonnet::ssi_body('/res/'.$url,
+ ('grade_username' => $tuname,
+ 'grade_domain' => $tudom,
+ 'grade_courseid' => $tcrsid,
+ 'grade_symb' => $tsymb)));
+ } else {
+ $request->print('Not authorized: '.$token.' ');
+ }
+ } else {
+ $request->print('Not a valid DocID: '.$token.' ');
+ }
+ } else {
+ $request->print(&Apache::lonxml::tokeninputfield());
+ }
+ }
+ } else {
+ &init_perm();
+ if ($command eq 'submission' && $perm{'vgr'}) {
+ ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
+ } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
+ &pickStudentPage($request);
+ } elsif ($command eq 'displayPage' && $perm{'vgr'}) {
+ &displayPage($request);
+ } elsif ($command eq 'gradeByPage' && $perm{'mgr'}) {
+ &updateGradeByPage($request);
+ } elsif ($command eq 'processGroup' && $perm{'vgr'}) {
+ &processGroup($request);
+ } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) {
+ $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'}) {
+ $request->print(&processHandGrade($request));
+ } elsif ($command eq 'editgrades' && $perm{'mgr'}) {
+ $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 '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';
+ } else {
+ $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'}) {
+ &Apache::lonnet::logthis("Selecting pyhase");
+ $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'})||
+ &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("Access Denied ($command)");
+ }
+ }
+ $request->print(&Apache::loncommon::end_page());
+ &reset_caches();
+ return '';
}
1;