# The LearningOnline Network with CAPA # The LON-CAPA Grading handler # # $Id: grades.pm,v 1.28 2002/06/20 21:21:16 ng 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; use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; use Apache::lonhomework; use Apache::Constants qw(:common); sub moreinfo { my ($request,$reason) = @_; $request->print("Unable to process request: $reason"); if ( $Apache::grades::viewgrades eq 'F' ) { $request->print('
'."\n"); if ($ENV{'form.url'}) { $request->print(''."\n"); } if ($ENV{'form.symb'}) { $request->print(''."\n"); } $request->print(''."\n"); $request->print("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(''); } } $request->print('
UsernameNameDomain 
$sname$fullname$sdom". ''); if ($ENV{'form.url'}) { $request->print( ''); } if ($ENV{'form.symb'}) { $request->print( ''); } $request->print( ''); $request->print( ''); $request->print( ''); $request->print( ''); $request->print( ''); $request->print('
'); } #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'}); #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 ($username,$domain) = split(/:/,$student); my (@requests) = ('lastname','firstname','middlename','generation'); my (%name) = &Apache::lonnet::get('environment',\@requests,$domain,$username); my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); my $fullname=$name{'lastname'}.$name{'generation'}; if ($fullname =~ /[^\s]+/) { $fullname.=', '; } $fullname.=$name{'firstname'}.' '.$name{'middlename'}; $result.="$username$fullname$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 { my ($request) = @_; my $url=$ENV{'form.url'}; $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; } # if ($ENV{'form.student'} eq '') { &listStudents($request); return ''; } my ($uname,$udom) = &finduser($ENV{'form.student'}); if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; } my $symb; if ($ENV{'form.symb'}) { $symb=$ENV{'form.symb'}; } else { $symb=&Apache::lonnet::symbread($url); } if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, $ENV{'request.course.id'}); my $result='

Submission Record

'; $result.='Username : '.$uname.'
Fullname : '.$ENV{'form.fullname'}.'
Domain : '.$udom.'
Resource : '.$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"; $result.=''."\n"; $result.='
'."\n"; $result.=' Resource : '.$url.'
'."\n"; $result.='
'."\n". ''."\n". ''."\n". ''."\n". ''."\n". '
'."\n"; $result.='
'."\n". ''."\n". ''."\n". ''."\n". ''."\n". '
'."\n"; $result.='
'."\n". ''."\n". ''."\n". ''."\n". ''."\n". '
'."\n"; $result.='
'."\n"; $result.='
'."\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.='
UsernameNameDomain'.$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(''); } sub send_footer { my ($request)= @_; $request->print(''); $request->print(&Apache::lontexconvert::footer()); } 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; &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 ''); $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:"); } } &send_footer($request); return OK; } 1; __END__;