--- loncom/homework/grades.pm 2002/07/26 20:28:42 1.42 +++ loncom/homework/grades.pm 2002/08/02 21:10:03 1.44 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.42 2002/07/26 20:28:42 ng Exp $ +# $Id: grades.pm,v 1.44 2002/08/02 21:10:03 ng 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; @@ -42,74 +42,33 @@ use Apache::loncommon; use Apache::lonhomework; use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); -#use Time::HiRes qw( gettimeofday tv_interval ); -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"); +# ----- 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_([0-9]+)_.*/) { + push(@parts,$key); } -# $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 } - return ''; + return @parts; } -sub student_gradeStatus { - my ($url,$udom,$uname,$partlist) = @_; +# --- 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))); - 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; - $partstatus{"resource.$_.submitted_by"} = $record{"resource.$_.submitted_by"} - if ($record{"resource.$_.submitted_by"} ne ''); - } - return %partstatus; + 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 ($uname,$udom) = @_; my %name=&Apache::lonnet::get('environment', ['lastname','generation', @@ -124,14 +83,15 @@ sub get_fullname { return $fullname; } +#--- 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'); -# print "allkeys=>$allkeys
"; my %seen = (); my (@partlist,%handgrade); foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_\d{1,2}.*/) { + if (/^\w+response_\d+.*/) { my ($responsetype,$part) = split(/_/,$_,2); my ($partid,$respid) = split(/_/,$part); $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); @@ -143,22 +103,219 @@ sub response_type { return \@partlist,\%handgrade; } +#--- Prints a message on screen if a user did something wrong +#--- Operator error --- +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"); + return ''; +} +#--- Dumps the class list with usernames,list of sections, +#--- section, ids and fullnames for each user. +sub getclasslist { + my ($getsec,$hideexpired) = @_; + my $now = time; + my %classlist=&Apache::lonnet::dump('classlist', + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + # codes to check for fields in the classlist + # should contain end:start:id:section:fullname + for (keys %classlist) { + my (@fields) = split(/:/,$classlist{$_}); + %classlist = &reformat_classlist(\%classlist) if (scalar(@fields) <= 2); + last; + } + + my (@holdsec,@sections,%allids,%stusec,%fullname); + foreach (keys(%classlist)) { + my ($end,$start,$id,$section,$fullname)=split(/:/,$classlist{$_}); + # still a student? + if (($hideexpired) && ($end) && ($end < $now)) { + next; + } + $section = ($section ne '' ? $section : 'no'); + push @holdsec,$section; + if ($getsec eq 'all' || $getsec eq $section) { + push (@{ $classlist{$getsec} }, $_); + $allids{$_} =$id; + $stusec{$_} =$section; + $fullname{$_}=$fullname; + } + } + my %seen = (); + foreach my $item (@holdsec) { + push (@sections, $item) unless $seen{$item}++; + } + return (\%classlist,\@sections,\%allids,\%stusec,\%fullname); +} + +# add id, section and fullname to the classlist.db +# done to maintain backward compatibility with older versions +sub reformat_classlist { + my ($classlist) = shift; + foreach (sort keys(%$classlist)) { + my ($unam,$udom) = split(/:/); + my $section = &Apache::lonnet::usection($udom,$unam,$ENV{'request.course.id'}); + my $fullname = &get_fullname ($unam,$udom); + my %userid = &Apache::lonnet::idrget($udom,($unam)); + $$classlist{$_} = $$classlist{$_}.':'.$userid{$unam}.':'.$section.':'.$fullname; + } + my $putresult = &Apache::lonnet::put + ('classlist',\%$classlist, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + return %$classlist; +} + +#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'}); + } +} + +#--- 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 ''; +} + +#--- 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; +} + + +#------------------ End of general use routines -------------------- +#------------------------------------------------------------------- + +#------------------------------------ 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); + } + + my $jscript=''."\n"; + $jscript.= '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n"; + + my $title.='

Verifying Submission Receipt '. + $receipt.'

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

'."\n"; + + my ($string,$contents,$matches) = ('','',0); + my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist('all','0'); + + foreach (sort {$$fullname{$a} cmp $$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++; + } + } + if ($matches == 0) { + $string = $title.'No match found for the above receipt.'; + } else { + $string = $jscript.$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; - 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 $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='

 View Submissions for a Student or a Group of Students

'; + my $result='

 '. + 'View Submissions for a Student or a Group of Students

