--- loncom/homework/grades.pm 2005/06/03 18:23:19 1.269 +++ loncom/homework/grades.pm 2005/09/20 06:45:02 1.285 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.269 2005/06/03 18:23:19 raeburn Exp $ +# $Id: grades.pm,v 1.285 2005/09/20 06:45:02 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -471,6 +471,10 @@ sub most_similar { $uessay=~s/\W+/ /gs; +# ignore empty submissions (occuring when only files are sent) + + unless ($uessay=~/\w+/) { return ''; } + # these will be returned. Do not care if not at least 50 percent similar my $limit=0.6; my $sname=''; @@ -743,7 +747,7 @@ LISTJAVASCRIPT if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { next if (/^resource.*?submitted_by$/); - $gradeTable.=' '.$status{$_}.' '."\n"; + $gradeTable.=' '.$status{$_}.' '."\n"; } } # $gradeTable.='' if ($ctr%2 ==1); @@ -1352,15 +1356,14 @@ sub gradeBox { my $result=''."\n"; my $display_part=&get_display_part($partid,undef,$symb); - my @partids = ("$partid"); - my %last_resets = (); - &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids); - my $aggtries; + + 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); - } else { - $aggtries = $$record{'resource.'.$partid.'.tries'}; } + $result.=''; - # retrieve last reset information - my %last_resets = (); - &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids); + my %last_resets = + &get_last_resets($symb,$env{'request.course.id'},\@partids); #get info for each student #list all the students - with points and grade status @@ -2660,7 +2660,6 @@ sub viewgrades { sub viewstudentgrade { my ($url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_; my ($uname,$udom) = split(/:/,$student); - $student=~s/:/_/; my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); my %aggregates = (); my $result=''."\n"; + $student=~s/:/_/; # colon doen't work in javascript for names foreach my $apart (@$parts) { my ($part,$type) = &split_part_type($apart); my $score=$record{"resource.$part.$type"}; - $result.='
'. 'Part: '.$display_part.' Points: '."\n"; @@ -2156,17 +2159,17 @@ sub saveHandGrade { } $newrecord{'resource.'.$new_part.'.regrader'}= "$env{'user.name'}:$env{'user.domain'}"; - my @partids = ("$new_part"); - my %last_resets = (); - &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids); - my ($totaltries,$aggtries,$solvedstatus); - $totaltries = $record{'resource.'.$part.'.tries'}; + my $totaltries = $record{'resource.'.$part.'.tries'}; + + my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, + [$new_part]); + my $aggtries =$totaltries; if ($last_resets{$new_part}) { - $aggtries = &get_num_tries(\%record,$last_resets{$new_part},$new_part); - } else { - $aggtries = $totaltries; + $aggtries = &get_num_tries(\%record,$last_resets{$new_part}, + $new_part); } - $solvedstatus = $record{'resource.'.$new_part.'.solved'}; + + my $solvedstatus = $record{'resource.'.$new_part.'.solved'}; if ($aggtries > 0) { &decrement($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); $aggregateflag = 1; @@ -2270,22 +2273,20 @@ sub decrement_aggs { # ----------- Determine timestamps for last reset of aggregate totals for parts sub get_last_resets { - my ($symb,$courseid,$last_resets,$partids) =@_; + my ($symb,$courseid,$partids) =@_; + my %last_resets; my $cdom = $env{'course.'.$courseid.'.domain'}; my $cname = $env{'course.'.$courseid.'.num'}; - my %resethash = &Apache::lonnet::restore($symb,'nohist_resourcetracker',$cdom,$cname); - if ($resethash{'version'}) { - foreach my $part (@{$partids}) { - $$last_resets{$part} = ''; - for (my $version=$resethash{'version'};$version>=1;$version--) { - if (exists($resethash{$version.':'.$part."\0".'prev_attempts'})) { - $$last_resets{$part} = $resethash{$version.':timestamp'}; - last; - } - } - } + my @keys; + foreach my $part (@{$partids}) { + push(@keys,"$symb\0$part\0resettime"); + } + my %results=&Apache::lonnet::get('nohist_resourcetracker',\@keys, + $cdom,$cname); + foreach my $part (@{$partids}) { + $last_resets{$part}=$results{"$symb\0$part\0resettime"}; } - return; + return %last_resets; } # ----------- Handles creating versions for portfolio files as answers @@ -2296,12 +2297,13 @@ sub version_portfiles { my $portfolio_root = &Apache::loncommon::propath($domain, $stuname). '/userfiles/portfolio'; - foreach my $key(keys %$record) { + foreach my $key (keys(%$record)) { my $new_portfiles; + if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { my @v_portfiles; my @portfiles = split(/,/,$$record{$key}); - # &Apache::lonnet::logthis("should be unmarking and remarking"); + &Apache::lonnet::logthis("should be unmarking and remarking $key",@portfiles); foreach my $file (@portfiles) { &Apache::lonnet::unmark_as_readonly($domain,$stuname,[$symb,$env{'request.course.id'}],$file); my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*$)/); @@ -2324,12 +2326,11 @@ sub version_portfiles { } } $version++; - my $home_server = &Apache::lonnet::homeserver($stuname,$domain,undef); $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stuname/portfolio$directory$answer_file"); if($env{'form.copy'} eq '-1') { &Apache::lonnet::logthis('problem getting file '.$directory.$answer_file); } else { - my $copy_result = &Apache::lonnet::finishuserfileupload($stuname,$domain,$home_server,'copy', + my $copy_result = &Apache::lonnet::finishuserfileupload($stuname,$domain,'copy', '/portfolio'.$directory.$answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]); push(@v_portfiles, $answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]); &Apache::lonnet::mark_as_readonly($domain,$stuname, @@ -2630,9 +2631,8 @@ sub viewgrades { } $result.='
'. @@ -2669,18 +2668,20 @@ sub viewstudentgrade { ''.$fullname.' '. '('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')'; + $result.=''; my ($aggtries,$totaltries); unless (exists($aggregates{$part})) { - $totaltries = $record{'resource.'.$part.'.tries'}; + $totaltries = $record{'resource.'.$part.'.tries'}; + + $aggtries = $totaltries; if ($$last_resets{$part}) { - $aggtries = &get_num_tries(\%record,$$last_resets{$part},$part); - } else { - $aggtries = $totaltries; - } + $aggtries = &get_num_tries(\%record,$$last_resets{$part}, + $part); + } $result.=''."\n"; $result.=' function checkUpload(formname) { @@ -3080,6 +3077,14 @@ sub upcsvScores_form { } CSVFORMJS + return $result; +} + +sub upcsvScores_form { + my ($request) = shift; + my ($symb,$url)=&get_symb_and_url($request); + if (!$symb) {return '';} + my $result=&checkforfile_js(); $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb); my ($table) = &showResourceInfo($url,$env{'form.probTitle'}); $result.=$table; @@ -3099,7 +3104,7 @@ CSVFORMJS $upfile_select
-
'."\n"; @@ -3868,6 +3873,7 @@ sub scantron_CODElist { my $namechoice=''; foreach my $name (sort {uc($a) cmp uc($b)} @names) { if ($name =~ /^error: 2 /) { next; } + if ($name =~ /^type\0/) { next; } $namechoice.=''; } $namechoice=''; @@ -3876,12 +3882,12 @@ sub scantron_CODElist { sub scantron_CODEunique { my $result=' - Yes + - No + '; return $result; } @@ -3931,8 +3937,8 @@ sub scantron_selectphase { Options: - Do only previously skipped records
- Remove all exisiting corrections +
+ @@ -4111,7 +4117,14 @@ sub scantron_fixup_scanline { &scan_data($scan_data, "$whichline.no_bubble.".$args->{'question'},'1'); } else { - substr($answer,$args->{'response'},1)=$on; + if ($on eq 'letter') { + my @alphabet=('A'..'Z'); + $answer=$alphabet[$args->{'response'}]; + } elsif ($on eq 'number') { + $answer=$args->{'response'}+1; + } else { + substr($answer,$args->{'response'},1)=$on; + } &scan_data($scan_data, "$whichline.no_bubble.".$args->{'question'},undef,'1'); } @@ -4136,8 +4149,11 @@ sub scantron_parse_scanline { my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); my $data=substr($line,0,$$scantron_config{'Qstart'}-1); - if ($$scantron_config{'CODElocation'} ne 0) { - if ($$scantron_config{'CODElocation'} < 0) { + if (!($$scantron_config{'CODElocation'} eq 0 || + $$scantron_config{'CODElocation'} eq 'none')) { + if ($$scantron_config{'CODElocation'} < 0 || + $$scantron_config{'CODElocation'} eq 'letter' || + $$scantron_config{'CODElocation'} eq 'number') { $record{'scantron.CODE'}=substr($data, $$scantron_config{'CODEstart'}-1, $$scantron_config{'CODElength'}); @@ -4172,8 +4188,12 @@ sub scantron_parse_scanline { substr($questions,0,$$scantron_config{'Qlength'})=''; if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } if ($$scantron_config{'Qon'} eq 'letter') { - if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} || - $currentquest !~ /^[A-Z]$/) { + if ($currentquest eq '?') { + push(@{$record{'scantron.doubleerror'}},$questnum); + $record{"scantron.$questnum.answer"}=''; + } elsif (!$currentquest + || $currentquest eq $$scantron_config{'Qoff'} + || $currentquest !~ /^[A-Z]$/) { $record{"scantron.$questnum.answer"}=''; if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); @@ -4182,8 +4202,12 @@ sub scantron_parse_scanline { $record{"scantron.$questnum.answer"}=$currentquest; } } elsif ($$scantron_config{'Qon'} eq 'number') { - if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} || - $currentquest !~ /^\d$/) { + if ($currentquest eq '?') { + push(@{$record{'scantron.doubleerror'}},$questnum); + $record{"scantron.$questnum.answer"}=''; + } elsif (!$currentquest + || $currentquest eq $$scantron_config{'Qoff'} + || $currentquest !~ /^\d$/) { $record{"scantron.$questnum.answer"}=''; if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); @@ -4354,14 +4378,26 @@ sub check_for_error { 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="a"; + if ($scantron_config{'CODElocation'} && + $scantron_config{'CODEstart'} && + $scantron_config{'CODElength'}) { + $CODElist=$env{'form.scantron_CODElist'}; + if ($CODElist eq '') { $CODElist='None'; } + $CODElist= + 'List of CODES to validate against:'. + $CODElist.''; + } return (< Please double check the information below before clicking on '$button_text'

- + +$CODElist
Sequence To be Graded:$title
Sequence to be Graded:$title
Data File that will be used:$env{'form.scantron_selectfile'}

@@ -4568,9 +4604,8 @@ sub lonnet_putfile { my ($contents,$filename)=@_; my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; - my $docuhome=$env{'course.'.$env{'request.course.id'}.'.home'}; $env{'form.sillywaytopassafilearound'}=$contents; - &Apache::lonnet::finishuserfileupload($docuname,$docudom,$docuhome,'sillywaytopassafilearound',$filename); + &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename); } @@ -4738,19 +4773,24 @@ sub scantron_get_correction { $r->print("

How should I handle this?
\n"); $r->print("\n
"); my $i=0; - if ($error eq 'incorrectCODE') { + if ($error eq 'incorrectCODE' + && $$scan_record{'scantron.CODE'}=~/\S/ ) { my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); - foreach my $testcode (@{$closest}) { - my $checked=''; - if (!$i) { $checked=' checked="on" '; } - $r->print(" Use the similar CODE ".$testcode." instead."); - $r->print("\n
"); - $i++; + if ($closest > 0) { + foreach my $testcode (@{$closest}) { + my $checked=''; + if (!$i) { $checked=' checked="on" '; } + $r->print(""); + $r->print("\n
"); + $i++; + } } } - my $checked; if (!$i) { $checked=' checked="on" '; } - $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error."); - $r->print("\n
"); + if ($$scan_record{'scantron.CODE'}=~/\S/ ) { + my $checked; if (!$i) { $checked=' checked="on" '; } + $r->print(""); + $r->print("\n
"); + } $r->print(< @@ -4769,9 +4809,9 @@ ENDSCRIPT "&scantron_CODElist=".&Apache::lonnet::escape($env{'form.scantron_CODElist'}). "&curCODE=".&Apache::lonnet::escape($$scan_record{'scantron.CODE'}). "&scantron_selectfile=".&Apache::lonnet::escape($env{'form.scantron_selectfile'}); - $r->print(" Select a CODE from the list of all CODEs and use it. Selected CODE is "); + $r->print(" Selected CODE is "); $r->print("\n
"); - $r->print(" Use as the CODE."); + $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"); @@ -4804,21 +4844,26 @@ ENDSCRIPT sub scantron_bubble_selector { my ($r,$scan_config,$quest,@selected)=@_; my $max=$$scan_config{'Qlength'}; + + my $scmode=$$scan_config{'Qon'}; + if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } + my @alphabet=('A'..'Z'); $r->print(""); for (my $i=0;$i<$max+1;$i++) { - $r->print(''); } - $r->print(''); + $r->print(''); for (my $i=0;$i<$max;$i++) { - $r->print('"); + $r->print("\n". + '"); } - $r->print(''); + $r->print(''); $r->print('
$quest'); + $r->print("\n".''); if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } else { $r->print(' '); } $r->print('
'.$alphabet[$i]." No bubble
'); } @@ -4844,11 +4889,24 @@ sub scantron_get_closely_matching_CODEs } sub get_codes { - my $old_name=$env{'form.scantron_CODElist'}; - my $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'}; - my $cnum =$env{'course.'.$env{'request.course.id'}.'.num'}; - my %result=&Apache::lonnet::get('CODEs',[$old_name],$cdom,$cnum); - my %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); + my ($old_name, $cdom, $cnum) = @_; + if (!$old_name) { + $old_name=$env{'form.scantron_CODElist'}; + } + if (!$cdom) { + $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'}; + } + if (!$cnum) { + $cnum =$env{'course.'.$env{'request.course.id'}.'.num'}; + } + my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"], + $cdom,$cnum); + my %allcodes; + if ($result{"type\0$old_name"} eq 'number') { + %allcodes=map {($_,1)} split(',',$result{$old_name}); + } else { + %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); + } return %allcodes; } @@ -5138,8 +5196,6 @@ sub scantron_upload_scantron_data_save { } my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); $r->print("Doing upload to ".$coursedata{'description'}."
"); - my $home=&Apache::lonnet::homeserver($env{'form.courseid'}, - $env{'form.domainid'}); my $fname=$env{'form.upfile.filename'}; #FIXME #copied from lonnet::userfileupload() @@ -5159,7 +5215,7 @@ sub scantron_upload_scantron_data_save { 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'},$home,'upfile',$fname); + 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 { @@ -5383,6 +5439,9 @@ GRADINGMENUJS $result.=''. ' access times.'."\n"; + $result.=''. + ' saved CODEs.'."\n"; $result.=''."\n". ''."\n". @@ -5390,10 +5449,32 @@ GRADINGMENUJS return $result; } +sub reset_perm { + undef(%perm); +} + +sub init_perm { + &reset_perm(); + if (!($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) { + if ($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$env{'request.course.id'}.'/'.$env{'request.course.sec'})) { + $perm{'vgr_section'}=$env{'request.course.sec'}; + } else { + delete($perm{'vgr'}); + } + } + if (!($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$env{'request.course.id'}))) { + if ($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$env{'request.course.id'}.'/'.$env{'request.course.sec'})) { + $perm{'mgr_section'}=$env{'request.course.sec'}; + } else { + delete($perm{'mgr'}); + } + } +} + sub handler { my $request=$_[0]; - undef(%perm); + &reset_perm(); if ($env{'browser.mathml'}) { &Apache::loncommon::content_type($request,'text/xml'); } else { @@ -5442,20 +5523,7 @@ sub handler { } } } else { - if (!($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) { - if ($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$env{'request.course.id'}.'/'.$env{'request.course.sec'})) { - $perm{'vgr_section'}=$env{'request.course.sec'}; - } else { - delete($perm{'vgr'}); - } - } - if (!($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$env{'request.course.id'}))) { - if ($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$env{'request.course.id'}.'/'.$env{'request.course.sec'})) { - $perm{'mgr_section'}=$env{'request.course.sec'}; - } else { - delete($perm{'mgr'}); - } - } + &init_perm(); if ($command eq 'submission' && $perm{'vgr'}) { ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {