--- loncom/homework/grades.pm 2005/04/07 07:03:23 1.258 +++ loncom/homework/grades.pm 2005/12/02 19:20:21 1.299 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.258 2005/04/07 07:03:23 albertel Exp $ +# $Id: grades.pm,v 1.299 2005/12/02 19:20:21 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -152,6 +152,7 @@ sub get_display_part { } return $display; } + #--- Show resource title #--- and parts and response type sub showResourceInfo { @@ -284,6 +285,11 @@ sub cleanRecord { } $answer =~ s-\n-
-g; return '

'.&keywords_highlight($answer).'
'; + } elsif ( $response eq 'organic') { + my $result='Smile representation: "'.$answer.'"'; + my $jme=$record->{$version."resource.$partid.$respid.molecule"}; + $result.=&Apache::chemresponse::jme_img($jme,$answer,400); + return $result; } return $answer; } @@ -328,7 +334,16 @@ COMMONJSFUNCTIONS #--- section, ids and fullnames for each user. sub getclasslist { my ($getsec,$filterlist) = @_; - $getsec = $getsec eq '' ? 'all' : $getsec; + my @getsec; + if (!ref($getsec)) { + if ($getsec ne '' && $getsec ne 'all') { + @getsec=($getsec); + } + } else { + @getsec=@{$getsec}; + } + if (grep(/^all$/,@getsec)) { undef(@getsec); } + my $classlist=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist return if (! defined($classlist)); @@ -357,7 +372,7 @@ sub getclasslist { } $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { - if ($getsec eq 'all' || $getsec eq $section) { + if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { $sections{$section}++; $fullnames{$student}=$fullname; } else { @@ -465,6 +480,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=''; @@ -526,7 +545,13 @@ sub verifyreceipt { if ($env{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; } my $parts=['0']; if ($receiptparts) { ($parts)=&response_type($url,$symb); } - foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + foreach (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } (keys(%$fullname))) { my ($uname,$udom)=split(/\:/); foreach my $part (@$parts) { if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { @@ -626,24 +651,24 @@ LISTJAVASCRIPT my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; my $gradeTable='
'. "\n".$table. - ' View Problem Text: no '."\n". - ' one student '."\n". - ' all students
'."\n". - ' View Answer: no '."\n". - ' one student '."\n". - ' all students
'."\n". + ' View Problem Text: '."\n". + ''."\n". + '
'."\n". + ' View Answer: '."\n". + ''."\n". + '
'."\n". ' Submissions: '."\n"; if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { - $gradeTable.=' essay part only'."\n"; + $gradeTable.=''."\n"; } my $saveStatus = $env{'form.Status'} eq '' ? 'Active' : $env{'form.Status'}; $env{'form.Status'} = $saveStatus; - $gradeTable.=' last submission only'."\n". - ' last submission & parts info'."\n". - ' by dates and submissions'."\n". - ' all details'."\n". + $gradeTable.=''."\n". + ''."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". '
'."\n". @@ -671,7 +696,7 @@ LISTJAVASCRIPT 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 'value="Next->" />
'."\n"; $gradeTable.=&check_buttons(); - $gradeTable.='Check For Plagiarism'; + $gradeTable.=''; my ($classlist, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. ''; @@ -692,7 +717,14 @@ LISTJAVASCRIPT $gradeTable.=''."\n"; my $ctr = 0; - foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + foreach my $student (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } + (keys(%$fullname))) { my ($uname,$udom) = split(/:/,$student); my %status = (); if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { @@ -737,7 +769,7 @@ LISTJAVASCRIPT if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { next if (/^resource.*?submitted_by$/); - $gradeTable.=''."\n"; + $gradeTable.=''."\n"; } } # $gradeTable.='' if ($ctr%2 ==1); @@ -1346,16 +1378,24 @@ sub gradeBox { my $result=''."\n"; my $display_part=&get_display_part($partid,undef,$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.='
 '.$status{$_}.'  '.$status{$_}.' 