'; $result.=''; - $result.=''; + $result.=''; my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); for (sort keys(%$handgrade)) { my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); $ENV{'form.handgrade'} = 'yes' if ($handgrade eq 'yes'); - $result.=''. + $result.=''. ''. ''; } @@ -188,25 +345,26 @@ ENDTABLEST $request->print(''."\n"); } $request->print(''."\n"); - + my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($getsec,'0'); $result='
Resource: '.$ENV{'form.url'}.'
'. + 'Resource: '.$ENV{'form.url'}.'
Part id: '.$_.'
Part '.(split(/_/))[0].'Type: '.$responsetype.'Handgrade: '.$handgrade.'
'. ''. - ''. - ''; + ''. + ''; foreach (sort(@$partlist)) { - $result.=''; + $result.=''; } $request->print($result.''."\n"); - foreach my $student (sort(@{ $$classlist{$getsec} }) ) { + foreach my $student (sort {$$fullname{$a} cmp $$fullname{$b} } keys %$fullname) { my ($uname,$udom) = split(/:/,$student); - my (%status) = &student_gradeStatus($ENV{'form.url'},$udom,$uname,$partlist); + my (%status) = &student_gradeStatus($ENV{'form.url'}, + $ENV{'form.symb'},$udom,$uname,$partlist); my $statusflg = ''; foreach (keys(%status)) { $statusflg = 1 if ($status{$_} ne 'nothing'); - my ($foo,$partid,$foo) = split(/\./,$_); + my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $statusflg = ''; $request->print(''. ''."\n". - ''."\n". ''."\n". + ''."\n". ''."\n"; foreach (sort keys(%status)) { @@ -233,8 +391,11 @@ ENDTABLEST } $request->print('
 Select  Username  Fullname  Domain  Select  Fullname  Username  Domain  Part ID '.$_.' Status  Part '.(split(/_/))[0].' Status 
 '.$uname.'  '.$$fullname{$student}.'  '.$uname.'  '.$udom.' 
'); $request->print('
'); + return ''; } +#---- Called from the listStudents routine +# Displays the submissions for one student or a group of students sub processGroup { my ($request) = shift; my $ctr = 0; @@ -247,98 +408,354 @@ sub processGroup { } foreach (@stuchecked) { my ($uname,$udom,$fullname) = split(/:/); - $ENV{'form.student'} = $uname; - $ENV{'form.fullname'} = $fullname; + $ENV{'form.student'} = $uname; + $ENV{'form.userdom'} = $udom; + $ENV{'form.fullname'} = $fullname; &submission($request,$ctr,$total); $ctr++; } return ''; } -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"); - 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; } +#------------------------------------------------------------------------------------ +# +#-------------------------- 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(< + 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; + } } -} -sub getclasslist { - my ($getsec,$hideexpired) = @_; - my $now = time; - my %classlist=&Apache::lonnet::dump('classlist', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - my (@holdsec,@sections,%allids,%stusec,%fullname); - foreach (keys(%classlist)) { - my ($end,$start,$id,$section,$fullname)=split(/:/,$classlist{$_}); - # still a student? - if (($hideexpired) && ($end) && ($end < $now)) { - next; + for (var i=0; iprint(''); - for (sort keys (%$hash)) { - $request->print(''); +//====================== 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); } - $request->print('
KeyValue
'.$_.''.$$hash{$_}.' 
'); - return ''; + newmsg = eval("document.SCORE.newmsg"+usrctr+".value"); + shwsel = ""; + re = /newmsg/; + if (re.test(msgchk)) { shwsel = "checked" } + newMsg(newmsg,shwsel); + msgTail(); + return; + } + + 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) = &finduser($ENV{'form.student'}); - if ($uname eq '') { &moreinfo($request,'Unable to find student'); return ''; } +# 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 ''; } @@ -352,8 +769,8 @@ sub submission { $request->print('

 Submission Record

