--- loncom/homework/grades.pm 2001/08/06 16:37:58 1.12 +++ loncom/homework/grades.pm 2002/07/10 21:08:38 1.38 @@ -1,14 +1,37 @@ -# The LON-CAPA grading handler. +# The LearningOnline Network with CAPA +# The LON-CAPA Grading handler # -# Handles the viewing of grades. +# $Id: grades.pm,v 1.38 2002/07/10 21:08:38 ng Exp $ # -# YEAR=2001 -# 2/7,2/9,2/13,4/16,4/17,5/1 Guy Albertelli +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# +# 2/9,2/13 Guy Albertelli # 6/8 Gerd Kortemeyer -# 7/26 Guy Albertelli -# 7/27 H.K. Ng -# 7/30 Guy Albertelli -# 8/6 Scott Harrison +# 7/26 H.K. Ng +# 8/20 Gerd Kortemeyer +# Year 2002 +# June, July 2002 H.K. Ng +# package Apache::grades; use strict; @@ -17,415 +40,1610 @@ use Apache::lonxml; use Apache::lonnet; 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 ); -# ======================================================== Get more information sub moreinfo { - my ($request,$reason) = @_; - $request->print("Unable to process request: $reason"); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print('
'."\n"); - $request->print(''."\n"); - $request->print(''."\n"); - $request->print("Student:". - ''."
\n"); - $request->print("Domain:". - ''."
\n"); - $request->print(''."
\n"); - $request->print('
'); + 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 } return ''; } -# ========================================= Displays the class list of students -sub listStudents { - my ($request) = shift; - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - my $chome = $ENV{"course.$ENV{'request.course.id'}.home"}; - $request->print ("Found $cdom:$cnum:$chome
"); - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - my ($sname,$sdom) = split(/:/,$student); - my $reply = &Apache::lonnet::reply('get:'.$sdom.':'.$sname. - ':environment:lastname&generation&firstname&middle'. - 'name',&Apache::lonnet::homeserver($sname,$sdom)); - print "reply=$reply
"; - my (@nameparts) = split /&/,$reply; -# my $sfullname = $Apache::lonnet::unescape($nameparts[0]); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print('
'."\n"); - $request->print("$sname @nameparts\n"); - $request->print(''."\n"); - $request->print(''."\n"); - $request->print(''."\n"); - $request->print(''."\n"); - $request->print(''."
\n"); - $request->print('
'); - } +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 ''; +} + +sub get_fullname { + my ($sname,$sdom) = @_; + my %name=&Apache::lonnet::get('environment', ['lastname','generation', + 'firstname','middlename'], + $sdom,$sname); + 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'}; } + 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 sub only + last sub & parts info + all details + + + + +
+ + + + +ENDTABLEST + if ($ENV{'form.url'}) { + $request->print(''."\n"); + } + if ($ENV{'form.symb'}) { + $request->print(''."\n"); + } + $request->print(''."\n"); + + my $t0=&Time::HiRes::time(); + + my ($classlist) = &getclasslist($getsec,'0'); + my $t1=&Time::HiRes::time(); + print "getclasslist=",$t1-$t0,"
"; + + 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"); + + $request->print(''); + } + } + my $t2=&Time::HiRes::time(); + print "processclasslist=",$t2-$t1,"
"; + $request->print('
 Select  Username  Fullname  Domain  Grade Status 
 '.$sname.'  '.$fullname.'  '.$sdom.'  '.$status.' 
