--- loncom/homework/grades.pm 2003/03/17 19:08:50 1.73
+++ loncom/homework/grades.pm 2003/07/14 16:11:19 1.115
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.73 2003/03/17 19:08:50 albertel Exp $
+# $Id: grades.pm,v 1.115 2003/07/14 16:11:19 ng Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -41,11 +41,16 @@ use Apache::style;
use Apache::lonxml;
use Apache::lonnet;
use Apache::loncommon;
+use Apache::lonhtmlcommon;
use Apache::lonnavmaps;
use Apache::lonhomework;
use Apache::loncoursedata;
use Apache::lonmsg qw(:user_normal_msg);
use Apache::Constants qw(:common);
+use String::Similarity;
+
+my %oldessays=();
+my %perm=();
# ----- These first few routines are general use routines.----
#
@@ -113,7 +118,7 @@ sub response_type {
#--- Dumps the class list with usernames,list of sections,
#--- section, ids and fullnames for each user.
sub getclasslist {
- my ($getsec,$hideexpired) = @_;
+ my ($getsec,$filterlist) = @_;
my $classlist=&Apache::loncoursedata::get_classlist();
# Bail out if we were unable to get the classlist
return if (! defined($classlist));
@@ -124,59 +129,68 @@ sub getclasslist {
# the following undefs are for 'domain', and 'username' respectively.
my (undef,undef,$end,$start,$id,$section,$fullname,$status)=
@{$classlist->{$_}};
- # still a student?
- if (($hideexpired) && ($status ne 'Active')) {
- delete ($classlist->{$_});
- next;
- }
+ # filter students according to status selected
+ if ($filterlist && $ENV{'form.Status'} ne 'Any') {
+ if ($ENV{'form.Status'} ne $status) {
+ delete ($classlist->{$_});
+ next;
+ }
+ }
$section = ($section ne '' ? $section : 'no');
- if ($getsec eq 'all' || $getsec eq $section) {
- $sections{$section}++;
- $fullnames{$_}=$fullname;
- } else {
- delete($classlist->{$_});
- }
+ if (&canview($section)) {
+ if ($getsec eq 'all' || $getsec eq $section) {
+ $sections{$section}++;
+ $fullnames{$_}=$fullname;
+ } else {
+ delete($classlist->{$_});
+ }
+ } else {
+ delete($classlist->{$_});
+ }
}
my %seen = ();
my @sections = sort(keys(%sections));
return ($classlist,\@sections,\%fullnames);
}
-#find user domain
-sub finduser {
- my ($name) = @_;
- my $domain = '';
- if ( $Apache::grades::viewgrades eq 'F' ) {
- my %classlist=&Apache::lonnet::dump('classlist',
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
- my (@fields) = grep /^$name:/, keys %classlist;
- ($name, $domain) = split(/:/,$fields[0]);
- return ($name,$domain);
- } else {
- return ($ENV{'user.name'},$ENV{'user.domain'});
+sub canmodify {
+ my ($sec)=@_;
+ if ($perm{'mgr'}) {
+ if (!defined($perm{'mgr_section'})) {
+ # can modify whole class
+ return 1;
+ } else {
+ if ($sec eq $perm{'mgr_section'}) {
+ #can modify the requested section
+ return 1;
+ } else {
+ # can't modify the request section
+ return 0;
+ }
+ }
}
+ #can't modify
+ return 0;
}
-#--- 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('
');
+sub canview {
+ my ($sec)=@_;
+ if ($perm{'vgr'}) {
+ if (!defined($perm{'vgr_section'})) {
+ # can modify whole class
+ return 1;
+ } else {
+ if ($sec eq $perm{'vgr_section'}) {
+ #can modify the requested section
+ return 1;
+ } else {
+ # can't modify the request section
+ return 0;
+ }
+ }
}
- return '';
+ #can't modify
+ return 0;
}
#--- Retrieve the grade status of a student for all the parts
@@ -209,8 +223,7 @@ sub jscriptNform {
$jscript.= '
+$grading_menu_button
+SCANTRONFORM
+
+ return $result;
+}
+
+sub get_scantron_config {
+ my ($which) = @_;
+ my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+ my %config;
+ foreach my $line (<$fh>) {
+ my ($name,$descrip)=split(/:/,$line);
+ if ($name ne $which ) { next; }
+ chomp($line);
+ my @config=split(/:/,$line);
+ $config{'name'}=$config[0];
+ $config{'description'}=$config[1];
+ $config{'CODElocation'}=$config[2];
+ $config{'CODEstart'}=$config[3];
+ $config{'CODElength'}=$config[4];
+ $config{'IDstart'}=$config[5];
+ $config{'IDlength'}=$config[6];
+ $config{'Qstart'}=$config[7];
+ $config{'Qlength'}=$config[8];
+ $config{'Qoff'}=$config[9];
+ $config{'Qon'}=$config[10];
+ last;
+ }
+ return %config;
+}
+
+sub username_to_idmap {
+ my ($classlist)= @_;
+ my %idmap;
+ foreach my $student (keys(%$classlist)) {
+ $idmap{$classlist->{$student}->[&Apache::loncoursedata::CL_ID]}=
+ $student;
+ }
+ return %idmap;
+}
+
+sub scantron_parse_scanline {
+ my ($line,$scantron_config)=@_;
+ my %record;
+ my $questions=substr($line,$$scantron_config{'Qstart'}-1);
+ my $data=substr($line,0,$$scantron_config{'Qstart'}-1);
+ if ($$scantron_config{'CODElocation'} ne 0) {
+ if ($$scantron_config{'CODElocation'} < 0) {
+ $record{'scantron.CODE'}=substr($data,$$scantron_config{'CODEstart'}-1,
+ $$scantron_config{'CODElength'});
+ } else {
+ #FIXME interpret first N questions
+ }
+ }
+ $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
+ $$scantron_config{'IDlength'});
+ my @alphabet=('A'..'Z');
+ my $questnum=0;
+ while ($questions) {
+ $questnum++;
+ my $currentquest=substr($questions,0,$$scantron_config{'Qlength'});
+ substr($questions,0,$$scantron_config{'Qlength'})='';
+ if (length($currentquest) < $$scantron_config{'Qlength'}) { next; }
+ my (@array)=split(/$$scantron_config{'Qon'}/,$currentquest);
+ if (scalar(@array) gt 2) {
+ #FIXME do something intelligent with double bubbles
+ Apache->request->print(" Wha!!!
result is'.$result);
+ &Apache::lonhomework::showhash(%score);
+ # if ($i eq 3) {last;}
+ }
+ &Apache::lonnet::delenv('form.counter');
+ &Apache::lonnet::delenv('scantron\.');
+ &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+ 'last student Who got a '.$studentcorrect.' correct and '.
+ $studentincorrect.' incorrect. The class has gotten '.
+ $totalcorrect.' correct and '.$totalincorrect.' incorrect');
+ last;
+ #FIXME
+ #get iterator for $sequence
+ #foreach question 'submit' the students answer to the server
+ # through grade target {
+ # generate data to pass back that includes grade recevied
+ #}
+ }
+ $Apache::lonxml::debug=0;
+ foreach my $delay (@delayqueue) {
+ #FIXME
+ #print out each delayed student with interface to select how
+ # to repair student provided info
+ #Expected errors include
+ # 1 bad/no stuid/username
+ # 2 invalid bubblings
+
+ }
+ #FIXME
+ # if delay queue exists 2 submits one to process delayed students one
+ # to ignore delayed students, possibly saving the delay queue for later
+
+ $navmap->untieHashes();
+}
+#-------- end of section for handling grading scantron forms -------
+#
+#-------------------------------------------------------------------
+
+
#-------------------------- Menu interface -------------------------
#
#--- Show a Grading Menu button - Calls the next routine ---
@@ -2775,40 +3307,40 @@ sub show_grading_menu_form {
my $result.='