--- loncom/homework/grades.pm 2001/02/13 19:43:44 1.4 +++ loncom/homework/grades.pm 2002/05/24 21:45:22 1.27 @@ -1,5 +1,34 @@ +# The LearningOnline Network with CAPA # The LON-CAPA Grading handler +# +# $Id: grades.pm,v 1.27 2002/05/24 21:45:22 albertel Exp $ +# +# 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 H.K. Ng +# 8/20 Gerd Kortemeyer package Apache::grades; use strict; @@ -13,20 +42,256 @@ use Apache::Constants qw(:common); sub moreinfo { my ($request,$reason) = @_; $request->print("Unable to process request: $reason"); - $request->print('
'."\n"); - $request->print(''."\n"); - $request->print(''."\n"); - $request->print("Student:".''."
\n"); - $request->print("Domain:".''."
\n"); - $request->print(''."
\n"); - $request->print('
'); + 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 ''; +} + +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($cdom,$cnum,'0'); + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + my ($uname,$udom)=split(/\:/,$student); + if ($receipt eq + &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { + $request->print('Matching '.$student.'
'); + $matches++; + } + } + $request->print('

'.$matches.' match(es)

'); + } + return ''; +} + +sub listStudents { + my ($request) = shift; + 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'}); + $request->print(<Verify a Submission Receipt Issued by this Server +
+$hostver- + + +ENDHEADER + if ($ENV{'form.url'}) { + $request->print( + ''); + } + if ($ENV{'form.symb'}) { + $request->print( + ''); + } + $request->print(< +

Show Student Submissions on Assessment

+ + +ENDTABLEST + my (%classlist) = &getclasslist($cdom,$cnum,'0'); + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + my ($sname,$sdom) = split(/:/,$student); + + 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'}; + } + if ( $Apache::grades::viewgrades eq 'F' ) { + $request->print("\n".''."'); + } + } + $request->print('
UsernameDomainName 
$sname$sdom$fullname". + ''); + if ($ENV{'form.url'}) { + $request->print( + ''); + } + if ($ENV{'form.symb'}) { + $request->print( + ''); + } + $request->print( + ''); + $request->print( + ''); + $request->print( + ''); + $request->print( + ''); + $request->print('
'); } -#FIXME - needs to be much smarter +#FIXME - needs to handle multiple matches sub finduser { my ($name) = @_; - return ($name,$ENV{'user.domain'}); + my $domain = ''; + + if ( $Apache::grades::viewgrades eq 'F' ) { + #get classlist + my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); + #print "Found $cdom:$cnum
"; + my (%classlist) = &getclasslist($cdom,$cnum,'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'}); + } +} + +sub getclasslist { + my ($coursedomain,$coursenum,$hideexpired) = @_; + my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum); + my $now = time; + foreach my $student (keys(%classlist)) { + my ($end,$start)=split(/:/,$classlist{$student}); + # still a student? + if (($hideexpired) && ($end) && ($end < $now)) { + #print "Skipping:$name:$end:$now
\n"; + next; + } + #print "record=$record
"; + push( @{ $classlist{'allids'} }, $student); + } + return (%classlist); +} + +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); + } + } + return @parts; +} + +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"; + } + } + $result.=''; + return $result; +} +#FIXME need to look at the meatdata 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); + + $result.="Stored away ".scalar(keys(%newrecord))." elements.
\n"; + } + return $result; } sub submission { @@ -34,25 +299,372 @@ sub submission { 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); + my $symb; + if ($ENV{'form.symb'}) { + $symb=$ENV{'form.symb'}; + } else { + $symb=&Apache::lonnet::symbread($url); + } if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - my $home=&Apache::lonnet::homeserver($uname,$udom); - my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,$home, + my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, $ENV{'request.course.id'}); - my $result="

Submission Record

$uname:$udom for $url".$answer; + my $result="

Submission Record