'); + $request->print(''); +} + +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'; +} + +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 ''; } -# ========== Finds a user based on a name substring (returns a 2 element array) #FIXME - needs to handle multiple matches sub finduser { - my ($name) = @_; - my $domain = ''; - if ( $Apache::grades::viewgrades eq 'F' ) { - #get classlist - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - my $chome = $ENV{"course.$ENV{'request.course.id'}.home"}; - #print "Found $cdom:$cnum:$chome
"; - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - my ($posname,$posdomain) = split(/:/,$student); - if ($posname =~ $name) { - $name = $posname; - $domain = $posdomain; - last; - } - } - return ($name,$domain); - } else { - return ($ENV{'user.name'},$ENV{'user.domain'}); + 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'}); + } } -# ===================================== Gets a class list (returns a hash list) sub getclasslist { - my ($coursedomain,$coursenum,$coursehome,$hideexpired) = @_; - my $classlist = &Apache::lonnet::reply('dump:'.$coursedomain.':'. - $coursenum.':classlist',$coursehome); - my %classlist = (); - my $now = time; - foreach my $record (split /&/, $classlist) { - my ($name,$value)=split(/=/,&Apache::lonnet::unescape($record)); - my ($end,$start)=split(/:/,$value); - # still a student? - if (($hideexpired) && ($end) && ($end < $now)) { - print "Skipping:$name:$end:$now
\n"; - next; - } - print "record=$record
"; - push( @{ $classlist{'allids'} }, $name); + 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; } - return (%classlist); + 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); } -# ============================== Get parts of a stored value (returns an array) 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); - } + 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); } - return @parts; + } + return @parts; } -# =================================== Displays student grade (returns a string) sub viewstudentgrade { - my ($url,$symb,$courseid,$student,@parts) = @_; - my $result = ''; - my $cellclr = '"#ffffdd"'; - my ($stuname,$domain) = split(/:/,$student); - my %record = &Apache::lonnet::restore($symb,$courseid,$domain,$stuname); - $result .= "$stuname$domain\n"; - foreach my $part (@parts) { - my ($temp,$part,$type)=split(/_/,$part); - #print "resource.$part.$type = ".$record{"resource.$part.$type"}."
\n"; - if ($type eq 'awarded') { - my $score = $record{"resource.$part.$type"}; - $result .= "". - "\n"; - } elsif ($type eq 'tries') { - my $score = $record{"resource.$part.$type"}; - $result .= "\n"; - } elsif ($type eq 'solved') { - my $score = $record{"resource.$part.$type"}; - $result .= "". - "\n"; - } + 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"; } - $result .= ''; - return $result; + } + $result.=''; + return $result; } -# ========================================================== Sets student grade -#FIXME need to look at the meatdata spec -# on what type of data to accept and provide an +#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"; - } + 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; } + } 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); - - $result .= 'Stored away '.scalar(keys(%newrecord)). - " elements.
\n"; + } + 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"; + } + return $result; +} + +# +# --------------------------- show submissions of a student, option to grade -------- +sub submission { + my ($request,$counter,$total) = @_; + + (my $url=$ENV{'form.url'})=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + if ($ENV{'form.student'} eq '') { &moreinfo($request,'Need student login id'); return ''; } + my ($uname,$udom) = &finduser($ENV{'form.student'}); + if ($uname eq '') { &moreinfo($request,'Unable to find student'); return ''; } + + my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); + if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } + my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); + + # header info + if ($counter == 0) { + &sub_page_js($request); + $request->print('

 Submission Record

'. + ' Resource: '.$url.''); + + # option to display problem, only once else it cause problems with the form later + # since the problem has a form. + if ($ENV{'form.vProb'} eq 'yes') { + my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, + $ENV{'request.course.id'}); + my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, + $ENV{'request.course.id'}); + my $result.='
'; + $result.='
'; + $result.='Student\'s view of the problem
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + $result.='
'; + $result.='

'; + $request->print($result); + } + + # kwclr is the only variable that is non blank if this has been used 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"); + + my ($cts,$prnmsg) = (1,''); + while ($cts <= $ENV{'form.savemsgN'}) { + $prnmsg.=''."\n"; + $cts++; + } + $request->print($prnmsg); + + if ($ENV{'form.handgrade'} eq 'yes') { + $request->print(<Keyword Options:  +List    +Paste Selection to List    +Highlight Attribute