'. ' Resource: '.$url.''); - # option to display problem, only once else it cause problems with the form later - # since the problem has a form. + # 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'}); @@ -361,14 +778,16 @@ sub submission { $ENV{'request.course.id'}); my $result.='
'; $result.='
'; - $result.='Student\'s view of the problem
'.$rendered.'
'; + $result.=' View of the problem for '.$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. + # 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', @@ -385,6 +804,7 @@ sub submission { $ENV{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; } + $request->print(''."\n". ''."\n". ''."\n". @@ -425,31 +845,36 @@ sub submission { KEYWORDS } } + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my ($partlist,$handgrade) = &response_type($url); -# &print_hash($request,\%record); - # Student info + # Display student info $request->print(($counter == 0 ? '' : '
')); - my $fullname = ($ENV{'form.fullname'} ne '' ? $ENV{'form.fullname'} : &get_fullname($uname,$udom)); my $result='
'. - '
'; + '
'; + +# $result.=''; + my ($string,$timestamp)= + &get_last_submission ($symb,$uname,$udom,$ENV{'request.course.id'}); + my $lastsubonly.=''. + ($$timestamp eq '' ? '' : 'Date Submitted: '. + $$timestamp).''; if ($$timestamp eq '') { $lastsubonly.=''; } else { @@ -502,11 +936,13 @@ KEYWORDS my ($partid,$respid) = /^resource\.(\d+)\.(\d+)\.submission/; if ($part eq ($partid.'_'.$respid)) { my ($ressub,$subval) = split(/:/,$_,2); - $lastsubonly.='' + $lastsubonly.='' if ($ENV{'form.lastSub'} eq 'lastonly' || - ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} =~ /:yes$/)); + ($ENV{'form.lastSub'} eq 'hdgrade' && + $$handgrade{$part} =~ /:yes$/)); } } } @@ -516,21 +952,26 @@ KEYWORDS } } else { $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, - $ENV{'request.course.id'},$last, - '.submission','Apache::grades::keywords_highlight')); + $ENV{'request.course.id'}, + $last,'.submission', + 'Apache::grades::keywords_highlight')); } - # view submission with no grading option + # return if view submission with no grading option if ($ENV{'form.showgrading'} eq '') { $request->print('
Fullname: '.$ENV{'form.fullname'}. + $result.='Fullname: '.$ENV{'form.fullname'}. + '   Username: '.$uname.''. + '   Domain: '.$udom.'
'; - $result.=''; + # If this is handgraded, then check for collaborators + my $col_flag = 0; if ($ENV{'form.handgrade'} eq 'yes') { my @col_list; ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist('all','0'); for (keys (%$handgrade)) { - my $ncol = &Apache::lonnet::EXT('resource.'.$_.'.maxcollaborators',$symb,$udom,$uname); + my $ncol = &Apache::lonnet::EXT('resource.'.$_. + '.maxcollaborators',$symb,$udom,$uname); if ($ncol > 0) { s/\_/\./g; if ($record{'resource.'.$_.'.collaborators'} ne '') { - my (@collaborators) = split(/,?\s+/,$record{'resource.'.$_.'.collaborators'}); + my (@collaborators) = split(/,?\s+/, + $record{'resource.'.$_.'.collaborators'}); my (@badcollaborators); if (scalar(@collaborators) != 0) { - $result.=''."\n"; - $result.='
Fullname: '.$fullname. - '   Username: '.$uname. - '   Domain: '.$udom.'
Collaborators: '; + $result.='Collaborators: '; foreach my $collaborator (@collaborators) { $collaborator = $collaborator =~ /\@|:/ ? (split(/@|:/,$collaborator))[0] : $collaborator; @@ -458,19 +883,21 @@ KEYWORDS push @badcollaborators,$collaborator; next; } + $col_flag++; push @col_list, $collaborator; - $result.=$$fullname{$collaborator.':'.$udom}.' ('.$collaborator.')    '; + $result.=$$fullname{$collaborator.':'.$udom}.'     '; } - $result.='
'. - 'This student has submitted '.(scalar (@badcollaborators) > 1 ? '' : 'an'). + $result.='
'."\n"; + $result.='' + (join ', ',@badcollaborators).'
'. + 'This student has submitted '. + (scalar (@badcollaborators) > 1 ? '' : 'an'). ' invalid collaborator'.(scalar (@badcollaborators) > 1 ? 's. ' : '. '). - (join ', ',@badcollaborators).'
' if (scalar(@badcollaborators) > 0); - $result.='
'. + $result.='' if (scalar(@collaborators) > $ncol); + $ncol.'.
'. 'This student has submitted too many collaborators. Maximum is '. - $ncol.'.
' if (scalar(@collaborators) > $ncol); $result.=''."\n"; } @@ -478,22 +905,29 @@ KEYWORDS } } } - $request->print($result.'
'."\n"); + $request->print($result."\n"); - # print student answer + # 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='
'. + my $submitby=''. 'Collaborative submission by: '. - ''. $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.''; - $submitby.='
'."\n"; $request->print($submitby); } else { - my ($string,$timestamp)=&get_last_submission ($symb,$uname,$udom,$ENV{'request.course.id'}); - my $lastsubonly.='
Last Submission Only'. - ($$timestamp eq '' ? '' : '    Date Submitted: '.$$timestamp).'
'.$$string[0].'
Part ID '. - $partid.' Response ID '.$respid. - ' Submission '.&keywords_highlight($subval).'
Part '. + $partid.' ( ID '.$respid. + ' )   Answer: '. + &keywords_highlight($subval).'
'); return; } + # Grading options $result=''."\n". ''."\n". ''."\n"; $result.=' Compose Message
'."\n" if ($ENV{'form.handgrade'} eq 'yes'); + ',\''.$ENV{'form.fullname'}.'\')"; TARGET=_self>'. + 'Compose Message to student'.($col_flag > 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 = (); @@ -542,21 +983,20 @@ KEYWORDS 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'); + 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); - - # display grading options $result=''; - $result.='
Part '.$partid.' Points'; + $result.=''; - $result.=''."\n"; + ',this.form.GD_BOX'.$counter.'_'.$partid. + ',this.form.GD_SEL'.$counter.'_'.$partid. + ',this.form.stores'.$counter.'_'.$partid. + ','.$wgt.')" />'."\n"; $result.=''."\n"; $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 ? '' : ''); @@ -565,18 +1005,19 @@ KEYWORDS $result.='
'.$ctr."
'; $result.='		 or /'.$wgt.' '.$wgtmsg.' '; - $result.=''."  \n"; @@ -606,6 +1047,7 @@ KEYWORDS return ''; } +#--- Retrieve the last submission for all the parts sub get_last_submission { my ($symb,$username,$domain,$course)=@_; if ($symb) { @@ -620,7 +1062,12 @@ sub get_last_submission { } } foreach ((keys %lasthash)) { - if ($_ =~ /\.submission$/) {push @string, (join(':',$_,$lasthash{$_}))} + if ($_ =~ /\.submission$/) { + my ($partid,$foo) = split(/submission$/,$_); + my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? + 'Draft Copy ' : ''; + push @string, (join(':',$_,$draft.$lasthash{$_})); + } if ($_ =~ /timestamp/) {$timestamp = scalar(localtime($lasthash{$_}))}; } } @@ -629,18 +1076,20 @@ sub get_last_submission { } } +#--- High light keywords, with style choosen by user. sub keywords_highlight { - my $string = shift; - my $size = $ENV{'form.kwsize'} eq '0' ? '' : 'size='.$ENV{'form.kwsize'}; - my $styleon = $ENV{'form.kwstyle'} eq '' ? '' : $ENV{'form.kwstyle'}; + my $string = shift; + my $size = $ENV{'form.kwsize'} eq '0' ? '' : 'size='.$ENV{'form.kwsize'}; + my $styleon = $ENV{'form.kwstyle'} eq '' ? '' : $ENV{'form.kwstyle'}; (my $styleoff = $styleon) =~ s/\$styleon$_$styleoff\<\/font\>/gi; } return $string; } +#--- Called from submission routine sub processHandGrade { my ($request) = shift; my $url = $ENV{'form.url'}; @@ -649,16 +1098,57 @@ sub processHandGrade { 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 ($errorflg) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr); + return '' if ($errorflg eq 'error'); + + my $includemsg = $ENV{'form.includemsg'.$ctr}; + my ($subject,$message,$msgstatus) = ('','',''); + if ($includemsg =~ /savemsg|new$ctr/) { + $subject = $ENV{'form.msgsub'} if ($includemsg =~ /^msgsub/); + my (@msgnum) = split(/,/,$includemsg); + foreach (@msgnum) { + $message.=$ENV{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); + } + $message =~ s/\s+/ /g; + $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom, + $ENV{'form.msgsub'},$message); + } + if ($ENV{'form.collaborator'.$ctr}) { + my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr}); + foreach (@collaborators) { + &saveHandGrade($request,$url,$symb,$_,$udom,$ctr, + $ENV{'form.unamedom'.$ctr}); + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom, + $ENV{'form.msgsub'}, + $message); + } + } + } + $ctr++; + } + } + + # 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 '') { @@ -683,51 +1173,19 @@ sub processHandGrade { $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'},my $udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); + ($ENV{'form.student'},$ENV{'form.userdom'}) = split(/:/,$ENV{'form.unamedom'.$ctr}); &submission($request,$ctr,$ngrade-1); $ctr++; } return ''; } - if ($button eq 'Save & Next') { - my $ctr = 0; - while ($ctr < $ngrade) { - my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); - my ($errorflg) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr); - return '' if ($errorflg eq 'error'); - - my $includemsg = $ENV{'form.includemsg'.$ctr}; - my ($subject,$message,$msgstatus) = ('','',''); - if ($includemsg =~ /savemsg|new$ctr/) { - $subject = $ENV{'form.msgsub'} if ($includemsg =~ /^msgsub/); - my (@msgnum) = split(/,/,$includemsg); - foreach (@msgnum) { - $message.=$ENV{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); - } - $message =~ s/\s+/ /g; - $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom, - $ENV{'form.msgsub'},$message); - } - if ($ENV{'form.collaborator'.$ctr}) { - my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr}); - foreach (@collaborators) { - &saveHandGrade($request,$url,$symb,$_,$udom,$ctr, - $ENV{'form.unamedom'.$ctr}); - if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom, - $ENV{'form.msgsub'}, - $message); - } - } - } - $ctr++; - } - } + # Get the next/previous one or group of students my $firststu = $ENV{'form.unamedom0'}; my $laststu = $ENV{'form.unamedom'.($ngrade-1)}; $ctr = 2; @@ -736,11 +1194,11 @@ sub processHandGrade { $ctr++; $laststu = $firststu if ($ctr > $ngrade); } - my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0'); + my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0'); my (@parsedlist,@nextlist); my ($nextflg) = 0; - foreach ( sort(@{ $$classlist{$ENV{'form.section'}} }) ) { + foreach (sort {$$fullname{$a} cmp $$fullname{$b} } keys %$fullname) { if ($nextflg == 1 && $button =~ /Next$/) { push @parsedlist,$_; } @@ -756,11 +1214,11 @@ sub processHandGrade { foreach my $student (@parsedlist) { my ($uname,$udom) = split(/:/,$student); if ($ENV{'form.submitonly'} eq 'yes') { - my (%status) = &student_gradeStatus($ENV{'form.url'},$udom,$uname,$partlist) ; + my (%status) = &student_gradeStatus($ENV{'form.url'},$symb,$udom,$uname,$partlist) ; my $statusflg = ''; foreach (keys(%status)) { $statusflg = 1 if ($status{$_} ne 'nothing'); - my ($foo,$partid,$foo) = split(/\./,$_); + my ($foo,$partid,$foo1) = split(/\./); $statusflg = '' if ($status{'resource.'.$partid.'.submitted_by'} ne ''); } next if ($statusflg eq ''); @@ -774,7 +1232,8 @@ sub processHandGrade { foreach (sort @nextlist) { my ($uname,$udom,$submitter) = split(/:/); - $ENV{'form.student'} = $uname; + $ENV{'form.student'} = $uname; + $ENV{'form.userdom'} = $udom; $ENV{'form.fullname'} = $$fullname{$_}; # $ENV{'form.'.$_.':submitted_by'} = $submitter; # print "submitter=$ENV{'form.'.$_.':submitted_by'}= $submitter:
"; @@ -791,240 +1250,63 @@ sub processHandGrade { return ''; } +#---- Save the score and award for each student, if changed sub saveHandGrade { my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_; -# my %record=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); + my %record=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); my %newrecord; foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { - if ($ENV{'form.GRADE_SEL'.$newflg.'_'.$_} eq 'excused') { - $newrecord{'resource.'.$_.'.solved'} = 'excused'; + if ($ENV{'form.GD_SEL'.$newflg.'_'.$_} eq 'excused') { + $newrecord{'resource.'.$_.'.solved'} = 'excused' + if ($record{'resource.'.$_.'.solved'} ne 'excused'); } else { - my $pts = ($ENV{'form.GRADE_BOX'.$newflg.'_'.$_} ne '' ? - $ENV{'form.GRADE_BOX'.$newflg.'_'.$_} : $ENV{'form.RADVAL'.$newflg.'_'.$_}); + my $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? + $ENV{'form.GD_BOX'.$newflg.'_'.$_} : + $ENV{'form.RADVAL'.$newflg.'_'.$_}); if ($pts eq '') { - &userError($request,'No point was assigned for part id '.$_.' and for username '.$stuname.'.'); + &userError($request,'No point was assigned for part '.$_. + ' and for username '.$stuname.'.'); return 'error'; } - my $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : $ENV{'form.WGT'.$newflg.'_'.$_}; + my $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : + $ENV{'form.WGT'.$newflg.'_'.$_}; my $partial= $pts/$wgt; - $newrecord{'resource.'.$_.'.awarded'} = $partial; + $newrecord{'resource.'.$_.'.awarded'} = $partial + if ($record{'resource.'.$_.'.awarded'} ne $partial); + my $reckey = 'resource.'.$_.'.solved'; if ($partial == 0) { - $newrecord{'resource.'.$_.'.solved'} = 'incorrect_by_override'; + $newrecord{$reckey} = 'incorrect_by_override' + if ($record{$reckey} ne 'incorrect_by_override'); } else { - $newrecord{'resource.'.$_.'.solved'} = 'correct_by_override'; + $newrecord{$reckey} = 'correct_by_override' + if ($record{$reckey} ne 'correct_by_override'); } - $newrecord{'resource.'.$_.'.submitted_by'} = $submitter if ($submitter); + $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'}"; -# &print_hash($request,\%newrecord); - &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); -} - -sub show_grading_menu_form { - my ($symb,$url)=@_; - my $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - '
'."\n"; - return $result; -} -sub gradingmenu { - my ($request) = @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - my $result='

 Select a Grading Method

