- Submissions: - handgrade only - 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_analyze_cache { + undef(%analyze_cache); + undef(%analyze_cache_formkeys); + } - my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($getsec,'0'); + sub get_analyze { + my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed,$bubbles_per_row)=@_; + my $key = "$symb\0$uname\0$udom"; + if ($type eq 'randomizetry') { + if ($trial ne '') { + $key .= "\0".$trial; + } + } + if (exists($analyze_cache{$key})) { + my $getupdate = 0; + if (ref($add_to_hash) eq 'HASH') { + foreach my $item (keys(%{$add_to_hash})) { + if (ref($analyze_cache_formkeys{$key}) eq 'HASH') { + if (!exists($analyze_cache_formkeys{$key}{$item})) { + $getupdate = 1; + last; + } + } else { + $getupdate = 1; + } + } + } + if (!$getupdate) { + return $analyze_cache{$key}; + } + } - $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,$type,$trial,$rndseed) = @_; + my $grayFont = ''; + if ($response =~ /^(option|rank)$/) { + my %answer=&Apache::lonnet::str2hash($answer); + my @answer = %answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my ($toprow,$bottomrow); + foreach my $foil (@$order) { + if ($grading{$foil} == 1) { + $toprow.='
'; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my @answer = %answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); + my ($toprow,$middlerow,$bottomrow); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my @answer = %answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed); + 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 = &Apache::lontexconvert::msgtexconverted($answer); + return ''. + '
'. + ' '.&mt('Answer').' '.$toprow.''.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'.&keywords_highlight($answer).''; + } elsif ( $response eq 'organic') { + my $result=&mt('Smile representation: [_1]', + '"'.&HTML::Entities::encode($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= &Apache::lonhtmlcommon::scripttag( + ' function viewOneStudent(user,domain) {'."\n". + ' document.onestudent.student.value = user;'."\n". + ' document.onestudent.userdom.value = domain;'."\n". + ' document.onestudent.submit();'."\n". + ' }'."\n". + "\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); - } - return ''; + $uessay=~s/\W+/ /gs; + +# ignore empty submissions (occuring when only files are sent) + + unless ($uessay=~/\w+/s) { 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{$symb}})) { + my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); +# ... except the same student + next if (($tname eq $uname) && ($tdom eq $udom)); + my $tessay=$old_essays{$symb}{$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{$symb}{$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; - } +#------------------------------------------------------------------- + +#------------------------------------ Receipt Verification Routines +# + +sub initialverifyreceipt { + my ($request,$symb) = @_; + &commonJSfunctions($request); + return '\n"; } -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; +#--- Check whether a receipt number is valid.--- +sub verifyreceipt { + my ($request,$symb) = @_; + + my $courseid = $env{'request.course.id'}; + my $receipt = &Apache::lonnet::recprefix($courseid).'-'. + $env{'form.receipt'}; + $receipt =~ s/[^\-\d]//g; + + my $title = + '
'. + &mt('Verifying Receipt Number [_1]',$receipt). + '
'."\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; } -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; - $ENV{'form.NTSTU'}=$ngrade; - while ($ctr < $ngrade) { - ($ENV{'form.student'},my $udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); - &submission($request,$ctr,$ngrade-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,$symb,$submitonly,$divforres) = @_; - 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)}; - $ctr = 2; - while ($laststu eq '') { - $laststu = $ENV{'form.unamedom'.($ngrade-$ctr)}; - $ctr++; - $laststu = $firststu if ($ctr > $ngrade); - } - my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0'); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; + unless ($submitonly) { + $submitonly = $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + } - my (@parsedlist,@nextlist); - my ($nextflg) = 0; - foreach ( sort(@{ $$classlist{$ENV{'form.section'}} }) ) { - if ($nextflg == 1 && $button =~ /Next$/) { - push @parsedlist,$_; - } - $nextflg = 1 if ($_ eq $laststu); - if ($button eq 'Previous') { - last if ($_ eq $firststu); - push @parsedlist,$_; - } - } - $ctr = 0; - my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); - @parsedlist = reverse @parsedlist if ($button eq 'Previous'); - foreach my $student (@parsedlist) { - my ($uname,$udom) = split(/:/,$student); - if ($ENV{'form.submitonly'} eq 'yes') { - my (%status) = &student_gradeStatus($ENV{'form.url'},$udom,$uname,$partlist) ; - my $statusflg = ''; - foreach (keys(%status)) { - $statusflg = 1 if ($status{$_} ne 'nothing'); - } - next if ($statusflg eq ''); - } - push @nextlist,$student if ($ctr < $ntstu); - $ctr++; - } + my $result=''; + my $res_error; + my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error); + + my $table; + if (ref($partlist) eq 'ARRAY') { + if (scalar(@$partlist) > 1 ) { + $table = &showResourceInfo($symb,$partlist,$responseType,'gradesub',1); + } elsif ($divforres) { + $table = ''; + } else { + $table = ''; + } + } - $ctr = 0; - my $total = scalar(@nextlist)-1; - foreach (sort @nextlist) { - my ($uname,$udom) = split(/:/); - $ENV{'form.student'} = $uname; - $ENV{'form.fullname'} = $$fullname{$_}; - &submission($request,$ctr,$total); - $ctr++; - } - if ($total < 0) { - my $the_end = '
LON-CAPA User Message
'."\n"; - $the_end.='Message: No more students for this section or class.
'."\n"; - $the_end.='Click on the button below to return to the grading menu.
'."\n"; - $the_end.=&show_grading_menu_form ($symb,$url); - $request->print($the_end); - } - return ''; -} + my %js_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.', + ); + &js_escape(\%js_lt); + $request->print(&Apache::lonhtmlcommon::scripttag(<
\n"; -# } - &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},$domain,$stuname); - } - return ''; -} + &commonJSfunctions($request); + $request->print($result); -sub get_symb_and_url { - my ($request) = @_; - (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - 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 ''; } - return ($symb,$url); -} - -sub show_grading_menu_form { - my ($symb,$url)=@_; - my $result.=''."\n"; - return $result; -} - -sub gradingmenu { - my ($request) = @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - my $result='
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.='
|
'.&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. ([quant,_1,student] checked for '.$submissions.')', + $num_students). + '
'; + } + } elsif ($ctr == 1) { + $gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/; + } + $request->print($gradeTable); + return ''; } -sub editgrades { - my ($request) = @_; - my $result=''; +#---- Called from the listStudents routine - my $symb=$ENV{'form.symb'}; - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; } - my $url=$ENV{'form.url'}; - #get classlist -# my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - #print "Found $cdom:$cnum
"; - my ($classlist) = &getclasslist('all','0'); - - #get list of parts for this problem - my (@parts) = &getpartlist($url); - - $result.='||g; + $rendered=~s|(
'
+ .'
';
+ $companswer=
+ ''.$renderheading.'
' + .$rendered + .''
+ .'
';
+ my $result;
+ if ($mode eq 'both') {
+ $result=$rendered.$companswer;
+ } elsif ($mode eq 'text') {
+ $result=$rendered;
+ } elsif ($mode eq 'answer') {
+ $result=$companswer;
+ }
+ 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) = @_;
+ unless (&files_exist($r, $symb)) {
+ $r->print(&mt('There are currently no submitted documents.'));
+ return;
+ }
+ 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 submit_download_link {
+ my ($request,$symb) = @_;
+ if (!$symb) { return ''; }
+ my $res_error;
+ my ($partlist,$handgrade,$responseType,$numresp,$numessay,$numdropbox) =
+ &response_type($symb,\$res_error);
+ if ($res_error) {
+ $request->print(&mt('An error occurred retrieving response types'));
+ return;
+ }
+ unless ($numessay) {
+ $request->print(&mt('No essayresponse items found'));
+ return;
+ }
+ my @chosenparts = &Apache::loncommon::get_env_multiple('form.vPart');
+ if (@chosenparts) {
+ $request->print(&showResourceInfo($symb,$partlist,$responseType,
+ undef,undef,1));
+ }
+ if ($numessay) {
+ my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};
+ my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
+ my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'};
+ (undef,undef,my $fullname) = &getclasslist($getsec,1,$getgroup,$symb,$submitonly,1);
+ if (ref($fullname) eq 'HASH') {
+ my @students = map { $_.':'.$fullname->{$_} } (keys(%{$fullname}));
+ if (@students) {
+ @{$env{'form.stuinfo'}} = @students;
+ if ($numdropbox) {
+ &download_all_link($request,$symb);
+ } else {
+ $request->print(&mt('No essayrespose items with dropbox found'));
+ }
+# FIXME Need a mechanism to download essays, i.e., if $numessay > $numdropbox
+# Needs to omit user's identity if resource instance is for an anonymous survey.
+ } else {
+ $request->print(&mt('No students match the criteria you selected'));
+ }
+ } else {
+ $request->print(&mt('Could not retrieve student information'));
+ }
+ } else {
+ $request->print(&mt('No essayresponse items found'));
+ }
+ return;
+}
+
+sub build_section_inputs {
+ 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,$symb,$divforres,$calledby) = @_;
+ 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 '';
+
+ if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
+ my $probtitle=&Apache::lonnet::gettitle($symb);
+ my ($essayurl,%coursedesc_by_cid);
+
+ if (!&canview($usec)) {
+ $request->print(
+ ''.
+ &mt('Unable to view requested student.').
+ ' '.&mt('([_1] in section [_2] in course id [_3])',
+ $uname.':'.$udom,$usec,$env{'request.course.id'}).
+ '');
+ return;
+ }
+
+ my $res_error;
+ my ($partlist,$handgrade,$responseType,$numresp,$numessay) =
+ &response_type($symb,\$res_error);
+ if ($res_error) {
+ $request->print(&navmap_errormsg());
+ 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'; }
+ if (($numessay) && ($calledby eq 'submission') && (!exists($env{'form.compmsg'}))) {
+ $env{'form.compmsg'} = 1;
+ }
+ my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
+ my $checkIcon = ''.$answerheading.'
' + .$companswer + .'.
+ '/check.gif){kind=small}
';
+
+ # header info
+ if ($counter == 0) {
+ my @chosenparts = &Apache::loncommon::get_env_multiple('form.vPart');
+ if (@chosenparts) {
+ $request->print(&showResourceInfo($symb,$partlist,$responseType,'gradesub'));
+ } elsif ($divforres) {
+ $request->print('');
+ } else {
+ $request->print(''); + } + &sub_page_js($request); + &sub_grademessage_js($request) if ($env{'form.compmsg'}); + &sub_page_kw_js($request) if ($numessay); + + # 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)); + } + + my %keyhash = (); + if (($env{'form.kwclr'} eq '' && $numessay) || ($env{'form.compmsg'})) { + %keyhash = &Apache::lonnet::dump('nohist_handgrade', + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + } + # kwclr is the only variable that is guaranteed not to be blank + # if this subroutine has been called once. + if ($env{'form.kwclr'} eq '' && $numessay) { + 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'} : ''; + } + if ($env{'form.compmsg'}) { + $env{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? + $keyhash{$symb.'_subject'} : $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(''; + $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,%lasthidden);
+ 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'});
+ }
+ }
+ my (%typeparts,%randombytry);
+ my $showsurv =
+ &Apache::lonnet::allowed('vas',$env{'request.course.id'});
+ foreach my $key (sort(keys(%lasthash))) {
+ if ($key =~ /\.type$/) {
+ if (($lasthash{$key} eq 'anonsurvey') ||
+ ($lasthash{$key} eq 'anonsurveycred') ||
+ ($lasthash{$key} eq 'randomizetry')) {
+ my ($ign,@parts) = split(/\./,$key);
+ pop(@parts);
+ my $id = join('.',@parts);
+ if ($lasthash{$key} eq 'randomizetry') {
+ $randombytry{$ign.'.'.$id} = $lasthash{$key};
+ } else {
+ unless ($showsurv) {
+ $typeparts{$ign.'.'.$id} = $lasthash{$key};
+ }
+ }
+ delete($lasthash{$key});
+ }
+ }
+ }
+ my @hidden = keys(%typeparts);
+ my @randomize = keys(%randombytry);
+ foreach my $key (keys(%lasthash)) {
+ next if ($key !~ /\.submission$/);
+ my $hide;
+ if (@hidden) {
+ foreach my $id (@hidden) {
+ if ($key =~ /^\Q$id\E/) {
+ $hide = 'anon';
+ last;
+ }
+ }
+ }
+ unless ($hide) {
+ if (@randomize) {
+ foreach my $id (@randomize) {
+ if ($key =~ /^\Q$id\E/) {
+ $hide = 'rand';
+ last;
+ }
+ }
+ }
+ }
+ my ($partid,$foo) = split(/submission$/,$key);
+ my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? 1 : 0;
+ push(@string, join(':', $key, $hide, $draft, (
+ ref($lasthash{$key}) eq 'ARRAY' ?
+ join(',', @{$lasthash{$key}}) : $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;
+}
+
+# For Tasks provide a mechanism to display previous version for one specific student
+
+sub show_previous_task_version {
+ my ($request,$symb) = @_;
+ if ($symb eq '') {
+ $request->print(
+ ''.
+ &mt('Unable to handle ambiguous references.').
+ '');
+ return '';
+ }
+ my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'});
+ my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
+ if (!&canview($usec)) {
+ $request->print(''.
+ &mt('Unable to view previous version for requested student.').
+ ' '.&mt('([_1] in section [_2] in course id [_3])',
+ $uname.':'.$udom,$usec,$env{'request.course.id'}).
+ '');
+ return;
+ }
+ my $mode = 'both';
+ my $isTask = ($symb =~/\.task$/);
+ if ($isTask) {
+ if ($env{'form.previousversion'} =~ /^\d+$/) {
+ if ($env{'form.fullname'} eq '') {
+ $env{'form.fullname'} =
+ &Apache::loncommon::plainname($uname,$udom,'lastname');
+ }
+ my $probtitle=&Apache::lonnet::gettitle($symb);
+ $request->print("\n\n".
+ ''.
+ '
");
+ }
+ }
+ return;
+}
+
+sub choose_task_version_form {
+ my ($symb,$uname,$udom,$nomenu) = @_;
+ my $isTask = ($symb =~/\.task$/);
+ my ($current,$version,$result,$js,$displayed,$rowtitle);
+ if ($isTask) {
+ my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $udom,$uname);
+ if (($record{'resource.0.version'} eq '') ||
+ ($record{'resource.0.version'} < 2)) {
+ return ($record{'resource.0.version'},
+ $record{'resource.0.version'},$result,$js);
+ } else {
+ $current = $record{'resource.0.version'};
+ }
+ if ($env{'form.previousversion'}) {
+ $displayed = $env{'form.previousversion'};
+ $rowtitle = &mt('Choose another version:')
+ } else {
+ $displayed = $current;
+ $rowtitle = &mt('Show earlier version:');
+ }
+ $result = ''.&nameUserString(undef,$env{'form.fullname'},$uname,$udom). + '
'."\n"); + &Apache::lonxml::clear_problem_counter(); + $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode, + {'previousversion' => $env{'form.previousversion'} })); + $request->print("\n';
+ my $list;
+ my $numversions = 0;
+ for (my $i=1; $i<=$record{'resource.0.version'}; $i++) {
+ if ($i == $current) {
+ if (!$env{'form.previousversion'} || $nomenu) {
+ next;
+ } else {
+ $list .= ''."\n";
+ $numversions ++;
+ }
+ } elsif (defined($record{'resource.'.$i.'.0.status'})) {
+ unless ($i == $env{'form.previousversion'}) {
+ $numversions ++;
+ }
+ $list .= ''."\n";
+ }
+ }
+ if ($numversions) {
+ $symb = &HTML::Entities::encode($symb,'<>"&');
+ $result .=
+ '';
+ $js = &previous_display_javascript($nomenu,$current);
+ } elsif ($displayed && $nomenu) {
+ $result .= ''.&mt('Close window').'';
+ } else {
+ $result .= &mt('No previous versions to show for this student');
+ }
+ $result .= '
';
+ }
+ return ($current,$displayed,$result,$js);
+}
+
+sub previous_display_javascript {
+ my ($nomenu,$current) = @_;
+ my $js = <<"JSONE";
+
+ENDJS
+
+}
+
+#--- Called from submission routine
+sub processHandGrade {
+ my ($request,$symb) = @_;
+ 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,$numhidden) =
+ &saveHandGrade($request,$symb,$uname,$udom,$ctr);
+ if ($errorflag eq 'no_score') {
+ $ctr++;
+ next;
+ }
+ if ($errorflag eq 'not_allowed') {
+ $request->print(
+ ''
+ .&mt('Not allowed to modify grades for [_1]',"$uname:$udom")
+ .'');
+ $ctr++;
+ next;
+ }
+ if ($numhidden) {
+ $request->print(
+ ''
+ .&mt('For [_1]: [quant,_2,transaction] hidden',"$uname:$udom",$numhidden)
+ .''); + } + 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 $restitle"; + } + $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 $restitle"; + } + $msgstatus = + &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); + } + } + } + } + $ctr++; + } + } + + my $res_error; + my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error); + if ($res_error) { + $request->print(&navmap_errormsg()); + return; + } + + my %keyhash = (); + if ($numessay) { + # Keywords sorted in alphabatical order + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $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'}; + } + + if ($env{'form.compmsg'}) { + # 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'}; + } + if (($numessay) || ($env{'form.compmsg'})) { + 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,$symb); + $ctr++; + } + 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'); + 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,$symb); + $ctr++; + } + if ($total < 0) { + my $the_end.='
'.&mt('[_1]Message:[_2] No more students for this section or class.','','').'
'."\n"; + $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,$totchg) = ('','',0); + my %aggregate = (); + my $aggregateflag = 0; + if ($env{'form.HIDE'.$newflg}) { + my ($version,$parts) = split(/:/,$env{'form.HIDE'.$newflg},2); + my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1); + $totchg += $numchgs; + } + 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,$totchg); +} + +sub makehidden { + my ($version,$parts,$record,$symb,$domain,$stuname,$tolog) = @_; + return unless (ref($record) eq 'HASH'); + my %modified; + my $numchanged = 0; + if (exists($record->{$version.':keys'})) { + my $partsregexp = $parts; + $partsregexp =~ s/,/|/g; + foreach my $key (split(/\:/,$record->{$version.':keys'})) { + if ($key =~ /^resource\.(?:$partsregexp)\.([^\.]+)$/) { + my $item = $1; + unless (($item eq 'solved') || ($item =~ /^award(|msg|ed)$/)) { + $modified{$key} = $record->{$version.':'.$key}; + } + } elsif ($key =~ m{^(resource\.(?:$partsregexp)\.[^\.]+\.)(.+)$}) { + $modified{$1.'hidden'.$2} = $record->{$version.':'.$key}; + } elsif ($key =~ /^(ip|timestamp|host)$/) { + $modified{$key} = $record->{$version.':'.$key}; + } + } + if (keys(%modified)) { + if (&Apache::lonnet::putstore($env{'request.course.id'},$symb,$version,\%modified, + $domain,$stuname,$tolog) eq 'ok') { + $numchanged ++; + } + } + } + return $numchanged; +} + +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 @handedback; + my $file_msg; + 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.'_countreturndoc'} =~ /^\d+$/) & ($new_part eq $part_id)) { + for (my $counter=1; $counter<=$env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'}; $counter++) { + # if multiple files are uploaded names will be 'returndoc2','returndoc3' + if ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter}) { + my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter.'.filename'}; + my ($directory,$answer_file) = + ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$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,$listerror) = + &Apache::lonnet::dirlist($portfolio_root.$portfolio_path, + $domain,$stuname,$getpropath); + my $version = &get_next_version($answer_name,$answer_ext,$dir_list); + # fix filename + my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); + my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, + $newflg.'_'.$part_resp.'_returndoc'.$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'.$counter). + ''); + } else { + # mark the file as read only + push(@handedback,$save_file_name); + 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.=''.$save_file_name."
"; + + } + $request->print('
'.&mt('[_1] will be the uploaded filename [_2]',''.$fname.'',''.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'')); + } + } + } + } + if (@handedback > 0) { + $request->print('
'); + my @what = ($symb,$env{'request.course.id'},'handback'); + &Apache::lonnet::mark_as_readonly($domain,$stuname,\@handedback,\@what); + my $user_lh = &Apache::loncommon::user_lang($stuname,$domain,$env{'request.course.id'}); + my ($subject,$message); + if (scalar(@handedback) == 1) { + $subject = &mt_user($user_lh,'File Handed Back by Instructor'); + $message = &mt_user($user_lh,'A file has been returned that was originally submitted in response to: '); + } else { + $subject = &mt_user($user_lh,'Files Handed Back by Instructor'); + $message = &mt_user($user_lh,'Files have been returned that were originally submitted in response to: '); + } + $message .= "
".&Apache::lonnet::gettitle($symb)."
"; + $message .= &mt_user($user_lh,'The returned file(s) are named: [_1]',"$file_msg
"). + &mt_user($user_lh,'The file(s) can be found in your [_1]portfolio[_2].','',''); + my ($feedurl,$showsymb) = + &get_feedurl_and_symb($symb,$domain,$stuname); + my $restitle = &Apache::lonnet::gettitle($symb); + $subject .= ' '.&mt_user($user_lh,'(File Returned)').' ['.$restitle.']'; + my $msgstatus = + &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject, + $message,undef,$feedurl,undef,undef,undef,$showsymb, + $restitle); + if ($msgstatus) { + $request->print(&mt('Notification message status: [_1]',''.$msgstatus.'').'
'); + } + } + 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,$listerror) = + &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; + if (ref($dir_list) eq 'ARRAY') { + 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 = '); + &js_escape(\$alertmsg); + $request->print(&Apache::lonhtmlcommon::scripttag(<
'.&mt('Manual Grading').'
'. + ''; + if ($env{'form.submitonly'} eq 'all') { + if (grep(/^all$/,@sections)) { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students with enrollment status [_1] to modify or grade.', + $stu_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students with no group assigned and with enrollment status [_1] to modify or grade.', + $stu_status); + } else { + $result .= &mt('There are no students in group(s) [_1] with enrollment status [_2] to modify or grade.', + $group_display,$stu_status); + } + } elsif (grep(/^none$/,@sections)) { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students in no section with enrollment status [_1] to modify or grade.', + $stu_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students in no section and no group with enrollment status [_1] to modify or grade.', + $stu_status); + } else { + $result .= &mt('There are no students in no section in group(s) [_1] with enrollment status [_2] to modify or grade.', + $group_display,$stu_status); + } + } else { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.', + $section_display,$stu_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students in section(s) [_1] and no group with enrollment status [_2] to modify or grade.', + $section_display,$stu_status); + } else { + $result .= &mt('There are no students in section(s) [_1] and group(s) [_2] with enrollment status [_3] to modify or grade.', + $section_display,$group_display,$stu_status); + } + } + } else { + if (grep(/^all$/,@sections)) { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students with enrollment status [_1] and submission status "[_2]" to modify or grade.', + $stu_status,$submission_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students with no group assigned with enrollment status [_1] and submission status "[_2]" to modify or grade.', + $stu_status,$submission_status); + } else { + $result .= &mt('There are no students in group(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', + $group_display,$stu_status,$submission_status); + } + } elsif (grep(/^none$/,@sections)) { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students in no section with enrollment status [_1] and submission status "[_2]" to modify or grade.', + $stu_status,$submission_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students in no section and no group with enrollment status [_1] and submission status "[_2]" to modify or grade.', + $stu_status,$submission_status); + } else { + $result .= &mt('There are no students in no section in group(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', + $group_display,$stu_status,$submission_status); + } + } else { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students in section(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', + $section_display,$stu_status,$submission_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students in section(s) [_1] and no group with enrollment status [_2] and submission status "[_3]" to modify or grade.', + $section_display,$stu_status,$submission_status); + } else { + $result .= &mt('There are no students in section(s) [_1] and group(s) [_2] with enrollment status [_3] and submission status "[_4]" to modify or grade.', + $section_display,$group_display,$stu_status,$submission_status); + } + } + } + $result .= ''; + } + return $result; +} + +#--- call by previous routine to display each student who satisfies submission filter. +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 $submitonly = $env{'form.submitonly'}; + unless (($submitonly eq 'all') || ($submitonly eq 'queued')) { + my %partstatus = (); + if (ref($parts) eq 'ARRAY') { + foreach my $apart (@{$parts}) { + my ($part,$type) = &split_part_type($apart); + my ($status,undef) = split(/_/,$record{"resource.$part.solved"},2); + $status = 'nothing' if ($status eq ''); + $partstatus{$part} = $status; + my $subkey = "resource.$part.submitted_by"; + $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); + } + my $submitted = 0; + my $graded = 0; + my $incorrect = 0; + foreach my $key (keys(%partstatus)) { + $submitted = 1 if ($partstatus{$key} ne 'nothing'); + $graded = 1 if ($partstatus{$key} =~ /^ungraded/); + $incorrect = 1 if ($partstatus{$key} =~ /^incorrect/); + + my $partid = (split(/\./,$key))[1]; + if ($partstatus{'resource.'.$partid.'.'.$key.'.submitted_by'} ne '') { + $submitted = 0; + } + } + return if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + return if (!$graded && ($submitonly eq 'graded')); + return if (!$incorrect && $submitonly eq 'incorrect'); + } + } + if ($submitonly eq 'queued') { + my ($cdom,$cnum) = split(/_/,$courseid); + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + return if (!defined($queue_status{'gradingqueue'})); + } + $$ctr++; + my %aggregates = (); + my $result=&Apache::loncommon::start_data_table_row().'
'.&mt('Current Grade Status').'
'; + $title.=''.&mt('Section:').' '.$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
--
Identify fields
-Total number of records found in file: $distotal-Enter 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.
- + my ($request,$symb,$datatoken,$distotal)= @_; + my $javascript; + if ($env{'form.upfile_associate'} eq 'reverse') { + $javascript=&csvupload_javascript_reverse_associate(); + } else { + $javascript=&csvupload_javascript_forward_associate(); + } + + my $checked=(($env{'form.noFirstLine'})?' checked="checked"':''); + my $ignore=&mt('Ignore First Line'); + $symb = &Apache::lonenc::check_encrypt($symb); + $request->print(' ENDPICK } +sub checkforfile_js { + my $alertmsg = &mt('Please use the browse button to select a file from your local directory.'); + &js_escape(\$alertmsg); + my $result = &Apache::lonhtmlcommon::scripttag(<
+ + +ENDUPFORM + $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV", + &mt("How do I create a CSV file from a spreadsheet")). + '
+ +
+ENDPICK + my %fields=&get_fields(); + if (!defined($fields{'domain'})) { + my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); + $request->print("\n".&mt('Users are in domain: [_1]',$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"); + 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,$symb) = @_; + if (!$symb) {return '';} + my $error_msg = ''; + my $datatoken = &Apache::loncommon::valid_datatoken($env{'form.datatoken'}); + if ($datatoken ne '') { + &Apache::loncommon::load_tmp_file($request,$datatoken); + } + my @gradedata = &Apache::loncommon::upfile_record_sep(); + if ($env{'form.noFirstLine'}) { shift(@gradedata); } + my %fields=&get_fields(); + my $courseid=$env{'request.course.id'}; + my ($classlist) = &getclasslist('all',0); + my @notallowed; + my @skipped; + my @warnings; + 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'; + if ($pcr>1) { + push(@warnings,&mt("[_1]: point value larger than weight","$username:$domain")); + } + $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') { +# Successfully stored + $request->print('.'); +# Remove from grading queue + &Apache::bridgetask::remove_from_queue('gradingqueue',$symb, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}, + $domain,$username); + } 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 (@warnings) { + $request->print('
'.&Apache::lonhtmlcommon::confirm_success(&mt('Warnings generated for the following saved scores:'),1).'
'); + $request->print(join(', ',@warnings)); + } + 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"); + 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,$symb) = @_; + + my $alertmsg = &mt('Please select the student you wish to grade.'); + &js_escape(\$alertmsg); + $request->print(&Apache::lonhtmlcommon::scripttag(<
'.$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()); + 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).''); + return; + } + my $iterator = $navmap->getIterator($map->map_start(), + $map->map_finish()); + + my $studentTable='