--- loncom/homework/grades.pm 2017/12/18 23:51:24 1.745 +++ loncom/homework/grades.pm 2020/08/26 18:13:40 1.771 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.745 2017/12/18 23:51:24 raeburn Exp $ +# $Id: grades.pm,v 1.771 2020/08/26 18:13:40 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -46,7 +46,10 @@ use Apache::lonenc; use Apache::lonstathelpers; use Apache::lonquickgrades; use Apache::bridgetask(); +use Apache::lontexconvert(); use String::Similarity; +use HTML::Parser(); +use File::MMagic; use LONCAPA; use POSIX qw(floor); @@ -312,7 +315,7 @@ sub reset_caches { $add_to_form = { 'code_for_randomlist' => $scancode,}; } } - my $analyze = + my $analyze = &get_analyze($symb,$uname,$udom,undef,$add_to_form, undef,undef,undef,$bubbles_per_row); if (ref($analyze) eq 'HASH') { @@ -342,7 +345,7 @@ sub cleanRecord { if ($response =~ /^(option|rank)$/) { my %answer=&Apache::lonnet::str2hash($answer); my @answer = %answer; - %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); my ($toprow,$bottomrow); foreach my $foil (@$order) { @@ -360,7 +363,7 @@ sub cleanRecord { } elsif ($response eq 'match') { my %answer=&Apache::lonnet::str2hash($answer); my @answer = %answer; - %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); my ($toprow,$middlerow,$bottomrow); @@ -417,8 +420,8 @@ sub cleanRecord { $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. } + $answer = &Apache::lontexconvert::msgtexconverted($answer); return '

'.&keywords_highlight($answer).'
'; - } elsif ( $response eq 'organic') { my $result=&mt('Smile representation: [_1]', '"'.&HTML::Entities::encode($answer, '"<>&').'"'); @@ -502,7 +505,7 @@ COMMONJSFUNCTIONS #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { - my ($getsec,$filterlist,$getgroup) = @_; + my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus) = @_; my @getsec; my @getgroup; my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); @@ -530,6 +533,13 @@ sub getclasslist { # my %sections; my %fullnames; + my ($cdom,$cnum,$partlist); + if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { + $cdom = $env{"course.$env{'request.course.id'}.domain"}; + $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $res_error; + ($partlist,my $handgrade,my $responseType) = &response_type($symb,\$res_error); + } foreach my $student (keys(%$classlist)) { my $end = $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; @@ -546,7 +556,7 @@ sub getclasslist { my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; # filter students according to status selected - if ($filterlist && (!($stu_status =~ /Any/))) { + if ($filterbyaccstatus && (!($stu_status =~ /Any/))) { if (!($stu_status =~ $status)) { delete($classlist->{$student}); next; @@ -563,13 +573,58 @@ sub getclasslist { } } if (($grp eq 'none') && !$group) { - $exclude = 0; + $exclude = 0; } } if ($exclude) { delete($classlist->{$student}); + next; } } + if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { + my $udom = + $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()]; + my $uname = + $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()]; + if (($symb ne '') && ($udom ne '') && ($uname ne '')) { + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + if (!defined($queue_status{'gradingqueue'})) { + delete($classlist->{$student}); + next; + } + } else { + my (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); + my $submitted = 0; + my $graded = 0; + my $incorrect = 0; + foreach (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 1 if ($status{$_} =~ /^ungraded/); + $incorrect = 1 if ($status{$_} =~ /^incorrect/); + + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + } + } + if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')) { + delete($classlist->{$student}); + next; + } elsif (!$graded && ($submitonly eq 'graded')) { + delete($classlist->{$student}); + next; + } elsif (!$incorrect && $submitonly eq 'incorrect') { + delete($classlist->{$student}); + next; + } + } + } + } $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { @@ -584,7 +639,6 @@ sub getclasslist { delete($classlist->{$student}); } } - my %seen = (); my @sections = sort(keys(%sections)); return ($classlist,\@sections,\%fullnames); } @@ -600,7 +654,7 @@ sub canmodify { #can modify the requested section return 1; } else { - # can't modify the request section + # can't modify the requested section return 0; } } @@ -613,19 +667,19 @@ sub canview { my ($sec)=@_; if ($perm{'vgr'}) { if (!defined($perm{'vgr_section'})) { - # can modify whole class + # can view whole class return 1; } else { if ($sec eq $perm{'vgr_section'}) { - #can modify the requested section + #can view the requested section return 1; } else { - # can't modify the request section + # can't view the requested section return 0; } } } - #can't modify + #can't view return 0; } @@ -766,14 +820,14 @@ sub initialverifyreceipt { #--- Check whether a receipt number is valid.--- sub verifyreceipt { - my ($request,$symb) = @_; + my ($request,$symb) = @_; my $courseid = $env{'request.course.id'}; my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $title.= + my $title = '

'. &mt('Verifying Receipt Number [_1]',$receipt). '

'."\n"; @@ -856,13 +910,13 @@ sub verifyreceipt { sub listStudents { my ($request,$symb,$submitonly) = @_; - my ($is_tool) = ($symb =~ /ext\.tool$/); + my $is_tool = ($symb =~ /ext\.tool$/); 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 $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; unless ($submitonly) { - $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + $submitonly = $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; } my $result=''; @@ -1159,8 +1213,8 @@ LISTJAVASCRIPT #---- Called from the listStudents routine sub check_script { - my ($form, $type)=@_; - my $chkallscript= &Apache::lonhtmlcommon::scripttag(' + my ($form,$type) = @_; + my $chkallscript = &Apache::lonhtmlcommon::scripttag(' function checkall() { for (i=0; iprint(&mt('There are currently no submitted documents.')); - return; + $r->print(&mt('There are currently no submitted documents.')); + return; } - my $all_students = join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo')); @@ -1995,7 +2047,55 @@ sub submit_download_link { my ($request,$symb) = @_; if (!$symb) { return ''; } #FIXME: Figure out which type of problem this is and provide appropriate download - &download_all_link($request,$symb); + my $res_error; + my ($partlist,$handgrade,$responseType) = &response_type($symb,$res_error); + if (ref($res_error)) { + if ($$res_error) { + $request->print(&mt('An error occurred retrieving response types')); + return; + } + } + my ($numupload,$numessay) = (0,0); + if (ref($responseType) eq 'HASH') { + foreach my $part (sort(keys(%$responseType))) { + foreach my $id (sort(keys(%{ $responseType->{$part} }))) { + my $responsetype = $responseType->{$part}->{$id}; + if ($responsetype eq 'essay') { + my $uploadedfiletypes = + &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes",$symb); + if ($uploadedfiletypes) { + $numupload++; + } else { + $numessay++; + } + } + } + } + } + if (($numupload) || ($numessay)) { + my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; + (undef,undef,my $fullname) = &getclasslist($getsec,1,$getgroup,$symb,$submitonly,1); + if (ref($fullname) eq 'HASH') { + my @students = map { $_.':'.$fullname->{$_} } (keys(%{$fullname})); + if (@students) { + @{$env{'form.stuinfo'}} = @students; + if ($numupload) { + &download_all_link($request,$symb); + } +# FIXME Need to provide a mechanism to download essays, i.e., if $numessay > 0 +# Needs to omit user's identity if resource instance is for an anonymous survey. + } else { + $request->print(&mt('No students match the criteria you selected')); + } + } else { + $request->print(&mt('Could not retrieve student information')); + } + } else { + $request->print(&mt('No essayresponse items found')); + } + return; } sub build_section_inputs { @@ -2021,7 +2121,8 @@ sub submission { my $probtitle=&Apache::lonnet::gettitle($symb); if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } - my ($is_tool) = ($symb =~ /ext\.tool$/); + my $is_tool = ($symb =~ /ext\.tool$/); + my ($essayurl,%coursedesc_by_cid); if (!&canview($usec)) { $request->print( @@ -2152,11 +2253,24 @@ sub submission { # # Load the other essays for similarity check # - my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); - my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); - $apath=&escape($apath); - $apath=~s/\W/\_/gs; - &init_old_essays($symb,$apath,$adom,$aname); + (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); + if ($essayurl eq 'lib/templates/simpleproblem.problem') { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + if ($cdom ne '' && $cnum ne '') { + my ($map,$id,$res) = &Apache::lonnet::decode_symb($symb); + if ($map =~ m{^\Quploaded/$cdom/$cnum/\E(default(?:|_\d+)\.(?:sequence|page))$}) { + my $apath = $1.'_'.$id; + $apath=~s/\W/\_/gs; + &init_old_essays($symb,$apath,$cdom,$cnum); + } + } + } else { + my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); + $apath=&escape($apath); + $apath=~s/\W/\_/gs; + &init_old_essays($symb,$apath,$adom,$aname); + } } } @@ -2307,24 +2421,52 @@ sub submission { &most_similar($uname,$udom,$symb,$subval); if ($osim) { $osim=int($osim*100.0); - my %old_course_desc = - &Apache::lonnet::coursedescription($ocrsid, - {'one_time' => 1}); - if ($hide eq 'anon') { $similar='
'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'
'. &mt('As the current submission is for an anonymous survey, no other details are available.').'
'; } else { - $similar="

". - &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])', - $osim, - &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')', - $old_course_desc{'description'}, - $old_course_desc{'num'}, - $old_course_desc{'domain'}). - '

'. - &keywords_highlight($oessay). - '
'; + $similar='
'; + if ($essayurl eq 'lib/templates/simpleproblem.problem') { + $similar .= '

'. + &mt('Essay is [_1]% similar to an essay by [_2]', + $osim, + &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')'). + '

