--- loncom/homework/grades.pm 2007/06/16 14:09:52 1.412
+++ loncom/homework/grades.pm 2007/09/07 00:07:30 1.439
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.412 2007/06/16 14:09:52 www Exp $
+# $Id: grades.pm,v 1.439 2007/09/07 00:07:30 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -45,36 +45,26 @@ use LONCAPA;
use POSIX qw(floor);
-my %oldessays=();
+
my %perm=();
+my %bubble_lines_per_response; # no. bubble lines for each response.
+ # index is "symb.part_id"
+
# ----- These first few routines are general use routines.----
#
# --- Retrieve the parts from the metadata file.---
sub getpartlist {
my ($symb) = @_;
- my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
- my $partorder = &Apache::lonnet::metadata($url, 'partorder');
- my @parts;
- if ($partorder) {
- for my $part (split (/,/,$partorder)) {
- if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) {
- push(@parts, $part);
- }
- }
- } else {
- my $metadata = &Apache::lonnet::metadata($url, 'packages');
- foreach (split(/\,/,$metadata)) {
- if ($_ =~ /^part_(.*)$/) {
- if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) {
- push(@parts, $1);
- }
- }
- }
- }
+
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my $res = $navmap->getBySymb($symb);
+ my $partlist = $res->parts();
+ my $url = $res->src();
+ my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys'));
+
my @stores;
- foreach my $part (@parts) {
- my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
+ foreach my $part (@{ $partlist }) {
foreach my $key (@metakeys) {
if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
}
@@ -93,6 +83,7 @@ sub get_symb {
return ();
}
}
+ &Apache::lonenc::check_decrypt(\$symb);
return ($symb);
}
@@ -194,22 +185,54 @@ sub showResourceInfo {
return $result,$responseType,$hdgrade,$partlist,$handgrade;
}
+sub reset_caches {
+ &reset_analyze_cache();
+ &reset_perm();
+}
-sub get_order {
- my ($partid,$respid,$symb,$uname,$udom)=@_;
- my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
- $url=&Apache::lonnet::clutter($url);
- my $subresult=&Apache::lonnet::ssi($url,
- ('grade_target' => 'analyze'),
- ('grade_domain' => $udom),
- ('grade_symb' => $symb),
- ('grade_courseid' =>
- $env{'request.course.id'}),
- ('grade_username' => $uname));
- (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
- my %analyze=&Apache::lonnet::str2hash($subresult);
- return ($analyze{"$partid.$respid.shown"});
+{
+ my %analyze_cache;
+
+ sub reset_analyze_cache {
+ undef(%analyze_cache);
+ }
+
+ sub get_analyze {
+ my ($symb,$uname,$udom)=@_;
+ my $key = "$symb\0$uname\0$udom";
+ return $analyze_cache{$key} if (exists($analyze_cache{$key}));
+
+ my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
+ $url=&Apache::lonnet::clutter($url);
+ my $subresult=&Apache::lonnet::ssi($url,
+ ('grade_target' => 'analyze'),
+ ('grade_domain' => $udom),
+ ('grade_symb' => $symb),
+ ('grade_courseid' =>
+ $env{'request.course.id'}),
+ ('grade_username' => $uname));
+ (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
+ my %analyze=&Apache::lonnet::str2hash($subresult);
+ return $analyze_cache{$key} = \%analyze;
+ }
+
+ sub get_order {
+ my ($partid,$respid,$symb,$uname,$udom)=@_;
+ my $analyze = &get_analyze($symb,$uname,$udom);
+ return $analyze->{"$partid.$respid.shown"};
+ }
+
+ sub get_radiobutton_correct_foil {
+ my ($partid,$respid,$symb,$uname,$udom)=@_;
+ my $analyze = &get_analyze($symb,$uname,$udom);
+ foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) {
+ if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
+ return $foil;
+ }
+ }
+ }
}
+
#--- Clean response type for display
#--- Currently filters option/rank/radiobutton/match/essay/Task
# response types only.
@@ -258,11 +281,11 @@ sub cleanRecord {
} elsif ($response eq 'radiobutton') {
my %answer=&Apache::lonnet::str2hash($answer);
my ($toprow,$bottomrow);
- my $correct=($order->[0])+1;
- for (my $i=1;$i<=$#$order;$i++) {
- my $foil=$order->[$i];
+ my $correct =
+ &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom);
+ foreach my $foil (@$order) {
if (exists($answer{$foil})) {
- if ($i == $correct) {
+ if ($foil eq $correct) {
$toprow.='
true
';
} else {
$toprow.='
true
';
@@ -492,7 +515,7 @@ sub jscriptNform {
' }'."\n".
''."\n";
$jscript.= ''."\n";
+ 'onClick="javascript:submit();" target="_self" />'."\n";
if (scalar(%$fullname) eq 0) {
my $colspan=3+scalar(@parts);
- $result='There are no students in section "'.$env{'form.section'}.
- '" with enrollment status "'.$env{'form.Status'}.'" to modify or grade.';
+ my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
+ $result=''.
+ &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade',
+ $section_display, $env{'form.Status'}).
+ '';
}
$result.=&show_grading_menu_form($symb);
return $result;
@@ -3107,7 +3138,7 @@ sub viewstudentgrade {
''.
"\n".$ctr.'
'."\n";
$student=~s/:/_/; # colon doen't work in javascript for names
foreach my $apart (@$parts) {
@@ -3168,9 +3199,10 @@ sub editgrades {
my ($request) = @_;
my $symb=&get_symb($request);
- my $title='
Current Grade Status
';
- $title.='
Current Resource: '.$env{'form.probTitle'}.'
'."\n";
- $title.='
Section: '.$env{'form.section'}.'
'."\n";
+ my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
+ my $title='
'.
@@ -3368,7 +3400,7 @@ sub split_part_type {
my ($partstr) = @_;
my ($temp,@allparts)=split(/_/,$partstr);
my $type=pop(@allparts);
- my $part=join('.',@allparts);
+ my $part=join('_',@allparts);
return ($part,$type);
}
@@ -3471,6 +3503,7 @@ sub csvuploadmap_header {
my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
my $ignore=&mt('Ignore First Line');
+ $symb = &Apache::lonenc::check_encrypt($symb);
$request->print(<
Uploading Class Grades
@@ -3565,6 +3598,7 @@ sub upcsvScores_form {
my $upload=&mt("Upload Scores");
my $upfile_select=&Apache::loncommon::upfile_select_html();
my $ignore=&mt('Ignore First Line');
+ $symb = &Apache::lonenc::check_encrypt($symb);
$result.=<
@@ -3839,7 +3873,7 @@ LISTJAVASCRIPT
$result.='
SCANTRONFORM
}
+
+ # Chunk of the form that prompts to view a scoring office file,
+ # corrected file, skipped records in a file.
+
$r->print(<
');
}
+=pod
+
+=item num_matches
+
+ Counts the number of characters that are the same between the two arguments.
+
+ Arguments:
+ $orig - CODE from the scanline
+ $code - CODE to match against
+
+ Returns:
+ $count - integer count of the number of same characters between the
+ two arguments
+
+=cut
+
sub num_matches {
my ($orig,$code) = @_;
my @code=split(//,$code);
@@ -5525,6 +6324,26 @@ sub num_matches {
return $same;
}
+=pod
+
+=item scantron_get_closely_matching_CODEs
+
+ Cycles through all CODEs and finds the set that has the greatest
+ number of same characters as the provided CODE
+
+ Arguments:
+ $allcodes - hash ref returned by &get_codes()
+ $CODE - CODE from the current scanline
+
+ Returns:
+ 2 element list
+ - first elements is number of how closely matching the best fit is
+ (5 means best set has 5 matching characters)
+ - second element is an arrary ref containing the set of valid CODEs
+ that best fit the passed in CODE
+
+=cut
+
sub scantron_get_closely_matching_CODEs {
my ($allcodes,$CODE)=@_;
my @CODEs;
@@ -5535,6 +6354,23 @@ sub scantron_get_closely_matching_CODEs
return ($#CODEs,$CODEs[-1]);
}
+=pod
+
+=item get_codes
+
+ Builds a hash which has keys of all of the valid CODEs from the selected
+ set of remembered CODEs.
+
+ Arguments:
+ $old_name - name of the set of remembered CODEs
+ $cdom - domain of the course
+ $cnum - internal course name
+
+ Returns:
+ %allcodes - keys are the valid CODEs, values are all 1
+
+=cut
+
sub get_codes {
my ($old_name, $cdom, $cnum) = @_;
if (!$old_name) {
@@ -5557,6 +6393,16 @@ sub get_codes {
return %allcodes;
}
+=pod
+
+=item scantron_validate_CODE
+
+ Validates all scanlines in the selected file to not have any
+ invalid or underspecified CODEs and that none of the codes are
+ duplicated if this was requested.
+
+=cut
+
sub scantron_validate_CODE {
my ($r,$currentphase) = @_;
my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
@@ -5608,6 +6454,15 @@ sub scantron_validate_CODE {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_validate_doublebubble
+
+ Validates all scanlines in the selected file to not have any
+ bubble lines with multiple bubbles marked.
+
+=cut
+
sub scantron_validate_doublebubble {
my ($r,$currentphase) = @_;
#get student info
@@ -5631,7 +6486,21 @@ sub scantron_validate_doublebubble {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_get_maxbubble
+
+ Returns the maximum number of bubble lines that are expected to
+ occur. Does this by walking the selected sequence rendering the
+ resource and then checking &Apache::lonxml::get_problem_counter()
+ for what the current value of the problem counter is.
+
+ Caches the result to $env{'form.scantron_maxbubble'}
+
+=cut
+
sub scantron_get_maxbubble {
+
if (defined($env{'form.scantron_maxbubble'}) &&
$env{'form.scantron_maxbubble'}) {
return $env{'form.scantron_maxbubble'};
@@ -5646,17 +6515,52 @@ sub scantron_get_maxbubble {
&Apache::lonxml::clear_problem_counter();
+ my $uname = $env{'form.student'};
+ my $udom = $env{'form.userdom'};
+ my $cid = $env{'request.course.id'};
+ my $total_lines = 0;
+ %bubble_lines_per_response = ();
+
foreach my $resource (@resources) {
+ my $symb = $resource->symb();
my $result=&Apache::lonnet::ssi($resource->src(),
- ('symb' => $resource->symb()));
+ ('symb' => $resource->symb()),
+ ('grade_target' => 'analyze'),
+ ('grade_courseid' => $cid),
+ ('grade_domain' => $udom),
+ ('grade_username' => $uname));
+ my (undef, $an) =
+ split(/_HASH_REF__/,$result, 2);
+
+ my %analysis = &Apache::lonnet::str2hash($an);
+
+
+
+ foreach my $part_id (@{$analysis{'parts'}}) {
+ my $bubble_lines = $analysis{"$part_id.bubble_lines"}[0];
+ if (!$bubble_lines) {
+ $bubble_lines = 1;
+ }
+ $bubble_lines_per_response{"$symb.$part_id"} = $bubble_lines;
+ $total_lines = $total_lines + $bubble_lines;
+ }
+
}
&Apache::lonnet::delenv('scantron\.');
$env{'form.scantron_maxbubble'} =
- &Apache::lonxml::get_problem_counter()-1;
-
+ $total_lines;
return $env{'form.scantron_maxbubble'};
}
+=pod
+
+=item scantron_validate_missingbubbles
+
+ Validates all scanlines in the selected file to not have any
+ bubble lines with missing bubbles that haven't been verified as missing.
+
+=cut
+
sub scantron_validate_missingbubbles {
my ($r,$currentphase) = @_;
#get student info
@@ -5689,6 +6593,30 @@ sub scantron_validate_missingbubbles {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_process_students
+
+ Routine that does the actual grading of the bubble sheet information.
+
+ The parsed scanline hash is added to %env
+
+ Then foreach unskipped scanline it does an &Apache::lonnet::ssi()
+ foreach resource , with the form data of
+
+ 'submitted' =>'scantron'
+ 'grade_target' =>'grade',
+ 'grade_username'=> username of student
+ 'grade_domain' => domain of student
+ 'grade_courseid'=> of course
+ 'grade_symb' => symb of resource to grade
+
+ This triggers a grading pass. The problem grading code takes care
+ of converting the bubbled letter information (now in %env) into a
+ valid submission.
+
+=cut
+
sub scantron_process_students {
my ($r) = @_;
my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
@@ -5793,6 +6721,14 @@ SCANTRONFORM
return '';
}
+=pod
+
+=item scantron_upload_scantron_data
+
+ Creates the screen for adding a new bubble sheet data file to a course.
+
+=cut
+
sub scantron_upload_scantron_data {
my ($r)=@_;
$r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));
@@ -5829,6 +6765,15 @@ UPLOAD
return '';
}
+=pod
+
+=item scantron_upload_scantron_data_save
+
+ Adds a provided bubble information data file to the course if user
+ has the correct privileges to do so.
+
+=cut
+
sub scantron_upload_scantron_data_save {
my($r)=@_;
my ($symb)=&get_symb($r,1);
@@ -5884,6 +6829,14 @@ sub scantron_upload_scantron_data_save {
return '';
}
+=pod
+
+=item valid_file
+
+ Validates that the requested bubble data file exists in the course.
+
+=cut
+
sub valid_file {
my ($requested_file)=@_;
foreach my $filename (sort(&scantron_filenames())) {
@@ -5892,6 +6845,16 @@ sub valid_file {
return 0;
}
+=pod
+
+=item scantron_download_scantron_data
+
+ Shows a list of the three internal files (original, corrected,
+ skipped) for a specific bubble sheet data file that exists in the
+ course.
+
+=cut
+
sub scantron_download_scantron_data {
my ($r)=@_;
my $default_form_data=&defaultFormData(&get_symb($r,1));
@@ -5928,6 +6891,12 @@ DOWNLOAD
return '';
}
+=pod
+
+=back
+
+=cut
+
#-------- end of section for handling grading scantron forms -------
#
#-------------------------------------------------------------------
@@ -5938,7 +6907,7 @@ DOWNLOAD
sub show_grading_menu_form {
my ($symb)=@_;
my $result.='