\n"; - next; + my ($getsec,$filterlist) = @_; + my @getsec; + if (!ref($getsec)) { + if ($getsec ne '' && $getsec ne 'all') { + @getsec=($getsec); + } + } else { + @getsec=@{$getsec}; } - #print "record=$record
"; - push( @{ $classlist{'allids'} }, $name); - } - return (%classlist); + if (grep(/^all$/,@getsec)) { undef(@getsec); } + + my $classlist=&Apache::loncoursedata::get_classlist(); + # Bail out if we were unable to get the classlist + return if (! defined($classlist)); + # + my %sections; + my %fullnames; + foreach my $student (keys(%$classlist)) { + my $end = + $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; + my $start = + $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; + my $id = + $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; + my $section = + $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + my $fullname = + $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; + my $status = + $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; + # filter students according to status selected + if ($filterlist && $env{'form.Status'} ne 'Any') { + if ($env{'form.Status'} ne $status) { + delete ($classlist->{$student}); + next; + } + } + $section = ($section ne '' ? $section : 'none'); + if (&canview($section)) { + if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { + $sections{$section}++; + $fullnames{$student}=$fullname; + } else { + delete($classlist->{$student}); + } + } else { + delete($classlist->{$student}); + } + } + my %seen = (); + my @sections = sort(keys(%sections)); + return ($classlist,\@sections,\%fullnames); } -sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_([0-9]+)_.*/ ) { - push(@parts,$key); +sub canmodify { + my ($sec)=@_; + if ($perm{'mgr'}) { + if (!defined($perm{'mgr_section'})) { + # can modify whole class + return 1; + } else { + if ($sec eq $perm{'mgr_section'}) { + #can modify the requested section + return 1; + } else { + # can't modify the request section + return 0; + } + } } - } - return @parts; + #can't modify + return 0; } -sub viewstudentgrade { - my ($url,$symb,$courseid,$student,@parts) = @_; - my $result =''; - my $cellclr = '"#ffffdd"'; - my ($stuname,$domain) = split(/:/,$student); - - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname); - - $result.="
\n"; - if ($type eq 'awarded') { - my $score=$record{"resource.$part.$type"}; - $result.="
\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'; } - } else { - #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
\n"; - } - if ($update) { $newrecord{"resource.$part.$type"}=$newscore; } + +#--- 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 ''); + } + return %partstatus; +} + +# 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 $jscript=''."\n"; + $jscript.= ''."\n"; + return $jscript; +} + +# 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; + }; + + $points = $check_for_nearness->(10); + $points = $check_for_nearness->(3); + $points = $check_for_nearness->(4); + + return $points; +} + +#------------------ End of general use routines -------------------- + +# +# Find most similar essay +# + +sub most_similar { + my ($uname,$udom,$uessay)=@_; + +# ignore spaces and punctuation + + $uessay=~s/\W+/ /gs; + +# ignore empty submissions (occuring when only files are sent) + + unless ($uessay=~/\w+/) { return ''; } + +# these will be returned. Do not care if not at least 50 percent similar + my $limit=0.6; + my $sname=''; + my $sdom=''; + my $scrsid=''; + my $sessay=''; +# go through all essays ... + foreach my $tkey (keys %oldessays) { + my ($tname,$tdom,$tcrsid)=split(/\./,$tkey); +# ... except the same student + if (($tname ne $uname) || ($tdom ne $udom)) { + my $tessay=$oldessays{$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=$oldessays{$tkey}; + } + } + } + if ($limit>0.6) { + return ($sname,$sdom,$scrsid,$sessay,$limit); + } else { + return ('','','','',0); + } +} + +#------------------------------------------------------------------- + +#------------------------------------ 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.='
Verifying Submission Receipt '. + $receipt.'
'."\n". + 'Resource: '.$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) { ($parts)=&response_type($symb); } + foreach (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } (keys(%$fullname))) { + my ($uname,$udom)=split(/\:/); + foreach my $part (@$parts) { + if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { + $contents.='
'."\n".
+ '
|
'.$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')); + + $request->print(<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='
'. + 'No '.$submissions.' found for this resource for any students. ('.$num_students. + ' students checked for '.$submissions.')
'; + } + } elsif ($ctr == 1) { + $gradeTable =~ s/type=checkbox/type=checkbox checked/; + } + $gradeTable.=&show_grading_menu_form($symb); + $request->print($gradeTable); + return ''; +} + +#---- Called from the listStudents routine + +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 (@stuchecked) { + my ($uname,$udom,$fullname) = split(/:/); + $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(<
\n"; + function strReplace(strx, orgStr, newStr) { + return strx.split(orgStr).join(newStr); } - return $result; + + function savedMsgHeader(Nmsg,usrctr,fullname) { + var height = 70*Nmsg+250; + var scrollbar = "no"; + if (height > 600) { + height = 600; + scrollbar = "yes"; + } + var xpos = (screen.width-600)/2; + xpos = (xpos < 0) ? '0' : xpos; + var ypos = (screen.height-height)/2-30; + ypos = (ypos < 0) ? '0' : ypos; + + pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); + pWin.focus(); + pDoc = pWin.document; + pDoc.$docopen; + pDoc.write('$start_page_msg_central'); + + pDoc.write(""); + pDoc.write('$end_page_msg_central'); + pDoc.close(); +} + +//====================== Script for keyword highlight options ============== + function kwhighlight() { + var kwclr = document.SCORE.kwclr.value; + var kwsize = document.SCORE.kwsize.value; + var kwstyle = document.SCORE.kwstyle.value; + var redsel = ""; + var grnsel = ""; + var blusel = ""; + if (kwclr=="red") {var redsel="checked"}; + if (kwclr=="green") {var grnsel="checked"}; + if (kwclr=="blue") {var blusel="checked"}; + var sznsel = ""; + var sz1sel = ""; + var sz2sel = ""; + if (kwsize=="0") {var sznsel="checked"}; + if (kwsize=="+1") {var sz1sel="checked"}; + if (kwsize=="+2") {var sz2sel="checked"}; + var synsel = ""; + var syisel = ""; + var sybsel = ""; + if (kwstyle=="") {var synsel="checked"}; + if (kwstyle=="") {var syisel="checked"}; + if (kwstyle=="") {var sybsel="checked"}; + highlightCentral(); + highlightbody('red','red',redsel,'0','normal',sznsel,'','normal',synsel); + highlightbody('green','green',grnsel,'+1','+1',sz1sel,'','italic',syisel); + highlightbody('blue','blue',blusel,'+2','+2',sz2sel,'','bold',sybsel); + highlightend(); + return; + } + + function highlightCentral() { +// if (window.hwdWin) window.hwdWin.close(); + var xpos = (screen.width-400)/2; + xpos = (xpos < 0) ? '0' : xpos; + var ypos = (screen.height-330)/2-30; + ypos = (ypos < 0) ? '0' : ypos; + + hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); + hwdWin.focus(); + var hDoc = hwdWin.document; + hDoc.$docopen; + hDoc.write('$start_page_highlight_central'); + hDoc.write(""); + hDoc.write('$end_page_highlight_central'); + hDoc.close(); + } + + +SUBJAVASCRIPT +} + +sub get_increment { + my $increment = $env{'form.increment'}; + if ($increment != 1 && $increment != .5 && $increment != .25 && + $increment != .1) { + $increment = 1; + } + return $increment; +} + +#--- displays the grading box, used in essay type problem and grading by page/sequence +sub gradeBox { + my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; + my $checkIcon = '
.
+ '/check.gif){kind=small}
';
+ my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
+ my $wgtmsg = ($wgt > 0 ? '(problem weight)' :
+ '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.='| '. + 'Part: '.$display_part.' Points: | '."\n";
+ my $ctr = 0;
+ my $thisweight = 0;
+ my $increment = &get_increment();
+ $result.='
| or | '."\n"; + $result.=''."\n"; + $result.=' | /'.$wgt.' '.$wgtmsg. + ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : ''). + ' | '."\n"; + $result.=''."\n"; + $result.=" \n"; + $result.=''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + $result.=' |
'; + $result.='(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|
';
+ $result.='
|
'; + return $result; +} + +# --------------------------- show submissions of a student, option to grade sub submission { - my ($request) = @_; - my $url=$ENV{'form.url'}; - $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; } -# if ($ENV{'form.student'} eq '') { &listStudents($request); return ''; } - my ($uname,$udom) = &finduser($ENV{'form.student'}); - if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; } - my $symb; - if ($ENV{'form.symb'}) { - $symb=$ENV{'form.symb'}; - } else { - $symb=&Apache::lonnet::symbread($url); - } - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, - $ENV{'request.course.id'}); - my $result="
Submission Record
$uname:$udom for $url".$answer; - my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $ENV{'request.course.id'}); - $result.="Student's view of the problem:
$rendered
Correct answer:"; - - my $answer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, - $ENV{'request.course.id'}); - $result.=$answer; - return $result; + 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 = '
';
+
+ # 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'};
+
+ $request->print('Submission Record
'."\n". + ' Resource: '.$env{'form.probTitle'}.''."\n"); + + if ($env{'form.handgrade'} eq 'no') { + my $checkMark='Note: Part(s) graded correct by the computer is marked with a '. + $checkIcon.' symbol.'."\n"; + $request->print($checkMark); + } + + # 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'}; + + $request->print('
+KEYWORDS +# +# Load the other essays for similarity check +# + my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); + my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); + $apath=&escape($apath); + $apath=~s/\W/\_/gs; + %oldessays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); + } + } + + if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') { + $request->print('
') if ($counter > 0); + my $mode; + if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') { + $mode='both'; + } elsif ($env{'form.vProb'} eq 'all' ) { + $mode='text'; + } elsif ($env{'form.vAns'} eq 'all') { + $mode='answer'; + } + &Apache::lonxml::clear_problem_counter(); + $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode)); + } + + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); + my ($partlist,$handgrade,$responseType) = &response_type($symb); + + # Display student info + $request->print(($counter == 0 ? '' : '
')); + my $result='
'."\n".
+ '
|
.
+ '/mailbkgrd.gif){kind=small}
'."\n".
+ '('. + &mt('Message will be sent when you click on Save & Next below.').")\n"; + $request->print($result); + } + if ($perm{'vgr'}) { + $request->print('
'. + &Apache::loncommon::track_student_link(&mt('View recent activity'), + $uname,$udom,'check')); + } + if ($perm{'opa'}) { + $request->print('
'. + &Apache::loncommon::pprmlink(&mt('Set/Change parameters'), + $uname,$udom,$symb,'check')); + } + + my %seen = (); + my @partlist; + my @gradePartRespid; + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($partid,$respid) = @{ $part_response_id }; + my $part_resp = join('_',@{ $part_response_id }); + next if ($seen{$partid} > 0); + $seen{$partid}++; + next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/); + push @partlist,$partid; + push @gradePartRespid,$partid.'.'.$respid; + $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); + } + $result=''."\n"; + $result.=''."\n" if ($counter == 0); + my $ctr = 0; + while ($ctr < scalar(@partlist)) { + $result.=''."\n"; + $ctr++; + } + $request->print($result.''."\n"); + + # print end of form + if ($counter == $total) { + my $endform='
| '."\n"; + $endform.=' '."\n"; + my $ntstu =''."\n"; + my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1'); + $ntstu =~ s/ |
'.&mt('Sending message to [_1]:[_2]',$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; + } else { + if ($message ne '') { + $encrypturl= + &Apache::lonnet::EXT('resource.0.encrypturl', + $symb,$udom,$collaborator); + if ($encrypturl =~ /^yes$/i) { + $baseurl = &Apache::lonenc::encrypted($feedurl,1); + $showsymb = &Apache::lonenc::encrypted($symb,1); + } else { + $baseurl = $feedurl; + $showsymb = $symb; + } + 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 (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,$_; + } + $nextflg = 1 if ($_ eq $laststu); + if ($button eq 'Previous') { + last if ($_ eq $firststu); + push @parsedlist,$_; + } + } + $ctr = 0; + @parsedlist = reverse @parsedlist if ($button eq 'Previous'); + my ($partlist) = &response_type($symb); + 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 (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $ungraded = 1 if ($status{$_} =~ /^ungraded/); + $incorrect = 1 if ($status{$_} =~ /^incorrect/); + my ($foo,$partid,$foo1) = split(/\./,$_); + 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 = '
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); + $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 = &propath($domain,$stuname).'/userfiles/portfolio'; + my ($partlist,$handgrade,$responseType) = &response_type($symb); + + 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 @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root); + 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(' An errror occured ('.$result. + ') while trying to upload '.$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 $url = (&Apache::lonnet::decode_symb($symb))[2]; + my $feedurl = &Apache::lonnet::clutter($url); + my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', + $symb,$domain,$stuname); + my ($baseurl,$showsymb); + if ($encrypturl =~ /^yes$/i) { + $baseurl = &Apache::lonenc::encrypted($feedurl,1); + $showsymb = &Apache::lonenc::encrypted($symb,1); + } else { + $baseurl = $feedurl; + $showsymb = $symb; + } + my $restitle = &Apache::lonnet::gettitle($symb); + my $msgstatus = + &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject. + ' (File Returned) ['.$restitle.']',$message,undef, + $baseurl,undef,undef,undef,$showsymb,$restitle); + } + } + return; +} + +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 = &propath($domain,$stu_name). + '/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 @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root); + 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') { + &Apache::lonnet::logthis('problem getting file '.$file_name); + $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; + + $request->print(<
"; - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - my $headerclr = '"#ccffff"'; - my $cellclr = '"#ffffcc"'; - - #get list of parts for this problem - my (@parts) = &getpartlist($url); - - $request->print ("
Manual Grading
"); - - #start the form - $result = ''; + ''."\n". + ''."\n". + ''."\n". + ''."\n"; - return $result; + my $sectionClass; + if ($env{'form.section'} eq 'all') { + $sectionClass='Class '; + } elsif ($env{'form.section'} eq 'none') { + $sectionClass='Students in no Section '; + } else { + $sectionClass='Students in Section '.$env{'form.section'}.''; + } + $result.='Assign Common Grade To '.$sectionClass; + $result.= '
'."\n".
+ '
|
Assign Grade to Specific Students in '.$sectionClass; + $result.= '
'."\n".
+ '
|
"; - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - - #get list of parts for this problem - my (@parts) = &getpartlist($url); - - $result.=''; - return $result; -} - -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()); + my $symb=&get_symb($request); + my $title='
Current Grade Status
'; + $title.='Current Resource: '.$env{'form.probTitle'}.''."\n"; + $title.='Section: '.$env{'form.section'}.''."\n"; + + my $result= '
'."\n";
+ $result.= '
|
Number of records updated = '.$rec_update. + ' for '.$count.' student'.($count <= 1 ? '' : 's').'.
'. + 'Total number of students = '.$env{'form.total'}.'
'; + return $title.$msg.$result; } -sub handler { - my $request=$_[0]; +sub split_part_type { + my ($partstr) = @_; + my ($temp,@allparts)=split(/_/,$partstr); + my $type=pop(@allparts); + my $part=join('.',@allparts); + return ($part,$type); +} + +#------------- end of section for handling grading by section/class --------- +# +#---------------------------------------------------------------------------- + - if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} else {$Apache::lonxml::debug=0;} - - if ($ENV{'browser.mathml'}) { - $request->content_type('text/xml'); - } else { - $request->content_type('text/html'); - } - $request->send_http_header; - return OK if $request->header_only; - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); - my $url=$ENV{'form.url'}; - my $symb=$ENV{'form.symb'}; - my $command=$ENV{'form.command'}; - if (!$url) { - my ($temp1,$temp2); - ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb); - $url = $ENV{'form.url'}; - } - &send_header($request); - if ($url eq '' && $symb eq '') { - if ($ENV{'user.adv'}) { - if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && - ($ENV{'form.codethree'})) { - my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'. - $ENV{'form.codethree'}; - my ($tsymb,$tuname,$tudom,$tcrsid)= - &Apache::lonnet::checkin($token); - if ($tsymb) { - my ($map,$id,$url)=split(/\_\_\_/,$tsymb); - if (&Apache::lonnet::allowed('mgr',$tcrsid)) { - $request->print( - &Apache::lonnet::ssi('/res/'.$url, - ('grade_username' => $tuname, - 'grade_domain' => $tudom, - 'grade_courseid' => $tcrsid, - 'grade_symb' => $tsymb))); +#---------------------------------------------------------------------------- +# +#-------------------------- Next few routines handles grading by csv upload +# +#--- Javascript to handle csv upload +sub csvupload_javascript_reverse_associate { + my $error1=&mt('You need to specify the username or ID'); + my $error2=&mt('You need to specify at least one grading field'); + return(<
Uploading Class Grades
+$result ++
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.
+ + + + + + + + + + + + +
+ +ENDPICK + return ''; + +} + +sub csvupload_fields { + my ($symb) = @_; + my (@parts) = &getpartlist($symb); + my @fields=(['ID','Student 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(<
+ +ENDPICK +} + +sub checkforfile_js { + my $result =<
'."\n";
+ $result.='
|
'."\n"; + $result.=&show_grading_menu_form($symb); + return $result; +} + + +sub csvuploadmap { + 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); + } + 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 @fields=&csvupload_fields($symb); + + 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)=&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='correct_by_override'; + $grades{"resource.$part.awarded"}=$pcr; + $grades{"resource.$part.solved"}=$award; + $points{$part}=1; } else { - $request->print('Not authorized: '.$token.'
'); - } + $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,"$username:$domain no data to store"); } + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; +# &Apache::lonnet::logthis(" storing ".(join('-',%grades))); + my $result=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($result eq 'ok') { + $request->print('.'); + } else { + $request->print("
+ + Failed to store student $username\@$domain. + Message when trying to store was ($result) + +
" ); + } + $request->rflush(); + $countdone++; + } + $request->print("Stored $countdone students\n"); + if (@skipped) { + $request->print('
Skipped Students
'); + foreach my $student (@skipped) { $request->print("$student\n"); } + } + if (@notallowed) { + $request->print('
Students Not Allowed to Modify
'); + foreach my $student (@notallowed) { $request->print("$student\n"); } + } + $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; + + $request->print(<