'; + } else { + my %old_course_desc; + if ($ocrsid ne '') { + if (ref($coursedesc_by_cid{$ocrsid}) eq 'HASH') { + %old_course_desc = %{$coursedesc_by_cid{$ocrsid}}; + } else { + my $args; + if ($ocrsid ne $env{'request.course.id'}) { + $args = {'one_time' => 1}; + } + %old_course_desc = + &Apache::lonnet::coursedescription($ocrsid,$args); + $coursedesc_by_cid{$ocrsid} = \%old_course_desc; + } + $similar .= + '

'. + &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])', + $osim, + &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')', + $old_course_desc{'description'}, + $old_course_desc{'num'}, + $old_course_desc{'domain'}). + '

'; + } else { + $similar .= + '

'. + &mt('Essay is [_1]% similar to an essay by [_2] in an unknown course', + $osim, + &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')'). + '

'; + } + } + $similar .= '
'. + &keywords_highlight($oessay). + '
'; } } } @@ -2635,7 +2777,7 @@ sub get_last_submission { if (!@string) { my $msg; if ($is_tool) { - $msg = &mt('Nothing passed back - no attempts.'); + $msg = &mt('No grade passed back.'); } else { $msg = &mt('Nothing submitted - no attempts.'); } @@ -4056,7 +4198,7 @@ sub editgrades { my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); my $title='

'.&mt('Current Grade Status').'

'; - $title.='

'.&mt('Section: [_1]',$section_display).'

'."\n"; + $title.='

'.&mt('Section:').' '.$section_display.'

'."\n"; my $result= &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). @@ -4090,6 +4232,7 @@ sub editgrades { $ctr++; } my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + my $totcolspan = 0; foreach my $partid (@partid) { $header .= ''.&mt('Old Score').''. ''.&mt('New Score').''; @@ -4106,6 +4249,7 @@ sub editgrades { ''.&mt('New').' '.$display.''; $columns{$partid}+=2; } + $totcolspan += $columns{$partid}; } foreach my $partid (@partid) { my $display_part=&get_display_part($partid,$symb); @@ -4121,18 +4265,18 @@ sub editgrades { my @noupdate; my ($updateCtr,$noupdateCtr) = (1,1); for ($i=0; $i<$env{'form.total'}; $i++) { - my $line; my $user = $env{'form.ctr'.$i}; my ($uname,$udom)=split(/:/,$user); my %newrecord; my $updateflag = 0; - $line .= ''.&nameUserString(undef,$$fullname{$user},$uname,$udom).''; my $usec=$classlist->{"$uname:$udom"}[5]; - if (!&canmodify($usec)) { - my $numcols=scalar(@partid)*4+2; + my $canmodify = &canmodify($usec); + my $line = ''. + &nameUserString(undef,$$fullname{$user},$uname,$udom).''; + if (!$canmodify) { push(@noupdate, - $line."". - &mt('Not allowed to modify student').""); + $line."". + &mt('Not allowed to modify student').""); next; } my %aggregate = (); @@ -4249,8 +4393,7 @@ sub editgrades { } } if (@noupdate) { -# my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; - my $numcols=scalar(@partid)*4+2; + my $numcols=$totcolspan+2; $result .= &Apache::loncommon::start_data_table_row('LC_empty_row'). ''. &mt('No Changes Occurred For the Students Below'). @@ -4498,7 +4641,7 @@ ENDUPFORM sub csvuploadmap { - my ($request,$symb)= @_; + my ($request,$symb) = @_; if (!$symb) {return '';} my $datatoken; @@ -4594,7 +4737,7 @@ sub get_fields { } sub csvuploadassign { - my ($request,$symb)= @_; + my ($request,$symb) = @_; if (!$symb) {return '';} my $error_msg = ''; my $datatoken = &Apache::loncommon::valid_datatoken($env{'form.datatoken'}); @@ -4710,7 +4853,7 @@ sub csvuploadassign { $grades{$store_key}=$entries{$fields{$dest}}; } } - if (! %grades) { + if (! %grades) { push(@skipped,&mt("[_1]: no data to save","$username:$domain")); } else { $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; @@ -4781,6 +4924,7 @@ LISTJAVASCRIPT 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 $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; my $result='

 '. &mt('Manual Grading by Page or Sequence').'

'; @@ -4870,7 +5014,7 @@ LISTJAVASCRIPT ''.&nameUserString('header').''. &Apache::loncommon::end_data_table_header_row(); - my (undef,undef,$fullname) = &getclasslist($getsec,'1'); + my (undef,undef,$fullname) = &getclasslist($getsec,'1',$getgroup); my $ptr = 1; foreach my $student (sort { @@ -5021,7 +5165,7 @@ sub displayPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - my ($is_tool) = ($symbx =~ /ext\.tool$/); + my $is_tool = ($symbx =~ /ext\.tool$/); $studentTable.= &Apache::loncommon::start_data_table_row(). ''.$prob. @@ -5032,7 +5176,9 @@ sub displayPage { ''; $studentTable.=''; my %form = ('CODE' => $env{'form.CODE'},); - unless ($is_tool) { + if ($is_tool) { + $studentTable.=' '.$title.'
'; + } else { if ($env{'form.vProb'} eq 'yes' ) { $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, undef,'both',\%form); @@ -5110,13 +5256,14 @@ sub displaySubByDates { my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; my $isCODE=0; my $isTask = ($symb =~/\.task$/); + my $is_tool = ($symb =~/\.tool$/); if (exists($record->{'resource.CODE'})) { $isCODE=1; } my $studentTable=&Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). ''.&mt('Date/Time').''. ($isCODE?''.&mt('CODE').'':''). ($isTask?''.&mt('Version').'':''). - ''.&mt('Submission').''. + ''.($is_tool?&mt('Grade'):&mt('Submission')).''. ''.&mt('Status').''. &Apache::loncommon::end_data_table_header_row(); my ($version); @@ -5124,7 +5271,11 @@ sub displaySubByDates { my %orders; $mark{'correct_by_student'} = $checkIcon; if (!exists($$record{'1:timestamp'})) { - return '
 '.&mt('Nothing submitted - no attempts.').'
'; + if ($is_tool) { + return '
 '.&mt('No grade passed back.').'
'; + } else { + return '
 '.&mt('Nothing submitted - no attempts.').'
