--- loncom/homework/grades.pm 2002/07/03 21:05:33 1.35 +++ loncom/homework/grades.pm 2002/10/17 14:35:34 1.57 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.35 2002/07/03 21:05:33 ng Exp $ +# $Id: grades.pm,v 1.57 2002/10/17 14:35:34 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,7 +30,7 @@ # 7/26 H.K. Ng # 8/20 Gerd Kortemeyer # Year 2002 -# June, July 2002 H.K. Ng +# June-August H.K. Ng # package Apache::grades; @@ -40,326 +40,425 @@ use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; use Apache::lonhomework; +use Apache::loncoursedata; +use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); -sub moreinfo { - my ($request,$reason) = @_; - $request->print("Unable to process request: $reason"); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print('
'."\n"); - if ($ENV{'form.url'}) { - $request->print(''."\n"); - } - if ($ENV{'form.symb'}) { - $request->print(''."\n"); - } -# $request->print(''."\n"); - $request->print(''."\n"); - $request->print("Student:".''."
\n"); - $request->print("Domain:".''."
\n"); - $request->print(''."
\n"); - $request->print('
'); - } - return ''; -} - -sub verifyreceipt { - my $request=shift; - my $courseid=$ENV{'request.course.id'}; -# my $cdom=$ENV{"course.$courseid.domain"}; -# my $cnum=$ENV{"course.$courseid.num"}; - my $receipt=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. - $ENV{'form.receipt'}; - $receipt=~s/[^\-\d]//g; - my $symb=$ENV{'form.symb'}; - unless ($symb) { - $symb=&Apache::lonnet::symbread($ENV{'form.url'}); - } - if ((&Apache::lonnet::allowed('mgr',$courseid)) && ($symb)) { - $request->print('

Verifying Submission Receipt '.$receipt.'

'); - my $matches=0; - my ($classlist) = &getclasslist('all','0'); - foreach my $student ( sort(@{ $$classlist{'all'} }) ) { - my ($uname,$udom)=split(/\:/,$student); - if ($receipt eq - &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { - $request->print('Matching '.$student.'
'); - $matches++; - } - } - $request->printf('

'.$matches." match%s

",$matches <= 1 ? '' : 'es'); -# needs to print who is matched +# ----- These first few routines are general use routines.----- +# +# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +sub getpartlist { + my ($url) = @_; + my @parts =(); + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ( $key =~ m/stores_(\w+)_.*/) { + push(@parts,$key); + } } - return ''; + return @parts; } -sub student_gradeStatus { - my ($url,$udom,$uname) = @_; - my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); - my %record= &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - foreach my $part (&getpartlist($url)) { - my ($temp,$part,$type)=split(/_/,$part); - if ($type eq 'solved') { - my ($status,$foo)=split(/_/,$record{"resource.$part.$type"},2); - $status = 'partial' if ($foo =~ /^partially/); - $status = 'nothing' if ($status eq ''); - return $type,$status; - } - } - return ''; +# --- Get the symbolic name of a problem and the url +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); } +# --- Retrieve the fullname for a user. Return lastname, first middle --- +# --- Generation is attached next to the lastname if it exists. --- sub get_fullname { - my ($sname,$sdom) = @_; + my ($uname,$udom) = @_; my %name=&Apache::lonnet::get('environment', ['lastname','generation', 'firstname','middlename'], - $sdom,$sname); + $udom,$uname); my $fullname; my ($tmp) = keys(%name); if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname=$name{'lastname'}.$name{'generation'}; - if ($fullname =~ /[^\s]+/) { $fullname.=', '; } - $fullname.=$name{'firstname'}.' '.$name{'middlename'}; + $fullname = &Apache::loncoursedata::ProcessFullName + (@name{qw/lastname generation firstname middlename/}); + } else { + &Apache::lonnet::logthis('grades.pm: no name data for '.$uname. + '@'.$udom.':'.$tmp); } return $fullname; } -sub listStudents { - my ($request) = shift; - my $cdom =$ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum =$ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec =$ENV{'form.section'}; - my $submitonly=$ENV{'form.submitonly'}; - - $request->print(< View Submissions for a Student or a Group of Students - Resource: $ENV{'form.url'}

-
 View Options