\n"; + ','.$ctr.')" />'.$ctr."\n"; $result.=(($ctr+1)%10 == 0 ? '' : ''); $ctr++; } @@ -2478,7 +2642,8 @@ sub viewgrades { $weight{$partid}.')"> '. ''. ''. - ''."\n"; + ''. + ''."\n"; $ctsparts++; } $result.='
'. 'Part: '.$display_part.' Points: '."\n"; my $ctr = 0; $result.=''."\n"; # display radio buttons in a nice table 10 across while ($ctr<=$wgt) { - $result.= '\n"; + ($score eq $ctr ? 'checked':'').' /> '.$ctr."\n"; $result.=(($ctr+1)%10 == 0 ? '' : ''); $ctr++; } @@ -1384,7 +1424,11 @@ sub gradeBox { $result.=''."\n". ''."\n". ''."\n"; + $$record{'resource.'.$partid.'.solved'}.'" />'."\n". + ''."\n". + ''."\n"; $result.='
'.$ctr."
'."\n"; return $result; } @@ -1593,7 +1637,6 @@ KEYWORDS } my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); - my ($partlist,$handgrade,$responseType) = &response_type($url,$symb); # Display student info @@ -1801,13 +1844,22 @@ KEYWORDS ''."\n"; $result.=' '. - 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').'  '. + &mt('Compose message to student').(scalar(@col_fullnames) >= 1 ? 's' : '').' ('. + &mt('incl. grades').' )'. ''."\n". - '
 (Message will be sent when you click on Save & Next below.)'."\n" - if ($env{'form.handgrade'} eq 'yes'); + '
 ('. + &mt('Message will be sent when you click on Save & Next below.').")\n"; $request->print($result); } + if (&Apache::lonnet::allowed('vgr',$env{'request.course.id'})) { + $request->print('
'. + &Apache::loncommon::track_student_link(&mt('View recent activity'),$uname,$udom,'check')); + } + if (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) { + $request->print('
'. + &Apache::loncommon::pprmlink(&mt('Set/Change parameters'),$uname,$udom,$symb,'check')); + } my %seen = (); my @partlist; @@ -1923,18 +1975,24 @@ sub processHandGrade { my $includemsg = $env{'form.includemsg'.$ctr}; my ($subject,$message,$msgstatus) = ('','',''); if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { - $subject = $env{'form.msgsub'} if ($includemsg =~ /^msgsub/); + $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); + unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } my (@msgnum) = split(/,/,$includemsg); foreach (@msgnum) { $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); } $message =&Apache::lonfeedback::clear_out_html($message); - $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; - $message.=" for 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; + $message.=" for $env{'form.probTitle'}"; + } $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom, - $env{'form.msgsub'},$message); + $subject.' ['. + &Apache::lonnet::declutter($url).']',$message); + $request->print('
'.&mt('Sending message to [_1]@[_2]',$uname,$udom).': '. + $msgstatus); } if ($env{'form.collaborator'.$ctr}) { my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); @@ -2043,7 +2101,13 @@ sub processHandGrade { my (@parsedlist,@nextlist); my ($nextflg) = 0; - foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + foreach (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } (keys(%$fullname))) { if ($nextflg == 1 && $button =~ /Next$/) { push @parsedlist,$_; } @@ -2109,6 +2173,7 @@ sub processHandGrade { #---- Save the score and award for each student, if changed sub saveHandGrade { my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; + my @v_flag; my $usec = &Apache::lonnet::getsection($domain,$stuname, $env{'request.course.id'}); if (!&canmodify($usec)) { return('not_allowed'); } @@ -2116,45 +2181,62 @@ sub saveHandGrade { my @parts_graded; my %newrecord = (); my ($pts,$wgt) = ('',''); - foreach (split(/:/,$env{'form.partlist'.$newflg})) { + my %aggregate = (); + my $aggregateflag = 0; + foreach my $new_part (split(/:/,$env{'form.partlist'.$newflg})) { #collaborator may vary for different parts - if ($submitter && $_ ne $part) { next; } - my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$_}; + if ($submitter && $new_part ne $part) { next; } + my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; if ($dropMenu eq 'excused') { - if ($record{'resource.'.$_.'.solved'} ne 'excused') { - $newrecord{'resource.'.$_.'.solved'} = 'excused'; - if (exists($record{'resource.'.$_.'.awarded'})) { - $newrecord{'resource.'.$_.'.awarded'} = ''; + if ($record{'resource.'.$new_part.'.solved'} ne 'excused') { + $newrecord{'resource.'.$new_part.'.solved'} = 'excused'; + if (exists($record{'resource.'.$new_part.'.awarded'})) { + $newrecord{'resource.'.$new_part.'.awarded'} = ''; } - $newrecord{'resource.'.$_.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; + $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; } } elsif ($dropMenu eq 'reset status' - && exists($record{'resource.'.$_.'.solved'})) { #don't bother if no old records -> no attempts + && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts foreach my $key (keys (%record)) { - if ($key=~/^resource\.\Q$_\E\./) { $newrecord{$key} = ''; } + if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } } - $newrecord{'resource.'.$_.'.regrader'}= + $newrecord{'resource.'.$new_part.'.regrader'}= "$env{'user.name'}:$env{'user.domain'}"; + 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); + } + + my $solvedstatus = $record{'resource.'.$new_part.'.solved'}; + if ($aggtries > 0) { + &decrement($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); + $aggregateflag = 1; + } } elsif ($dropMenu eq '') { - $pts = ($env{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? - $env{'form.GD_BOX'.$newflg.'_'.$_} : - $env{'form.RADVAL'.$newflg.'_'.$_}); - if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$_} eq '') { + $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? + $env{'form.GD_BOX'.$newflg.'_'.$new_part} : + $env{'form.RADVAL'.$newflg.'_'.$new_part}); + if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$new_part} eq '') { next; } - $wgt = $env{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : - $env{'form.WGT'.$newflg.'_'.$_}; + $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : + $env{'form.WGT'.$newflg.'_'.$new_part}; my $partial= $pts/$wgt; - if ($partial eq $record{'resource.'.$_.'.awarded'}) { + if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { #do not update score for part if not changed. next; } else { - push @parts_graded, $_; + push @parts_graded, $new_part; } - if ($record{'resource.'.$_.'.awarded'} ne $partial) { - $newrecord{'resource.'.$_.'.awarded'} = $partial; + if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { + $newrecord{'resource.'.$new_part.'.awarded'} = $partial; } - my $reckey = 'resource.'.$_.'.solved'; + my $reckey = 'resource.'.$new_part.'.solved'; if ($partial == 0) { if ($record{$reckey} ne 'incorrect_by_override') { $newrecord{$reckey} = 'incorrect_by_override'; @@ -2165,32 +2247,108 @@ sub saveHandGrade { } } if ($submitter && - ($record{'resource.'.$_.'.submitted_by'} ne $submitter)) { - $newrecord{'resource.'.$_.'.submitted_by'} = $submitter; + ($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) { + $newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter; } - $newrecord{'resource.'.$_.'.regrader'}= + $newrecord{'resource.'.$new_part.'.regrader'}= "$env{'user.name'}:$env{'user.domain'}"; } + # unless problem has been graded, set flag to version the submitted files + unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override') { + push (@v_flag,$new_part); + } } if (scalar(keys(%newrecord)) > 0) { - &version_portfiles(\%record, \@parts_graded, $env{'request.course.id'}, $symb, $domain, $stuname); + if (scalar(@v_flag)) { + &version_portfiles(\%record, \@parts_graded, $env{'request.course.id'}, $symb, $domain, $stuname, \@v_flag); + } &Apache::lonnet::cstore(\%newrecord,$symb, $env{'request.course.id'},$domain,$stuname); } + if ($aggregateflag) { + &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + } return '',$pts,$wgt; } +# ----------- Provides number of tries since last reset. +sub get_num_tries { + my ($record,$last_reset,$part) = @_; + my $timestamp = ''; + my $num_tries = 0; + if ($$record{'version'}) { + for (my $version=$$record{'version'};$version>=1;$version--) { + if (exists($$record{$version.':resource.'.$part.'.solved'})) { + $timestamp = $$record{$version.':timestamp'}; + if ($timestamp > $last_reset) { + $num_tries ++; + } else { + last; + } + } + } + } + return $num_tries; +} + +# ----------- Determine decrements required in aggregate totals +sub decrement_aggs { + my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_; + my %decrement = ( + attempts => 0, + users => 0, + correct => 0 + ); + $decrement{'attempts'} = $aggtries; + if ($solvedstatus =~ /^correct/) { + $decrement{'correct'} = 1; + } + if ($aggtries == $totaltries) { + $decrement{'users'} = 1; + } + foreach my $type (keys (%decrement)) { + $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type}; + } + return; +} + +# ----------- Determine timestamps for last reset of aggregate totals for parts +sub get_last_resets { + my ($symb,$courseid,$partids) =@_; + my %last_resets; + my $cdom = $env{'course.'.$courseid.'.domain'}; + my $cname = $env{'course.'.$courseid.'.num'}; + 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 %last_resets; +} + # ----------- Handles creating versions for portfolio files as answers sub version_portfiles { - my ($record, $parts_graded, $courseid, $symb, $domain, $stuname) = @_; + my ($record, $parts_graded, $courseid, $symb, $domain, $stuname, $v_flag) = @_; + my $version_parts = join('|',@$v_flag); my $parts = join('|', @$parts_graded); my $portfolio_root = &Apache::loncommon::propath($domain, $stuname). '/userfiles/portfolio'; - foreach my $key(keys %$record) { - if ($key =~ /^resource\.($parts)\./ && $key =~ /\.portfiles$/) { + 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 $key",@portfiles); foreach my $file (@portfiles) { + &Apache::lonnet::unmark_as_readonly($domain,$stuname,[$symb,$env{'request.course.id'}],$file); my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*$)/); my $version = 0; my @answer_file_parts = split(/\./, $answer_file); @@ -2211,21 +2369,22 @@ sub version_portfiles { } } $version++; - my $home_server = &Apache::lonnet::homeserver($stuname,$domain,undef); - $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stuname/$directory$answer_file"); - # $env{'form.copy.filename'}=''; - my $copy_result = &Apache::lonnet::finishuserfileupload($stuname,$domain,$home_server,'copy', + $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,'copy', '/portfolio'.$directory.$answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]); - &Apache::lonnet::logthis('copy result is '.$copy_result); - &Apache::lonnet::logthis('answer file is '.$answer_file. - ' becomes '.$answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]); - &Apache::lonnet::logthis('from dir list is '.$file_names[0].' has '.@file_name_parts.' parts'); + push(@v_portfiles, $directory.$answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]); + &Apache::lonnet::mark_as_readonly($domain,$stuname, + ['/portfolio'.$directory.$answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]], + [$symb,$env{'request.course.id'},'graded']); + } } - &Apache::lonnet::logthis('found key portfiles '.$key); - &Apache::lonnet::logthis('found value portfiles '.$$record{$key}); + $$record{$key} = join(',',@v_portfiles); } } - + return 'ok'; } @@ -2278,6 +2437,7 @@ sub viewgrades_js { } for (i=0;i'.$ctr."
'.'
'.''."\n". @@ -2493,11 +2658,13 @@ sub viewgrades { ''. '\n"; my (@parts) = sort(&getpartlist($url,$symb)); + my @partids = (); foreach my $part (@parts) { my $display=&Apache::lonnet::metadata($url,$part.'.display'); $display =~ s|^Number of Attempts|Tries
|; # makes the column narrower if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } my ($partid) = &split_part_type($part); + push(@partids, $partid); my $display_part=&get_display_part($partid,$url,$symb); if ($display =~ /^Partial Credit Factor/) { $result.=''; + 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 my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); my $ctr = 0; - foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + foreach (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } (keys(%$fullname))) { $ctr++; $result.=&viewstudentgrade($url,$symb,$env{'request.course.id'}, - $_,$$fullname{$_},\@parts,\%weight,$ctr); + $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets); } $result.='
 No. '.&nameUserString('header')."Score Part: '.$display_part. @@ -2511,14 +2678,23 @@ sub viewgrades { } $result.='
'; $result.=''."\n"; @@ -2535,20 +2711,36 @@ sub viewgrades { #--- call by previous routine to display each student sub viewstudentgrade { - my ($url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr) = @_; + 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".$ctr.'  '. ''.$fullname.' '. '('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')'."\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.=''; + $result.=''; + my ($aggtries,$totaltries); + unless (exists($aggregates{$part})) { + $totaltries = $record{'resource.'.$part.'.tries'}; + + $aggtries = $totaltries; + if ($$last_resets{$part}) { + $aggtries = &get_num_tries(\%record,$$last_resets{$part}, + $part); + } + $result.=''."\n"; + $result.=''."\n"; + $aggregates{$part} = 1; + } if ($type eq 'awarded') { my $pts = $score eq '' ? '' : $score*$$weight{$part}; $result.='Not allowed to modify student"; next; } + my %aggregate = (); + my $aggregateflag = 0; + $user=~s/:/_/; # colon doen't work in javascript for names foreach (@partid) { my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'}; my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1); my $old_part = $old_aw eq '' ? '' : $old_part_pcr; my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; - my $awarded = $env{'form.GD_'.$user.'_'.$_.'_awarded'}; my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1); my $partial = $awarded eq '' ? '' : $pcr; @@ -2683,14 +2875,22 @@ sub editgrades { my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'}; $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused')); + $newrecord{'resource.'.$_.'.regrader'}= + "$env{'user.name'}:$env{'user.domain'}"; if ($dropMenu eq 'reset status' && $old_score ne '') { # ignore if no previous attempts => nothing to reset - $newrecord{'resource.'.$_.'.tries'} = 0; + $newrecord{'resource.'.$_.'.tries'} = ''; $newrecord{'resource.'.$_.'.solved'} = ''; $newrecord{'resource.'.$_.'.award'} = ''; - $newrecord{'resource.'.$_.'.awarded'} = 0; - $newrecord{'resource.'.$_.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; + $newrecord{'resource.'.$_.'.awarded'} = ''; $updateflag = 1; + if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) { + my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'}; + my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'}; + my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'}; + &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus); + $aggregateflag = 1; + } } elsif (!($old_part eq $partial && $old_score eq $score)) { $updateflag = 1; $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; @@ -2730,6 +2930,11 @@ sub editgrades { $noupdate.=' '.$noupdateCtr.' '.$line; $noupdateCtr++; } + if ($aggregateflag) { + &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + } } if ($noupdate) { # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; @@ -2914,10 +3119,7 @@ sub csvuploadmap_footer { ENDPICK } -sub upcsvScores_form { - my ($request) = shift; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} +sub checkforfile_js { my $result =< function checkUpload(formname) { @@ -2929,6 +3131,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; @@ -2948,7 +3158,7 @@ CSVFORMJS $upfile_select
-'."\n"; $result.='
'. ''. @@ -5217,6 +5508,9 @@ GRADINGMENUJS $result.=''. ' access times.'."\n"; + $result.=''. + ' saved CODEs.'."\n"; $result.=''."\n". ''."\n". @@ -5224,10 +5518,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 { @@ -5276,20 +5592,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'}) {