+KEYWORDS + } + } + + # Student info + $request->print(($counter == 0 ? '' : '
')); + my $fullname = ($ENV{'form.fullname'} ne '' ? $ENV{'form.fullname'} : &get_fullname($uname,$udom)); + my $result.='
'. + '
'; + $result.=''; + if ($ENV{'form.handgrade'} eq 'yes') { +# my $subonly = &get_last_submission($symb,$uname,$udom,$ENV{'request.course.id'}); + my ($classlist) = &getclasslist('all','0'); + my @collaborators; +# foreach ( sort(@{ $$classlist{'all'} }) ) { +# my ($sname,$sdom) = split(/:/); +# push @collaborators,$sname if (grep /\b$sname(\b|\.)/i,$subonly); +# } +# push @collaborators,'leede','carlandmm','freyniks'; # as a test to display collaborators. + if (scalar(@collaborators) != 0) { + $result.=''."\n"; + $result.=''."\n"; + } + } + $result.='
Username: '.$uname. + 'Fullname: '.$fullname. + 'Domain: '.$udom.'
Collaborators: '; + foreach (@collaborators) { + $result.=$_.' ('.&get_fullname($_,$udom).')    '; + } + $result.='
'."\n"; + $request->print($result); + + # print student answer + if ($ENV{'form.lastSub'} eq 'lastonly') { + my ($string,$timestamp)=&get_last_submission ($symb,$uname,$udom,$ENV{'request.course.id'}); + $string=&keywords_highlight(join('::::',@$string)); + my $lastsubonly='
'; + $lastsubonly.=''; + $lastsubonly.=''; + $lastsubonly.='
Last Submission Only'. + ($timestamp eq '' ? '' : '    Date Submitted: '.@$timestamp).'
'; + $lastsubonly.=$string; + $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')); + } + + 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 %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my $score = ($record{'resource.0.awarded'} eq '' ? '' : $record{'resource.0.awarded'}*$wgt); + + # display grading options + $result=''. + ''."\n"; + $result.=''."\n"; + $result.=''."\n"; + $result.=''; + $result.=''."\n"; + $result.='
Points'; + + my $ctr = 0; + $result.=''; # display radio buttons in a nice table with 10 across + while ($ctr<=$wgt) { + $result.= '\n"; + $result.=(($ctr+1)%10 == 0 ? '' : ''); + $ctr++; + } + $result.='
'.$ctr."
'; + + $result.='		 or /'.$wgt.' '.$wgtmsg.' '; + + foreach my $part (&getpartlist($url)) { + print "parts=$part
"; + 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.='  \n"; + } + } + $result.='Compose Message
'."\n"; +# $result.='
'; + $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 ''; +} + +sub get_last_submission { + my ($symb,$username,$domain,$course)=@_; + if ($symb) { + my (@string,@timestamp); + my (%returnhash)=&Apache::lonnet::restore($symb,$course,$domain,$username); + if ($returnhash{'version'}) { + my %lasthash=(); + my ($version); + for ($version=1;$version<=$returnhash{'version'};$version++) { + foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { + $lasthash{$_}=$returnhash{$version.':'.$_}; + } + } + foreach ((keys %lasthash)) { + print "lasthash key=$_
"; + if ($_ =~ /\.submission$/) {push @string, $_,$lasthash{$_}} + if ($_ =~ /timestamp/) {push @timestamp, scalar(localtime($lasthash{$_}))}; +# if ($_ =~ /\.submission$/) {$string = $lasthash{$_}} +# if ($_ =~ /timestamp/) {$timestamp=scalar(localtime($lasthash{$_}))}; + } } - return $result; + @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; + return \@string,\@timestamp; + } } +sub keywords_highlight { + my $string = shift; + my $size = $ENV{'form.kwsize'} eq '0' ? '' : 'size='.$ENV{'form.kwsize'}; + my $styleon = $ENV{'form.kwstyle'} eq '' ? '' : $ENV{'form.kwstyle'}; + (my $styleoff = $styleon) =~ s/\$styleon$_$styleoff\<\/font\>/gi; + } + return $string; +} -# ========================================================== Attempt submission -sub submission { - my ($request) = @_; - my $url = $ENV{'form.url'}; - $url =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - if ($ENV{'form.student'} eq '') { - &moreinfo($request,"Need student login id"); return ''; } -# if ($ENV{'form.student'} eq '') { &listStudents($request); return ''; } - my ($uname,$udom) = &finduser($ENV{'form.student'}); - if ($uname eq '') { - &moreinfo($request,"Unable to find student"); return ''; } - my $symb=&Apache::lonnet::symbread($url); - if ($symb eq '') { - $request->print("Unable to handle ambiguous references:$url:."); - return ''; } - my $answer = &Apache::loncommon::get_previous_attempt($symb,$uname,$udom, - $ENV{'request.course.id'}); - my $result = "

