'.
+ ''.
+ '| Prob. | '.
+ ' '.($env{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade | ';
+
+ &Apache::lonxml::clear_problem_counter();
+ my ($depth,$question,$prob) = (1,1,1);
$iterator->next(); # skip the first BEGIN_MAP
my $curRes = $iterator->next(); # for "current resource"
- my %symbx = ();
- my @titles = ();
- my %parts = ();
- my $ctr=0;
- my $minder=0;
- while ($depth > 0 && $ctr < 100) { # ctr, just in case it never gets out of loop
+ while ($depth > 0) {
if($curRes == $iterator->BEGIN_MAP) { $depth++; }
- if($curRes == $iterator->END_MAP) { $depth++; }
+ if($curRes == $iterator->END_MAP) { $depth--; }
- if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) {
+ if (ref($curRes) && $curRes->is_problem()) {
my $parts = $curRes->parts();
my $title = $curRes->compTitle();
- push @titles,$minder.'.'.$title; # minder, just in case two titles are identical
- if (scalar(@{$parts}) > 1) { shift @{$parts}; }
- $parts{$minder.'.'.$title} = join '::',@{$parts};
- $symbx{$minder.'.'.$title} = $curRes->symb();
- $minder++;
+ my $symbx = $curRes->symb();
+ $studentTable.=''.$prob.
+ (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').' | ';
+ $studentTable.='';
+ my %form = ('CODE' => $env{'form.CODE'},);
+ if ($env{'form.vProb'} eq 'yes' ) {
+ $studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
+ undef,'both',\%form);
+ } else {
+ my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form);
+ $companswer =~ s|||g;
+ $companswer =~ s|||g;
+# while ($companswer =~ /()/s) { #\n");
+# }
+# $companswer =~ s|||g;
+ $studentTable.=' '.$title.'
Correct answer:
'.$companswer;
+ }
- }
+ my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);
+
+ if ($env{'form.lastSub'} eq 'datesub') {
+ if ($record{'version'} eq '') {
+ $studentTable.='
No recorded submission for this problem
';
+ } else {
+ my %responseType = ();
+ foreach my $partid (@{$parts}) {
+ my @responseIds =$curRes->responseIds($partid);
+ my @responseType =$curRes->responseType($partid);
+ my %responseIds;
+ for (my $i=0;$i<=$#responseIds;$i++) {
+ $responseIds{$responseIds[$i]}=$responseType[$i];
+ }
+ $responseType{$partid} = \%responseIds;
+ }
+ $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom);
+
+ }
+ } elsif ($env{'form.lastSub'} eq 'all') {
+ my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
+ $studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom,
+ $env{'request.course.id'},
+ '','.submission');
+
+ }
+ if (&canmodify($usec)) {
+ foreach my $partid (@{$parts}) {
+ $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record);
+ $studentTable.=''."\n";
+ $question++;
+ }
+ $prob++;
+ }
+ $studentTable.='';
+
+ }
$curRes = $iterator->next();
- $ctr++;
}
+ $studentTable.=' '."\n".
+ ''.
+ ''."\n";
+ $studentTable.=&show_grading_menu_form($symb);
+ $request->print($studentTable);
+
+ return '';
+}
+
+sub displaySubByDates {
+ my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
+ my $isCODE=0;
+ my $isTask = ($symb =~/\.task$/);
+ if (exists($record->{'resource.CODE'})) { $isCODE=1; }
+ my $studentTable=''.
+ ''.
+ '| Date/Time | '.
+ ($isCODE?'CODE | ':'').
+ 'Submission | '.
+ 'Status | ';
+ my ($version);
+ my %mark;
+ my %orders;
+ $mark{'correct_by_student'} = $checkIcon;
+ if (!exists($$record{'1:timestamp'})) {
+ return '
Nothing submitted - no attempts
';
+ }
+
+ my $interaction;
+ for ($version=1;$version<=$$record{'version'};$version++) {
+ my $timestamp = scalar(localtime($$record{$version.':timestamp'}));
+ if (exists($$record{$version.':resource.0.version'})) {
+ $interaction = $$record{$version.':resource.0.version'};
+ }
+
+ my $where = ($isTask ? "$version:resource.$interaction"
+ : "$version:resource");
+ #&Apache::lonnet::logthis(" got $where");
+ $studentTable.='| '.$timestamp.' | ';
+ if ($isCODE) {
+ $studentTable.=''.$record->{$version.':resource.CODE'}.' | ';
+ }
+ my @versionKeys = split(/\:/,$$record{$version.':keys'});
+ my @displaySub = ();
+ foreach my $partid (@{$parts}) {
+ my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)
+ : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
+
+
+# next if ($$record{"$version:resource.$partid.solved"} eq '');
+ my $display_part=&get_display_part($partid,$symb);
+ foreach my $matchKey (@matchKey) {
+ if (exists($$record{$version.':'.$matchKey}) &&
+ $$record{$version.':'.$matchKey} ne '') {
+
+ my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
+ : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
+ #&Apache::lonnet::logthis("match $matchKey $responseId (".$$record{$version.':'.$matchKey});
+ $displaySub[0].='Part: '.$display_part.' ';
+ $displaySub[0].='(ID '.
+ $responseId.') ';
+ if ($$record{"$where.$partid.tries"} eq '') {
+ $displaySub[0].='Trial not counted';
+ } else {
+ $displaySub[0].='Trial '.
+ $$record{"$where.$partid.tries"};
+ }
+ my $responseType=($isTask ? 'Task'
+ : $responseType->{$partid}->{$responseId});
+ if (!exists($orders{$partid})) { $orders{$partid}={}; }
+ if (!exists($orders{$partid}->{$responseId})) {
+ $orders{$partid}->{$responseId}=
+ &get_order($partid,$responseId,$symb,$uname,$udom);
+ }
+ $displaySub[0].=' '.
+ &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'
';
+ }
+ }
+ if (exists($$record{"$where.$partid.checkedin"})) {
+ $displaySub[1].='Checked in by '.
+ $$record{"$where.$partid.checkedin"}.' into slot '.
+ $$record{"$where.$partid.checkedin.slot"}.
+ '
';
+ }
+ if (exists $$record{"$where.$partid.award"}) {
+ $displaySub[1].='Part: '.$display_part.' '.
+ lc($$record{"$where.$partid.award"}).' '.
+ $mark{$$record{"$where.$partid.solved"}}.
+ '
';
+ }
+ if (exists $$record{"$where.$partid.regrader"}) {
+ $displaySub[2].=$$record{"$where.$partid.regrader"}.
+ ' ('.&mt('Part').': '.$display_part.')';
+ } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) {
+ $displaySub[2].=
+ $$record{"$version:resource.$partid.regrader"}.
+ ' ('.&mt('Part').': '.$display_part.')';
+ }
+ }
+ # needed because old essay regrader has not parts info
+ if (exists $$record{"$version:resource.regrader"}) {
+ $displaySub[2].=$$record{"$version:resource.regrader"};
+ }
+ $studentTable.=''.$displaySub[0].' | '.$displaySub[1];
+ if ($displaySub[2]) {
+ $studentTable.='Manually graded by '.$displaySub[2];
+ }
+ $studentTable.=' | ';
+
+ }
+ $studentTable.='
|
';
+ return $studentTable;
+}
+
+sub updateGradeByPage {
+ my ($request) = shift;
+
+ 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];
+ if (!&canmodify($usec)) {
+ $request->print('Unable to modify requested student.('.$env{'form.student'}.'');
+ $request->print(&show_grading_menu_form($env{'form.symb'}));
+ return;
+ }
+ my $result=' '.$env{'form.title'}.'';
+ $result.=' Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
+ ''."\n";
- $navmap->init();
$request->print($result);
- &sub_page_js($request);
- my $studentTable=' |
';
- $studentTable.='';
+=pod
- $request->print($studentTable);
+=item scantron_filter
+
+ Filter sub for lonnavmaps, filters out hidden resources if ignore
+ hidden resources was selected
+
+=cut
+
+sub scantron_filter {
+ my ($curres)=@_;
+
+ if (ref($curres) && $curres->is_problem()) {
+ # 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_process_corrections
+
+ Gets correction information out of submitted form data and corrects
+ the scanline
+
+=cut
+
+sub scantron_process_corrections {
+ my ($r) = @_;
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ my $classlist=&Apache::loncoursedata::get_classlist();
+ my $which=$env{'form.scantron_line'};
+ my $line=&scantron_get_line($scanlines,$scan_data,$which);
+ my ($skip,$err,$errmsg);
+ if ($env{'form.scantron_skip_record'}) {
+ $skip=1;
+ } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
+ my $newstudent=$env{'form.scantron_username'}.':'.
+ $env{'form.scantron_domain'};
+ my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
+ ($line,$err,$errmsg)=
+ &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
+ 'ID',{'newid'=>$newid,
+ 'username'=>$env{'form.scantron_username'},
+ 'domain'=>$env{'form.scantron_domain'}});
+ } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) {
+ my $resolution=$env{'form.scantron_CODE_resolution'};
+ my $newCODE;
+ my %args;
+ if ($resolution eq 'use_unfound') {
+ $newCODE='use_unfound';
+ } elsif ($resolution eq 'use_found') {
+ $newCODE=$env{'form.scantron_CODE_selectedvalue'};
+ } elsif ($resolution eq 'use_typed') {
+ $newCODE=$env{'form.scantron_CODE_newvalue'};
+ } elsif ($resolution =~ /^use_closest_(\d+)/) {
+ $newCODE=$env{"form.scantron_CODE_closest_$1"};
+ }
+ if ($env{'form.scantron_corrections'} eq 'duplicateCODE') {
+ $args{'CODE_ignore_dup'}=1;
+ }
+ $args{'CODE'}=$newCODE;
+ ($line,$err,$errmsg)=
+ &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
+ 'CODE',\%args);
+ } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
+ foreach my $question (split(',',$env{'form.scantron_questions'})) {
+ ($line,$err,$errmsg)=
+ &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
+ $which,'answer',
+ { 'question'=>$question,
+ 'response'=>$env{"form.scantron_correct_Q_$question"}});
+ if ($err) { last; }
+ }
+ }
+ if ($err) {
+ $r->print("Unable to accept last correction, an error occurred :$errmsg:");
+ } else {
+ &scantron_put_line($scanlines,$scan_data,$which,$line,$skip);
+ &scantron_putfile($scanlines,$scan_data);
+ }
+}
+
+=pod
+
+=item reset_skipping_status
+
+ Forgets the current set of remember skipped scanlines (and thus
+ reverts back to considering all lines in the
+ scantron_skipped_ file)
+
+=cut
+
+sub reset_skipping_status {
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ &scan_data($scan_data,'remember_skipping',undef,1);
+ &scantron_putfile(undef,$scan_data);
+}
+
+=pod
+
+=item start_skipping
+
+ Marks a scanline to be skipped.
+
+=cut
+
+sub start_skipping {
+ my ($scan_data,$i)=@_;
+ my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
+ if ($env{'form.scantron_options_redo'} =~ /^redo_/) {
+ $remembered{$i}=2;
+ } else {
+ $remembered{$i}=1;
+ }
+ &scan_data($scan_data,'remember_skipping',join(':',%remembered));
+}
+
+=pod
+
+=item should_be_skipped
+
+ Checks whether a scanline should be skipped.
+
+=cut
+
+sub should_be_skipped {
+ my ($scanlines,$scan_data,$i)=@_;
+ if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
+ # not redoing old skips
+ if ($scanlines->{'skipped'}[$i]) { return 1; }
+ return 0;
+ }
+ my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
+
+ if (exists($remembered{$i}) && $remembered{$i} != 2 ) {
+ return 0;
+ }
+ return 1;
+}
+
+=pod
+
+=item remember_current_skipped
+
+ Discovers what scanlines are in the scantron_skipped_
+ file and remembers them into scan_data for later use.
+
+=cut
+
+sub remember_current_skipped {
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ my %to_remember;
+ for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ if ($scanlines->{'skipped'}[$i]) {
+ $to_remember{$i}=1;
+ }
+ }
+
+ &scan_data($scan_data,'remember_skipping',join(':',%to_remember));
+ &scantron_putfile(undef,$scan_data);
+}
+
+=pod
+
+=item check_for_error
+
+ Checks if there was an error when attempting to remove a specific
+ scantron_.. bubble sheet data file. Prints out an error if
+ something went wrong.
+
+=cut
+
+sub check_for_error {
+ my ($r,$result)=@_;
+ if ($result ne 'ok' && $result ne 'not_found' ) {
+ $r->print("An error occurred ($result) when trying to Remove the existing corrections.");
+ }
+}
+
+=pod
+
+=item scantron_warning_screen
+ Interstitial screen to make sure the operator has selected the
+ correct options before we start the validation phase.
+
+=cut
+
+sub scantron_warning_screen {
+ my ($button_text)=@_;
+ my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my $CODElist;
+ if ($scantron_config{'CODElocation'} &&
+ $scantron_config{'CODEstart'} &&
+ $scantron_config{'CODElength'}) {
+ $CODElist=$env{'form.scantron_CODElist'};
+ if ($env{'form.scantron_CODElist'} eq '') { $CODElist='None'; }
+ $CODElist=
+ '| List of CODES to validate against: | '.
+ $env{'form.scantron_CODElist'}.' | ';
+ }
+ return (<
+Please double check the information
+ below before clicking on '$button_text'
+
+
+| Sequence to be Graded: | $title |
+| Data File that will be used: | $env{'form.scantron_selectfile'} |
+$CODElist
+
+
+ If this information is correct, please click on '$button_text'.
+ If something is incorrect, please click the 'Grading Menu' button to start over.
+
+
+STUFF
+}
+
+=pod
+
+=item scantron_do_warning
+
+ Check if the operator has picked something for all required
+ fields. Error out if something is missing.
+
+=cut
+
+sub scantron_do_warning {
+ my ($r)=@_;
+ my ($symb)=&get_symb($r);
+ if (!$symb) {return '';}
+ my $default_form_data=&defaultFormData($symb);
+ $r->print(&scantron_form_start().$default_form_data);
+ if ( $env{'form.selectpage'} eq '' ||
+ $env{'form.scantron_selectfile'} eq '' ||
+ $env{'form.scantron_format'} eq '' ) {
+ $r->print("You have forgetten to specify some information. Please go Back and try again. ");
+ if ( $env{'form.selectpage'} eq '') {
+ $r->print('You have not selected a Sequence to grade ');
+ }
+ if ( $env{'form.scantron_selectfile'} eq '') {
+ $r->print('You have not selected a file that contains the student\'s response data. ');
+ }
+ if ( $env{'form.scantron_format'} eq '') {
+ $r->print('You have not selected a the format of the student\'s response data. ');
+ }
+ } else {
+ my $warning=&scantron_warning_screen('Grading: Validate Records');
+ $r->print(<
+
+STUFF
+ }
+ $r->print("
".&show_grading_menu_form($symb));
return '';
}
-sub gradeBox {
- my ($symb,$uname,$udom,$counter,$partid,$record) = @_;
- my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
- my $wgtmsg = ($wgt > 0 ? '(problem weight)' :
- 'problem weight assigned by computer');
- $wgt = ($wgt > 0 ? $wgt : '1');
- my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
- '' : $$record{'resource.'.$partid.'.awarded'}*$wgt);
- my $result='';
- $result.='| Part '.$partid.' Points: | ';
+=pod
- my $ctr = 0;
- $result.=''; # display radio buttons in a nice table 10 across
- while ($ctr<=$wgt) {
- $result.= '| '.$ctr." | \n";
- $result.=(($ctr+1)%10 == 0 ? ' ' : '');
- $ctr++;
+=item scantron_form_start
+
+ html hidden input for remembering all selected grading options
+
+=cut
+
+sub scantron_form_start {
+ my ($max_bubble)=@_;
+ my $result= <
+
+
+
+
+
+
+
+
+
+SCANTRONFORM
+ return $result;
+}
+
+=pod
+
+=item scantron_validate_file
+
+ Dispatch routine for doing validation of a bubble sheet data file.
+
+ 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'};
+
+ 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("");
}
- $result.='
';
- $result.=' | or | ';
- $result.=' | '."\n";
- $result.='/'.$wgt.' '.$wgtmsg.' | ';
+ if ($stop) {
+ if ($validate_phases[$currentphase] eq 'sequence') {
+ $r->print('');
+ $r->print(' this error
');
- $result.='';
+ $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 '';
+}
+
+
+=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 {
- $result.=''.
- '';
+ return 'refused';
+ }
+ $file.=$env{'form.scantron_selectfile'};
+ return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
+}
+
+
+=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);
}
- $result.=" \n";
- $result.='';
- $result.=' |
'."\n";
return $result;
}
-#--- Form to input a receipt number ---
-sub verifyReceipt_form {
- my ($symb,$url) = @_;
- my $result = ''."\n";
- my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'});
+=pod
- $result.=''."\n";
- $result.='| '."\n";
- $result.=' Verify a Submission Receipt Issued by this Server | '."\n";
- $result.='| '."\n";
- $result.='';
- $result.=' |
'."\n";
- $result.=' |
'."\n";
+ 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();
+
+ 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("");
+ $r->print("\n
");
+ $i++;
+ }
+ }
+ }
+ if ($$scan_record{'scantron.CODE'}=~/\S/ ) {
+ my $checked; if (!$i) { $checked=' checked="checked" '; }
+ $r->print("");
+ $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(" Selected CODE is ");
+ $r->print("\n
");
+ }
+ $r->print(" 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=$$scan_record{"scantron.$question.answer"};
+ &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=$$scan_record{"scantron.$question.answer"};
+ &scantron_bubble_selector($r,$scan_config,$question);
+ }
+ } else {
+ $r->print("\n");
+
+}
+
+=pod
+
+=item scantron_bubble_selector
+
+ Generates the html radiobuttons to correct a single bubble line
+ possibly showing the existing the selected bubbles if known
+
+ Arguments:
+ $r - Apache request object
+ $scan_config - hash from &get_scantron_config()
+ $quest - number of the bubble line to make a corrector for
+ $selected - array of letters of previously selected bubbles
+ $lines - if present, number of bubble lines to show
+
+=cut
+
+sub scantron_bubble_selector {
+ my ($r,$scan_config,$quest,@selected, $lines)=@_;
+ my $max=$$scan_config{'Qlength'};
+
+ my $scmode=$$scan_config{'Qon'};
+ if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }
+
+
+ if (!defined($lines)) {
+ $lines = 1;
+ }
+ 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;$i{'count'};$i++) {
+ my $line=&scantron_get_line($scanlines,$scan_data,$i);
+ if ($line=~/^[\s\cz]*$/) { next; }
+ my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
+ $scan_data);
+ my $CODE=$$scan_record{'scantron.CODE'};
+ my $error=0;
+ if (!&Apache::lonnet::validCODE($CODE)) {
+ &scantron_get_correction($r,$i,$scan_record,
+ \%scantron_config,
+ $line,'incorrectCODE',\%allcodes);
+ return(1,$currentphase);
+ }
+ if (%allcodes && !exists($allcodes{$CODE})
+ && !$$scan_record{'scantron.useCODE'}) {
+ &scantron_get_correction($r,$i,$scan_record,
+ \%scantron_config,
+ $line,'incorrectCODE',\%allcodes);
+ return(1,$currentphase);
+ }
+ if (exists($usedCODEs{$CODE})
+ && $env{'form.scantron_CODEunique'} eq 'yes'
+ && !$$scan_record{'scantron.CODE_ignore_dup'}) {
+ &scantron_get_correction($r,$i,$scan_record,
+ \%scantron_config,
+ $line,'duplicateCODE',$usedCODEs{$CODE});
+ return(1,$currentphase);
+ }
+ push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
+ }
+ return (0,$currentphase+1);
+}
+
+=pod
+
+=item scantron_validate_doublebubble
+
+ Validates all scanlines in the selected file to not have any
+ bubble lines with multiple bubbles marked.
+
+=cut
+
+sub scantron_validate_doublebubble {
+ my ($r,$currentphase) = @_;
+ #get student info
+ my $classlist=&Apache::loncoursedata::get_classlist();
+ my %idmap=&username_to_idmap($classlist);
+
+ #get scantron line setup
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ 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 result to $env{'form.scantron_maxbubble'}
+
+=cut
+
+sub scantron_get_maxbubble {
+
+ if (defined($env{'form.scantron_maxbubble'}) &&
+ $env{'form.scantron_maxbubble'}) {
+ return $env{'form.scantron_maxbubble'};
+ }
+
+ my $navmap=Apache::lonnavmaps::navmap->new();
+ my (undef,undef,$sequence)=
+ &Apache::lonnet::decode_symb($env{'form.selectpage'});
+
+ 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 = ();
+
+ foreach my $resource (@resources) {
+ my $symb = $resource->symb();
+ 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 $bubble_lines = $analysis{"$part_id.bubble_lines"}[0];
+ if (!$bubble_lines) {
+ $bubble_lines = 1;
+ }
+ $bubble_lines_per_response{"$symb.$part_id"} = $bubble_lines;
+ $total_lines = $total_lines + $bubble_lines;
+ }
+
+ }
+ &Apache::lonnet::delenv('scantron\.');
+ $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
+ bubble lines with missing bubbles that haven't been verified as missing.
+
+=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);
+ 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 '') {
+ &Apache::lonnet::logthis("scantron grading error -> $result");
+ &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $env{'request.course.id'} url ".$resource->src());
+ }
+ 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();
+ }
+
+
+
+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";
+ 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";
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;
+}
+
+#--- Displays the main menu page -------
+sub gradingmenu {
+ 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";
+ 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";
+ $result.=' '.&mt('Specify a file containing the clicker information for this resource').
+ '. | '."\n";
+ $result.='| '."\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.=<
+function sanitycheck() {
+// Accept only integer percentages
+ document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value);
+ document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value);
+// Find out grading choice
+ for (i=0; i
+
+ENDUPFORM
+ $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.=(<
'."\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];
-
- 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 '') {
- 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));
+ }
+ $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('/res/'.$url,
- ('grade_username' => $tuname,
- 'grade_domain' => $tudom,
- 'grade_courseid' => $tcrsid,
- 'grade_symb' => $tsymb)));
+ $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.'');
}
@@ -2678,70 +7637,80 @@ sub handler {
}
}
} else {
- $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
- if ($command eq 'submission') {
- ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
-# if ($command eq 'submission') {
-# &listStudents($request) if ($ENV{'form.student'} eq '');
-# &submission($request,0,0) if ($ENV{'form.student'} ne '');
- } elsif ($command eq 'pickStudentPage') {
+ &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') {
+ } elsif ($command eq 'displayPage' && $perm{'vgr'}) {
&displayPage($request);
- } elsif ($command eq 'processGroup') {
+ } elsif ($command eq 'gradeByPage' && $perm{'mgr'}) {
+ &updateGradeByPage($request);
+ } elsif ($command eq 'processGroup' && $perm{'vgr'}) {
&processGroup($request);
- } elsif ($command eq 'gradingmenu') {
+ } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) {
$request->print(&gradingmenu($request));
- } elsif ($command eq 'viewgrades') {
+ } elsif ($command eq 'viewgrades' && $perm{'vgr'}) {
$request->print(&viewgrades($request));
- } elsif ($command eq 'handgrade') {
+ } elsif ($command eq 'handgrade' && $perm{'mgr'}) {
$request->print(&processHandGrade($request));
- } elsif ($command eq 'editgrades') {
+ } elsif ($command eq 'editgrades' && $perm{'mgr'}) {
$request->print(&editgrades($request));
- } elsif ($command eq 'verify') {
+ } elsif ($command eq 'verify' && $perm{'vgr'}) {
$request->print(&verifyreceipt($request));
- } elsif ($command eq 'csvupload') {
+ } 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 'viewclasslist') {
- $request->print(&viewclasslist($request));
- } elsif ($command eq 'csvuploadmap') {
+ } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {
$request->print(&csvuploadmap($request));
- } elsif ($command eq 'csvuploadassign') {
- 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));
}
- } else {
- $request->print("Unknown action: $command:");
+ } 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'})||
+ &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)");
}
}
- &send_footer($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'));
-}
-
-sub send_footer {
- my ($request)= @_;
- $request->print('');
- $request->print(&Apache::lontexconvert::footer());
-}
-
1;
__END__;
|
.
+ '/check.gif){kind=small}
';
+ my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
+ my $wgtmsg = ($wgt > 0 ? '(problem weight)' :
+ 'problem weight assigned by computer');
+ $wgt = ($wgt > 0 ? $wgt : '1');
+ my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
+ '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
+ my $result=''."\n";
+ my $display_part=&get_display_part($partid,$symb);
+ my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
+ [$partid]);
+ my $aggtries = $$record{'resource.'.$partid.'.tries'};
+ if ($last_resets{$partid}) {
+ $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
+ }
+ $result.='.
+ '/mailbkgrd.gif){kind=small}
'."\n".
+ '