--- loncom/homework/grades.pm 2006/03/13 20:26:51 1.333
+++ loncom/homework/grades.pm 2006/03/21 13:49:34 1.338
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.333 2006/03/13 20:26:51 albertel Exp $
+# $Id: grades.pm,v 1.338 2006/03/21 13:49:34 banghart Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -118,9 +118,10 @@ sub response_type {
my %seen = ();
my (@partlist,%handgrade,%responseType);
foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
- if (/^\w+response_.*/) {
+ 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;
}
@@ -205,9 +206,11 @@ sub get_order {
return ($analyze{"$partid.$respid.shown"});
}
#--- Clean response type for display
-#--- Currently filters option/rank/radiobutton/match/essay response types only.
+#--- Currently filters option/rank/radiobutton/match/essay/Task
+# response types only.
sub cleanRecord {
- my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_;
+ my ($answer,$response,$symb,$partid,$respid,$record,$order,$version,
+ $uname,$udom) = @_;
my $grayFont = '<font color="#999999">';
if ($response =~ /^(option|rank)$/) {
my %answer=&Apache::lonnet::str2hash($answer);
@@ -288,6 +291,37 @@ sub cleanRecord {
my $jme=$record->{$version."resource.$partid.$respid.molecule"};
$result.=&Apache::chemresponse::jme_img($jme,$answer,400);
return $result;
+ } elsif ( $response eq 'Task') {
+ if ( $answer eq 'SUBMITTED') {
+ my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"};
+ my $result = &Apache::bridgetask::file_list($files,$uname,$udom);
+ return $result;
+ } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) {
+ my @matches = grep(/^\Q$version\E.*?\.instance$/,
+ keys(%{$record}));
+ return join('<br />',($version,@matches));
+
+
+ } else {
+ my $result =
+ '<p>'
+ .&mt('Overall result: [_1]',
+ $record->{$version."resource.$respid.$partid.status"})
+ .'</p>';
+
+ $result .= '<ul>';
+ my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/,
+ keys(%{$record}));
+ foreach my $grade (sort(@grade)) {
+ my ($dim) = ($grade =~/[.]([^.]+)[.]status$/);
+ $result.= '<li>'.&mt("Dimension: [_1], status [_2] ",
+ $dim, $record->{$grade}).
+ '</li>';
+ }
+ $result.='</ul>';
+ return $result;
+ }
+
}
return $answer;
}
@@ -1841,7 +1875,7 @@ KEYWORDS
foreach my $file (@$files) {
$file_counter ++;
&Apache::lonnet::allowuploaded('/adm/grades',$file);
- $lastsubonly.='<br /><a href="'.$file.'" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0"> '.$file.'</a>';
+ $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border=0"> '.$file.'</a>';
}
$lastsubonly.='<br />';
}
@@ -2239,16 +2273,15 @@ sub saveHandGrade {
my $usec = &Apache::lonnet::getsection($domain,$stuname,
$env{'request.course.id'});
if (!&canmodify($usec)) { return('not_allowed'); }
- my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);
+ my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);
my @parts_graded;
my %newrecord = ();
my ($pts,$wgt) = ('','');
my %aggregate = ();
my $aggregateflag = 0;
-
my @parts = split(/:/,$env{'form.partlist'.$newflg});
foreach my $new_part (@parts) {
- #collaborator may vary for different parts
+ #collaborator ($submi may vary for different parts
if ($submitter && $new_part ne $part) { next; }
my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};
if ($dropMenu eq 'excused') {
@@ -2316,32 +2349,8 @@ sub saveHandGrade {
}
$newrecord{'resource.'.$new_part.'.regrader'}=
"$env{'user.name'}:$env{'user.domain'}";
+ &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
}
- my ($partlist,$handgrade,$responseType) = &response_type($symb);
- foreach my $part_resp (sort(keys(%$handgrade))) {
- my ($part_id, $resp_id) = split(/_/,$part_resp);
- 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;
- while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {
- my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};
- $newrecord{"resource.$new_part.$resp_id.handback"} = $env{'form.returndocorig'.$file_counter};
- # set the filename to match the submitted file name
- $env{'form.'.$newflg.'_'.$part_resp.'_returndoc1.filename'} = $env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter};
- my $result=&Apache::lonnet::userfileupload($newflg.'_'.$part_resp.'_returndoc'.$file_counter,'',
- 'portfolio',undef,undef,undef,$stuname,$domain);
- if ($result !~ m|^/uploaded/|) {
- $request->print('<font color="red"> An errror occured ('.$result.
- ') while trying to upload '.&display_file().'</font><br />');
- # $request->print(&done('Back'));
- }
- $request->print("<br />".$fname." will be the uploaded file name");
- $request->print("<font color=\"red\">Will upload document</font>".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter});
- $file_counter++;
- }
- }
- }
-
# unless problem has been graded, set flag to version the submitted files
unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ ||
$record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||
@@ -2359,7 +2368,6 @@ sub saveHandGrade {
}
&Apache::lonnet::cstore(\%newrecord,$symb,
$env{'request.course.id'},$domain,$stuname);
-
my @ungraded_parts;
foreach my $part (@parts) {
if ( !defined($record{'resource.'.$part.'.awarded'})
@@ -2379,6 +2387,46 @@ sub saveHandGrade {
return ('',$pts,$wgt);
}
+sub handback_files {
+ my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
+ my $portfolio_root = &Apache::loncommon::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);
+ 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;
+ while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {
+ my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};
+ my ($directory,$answer_file) =
+ ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/);
+ my ($answer_name,$answer_ver,$answer_ext) =
+ &file_name_version_ext($answer_file);
+ my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stuname,$portfolio_root);
+ my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
+ my $new_answer = &version_selected_portfile($domain, $stuname, $directory, $answer_file, $version);
+ $$newrecord{"resource.$new_part.$resp_id.handback"} = $new_answer;
+
+ # set the filename to match the submitted file name
+ $env{'form.'.$newflg.'_'.$part_resp.'_returndoc1.filename'} = $env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter};
+ my $result=&Apache::lonnet::userfileupload($newflg.'_'.$part_resp.'_returndoc'.$file_counter,'',
+ 'portfolio',undef,undef,undef,$stuname,$domain);
+ if ($result !~ m|^/uploaded/|) {
+ $request->print('<font color="red"> An errror occured ('.$result.
+ ') while trying to upload '.&display_file().'</font><br />');
+ # $request->print(&done('Back'));
+ }
+ $request->print("<br />".$fname." will be the uploaded file name");
+ $request->print("<font color=\"red\">Will upload document </font>".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter});
+ $file_counter++;
+ }
+ }
+ }
+ return;
+}
+
sub get_submitted_files {
my ($udom,$uname,$partid,$respid,$record) = @_;
my @files;
@@ -3842,6 +3890,7 @@ sub displayPage {
sub displaySubByDates {
my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
my $isCODE=0;
+ my $isTask = ($symb =~/\.task$/);
if (exists($record->{'resource.CODE'})) { $isCODE=1; }
my $studentTable='<table border="0" width="100%"><tr><td bgcolor="#777777">'.
'<table border="0" width="100%"><tr bgcolor="#e6ffff">'.
@@ -3856,8 +3905,17 @@ sub displaySubByDates {
if (!exists($$record{'1:timestamp'})) {
return '<br /> <font color="red">Nothing submitted - no attempts</font><br />';
}
+
+ my $interaction;
for ($version=1;$version<=$$record{'version'};$version++) {
my $timestamp = scalar(localtime($$record{$version.':timestamp'}));
+ if (exists($$record{$version.':resource.0.version'})) {
+ $interaction = $$record{$version.':resource.0.version'};
+ }
+
+ my $where = ($isTask ? "$version:resource.$interaction"
+ : "$version:resource");
+ #&Apache::lonnet::logthis(" got $where");
$studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>';
if ($isCODE) {
$studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';
@@ -3865,40 +3923,57 @@ sub displaySubByDates {
my @versionKeys = split(/\:/,$$record{$version.':keys'});
my @displaySub = ();
foreach my $partid (@{$parts}) {
- my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys);
+ my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)
+ : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
+
+
# next if ($$record{"$version:resource.$partid.solved"} eq '');
my $display_part=&get_display_part($partid,$symb);
foreach my $matchKey (@matchKey) {
if (exists($$record{$version.':'.$matchKey}) &&
$$record{$version.':'.$matchKey} ne '') {
- my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/);
+
+ my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
+ : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
+ #&Apache::lonnet::logthis("match $matchKey $responseId (".$$record{$version.':'.$matchKey});
$displaySub[0].='<b>Part:</b> '.$display_part.' ';
$displaySub[0].='<font color="#999999">(ID '.
$responseId.')</font> <b>';
- if ($$record{"$version:resource.$partid.tries"} eq '') {
+ if ($$record{"$where.$partid.tries"} eq '') {
$displaySub[0].='Trial not counted';
} else {
$displaySub[0].='Trial '.
- $$record{"$version:resource.$partid.tries"};
+ $$record{"$where.$partid.tries"};
}
- my $responseType=$responseType->{$partid}->{$responseId};
+ my $responseType=($isTask ? 'Task'
+ : $responseType->{$partid}->{$responseId});
if (!exists($orders{$partid})) { $orders{$partid}={}; }
if (!exists($orders{$partid}->{$responseId})) {
$orders{$partid}->{$responseId}=
&get_order($partid,$responseId,$symb,$uname,$udom);
}
$displaySub[0].='</b> '.
- &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'<br />';
+ &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'<br />';
}
}
- if (exists $$record{"$version:resource.$partid.award"}) {
+ if (exists($$record{"$where.$partid.checkedin"})) {
+ $displaySub[1].='Checked in by '.
+ $$record{"$where.$partid.checkedin"}.' into slot '.
+ $$record{"$where.$partid.checkedin.slot"}.
+ '<br />';
+ }
+ if (exists $$record{"$where.$partid.award"}) {
$displaySub[1].='<b>Part:</b> '.$display_part.' '.
- lc($$record{"$version:resource.$partid.award"}).' '.
- $mark{$$record{"$version:resource.$partid.solved"}}.
+ lc($$record{"$where.$partid.award"}).' '.
+ $mark{$$record{"$where.$partid.solved"}}.
'<br />';
}
- if (exists $$record{"$version:resource.$partid.regrader"}) {
- $displaySub[2].=$$record{"$version:resource.$partid.regrader"}.
+ if (exists $$record{"$where.$partid.regrader"}) {
+ $displaySub[2].=$$record{"$where.$partid.regrader"}.
+ ' (<b>'.&mt('Part').':</b> '.$display_part.')';
+ } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) {
+ $displaySub[2].=
+ $$record{"$version:resource.$partid.regrader"}.
' (<b>'.&mt('Part').':</b> '.$display_part.')';
}
}
@@ -4637,7 +4712,6 @@ sub remember_current_skipped {
$to_remember{$i}=1;
}
}
- &Apache::lonnet::logthis('remembering '.join(':',%to_remember));
&scan_data($scan_data,'remember_skipping',join(':',%to_remember));
&scantron_putfile(undef,$scan_data);
}
@@ -4764,7 +4838,8 @@ sub scantron_validate_file {
my $result=&scantron_form_start($max_bubble).$default_form_data;
$r->print($result);
- my @validate_phases=( 'ID',
+ my @validate_phases=( 'sequence',
+ 'ID',
'CODE',
'doublebubble',
'missingbubbles');
@@ -4797,10 +4872,17 @@ STUFF
$r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
}
if ($stop) {
- $r->print('<input type="submit" name="submit" value="Continue ->" />');
- $r->print(' using corrected info <br />');
- $r->print("<input type='submit' value='Skip' name='scantron_skip_record' />");
- $r->print(" this scanline saving it for later.");
+ if ($validate_phases[$currentphase] eq 'sequence') {
+ $r->print('<input type="submit" name="submit" value="Ignore -> " />');
+ $r->print(' this error <br />');
+
+ $r->print(" <p>Or click the 'Grading Menu' button to start over.</p>");
+ } else {
+ $r->print('<input type="submit" name="submit" value="Continue ->" />');
+ $r->print(' using corrected info <br />');
+ $r->print("<input type='submit' value='Skip' name='scantron_skip_record' />");
+ $r->print(" this scanline saving it for later.");
+ }
}
$r->print(" </form><br />".&show_grading_menu_form($symb).
"</body></html>");
@@ -4933,6 +5015,45 @@ sub scantron_put_line {
$scanlines->{'corrected'}[$i]=$newline;
}
+sub scantron_filter_not_exam {
+ my ($curres)=@_;
+
+ if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) {
+ # if the user has asked to not have either hidden
+ # or 'randomout' controlled resources to be graded
+ # don't include them
+ if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
+ && $curres->randomout) {
+ return 0;
+ }
+ return 1;
+ }
+ return 0;
+}
+
+sub scantron_validate_sequence {
+ my ($r,$currentphase) = @_;
+
+ my $navmap=Apache::lonnavmaps::navmap->new();
+ my (undef,undef,$sequence)=
+ &Apache::lonnet::decode_symb($env{'form.selectpage'});
+
+ my $map=$navmap->getResourceByUrl($sequence);
+
+ $r->print('<input type="hidden" name="validate_sequence_exam"
+ value="ignore" />');
+ if ($env{'form.validate_sequence_exam'} ne 'ignore') {
+ my @resources=
+ $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
+ if (@resources) {
+ $r->print("<p>".&mt('Some resource in the sequece currently are not set to exam mode. Grading these resources currently may not work correctly.')."</p>");
+ return (1,$currentphase);
+ }
+ }
+
+ return (0,$currentphase+1);
+}
+
sub scantron_validate_ID {
my ($r,$currentphase) = @_;
@@ -5512,7 +5633,6 @@ sub scantron_upload_scantron_data_save {
sub valid_file {
my ($requested_file)=@_;
foreach my $filename (sort(&scantron_filenames())) {
- &Apache::lonnet::logthis("$requested_file $filename");
if ($requested_file eq $filename) { return 1; }
}
return 0;