- View Problem: no - yes -   Submissions: last - all - - - - -
- - - - -ENDTABLEST - if ($ENV{'form.url'}) { - $request->print(''."\n"); - } - if ($ENV{'form.symb'}) { - $request->print(''."\n"); - } - $request->print(''."\n"); - - my ($classlist) = &getclasslist($getsec,'0'); - foreach my $student ( sort(@{ $$classlist{$getsec} }) ) { - my ($sname,$sdom) = split(/:/,$student); - my ($type,$status) = &student_gradeStatus($ENV{'form.url'},$cdom,$sname); - next if ($status eq 'nothing' && $submitonly eq 'yes'); - - my $fullname = &get_fullname($sname,$sdom); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print("\n".''. - ''."\n". - ''."\n". - ''."\n". - ''."\n"); - $request->print(''."\n"); +#--- Get the partlist and the response type for a given problem. --- +#--- Indicate if a response type is coded handgraded or not. --- +sub response_type { + my ($url) = shift; + my $allkeys = &Apache::lonnet::metadata($url,'keys'); + my %seen = (); + my (@partlist,%handgrade); + foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { + if (/^\w+response_\w+.*/) { + my ($responsetype,$part) = split(/_/,$_,2); + my ($partid,$respid) = split(/_/,$part); + $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); + next if ($seen{$partid} > 0); + $seen{$partid}++; + push @partlist,$partid; + } + } + return \@partlist,\%handgrade; +} - $request->print(''); - } - } - $request->print('
 Select  Username  Fullname  Domain  Grade Status 
 '.$sname.'  '.$fullname.'  '.$sdom.'  '.$status.' 
'); - $request->print(''); +#--- Dumps the class list with usernames,list of sections, +#--- section, ids and fullnames for each user. +sub getclasslist { + my ($getsec,$hideexpired) = @_; + 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 (keys(%$classlist)) { + # the following undefs are for 'domain', and 'username' respectively. + my (undef,undef,$end,$start,$id,$section,$fullname,$status)= + @{$classlist->{$_}}; + # still a student? + if (($hideexpired) && ($status ne 'Active')) { + delete ($classlist->{$_}); + next; + } + $section = ($section ne '' ? $section : 'no'); + if ($getsec eq 'all' || $getsec eq $section) { + $sections{$section}++; + $fullnames{$_}=$fullname; + } else { + delete($classlist->{$_}); + } + } + my %seen = (); + my @sections = sort(keys(%sections)); + return ($classlist,\@sections,\%fullnames); } -sub processGroup { - my ($request) = shift; - my $ctr = 0; - my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} - : ($ENV{'form.stuinfo'})); - my $total = scalar(@stuchecked)-1; - if ($stuchecked[0] eq '') { - &userError($request,'No student was selected for viewing/grading.'); - return; - } - foreach (@stuchecked) { - my ($sname,$sdom,$fullname) = split(/:/); - $ENV{'form.student'} = $sname; - $ENV{'form.fullname'} = $fullname; - &submission($request,$ctr,$total); - $ctr++; - } - return 'The End'; +#find user domain +sub finduser { + my ($name) = @_; + my $domain = ''; + if ( $Apache::grades::viewgrades eq 'F' ) { + my %classlist=&Apache::lonnet::dump('classlist', + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + my (@fields) = grep /^$name:/, keys %classlist; + ($name, $domain) = split(/:/,$fields[0]); + return ($name,$domain); + } else { + return ($ENV{'user.name'},$ENV{'user.domain'}); + } } -sub userError { - my ($request, $reason, $step) = @_; - $request->print('

LON-CAPA User Error


'."\n"); - $request->print('Reason: '.$reason.'

'."\n"); - $request->print('Step: '.($step ne '' ? $step : 'Use your browser back button to correct') - .'

'."\n"); +#--- Prompts a user to enter a username. +sub moreinfo { + my ($request,$reason) = @_; + $request->print("Unable to process request: $reason"); + if ( $Apache::grades::viewgrades eq 'F' ) { + $request->print(''."\n"); + if ($ENV{'form.url'}) { + $request->print(''."\n"); + } + if ($ENV{'form.symb'}) { + $request->print(''."\n"); + } + $request->print(''."\n"); + $request->print("Student:".''."
\n"); + $request->print("Domain:".''."
\n"); + $request->print(''."
\n"); + $request->print('
'); + } return ''; } -#FIXME - needs to handle multiple matches -sub finduser { - my ($name) = @_; - my $domain = ''; - if ( $Apache::grades::viewgrades eq 'F' ) { - my ($classlist) = &getclasslist('all','0'); - foreach ( sort(@{ $$classlist{'all'} }) ) { - my ($posname,$posdomain) = split(/:/); - if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } - } - return ($name,$domain); - } else { - return ($ENV{'user.name'},$ENV{'user.domain'}); - } +#--- Retrieve the grade status of a student for all the parts +sub student_gradeStatus { + my ($url,$symb,$udom,$uname,$partlist) = @_; + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my %partstatus = (); + foreach (@$partlist) { + my ($status,$foo) = 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 ($url,$symb) = @_; + my $jscript=''."\n"; + $jscript.= '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n"; + return $jscript; } -sub getclasslist { - my ($getsec,$hideexpired) = @_; - my ($coursedomain,$coursenum) = split(/_/,$ENV{'request.course.id'}); - my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum); - my $now = time; - my (@holdsec,@sections); - foreach my $student (keys(%classlist)) { - my ($end,$start)=split(/:/,$classlist{$student}); - # still a student? - if (($hideexpired) && ($end) && ($end < $now)) { - next; - } - my ($unam,$udom) = split(/:/,$student,2); - my $section = &Apache::lonnet::usection($udom,$unam,$ENV{'request.course.id'}); - $section = ($section ne '-1' ? $section : 'no'); - push @holdsec,$section; - push (@{ $classlist{$getsec} }, $student) if ($getsec eq 'all' || $getsec eq $section); - } - my %seen = (); - foreach my $item (@holdsec) { - push (@sections, $item) unless $seen{$item}++; - } - return (\%classlist,\@sections); -} +#------------------ End of general use routines -------------------- +#------------------------------------------------------------------- -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); +#------------------------------------ Receipt Verification Routines +# +#--- Check whether a receipt number is valid.--- +sub verifyreceipt { + my $request = shift; + + my $courseid = $ENV{'request.course.id'}; + my $receipt = unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. + $ENV{'form.receipt'}; + $receipt =~ s/[^\-\d]//g; + my $url = $ENV{'form.url'}; + my $symb = $ENV{'form.symb'}; + unless ($symb) { + $symb = &Apache::lonnet::symbread($url); } - } - return @parts; -} -sub viewstudentgrade { - my ($url,$symb,$courseid,$student,@parts) = @_; - my $result =''; - my $cellclr = '"#ffffdd"'; - my ($username,$domain) = split(/:/,$student); - - my $fullname = &get_fullname($username,$domain); - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); - - $result.="$username$fullname$domain\n"; - foreach my $part (@parts) { - my ($temp,$part,$type)=split(/_/,$part); - my $score=$record{"resource.$part.$type"}; - if ($type eq 'awarded' || $type eq 'tries') { - $result.=''."\n"; - } elsif ($type eq 'solved') { - my ($status,$foo)=split(/_/,$score,2); - $result.="\n"; + my $title.='

Verifying Submission Receipt '. + $receipt.'

'."\n". + 'Resource: '.$ENV{'form.url'}.'

'."\n"; + + my ($string,$contents,$matches) = ('','',0); + my (undef,undef,$fullname) = &getclasslist('all','0'); + + foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + my ($uname,$udom)=split(/\:/); + if ($receipt eq + &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { + $contents.=' '."\n". + ''.$$fullname{$_}.' '."\n". + ' '.$uname.' '. + ' '.$udom.' '."\n"; + + $matches++; + } } - } - $result.=''; - return $result; -} + if ($matches == 0) { + $string = $title.'No match found for the above receipt.'; + } else { + $string = &jscriptNform($url,$symb).$title. + 'The above receipt matches the following student'. + ($matches <= 1 ? '.' : 's.')."\n". + '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + $contents. + '
 Fullname  Username  Domain 
'."\n"; + } + return $string.&show_grading_menu_form($symb,$url); +} + +#--- This is called by a number of programs. +#--- Called from the Grading Menu - View/Grade an individual student +#--- Also called directly when one clicks on the subm button +# on the problem page. +sub listStudents { + my ($request) = shift; -#FIXME need to look at the metadata spec on what type of data to accept and provide an -#interface based on that, also do that to above function. -sub setstudentgrade { - my ($url,$symb,$courseid,$student,@parts) = @_; - print "set student grade parts=@parts
"; - 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; } + my ($symb,$url) = &get_symb_and_url(); + 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 $submitonly= $ENV{'form.submitonly'} eq '' ? 'all' : $ENV{'form.submitonly'}; + + my $result; + my ($partlist,$handgrade) = &response_type($url); + for (sort keys(%$handgrade)) { + my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + $ENV{'form.handgrade'} = 'yes' if ($handgrade eq 'yes'); + $result.='Part '.(split(/_/))[0].''. + 'Type: '.$responsetype.''. + 'Handgrade: '.$handgrade.''; + } + $result.=''; + + my $viewgrade; + if ($ENV{'form.handgrade'} eq 'yes') { + $viewgrade = 'View/Grade'; } 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"; - } + $viewgrade = 'View'; } - } - if ( scalar(keys(%newrecord)) > 0 ) { - $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; -# &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname); - $result.="Stored away ".scalar(keys(%newrecord))." elements.
\n"; + $result='

 '. + $viewgrade. + ' Submissions for a Student or a Group of Students

'. + ''.$result; + + $request->print(< + function checkSelect(checkBox) { + var ctr=0; + var sense=""; + if (checkBox.length > 1) { + for (var i=0; i +LISTJAVASCRIPT + + $request->print($result); + + my $checkhdgrade = $ENV{'form.handgrade'} eq 'yes' ? 'checked' : ''; + my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked'; + + my $gradeTable='
'."\n". + ' View Problem: no '."\n". + ' yes
'."\n". + ' Submissions: '."\n"; + if ($ENV{'form.handgrade'} eq 'yes') { + $gradeTable.=' handgrade only'."\n"; + } + $gradeTable.=' last sub only'."\n". + ' last sub & parts info'."\n". + ' all details'."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n". + '
'."\n". + ''."\n". + ''."\n". + 'To '.lc($viewgrade).' a submission, click on the check box next to the student\'s name. Then '."\n". + 'click on the '.$viewgrade.' button. To view the submissions for a group of students, click'."\n". + ' on the check boxes for the group of students.
'."\n". + ''."\n". + ''."\n"; + + my (undef,undef,$fullname) = &getclasslist($getsec,'0'); + + $gradeTable.='
'. + 'Resource: '.$url.'
'. + ''. + ''. + ''; + foreach (sort(@$partlist)) { + $gradeTable.=''; + } + $gradeTable.=''."\n"; + + my $ctr = 0; + foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + my ($uname,$udom) = split(/:/,$student); + my (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); + my $statusflg = ''; + foreach (keys(%status)) { + $statusflg = 1 if ($status{$_} ne 'nothing'); + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $statusflg = ''; + $gradeTable.=''; + } + } + next if ($statusflg eq '' && $submitonly eq 'yes'); + + $ctr++; + if ( $Apache::grades::viewgrades eq 'F' ) { + $gradeTable.=''. + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + foreach (sort keys(%status)) { + next if (/^resource.*?submitted_by$/); + $gradeTable.=''."\n"; + } + $gradeTable.=''."\n"; + } + } + $gradeTable.='
 Select  Fullname  Username  Domain  Part '.(split(/_/))[0].' Status 
 '.$$fullname{$student}.'  '.$uname.'  '.$udom.'  '.$status{$_}.' 
'. + ''."\n"; + if ($ctr == 0) { + $gradeTable='
 '. + 'No submission found for this resource.
'; + } elsif ($ctr == 1) { + $gradeTable =~ s/type=checkbox/type=checkbox checked/; + } + $gradeTable.=&show_grading_menu_form($symb,$url); + $request->print($gradeTable); + return ''; } -# -# --------------------------- show submissions of a student, option to grade -------- -sub submission { - my ($request,$counter,$total) = @_; +#---- Called from the listStudents routine +# Displays the submissions for one student or a group of students +sub processGroup { + my ($request) = shift; + my $ctr = 0; + my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} + : ($ENV{'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 ''; +} - if ($counter == 0) { - $request->print(<print(< - function updateRadio(radioButton,formtextbox,formsel,wgt) { + function updateRadio(radioButton,formtextbox,formsel,scores,weight) { var pts = formtextbox.value; var resetbox =false; if (isNaN(pts) || pts < 0) { - alert("A number equal or greater than 0 is expected. Entered value = "+pts); - for (var i=0; i weight) { + var resp = confirm("You entered a value ("+pts+ + ") greater than the weight for the part. Accept?"); + if (resp == false) { + formtextbox.value = ""; + return; + } } for (var i=0; i 0 && pts < wgt) { - formsel[4].selected = true; + function clearRadBox(radioButton,formbox,formsel,scores) { + for (var i=0; i -JAVASCRIPT -} - (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) { - $request->print('

Submission Record

'); +//====================== Script for composing message ============== + function msgCenter(msgform,usrctr,fullname) { + var Nmsg = msgform.savemsgN.value; + savedMsgHeader(Nmsg,usrctr,fullname); + var subject = msgform.msgsub.value; + var rtrchk = eval("document.SCORE.includemsg"+usrctr); + var msgchk = rtrchk.value; + re = /msgsub/; + var shwsel = ""; + if (re.test(msgchk)) { shwsel = "checked" } + displaySubject(subject,shwsel); + for (var i=1; i<=Nmsg; i++) { + var testpt = "savemsg"+i+","; + re = /testpt/; + shwsel = ""; + if (re.test(msgchk)) { shwsel = "checked" } + var message = eval("document.SCORE.savemsg"+i+".value"); + displaySavedMsg(i,message,shwsel); + } + newmsg = eval("document.SCORE.newmsg"+usrctr+".value"); + shwsel = ""; + re = /newmsg/; + if (re.test(msgchk)) { shwsel = "checked" } + newMsg(newmsg,shwsel); + msgTail(); + return; } -# -# 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' && $counter == 0) { - 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.='
'; - $result.='Student\'s view of the problem
'.$rendered.'
'; - $result.='Correct answer:
'.$companswer; - $result.='
'; - $result.='

'; - $request->print($result); - } -# -# beginning of form - if ($counter == 0) { - my %keyhash = &Apache::lonnet::get - ('nohist_handgrade',[$symb.'_keywords'], - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - - $request->print('
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n"); - - if ($ENV{'form.handgrade'} eq 'yes') { - $request->print(<Grading Options -Keywords list    -Add a message    -Saved messages

-KEYWORDS - } + function savedMsgHeader(Nmsg,usrctr,fullname) { + var height = 30*Nmsg+250; + var scrollbar = "no"; + if (height > 600) { + height = 600; + scrollbar = "yes"; + } +/* if (window.pWin) + window.pWin.close(); */ + pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx=70,screeny=75,width=600,height='+height); + pWin.document.write(""); + pWin.document.write("Message Central"); + + pWin.document.write(" +SUBJAVASCRIPT +} + + +# --------------------------- 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) = ($ENV{'form.student'},$ENV{'form.userdom'}); + ($uname,$udom) = &finduser($uname) if $udom eq ''; + $ENV{'form.fullname'} = &get_fullname ($uname,$udom) if $ENV{'form.fullname'} eq ''; +# 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' : ''); + $ENV{'form.vProb'} = $ENV{'form.vProb'} ne '' ? $ENV{'form.vProb'} : 'yes'; + + # header info + if ($counter == 0) { + &sub_page_js($request); + $request->print('

 Submission Record

'."\n". + ' Resource: '.$url.''."\n"); + + # option to display problem, only once else it cause problems + # with the form later since the problem has a form. + if ($ENV{'form.vProb'} eq 'yes') { + 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.='
'; + $result.=' View of the problem - '.$ENV{'form.fullname'}. + '
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + $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'; + + } + + $request->print(''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"); + + my ($cts,$prnmsg) = (1,''); + while ($cts <= $ENV{'form.savemsgN'}) { + $prnmsg.=''."\n"; + $cts++; + } + $request->print($prnmsg); + + if ($ENV{'form.handgrade'} eq 'yes' && $ENV{'form.showgrading'} eq 'yes') { + $request->print(<Keyword Options:  +List    +Paste Selection to List    +Highlight Attribute

+KEYWORDS + } + } + + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my ($partlist,$handgrade) = &response_type($url); + + # Display student info + $request->print(($counter == 0 ? '' : '
')); + my $result=''; - $result.=''."\n"; - $result.='\n"; + $result.=''; + $result.=''."\n"; + $result.='
'."\n". + '
'."\n"; + + $result.='Fullname: '.$ENV{'form.fullname'}. + '   Username: '.$uname.''. + '   Domain: '.$udom.'
'."\n"; + $result.=''."\n"; + + # If this is handgraded, then check for collaborators + my @col_fullnames; + my ($classlist,$fullname); + if ($ENV{'form.handgrade'} eq 'yes') { + my @col_list; + ($classlist,undef,$fullname) = &getclasslist('all','0'); + for (keys (%$handgrade)) { + my $ncol = &Apache::lonnet::EXT('resource.'.$_. + '.maxcollaborators', + $symb,$udom,$uname); + next if ($ncol <= 0); + s/\_/\./g; + next if ($record{'resource.'.$_.'.collaborators'} eq ''); + my (@collaborators) = split(/,?\s+/, + $record{'resource.'.$_.'.collaborators'}); + my (@badcollaborators); + if (scalar(@collaborators) != 0) { + $result.='Collaborators: '; + foreach my $collaborator (@collaborators) { + my ($co_name,$co_dom) = split /\@|:/,$collaborator; + $co_dom = $udom if (! defined($co_dom)); + next if ($co_name eq $uname && $co_dom eq $udom); + # Doing this grep allows 'fuzzy' specification + my @Matches = grep /^$co_name:$co_dom/i, + keys %$classlist; + if (! scalar(@Matches)) { + push @badcollaborators,$collaborator; + next; + } + push @col_list, @Matches; + foreach (@Matches) { + my ($lastname,$givenn) = split(/,/,$$fullname{$_}); + push @col_fullnames, $givenn.' '.$lastname; + $result.=$$fullname{$_}.'     '; + } + } + $result.='
'."\n"; + if (scalar(@badcollaborators) > 0) { + $result.=''."\n"; + } else { + for my $part (sort keys(%$handgrade)) { + foreach (@$string) { + my ($partid,$respid) = /^resource\.(\d+)\.(\d+)\.submission/; + if ($part eq ($partid.'_'.$respid)) { + my ($ressub,$subval) = split(/:/,$_,2); + $lastsubonly.=''."\n" + if ($ENV{'form.lastSub'} eq 'lastonly' || + ($ENV{'form.lastSub'} eq 'hdgrade' && + $$handgrade{$part} =~ /:yes$/)); + } + } + } + } + $lastsubonly.=''."\n"; + $request->print($lastsubonly); + } + } else { + $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, + $ENV{'request.course.id'}, + $last,'.submission', + 'Apache::grades::keywords_highlight')); + } + + # return if view submission with no grading option + if ($ENV{'form.showgrading'} eq '') { + $request->print('
'; + $result.='This student has submitted '; + if (scalar(@badcollaborators) == 1) { + $result .= 'an invalid collaborator'; + } else { + $result .= 'invalid collaborators'; + } + $result .= ': '.join(', ',@badcollaborators); + + } + if (scalar(@collaborators > $ncol)) { + $result .= '
'; + $result .= 'This student has sumbitted too many '. + 'collaborators. Maximum is '.$ncol; + $result .= '
'; + } + $result.=''."\n"; + } + } + } + $request->print($result."\n"); + + # print student answer/submission + # Options are (1) Handgaded submission only + # (2) Last submission, includes submission that is not handgraded + # (for multi-response type part) + # (3) Last submission plus the parts info + # (4) The whole record for this student + if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { + if ($ENV{'form.'.$uname.':'.$udom.':submitted_by'}) { + my $submitby=''. + 'Collaborative submission by: '. + ''. + $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.''; + $request->print($submitby); + } else { + my ($string,$timestamp)= + &get_last_submission (%record); + my $lastsubonly.=''. + ($$timestamp eq '' ? '' : 'Date Submitted: '. + $$timestamp).''; + if ($$timestamp eq '') { + $lastsubonly.='
'.$$string[0].'
Part '. + $partid.' ( ID '.$respid. + ' )   Answer: '. + &keywords_highlight($subval).'
'."\n"); + return; + } + + # Grading options + $result=''."\n". + ''."\n". + ''."\n"; + my ($lastname,$givenn) = split(/,/,$ENV{'form.fullname'}); + my $msgfor = $givenn.' '.$lastname; + if (scalar(@col_fullnames) > 0) { + my $lastone = pop @col_fullnames; + $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; + } + $result.='
'."\n". + ' '. + 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').''. + '
 (Message will be sent when you click on Save & Next below.)'."\n" + if ($ENV{'form.handgrade'} eq 'yes'); + $request->print($result); + + my %seen = (); + my @partlist; + for (sort keys(%$handgrade)) { + my ($partid,$respid) = split(/_/); + next if ($seen{$partid} > 0); + $seen{$partid}++; + next if ($$handgrade{$_} =~ /:no$/); + push @partlist,$partid; + 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 '' ? + '' : $record{'resource.'.$partid.'.awarded'}*$wgt); + $result=''; + $result.='' : ''); + $ctr++; + } + $result.='
Part '.$partid.' Points: '; + + my $ctr = 0; + $result.=''; # display radio buttons in a nice table 10 across + while ($ctr<=$wgt) { + $result.= '\n"; - $result.=(($ctr+1)%10 == 0 ? '' : ''); - $ctr++; - } - $result.='
'.$ctr."
'; + $result.=(($ctr+1)%10 == 0 ? '
'; - $result.='		 or /'.$wgt.' '.$wgtmsg.' '; - - foreach my $part (&getpartlist($url)) { - my ($temp,$part,$type)=split(/_/,$part); - if ($type eq 'solved') { - my ($status,$foo)=split(/_/,$record{"resource.$part.$type"},2); - $status = 'partial' if ($foo =~ /partially/); - $status = 'nothing' if ($status eq ''); - $result.='
 or /'.$wgt.' '.$wgtmsg.' '; + + $result.=''."  \n"; + $result.=''; + $result.='
'."\n"; + $request->print($result); + } + $result=''."\n"; + my $ctr = 0; + while ($ctr < scalar(@partlist)) { + $result.=''."\n"; + $ctr++; + } + $request->print($result.''."\n"); + + # print end of form + if ($counter == $total) { + my $endform='
'. + ''."\n"; + if ($ENV{'form.handgrade'} eq 'yes') { + $endform.='  '."\n"; + my $ntstu =''."\n"; + my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1'); + $ntstu =~ s/
'; + $endform.=&show_grading_menu_form($symb,$url); + $request->print($endform); } - } - $result.=''; - $request->print($result); -# -# print end of form - if ($counter == $total) { - my $endform.='
'; - my $ntstu =''."\n"; - my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1'); - $ntstu =~ s/
'; - $request->print($endform); - } - return ''; + return ''; } +#--- Retrieve the last submission for all the parts sub get_last_submission { - my ($symb,$username,$domain,$course)=@_; - if ($symb) { - my (%returnhash)=&Apache::lonnet::restore($symb,$course,$domain,$username); - if ($returnhash{'version'}) { + my (%returnhash)=@_; + my (@string,$timestamp); + if ($returnhash{'version'}) { my %lasthash=(); - my $version; + my ($version); for ($version=1;$version<=$returnhash{'version'};$version++) { - foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { - $lasthash{$_}=$returnhash{$version.':'.$_}; - } - } + foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { + $lasthash{$_}=$returnhash{$version.':'.$_}; + if ($returnhash{$version.':'.$_} =~ /(SUBMITTED|DRAFT)$/) { + $timestamp = scalar(localtime($returnhash{$version.':timestamp'})); + } + } + } foreach ((keys %lasthash)) { - if ($_ =~ /\.submission$/) {return $lasthash{$_}} + if ($_ =~ /\.submission$/) { + my ($partid,$foo) = split(/submission$/,$_); + my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? + 'Draft Copy ' : ''; + push @string, (join(':',$_,$draft.$lasthash{$_})); + } } - return ''; } - } + @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; + return \@string,\$timestamp; } +#--- High light keywords, with style choosen by user. sub keywords_highlight { - my $string = shift; - (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))); - my %keyhash = &Apache::lonnet::get - ('nohist_handgrade',[$symb.'_keywords'], - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - my @keylist = split(/[,\s+]/,$keyhash{$symb.'_keywords'}); - foreach my $word (@keylist) { - next if ($word eq ''); - $string =~ s/\b$word(\b|\.)/\$word\<\/font\>/gi; - } - return $string; + 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; + } + # This is not really the right place to do this, but I cannot find a + # better one at this time. So here we go - the m in the s:::mg causes + # ^ to match the beginning of a new line. So we replace(???) the beginning + # of the line with
to make things formatted a little better. + $string =~ s:^:
:mg; + return $string; } +#--- Called from submission routine 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 $keywords= $ENV{'form.keywords'}; - my $addmsg = $ENV{'form.addmsg'}; - print "addmsg=$addmsg
"; - if ($keywords ne '') { - my $crsname = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $crsdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $putresult = &Apache::lonnet::put - ('nohist_handgrade',{$symb.'_keywords' => $keywords}, - $crsdom,$crsname); - } - my (@parts) = sort(&getpartlist($url)); + 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'}; + + if ($button eq 'Save & Next') { + my $ctr = 0; + while ($ctr < $ngrade) { + my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); + my ($errorflag) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr); + + 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, + $ENV{'form.unamedom'.$ctr}); + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom, + $ENV{'form.msgsub'}, + $message); + } + } + } + $ctr++; + } + } - if ($button eq 'Save & Next') { - my $ctr = 0; - while ($ctr < $ENV{'form.NCT'}) { - my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); - &saveHandGrade($url,$symb,$uname,$udom,$ctr,@parts); - if ($ENV{'form.collaborator'.$ctr}) { - my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr}); - foreach (@collaborators) { - &saveHandGrade($url,$symb,$_,$udom,$ctr,@parts); - } - } - $ctr++; - } - } - my $firststu = $ENV{'form.unamedom0'}; - my $laststu = $ENV{'form.unamedom'.($ngrade-1)}; + # 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, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + # Called by Save & Refresh from Highlight Attribute Window + if ($ENV{'form.refresh'} eq 'on') { + my $ctr = 0; + $ENV{'form.NTSTU'}=$ngrade; + while ($ctr < $ngrade) { + ($ENV{'form.student'},$ENV{'form.userdom'}) = split(/:/,$ENV{'form.unamedom'.$ctr}); + &submission($request,$ctr,$ngrade-1); + $ctr++; + } + return ''; + } - my ($classlist) = &getclasslist($ENV{'form.section'},'0'); + # Get the next/previous one or group of students + 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 (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); + my (@parsedlist,@nextlist); + my ($nextflg) = 0; + foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$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; + 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'},$symb,$udom,$uname,$partlist) ; + my $statusflg = ''; + foreach (keys(%status)) { + $statusflg = 1 if ($status{$_} ne 'nothing'); + my ($foo,$partid,$foo1) = split(/\./); + $statusflg = '' if ($status{'resource.'.$partid.'.submitted_by'} ne ''); + } + next if ($statusflg eq ''); + } + push @nextlist,$student if ($ctr < $ntstu); + $ctr++; + } - my (@nextlist,@prevlist); - my ($nextflg,$prevflg,$ctr,$ctprev) = (0,0,0,0); - foreach my $student ( sort(@{ $$classlist{$ENV{'form.section'}} }) ) { - my ($uname,$udom) = split(/:/,$student); - if ($nextflg == 1 && $button =~ /Next$/) { - push @nextlist,$uname if ($ctr < $ntstu); - $ctr++; - } - $nextflg = 1 if ($student eq $laststu); - $prevflg = 1 if ($student eq $firststu); - if ($prevflg == 0 && $button eq 'Previous') { - push @prevlist,$uname; - $ctprev++; - } - } - if ($button eq 'Previous') { - if ($ctprev <= $ntstu) { - @nextlist = @prevlist; - } else { - my $idx = 0; - my $start = $ctprev - $ntstu; - while ($idx < $ntstu) { - $nextlist[$idx] = $prevlist[$start+$idx]; - $idx++; - } - } - } - $ctr = 0; - my $total = scalar(@nextlist)-1; - foreach my $student (@nextlist) { - $ENV{'form.student'} = $student; - &submission($request,$ctr,$total); - $ctr++; - } + $ctr = 0; + my $total = scalar(@nextlist)-1; - return 'The End'; + foreach (sort @nextlist) { + my ($uname,$udom,$submitter) = split(/:/); + $ENV{'form.student'} = $uname; + $ENV{'form.userdom'} = $udom; + $ENV{'form.fullname'} = $$fullname{$_}; +# $ENV{'form.'.$_.':submitted_by'} = $submitter; +# print "submitter=$ENV{'form.'.$_.':submitted_by'}= $submitter:
"; + &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 ''; } +#---- Save the score and award for each student, if changed sub saveHandGrade { - my ($url,$symb,$stuname,$domain,$newflg,@parts) = @_; - my %record=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); - my %newrecord; - - foreach my $part (@parts) { - my ($temp,$part,$type)=split(/_/,$part); - my $oldscore=$record{"resource.$part.$type"}; - my $newscore; - if ($type eq 'awarded' && $newflg >= 0) { - my $pts = ($ENV{'form.GRADE_BOX'.$newflg} ne '' ? - $ENV{'form.GRADE_BOX'.$newflg} : $ENV{'form.RADVAL'.$newflg}); - my $wgt = $ENV{'form.WGT'.$newflg}; -# my $sel = $ENV{'form.GRADE_SEL'.$newflg}; - $newscore = $pts/$wgt if ($wgt != 0); - } - if ($type eq 'solved') { - $newscore = $ENV{'form.GRADE_SEL'.$newflg} if ($newflg >= 0); - my $update=0; - if ($newscore eq 'nothing' ) { - if ($oldscore ne '') { - $update=1; - $newscore = ''; - } - } elsif ($oldscore !~ m/^$newscore/) { - $update=1; - 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'; } - } - if ($update) { $newrecord{"resource.$part.$type"}=$newscore; } - } else { - if ($oldscore ne $newscore) { - $newrecord{"resource.$part.$type"}=$newscore; - } + my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_; + my %record=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); + my %newrecord; + foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { + if ($ENV{'form.GD_SEL'.$newflg.'_'.$_} eq 'excused') { + $newrecord{'resource.'.$_.'.solved'} = 'excused' + if ($record{'resource.'.$_.'.solved'} ne 'excused'); + } else { + my $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? + $ENV{'form.GD_BOX'.$newflg.'_'.$_} : + $ENV{'form.RADVAL'.$newflg.'_'.$_}); + my $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : + $ENV{'form.WGT'.$newflg.'_'.$_}; + my $partial= $pts/$wgt; + $newrecord{'resource.'.$_.'.awarded'} = $partial + if ($record{'resource.'.$_.'.awarded'} ne $partial); + my $reckey = 'resource.'.$_.'.solved'; + if ($partial == 0) { + $newrecord{$reckey} = 'incorrect_by_override' + if ($record{$reckey} ne 'incorrect_by_override'); + } else { + $newrecord{$reckey} = 'correct_by_override' + if ($record{$reckey} ne 'correct_by_override'); + } + $newrecord{'resource.'.$_.'.submitted_by'} = $submitter + if ($submitter && ($record{'resource.'.$_.'.submitted_by'} ne $submitter)); + } } - } - if ( scalar(keys(%newrecord)) > 0 ) { - $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; -# while (my ($k,$v) = each %newrecord) { -# print "k=$k:v=$v:
\n"; -# } -# print "symb=$symb,courseid=$ENV{'request.course.id'},dom=$domain,name=$stuname
"; -# &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},$domain,$stuname); - } - return ''; -} -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); + if (scalar(keys(%newrecord)) > 0) { + $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + &Apache::lonnet::cstore(\%newrecord,$symb, + $ENV{'request.course.id'},$domain,$stuname); + } + return ''; } -sub show_grading_menu_form { - my ($symb,$url)=@_; - my $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - '
'."\n"; - return $result; -} +#-------------------------------------------------------------------------------------- +# +#-------------------------- 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; -sub gradingmenu { - my ($request) = @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - my $allkeys = &Apache::lonnet::metadata($url,'keys'); - my $handgrade = ($allkeys =~ /parameter_.*?_handgrade/ ? 'yes' : 'no'); - my ($responsetype,$foo) = split(/_/,&Apache::lonnet::metadata($url,'packages')); - - my $result='

 Select a Grading Method

'; - $result.=''; - $result.=''. - ''; - $result.=''. - ''; - $result.='
Resource: '.$url.'
Type: '.$responsetype.'  Handgrade: '.$handgrade.'
'; - - $result.=&view_edit_entire_class_form($symb,$url).'
'; - $result.=&upcsvScores_form($symb,$url).'
'; - $result.=&viewGradeaStu_form($symb,$url,$responsetype,$handgrade).'
'; - $result.=&verifyReceipt_form($symb,$url); - return $result; -} + $request->print(< + function writePoint(partid,weight,point) { + var radioButton = eval("document.classgrade.RADVAL_"+partid); + var textbox = eval("document.classgrade.TEXTVAL_"+partid); + if (point == "textval") { + var point = eval("document.classgrade.TEXTVAL_"+partid+".value"); + if (isNaN(point) || point < 0) { + alert("A number equal or greater than 0 is expected. Entered value = "+point); + var resetbox = false; + for (var i=0; i weight) { + var resp = confirm("You entered a value ("+point+ + ") greater than the weight for the part. Accept?"); + if (resp == false) { + textbox.value = ""; + return; + } + } + for (var i=0; i'."\n". - ''."\n". - ''."\n"; - $result.=' Display students who has: '. - ' submitted'. - ' everybody

'; - $result.=' '."\n"; - $result.=''."\n"; - $result.=''."\n"; - return $result; -} + } else { + textbox.value = point; + } + for (i=0;i - - - -$upfile_select -
  - -ENDUPFORM - $result.=''."\n"; - $result.=''."\n"; - return $result; -} + function writeRadText(partid,weight) { + var selval = eval("document.classgrade.SELVAL_"+partid); + var radioButton = eval("document.classgrade.RADVAL_"+partid); + var textbox = eval("document.classgrade.TEXTVAL_"+partid); + if (selval[1].selected) { + for (var i=0; i weight) { + var resp = confirm("You entered a value ("+point+ + ") greater than the weight of the part. Accept?"); + if (resp == false) { + textbox.value = ""; + return; + } + } + selval[0].selected = true; + } -sub viewGradeaStu_form { - my ($symb,$url,$response,$handgrade) = @_; - my ($classlist,$sections) = &getclasslist('all','0'); - my $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' View/Grade an Individual Student\'s Submission
'."\n"; - $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n"; - - $result.=' Select section: '."\n"; - $result.='  Display students who has: '. - ' submitted'. - ' everybody
'; - $result.=' (Section "no" implies the students were not assigned a section.)
' - if (grep /no/,@$sections); - - $result.='
 '."\n". - '
'."\n"; - $result.='
'."\n"; - $result.='
'."\n"; - return $result; -} + function changeOneScore(partid,user) { + var selval = eval("document.classgrade.GD_"+user+'_'+partid+"_solved"); + if (selval[1].selected) { + var boxval = eval("document.classgrade.GD_"+user+'_'+partid+"_awarded"); + boxval.value = ""; + } + } -sub verifyReceipt_form { - my ($symb,$url) = @_; - my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"}; - my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}); - - my $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' Verify a Submission Receipt Issued by this Server
'."\n"; - $result.='
'."\n"; - $result.=' '.$hostver.'-
'."\n"; - $result.=' '."\n"; - $result.=''."\n"; - if ($ENV{'form.url'}) { - $result.=''; - } - if ($ENV{'form.symb'}) { - $result.=''; - } - $result.='
'; - $result.='
'."\n"; - $result.='
'."\n"; - return $result; + function resetEntry(numpart) { + for (ctpart=0;ctpart +VIEWJAVASCRIPT } +#--- show scores for a section or whole class w/ option to change/update a score sub viewgrades { - my ($request) = @_; - my $result=''; + my ($request) = shift; + &viewgrades_js($request); + + my ($symb,$url) = ($ENV{'form.symb'},$ENV{'form.url'}); + my $result='

Manual Grading

'; + + $result.='Resource: '.$ENV{'form.url'}.''."\n"; - #get resource reference - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - #get classlist - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - #print "Found $cdom:$cnum
"; - my ($classlist) = &getclasslist('all','0'); - my $headerclr = '"#ccffff"'; - my $cellclr = '"#ffffcc"'; - - #get list of parts for this problem - my (@parts) = sort(&getpartlist($url)); - - $request->print ("

Manual Grading

"); - - #start the form - $result = '
'."\n". - ''."\n". - ''."\n". + #view individual student submission form - called using Javascript viewOneStudent + $result.=&jscriptNform($url,$symb); + + #beginning of class grading form + $result.= ''."\n". + ''."\n". + ''."\n". ''."\n". - ''."\n". - '
'."\n". - ''."\n". - ''."\n"; - foreach my $part (@parts) { - my $display=&Apache::lonnet::metadata($url,$part.'.display'); - if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } - $result.=''."\n"; - } - $result.=''; - #get info for each student - foreach my $student ( sort(@{ $$classlist{'all'} }) ) { - my $display=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); -# print "ID=$ENV{'request.course.id'}:STU=$student:DIS=$display:
\n"; - $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); - } - $result.='
UsernameNameDomain'.$display.'
'; - $result.='
'; - $result.=&show_grading_menu_form($symb,$url); - return $result; + ''."\n"; + $result.='

Assign Common Grade To '; + if ($ENV{'form.section'} eq 'all') { + $result.='Class

'; + } elsif ($ENV{'form.section'} eq 'no') { + $result.='Students in no Section '; + } else { + $result.='Students in Section '.$ENV{'form.section'}.''; + } + $result.= '
'."\n". + '
'; +# $result.='To assign the same score for all the students use the radio buttons or '. +# 'text box below. To assign scores individually fill in the score boxes for '. +# 'each student in the table below. A part that has already '. +# 'been graded does not get changed using the radio buttons or text box. '. +# 'If needed, it has to be changed individually.'; +# $result.='
'; + #radio buttons/text box for assigning points for a section or class. + #handles different parts of a problem + my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); + my %weight = (); + my $ctsparts = 0; + $result.=''; + my %seen = (); + for (sort keys(%$handgrade)) { + my ($partid,$respid) = split (/_/,$_,2); + next if $seen{$partid}; + $seen{$partid}++; + my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); + $weight{$partid} = $wgt eq '' ? '1' : $wgt; + + $result.=''."\n"; + $result.=''."\n"; + $result.=''."\n"; + $result.= ''."\n"; + $ctsparts++; + } + $result.='
Part '.$partid.'   Point: '; + $result.=''; + my $ctr = 0; + while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across + $result.= '\n"; + $result.=(($ctr+1)%10 == 0 ? '' : ''); + $ctr++; + } + $result.='
'.$ctr."
'; + $result.= '		 or /'. + $weight{$partid}.' (problem weight)
'.'
'.'
'."\n". + ''; + $result.='    '; + $result.=''."\n"; + + #table listing all the students in a section/class + #header of table + $result.= '

Assign Grade to Specific Students in '; + if ($ENV{'form.section'} eq 'all') { + $result.='the Class

'; + } elsif ($ENV{'form.section'} eq 'no') { + $result.='no Section '; + } else { + $result.='Section '.$ENV{'form.section'}.''; + } + $result.= '
'."\n". + ''. + ''."\n"; + my (@parts) = sort(&getpartlist($url)); + foreach my $part (@parts) { + my $display=&Apache::lonnet::metadata($url,$part.'.display'); + if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } + if ($display =~ /^Partial Credit Factor/) { + my ($partid) = &split_part_type($part); + $result.=''."\n"; + next; + } + $display =~ s|Problem Status|Grade Status
|; + $result.=''."\n"; + } + $result.=''; + + #get info for each student + #list all the students - with points and grade status + my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); + my $ctr = 0; + foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + my ($uname,$udom) = split(/:/); + $result.=''."\n"; + $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'}, + $_,$$fullname{$_},\@parts,\%weight); + $ctr++; + } + $result.='
FullnameUsernameDomainScore Part '.$partid.'
(weight = '. + $weight{$partid}.')		'.$display.'
'; + $result.=''."\n"; + $result.=''."\n"; + $result.=&show_grading_menu_form($symb,$url); + return $result; +} + +#--- call by previous routine to display each student +sub viewstudentgrade { + my ($url,$symb,$courseid,$student,$fullname,$parts,$weight) = @_; + my ($uname,$udom) = split(/:/,$student); + my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); + my $result=''. + ''.$fullname.''. + ''.$uname.''.$udom.''."\n"; + foreach my $part (@$parts) { + my ($part,$type) = &split_part_type($part); + my $score=$record{"resource.$part.$type"}; + if ($type eq 'awarded') { + my $pts = $score eq '' ? '' : $score*$$weight{$part}; + $result.=''."\n"; + $result.=''."\n"; + } elsif ($type eq 'solved') { + my ($status,$foo)=split(/_/,$score,2); + $status = 'nothing' if ($status eq ''); + $result.=''."\n"; + $result.='\n"; + } else { + $result.=''. + "\n"; + $result.=''."\n"; + } + } + $result.=''; + return $result; } +#--- change scores for all the students in a section/class +# record does not get update if unchanged sub editgrades { - my ($request) = @_; - my $result=''; + my ($request) = @_; - 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.='
'."\n". - ''."\n". - ''."\n". - ''."\n". - '
'."\n"; + my $symb=$ENV{'form.symb'}; + my $url =$ENV{'form.url'}; + my $title='

Current Grade Status

'; + $title.='Resource: '.$ENV{'form.url'}.'
'."\n"; + $title.='Section: '.$ENV{'form.section'}.''."\n"; + $title.= &show_grading_menu_form ($symb,$url); + my $result= '
'."\n"; + $result.= ''. + ''."\n"; + + my %scoreptr = ( + 'correct' =>'correct_by_override', + 'incorrect'=>'incorrect_by_override', + 'excused' =>'excused', + 'ungraded' =>'ungraded_attempted', + 'nothing' => '', + ); + my ($classlist,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); + + my (@partid); + my %weight = (); + my %columns = (); + my ($i,$ctr,$count,$rec_update) = (0,0,0,0); + + my (@parts) = sort(&getpartlist($url)); + my $header; + while ($ctr < $ENV{'form.totalparts'}) { + my $partid = $ENV{'form.partid_'.$ctr}; + push @partid,$partid; + $weight{$partid} = $ENV{'form.weight_'.$partid}; + $ctr++; + } + foreach my $partid (@partid) { + $header .= ''. + ''; + $columns{$partid}=2; + foreach my $stores (@parts) { + my ($part,$type) = &split_part_type($stores); + if ($part !~ m/^\Q$partid\E/) { next;} + if ($type eq 'awarded' || $type eq 'solved') { next; } + my $display=&Apache::lonnet::metadata($url,$stores.'.display'); + $display =~ s/\[Part: (\w)+\]//; + $header .= ''. + ''; + $columns{$partid}+=2; + } + } + foreach my $partid (@partid) { + $result .= ''; + + } + $result .= ''; + $result .= $header; + $result .= ''."\n"; + + for ($i=0; $i<$ENV{'form.total'}; $i++) { + my $user = $ENV{'form.ctr'.$i}; + my %newrecord; + my $updateflag = 0; + my @userdom = grep /^$user:/,keys %$classlist; + my (undef,$udom) = split(/:/,$userdom[0]); + + $result .= ''; + foreach (@partid) { + my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'}; + my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1); + my $old_part = $old_aw eq '' ? '' : $old_part_pcr; + my $old_score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_solved_s'}}; + + my $awarded = $ENV{'form.GD_'.$user.'_'.$_.'_awarded'}; + my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1); + my $partial = $awarded eq '' ? '' : $pcr; + my $score; + if ($partial eq '') { + $score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_solved_s'}}; + } elsif ($partial > 0) { + $score = 'correct_by_override'; + } elsif ($partial == 0) { + $score = 'incorrect_by_override'; + } + $score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_solved'} eq 'excused') && + ($score ne 'excused')); + $result .= ''. + ''; + + if (!($old_part eq $partial && $old_score eq $score)) { + $updateflag = 1; + $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; + $newrecord{'resource.'.$_.'.solved'} = $score; + $rec_update++; + } + + my $partid=$_; + foreach my $stores (@parts) { + my ($part,$type) = &split_part_type($stores); + if ($part !~ m/^\Q$partid\E/) { next;} + if ($type eq 'awarded' || $type eq 'solved') { next; } + my $old_aw = $ENV{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'}; + my $awarded = $ENV{'form.GD_'.$user.'_'.$part.'_'.$type}; + if ($awarded ne '' && $awarded ne $old_aw) { + $newrecord{'resource.'.$part.'.'.$type}= $awarded; + $updateflag=1; + } + $result .= ''. + ''; + } + } + $result .= ''."\n"; + if ($updateflag) { + $count++; + $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'}, + $udom,$user); + } + } + $result .= '
UsernameFullname Old Score  New Score  Old '.$display.'  New '.$display.' Part '.$partid. + ' (Weight = '.$weight{$partid}.')
'.$user.' '. + $$fullname{$userdom[0]}.' '.$old_aw.' '.$awarded. + ($score eq 'excused' ? $score : '').' '.$old_aw.' '.$awarded.' 
'."\n"; + my $msg = 'Number of records updated = '.$rec_update. + ' for '.$count.' student'.($count <= 1 ? '' : 's').'.
'. + 'Total number of students = '.$ENV{'form.total'}.'
'; + return $title.$msg.$result; +} + +sub split_part_type { + my ($partstr) = @_; + my ($temp,@allparts)=split(/_/,$partstr); + my $type=pop(@allparts); + my $part=join('.',@allparts); + return ($part,$type); +} - foreach my $student ( sort(@{ $$classlist{'all'} }) ) { - $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); - } +#------------- end of section for handling grading by section/class --------- +# +#---------------------------------------------------------------------------- - $result.='
'; - return $result; -} +#---------------------------------------------------------------------------- +# +#-------------------------- Next few routines handles grading by csv upload +# +#--- Javascript to handle csv upload sub csvupload_javascript_reverse_associate { return(<print(<'; + my ($partlist,$handgrade) = &response_type($url); + my ($resptype,$hdgrade)=('','no'); + for (sort keys(%$handgrade)) { + my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + $resptype = $responsetype; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.='Part '.(split(/_/))[0].''. + 'Type: '.$responsetype.''. + 'Handgrade: '.$handgrade.''; + } + $result.=''; + $request->print(< -

Uploading Class Grades for resource $url

+

Uploading Class Grades

+$result

Identify fields

Total number of records found in file: $distotal
@@ -1079,28 +2000,28 @@ to this page if the data selected is ins $javascript ENDPICK - return ''; +return ''; } sub csvupload_fields { - my ($url) = @_; - my (@parts) = &getpartlist($url); - my @fields=(['username','Student Username'],['domain','Student Domain']); - foreach my $part (sort(@parts)) { - my @datum; - my $display=&Apache::lonnet::metadata($url,$part.'.display'); - my $name=$part; - if (!$display) { $display = $name; } - @datum=($name,$display); - push(@fields,\@datum); - } - return (@fields); + my ($url) = @_; + my (@parts) = &getpartlist($url); + my @fields=(['username','Student Username'],['domain','Student Domain']); + foreach my $part (sort(@parts)) { + my @datum; + my $display=&Apache::lonnet::metadata($url,$part.'.display'); + my $name=$part; + if (!$display) { $display = $name; } + @datum=($name,$display); + push(@fields,\@datum); + } + return (@fields); } sub csvuploadmap_footer { - my ($request,$i,$keyfields) =@_; - $request->print(<print(< @@ -1110,205 +2031,390 @@ ENDPICK } sub csvuploadmap { - my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - my $datatoken; - if (!$ENV{'form.datatoken'}) { - $datatoken=&Apache::loncommon::upfile_store($request); - } else { - $datatoken=$ENV{'form.datatoken'}; - &Apache::loncommon::load_tmp_file($request); - } - my @records=&Apache::loncommon::upfile_record_sep(); - &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); - my $i; - my $keyfields; - if (@records) { - my @fields=&csvupload_fields($url); - if ($ENV{'form.upfile_associate'} eq 'reverse') { - &Apache::loncommon::csv_print_samples($request,\@records); - $i=&Apache::loncommon::csv_print_select_table($request,\@records, - \@fields); - foreach (@fields) { $keyfields.=$_->[0].','; } - chop($keyfields); + my ($request)= @_; + my ($symb,$url)=&get_symb_and_url($request); + if (!$symb) {return '';} + my $datatoken; + if (!$ENV{'form.datatoken'}) { + $datatoken=&Apache::loncommon::upfile_store($request); } else { - unshift(@fields,['none','']); - $i=&Apache::loncommon::csv_samples_select_table($request,\@records, - \@fields); - my %sone=&Apache::loncommon::record_sep($records[0]); - $keyfields=join(',',sort(keys(%sone))); + $datatoken=$ENV{'form.datatoken'}; + &Apache::loncommon::load_tmp_file($request); } - } - &csvuploadmap_footer($request,$i,$keyfields); - return ''; + my @records=&Apache::loncommon::upfile_record_sep(); + &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); + my ($i,$keyfields); + if (@records) { + my @fields=&csvupload_fields($url); + + if ($ENV{'form.upfile_associate'} eq 'reverse') { + &Apache::loncommon::csv_print_samples($request,\@records); + $i=&Apache::loncommon::csv_print_select_table($request,\@records, + \@fields); + foreach (@fields) { $keyfields.=$_->[0].','; } + chop($keyfields); + } else { + unshift(@fields,['none','']); + $i=&Apache::loncommon::csv_samples_select_table($request,\@records, + \@fields); + my %sone=&Apache::loncommon::record_sep($records[0]); + $keyfields=join(',',sort(keys(%sone))); + } + } + &csvuploadmap_footer($request,$i,$keyfields); + return ''; } sub csvuploadassign { - my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - &Apache::loncommon::load_tmp_file($request); - my @gradedata=&Apache::loncommon::upfile_record_sep(); - my @keyfields = split(/\,/,$ENV{'form.keyfields'}); - my %fields=(); - for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) { - if ($ENV{'form.upfile_associate'} eq 'reverse') { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$keyfields[$i]}=$ENV{'form.f'.$i}; - } + my ($request)= @_; + my ($symb,$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}; + } + } else { + if ($ENV{'form.f'.$i} ne 'none') { + $fields{$ENV{'form.f'.$i}}=$keyfields[$i]; + } + } + } + $request->print('

Assigning Grades

'); + my $courseid=$ENV{'request.course.id'}; + 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 ''; +} +#------------- end of section for handling csv file upload --------- +# +#------------------------------------------------------------------- + +#-------------------------- Menu interface ------------------------- +# +#--- Show a Grading Menu button - Calls the next routine --- +sub show_grading_menu_form { + my ($symb,$url)=@_; + my $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n"; + return $result; +} + +#--- Displays the main menu page ------- +sub gradingmenu { + my ($request) = @_; + my ($symb,$url)=&get_symb_and_url($request); + if (!$symb) {return '';} + my $result='

 Select a Grading Method

'; + $result.=''; + $result.=''; + my ($partlist,$handgrade) = &response_type($url); + my ($resptype,$hdgrade)=('','no'); + for (sort keys(%$handgrade)) { + my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + $resptype = $responsetype; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.=''. + ''. + ''; + } + $result.='
Resource: '.$url.'
Part '.(split(/_/))[0].'Type: '.$responsetype.'Handgrade: '.$handgrade.'
'; + $result.=&view_edit_entire_class_form($symb,$url).'
'; + $result.=&upcsvScores_form($symb,$url).'
'; + $result.=&viewGradeaStu_form($symb,$url,$resptype,$hdgrade).'
'; + $result.=&verifyReceipt_form($symb,$url) + if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)); + + return $result; +} + +#--- Menu for grading a section or the whole class --- +sub view_edit_entire_class_form { + my ($symb,$url)=@_; + my ($classlist,$sections,undef) = &getclasslist('all','0'); + my $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' Grade Entire Section or Class
'."\n"; + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n"; + $result.=' Select section: '."
\n"; + $result.=' 
'."\n"; + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +#--- Menu to upload a csv scores --- +sub upcsvScores_form { + my ($symb,$url) = @_; + if (!$symb) {return '';} + my $result = ''."\n"; + + $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' Specify a file containing the class scores for above resource
'."\n"; + my $upfile_select=&Apache::loncommon::upfile_select_html(); + $result.=< + + + +$upfile_select +
  + +ENDUPFORM + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +#--- Handgrading problems --- +sub viewGradeaStu_form { + my ($symb,$url,$response,$handgrade) = @_; + my ($classlist,$sections) = &getclasslist('all','0'); + my $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' '; + if ($handgrade eq 'yes') { + $result.="View/Grade "; } else { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$ENV{'form.f'.$i}}=$keyfields[$i]; - } + $result.="View "; } - } - $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 ''; + $result.='an Individual Student\'s Submission
'."\n"; + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + $result.=' Select section: '."\n"; + $result.='  Display students who has: '. + ' submitted'. + ' everybody
'; + if (ref($sections)) { + $result.=' (Section "no" implies the students were not assigned a section.)
' + if (grep /no/,@$sections); + } + + + $result.='
 '."\n"; + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +#--- Form to input a receipt number --- +sub verifyReceipt_form { + my ($symb,$url) = @_; + my $result = ''."\n"; + + my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}); + + $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' Verify a Submission Receipt Issued by this Server
'."\n"; + $result.=''."\n"; + $result.=' '.$hostver.'-
'."\n"; + $result.=' '."\n"; + $result.=''."\n"; + if ($ENV{'form.url'}) { + $result.=''; + } + if ($ENV{'form.symb'}) { + $result.=''; + } + $result.=''; + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +sub handler { + my $request=$_[0]; + + if ($ENV{'browser.mathml'}) { + $request->content_type('text/xml'); + } else { + $request->content_type('text/html'); + } + $request->send_http_header; + return '' 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))); + } else { + $request->print('

Not authorized: '.$token.'

'); + } + } else { + $request->print('

Not a valid DocID: '.$token.'

'); + } + } else { + $request->print(&Apache::lonxml::tokeninputfield()); + } + } + } else { + $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); + if ($command eq 'submission') { + &listStudents($request) if ($ENV{'form.student'} eq ''); + &submission($request,0,0) if ($ENV{'form.student'} ne ''); + } elsif ($command eq 'processGroup') { + &processGroup($request); + } elsif ($command eq 'gradingmenu') { + $request->print(&gradingmenu($request)); + } elsif ($command eq 'viewgrades') { + $request->print(&viewgrades($request)); + } elsif ($command eq 'handgrade') { + $request->print(&processHandGrade($request)); + } elsif ($command eq 'editgrades') { + $request->print(&editgrades($request)); + } elsif ($command eq 'verify') { + $request->print(&verifyreceipt($request)); + } elsif ($command eq 'csvupload') { + $request->print(&csvupload($request)); + } elsif ($command eq 'viewclasslist') { + $request->print(&viewclasslist($request)); + } elsif ($command eq 'csvuploadmap') { + $request->print(&csvuploadmap($request)); + } elsif ($command eq 'csvuploadassign') { + if ($ENV{'form.associate'} ne 'Reverse Association') { + $request->print(&csvuploadassign($request)); + } else { + if ( $ENV{'form.upfile_associate'} ne 'reverse' ) { + $ENV{'form.upfile_associate'} = 'reverse'; + } else { + $ENV{'form.upfile_associate'} = 'forward'; + } + $request->print(&csvuploadmap($request)); + } + } else { + $request->print("Unknown action: $command:"); + } + } + &send_footer($request); + return ''; } sub send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); + my ($request)= @_; + $request->print(&Apache::lontexconvert::header()); # $request->print(" #"); - $request->print(''); + $request->print(&Apache::loncommon::bodytag('Grading')); } sub send_footer { - my ($request)= @_; - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); -} - -sub handler { - my $request=$_[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))); - } else { - $request->print('

Not authorized: '.$token.'

'); - } - } else { - $request->print('

Not a valid DocID: '.$token.'

'); - } - } else { - $request->print(&Apache::lonxml::tokeninputfield()); - } - } - } else { - #&Apache::lonhomework::showhashsubset(\%ENV,'^form'); - $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); - if ($command eq 'submission') { - &listStudents($request) if ($ENV{'form.student'} eq ''); - &submission($request,0,0) if ($ENV{'form.student'} ne ''); - } elsif ($command eq 'processGroup') { - &processGroup($request); - } elsif ($command eq 'gradingmenu') { - $request->print(&gradingmenu($request)); - } elsif ($command eq 'viewgrades') { - $request->print(&viewgrades($request)); - } elsif ($command eq 'handgrade') { - $request->print(&processHandGrade($request)); - } elsif ($command eq 'editgrades') { - $request->print(&editgrades($request)); - } elsif ($command eq 'verify') { - $request->print(&verifyreceipt($request)); - } elsif ($command eq 'csvupload') { - $request->print(&csvupload($request)); - } elsif ($command eq 'csvuploadmap') { - $request->print(&csvuploadmap($request)); -# } elsif ($command eq 'receiptInput') { -# &receiptInput($request); - } elsif ($command eq 'csvuploadassign') { - if ($ENV{'form.associate'} ne 'Reverse Association') { - $request->print(&csvuploadassign($request)); - } else { - if ( $ENV{'form.upfile_associate'} ne 'reverse' ) { - $ENV{'form.upfile_associate'} = 'reverse'; - } else { - $ENV{'form.upfile_associate'} = 'forward'; - } - $request->print(&csvuploadmap($request)); - } - } else { - $request->print("Unknown action: $command:"); - } - } - &send_footer($request); - return OK; + my ($request)= @_; + $request->print(''); + $request->print(&Apache::lontexconvert::footer()); } 1;