Submission Record

$uname:$udom for $url
". - $answer; - return $result; +sub processHandGrade { + my ($request) = shift; + my $url = $ENV{'form.url'}; + my $symb = $ENV{'form.symb'}; + my $button = $ENV{'form.gradeOpt'}; + my $ngrade = $ENV{'form.NCT'}; + my $ntstu = $ENV{'form.NTSTU'}; + + my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; + my %keyhash = (); + $ENV{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; + $keyhash{$symb.'_handgrade'} = 'activated'; + $keyhash{$symb.'_keywords'} = $ENV{'form.keywords'}; + $keyhash{$symb.'_subject'} = $ENV{'form.msgsub'}; + $keyhash{$loginuser.'_kwclr'} = $ENV{'form.kwclr'}; + $keyhash{$loginuser.'_kwsize'} = $ENV{'form.kwsize'}; + $keyhash{$loginuser.'_kwstyle'} = $ENV{'form.kwstyle'}; + + my ($ctr,$idx) = (1,1); + while ($ctr <= $ENV{'form.savemsgN'}) { + if ($ENV{'form.savemsg'.$ctr} ne '') { + $keyhash{$symb.'_savemsg'.$idx} = $ENV{'form.savemsg'.$ctr}; + $idx++; + } + $ctr++; + } + $ctr = 0; + while ($ctr < $ngrade) { + if ($ENV{'form.newmsg'.$ctr} ne '') { + $keyhash{$symb.'_savemsg'.$idx} = $ENV{'form.newmsg'.$ctr}; + $ENV{'form.savemsg'.$idx} = $ENV{'form.newmsg'.$ctr}; + $idx++; + } + $ctr++; + } + $ENV{'form.savemsgN'} = --$idx; + $keyhash{$symb.'_savemsgN'} = $ENV{'form.savemsgN'}; + my $putresult = &Apache::lonnet::put + ('nohist_handgrade',\%keyhash, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + my (@parts) = sort(&getpartlist($url)); + + if ($button eq 'Save & Next') { + my $ctr = 0; + while ($ctr < $ngrade) { + my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); + &saveHandGrade($url,$symb,$uname,$udom,$ctr,@parts); + + 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($url,$symb,$_,$udom,$ctr,@parts); + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom,$ENV{'form.msgsub'},$message); + } + } + } + $ctr++; + } + } + my $firststu = $ENV{'form.unamedom0'}; + my $laststu = $ENV{'form.unamedom'.($ngrade-1)}; + + my ($classlist) = &getclasslist($ENV{'form.section'},'0'); + 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); + my ($type,$status) = &student_gradeStatus($ENV{'form.url'},$udom,$uname); + next if ($status eq 'nothing' && $ENV{'form.submitonly'} eq 'yes'); + + 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++; + } + 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 ''; +} + +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; + } + } + } + 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); +} + +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 $allkeys = &Apache::lonnet::metadata($url,'keys'); + my $handgrade = ($allkeys =~ /parameter_.*?_handgrade/ ? 'yes' : 'no'); + my ($responsetype,$foo) = split(/_/,&Apache::lonnet::metadata($url,'packages')); + $allkeys=~s/,/\/g; +# print "allkeys=$allkeys

"; + $Apache::lonxml::debug=1; + &Apache::lonxml::debug(join(':',&Apache::lonnet::metadata($url,'packages'))); + $Apache::lonxml::debug=0; + + my $result='

 Select a Grading Method