$uname:$udom for $url
".$answer; + my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, + $ENV{'request.course.id'}); + $result.="Student's view of the problem:
$rendered
Correct answer:
"; + + $answer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, + $ENV{'request.course.id'}); + $result.=$answer; return $result; } +sub get_symb_and_url { + my ($request) = @_; + 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 ''; } + return ($symb,$url); +} + +sub gradingmenu { + my ($request) = @_; + my ($symb,$url)=&get_symb_and_url($request); + if (!$symb) {return '';} + my $result='

Select a grading method


'; + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'; + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'; + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'; + return $result; +} + +sub viewgrades { + 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($cdom,$cnum,'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 (sort(@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; +} + +sub editgrades { + 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($cdom,$cnum,'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 csvupload { + my ($request)= @_; + my $result; + my ($symb,$url)=&get_symb_and_url($request); + if (!$symb) {return '';} + my $upfile_select=&Apache::loncommon::upfile_select_html(); + $result.=< + + + +
+

Specify a file containing the class grades for resource $url

+$upfile_select +

+ENDUPFORM + return $result; +} + +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); +} + +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

'); + &Apache::lonhomework::showhash(('1'=>\@keyfields)); + &Apache::lonhomework::showhash(%fields); + my $courseid=$ENV{'request.course.id'}; + my $cdom=$ENV{"course.$courseid.domain"}; + my $cnum=$ENV{"course.$courseid.num"}; + my (%classlist) = &getclasslist($cdom,$cnum,'1'); + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + my %newhash; + foreach my $grade (@gradedata) { + my %entries=&Apache::loncommon::record_sep($grade); + foreach my $dest (keys(%fields)) { + + } + } + } +} + sub send_header { my ($request)= @_; $request->print(&Apache::lontexconvert::header()); - $request->print(" -"); +# $request->print(" +#"); $request->print(''); } @@ -74,18 +686,74 @@ sub handler { } $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 '') { - $request->print("Non-Contextual Access Unsupported:$command:$url:"); + if ($url eq '' && $symb eq '') { + if ($ENV{'user.adv'}) { + if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && + ($ENV{'form.codethree'})) { + my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'. + $ENV{'form.codethree'}; + my ($tsymb,$tuname,$tudom,$tcrsid)= + &Apache::lonnet::checkin($token); + if ($tsymb) { + my ($map,$id,$url)=split(/\_\_\_/,$tsymb); + if (&Apache::lonnet::allowed('mgr',$tcrsid)) { + $request->print( + &Apache::lonnet::ssi('/res/'.$url, + ('grade_username' => $tuname, + 'grade_domain' => $tudom, + 'grade_courseid' => $tcrsid, + 'grade_symb' => $tsymb))); + } else { + $request->print('

Not authorized: '.$token.'

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

Not a valid DocID: '.$token.'

'); + } + } else { + $request->print(&Apache::lonxml::tokeninputfield()); + } + } } else { - $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$url); + &Apache::lonhomework::showhashsubset(\%ENV,'^form'); + $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); if ($command eq 'submission') { - $request->print(&submission($request)); + &listStudents($request) if ($ENV{'form.student'} eq ''); + $request->print(&submission($request)) if ($ENV{'form.student'} ne ''); + } elsif ($command eq 'gradingmenu') { + $request->print(&gradingmenu($request)); + } elsif ($command eq 'viewgrades') { + $request->print(&viewgrades($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 'csvuploadassign') { + if ($ENV{'form.associate'} ne 'Reverse Association') { + $request->print(&csvuploadassign($request)); + } else { + if ( $ENV{'form.upfile_associate'} ne 'reverse' ) { + $ENV{'form.upfile_associate'} = 'reverse'; + } else { + $ENV{'form.upfile_associate'} = 'forward'; + } + $request->print(&csvuploadmap($request)); + } } else { - $request->print("Unknown action:$command:"); + $request->print("Unknown action: $command:"); } } &send_footer($request);