'; - $result.=''; - $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.=''. - ''. - ''; + 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); } - $result.='
Resource: '.$url.'
Part id: '.$_.'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).'
'; - $result.=&view_classlist_form($symb,$url); - - return $result; -} - -sub view_classlist_form { - my ($symb,$url)=@_; - my $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' View Class List
'."\n"; - $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n"; - $result.=' 
'."\n"; - $result.='
'."\n"; - $result.='
'."\n"; - return $result; -} - -sub viewclasslist { - my ($request) = shift; - my ($coursedomain,$coursenum) = split(/_/,$ENV{'request.course.id'}); - my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum); - $request->print(''); - foreach (sort keys(%classlist)) { -# my ($unam,$udom) = split(/:/,$_,2); -# my $section = &Apache::lonnet::usection($udom,$unam,$ENV{'request.course.id'}); -# my $fullname = &get_fullname ($unam,$udom); -# my @uname; -# $uname[0]=$unam; -# my %userid=&Apache::lonnet::idrget($udom,@uname); -# my $value=$classlist{$_}.':'.$userid{$unam}.':'.$section.':'.$fullname; -# $classlist{$_}=$value; - $request->print(''); - } - $request->print('
'.$_.' 
 '.$classlist{$_}.'
'); -# my $putresult = &Apache::lonnet::put -# ('classlist',\%classlist, -# $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, -# $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - return ''; } -sub view_edit_entire_class_form { - my ($symb,$url)=@_; - my ($classlist,$sections) = &getclasslist('all','0'); - my $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' View/Grade Entire Section/Class
'."\n"; - $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n"; - $result.=' Select section: '."
\n"; -# $result.=' Display students who has: '. -# ' submitted'. -# ' everybody