'; + $result.=''; + $result.=''. + ''; + $result.=''. + ''; + $result.='
Resource: '.$url.'
Type: '.$responsetype.'  Handgrade: '.$handgrade.'
'; + my $t0=&Time::HiRes::time(); + $result.=&view_edit_entire_class_form($symb,$url).'
'; + my $t1=&Time::HiRes::time(); + print "elapsed10=",$t1-$t0,"
"; + $result.=&upcsvScores_form($symb,$url).'
'; + my $t2=&Time::HiRes::time(); + print "elapsed21=",$t2-$t1,"
"; + $result.=&viewGradeaStu_form($symb,$url,$responsetype,$handgrade).'
'; + my $t3=&Time::HiRes::time(); + print "elapsed32=",$t3-$t2,"
"; + $result.=&verifyReceipt_form($symb,$url); + my $t4=&Time::HiRes::time(); + print "elapsed43=",$t4-$t3,"
"; + print "Total elapsed time=",$t4-$t0,"
"; + return $result; +} + +sub view_edit_entire_class_form { + my ($symb,$url)=@_; + my $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' View/Grade Entire Class
'."\n"; + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\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 $t3=&Time::HiRes::time(); + + my ($classlist,$sections) = &getclasslist('all','0'); + + my $t4=&Time::HiRes::time(); + print "elapsed_getclasslist=",$t4-$t3,"
"; + + + 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; +} + +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; } -# ================================================================= View grades sub viewgrades { - my ($request) = @_; - my $result = ''; - - #get resource reference - my $url = $ENV{'form.url'}; - $url =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - my $symb=$ENV{'form.symb'}; - if (!$symb) { $symb = &Apache::lonnet::symbread($url); } - if ($symb eq '') { - $request->print("Unable to handle ambiguous references:$url:."); - return ''; - } - - #get classlist - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - my $chome = $ENV{"course.$ENV{'request.course.id'}.home"}; - #print "Found $cdom:$cnum:$chome
"; - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - my $headerclr = '"#ccffff"'; - my $cellclr = '"#ffffcc"'; - - #get list of parts for this problem - my (@parts) = &getpartlist($url); - - $request->print("

Manual Grading

"); - - #start the form - $result = '
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''. - "\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{'allids'} }) ) { - $result .= &viewstudentgrade($url,$symb,$ENV{'request.course.id'}, - $student,@parts); - } - $result .= '
UserIdDomain'.$display.'
'; - return $result; + my ($request) = @_; + my $result=''; + + #get resource reference + my ($symb,$url)=&get_symb_and_url($request); + if (!$symb) {return '';} + #get classlist + my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); + #print "Found $cdom:$cnum
"; + my ($classlist) = &getclasslist('all','0'); + my $headerclr = '"#ddffff"'; + my $cellclr = '"#ffffdd"'; + + #get list of parts for this problem + my (@parts) = sort(&getpartlist($url)); + + $request->print ("

Manual Grading

"); + + #start the form + $result = '
'."\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.='
UsernameFullnameDomain'.$display.'
'; + $result.='
'; + $result.=&show_grading_menu_form($symb,$url); + return $result; } -# ================================================================= Edit grades sub editgrades { - my ($request) = @_; - my $result=''; + my ($request) = @_; + my $result=''; + + 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"; + + foreach my $student ( sort(@{ $$classlist{'all'} }) ) { + $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); + } + + $result.='
'; + return $result; +} + +sub sub_page_js { + my $request = shift; + $request->print(< + function updateRadio(radioButton,formtextbox,formsel,wgt) { + 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 0 && pts < wgt) { + formsel[4].selected = true; + } + if (pts == wgt) { + formsel[0].selected = true; + } + return; + } + + function keywords(keyform) { + var keywds = keyform.value; + var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",keywds); + if (nret==null) return; + keyform.value = nret; + return; + } + +//===================== Script to add keyword(s) ================== + function getSel() { + if (document.getSelection) txt = document.getSelection(); + else if (document.selection) txt = document.selection.createRange().text; + else return; + var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," "); + if (cleantxt=="") { + alert("Select a word or group of words from document and then click this link."); + return; + } + var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt); + if (nret==null) return; + var curlist = document.SCORE.keywords.value; + document.SCORE.keywords.value = curlist+" "+nret; + return; + } + +//====================== 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; +// alert("checked=>"+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 +} + +sub csvupload_javascript_reverse_associate { + return(<2) { foundsomething=1; } + } + if (founduname==0 || founddomain==0) { + alert('You need to specify at both the username and domain'); + return; + } + if (foundsomething==0) { + alert('You need to specify at least one grading field'); + return; + } + vf.submit(); + } + function flip(vf,tf) { + var nw=eval('vf.f'+tf+'.selectedIndex'); + var i; + //can not pick the same destination field twice + for (i=0;i<=vf.nfields.value;i++) { + if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) { + eval('vf.f'+i+'.selectedIndex=0;') + } + } + } +ENDPICK +} + +sub csvuploadmap_header { + my ($request,$symb,$url,$datatoken,$distotal)= @_; + my $result; + my $javascript; + if ($ENV{'form.upfile_associate'} eq 'reverse') { + $javascript=&csvupload_javascript_reverse_associate(); + } else { + $javascript=&csvupload_javascript_forward_associate(); + } + $request->print(< +