'; + } } my $interaction; @@ -5157,56 +5308,64 @@ sub displaySubByDates { if (($type eq 'anonsurvey') || ($type eq 'anonsurveycred')) { $hidden = 1; } - my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys) - : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); - + my @matchKey; + if ($isTask) { + @matchKey = sort(grep(/^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)); + } elsif ($is_tool) { + @matchKey = sort(grep(/^resource\.\Q$partid\E\.awarded$/,@versionKeys)); + } else { + @matchKey = 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$/)); - $displaySub[0].=''; - $displaySub[0].=''.&mt('Part: [_1]',$display_part).'' - .' ' - .'('.&mt('Response ID: [_1]',$responseId).')' - .'' - .' '; - if ($hidden) { - $displaySub[0].= &mt('Anonymous Survey').''; + if ($is_tool) { + $displaySub[0].=$$record{"$version:resource.$partid.awarded"}; } else { - my ($trial,$rndseed,$newvariation); - if ($type eq 'randomizetry') { - $trial = $$record{"$where.$partid.tries"}; - $rndseed = $$record{"$where.$partid.rndseed"}; - } - if ($$record{"$where.$partid.tries"} eq '') { - $displaySub[0].=&mt('Trial not counted'); - } else { - $displaySub[0].=&mt('Trial: [_1]', - $$record{"$where.$partid.tries"}); - if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) { - if (($rndseed ne $lastrndseed{$partid}) && - (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) { - $newvariation = ' ('.&mt('New variation this try').')'; - } + my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) + : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); + $displaySub[0].=''; + $displaySub[0].=''.&mt('Part: [_1]',$display_part).'' + .' ' + .'('.&mt('Response ID: [_1]',$responseId).')' + .'' + .' '; + if ($hidden) { + $displaySub[0].= &mt('Anonymous Survey').''; + } else { + my ($trial,$rndseed,$newvariation); + if ($type eq 'randomizetry') { + $trial = $$record{"$where.$partid.tries"}; + $rndseed = $$record{"$where.$partid.rndseed"}; } - $lastrndseed{$partid} = $rndseed; - $lasttype{$partid} = $type; - } - my $responseType=($isTask ? 'Task' + if ($$record{"$where.$partid.tries"} eq '') { + $displaySub[0].=&mt('Trial not counted'); + } else { + $displaySub[0].=&mt('Trial: [_1]', + $$record{"$where.$partid.tries"}); + if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) { + if (($rndseed ne $lastrndseed{$partid}) && + (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) { + $newvariation = ' ('.&mt('New variation this try').')'; + } + } + $lastrndseed{$partid} = $rndseed; + $lasttype{$partid} = $type; + } + my $responseType=($isTask ? 'Task' : $responseType->{$partid}->{$responseId}); - if (!exists($orders{$partid})) { $orders{$partid}={}; } - if ((!exists($orders{$partid}->{$responseId})) || ($trial)) { - $orders{$partid}->{$responseId}= - &get_order($partid,$responseId,$symb,$uname,$udom, - $no_increment,$type,$trial,$rndseed); - } - $displaySub[0].=''.$newvariation.''; # /nobreak - $displaySub[0].='  '. - &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'
'; + if (!exists($orders{$partid})) { $orders{$partid}={}; } + if ((!exists($orders{$partid}->{$responseId})) || ($trial)) { + $orders{$partid}->{$responseId}= + &get_order($partid,$responseId,$symb,$uname,$udom, + $no_increment,$type,$trial,$rndseed); + } + $displaySub[0].=''.$newvariation.''; # /nobreak + $displaySub[0].='  '. + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'
'; + } } } } @@ -5221,14 +5380,22 @@ sub displaySubByDates { lc($$record{"$where.$partid.award"}).' '. $mark{$$record{"$where.$partid.solved"}}. '
'; + } elsif (($is_tool) && (exists($$record{"$version:resource.$partid.solved"}))) { + if ($$record{"$version:resource.$partid.solved"} =~ /^(in|)correct_by_passback$/) { + $displaySub[1].=&mt('Grade passed back by external tool'); + } } if (exists $$record{"$where.$partid.regrader"}) { - $displaySub[2].=$$record{"$where.$partid.regrader"}. - ' ('.&mt('Part').': '.$display_part.')'; + $displaySub[2].=$$record{"$where.$partid.regrader"}; + unless ($is_tool) { + $displaySub[2].=' ('.&mt('Part').': '.$display_part.')'; + } } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { $displaySub[2].= - $$record{"$version:resource.$partid.regrader"}. - ' ('.&mt('Part').': '.$display_part.')'; + $$record{"$version:resource.$partid.regrader"}; + unless ($is_tool) { + $displaySub[2].=' ('.&mt('Part').': '.$display_part.')'; + } } } # needed because old essay regrader has not parts info @@ -5487,7 +5654,7 @@ the homework problem. sub defaultFormData { my ($symb)=@_; - return ''; + return ''; } @@ -5640,7 +5807,7 @@ sub scantron_uploads { sub scantron_scantab { my $result=' + - '.&mt('File to upload: [_1]','').' -
- - -'); + '.&Apache::loncommon::start_data_table('LC_scantron_action').' + '.&Apache::loncommon::start_data_table_header_row().' + +  '.&mt('Specify a bubblesheet data file to upload.').' + + '.&Apache::loncommon::end_data_table_header_row().' + '.&Apache::loncommon::start_data_table_row().' + + '.&mt('File to upload: [_1]','').'
'."\n"); + if ($formatoptions) { + $r->print(' + '.&Apache::loncommon::end_data_table_row().' + '.&Apache::loncommon::start_data_table_row().' + '.$formattitle.(' 'x2).$formatoptions.' + + '.&Apache::loncommon::end_data_table_row().' + '.&Apache::loncommon::start_data_table_row().' + ' + ); + } else { + $r->print('
'); + } + $r->print(' + + '.&Apache::loncommon::end_data_table_row().' + '.&Apache::loncommon::end_data_table().' + ' + ); - $r->print(' - - '.&Apache::loncommon::end_data_table_row().' - '.&Apache::loncommon::end_data_table().' -'); } # Chunk of form to prompt for a file to grade and how: @@ -5881,8 +6002,6 @@ sub scantron_selectphase { $r->print($result); - - # Chunk of the form that prompts to view a scoring office file, # corrected file, skipped records in a file. @@ -5944,98 +6063,6 @@ sub scantron_selectphase { return; } -=pod - -=item get_scantron_config - - Parse and return the bubblesheet configuration line selected as a - hash of configuration file fields. - - Arguments: - which - the name of the configuration to parse from the file. - - - Returns: - If the named configuration is not in the file, an empty - hash is returned. - a hash with the fields - name - internal name for the this configuration setup - description - text to display to operator that describes this config - CODElocation - if 0 or the string 'none' - - no CODE exists for this config - if -1 || the string 'letter' - - a CODE exists for this config and is - a string of letters - Unsupported value (but planned for future support) - if a positive integer - - The CODE exists as the first n items from - the question section of the form - if the string 'number' - - The CODE exists for this config and is - a string of numbers - CODEstart - (only matter if a CODE exists) column in the line where - the CODE starts - CODElength - length of the CODE - IDstart - column where the student/employee ID starts - IDlength - length of the student/employee ID info - Qstart - column where the information from the bubbled - 'questions' start - Qlength - number of columns comprising a single bubble line from - the sheet. (usually either 1 or 10) - Qon - either a single character representing the character used - to signal a bubble was chosen in the positional setup, or - the string 'letter' if the letter of the chosen bubble is - in the final, or 'number' if a number representing the - chosen bubble is in the file (1->A 0->J) - Qoff - the character used to represent that a bubble was - left blank - PaperID - if the scanning process generates a unique number for each - sheet scanned the column that this ID number starts in - PaperIDlength - number of columns that comprise the unique ID number - for the sheet of paper - FirstName - column that the first name starts in - FirstNameLength - number of columns that the first name spans - - LastName - column that the last name starts in - LastNameLength - number of columns that the last name spans - BubblesPerRow - number of bubbles available in each row used to - bubble an answer. (If not specified, 10 assumed). - -=cut - -sub get_scantron_config { - my ($which) = @_; - my @lines = &get_scantronformat_file(); - my %config; - #FIXME probably should move to XML it has already gotten a bit much now - foreach my $line (@lines) { - my ($name,$descrip)=split(/:/,$line); - if ($name ne $which ) { next; } - chomp($line); - my @config=split(/:/,$line); - $config{'name'}=$config[0]; - $config{'description'}=$config[1]; - $config{'CODElocation'}=$config[2]; - $config{'CODEstart'}=$config[3]; - $config{'CODElength'}=$config[4]; - $config{'IDstart'}=$config[5]; - $config{'IDlength'}=$config[6]; - $config{'Qstart'}=$config[7]; - $config{'Qlength'}=$config[8]; - $config{'Qoff'}=$config[9]; - $config{'Qon'}=$config[10]; - $config{'PaperID'}=$config[11]; - $config{'PaperIDlength'}=$config[12]; - $config{'FirstName'}=$config[13]; - $config{'FirstNamelength'}=$config[14]; - $config{'LastName'}=$config[15]; - $config{'LastNamelength'}=$config[16]; - $config{'BubblesPerRow'}=$config[17]; - last; - } - return %config; -} - =pod =item username_to_idmap @@ -6083,7 +6110,7 @@ sub username_to_idmap { Process a requested correction to a scanline. Arguments: - $scantron_config - hash from &get_scantron_config() + $scantron_config - hash from &Apache::lonnet::get_scantron_config() $scan_data - hash of correction information (see &scantron_getfile()) $line - existing scanline @@ -6766,7 +6793,7 @@ sub scantron_filter { sub scantron_process_corrections { my ($r) = @_; - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::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'}; @@ -6935,7 +6962,7 @@ sub check_for_error { sub scantron_warning_screen { my ($button_text,$symb)=@_; my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $CODElist; if ($scantron_config{'CODElocation'} && $scantron_config{'CODEstart'} && @@ -6952,7 +6979,7 @@ sub scantron_warning_screen { ''.&mt('Hand-graded items: points from last bubble in row').''. $env{'form.scantron_lastbubblepoints'}.''; } - return (' + return '

'.&mt("Please double check the information below before clicking on '[_1]'",&mt($button_text)).' @@ -6964,9 +6991,7 @@ sub scantron_warning_screen {

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

- -
-'); +'; } =pod @@ -6992,15 +7017,58 @@ sub scantron_do_warning { } if ( $env{'form.scantron_selectfile'} eq '') { $r->print('

'.&mt("You have not selected a file that contains the student's response data.").'

'); - } + } if ( $env{'form.scantron_format'} eq '') { $r->print('

'.&mt("You have not selected the format of the student's response data.").'

'); - } + } } else { my $warning=&scantron_warning_screen('Grading: Validate Records',$symb); + my ($checksec,@possibles) = &gradable_sections(); + my $gradesections; + if ($checksec) { + my $file=$env{'form.scantron_selectfile'}; + if (&valid_file($file)) { + my %bysec = &scantron_get_sections(); + my $table; + if ((keys(%bysec) > 1) || ((keys(%bysec) == 1) && ((keys(%bysec))[0] ne $checksec))) { + $gradesections = &mt('Your current role is for section [_1].',''.$checksec.'').'
'; + $table = &Apache::loncommon::start_data_table()."\n". + &Apache::loncommon::start_data_table_header_row(). + ''.&mt('Section').''.&mt('Number of records').''. + &Apache::loncommon::end_data_table_header_row()."\n"; + if ($bysec{'none'}) { + $table .= &Apache::loncommon::start_data_table_row(). + ''.&mt('None').''.$bysec{'none'}.''. + &Apache::loncommon::end_data_table_row()."\n"; + } + foreach my $sec (sort { $a <=> $b } keys(%bysec)) { + next if ($sec eq 'none'); + $table .= &Apache::loncommon::start_data_table_row(). + ''.$sec.''.$bysec{$sec}.''. + &Apache::loncommon::end_data_table_row()."\n"; + } + $table .= &Apache::loncommon::end_data_table()."\n"; + $gradesections .= &mt('Sections represented in the bubblesheet data file (based on bubbled student IDs) are as follows:'). + '

'.$table.'

'; + if (@possibles) { + $gradesections .= '

'. + &mt('You have role(s) in [quant,_1,other section,other sections] with privileges to manage grades.', + scalar(@possibles)).'
'. + &mt('Check which of those section(s), in addition to section [_1], you wish to grade using this bubblesheet file:', + ''.$checksec.'').' '; + foreach my $sec (sort {$a <=> $b } @possibles) { + $gradesections .= ''.(' 'x2); + } + $gradesections .= '

'; + } + } + } else { + $gradesections = '

'.&mt('The selected file is unavailable').'

'; + } + } my $bubbledbyhand=&hand_bubble_option(); $r->print(' -'.$warning.$bubbledbyhand.' +'.$warning.$gradesections.$bubbledbyhand.' '); @@ -7087,11 +7155,42 @@ sub scantron_validate_file { if ($env{'form.scantron_corrections'}) { &scantron_process_corrections($r); } - $r->print('

'.&mt('Gathering necessary information.').'

');$r->rflush(); + + $r->print('

'.&mt('Gathering necessary information.').'

'); + my ($checksec,@gradable); + if ($env{'request.course.sec'}) { + ($checksec,my @possibles) = &gradable_sections(); + if ($checksec) { + if (@possibles) { + my @chosensecs = &Apache::loncommon::get_env_multiple('form.scantron_othersections'); + if (@chosensecs) { + foreach my $sec (@chosensecs) { + if (grep(/^\Q$sec\E$/,@possibles)) { + unless (grep(/^\Q$sec\E$/,@gradable)) { + push(@gradable,$sec); + } + } + } + } + } + $r->print('

'); + if (@gradable) { + my @showsections = sort { $a <=> $b } (@gradable,$checksec); + $r->print( + ''); + } else { + $r->print( + ''); + } + $r->print('
'.&mt('Sections to be Graded:').''.join(', ',@showsections).'
'.&mt('Section to be Graded:').''.$checksec.'

'); + } + } + $r->rflush(); + #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); my $nav_error; - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); if ($nav_error) { $r->print(&navmap_errormsg()); @@ -7112,7 +7211,7 @@ sub scantron_validate_file { $env{'form.validatepass'} = 0; } my $currentphase=$env{'form.validatepass'}; - + my %skipbysec=(); my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { @@ -7122,13 +7221,29 @@ sub scantron_validate_file { my $which="scantron_validate_".$validate_phases[$currentphase]; { no strict 'refs'; - ($stop,$currentphase)=&$which($r,$currentphase); + my @extras=(); + if ($validate_phases[$currentphase] eq 'ID') { + @extras = (\%skipbysec,$checksec,@gradable); + } + ($stop,$currentphase)=&$which($r,$currentphase,@extras); } } if (!$stop) { my $warning=&scantron_warning_screen('Start Grading',$symb); + my $secinfo; + if (keys(%skipbysec) > 0) { + my $seclist = ''; + $secinfo = '

'. + &mt('Numbers of records for students in sections not being graded [_1]', + $seclist). + '

'; + } $r->print(&mt('Validation process complete.').'
'. - $warning. + $secinfo.$warning. &mt('Perform verification for each student after storage of submissions?'). ' '. @@ -7544,14 +7659,15 @@ sub scantron_validate_sequence { sub scantron_validate_ID { - my ($r,$currentphase) = @_; + my ($r,$currentphase,$skipbysec,$checksec,@gradable) = @_; #get student info my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); + my $secidx = &Apache::loncoursedata::CL_SECTION(); #get scantron line setup - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my $nav_error; @@ -7562,6 +7678,7 @@ sub scantron_validate_ID { } my %found=('ids'=>{},'usernames'=>{}); + my $unsavedskips = 0; for (my $i=0;$i<=$scanlines->{'count'};$i++) { my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } @@ -7574,13 +7691,41 @@ sub scantron_validate_ID { } if ($found) { my $username=$idmap{$found}; + if ($checksec) { + if (ref($classlist->{$username}) eq 'ARRAY') { + my $stusec = $classlist->{$username}->[$secidx]; + if ($stusec ne $checksec) { + unless ((@gradable > 0) && (grep(/^\Q$stusec\E$/,@gradable))) { + my $skip=1; + &scantron_put_line($scanlines,$scan_data,$i,$line,$skip); + if (ref($skipbysec) eq 'HASH') { + if ($stusec eq '') { + $skipbysec->{'none'} ++; + } else { + $skipbysec->{$stusec} ++; + } + } + $unsavedskips ++; + next; + } + } + } + } if ($found{'ids'}{$found}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$found); + if ($unsavedskips) { + &scantron_putfile($scanlines,$scan_data); + $unsavedskips = 0; + } return(1,$currentphase); } elsif ($found{'usernames'}{$username}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$username); + if ($unsavedskips) { + &scantron_putfile($scanlines,$scan_data); + $unsavedskips = 0; + } return(1,$currentphase); } #FIXME store away line we previously saw the ID on to use above @@ -7589,29 +7734,95 @@ sub scantron_validate_ID { } else { if ($id =~ /^\s*$/) { my $username=&scan_data($scan_data,"$i.user"); - if (defined($username) && $found{'usernames'}{$username}) { + if (($checksec && $username ne '')) { + if (ref($classlist->{$username}) eq 'ARRAY') { + my $stusec = $classlist->{$username}->[$secidx]; + if ($stusec ne $checksec) { + unless ((@gradable > 0) && (grep(/^\Q$stusec\E$/,@gradable))) { + my $skip=1; + &scantron_put_line($scanlines,$scan_data,$i,$line,$skip); + if (ref($skipbysec) eq 'HASH') { + if ($stusec eq '') { + $skipbysec->{'none'} ++; + } else { + $skipbysec->{$stusec} ++; + } + } + $unsavedskips ++; + next; + } + } + } + } elsif (defined($username) && $found{'usernames'}{$username}) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'duplicateID',$username); + if ($unsavedskips) { + &scantron_putfile($scanlines,$scan_data); + $unsavedskips = 0; + } return(1,$currentphase); } elsif (!defined($username)) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'incorrectID'); + if ($unsavedskips) { + &scantron_putfile($scanlines,$scan_data); + $unsavedskips = 0; + } return(1,$currentphase); } $found{'usernames'}{$username}++; } else { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'incorrectID'); + if ($unsavedskips) { + &scantron_putfile($scanlines,$scan_data); + $unsavedskips = 0; + } return(1,$currentphase); } } } - + if ($unsavedskips) { + &scantron_putfile($scanlines,$scan_data); + $unsavedskips = 0; + } return (0,$currentphase+1); } +sub scantron_get_sections { + my %bysec; + if ($env{'form.scantron_format'} ne '') { + my %scantron_config=&Apache::lonnet::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); + foreach my $key (keys(%idmap)) { + my $lckey = lc($key); + $idmap{$lckey} = $idmap{$key}; + } + my $secidx = &Apache::loncoursedata::CL_SECTION(); + 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=lc($$scan_record{'scantron.ID'}); + if (exists($idmap{$id})) { + if (ref($classlist->{$idmap{$id}}) eq 'ARRAY') { + my $stusec = $classlist->{$idmap{$id}}->[$secidx]; + if ($stusec eq '') { + $bysec{'none'} ++; + } else { + $bysec{$stusec} ++; + } + } + } + } + } + return %bysec; +} sub scantron_get_correction { my ($r,$i,$scan_record,$scan_config,$line,$error,$arg, @@ -7798,7 +8009,7 @@ sub verify_bubbles_checked { my $ansnumstr = join('","',@ansnums); my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines."); &js_escape(\$warning); - my $output = &Apache::lonhtmlcommon::scripttag((<new(); @@ -8441,7 +8652,7 @@ sub scantron_validate_missingbubbles { &Apache::lonnet::decode_symb($env{'form.selectpage'}); #get scantron line setup - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my $navmap = Apache::lonnavmaps::navmap->new(); @@ -8570,7 +8781,7 @@ sub hand_bubble_option { } } if ($needs_hand_bubbles) { - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); return &mt('The sequence to be graded contains response types which are handgraded.').'

'. &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?','
'). @@ -8589,7 +8800,7 @@ sub scantron_process_students { } my $default_form_data=&defaultFormData($symb); - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); @@ -8629,9 +8840,10 @@ sub scantron_process_students { SCANTRONFORM $r->print($result); + my ($checksec,@possibles)=&gradable_sections(); my @delayqueue; my (%completedstudents,%scandata); - + my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam')); my $count=&get_todo_count($scanlines,$scan_data); my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); @@ -8657,7 +8869,7 @@ SCANTRONFORM return ''; # Dunno why the other returns return '' rather than just returning. } - my %lettdig = &letter_to_digits(); + my %lettdig = &Apache::lonnet::letter_to_digits(); my $numletts = scalar(keys(%lettdig)); my %orderedforcode; @@ -8691,6 +8903,13 @@ SCANTRONFORM next; } my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; + if (($checksec ne '') && ($checksec ne $usec)) { + unless (grep(/^\Q$usec\E$/,@possibles)) { + &scantron_add_delay(\@delayqueue,$line, + "No role with manage grades privilege in student's section ($usec)",3); + next; + } + } my $user = $uname.':'.$usec; ($uname,$udom)=split(/:/,$uname); @@ -8982,8 +9201,9 @@ sub grade_student_bubbles { } sub scantron_upload_scantron_data { - my ($r,$symb)=@_; + my ($r,$symb) = @_; my $dom = $env{'request.role.domain'}; + my ($formatoptions,$formattitle,$formatjs) = &scantron_upload_dataformat($dom); my $domdesc = &Apache::lonnet::domain($dom,'description'); $r->print(&Apache::loncommon::coursebrowser_javascript($dom)); my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', @@ -9023,6 +9243,7 @@ sub scantron_upload_scantron_data { return; } + '.$formatjs.' ')); $r->print('

'.&mt('Send bubblesheet data to a course').'

@@ -9038,7 +9259,12 @@ sub scantron_upload_scantron_data { &Apache::lonhtmlcommon::row_closure(). &Apache::lonhtmlcommon::row_title(&mt('Domain')). ''.$domdesc. - &Apache::lonhtmlcommon::row_closure(). + &Apache::lonhtmlcommon::row_closure()); + if ($formatoptions) { + $r->print(&Apache::lonhtmlcommon::row_title($formattitle).$formatoptions. + &Apache::lonhtmlcommon::row_closure()); + } + $r->print( &Apache::lonhtmlcommon::row_title(&mt('File to upload')). ''. &Apache::lonhtmlcommon::row_closure(1). @@ -9051,9 +9277,87 @@ sub scantron_upload_scantron_data { return ''; } +sub scantron_upload_dataformat { + my ($dom) = @_; + my ($formatoptions,$formattitle,$formatjs); + $formatjs = <<'END'; +function toggleScantab(form) { + return; +} +END + my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$dom); + if (ref($domconfig{'scantron'}) eq 'HASH') { + if (ref($domconfig{'scantron'}{'config'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}}) > 1) { + if (($domconfig{'scantron'}{'config'}{'dat'}) && + (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH')) { + if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}})) { + my ($onclick,$formatextra,$singleline); + my @lines = &Apache::lonnet::get_scantronformat_file(); + my $count = 0; + foreach my $line (@lines) { + next if ($line =~ /^#/); + $singleline = $line; + $count ++; + } + if ($count > 1) { + $formatextra = ''; + $onclick = ' onclick="toggleScantab(this.form);"'; + $formatjs = <<"END"; +function toggleScantab(form) { + var divid = 'bubbletype'; + if (document.getElementById(divid)) { + var radioname = 'fileformat'; + var num = form.elements[radioname].length; + if (num) { + for (var i=0; i'; + } + $formattitle = &mt('File format'); + $formatoptions = ''.(' 'x2). + ''.$formatextra; + } + } + } + } elsif (keys(%{$domconfig{'scantron'}{'config'}}) == 1) { + if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}})) { + $formattitle = &mt('Bubblesheet type'); + $formatoptions = &scantron_scantab(); + } + } + } + } + } + return ($formatoptions,$formattitle,$formatjs); +} sub scantron_upload_scantron_data_save { - my($r,$symb)=@_; + my ($r,$symb) = @_; my $doanotherupload= '
'."\n". ''."\n". @@ -9061,7 +9365,9 @@ sub scantron_upload_scantron_data_save { '
'."\n"; if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && !&Apache::lonnet::allowed('usc', - $env{'form.domainid'}.'_'.$env{'form.courseid'})) { + $env{'form.domainid'}.'_'.$env{'form.courseid'}) && + !&Apache::lonnet::allowed('usc', + $env{'form.domainid'}.'_'.$env{'form.courseid'}.'/'.$env{'form.coursesec'})) { $r->print(&mt("You are not allowed to upload bubblesheet data to the requested course.")."
"); unless ($symb) { $r->print($doanotherupload); @@ -9077,8 +9383,38 @@ sub scantron_upload_scantron_data_save { &mt('The file: [_1] you attempted to upload contained no information. Please check that you entered the correct filename.', ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''),1)); } else { - my $result = - &Apache::lonnet::userfileupload('upfile','','scantron','','','', + my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$env{'form.domainid'}); + my $parser; + if (ref($domconfig{'scantron'}) eq 'HASH') { + if (ref($domconfig{'scantron'}{'config'}) eq 'HASH') { + my $is_csv; + my @possibles = keys(%{$domconfig{'scantron'}{'config'}}); + if (@possibles > 1) { + if ($env{'form.fileformat'} eq 'csv') { + if (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH') { + if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}}) > 1) { + $is_csv = 1; + } + } + } + } + } elsif (@possibles == 1) { + if (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH') { + if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}}) > 1) { + $is_csv = 1; + } + } + } + } + if ($is_csv) { + $parser = $domconfig{'scantron'}{'config'}{'csv'}; + } + } + } + my $result = + &Apache::lonnet::userfileupload('upfile','scantron','scantron',$parser,'','', $env{'form.courseid'},$env{'form.domainid'}); if ($result =~ m{^/uploaded/}) { $r->print( @@ -9087,8 +9423,17 @@ sub scantron_upload_scantron_data_save { (length($env{'form.upfile'})-1), ''.$result.'')); ($uploadedfile) = ($result =~ m{/([^/]+)$}); + if ($uploadedfile =~ /^scantron_orig_/) { + my $logname = $uploadedfile; + $logname =~ s/^scantron_orig_//; + if ($logname ne '') { + my $now = time; + my %info = ($logname => { $now => $env{'user.name'}.':'.$env{'user.domain'} }); + &Apache::lonnet::put('scantronupload',\%info,$env{'form.domainid'},$env{'form.courseid'}); + } + } $r->print(&validate_uploaded_scantron_file($env{'form.domainid'}, - $env{'form.courseid'},$uploadedfile)); + $env{'form.courseid'},$symb,$uploadedfile)); } else { $r->print( &Apache::lonhtmlcommon::confirm_success(&mt('Upload failed'),1).'
'. @@ -9106,13 +9451,34 @@ sub scantron_upload_scantron_data_save { } sub validate_uploaded_scantron_file { - my ($cdom,$cname,$fname) = @_; + my ($cdom,$cname,$symb,$fname,$context,$countsref) = @_; + my $scanlines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.$fname); my @lines; if ($scanlines ne '-1') { @lines=split("\n",$scanlines,-1); } - my $output; + my ($output,$secidx,$checksec,$priv,%crsroleshash,@possibles); + $secidx = &Apache::loncoursedata::CL_SECTION(); + if ($context eq 'download') { + $priv = 'mgr'; + } else { + $priv = 'usc'; + } + unless ((&Apache::lonnet::allowed($priv,$env{'request.role.domain'})) || + (($env{'request.course.id'}) && + (&Apache::lonnet::allowed($priv,$env{'request.course.id'})))) { + if ($env{'request.course.sec'} ne '') { + unless (&Apache::lonnet::allowed($priv, + "$env{'request.course.id'}/$env{'request.course.sec'}")) { + unless ($context eq 'download') { + $output = '

'.&mt('You do not have permission to upload bubblesheet data').'

'; + } + return $output; + } + ($checksec,@possibles)=&gradable_sections(); + } + } if (@lines) { my (%counts,$max_match_format); my ($found_match_count,$max_match_count,$max_match_pct) = (0,0,0); @@ -9123,7 +9489,7 @@ sub validate_uploaded_scantron_file { $idmap{$lckey} = $idmap{$key}; } my %unique_formats; - my @formatlines = &get_scantronformat_file(); + my @formatlines = &Apache::lonnet::get_scantronformat_file(); foreach my $line (@formatlines) { chomp($line); my @config = split(/:/,$line); @@ -9142,6 +9508,8 @@ sub validate_uploaded_scantron_file { %{$counts{$key}} = ( 'found' => 0, 'total' => 0, + 'totalanysec' => 0, + 'othersec' => 0, ); foreach my $line (@lines) { next if ($line =~ /^#/); @@ -9149,6 +9517,23 @@ sub validate_uploaded_scantron_file { my $id = substr($line,$idstart-1,$idlength); $id = lc($id); if (exists($idmap{$id})) { + if ($checksec ne '') { + $counts{$key}{'totalanysec'} ++; + if (ref($classlist->{$idmap{$id}}) eq 'ARRAY') { + my $stusec = $classlist->{$idmap{$id}}->[$secidx]; + if ($stusec ne $checksec) { + if (@possibles) { + unless (grep(/^\Q$stusec\E$/,@possibles)) { + $counts{$key}{'othersec'} ++; + next; + } + } else { + $counts{$key}{'othersec'} ++; + next; + } + } + } + } $counts{$key}{'found'} ++; } $counts{$key}{'total'} ++; @@ -9163,7 +9548,7 @@ sub validate_uploaded_scantron_file { } } } - if (ref($unique_formats{$max_match_format}) eq 'ARRAY') { + if ((ref($unique_formats{$max_match_format}) eq 'ARRAY') && ($context ne 'download')) { my $format_descs; my $numwithformat = @{$unique_formats{$max_match_format}}; for (my $i=0; $i<$numwithformat; $i++) { @@ -9208,13 +9593,179 @@ sub validate_uploaded_scantron_file { '
  • '.&mt('The course roster is not up to date.').'
    • '. ''; } + if (($checksec ne '') && (ref($counts{$max_match_format}) eq 'HASH')) { + if ($counts{$max_match_format}{'othersec'}) { + my $percent_nongrade = (100*$counts{$max_match_format}{'othersec'})/($counts{$max_match_format}{'totalanysec'}); + my $showpct = sprintf("%.0f",$percent_nongrade).'%'; + my $confirmdel = &mt('Are you sure you want to permanently delete this file?'); + &js_escape(\$confirmdel); + $output .= '

    '. + &mt('Comparison of student IDs in the uploaded file with the course roster found [_1][quant,_2,match,matches][_3] for students in section(s) for which none of your role(s) have privileges to modify grades', + '',$counts{$max_match_format}{'othersec'},''). + '
    '. + &mt('Unless you are assigned role(s) which allow modification of grades in additional sections, [_1] of the records in this file will be automatically excluded when you perform bubblesheet grading.',''.$showpct.''). + '

    '. + &mt('If you prefer to delete the file now, use: [_1]'). + '

    '. + ''. + ''. + ''. + ''. + ''. + ''. + ''. + '

    '; + } + } } - } else { + if (($context eq 'download') && ($checksec ne '')) { + if ((ref($countsref) eq 'HASH') && (ref($counts{$max_match_format}) eq 'HASH')) { + $countsref->{'totalanysec'} = $counts{$max_match_format}{'totalanysec'}; + $countsref->{'othersec'} = $counts{$max_match_format}{'othersec'}; + } + } + } elsif ($context ne 'download') { $output = '

    '.&mt('Uploaded file contained no data').'

    '; } return $output; } +sub gradable_sections { + my $checksec = $env{'request.course.sec'}; + my @oksecs; + if ($checksec) { + my %availablesecs = §ions_grade_privs(); + if (ref($availablesecs{'mgr'}) eq 'ARRAY') { + foreach my $sec (@{$availablesecs{'mgr'}}) { + unless (grep(/^\Q$sec\E$/,@oksecs)) { + push(@oksecs,$sec); + } + } + if (grep(/^all$/,@oksecs)) { + undef($checksec); + } + } + } + return($checksec,@oksecs); +} + +sub sections_grade_privs { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my %availablesecs = ( + mgr => [], + vgr => [], + usc => [], + ); + my $ccrole = 'cc'; + if ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Community') { + $ccrole = 'co'; + } + my %crsroleshash = &Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'}, + 'userroles',['active'], + [$ccrole,'in','cr'],$cdom,1); + my $crsid = $cnum.':'.$cdom; + foreach my $item (keys(%crsroleshash)) { + next unless ($item =~ /^$crsid\:/); + my ($crsnum,$crsdom,$role,$sec) = split(/\:/,$item); + my $suffix = "/$cdom/$cnum./$cdom/$cnum"; + if ($sec ne '') { + $suffix = "/$cdom/$cnum/$sec./$cdom/$cnum/$sec"; + } + if (($role eq $ccrole) || ($role eq 'in')) { + foreach my $priv ('mgr','vgr','usc') { + unless (grep(/^all$/,@{$availablesecs{$priv}})) { + if ($sec eq '') { + $availablesecs{$priv} = ['all']; + } elsif ($sec ne $env{'request.course.sec'}) { + unless (grep(/^\Q$sec\E$/,@{$availablesecs{$priv}})) { + push(@{$availablesecs{$priv}},$sec); + } + } + } + } + } elsif ($role =~ m{^cr/}) { + foreach my $priv ('mgr','vgr','usc') { + unless (grep(/^all$/,@{$availablesecs{$priv}})) { + if ($env{"user.priv.$role.$suffix"} =~ /:$priv&/) { + if ($sec eq '') { + $availablesecs{$priv} = ['all']; + } elsif ($sec ne $env{'request.course.sec'}) { + unless (grep(/^\Q$sec\E$/,@{$availablesecs{$priv}})) { + push(@{$availablesecs{$priv}},$sec); + } + } + } + } + } + } + } + return %availablesecs; +} + +sub scantron_upload_delete { + my ($r,$symb) = @_; + my $filename = $env{'form.uploadedfile'}; + if ($filename =~ /^scantron_orig_/) { + if (&Apache::lonnet::allowed('usc',$env{'form.domainid'}) || + &Apache::lonnet::allowed('usc', + $env{'form.domainid'}.'_'.$env{'form.courseid'}) || + &Apache::lonnet::allowed('usc', + $env{'form.domainid'}.'_'.$env{'form.courseid'}.'/'.$env{'form.coursesec'})) { + my $uploadurl = '/uploaded/'.$env{'form.domainid'}.'/'.$env{'form.courseid'}.'/'.$env{'form.uploadedfile'}; + my $retrieval = &Apache::lonnet::getfile($uploadurl); + if ($retrieval eq '-1') { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).'
    '. + &mt('File requested for deletion not found.')); + } else { + $filename =~ s/^scantron_orig_//; + if ($filename ne '') { + my ($is_valid,$numleft); + my %info = &Apache::lonnet::get('scantronupload',[$filename],$env{'form.domainid'},$env{'form.courseid'}); + if (keys(%info)) { + if (ref($info{$filename}) eq 'HASH') { + foreach my $timestamp (sort(keys(%{$info{$filename}}))) { + if ($info{$filename}{$timestamp} eq $env{'user.name'}.':'.$env{'user.domain'}) { + $is_valid = 1; + delete($info{$filename}{$timestamp}); + } + } + $numleft = scalar(keys(%{$info{$filename}})); + } + } + if ($is_valid) { + my $result = &Apache::lonnet::removeuploadedurl($uploadurl); + if ($result eq 'ok') { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion successful')).'
    '); + if ($numleft) { + &Apache::lonnet::put('scantronupload',\%info,$env{'form.domainid'},$env{'form.courseid'}); + } else { + &Apache::lonnet::del('scantronupload',[$filename],$env{'form.domainid'},$env{'form.courseid'}); + } + } else { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).'
    '. + &mt('Result was [_1]',$result)); + } + } else { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).'
    '. + &mt('File requested for deletion was uploaded by a different user.')); + } + } else { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).'
    '. + &mt('Filename of bubblesheet data file requested for deletion is invalid.')); + } + } + } else { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).'
    '. + &mt('You are not permitted to delete bubblesheet data files from the requested course.')); + } + } else { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).'
    '. + &mt('Filename of bubblesheet data file requested for deletion is invalid.')); + } + return; +} + sub valid_file { my ($requested_file)=@_; foreach my $filename (sort(&scantron_filenames())) { @@ -9224,7 +9775,7 @@ sub valid_file { } sub scantron_download_scantron_data { - my ($r,$symb)=@_; + my ($r,$symb) = @_; my $default_form_data=&defaultFormData($symb); my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; @@ -9237,6 +9788,29 @@ sub scantron_download_scantron_data { '); return; } + my (%uploader,$is_owner,%counts,$percent); + my %uploader = &Apache::lonnet::get('scantronupload',[$file],$cdom,$cname); + if (ref($uploader{$file}) eq 'HASH') { + foreach my $timestamp (sort { $a <=> $b } keys(%{$uploader{$file}})) { + if ($uploader{$file}{$timestamp} eq $env{'user.name'}.':'.$env{'user.domain'}) { + $is_owner = 1; + last; + } + } + } + unless ($is_owner) { + &validate_uploaded_scantron_file($cdom,$cname,$symb,'scantron_orig_'.$file,'download',\%counts); + if ($counts{'totalanysec'}) { + my $percent_othersec = (100*$counts{'othersec'})/($counts{'totalanysec'}); + if ($percent_othersec >= 10) { + my $showpct = sprintf("%.0f",$percent_othersec).'%'; + $r->print('

    '. + &mt('The original uploaded file includes [_1] or more of records for students for which none of your roles have rights to modify grades, so files are unavailable for download.',$showpct). + '

    '); + 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; @@ -9264,16 +9838,16 @@ sub checkscantron_results { my ($r,$symb) = @_; if (!$symb) {return '';} my $cid = $env{'request.course.id'}; - my %lettdig = &letter_to_digits(); + my %lettdig = &Apache::lonnet::letter_to_digits(); my $numletts = scalar(keys(%lettdig)); my $cnum = $env{'course.'.$cid.'.num'}; my $cdom = $env{'course.'.$cid.'.domain'}; my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); my %record; my %scantron_config = - &Apache::grades::get_scantron_config($env{'form.scantron_format'}); + &Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); - my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile(); + my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&Apache::grades::username_to_idmap($classlist); my $navmap=Apache::lonnavmaps::navmap->new(); @@ -9595,23 +10169,6 @@ sub verify_scantron_grading { return ($counter,$record); } -sub letter_to_digits { - my %lettdig = ( - A => 1, - B => 2, - C => 3, - D => 4, - E => 5, - F => 6, - G => 7, - H => 8, - I => 9, - J => 0, - ); - return %lettdig; -} - - #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -9666,7 +10223,7 @@ sub grading_menu { icon => 'grade_students.png', linktitle => 'Grade current resource for a selection of students.' }, - { linktext => 'Grade ungraded submissions.', + { linktext => 'Grade ungraded submissions', url => $url1b, permission => 'F', icon => 'ungrade_sub.png', @@ -9732,7 +10289,6 @@ sub grading_menu { return $Str; } - sub ungraded { my ($request)=@_; &submit_options($request); @@ -9760,7 +10316,7 @@ sub submit_options_table { my ($request,$symb) = @_; if (!$symb) {return '';} &commonJSfunctions($request); - my ($is_tool) = ($symb =~ /ext\.tool$/); + my $is_tool = ($symb =~ /ext\.tool$/); my $result; $result.='
    '."\n". @@ -9780,14 +10336,14 @@ sub submit_options_download { my ($request,$symb) = @_; if (!$symb) {return '';} - my ($is_tool) = ($symb =~ /ext\.tool$/); + my $is_tool = ($symb =~ /ext\.tool$/); &commonJSfunctions($request); my $result=''."\n". ''."\n"; $result.='

    - '.&mt('Select Students for Which to Download Submissions').' + '.&mt('Select Students for whom to Download Submissions').'

    '.&selectfield(1,$is_tool).' @@ -9804,7 +10360,7 @@ sub submit_options { my ($request,$symb) = @_; if (!$symb) {return '';} - my ($is_tool) = ($symb =~ /ext\.tool$/); + my $is_tool = ($symb =~ /ext\.tool$/); &commonJSfunctions($request); my $result; @@ -9815,8 +10371,6 @@ sub submit_options { - -
    '; return $result; } @@ -9896,7 +10450,7 @@ sub reset_perm { sub init_perm { &reset_perm(); - foreach my $test_perm ('vgr','mgr','opa') { + foreach my $test_perm ('vgr','mgr','opa','usc') { my $scope = $env{'request.course.id'}; if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) { @@ -10084,12 +10638,12 @@ ENDUPFORM ENDGRADINGFORM - $result.=''.&Apache::loncommon::end_data_table_row(). + $result.=''.&Apache::loncommon::end_data_table_row(). &Apache::loncommon::start_data_table_row().''.(<$pcorrect:

    -' + ENDPERCFORM $result.=''. &Apache::loncommon::end_data_table_row(). @@ -10098,7 +10652,7 @@ ENDPERCFORM } sub process_clicker_file { - my ($r,$symb)=@_; + my ($r,$symb) = @_; if (!$symb) {return '';} my %Saveable_Parameters=&clicker_grading_parameters(); @@ -10170,6 +10724,22 @@ sub process_clicker_file { ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''),1); return $result; } + my $mimetype; + if ($env{'form.upfiletype'} eq 'iclicker') { + my $mm = new File::MMagic; + $mimetype = $mm->checktype_contents($env{'form.upfile'}); + unless (($mimetype eq 'text/plain') || ($mimetype eq 'text/html')) { + $result.= '

    '. + &Apache::lonhtmlcommon::confirm_success( + &mt('File format is neither csv (iclicker 6) nor xml (iclicker 7)'),1).'

    '; + return $result; + } + } elsif (($env{'form.upfiletype'} ne 'interwrite') && ($env{'form.upfiletype'} ne 'turning')) { + $result .= '

    '. + &Apache::lonhtmlcommon::confirm_success( + &mt('Invalid clicker type: choose one of: i>clicker, Interwrite PRS, or Turning Technologies.'),1).'

    '; + return $result; + } # Were able to get all the info needed, now analyze the file @@ -10196,12 +10766,14 @@ ENDHEADER my $errormsg=''; my $number=0; if ($env{'form.upfiletype'} eq 'iclicker') { - ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); - } - if ($env{'form.upfiletype'} eq 'interwrite') { + if ($mimetype eq 'text/plain') { + ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); + } elsif ($mimetype eq 'text/html') { + ($errormsg,$number)=&iclickerxml_eval(\@questiontitles,\%responses); + } + } elsif ($env{'form.upfiletype'} eq 'interwrite') { ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); - } - if ($env{'form.upfiletype'} eq 'turning') { + } elsif ($env{'form.upfiletype'} eq 'turning') { ($errormsg,$number)=&turning_eval(\@questiontitles,\%responses); } $result.='
    '.&mt('Found [_1] question(s)',$number).'
    '. @@ -10254,7 +10826,7 @@ ENDHEADER "\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,0,$id); + &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id,'',$id); $unknown_count++; } } @@ -10309,6 +10881,49 @@ sub iclicker_eval { return ($errormsg,$number); } +sub iclickerxml_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + my @state; + my %respbyid; + my $p = HTML::Parser->new + ( + xml_mode => 1, + start_h => + [sub { + my ($tagname,$attr) = @_; + push(@state,$tagname); + if ("@state" eq "ssn p") { + my $title = $attr->{qn}; + $title =~ s/(^\s+|\s+$)//g; + $questiontitles->[$number]=$title; + } elsif ("@state" eq "ssn p v") { + my $id = $attr->{id}; + my $entry = $attr->{ans}; + $id=~s/^[\#0]+//; + $entry =~s/[^a-zA-Z0-9\.\*\-\+]+//g; + $respbyid{$id}[$number] = $entry; + } + }, "tagname, attr"], + end_h => + [sub { + my ($tagname) = @_; + if ("@state" eq "ssn p") { + $number++; + } + pop(@state); + }, "tagname"], + ); + + $p->parse($env{'form.upfile'}); + $p->eof; + foreach my $id (keys(%respbyid)) { + $responses->{$id}=join(',',@{$respbyid{$id}}); + } + return ($errormsg,$number); +} + sub interwrite_eval { my ($questiontitles,$responses)=@_; my $number=0; @@ -10367,7 +10982,7 @@ sub turning_eval { sub assign_clicker_grades { - my ($r,$symb)=@_; + my ($r,$symb) = @_; if (!$symb) {return '';} # See which part we are saving to my $res_error; @@ -10378,11 +10993,11 @@ sub assign_clicker_grades { # FIXME: This should probably look for the first handgradeable part my $part=$$partlist[0]; # Start screen output - my $result=&Apache::loncommon::start_data_table(). - &Apache::loncommon::start_data_table_header_row(). - ''.&mt('Assigning grades based on clicker file').''. - &Apache::loncommon::end_data_table_header_row(). - &Apache::loncommon::start_data_table_row().''; + my $result = &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ''.&mt('Assigning grades based on clicker file').''. + &Apache::loncommon::end_data_table_header_row(). + &Apache::loncommon::start_data_table_row().''; # Get correct result # FIXME: Possibly need delimiter other than ":" my @correct=(); @@ -10444,7 +11059,7 @@ sub assign_clicker_grades { for (my $i=0;$i<$number;$i++) { if ($correct[$i] eq '-') { $realnumber--; - } elsif (($answer[$i]) || ($answer[$i]=~/^[0\.]+$/)) { + } elsif (($answer[$i]) || ($answer[$i]=~/^[0\.]+$/)) { if ($gradingmechanism eq 'attendance') { $sum+=$pcorrect; } elsif ($correct[$i] eq '*') { @@ -10503,24 +11118,34 @@ sub navmap_errormsg { } sub startpage { - my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$js) = @_; + my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$js,$onload) = @_; + my %args; + if ($onload) { + my %loaditems = ( + 'onload' => $onload, + ); + $args{'add_entries'} = \%loaditems; + } if ($nomenu) { - $r->print(&Apache::loncommon::start_page("Student's Version",$js,{'only_body' => '1'})); + $args{'only_body'} = 1; + $r->print(&Apache::loncommon::start_page("Student's Version",$js,\%args)); } else { unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"}); - $r->print(&Apache::loncommon::start_page('Grading',$js, - {'bread_crumbs' => $crumbs})); - &Apache::lonquickgrades::startGradeScreen($r,($env{'form.symb'}?'probgrading':'grading')); + $args{'bread_crumbs'} = $crumbs; + $r->print(&Apache::loncommon::start_page('Grading',$js,\%args)); + if ($env{'request.course.id'}) { + &Apache::lonquickgrades::startGradeScreen($r,($env{'form.symb'}?'probgrading':'grading')); + } } unless ($nodisplayflag) { - $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag,$stuvcurrent,$stuvdisp)); + $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag,$stuvcurrent,$stuvdisp)); } } sub select_problem { my ($r)=@_; $r->print('

    '.&mt('Select the problem or one of the problems you want to grade').'

    '); - $r->print(&Apache::lonstathelpers::problem_selector('.',undef,1,undef,undef,undef,undef,1)); + $r->print(&Apache::lonstathelpers::problem_selector('.',undef,1,undef,undef,1,1)); $r->print(''); $r->print('
    '); } @@ -10693,7 +11318,8 @@ sub handler { &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); $request->print(&csvuploadassign($request,$symb)); } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { - &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); + &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1, + undef,undef,undef,undef,'toggleScantab(document.rules);'); $request->print(&scantron_selectphase($request,undef,$symb)); } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) { &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); @@ -10705,19 +11331,21 @@ sub handler { &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); $request->print(&scantron_process_students($request,$symb)); } elsif ($command eq 'scantronupload' && - (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| - &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { - &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); + (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || $perm{'usc'})) { + &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1, + undef,undef,undef,undef,'toggleScantab(document.rules);'); $request->print(&scantron_upload_scantron_data($request,$symb)); } elsif ($command eq 'scantronupload_save' && - (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| - &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { + (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || $perm{'usc'})) { &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); $request->print(&scantron_upload_scantron_data_save($request,$symb)); - } elsif ($command eq 'scantron_download' && - &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { + } elsif ($command eq 'scantron_download' && ($perm{'usc'} || $perm{'mgr'})) { &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); $request->print(&scantron_download_scantron_data($request,$symb)); + } elsif ($command eq 'scantronupload_delete' && + (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || $perm{'usc'})) { + &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); + &scantron_upload_delete($request,$symb); } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) { &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); $request->print(&checkscantron_results($request,$symb)); @@ -10727,7 +11355,7 @@ sub handler { } elsif ($command eq 'downloadfileslink' && $perm{'vgr'}) { &startpage($request,$symb, [{href=>&href_symb_cmd($symb,'downloadfilesselect'), text=>'Select which submissions to download'}, - {href=>'', text=>'Download submissions'}]); + {href=>'', text=>'Download submitted files'}]); &submit_download_link($request,$symb); } elsif ($command) { &startpage($request,$symb,[{href=>'', text=>'Access denied'}]); @@ -10739,7 +11367,7 @@ sub handler { } if ($env{'form.inhibitmenu'}) { $request->print(&Apache::loncommon::end_page()); - } else { + } elsif ($env{'request.course.id'}) { &Apache::lonquickgrades::endGradeScreen($request); } &reset_caches(); @@ -10890,7 +11518,7 @@ Side Effects: None. $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() + $scan_config - hash ref as returned from &Apache::lonnet::get_scantron_config() $line - full contents of the current scanline $error - error condition, valid values are 'incorrectCODE', 'duplicateCODE', @@ -10977,7 +11605,12 @@ Side Effects: None. =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. + has the correct privileges to do so. + += item scantron_upload_delete() : + + Deletes a previously uploaded bubble information data file, if user + was the one who uploaded the file, and has the privileges to do so. =item valid_file() :