'; - $result.=' 
'."\n"; - $result.='
'."\n"; - $result.='
'."\n"; - return $result; -} - -sub upcsvScores_form { - my ($symb,$url) = @_; - if (!$symb) {return '';} - my $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; -} - -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". - ''."\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; -} - -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; -} - +#-------------------------------------------------------------------------------------- +# +#-------------------------- 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(< - function viewOneStudent(user) { + function viewOneStudent(user,domain) { document.onestudent.student.value = user; + document.onestudent.userdom.value = domain; document.onestudent.submit(); } @@ -1047,6 +1329,14 @@ sub viewgrades_js { } return; } + if (point > 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 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; } function changeOneScore(partid,user) { - var selval = eval("document.classgrade.GRADE_"+user+'_'+partid+"_solved"); + var selval = eval("document.classgrade.GD_"+user+'_'+partid+"_sv"); if (selval[1].selected) { - var boxval = eval("document.classgrade.GRADE_"+user+'_'+partid+"_awarded"); + var boxval = eval("document.classgrade.GD_"+user+'_'+partid+"_aw"); boxval.value = ""; } } @@ -1127,38 +1451,38 @@ sub viewgrades_js { selval[0].selected = true; for (i=0;i VIEWJAVASCRIPT } +#--- show scores for a section or whole class w/ option to change/update a score sub viewgrades { my ($request) = shift; &viewgrades_js($request); my ($symb,$url) = ($ENV{'form.symb'},$ENV{'form.url'}); - $request->print ('

