--- loncom/homework/grades.pm 2006/06/12 18:56:22 1.361
+++ loncom/homework/grades.pm 2006/10/13 21:49:28 1.378
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.361 2006/06/12 18:56:22 albertel Exp $
+# $Id: grades.pm,v 1.378 2006/10/13 21:49:28 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,7 +36,7 @@ use Apache::lonhtmlcommon;
use Apache::lonnavmaps;
use Apache::lonhomework;
use Apache::loncoursedata;
-use Apache::lonmsg qw(:user_normal_msg);
+use Apache::lonmsg();
use Apache::Constants qw(:common);
use Apache::lonlocal;
use String::Similarity;
@@ -112,36 +112,34 @@ sub nameUserString {
#--- Indicate if a response type is coded handgraded or not. ---
sub response_type {
my ($symb) = shift;
- my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
- my $allkeys = &Apache::lonnet::metadata($url,'keys');
- my %vPart;
- foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) {
- $vPart{$partid}=1;
- }
- my %seen = ();
- my (@partlist,%handgrade,%responseType);
- foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
- if (/^\w+response_.*/ || /^Task_/) {
- my ($responsetype,$part) = split(/_/,$_,2);
- my ($partid,$respid) = split(/_/,$part);
- if ($responsetype eq 'Task') { $respid='0'; }
- if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {
- next;
- }
- if (%vPart && !exists($vPart{$partid})) {
- next;
- }
- $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!!
- my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb);
- $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no');
- if (!exists($responseType{$partid})) { $responseType{$partid}={}; }
- $responseType{$partid}->{$respid}=$responsetype;
- next if ($seen{$partid} > 0);
- $seen{$partid}++;
- push @partlist,$partid;
- }
- }
- return (\@partlist,\%handgrade,\%responseType);
+
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my $res = $navmap->getBySymb($symb);
+ my $partlist = $res->parts();
+ my (%response_types,%handgrade);
+ foreach my $part (@{ $partlist }) {
+ my @types = $res->responseType($part);
+ my @ids = $res->responseIds($part);
+ for (my $i=0; $i < scalar(@ids); $i++) {
+ $response_types{$part}{$ids[$i]} = $types[$i];
+ $handgrade{$part.'_'.$ids[$i]} =
+ &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i].
+ '.handgrade',$symb);
+ }
+ }
+ return ($partlist,\%handgrade,\%response_types);
+}
+
+sub flatten_responseType {
+ my ($responseType) = @_;
+ my @part_response_id =
+ map {
+ my $part = $_;
+ map {
+ [$part,$_]
+ } sort(keys(%{ $responseType->{$part} }));
+ } sort(keys(%$responseType));
+ return @part_response_id;
}
sub get_display_part {
@@ -168,25 +166,26 @@ sub showResourceInfo {
my %resptype = ();
my $hdgrade='no';
my %partsseen;
- for my $part_resID (sort keys(%$handgrade)) {
- my $handgrade=$$handgrade{$part_resID};
- my ($partID,$resID) = split(/_/,$part_resID);
- my $responsetype = $responseType->{$partID}->{$resID};
- $hdgrade = $handgrade if ($handgrade eq 'yes');
- $result.='
Part: '.
$display_part.' ( ID '.$respid.
@@ -1990,8 +1994,10 @@ KEYWORDS
my %seen = ();
my @partlist;
my @gradePartRespid;
- for my $part_resp (sort(keys(%$handgrade))) {
- my ($partid,$respid) = split(/_/, $part_resp);
+ my @part_response_id = &flatten_responseType($responseType);
+ foreach my $part_response_id (@part_response_id) {
+ my ($partid,$respid) = @{ $part_response_id };
+ my $part_resp = join('_',@{ $part_response_id });
next if ($seen{$partid} > 0);
$seen{$partid}++;
next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/);
@@ -2107,6 +2113,7 @@ sub processHandGrade {
if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
$subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/);
unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); }
+ $subject.=' ['.&Apache::lonnet::declutter($url).']';
my (@msgnum) = split(/,/,$includemsg);
foreach (@msgnum) {
$message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne '');
@@ -2119,8 +2126,8 @@ sub processHandGrade {
"?symb=$symb\">$env{'form.probTitle'}";
}
$msgstatus = &Apache::lonmsg::user_normal_msg($uname,$udom,
- $subject.' ['.
- &Apache::lonnet::declutter($url).']',$message);
+ $subject,
+ $message);
$request->print(' '.&mt('Sending message to [_1]@[_2]',$uname,$udom).': '.
$msgstatus);
}
@@ -2133,11 +2140,11 @@ sub processHandGrade {
&saveHandGrade($request,$symb,$collaborator,$udom,$ctr,
$env{'form.unamedom'.$ctr},$part);
if ($errorflag eq 'not_allowed') {
- $request->print("Not allowed to modify grades for $collaborator:$udom");
+ $request->print("".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."");
next;
} else {
if ($message ne '') {
- $msgstatus = &Apache::lonmsg::user_normal_msg($collaborator,$udom,$env{'form.msgsub'},$message);
+ $msgstatus = &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message);
}
}
}
@@ -2329,7 +2336,7 @@ sub saveHandGrade {
if (exists($record{'resource.'.$new_part.'.awarded'})) {
$newrecord{'resource.'.$new_part.'.awarded'} = '';
}
- $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
+ $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
}
} elsif ($dropMenu eq 'reset status'
&& exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts
@@ -2389,7 +2396,6 @@ sub saveHandGrade {
}
$newrecord{'resource.'.$new_part.'.regrader'}=
"$env{'user.name'}:$env{'user.domain'}";
- &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
}
# unless problem has been graded, set flag to version the submitted files
unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ ||
@@ -2404,8 +2410,13 @@ sub saveHandGrade {
if (%newrecord) {
if (@version_parts) {
- my @changed_keys = &version_portfiles(\%record, \@parts_graded, $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts);
+ my @changed_keys = &version_portfiles(\%record, \@parts_graded,
+ $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts);
@newrecord{@changed_keys} = @record{@changed_keys};
+ foreach my $new_part (@version_parts) {
+ &handback_files($request,$symb,$stuname,$domain,$newflg,
+ $new_part,\%newrecord);
+ }
}
&Apache::lonnet::cstore(\%newrecord,$symb,
$env{'request.course.id'},$domain,$stuname);
@@ -2432,11 +2443,15 @@ sub handback_files {
my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio';
my ($partlist,$handgrade,$responseType) = &response_type($symb);
- foreach my $part_resp (sort(keys(%$handgrade))) {
- my ($part_id, $resp_id) = split(/_/,$part_resp);
+
+ my @part_response_id = &flatten_responseType($responseType);
+ foreach my $part_response_id (@part_response_id) {
+ my ($part_id,$resp_id) = @{ $part_response_id };
+ my $part_resp = join('_',@{ $part_response_id });
if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) {
# if multiple files are uploaded names will be 'returndoc2','returndoc3'
my $file_counter = 1;
+ my $file_msg;
while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {
my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};
my ($directory,$answer_file) =
@@ -2446,9 +2461,6 @@ sub handback_files {
my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root);
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
- my $new_answer = &version_selected_portfile($domain, $stuname, $portfolio_path, $answer_file, $version);
- $$newrecord{"resource.$new_part.$resp_id.handback"} = $new_answer;
- $version++;
# fix file name
my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,
@@ -2460,21 +2472,29 @@ sub handback_files {
} else {
# mark the file as read only
my @files = ($save_file_name);
- my @what = ($symb,'handback');
+ my @what = ($symb,$env{'request.course.id'},'handback');
&Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what);
- my $subject = "File Handed Back by Instructor ";
- my $message = "A file has been returned that was originally submitted in reponse to: ";
- $message .= "".&Apache::lonnet::gettitle($symb)." ";
- $message .= " The returned file is named: ".$save_file_name." ";
- $message .= " and can be found in your portfolio space.";
- &Apache::lonnet::logthis($message);
- my $msgstatus = &Apache::lonmsg::user_normal_msg($stuname,$domain,
- $subject.' [File Returned]',$message);
+ if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) {
+ $$newrecord{"resource.$new_part.$resp_id.handback"}.=',';
+ }
+ $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name;
+ $file_msg.= "\n".' '.$save_file_name." ";
+
}
$request->print(" ".$fname." will be the uploaded file name");
$request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter});
$file_counter++;
}
+ my $subject = "File Handed Back by Instructor ";
+ my $message = "A file has been returned that was originally submitted in reponse to: ";
+ $message .= "".&Apache::lonnet::gettitle($symb)." ";
+ $message .= ' The returned file(s) are named: '. $file_msg;
+ $message .= " and can be found in your portfolio space.";
+ my $url = (&Apache::lonnet::decode_symb($symb))[2];
+ $url = &Apache::lonnet::declutter($url);
+ my $msgstatus = &Apache::lonmsg::user_normal_msg($stuname,$domain,
+ $subject.' (File Returned) ['.$url.']',$message);
+
}
}
return;
@@ -2566,7 +2586,7 @@ sub version_portfiles {
my $new_portfiles;
if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {
my @versioned_portfiles;
- my @portfiles = split(/,/,$$record{$key});
+ my @portfiles = split(/\s*,\s*/,$$record{$key});
foreach my $file (@portfiles) {
&Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file);
my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
@@ -2578,7 +2598,7 @@ sub version_portfiles {
if ($new_answer ne 'problem getting file') {
push(@versioned_portfiles, $directory.$new_answer);
&Apache::lonnet::mark_as_readonly($domain,$stu_name,
- ['/portfolio'.$directory.$new_answer],
+ [$directory.$new_answer],
[$symb,$env{'request.course.id'},'graded']);
}
}
@@ -2860,16 +2880,18 @@ sub viewgrades {
'';
#radio buttons/text box for assigning points for a section or class.
#handles different parts of a problem
- my ($partlist,$handgrade) = &response_type($symb);
+ my ($partlist,$handgrade,$responseType) = &response_type($symb);
my %weight = ();
my $ctsparts = 0;
$result.='';
my %seen = ();
- for (sort keys(%$handgrade)) {
- my ($partid,$respid) = split (/_/,$_,2);
+ my @part_response_id = &flatten_responseType($responseType);
+ foreach my $part_response_id (@part_response_id) {
+ my ($partid,$respid) = @{ $part_response_id };
+ my $part_resp = join('_',@{ $part_response_id });
next if $seen{$partid};
$seen{$partid}++;
- my $handgrade=$$handgrade{$_};
+ my $handgrade=$$handgrade{$part_resp};
my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);
$weight{$partid} = $wgt eq '' ? '1' : $wgt;
@@ -3428,9 +3450,10 @@ sub upcsvScores_form {
$result.=$table;
$result.='
'."\n";
$result.=''."\n";
+ $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV",
+ &mt("How do I create a CSV file from a spreadsheet"))
+ .' | '."\n";
$result.='
'."\n";
$result.=&show_grading_menu_form($symb);
return $result;
@@ -4591,7 +4616,8 @@ sub scantron_parse_scanline {
substr($questions,0,$$scantron_config{'Qlength'})='';
if (length($currentquest) < $$scantron_config{'Qlength'}) { next; }
if ($$scantron_config{'Qon'} eq 'letter') {
- if ($currentquest eq '?') {
+ if ($currentquest eq '?'
+ || $currentquest eq '*') {
push(@{$record{'scantron.doubleerror'}},$questnum);
$record{"scantron.$questnum.answer"}='';
} elsif (!$currentquest
@@ -4605,7 +4631,8 @@ sub scantron_parse_scanline {
$record{"scantron.$questnum.answer"}=$currentquest;
}
} elsif ($$scantron_config{'Qon'} eq 'number') {
- if ($currentquest eq '?') {
+ if ($currentquest eq '?'
+ || $currentquest eq '*') {
push(@{$record{'scantron.doubleerror'}},$questnum);
$record{"scantron.$questnum.answer"}='';
} elsif (!$currentquest
@@ -4616,8 +4643,14 @@ sub scantron_parse_scanline {
push(@{$record{"scantron.missingerror"}},$questnum);
}
} else {
- $record{"scantron.$questnum.answer"}=
- $alphabet[$currentquest-1];
+ # wrap zero back to J
+ if ($currentquest eq '0') {
+ $record{"scantron.$questnum.answer"}=
+ $alphabet[9];
+ } else {
+ $record{"scantron.$questnum.answer"}=
+ $alphabet[$currentquest-1];
+ }
}
} else {
my @array=split($$scantron_config{'Qon'},$currentquest,-1);
@@ -4747,21 +4780,29 @@ sub reset_skipping_status {
&scantron_putfile(undef,$scan_data);
}
-sub allow_skipping {
+sub start_skipping {
my ($scan_data,$i)=@_;
my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
- delete($remembered{$i});
+ if ($env{'form.scantron_options_redo'} =~ /^redo_/) {
+ $remembered{$i}=2;
+ } else {
+ $remembered{$i}=1;
+ }
&scan_data($scan_data,'remember_skipping',join(':',%remembered));
}
sub should_be_skipped {
- my ($scan_data,$i)=@_;
+ my ($scanlines,$scan_data,$i)=@_;
if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
# not redoing old skips
+ if ($scanlines->{'skipped'}[$i]) { return 1; }
return 0;
}
my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
- if (exists($remembered{$i})) { return 0; }
+
+ if (exists($remembered{$i}) && $remembered{$i} != 2 ) {
+ return 0;
+ }
return 1;
}
@@ -4773,6 +4814,7 @@ sub remember_current_skipped {
$to_remember{$i}=1;
}
}
+
&scan_data($scan_data,'remember_skipping',join(':',%to_remember));
&scantron_putfile(undef,$scan_data);
}
@@ -4788,15 +4830,15 @@ sub scantron_warning_screen {
my ($button_text)=@_;
my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});
my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
- my $CODElist="a";
+ my $CODElist;
if ($scantron_config{'CODElocation'} &&
$scantron_config{'CODEstart'} &&
$scantron_config{'CODElength'}) {
$CODElist=$env{'form.scantron_CODElist'};
- if ($CODElist eq '') { $CODElist='None'; }
+ if ($env{'form.scantron_CODElist'} eq '') { $CODElist='None'; }
$CODElist=
' | List of CODES to validate against: | '.
- $CODElist.' | ';
+ $env{'form.scantron_CODElist'}.'';
}
return (<
@@ -4878,7 +4920,6 @@ sub scantron_validate_file {
}
if ($env{'form.scantron_options_redo'} eq 'redo_skipped') {
&remember_current_skipped();
- &scantron_remove_file('skipped');
$env{'form.scantron_options_redo'}='redo_skipped_ready';
}
@@ -5048,8 +5089,8 @@ sub scantron_putfile {
sub scantron_get_line {
my ($scanlines,$scan_data,$i)=@_;
- if (&should_be_skipped($scan_data,$i)) { return undef; }
- if ($scanlines->{'skipped'}[$i]) { return undef; }
+ if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; }
+ #if ($scanlines->{'skipped'}[$i]) { return undef; }
if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
return $scanlines->{'orig'}[$i];
}
@@ -5069,12 +5110,21 @@ sub scantron_put_line {
my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
if ($skip) {
$scanlines->{'skipped'}[$i]=$newline;
- &allow_skipping($scan_data,$i);
+ &start_skipping($scan_data,$i);
return;
}
$scanlines->{'corrected'}[$i]=$newline;
}
+sub scantron_clear_skip {
+ my ($scanlines,$scan_data,$i)=@_;
+ if (exists($scanlines->{'skipped'}[$i])) {
+ undef($scanlines->{'skipped'}[$i]);
+ return 1;
+ }
+ return 0;
+}
+
sub scantron_filter_not_exam {
my ($curres)=@_;
@@ -5561,6 +5611,10 @@ SCANTRONFORM
&Apache::lonxml::clear_problem_counter();
&Apache::lonnet::appenv(%$scan_record);
+
+ if (&scantron_clear_skip($scanlines,$scan_data,$i)) {
+ &scantron_putfile($scanlines,$scan_data);
+ }
my $i=0;
foreach my $resource (@resources) {
|