- Submissions: - last sub only - last sub & parts info - all details - - - - - -ENDTABLEST - if ($ENV{'form.url'}) { - $request->print(''."\n"); - } - if ($ENV{'form.symb'}) { - $request->print(''."\n"); - } - $request->print(''."\n"); +sub reset_caches { + &reset_analyze_cache(); + &reset_perm(); +} - my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($getsec,'0'); +{ + my %analyze_cache; + my %analyze_cache_formkeys; - $result='
'.
- '
|
LON-CAPA User Error
'."\n"); - $request->print('Reason: '.$reason.'
'."\n"); - $request->print('Step: '.($step ne '' ? $step : 'Use your browser back button to correct') - .'
'."\n"); - return ''; +#--- Clean response type for display +#--- Currently filters option/rank/radiobutton/match/essay/Task +# response types only. +sub cleanRecord { + my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, + $uname,$udom) = @_; + my $grayFont = ''; + if ($response =~ /^(option|rank)$/) { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my ($toprow,$bottomrow); + foreach my $foil (@$order) { + if ($grading{$foil} == 1) { + $toprow.='
'; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($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); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. + $grayFont.$bottomrow.'
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { + if (exists($answer{$foil})) { + if ($foil eq $correct) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''. + ' '.$grayFont.&mt('Item ID').' '. + $middlerow.''.' '.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'; + } elsif ($response eq 'essay') { + if (! exists ($env{'form.'.$symb})) { + my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $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 =~ s-\n-'. + '
'. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. + $grayFont.$bottomrow.'
-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; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
',($version,@matches)); + + + } else { + my $result = + '
' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'
'; + + $result .= '- ';
+ my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/,
+ keys(%{$record}));
+ foreach my $grade (sort(@grade)) {
+ my ($dim) = ($grade =~/[.]([^.]+)[.]status$/);
+ $result.= '
- '.&mt("Dimension: [_1], status [_2] ", + $dim, $record->{$grade}). + ' '; + } + $result.='
"; - my $result =''; - my ($stuname,$domain) = split(/:/,$student); - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname); - my %newrecord; - - foreach my $part (@parts) { - my ($temp,$part,$type)=split(/_/,$part); - my $oldscore=$record{"resource.$part.$type"}; - my $newscore=$ENV{"form.GRADE.$student.$part.$type"}; - print "old=$oldscore:new=$newscore:
"; - if ($type eq 'solved') { - my $update=0; - if ($newscore eq 'nothing' ) { - if ($oldscore ne '') { - $update=1; - $newscore = ''; - } - } elsif ($oldscore !~ m/^$newscore/) { - $update=1; - $result.="Updating $stuname to $newscore
\n"; - if ($newscore eq 'correct') { $newscore = 'correct_by_override'; } - if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; } - if ($newscore eq 'excused') { $newscore = 'excused'; } - if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; } -# if ($newscore eq 'partial') { $newscore = 'correct_partially_by_override'; } - } else { - #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
\n"; - } - if ($update) { $newrecord{"resource.$part.$type"}=$newscore; } - } else { - if ($oldscore ne $newscore) { - $newrecord{"resource.$part.$type"}=$newscore; - $result.="Updating $student"."'s status for $part.$type to $newscore
\n"; - } else { - #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
\n"; - } +#--- Retrieve the grade status of a student for all the parts +sub student_gradeStatus { + my ($symb,$udom,$uname,$partlist) = @_; + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); + my %partstatus = (); + foreach (@$partlist) { + my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); + $status = 'nothing' if ($status eq ''); + $partstatus{$_} = $status; + my $subkey = "resource.$_.submitted_by"; + $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); } - } - if ( scalar(keys(%newrecord)) > 0 ) { - $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; -# &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname); + return %partstatus; +} - $result.="Stored away ".scalar(keys(%newrecord))." elements.
\n"; - } - return $result; +# hidden form and javascript that calls the form +# Use by verifyscript and viewgrades +# Shows a student's view of problem and submission +sub jscriptNform { + my ($symb) = @_; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + my $jscript=''."\n"; + $jscript.= ''."\n"; + return $jscript; } -# -# --------------------------- show submissions of a student, option to grade -------- -sub submission { - my ($request,$counter,$total) = @_; - (my $url=$ENV{'form.url'})=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - if ($ENV{'form.student'} eq '') { &moreinfo($request,'Need student login id'); return ''; } - my ($uname,$udom) = &finduser($ENV{'form.student'}); - if ($uname eq '') { &moreinfo($request,'Unable to find student'); return ''; } - - my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); - - # header info - if ($counter == 0) { - &sub_page_js($request); - $request->print('
Submission Record
'. - ' Resource: '.$url.''); - - # option to display problem, only once else it cause problems with the form later - # since the problem has a form. - if ($ENV{'form.vProb'} eq 'yes') { - my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $ENV{'request.course.id'}); - my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, - $ENV{'request.course.id'}); - my $result.='';
- $result.='
|
'; - $request->print($result); - } - # kwclr is the only variable that is guaranteed to be non blank if this subroutine has been called once. - my %keyhash = (); - if ($ENV{'form.kwclr'} eq '') { - %keyhash = &Apache::lonnet::dump('nohist_handgrade', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - - my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; - $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; - $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; - $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; - $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; - $ENV{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? - $keyhash{$symb.'_subject'} : &Apache::lonnet::metadata($url,'title'); - $ENV{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; +# Given the score (as a number [0-1] and the weight) what is the final +# point value? This function will round to the nearest tenth, third, +# or quarter if one of those is within the tolerance of .00001. +sub compute_points { + my ($score, $weight) = @_; + + my $tolerance = .00001; + my $points = $score * $weight; + + # Check for nearness to 1/x. + my $check_for_nearness = sub { + my ($factor) = @_; + my $num = ($points * $factor) + $tolerance; + my $floored_num = floor($num); + if ($num - $floored_num < 2 * $tolerance * $factor) { + return $floored_num / $factor; + } + return $points; + }; - } - $request->print(''; - $request->print($endform); - } +# ignore empty submissions (occuring when only files are sent) - return ''; + unless ($uessay=~/\w+/) { return ''; } + +# these will be returned. Do not care if not at least 50 percent similar + my $limit=0.6; + my $sname=''; + my $sdom=''; + my $scrsid=''; + my $sessay=''; +# go through all essays ... + foreach my $tkey (keys(%$old_essays)) { + my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); +# ... except the same student + next if (($tname eq $uname) && ($tdom eq $udom)); + my $tessay=$old_essays->{$tkey}; + $tessay=~s/\W+/ /gs; +# String similarity gives up if not even limit + my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); +# Found one + if ($tsimilar>$limit) { + $limit=$tsimilar; + $sname=$tname; + $sdom=$tdom; + $scrsid=$tcrsid; + $sessay=$old_essays->{$tkey}; + } + } + if ($limit>0.6) { + return ($sname,$sdom,$scrsid,$sessay,$limit); + } else { + return ('','','','',0); + } } -sub get_last_submission { - my ($symb,$username,$domain,$course)=@_; - if ($symb) { - my (@string,$timestamp); - my (%returnhash)=&Apache::lonnet::restore($symb,$course,$domain,$username); - if ($returnhash{'version'}) { - my %lasthash=(); - my ($version); - for ($version=1;$version<=$returnhash{'version'};$version++) { - foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { - $lasthash{$_}=$returnhash{$version.':'.$_}; - } - } - foreach ((keys %lasthash)) { - if ($_ =~ /\.submission$/) {push @string, (join(':',$_,$lasthash{$_}))} - if ($_ =~ /timestamp/) {$timestamp = scalar(localtime($lasthash{$_}))}; - } - } - @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; - return \@string,\$timestamp; - } -} +#------------------------------------------------------------------- -sub keywords_highlight { - my $string = shift; - my $size = $ENV{'form.kwsize'} eq '0' ? '' : 'size='.$ENV{'form.kwsize'}; - my $styleon = $ENV{'form.kwstyle'} eq '' ? '' : $ENV{'form.kwstyle'}; - (my $styleoff = $styleon) =~ s/\$styleon$_$styleoff\<\/font\>/gi; - } - return $string; +#------------------------------------ Receipt Verification Routines +# +#--- Check whether a receipt number is valid.--- +sub verifyreceipt { + my $request = shift; + + my $courseid = $env{'request.course.id'}; + my $receipt = &Apache::lonnet::recprefix($courseid).'-'. + $env{'form.receipt'}; + $receipt =~ s/[^\-\d]//g; + my ($symb) = &get_symb($request); + + my $title.= + '
'. + &mt('Verifying Receipt No. [_1]',$receipt). + '
'."\n". + ''.&mt('Resource: [_1]',$env{'form.probTitle'}). + '
'."\n"; + + my ($string,$contents,$matches) = ('','',0); + my (undef,undef,$fullname) = &getclasslist('all','0'); + + my $receiptparts=0; + if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || + $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } + my $parts=['0']; + if ($receiptparts) { + my $res_error; + ($parts)=&response_type($symb,\$res_error); + if ($res_error) { + return &navmap_errormsg(); + } + } + + my $header = + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + '' + .&mt('No match found for the above receipt number.') + .'
'; + } else { + $string = &jscriptNform($symb).$title. + ''. + &mt('The above receipt number matches the following [quant,_1,student].',$matches). + '
'. + $header. + $contents. + &Apache::loncommon::end_data_table()."\n"; + } + return $string.&show_grading_menu_form($symb); } -sub processHandGrade { - my ($request) = shift; - my $url = $ENV{'form.url'}; - my $symb = $ENV{'form.symb'}; - my $button = $ENV{'form.gradeOpt'}; - my $ngrade = $ENV{'form.NCT'}; - my $ntstu = $ENV{'form.NTSTU'}; - - my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; - my %keyhash = (); - $ENV{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; - $ENV{'form.keywords'} =~ s/^\s+|\s+$//; - $keyhash{$symb.'_keywords'} = $ENV{'form.keywords'}; - $keyhash{$symb.'_subject'} = $ENV{'form.msgsub'}; - $keyhash{$loginuser.'_kwclr'} = $ENV{'form.kwclr'}; - $keyhash{$loginuser.'_kwsize'} = $ENV{'form.kwsize'}; - $keyhash{$loginuser.'_kwstyle'} = $ENV{'form.kwstyle'}; - - my ($ctr,$idx) = (1,1); - while ($ctr <= $ENV{'form.savemsgN'}) { - if ($ENV{'form.savemsg'.$ctr} ne '') { - $keyhash{$symb.'_savemsg'.$idx} = $ENV{'form.savemsg'.$ctr}; - $idx++; - } - $ctr++; - } - $ctr = 0; - while ($ctr < $ngrade) { - if ($ENV{'form.newmsg'.$ctr} ne '') { - $keyhash{$symb.'_savemsg'.$idx} = $ENV{'form.newmsg'.$ctr}; - $ENV{'form.savemsg'.$idx} = $ENV{'form.newmsg'.$ctr}; - $idx++; - } - $ctr++; - } - $ENV{'form.savemsgN'} = --$idx; - $keyhash{$symb.'_savemsgN'} = $ENV{'form.savemsgN'}; - my $putresult = &Apache::lonnet::put - ('nohist_handgrade',\%keyhash, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - - if ($ENV{'form.refresh'} eq 'on') { - my $ctr = 0; - while ($ctr < $ntstu) { - ($ENV{'form.student'},my $udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); - &submission($request,$ctr,$ntstu-1); - $ctr++; - } - return ''; - } +#--- This is called by a number of programs. +#--- Called from the Grading Menu - View/Grade an individual student +#--- Also called directly when one clicks on the subm button +# on the problem page. +sub listStudents { + my ($request) = shift; - if ($button eq 'Save & Next') { - my $ctr = 0; - while ($ctr < $ngrade) { - my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); - my ($errorflg) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr); - return '' if ($errorflg eq 'error'); - - my $includemsg = $ENV{'form.includemsg'.$ctr}; - my ($subject,$message,$msgstatus) = ('','',''); - if ($includemsg =~ /savemsg|new$ctr/) { - $subject = $ENV{'form.msgsub'} if ($includemsg =~ /^msgsub/); - my (@msgnum) = split(/,/,$includemsg); - foreach (@msgnum) { - $message.=$ENV{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); - } - $message =~ s/\s+/ /g; - $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom,$ENV{'form.msgsub'},$message); - } - if ($ENV{'form.collaborator'.$ctr}) { - my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr}); - foreach (@collaborators) { - &saveHandGrade($request,$url,$symb,$_,$udom,$ctr); - if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom,$ENV{'form.msgsub'},$message); - } - } - } - $ctr++; - } - } - my $firststu = $ENV{'form.unamedom0'}; - my $laststu = $ENV{'form.unamedom'.($ngrade-1)}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; + my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; + $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? + &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; + + my $result='' + .&mt("$viewgrade Submissions for a Student or a Group of Students") + .'
'; + + my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); + + my %lt = &Apache::lonlocal::texthash ( + 'multiple' => 'Please select a student or group of students before clicking on the Next button.', + 'single' => 'Please select the student before clicking on the Next button.', + ); + $request->print(<Select a Grading Method
'; - $result.='| Resource: '.$url.' | ||
| Part id: '.$_.' | '. - 'Type: '.$responsetype.' | '. - 'Handgrade: '.$handgrade.' |
'; - $result.=&upcsvScores_form($symb,$url).'
'; - $result.=&viewGradeaStu_form($symb,$url,$resptype,$hdgrade).'
'; - $result.=&verifyReceipt_form($symb,$url).'
'; - $result.=&view_classlist_form($symb,$url); - - return $result; -} - -sub view_classlist_form { - my ($symb,$url)=@_; - my $result.='
'."\n";
- $result.='
|
| '.$_.' | '.$classlist{$_}.' |
'."\n";
- $result.='
|
'."\n";
- $result.='
|
'."\n";
- $result.='
|
'."\n";
- $result.='
|
'.&mt('There are no students currently enrolled.').''; + } else { + my $submissions='submissions'; + if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } + if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } + if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } + $gradeTable='
'. + &mt('No '.$submissions.' found for this resource for any students. ([_1] students checked for '.$submissions.')', + $num_students). + '
'; + } + } elsif ($ctr == 1) { + $gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/; + } + $gradeTable.=&show_grading_menu_form($symb); + $request->print($gradeTable); + return ''; } -sub viewgrades { - my ($request) = @_; - my $result=''; +#---- Called from the listStudents routine - #get resource reference - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - #get classlist - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - #print "Found $cdom:$cnum
"; - my ($classlist) = &getclasslist('all','0'); - my $headerclr = '"#ddffff"'; - my $cellclr = '"#ffffdd"'; - - #get list of parts for this problem - my (@parts) = sort(&getpartlist($url)); - - $request->print ("
Manual Grading
"); - - #start the form - $result = ''; - $result.=&show_grading_menu_form($symb,$url); - return $result; -} +sub check_script { + my ($form, $type)=@_; + my $chkallscript=''."\n"; + return $chkallscript; } +sub check_buttons { + my $buttons.=''; + $buttons.=' '; + $buttons.=''; + $buttons.=' '; + return $buttons; +} + +# Displays the submissions for one student or a group of students +sub processGroup { + my ($request) = shift; + my $ctr = 0; + my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); + my $total = scalar(@stuchecked)-1; + + foreach my $student (@stuchecked) { + my ($uname,$udom,$fullname) = split(/:/,$student); + $env{'form.student'} = $uname; + $env{'form.userdom'} = $udom; + $env{'form.fullname'} = $fullname; + &submission($request,$ctr,$total); + $ctr++; + } + return ''; +} + +#------------------------------------------------------------------------------------ +# +#-------------------------- Next few routines handles grading by student, essentially +# handles essay response type problem/part +# +#--- Javascript to handle the submission page functionality --- sub sub_page_js { - my $request = shift; - $request->print(<.'/check.gif').'){kind=small}
';
+ my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
+ my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)')
+ : ''.&mt('problem weight assigned by computer').'';
+ $wgt = ($wgt > 0 ? $wgt : '1');
+ my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
+ '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
+ my $result=''."\n";
+ my $display_part= &get_display_part($partid,$symb);
+ my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
+ [$partid]);
+ my $aggtries = $$record{'resource.'.$partid.'.tries'};
+ if ($last_resets{$partid}) {
+ $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
+ }
+ $result.=&Apache::loncommon::start_data_table_row();
+ my $ctr = 0;
+ my $thisweight = 0;
+ my $increment = &get_increment();
+
+ my $radio.='| \n"; + $radio.=(($ctr+1)%10 == 0 ? ' |
'; + $result.='('.&mt('File will be uploaded when you click on Save & Next below.').')
'; + $file_counter++; + } + } + } + return $result; +} + +sub show_problem { + my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_; + my $rendered; + my %form = ((ref($form) eq 'HASH')? %{$form} : ()); + &Apache::lonxml::remember_problem_counter(); + if ($mode eq 'both' or $mode eq 'text') { + $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, + $env{'request.course.id'}, + undef,\%form); + } + if ($removeform) { + $rendered=~s|
'.
+ &mt('View of the problem').
+ '
'.
+ $rendered.
+ '
';
+ $companswer=
+ ''.
+ &mt('Correct answer').
+ '
'.
+ $companswer.
+ '
';
+ my $result;
+ if ($mode eq 'both') {
+ $result=$rendered.$companswer;
+ } elsif ($mode eq 'text') {
+ $result=$rendered;
+ } elsif ($mode eq 'answer') {
+ $result=$companswer;
+ }
+ $result=''.$result.'
';
+ return $result;
+}
+
+sub files_exist {
+ my ($r, $symb) = @_;
+ my @students = &Apache::loncommon::get_env_multiple('form.stuinfo');
+
+ foreach my $student (@students) {
+ my ($uname,$udom,$fullname) = split(/:/,$student);
+ my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $udom,$uname);
+ my ($string,$timestamp)= &get_last_submission(\%record);
+ foreach my $submission (@$string) {
+ my ($partid,$respid) =
+ ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
+ my $files=&get_submitted_files($udom,$uname,$partid,$respid,
+ \%record);
+ return 1 if (@$files);
+ }
+ }
+ return 0;
+}
+
+sub download_all_link {
+ my ($r,$symb) = @_;
+ my $all_students =
+ join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo'));
+
+ my $parts =
+ join("\n",&Apache::loncommon::get_env_multiple('form.vPart'));
+
+ my $identifier = &Apache::loncommon::get_cgi_id();
+ &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students,
+ 'cgi.'.$identifier.'.symb' => $symb,
+ 'cgi.'.$identifier.'.parts' => $parts,});
+ $r->print(''.
+ &mt('Download All Submitted Documents').'');
+ return
+}
+
+sub build_section_inputs {
+ my $section_inputs;
+ if ($env{'form.section'} eq '') {
+ $section_inputs .= ''."\n";
+ } else {
+ my @sections = &Apache::loncommon::get_env_multiple('form.section');
+ foreach my $section (@sections) {
+ $section_inputs .= ''."\n";
+ }
+ }
+ return $section_inputs;
+}
+
+# --------------------------- show submissions of a student, option to grade
+sub submission {
+ my ($request,$counter,$total) = @_;
+ my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'});
+ $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student?
+ my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
+ $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';
+ my $symb = &get_symb($request);
+ if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
+
+ if (!&canview($usec)) {
+ $request->print('Unable to view requested student.('.
+ $uname.':'.$udom.' in section '.$usec.' in course id '.
+ $env{'request.course.id'}.')');
+ $request->print(&show_grading_menu_form($symb));
+ return;
+ }
+
+ if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; }
+ if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; }
+ if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; }
+ my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
+ my $checkIcon = '.
+ '/check.gif){kind=small}
';
+
+ my %old_essays;
+ # header info
+ if ($counter == 0) {
+ &sub_page_js($request);
+ &sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes');
+ $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ?
+ &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
+ if ($env{'form.handgrade'} eq 'yes' && &files_exist($request, $symb)) {
+ &download_all_link($request, $symb);
+ }
+ $request->print(''.&mt('Submission Record').'
'."\n". + ''.&mt('Resource: [_1]',$env{'form.probTitle'}).'
'."\n"); + + # option to display problem, only once else it cause problems + # with the form later since the problem has a form. + if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') { + my $mode; + if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') { + $mode='both'; + } elsif ($env{'form.vProb'} eq 'yes') { + $mode='text'; + } elsif ($env{'form.vAns'} eq 'yes') { + $mode='answer'; + } + &Apache::lonxml::clear_problem_counter(); + $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); + } + + # kwclr is the only variable that is guaranteed to be non blank + # if this subroutine has been called once. + my %keyhash = (); + if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') { + %keyhash = &Apache::lonnet::dump('nohist_handgrade', + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; + $env{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? + $keyhash{$symb.'_subject'} : $env{'form.probTitle'}; + $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; + } + my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'}; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + $request->print(''; + $endform.=&show_grading_menu_form($symb); + $request->print($endform); + } + return ''; +} + +sub check_collaborators { + my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_; + my ($result,@col_fullnames); + my ($classlist,undef,$fullname) = &getclasslist('all','0'); + foreach my $part (keys(%$handgrade)) { + my $ncol = &Apache::lonnet::EXT('resource.'.$part. + '.maxcollaborators', + $symb,$udom,$uname); + next if ($ncol <= 0); + $part =~ s/\_/\./g; + next if ($record->{'resource.'.$part.'.collaborators'} eq ''); + my (@good_collaborators, @bad_collaborators); + foreach my $possible_collaborator + (split(/,?\s+/,$record->{'resource.'.$part.'.collaborators'})) { + $possible_collaborator =~ s/[\$\^\(\)]//g; + next if ($possible_collaborator eq ''); + my ($co_name,$co_dom) = split(/\@|:/,$possible_collaborator); + $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i); + next if ($co_name eq $uname && $co_dom eq $udom); + # Doing this grep allows 'fuzzy' specification + my @matches = grep(/^\Q$co_name\E:\Q$co_dom\E$/i, + keys(%$classlist)); + if (! scalar(@matches)) { + push(@bad_collaborators, $possible_collaborator); + } else { + push(@good_collaborators, @matches); + } + } + if (scalar(@good_collaborators) != 0) { + $result.=''.&mt('Collaborators: '); + foreach my $name (@good_collaborators) { + my ($lastname,$givenn) = split(/,/,$$fullname{$name}); + push(@col_fullnames, $givenn.' '.$lastname); + $result.=$fullname->{$name}.' '; + } + $result.='
'."\n"; + my ($part)=split(/\./,$part); + $result.=''. + "\n"; + } + if (scalar(@bad_collaborators) > 0) { + $result.='
';
+ $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators));
+ $result .= '
';
+ }
+ if (scalar(@bad_collaborators > $ncol)) {
+ $result .= '';
+ $result .= &mt('This student has submitted too many '.
+ 'collaborators. Maximum is [_1].',$ncol);
+ $result .= '
';
+ }
+ }
+ return ($result,$fullname,\@col_fullnames);
+}
+
+#--- Retrieve the last submission for all the parts
+sub get_last_submission {
+ my ($returnhash)=@_;
+ my (@string,$timestamp);
+ if ($$returnhash{'version'}) {
+ my %lasthash=();
+ my ($version);
+ for ($version=1;$version<=$$returnhash{'version'};$version++) {
+ foreach my $key (sort(split(/\:/,
+ $$returnhash{$version.':keys'}))) {
+ $lasthash{$key}=$$returnhash{$version.':'.$key};
+ $timestamp =
+ &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'});
+ }
+ }
+ foreach my $key (keys(%lasthash)) {
+ next if ($key !~ /\.submission$/);
+
+ my ($partid,$foo) = split(/submission$/,$key);
+ my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?
+ 'Draft Copy ' : '';
+ push(@string, join(':', $key, $draft.$lasthash{$key}));
+ }
+ }
+ if (!@string) {
+ $string[0] =
+ ''.&mt('Nothing submitted - no attempts.').'';
+ }
+ return (\@string,\$timestamp);
+}
+
+#--- High light keywords, with style choosen by user.
+sub keywords_highlight {
+ my $string = shift;
+ my $size = $env{'form.kwsize'} eq '0' ? '' : 'size='.$env{'form.kwsize'};
+ my $styleon = $env{'form.kwstyle'} eq '' ? '' : $env{'form.kwstyle'};
+ (my $styleoff = $styleon) =~ s/\$styleon$keyword$styleoff<\/font>/gi;
+ }
+ return $string;
+}
+
+#--- Called from submission routine
+sub processHandGrade {
+ my ($request) = shift;
+ my $symb = &get_symb($request);
+ my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
+ my $button = $env{'form.gradeOpt'};
+ my $ngrade = $env{'form.NCT'};
+ my $ntstu = $env{'form.NTSTU'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+
+ if ($button eq 'Save & Next') {
+ my $ctr = 0;
+ while ($ctr < $ngrade) {
+ my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr});
+ my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$symb,$uname,$udom,$ctr);
+ if ($errorflag eq 'no_score') {
+ $ctr++;
+ next;
+ }
+ if ($errorflag eq 'not_allowed') {
+ $request->print("Not allowed to modify grades for $uname:$udom");
+ $ctr++;
+ next;
+ }
+ my $includemsg = $env{'form.includemsg'.$ctr};
+ my ($subject,$message,$msgstatus) = ('','','');
+ my $restitle = &Apache::lonnet::gettitle($symb);
+ my ($feedurl,$showsymb) =
+ &get_feedurl_and_symb($symb,$uname,$udom);
+ my $messagetail;
+ if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
+ $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/);
+ unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); }
+ $subject.=' ['.$restitle.']';
+ my (@msgnum) = split(/,/,$includemsg);
+ foreach (@msgnum) {
+ $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne '');
+ }
+ $message =&Apache::lonfeedback::clear_out_html($message);
+ if ($env{'form.withgrades'.$ctr}) {
+ $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt;
+ $messagetail = " for $env{'form.probTitle'}";
+ }
+ $msgstatus =
+ &Apache::lonmsg::user_normal_msg($uname,$udom,$subject,
+ $message.$messagetail,
+ undef,$feedurl,undef,
+ undef,undef,$showsymb,
+ $restitle);
+ $request->print(''.&mt('Sending message to [_1]',$uname.':'.$udom).': '. + $msgstatus); + } + if ($env{'form.collaborator'.$ctr}) { + my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); + foreach my $collabstr (@collabstrs) { + my ($part,@collaborators) = split(/:/,$collabstr); + foreach my $collaborator (@collaborators) { + my ($errorflag,$pts,$wgt) = + &saveHandGrade($request,$symb,$collaborator,$udom,$ctr, + $env{'form.unamedom'.$ctr},$part); + if ($errorflag eq 'not_allowed') { + $request->print("".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom").""); + next; + } elsif ($message ne '') { + my ($baseurl,$showsymb) = + &get_feedurl_and_symb($symb,$collaborator, + $udom); + if ($env{'form.withgrades'.$ctr}) { + $messagetail = " for $env{'form.probTitle'}"; + } + $msgstatus = + &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); + } + } + } + } + $ctr++; + } + } + + if ($env{'form.handgrade'} eq 'yes') { + # Keywords sorted in alphabatical order + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + my %keyhash = (); + $env{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; + $env{'form.keywords'} =~ s/^\s+|\s+$//; + my (@keywords) = sort(split(/\s+/,$env{'form.keywords'})); + $env{'form.keywords'} = join(' ',@keywords); + $keyhash{$symb.'_keywords'} = $env{'form.keywords'}; + $keyhash{$symb.'_subject'} = $env{'form.msgsub'}; + $keyhash{$loginuser.'_kwclr'} = $env{'form.kwclr'}; + $keyhash{$loginuser.'_kwsize'} = $env{'form.kwsize'}; + $keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'}; + + # message center - Order of message gets changed. Blank line is eliminated. + # New messages are saved in env for the next student. + # All messages are saved in nohist_handgrade.db + my ($ctr,$idx) = (1,1); + while ($ctr <= $env{'form.savemsgN'}) { + if ($env{'form.savemsg'.$ctr} ne '') { + $keyhash{$symb.'_savemsg'.$idx} = $env{'form.savemsg'.$ctr}; + $idx++; + } + $ctr++; + } + $ctr = 0; + while ($ctr < $ngrade) { + if ($env{'form.newmsg'.$ctr} ne '') { + $keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr}; + $env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr}; + $idx++; + } + $ctr++; + } + $env{'form.savemsgN'} = --$idx; + $keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'}; + my $putresult = &Apache::lonnet::put + ('nohist_handgrade',\%keyhash,$cdom,$cnum); + } + # Called by Save & Refresh from Highlight Attribute Window + my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); + if ($env{'form.refresh'} eq 'on') { + my ($ctr,$total) = (0,0); + while ($ctr < $ngrade) { + $total++ if $env{'form.unamedom'.$ctr} ne ''; + $ctr++; + } + $env{'form.NTSTU'}=$ngrade; + $ctr = 0; + while ($ctr < $total) { + my $processUser = $env{'form.unamedom'.$ctr}; + ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); + $env{'form.fullname'} = $$fullname{$processUser}; + &submission($request,$ctr,$total-1); + $ctr++; + } + return ''; + } + +# Go directly to grade student - from submission or link from chart page + if ($button eq 'Grade Student') { + (undef,undef,$env{'form.handgrade'},undef,undef) = &showResourceInfo($symb); + my $processUser = $env{'form.unamedom'.$env{'form.studentNo'}}; + ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); + $env{'form.fullname'} = $$fullname{$processUser}; + &submission($request,0,0); + return ''; + } + + # Get the next/previous one or group of students + my $firststu = $env{'form.unamedom0'}; + my $laststu = $env{'form.unamedom'.($ngrade-1)}; + my $ctr = 2; + while ($laststu eq '') { + $laststu = $env{'form.unamedom'.($ngrade-$ctr)}; + $ctr++; + $laststu = $firststu if ($ctr > $ngrade); + } + + my (@parsedlist,@nextlist); + my ($nextflg) = 0; + foreach my $item (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,$item); + } + $nextflg = 1 if ($item eq $laststu); + if ($button eq 'Previous') { + last if ($item eq $firststu); + push(@parsedlist,$item); + } + } + $ctr = 0; + @parsedlist = reverse @parsedlist if ($button eq 'Previous'); + my $res_error; + my ($partlist) = &response_type($symb,\$res_error); + if ($res_error) { + $request->print(&navmap_errormsg()); + return; + } + foreach my $student (@parsedlist) { + my $submitonly=$env{'form.submitonly'}; + my ($uname,$udom) = split(/:/,$student); + + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + next if (!defined($queue_status{'gradingqueue'})); + } + + if ($submitonly =~ /^(yes|graded|incorrect)$/) { +# my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); + my %status=&student_gradeStatus($symb,$udom,$uname,$partlist); + my $submitted = 0; + my $ungraded = 0; + my $incorrect = 0; + foreach my $item (keys(%status)) { + $submitted = 1 if ($status{$item} ne 'nothing'); + $ungraded = 1 if ($status{$item} =~ /^ungraded/); + $incorrect = 1 if ($status{$item} =~ /^incorrect/); + my ($foo,$partid,$foo1) = split(/\./,$item); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + } + } + next if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + next if (!$ungraded && ($submitonly eq 'graded')); + next if (!$incorrect && $submitonly eq 'incorrect'); + } + push(@nextlist,$student) if ($ctr < $ntstu); + last if ($ctr == $ntstu); + $ctr++; + } + + $ctr = 0; + my $total = scalar(@nextlist)-1; + + foreach (sort(@nextlist)) { + my ($uname,$udom,$submitter) = split(/:/); + $env{'form.student'} = $uname; + $env{'form.userdom'} = $udom; + $env{'form.fullname'} = $$fullname{$_}; + &submission($request,$ctr,$total); + $ctr++; + } + if ($total < 0) { + my $the_end = '
'.&mt('LON-CAPA User Message').'
'."\n"; + $the_end.=&mt('Message: No more students for this section or class.').'
'."\n"; + $the_end.=&mt('Click on the button below to return to the grading menu.').'
'."\n"; + $the_end.=&show_grading_menu_form($symb); + $request->print($the_end); + } + return ''; +} + +#---- Save the score and award for each student, if changed +sub saveHandGrade { + my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; + my @version_parts; + my $usec = &Apache::lonnet::getsection($domain,$stuname, + $env{'request.course.id'}); + if (!&canmodify($usec)) { return('not_allowed'); } + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); + my @parts_graded; + my %newrecord = (); + my ($pts,$wgt) = ('',''); + my %aggregate = (); + my $aggregateflag = 0; + my @parts = split(/:/,$env{'form.partlist'.$newflg}); + foreach my $new_part (@parts) { + #collaborator ($submi may vary for different parts + if ($submitter && $new_part ne $part) { next; } + my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; + if ($dropMenu eq 'excused') { + 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.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; + } + } elsif ($dropMenu eq 'reset status' + && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts + foreach my $key (keys(%record)) { + if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } + } + $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_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); + $aggregateflag = 1; + } + } elsif ($dropMenu 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.'_'.$new_part} eq '' ? 1 : + $env{'form.WGT'.$newflg.'_'.$new_part}; + my $partial= $pts/$wgt; + if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { + #do not update score for part if not changed. + &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); + next; + } else { + push(@parts_graded,$new_part); + } + if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { + $newrecord{'resource.'.$new_part.'.awarded'} = $partial; + } + my $reckey = 'resource.'.$new_part.'.solved'; + if ($partial == 0) { + if ($record{$reckey} ne 'incorrect_by_override') { + $newrecord{$reckey} = 'incorrect_by_override'; + } + } else { + if ($record{$reckey} ne 'correct_by_override') { + $newrecord{$reckey} = 'correct_by_override'; + } + } + if ($submitter && + ($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) { + $newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter; + } + $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' || + $dropMenu eq 'reset status') + { + push(@version_parts,$new_part); + } + } + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + + if (%newrecord) { + if (@version_parts) { + my @changed_keys = &version_portfiles(\%record, \@parts_graded, + $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts); + @newrecord{@changed_keys} = @record{@changed_keys}; + foreach my $new_part (@version_parts) { + &handback_files($request,$symb,$stuname,$domain,$newflg, + $new_part,\%newrecord); + } + } + &Apache::lonnet::cstore(\%newrecord,$symb, + $env{'request.course.id'},$domain,$stuname); + &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb, + $cdom,$cnum,$domain,$stuname); + } + if ($aggregateflag) { + &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, + $cdom,$cnum); + } + return ('',$pts,$wgt); +} + +sub check_and_remove_from_queue { + my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_; + my @ungraded_parts; + foreach my $part (@{$parts}) { + if ( $record->{ 'resource.'.$part.'.awarded'} eq '' + && $record->{ 'resource.'.$part.'.solved' } ne 'excused' + && $newrecord->{'resource.'.$part.'.awarded'} eq '' + && $newrecord->{'resource.'.$part.'.solved' } ne 'excused' + ) { + push(@ungraded_parts, $part); + } + } + if ( !@ungraded_parts ) { + &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom, + $cnum,$domain,$stuname); + } +} + +sub handback_files { + my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; + my $portfolio_root = '/userfiles/portfolio'; + my $res_error; + my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); + if ($res_error) { + $request->print('
'.&navmap_errormsg().'
'); + return; + } + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($part_id,$resp_id) = @{ $part_response_id }; + my $part_resp = join('_',@{ $part_response_id }); + if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) { + # if multiple files are uploaded names will be 'returndoc2','returndoc3' + my $file_counter = 1; + my $file_msg; + while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) { + my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'}; + my ($directory,$answer_file) = + ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/); + my ($answer_name,$answer_ver,$answer_ext) = + &file_name_version_ext($answer_file); + my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); + my $getpropath = 1; + my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath); + my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); + # fix file name + my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); + my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, + $newflg.'_'.$part_resp.'_returndoc'.$file_counter, + $save_file_name); + if ($result !~ m|^/uploaded/|) { + $request->print('
'. + &mt('An error occurred ([_1]) while trying to upload [_2].', + $result,$newflg.'_'.$part_resp.'_returndoc'.$file_counter). + ''); + } else { + # mark the file as read only + my @files = ($save_file_name); + my @what = ($symb,$env{'request.course.id'},'handback'); + &Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what); + if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) { + $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; + } + $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; + $file_msg.= "\n".'
'.$save_file_name."
"; + + } + $request->print("
".$fname." will be the uploaded file name"); + $request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter}); + $file_counter++; + } + my $subject = "File Handed Back by Instructor "; + my $message = "A file has been returned that was originally submitted in reponse to:
"; + $message .= "".&Apache::lonnet::gettitle($symb)."
"; + $message .= ' The returned file(s) are named: '. $file_msg; + $message .= " and can be found in your portfolio space."; + my ($feedurl,$showsymb) = + &get_feedurl_and_symb($symb,$domain,$stuname); + my $restitle = &Apache::lonnet::gettitle($symb); + my $msgstatus = + &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject. + ' (File Returned) ['.$restitle.']',$message,undef, + $feedurl,undef,undef,undef,$showsymb,$restitle); + } + } + return; +} + +sub get_feedurl_and_symb { + my ($symb,$uname,$udom) = @_; + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + $url = &Apache::lonnet::clutter($url); + my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', + $symb,$udom,$uname); + if ($encrypturl =~ /^yes$/i) { + &Apache::lonenc::encrypted(\$url,1); + &Apache::lonenc::encrypted(\$symb,1); + } + return ($url,$symb); +} + +sub get_submitted_files { + my ($udom,$uname,$partid,$respid,$record) = @_; + my @files; + if ($$record{"resource.$partid.$respid.portfiles"}) { + my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; + foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) { + push(@files,$file_url.$file); + } + } + if ($$record{"resource.$partid.$respid.uploadedurl"}) { + push(@files,$$record{"resource.$partid.$respid.uploadedurl"}); + } + return (\@files); +} + +# ----------- 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, $stu_name, $v_flag) = @_; + my $version_parts = join('|',@$v_flag); + my @returned_keys; + my $parts = join('|', @$parts_graded); + my $portfolio_root = '/userfiles/portfolio'; + foreach my $key (keys(%$record)) { + my $new_portfiles; + if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { + my @versioned_portfiles; + my @portfiles = split(/\s*,\s*/,$$record{$key}); + foreach my $file (@portfiles) { + &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file); + my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); + my ($answer_name,$answer_ver,$answer_ext) = + &file_name_version_ext($answer_file); + my $getpropath = 1; + my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath); + my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); + my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); + if ($new_answer ne 'problem getting file') { + push(@versioned_portfiles, $directory.$new_answer); + &Apache::lonnet::mark_as_readonly($domain,$stu_name, + [$directory.$new_answer], + [$symb,$env{'request.course.id'},'graded']); + } + } + $$record{$key} = join(',',@versioned_portfiles); + push(@returned_keys,$key); + } + } + return (@returned_keys); +} + +sub get_next_version { + my ($answer_name, $answer_ext, $dir_list) = @_; + my $version; + foreach my $row (@$dir_list) { + my ($file) = split(/\&/,$row,2); + my ($file_name,$file_version,$file_ext) = + &file_name_version_ext($file); + if (($file_name eq $answer_name) && + ($file_ext eq $answer_ext)) { + # gets here if filename and extension match, regardless of version + if ($file_version ne '') { + # a versioned file is found so save it for later + if ($file_version > $version) { + $version = $file_version; + } + } + } + } + $version ++; + return($version); +} + +sub version_selected_portfile { + my ($domain,$stu_name,$directory,$file_name,$version) = @_; + my ($answer_name,$answer_ver,$answer_ext) = + &file_name_version_ext($file_name); + my $new_answer; + $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name"); + if($env{'form.copy'} eq '-1') { + $new_answer = 'problem getting file'; + } else { + $new_answer = $answer_name.'.'.$version.'.'.$answer_ext; + my $copy_result = &Apache::lonnet::finishuserfileupload( + $stu_name,$domain,'copy', + '/portfolio'.$directory.$new_answer); + } + return ($new_answer); +} + +sub file_name_version_ext { + my ($file)=@_; + my @file_parts = split(/\./, $file); + my ($name,$version,$ext); + if (@file_parts > 1) { + $ext=pop(@file_parts); + if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) { + $version=pop(@file_parts); + } + $name=join('.',@file_parts); + } else { + $name=join('.',@file_parts); + } + return($name,$version,$ext); +} + +#-------------------------------------------------------------------------------------- +# +#-------------------------- Next few routines handles grading by section or whole class +# +#--- Javascript to handle grading by section or whole class +sub viewgrades_js { + my ($request) = shift; + + my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); + $request->print(<
'.&mt('Manual Grading').'
'; + $result.=''.&mt('Current Resource: [_1]',$env{'form.probTitle'}).'
'."\n"; + + #view individual student submission form - called using Javascript viewOneStudent + $result.=&jscriptNform($symb); + + #beginning of class grading form + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + $result.= ''."\n"; + if (scalar(%$fullname) eq 0) { + my $colspan=3+scalar(@parts); + my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); + my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status')); + $result=''. + &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.', + $section_display, $stu_status). + ''; + } + $result.=&show_grading_menu_form($symb); + return $result; +} + +#--- call by previous routine to display each student +sub viewstudentgrade { + my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_; + my ($uname,$udom) = split(/:/,$student); + my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); + my %aggregates = (); + my $result=&Apache::loncommon::start_data_table_row().''.&mt('Current Grade Status').'
'; + $title.=''.&mt('Current Resource: [_1]',$env{'form.probTitle'}).'
'."\n"; + $title.=''.&mt('Section: [_1]',$section_display).'
'."\n"; + + my $result= &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ''.
+ &mt('Number of records updated = [_1] for [quant,_2,student].',
+ $rec_update,$count).'
'.
+ ''.&mt('Total number of students = [_1]',$env{'form.total'}).
+ '
Uploading Class Grades for resource $url
-+
Uploading Class Grades
+$result +Identify fields
Total number of records found in file: $distotalEnter as many fields as you can. The system will inform you and bring you back to this page if the data selected is insufficient to run your class.
+ - - + + + value="$env{'form.upfile_associate'}" /> - - + + +
ENDPICK - return ''; + return ''; } sub csvupload_fields { - my ($url) = @_; - my (@parts) = &getpartlist($url); - my @fields=(['username','Student Username'],['domain','Student Domain']); - foreach my $part (sort(@parts)) { - my @datum; - my $display=&Apache::lonnet::metadata($url,$part.'.display'); - my $name=$part; - if (!$display) { $display = $name; } - @datum=($name,$display); - push(@fields,\@datum); - } - return (@fields); + my ($symb,$errorref) = @_; + my (@parts) = &getpartlist($symb,$errorref); + if (ref($errorref)) { + if ($$errorref) { + return; + } + } + + my @fields=(['ID','Student/Employee ID'], + ['username','Student Username'], + ['domain','Student Domain']); + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + foreach my $part (sort(@parts)) { + my @datum; + my $display=&Apache::lonnet::metadata($url,$part.'.display'); + my $name=$part; + if (!$display) { $display = $name; } + @datum=($name,$display); + if ($name=~/^stores_(.*)_awarded/) { + push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]); + } + push(@fields,\@datum); + } + return (@fields); } sub csvuploadmap_footer { - my ($request,$i,$keyfields) =@_; - $request->print(<
'."\n";
+ $result.='
|
'."\n"; + $result.=&show_grading_menu_form($symb); + return $result; +} + + sub csvuploadmap { - my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - my $datatoken; - if (!$ENV{'form.datatoken'}) { - $datatoken=&Apache::loncommon::upfile_store($request); - } else { - $datatoken=$ENV{'form.datatoken'}; - &Apache::loncommon::load_tmp_file($request); - } - my @records=&Apache::loncommon::upfile_record_sep(); - &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); - my $i; - my $keyfields; - if (@records) { - my @fields=&csvupload_fields($url); - if ($ENV{'form.upfile_associate'} eq 'reverse') { - &Apache::loncommon::csv_print_samples($request,\@records); - $i=&Apache::loncommon::csv_print_select_table($request,\@records, - \@fields); - foreach (@fields) { $keyfields.=$_->[0].','; } - chop($keyfields); - } else { - unshift(@fields,['none','']); - $i=&Apache::loncommon::csv_samples_select_table($request,\@records, - \@fields); - my %sone=&Apache::loncommon::record_sep($records[0]); - $keyfields=join(',',sort(keys(%sone))); + my ($request)= @_; + my ($symb)=&get_symb($request); + if (!$symb) {return '';} + + my $datatoken; + if (!$env{'form.datatoken'}) { + $datatoken=&Apache::loncommon::upfile_store($request); + } else { + $datatoken=$env{'form.datatoken'}; + &Apache::loncommon::load_tmp_file($request); } - } - &csvuploadmap_footer($request,$i,$keyfields); - return ''; + my @records=&Apache::loncommon::upfile_record_sep(); + if ($env{'form.noFirstLine'}) { shift(@records); } + &csvuploadmap_header($request,$symb,$datatoken,$#records+1); + my ($i,$keyfields); + if (@records) { + my $fieldserror; + my @fields=&csvupload_fields($symb,\$fieldserror); + if ($fieldserror) { + $request->print(&navmap_errormsg()); + return; + } + if ($env{'form.upfile_associate'} eq 'reverse') { + &Apache::loncommon::csv_print_samples($request,\@records); + $i=&Apache::loncommon::csv_print_select_table($request,\@records, + \@fields); + foreach (@fields) { $keyfields.=$_->[0].','; } + chop($keyfields); + } else { + unshift(@fields,['none','']); + $i=&Apache::loncommon::csv_samples_select_table($request,\@records, + \@fields); + foreach my $rec (@records) { + my %temp = &Apache::loncommon::record_sep($rec); + if (%temp) { + $keyfields=join(',',sort(keys(%temp))); + last; + } + } + } + } + &csvuploadmap_footer($request,$i,$keyfields); + $request->print(&show_grading_menu_form($symb)); + + return ''; +} + +sub csvuploadoptions { + my ($request)= @_; + my ($symb)=&get_symb($request); + my $checked=(($env{'form.noFirstLine'})?'1':'0'); + my $ignore=&mt('Ignore First Line'); + $request->print(<
Uploading Class Grade Options
+ + ++ +
+ENDPICK + my %fields=&get_fields(); + if (!defined($fields{'domain'})) { + my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); + $request->print("\nUsers are in domain: ".$domform."
\n"); + } + foreach my $key (sort(keys(%env))) { + if ($key !~ /^form\.(.*)$/) { next; } + my $cleankey=$1; + if ($cleankey eq 'command') { next; } + $request->print(''."\n"); + } + # FIXME do a check for any duplicated user ids... + # FIXME do a check for any invalid user ids?... + $request->print('+
'."\n"); + $request->print(&show_grading_menu_form($symb)); + return ''; +} + +sub get_fields { + my %fields; + my @keyfields = split(/\,/,$env{'form.keyfields'}); + for (my $i=0; $i<=$env{'form.nfields'}; $i++) { + if ($env{'form.upfile_associate'} eq 'reverse') { + if ($env{'form.f'.$i} ne 'none') { + $fields{$keyfields[$i]}=$env{'form.f'.$i}; + } + } else { + if ($env{'form.f'.$i} ne 'none') { + $fields{$env{'form.f'.$i}}=$keyfields[$i]; + } + } + } + return %fields; } sub csvuploadassign { - my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - &Apache::loncommon::load_tmp_file($request); - my @gradedata=&Apache::loncommon::upfile_record_sep(); - my @keyfields = split(/\,/,$ENV{'form.keyfields'}); - my %fields=(); - for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) { - if ($ENV{'form.upfile_associate'} eq 'reverse') { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$keyfields[$i]}=$ENV{'form.f'.$i}; - } + my ($request)= @_; + my ($symb)=&get_symb($request); + if (!$symb) {return '';} + my $error_msg = ''; + &Apache::loncommon::load_tmp_file($request); + my @gradedata = &Apache::loncommon::upfile_record_sep(); + if ($env{'form.noFirstLine'}) { shift(@gradedata); } + my %fields=&get_fields(); + $request->print('
Assigning Grades
'); + my $courseid=$env{'request.course.id'}; + my ($classlist) = &getclasslist('all',0); + my @notallowed; + my @skipped; + my $countdone=0; + foreach my $grade (@gradedata) { + my %entries=&Apache::loncommon::record_sep($grade); + my $domain; + if ($entries{$fields{'domain'}}) { + $domain=$entries{$fields{'domain'}}; + } else { + $domain=$env{'form.default_domain'}; + } + $domain=~s/\s//g; + my $username=$entries{$fields{'username'}}; + $username=~s/\s//g; + if (!$username) { + my $id=$entries{$fields{'ID'}}; + $id=~s/\s//g; + my %ids=&Apache::lonnet::idget($domain,$id); + $username=$ids{$id}; + } + if (!exists($$classlist{"$username:$domain"})) { + my $id=$entries{$fields{'ID'}}; + $id=~s/\s//g; + if ($id) { + push(@skipped,"$id:$domain"); + } else { + push(@skipped,"$username:$domain"); + } + next; + } + my $usec=$classlist->{"$username:$domain"}[5]; + if (!&canmodify($usec)) { + push(@notallowed,"$username:$domain"); + next; + } + my %points; + my %grades; + foreach my $dest (keys(%fields)) { + if ($dest eq 'ID' || $dest eq 'username' || + $dest eq 'domain') { next; } + if ($entries{$fields{$dest}} =~ /^\s*$/) { next; } + if ($dest=~/stores_(.*)_points/) { + my $part=$1; + my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', + $symb,$domain,$username); + if ($wgt) { + $entries{$fields{$dest}}=~s/\s//g; + my $pcr=$entries{$fields{$dest}} / $wgt; + my $award=($pcr == 0) ? 'incorrect_by_override' + : 'correct_by_override'; + $grades{"resource.$part.awarded"}=$pcr; + $grades{"resource.$part.solved"}=$award; + $points{$part}=1; + } else { + $error_msg = "" . + &mt("Some point values were assigned" + ." for problems with a weight " + ."of zero. These values were " + ."ignored."); + } + } else { + if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } + if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } + my $store_key=$dest; + $store_key=~s/^stores/resource/; + $store_key=~s/_/\./g; + $grades{$store_key}=$entries{$fields{$dest}}; + } + } + if (! %grades) { + push(@skipped,&mt("[_1]: no data to save","$username:$domain")); + } else { + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $result=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($result eq 'ok') { + $request->print('.'); + } else { + $request->print("
". + &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", + "$username:$domain",$result)."
"); + } + $request->rflush(); + $countdone++; + } + } + $request->print(''.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0)); + if (@skipped) { + $request->print('
'.&Apache::lonhtmlcommon::confirm_success(&mt('No scores stored for the following username(s):'),1).'
'); + $request->print(join(', ',@skipped)); + } + if (@notallowed) { + $request->print('
'.&Apache::lonhtmlcommon::confirm_success(&mt('Modification of scores not allowed for the following username(s):'),1).'
'); + $request->print(join(', ',@notallowed)); + } + $request->print("
\n"); + $request->print(&show_grading_menu_form($symb)); + return $error_msg; +} +#------------- end of section for handling csv file upload --------- +# +#------------------------------------------------------------------- +# +#-------------- Next few routines handle grading by page/sequence +# +#--- Select a page/sequence and a student to grade +sub pickStudentPage { + my ($request) = shift; + + my $alertmsg = &mt('Please select the student you wish to grade.'); + $request->print(<
'. + &mt('Manual Grading by Page or Sequence').'
'; + + $result.=''."\n"; + + $studentTable.=&show_grading_menu_form($symb); + $request->print($studentTable); + + return ''; +} + +sub getSymbMap { + my ($map_error) = @_; + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + if (ref($map_error)) { + $$map_error = 'navmap'; + } + return; + } + my %symbx = (); + my @titles = (); + my $minder = 0; + + # Gather every sequence that has problems. + my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, + 1,0,1); + for my $sequence ($navmap->getById('0.0'), @sequences) { + if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { + my $title = $minder.'.'. + &HTML::Entities::encode($sequence->compTitle(),'"\'&'); + push(@titles, $title); # minder in case two titles are identical + $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); + $minder++; + } + } + return \@titles,\%symbx; +} + +# +#--- Displays a page/sequence w/wo problems, w/wo submissions +sub displayPage { + my ($request) = shift; + + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $pageTitle = $env{'form.page'}; + my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); + my ($uname,$udom) = split(/:/,$env{'form.student'}); + my $usec=$classlist->{$env{'form.student'}}[5]; + + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $env{'course.'.$env{'request.course.id'}.'.num'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + + if (!&canview($usec)) { + $request->print(''.&mt('Unable to view requested student. ([_1])',$env{'form.student'}).''); + $request->print(&show_grading_menu_form($symb)); + return; + } + my $result=''.$env{'form.title'}.'
'; + $result.=''.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)). + '
'."\n"; + $env{'form.CODE'} = uc($env{'form.CODE'}); + if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) { + $result.=''.&mt('CODE: [_1]',$env{'form.CODE'}).'
'."\n"; } else { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$ENV{'form.f'.$i}}=$keyfields[$i]; - } + delete($env{'form.CODE'}); } - } - $request->print('Assigning Grades
'); - my $courseid=$ENV{'request.course.id'}; -# my $cdom=$ENV{"course.$courseid.domain"}; -# my $cnum=$ENV{"course.$courseid.num"}; - my ($classlist) = &getclasslist('all','1'); - my @skipped; - my $countdone=0; - foreach my $grade (@gradedata) { - my %entries=&Apache::loncommon::record_sep($grade); - my $username=$entries{$fields{'username'}}; - my $domain=$entries{$fields{'domain'}}; - if (!exists($$classlist{"$username:$domain"})) { - push(@skipped,"$username:$domain"); - next; - } - my %grades; - foreach my $dest (keys(%fields)) { - if ($dest eq 'username' || $dest eq 'domain') { next; } - if ($entries{$fields{$dest}} eq '') { next; } - my $store_key=$dest; - $store_key=~s/^stores/resource/; - $store_key=~s/_/\./g; - $grades{$store_key}=$entries{$fields{$dest}}; - } - $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}"; - &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'}, - $domain,$username); - $request->print('.'); - $request->rflush(); - $countdone++; - } - $request->print("Stored $countdone students\n"); - if (@skipped) { - $request->print('
Skipped Students
'); - foreach my $student (@skipped) { $request->print("
$student"); } - } - $request->print(&view_edit_entire_class_form($symb,$url)); - $request->print(&show_grading_menu_form($symb,$url)); - return ''; -} - -sub send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); -# $request->print(" -#"); - $request->print(''); -} - -sub send_footer { - my ($request)= @_; - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); + &sub_page_js($request); + $request->print($result); + + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + $request->print(&navmap_errormsg()); + $request->print(&show_grading_menu_form($symb)); + return; + } + my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'}); + my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps + if (!$map) { + $request->print(''.&mt('Unable to view requested sequence. ([_1])',$resUrl).''); + $request->print(&show_grading_menu_form($symb)); + return; + } + my $iterator = $navmap->getIterator($map->map_start(), + $map->map_finish()); + + my $studentTable='