Manual Grading

'); + my $result='

Manual Grading

'; - my $result='Resource: '.$ENV{'form.url'}.''."\n"; + $result.='Resource: '.$ENV{'form.url'}.''."\n"; #view individual student submission form - called using Javascript viewOneStudent $result.= '
'."\n". @@ -1166,9 +1490,10 @@ sub viewgrades { ''."\n". ''."\n". ''."\n". + ''."\n". '
'."\n"; - #start the form + #beginning of class grading form $result.= '
'."\n". ''."\n". ''."\n". @@ -1177,10 +1502,12 @@ sub viewgrades { $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 score that has already '. + '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.'; + #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; @@ -1191,8 +1518,11 @@ sub viewgrades { my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); $weight{$partid} = $wgt eq '' ? '1' : $wgt; - $result.=''."\n"; - $result.='
Part ID: '.$partid.'   '; + $result.=''."\n"; + $result.=''."\n"; + $result.='
Part '.$partid.'   Point: '; $result.=''; my $ctr = 0; while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across @@ -1203,8 +1533,10 @@ sub viewgrades { $ctr++; } $result.='
'; - $result.= '		 or /'. + $result.= ' or /'. $weight{$partid}.' (problem weight)
'; $result.='    '; + 'onClick="javascript:resetEntry('.$ctsparts.');" TARGET=_self>    '; +# $result.=''."\n"; $result.= ''."\n"; + #table listing all the students in a section/class + #header of table $result.= '
'."\n". ''. - ''."\n"; - #get list of parts for this problem + ''."\n"; my (@parts) = sort(&getpartlist($url)); foreach my $part (@parts) { my $display=&Apache::lonnet::metadata($url,$part.'.display'); @@ -1237,12 +1572,14 @@ sub viewgrades { $result.=''."\n"; } $result.=''; + #get info for each student + #list all the students - with points and grade status my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0'); my $ctr = 0; - foreach ( sort(@{ $$classlist{$ENV{'form.section'}} }) ) { - (my $username = $_) = split(/:/); - $result.=''."\n"; + foreach (sort {$$fullname{$a} cmp $$fullname{$b} } keys %$fullname) { + my ($uname,$udom) = split(/:/); + $result.=''."\n"; $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'}, $_,$$fullname{$_},\@parts,\%weight); $ctr++; @@ -1254,13 +1591,15 @@ sub viewgrades { return $result; } +#--- call by previous routine to display each student sub viewstudentgrade { my ($url,$symb,$courseid,$student,$fullname,$parts,$weight) = @_; - my ($username,$domain) = split(/:/,$student); - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); + my ($uname,$udom) = split(/:/,$student); + my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); my $result=''."\n"; + ''.$fullname.''. + ''."\n"; foreach my $part (@$parts) { my ($temp,$part,$type)=split(/_/,$part); my $score=$record{"resource.$part.$type"}; @@ -1268,19 +1607,19 @@ sub viewstudentgrade { if ($type eq 'awarded') { my $pts = $score eq '' ? '' : $score*$$weight{$part}; $result.=''."\n"; + 'GD_'.$uname.'_'.$part.'_aw_s" value="'.$pts.'" />'."\n"; $result.=''."\n"; + 'GD_'.$uname.'_'.$part.'_aw" '. + 'onChange="javascript:changeSelect('.$part.',\''.$uname. + '\')" value="'.$pts.'" size="4" />'."\n"; } elsif ($type eq 'solved') { my ($status,$foo)=split(/_/,$score,2); $status = 'nothing' if ($status eq ''); $result.=''."\n"; + 'GD_'.$uname.'_'.$part.'_sv_s" value="'.$status.'" />'."\n"; $result.='
UsernameFullnameDomainFullnameUsernameDomain'.$display.'
'. - ''.$username.''. - ''.$fullname.''.$domain.''.$uname.''.$udom.''."\n". - ''."\n". - ''."\n". - '
'."\n"; - - my (@parts) = &getpartlist($url); - my ($classlist) = &getclasslist($ENV{'form.section'},'0'); - foreach my $student ( sort(@{ $$classlist{$ENV{'form.section'}} }) ) { - $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); - } - - $result.='
'; - return $result; -} - - -#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) = @_; - 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"}; - 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'; } - } else { - #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
\n"; - } - if ($update) { $newrecord{"resource.$part.$type"}=$newscore; } - } else { - if ($oldscore ne $newscore) { - $newrecord{"resource.$part.$type"}=$newscore; - $result.="Updating $student"."'s status for $part.$type to $newscore
\n"; - } else { - #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
\n"; - } - } - } - if ( scalar(keys(%newrecord)) > 0 ) { - $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; -# &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname); + 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,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0'); - $result.="Stored away ".scalar(keys(%newrecord))." elements.
\n"; + my (@partid); + my %weight = (); + my ($i,$ctr,$count,$rec_update) = (0,0,0,0); + while ($ctr < $ENV{'form.totalparts'}) { + my $partid = $ENV{'form.partid_'.$ctr}; + push @partid,$partid; + $weight{$partid} = $ENV{'form.weight_'.$partid}; + $ctr++; + $result .= ''; } - return $result; + $result .= ''; + foreach (@partid) { + $result .= ''. + ''; + } + $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 ($foo,$udom) = split(/:/,$userdom[0]); + + $result .= ''; + + foreach (@partid) { + my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_aw_s'}; + my $old_part = $old_aw eq '' ? '' : $old_aw/$weight{$_}; + my $old_score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_sv_s'}}; + + my $awarded = $ENV{'form.GD_'.$user.'_'.$_.'_aw'}; + my $partial = $awarded eq '' ? '' : $awarded/$weight{$_}; + my $score; + if ($partial eq '') { + $score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_sv_s'}}; + } elsif ($partial > 0) { + $score = 'correct_by_override'; + } elsif ($partial == 0) { + $score = 'incorrect_by_override'; + } + $score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_sv'} eq 'excused') && + ($score ne 'excused')); + $result .= ''. + ''; + + next if ($old_part eq $partial && $old_score eq $score); + + $updateflag = 1; + $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; + $newrecord{'resource.'.$_.'.solved'} = $score; + $rec_update++; + } + $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 .= '
UsernameFullnamePart '.$partid. + ' (Weight = '.$weight{$partid}.')
 Old Score  New Score 
'.$user.' '. + $$fullname{$userdom[0]}.' '.$old_aw.' '.$awarded. + ($score eq 'excused' ? $score : '').' 
'."\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; } +#------------- end of section for handling grading by section/class --------- +# +#---------------------------------------------------------------------------- -sub sub_page_js { - my $request = shift; - $request->print(< - function updateRadio(radioButton,formtextbox,formsel,scores) { - 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"+msgchk); - 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; - } - - 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 -} - +#---------------------------------------------------------------------------- +# +#-------------------------- Next few routines handles grading by csv upload +# +#--- Javascript to handle csv upload sub csvupload_javascript_reverse_associate { return(<print(&show_grading_menu_form($symb,$url)); return ''; } +#------------- end of section for handling csv file upload --------- +# +#------------------------------------------------------------------- -sub send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); -# $request->print(" -#"); - $request->print(''); +#-------------------------- 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; } -sub send_footer { - my ($request)= @_; - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); +#--- 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) = &getclasslist('all','0'); + my $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' View/Grade Entire Section/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.=' 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.=' View/Grade 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
'; + $result.=' (Section "no" implies the students were not assigned a section.)
' + if (grep /no/,@$sections); + + $result.='
 '."\n". + '
'."\n"; + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +#--- Form to input a receipt number --- +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; } sub handler { @@ -1935,7 +2126,7 @@ sub handler { $request->content_type('text/html'); } $request->send_http_header; - return OK if $request->header_only; + return '' if $request->header_only; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); my $url=$ENV{'form.url'}; my $symb=$ENV{'form.symb'}; @@ -1964,10 +2155,10 @@ sub handler { 'grade_courseid' => $tcrsid, 'grade_symb' => $tsymb))); } else { - $request->print('

Not authorized: '.$token.'

'); + $request->print('

Not authorized: '.$token.'

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

Not a valid DocID: '.$token.'

'); + $request->print('

Not a valid DocID: '.$token.'

'); } } else { $request->print(&Apache::lonxml::tokeninputfield()); @@ -1997,8 +2188,6 @@ sub handler { $request->print(&viewclasslist($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)); @@ -2015,7 +2204,24 @@ sub handler { } } &send_footer($request); - return OK; + return ''; +} + +sub send_header { + my ($request)= @_; + $request->print(&Apache::lontexconvert::header()); +# $request->print(" +#"); + $request->print(''); +} + +sub send_footer { + my ($request)= @_; + $request->print(''); + $request->print(&Apache::lontexconvert::footer()); } 1;