Uploading Class Grades for resource $url

+
+

Identify fields

+Total number of records found in file: $distotal
+Enter as many fields as you can. The system will inform you and bring you back +to this page if the data selected is insufficient to run your class.
+ + + + + + + + + + +
+ +ENDPICK + return ''; + +} + +sub csvupload_fields { + my ($url) = @_; + my (@parts) = &getpartlist($url); + my @fields=(['username','Student Username'],['domain','Student Domain']); + foreach my $part (sort(@parts)) { + my @datum; + my $display=&Apache::lonnet::metadata($url,$part.'.display'); + my $name=$part; + if (!$display) { $display = $name; } + @datum=($name,$display); + push(@fields,\@datum); + } + return (@fields); +} - my $symb = $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'}); - my $chome = $ENV{"course.$ENV{'request.course.id'}.home"}; - #print "Found $cdom:$cnum:$chome
"; - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - - #get list of parts for this problem - my (@parts) = &getpartlist($url); - - $result .= '
'."\n". - ''."\n". - ''."\n". - ''. - "\n".''. - '
'."\n"; - - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - $result .= &setstudentgrade($url,$symb,$ENV{'request.course.id'}, - $student,@parts); - } - - $result .= ''. - '
'; - return $result; +sub csvuploadmap_footer { + my ($request,$i,$keyfields) =@_; + $request->print(< + + +
+ +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); + } 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}; + } + } 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 $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 ''; } -# ================================================================= Send header sub send_header { - my ($request) = @_; - $request->print(&Apache::lontexconvert::header()); + my ($request)= @_; + $request->print(&Apache::lontexconvert::header()); # $request->print(" #"); - $request->print(''); + $request->print(''); } -# ================================================================= Send footer sub send_footer { - my ($request) = @_; + my ($request)= @_; $request->print(''); $request->print(&Apache::lontexconvert::footer()); } -# ===================================================================== Handler sub handler { - my $request = $_[0]; - if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} - else {$Apache::lonxml::debug=0;} - if ($ENV{'browser.mathml'}) { - $request->content_type('text/xml'); - } else { - $request->content_type('text/html'); - } - $request->send_http_header; - return OK if $request->header_only; - my $url = $ENV{'form.url'}; - my $symb = $ENV{'form.symb'}; - my $command = $ENV{'form.command'}; - - &send_header($request); - if ($url eq '' && $symb eq '') { - $request->print("Non-Contextual Access Unsupported:$command:$url:"); - } else { - $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr', - $ENV{'request.course.id'}); - if ($command eq 'submission') { - $request->print(&listStudents($request)) - if ($ENV{'form.student'} eq ''); - $request->print(&submission($request)) - if ($ENV{'form.student'} ne ''); - } elsif ($command eq 'viewgrades') { - $request->print(&viewgrades($request)); - } elsif ($command eq 'editgrades') { - $request->print(&editgrades($request)); + 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 { - $request->print("Unknown action:$command:"); + $ENV{'form.upfile_associate'} = 'forward'; } + $request->print(&csvuploadmap($request)); + } + } else { + $request->print("Unknown action: $command:"); } - &send_footer($request); - return OK; + } + &send_footer($request); + return OK; } 1; -__END__ +__END__;