loncom/homework/grades.pm - view

File: [LON-CAPA] / loncom / homework / grades.pm
Revision 1.440: download - view: text, annotated - select for diffs
Mon Sep 10 23:03:35 2007 UTC (16 years, 8 months ago) by albertel
Branches: MAIN
CVS tags: HEAD

- BUG#5409, multi-entry numerical/formula response submissions were not displaying correctly in the PGRD view

1: # The LearningOnline Network with CAPA 2: # The LON-CAPA Grading handler 3: # 4: # $Id: grades.pm,v 1.440 2007/09/10 23:03:35 albertel Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: package Apache::grades; 30: use strict; 31: use Apache::style; 32: use Apache::lonxml; 33: use Apache::lonnet; 34: use Apache::loncommon; 35: use Apache::lonhtmlcommon; 36: use Apache::lonnavmaps; 37: use Apache::lonhomework; 38: use Apache::loncoursedata; 39: use Apache::lonmsg(); 40: use Apache::Constants qw(:common); 41: use Apache::lonlocal; 42: use Apache::lonenc; 43: use String::Similarity; 44: use LONCAPA; 45: 46: use POSIX qw(floor); 47: 48: 49: my %perm=(); 50: my %bubble_lines_per_response; # no. bubble lines for each response. 51: # index is "symb.part_id" 52: 53: 54: # ----- These first few routines are general use routines.---- 55: # 56: # --- Retrieve the parts from the metadata file.--- 57: sub getpartlist { 58: my ($symb) = @_; 59: 60: my $navmap = Apache::lonnavmaps::navmap->new(); 61: my $res = $navmap->getBySymb($symb); 62: my $partlist = $res->parts(); 63: my $url = $res->src(); 64: my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys')); 65: 66: my @stores; 67: foreach my $part (@{ $partlist }) { 68: foreach my $key (@metakeys) { 69: if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } 70: } 71: } 72: return @stores; 73: } 74: 75: # --- Get the symbolic name of a problem and the url 76: sub get_symb { 77: my ($request,$silent) = @_; 78: (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; 79: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); 80: if ($symb eq '') { 81: if (!$silent) { 82: $request->print("Unable to handle ambiguous references:$url:."); 83: return (); 84: } 85: } 86: &Apache::lonenc::check_decrypt(\$symb); 87: return ($symb); 88: } 89: 90: #--- Format fullname, username:domain if different for display 91: #--- Use anywhere where the student names are listed 92: sub nameUserString { 93: my ($type,$fullname,$uname,$udom) = @_; 94: if ($type eq 'header') { 95: return '<b> Fullname </b><span class="LC_internal_info">(Username)</span>'; 96: } else { 97: return ' '.$fullname.'<span class="LC_internal_info"> ('.$uname. 98: ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')</span>'; 99: } 100: } 101: 102: #--- Get the partlist and the response type for a given problem. --- 103: #--- Indicate if a response type is coded handgraded or not. --- 104: sub response_type { 105: my ($symb) = shift; 106: 107: my $navmap = Apache::lonnavmaps::navmap->new(); 108: my $res = $navmap->getBySymb($symb); 109: my $partlist = $res->parts(); 110: my %vPart = 111: map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); 112: my (%response_types,%handgrade); 113: foreach my $part (@{ $partlist }) { 114: next if (%vPart && !exists($vPart{$part})); 115: 116: my @types = $res->responseType($part); 117: my @ids = $res->responseIds($part); 118: for (my $i=0; $i < scalar(@ids); $i++) { 119: $response_types{$part}{$ids[$i]} = $types[$i]; 120: $handgrade{$part.'_'.$ids[$i]} = 121: &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. 122: '.handgrade',$symb); 123: } 124: } 125: return ($partlist,\%handgrade,\%response_types); 126: } 127: 128: sub flatten_responseType { 129: my ($responseType) = @_; 130: my @part_response_id = 131: map { 132: my $part = $_; 133: map { 134: [$part,$_] 135: } sort(keys(%{ $responseType->{$part} })); 136: } sort(keys(%$responseType)); 137: return @part_response_id; 138: } 139: 140: sub get_display_part { 141: my ($partID,$symb)=@_; 142: my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); 143: if (defined($display) and $display ne '') { 144: $display.= " (<span class=\"LC_internal_info\">id $partID</span>)"; 145: } else { 146: $display=$partID; 147: } 148: return $display; 149: } 150: 151: #--- Show resource title 152: #--- and parts and response type 153: sub showResourceInfo { 154: my ($symb,$probTitle,$checkboxes) = @_; 155: my $col=3; 156: if ($checkboxes) { $col=4; } 157: my $result = '<h3>'.&mt('Current Resource').': '.$probTitle.'</h3>'."\n"; 158: $result .='<table border="0">'; 159: my ($partlist,$handgrade,$responseType) = &response_type($symb); 160: my %resptype = (); 161: my $hdgrade='no'; 162: my %partsseen; 163: foreach my $partID (sort keys(%$responseType)) { 164: foreach my $resID (sort keys(%{ $responseType->{$partID} })) { 165: my $handgrade=$$handgrade{$partID.'_'.$resID}; 166: my $responsetype = $responseType->{$partID}->{$resID}; 167: $hdgrade = $handgrade if ($handgrade eq 'yes'); 168: $result.='<tr>'; 169: if ($checkboxes) { 170: if (exists($partsseen{$partID})) { 171: $result.="<td> </td>"; 172: } else { 173: $result.="<td><input type='checkbox' name='vPart' value='$partID' checked='checked' /></td>"; 174: } 175: $partsseen{$partID}=1; 176: } 177: my $display_part=&get_display_part($partID,$symb); 178: $result.='<td><b>Part: </b>'.$display_part.' <span class="LC_internal_info">'. 179: $resID.'</span></td>'. 180: '<td><b>Type: </b>'.$responsetype.'</td></tr>'; 181: # '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>'; 182: } 183: } 184: $result.='</table>'."\n"; 185: return $result,$responseType,$hdgrade,$partlist,$handgrade; 186: } 187: 188: sub reset_caches { 189: &reset_analyze_cache(); 190: &reset_perm(); 191: } 192: 193: { 194: my %analyze_cache; 195: 196: sub reset_analyze_cache { 197: undef(%analyze_cache); 198: } 199: 200: sub get_analyze { 201: my ($symb,$uname,$udom)=@_; 202: my $key = "$symb\0$uname\0$udom"; 203: return $analyze_cache{$key} if (exists($analyze_cache{$key})); 204: 205: my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); 206: $url=&Apache::lonnet::clutter($url); 207: my $subresult=&Apache::lonnet::ssi($url, 208: ('grade_target' => 'analyze'), 209: ('grade_domain' => $udom), 210: ('grade_symb' => $symb), 211: ('grade_courseid' => 212: $env{'request.course.id'}), 213: ('grade_username' => $uname)); 214: (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); 215: my %analyze=&Apache::lonnet::str2hash($subresult); 216: return $analyze_cache{$key} = \%analyze; 217: } 218: 219: sub get_order { 220: my ($partid,$respid,$symb,$uname,$udom)=@_; 221: my $analyze = &get_analyze($symb,$uname,$udom); 222: return $analyze->{"$partid.$respid.shown"}; 223: } 224: 225: sub get_radiobutton_correct_foil { 226: my ($partid,$respid,$symb,$uname,$udom)=@_; 227: my $analyze = &get_analyze($symb,$uname,$udom); 228: foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) { 229: if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { 230: return $foil; 231: } 232: } 233: } 234: } 235: 236: #--- Clean response type for display 237: #--- Currently filters option/rank/radiobutton/match/essay/Task 238: # response types only. 239: sub cleanRecord { 240: my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, 241: $uname,$udom) = @_; 242: my $grayFont = '<span class="LC_internal_info">'; 243: if ($response =~ /^(option|rank)$/) { 244: my %answer=&Apache::lonnet::str2hash($answer); 245: my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); 246: my ($toprow,$bottomrow); 247: foreach my $foil (@$order) { 248: if ($grading{$foil} == 1) { 249: $toprow.='<td><b>'.$answer{$foil}.' </b></td>'; 250: } else { 251: $toprow.='<td><i>'.$answer{$foil}.' </i></td>'; 252: } 253: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 254: } 255: return '<blockquote><table border="1">'. 256: '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'. 257: '<tr valign="top"><td>'.$grayFont.'Option ID</span></td>'. 258: $grayFont.$bottomrow.'</tr>'.'</table></blockquote>'; 259: } elsif ($response eq 'match') { 260: my %answer=&Apache::lonnet::str2hash($answer); 261: my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); 262: my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); 263: my ($toprow,$middlerow,$bottomrow); 264: foreach my $foil (@$order) { 265: my $item=shift(@items); 266: if ($grading{$foil} == 1) { 267: $toprow.='<td><b>'.$item.' </b></td>'; 268: $middlerow.='<td><b>'.$grayFont.$answer{$foil}.' </span></b></td>'; 269: } else { 270: $toprow.='<td><i>'.$item.' </i></td>'; 271: $middlerow.='<td><i>'.$grayFont.$answer{$foil}.' </span></i></td>'; 272: } 273: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 274: } 275: return '<blockquote><table border="1">'. 276: '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'. 277: '<tr valign="top"><td>'.$grayFont.'Item ID</span></td>'. 278: $middlerow.'</tr>'. 279: '<tr valign="top"><td>'.$grayFont.'Option ID</span></td>'. 280: $bottomrow.'</tr>'.'</table></blockquote>'; 281: } elsif ($response eq 'radiobutton') { 282: my %answer=&Apache::lonnet::str2hash($answer); 283: my ($toprow,$bottomrow); 284: my $correct = 285: &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); 286: foreach my $foil (@$order) { 287: if (exists($answer{$foil})) { 288: if ($foil eq $correct) { 289: $toprow.='<td><b>true</b></td>'; 290: } else { 291: $toprow.='<td><i>true</i></td>'; 292: } 293: } else { 294: $toprow.='<td>false</td>'; 295: } 296: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 297: } 298: return '<blockquote><table border="1">'. 299: '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'. 300: '<tr valign="top"><td>'.$grayFont.'Option ID</span></td>'. 301: $grayFont.$bottomrow.'</tr>'.'</table></blockquote>'; 302: } elsif ($response eq 'essay') { 303: if (! exists ($env{'form.'.$symb})) { 304: my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', 305: $env{'course.'.$env{'request.course.id'}.'.domain'}, 306: $env{'course.'.$env{'request.course.id'}.'.num'}); 307: 308: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 309: $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; 310: $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; 311: $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; 312: $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; 313: $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. 314: } 315: $answer =~ s-\n-<br />-g; 316: return '<br /><br /><blockquote><tt>'.&keywords_highlight($answer).'</tt></blockquote>'; 317: } elsif ( $response eq 'organic') { 318: my $result='Smile representation: "<tt>'.$answer.'</tt>"'; 319: my $jme=$record->{$version."resource.$partid.$respid.molecule"}; 320: $result.=&Apache::chemresponse::jme_img($jme,$answer,400); 321: return $result; 322: } elsif ( $response eq 'Task') { 323: if ( $answer eq 'SUBMITTED') { 324: my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; 325: my $result = &Apache::bridgetask::file_list($files,$uname,$udom); 326: return $result; 327: } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { 328: my @matches = grep(/^\Q$version\E.*?\.instance$/, 329: keys(%{$record})); 330: return join('<br />',($version,@matches)); 331: 332: 333: } else { 334: my $result = 335: '<p>' 336: .&mt('Overall result: [_1]', 337: $record->{$version."resource.$respid.$partid.status"}) 338: .'</p>'; 339: 340: $result .= '<ul>'; 341: my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/, 342: keys(%{$record})); 343: foreach my $grade (sort(@grade)) { 344: my ($dim) = ($grade =~/[.]([^.]+)[.]status$/); 345: $result.= '<li>'.&mt("Dimension: [_1], status [_2] ", 346: $dim, $record->{$grade}). 347: '</li>'; 348: } 349: $result.='</ul>'; 350: return $result; 351: } 352: } elsif ( $response =~ m/(?:numerical|formula)/) { 353: $answer = 354: &Apache::loncommon::format_previous_attempt_value('submission', 355: $answer); 356: } 357: return $answer; 358: } 359: 360: #-- A couple of common js functions 361: sub commonJSfunctions { 362: my $request = shift; 363: $request->print(<<COMMONJSFUNCTIONS); 364: <script type="text/javascript" language="javascript"> 365: function radioSelection(radioButton) { 366: var selection=null; 367: if (radioButton.length > 1) { 368: for (var i=0; i<radioButton.length; i++) { 369: if (radioButton[i].checked) { 370: return radioButton[i].value; 371: } 372: } 373: } else { 374: if (radioButton.checked) return radioButton.value; 375: } 376: return selection; 377: } 378: 379: function pullDownSelection(selectOne) { 380: var selection=""; 381: if (selectOne.length > 1) { 382: for (var i=0; i<selectOne.length; i++) { 383: if (selectOne[i].selected) { 384: return selectOne[i].value; 385: } 386: } 387: } else { 388: // only one value it must be the selected one 389: return selectOne.value; 390: } 391: } 392: </script> 393: COMMONJSFUNCTIONS 394: } 395: 396: #--- Dumps the class list with usernames,list of sections, 397: #--- section, ids and fullnames for each user. 398: sub getclasslist { 399: my ($getsec,$filterlist) = @_; 400: my @getsec; 401: if (!ref($getsec)) { 402: if ($getsec ne '' && $getsec ne 'all') { 403: @getsec=($getsec); 404: } 405: } else { 406: @getsec=@{$getsec}; 407: } 408: if (grep(/^all$/,@getsec)) { undef(@getsec); } 409: 410: my $classlist=&Apache::loncoursedata::get_classlist(); 411: # Bail out if we were unable to get the classlist 412: return if (! defined($classlist)); 413: # 414: my %sections; 415: my %fullnames; 416: foreach my $student (keys(%$classlist)) { 417: my $end = 418: $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; 419: my $start = 420: $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; 421: my $id = 422: $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; 423: my $section = 424: $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; 425: my $fullname = 426: $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; 427: my $status = 428: $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; 429: # filter students according to status selected 430: if ($filterlist && $env{'form.Status'} ne 'Any') { 431: if ($env{'form.Status'} ne $status) { 432: delete ($classlist->{$student}); 433: next; 434: } 435: } 436: $section = ($section ne '' ? $section : 'none'); 437: if (&canview($section)) { 438: if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { 439: $sections{$section}++; 440: $fullnames{$student}=$fullname; 441: } else { 442: delete($classlist->{$student}); 443: } 444: } else { 445: delete($classlist->{$student}); 446: } 447: } 448: my %seen = (); 449: my @sections = sort(keys(%sections)); 450: return ($classlist,\@sections,\%fullnames); 451: } 452: 453: sub canmodify { 454: my ($sec)=@_; 455: if ($perm{'mgr'}) { 456: if (!defined($perm{'mgr_section'})) { 457: # can modify whole class 458: return 1; 459: } else { 460: if ($sec eq $perm{'mgr_section'}) { 461: #can modify the requested section 462: return 1; 463: } else { 464: # can't modify the request section 465: return 0; 466: } 467: } 468: } 469: #can't modify 470: return 0; 471: } 472: 473: sub canview { 474: my ($sec)=@_; 475: if ($perm{'vgr'}) { 476: if (!defined($perm{'vgr_section'})) { 477: # can modify whole class 478: return 1; 479: } else { 480: if ($sec eq $perm{'vgr_section'}) { 481: #can modify the requested section 482: return 1; 483: } else { 484: # can't modify the request section 485: return 0; 486: } 487: } 488: } 489: #can't modify 490: return 0; 491: } 492: 493: #--- Retrieve the grade status of a student for all the parts 494: sub student_gradeStatus { 495: my ($symb,$udom,$uname,$partlist) = @_; 496: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 497: my %partstatus = (); 498: foreach (@$partlist) { 499: my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); 500: $status = 'nothing' if ($status eq ''); 501: $partstatus{$_} = $status; 502: my $subkey = "resource.$_.submitted_by"; 503: $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); 504: } 505: return %partstatus; 506: } 507: 508: # hidden form and javascript that calls the form 509: # Use by verifyscript and viewgrades 510: # Shows a student's view of problem and submission 511: sub jscriptNform { 512: my ($symb) = @_; 513: my $jscript='<script type="text/javascript" language="javascript">'."\n". 514: ' function viewOneStudent(user,domain) {'."\n". 515: ' document.onestudent.student.value = user;'."\n". 516: ' document.onestudent.userdom.value = domain;'."\n". 517: ' document.onestudent.submit();'."\n". 518: ' }'."\n". 519: '</script>'."\n"; 520: $jscript.= '<form action="/adm/grades" method="post" name="onestudent">'."\n". 521: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 522: '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n". 523: '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n". 524: '<input type="hidden" name="Status" value="'.$env{'form.Status'}.'" />'."\n". 525: '<input type="hidden" name="command" value="submission" />'."\n". 526: '<input type="hidden" name="student" value="" />'."\n". 527: '<input type="hidden" name="userdom" value="" />'."\n". 528: '</form>'."\n"; 529: return $jscript; 530: } 531: 532: # Given the score (as a number [0-1] and the weight) what is the final 533: # point value? This function will round to the nearest tenth, third, 534: # or quarter if one of those is within the tolerance of .00001. 535: sub compute_points { 536: my ($score, $weight) = @_; 537: 538: my $tolerance = .00001; 539: my $points = $score * $weight; 540: 541: # Check for nearness to 1/x. 542: my $check_for_nearness = sub { 543: my ($factor) = @_; 544: my $num = ($points * $factor) + $tolerance; 545: my $floored_num = floor($num); 546: if ($num - $floored_num < 2 * $tolerance * $factor) { 547: return $floored_num / $factor; 548: } 549: return $points; 550: }; 551: 552: $points = $check_for_nearness->(10); 553: $points = $check_for_nearness->(3); 554: $points = $check_for_nearness->(4); 555: 556: return $points; 557: } 558: 559: #------------------ End of general use routines -------------------- 560: 561: # 562: # Find most similar essay 563: # 564: 565: sub most_similar { 566: my ($uname,$udom,$uessay,$old_essays)=@_; 567: 568: # ignore spaces and punctuation 569: 570: $uessay=~s/\W+/ /gs; 571: 572: # ignore empty submissions (occuring when only files are sent) 573: 574: unless ($uessay=~/\w+/) { return ''; } 575: 576: # these will be returned. Do not care if not at least 50 percent similar 577: my $limit=0.6; 578: my $sname=''; 579: my $sdom=''; 580: my $scrsid=''; 581: my $sessay=''; 582: # go through all essays ... 583: foreach my $tkey (keys(%$old_essays)) { 584: my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); 585: # ... except the same student 586: next if (($tname eq $uname) && ($tdom eq $udom)); 587: my $tessay=$old_essays->{$tkey}; 588: $tessay=~s/\W+/ /gs; 589: # String similarity gives up if not even limit 590: my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); 591: # Found one 592: if ($tsimilar>$limit) { 593: $limit=$tsimilar; 594: $sname=$tname; 595: $sdom=$tdom; 596: $scrsid=$tcrsid; 597: $sessay=$old_essays->{$tkey}; 598: } 599: } 600: if ($limit>0.6) { 601: return ($sname,$sdom,$scrsid,$sessay,$limit); 602: } else { 603: return ('','','','',0); 604: } 605: } 606: 607: #------------------------------------------------------------------- 608: 609: #------------------------------------ Receipt Verification Routines 610: # 611: #--- Check whether a receipt number is valid.--- 612: sub verifyreceipt { 613: my $request = shift; 614: 615: my $courseid = $env{'request.course.id'}; 616: my $receipt = &Apache::lonnet::recprefix($courseid).'-'. 617: $env{'form.receipt'}; 618: $receipt =~ s/[^\-\d]//g; 619: my ($symb) = &get_symb($request); 620: 621: my $title.='<h3><span class="LC_info">Verifying Submission Receipt '. 622: $receipt.'</h3></span>'."\n". 623: '<h4><b>Resource: </b>'.$env{'form.probTitle'}.'</h4><br /><br />'."\n"; 624: 625: my ($string,$contents,$matches) = ('','',0); 626: my (undef,undef,$fullname) = &getclasslist('all','0'); 627: 628: my $receiptparts=0; 629: if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || 630: $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } 631: my $parts=['0']; 632: if ($receiptparts) { ($parts)=&response_type($symb); } 633: foreach (sort 634: { 635: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 636: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 637: } 638: return $a cmp $b; 639: } (keys(%$fullname))) { 640: my ($uname,$udom)=split(/\:/); 641: foreach my $part (@$parts) { 642: if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { 643: $contents.='<tr bgcolor="#ffffe6"><td> '."\n". 644: '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. 645: '\');" target="_self">'.$$fullname{$_}.'</a> </td>'."\n". 646: '<td> '.$uname.' </td>'. 647: '<td> '.$udom.' </td>'; 648: if ($receiptparts) { 649: $contents.='<td> '.$part.' </td>'; 650: } 651: $contents.='</tr>'."\n"; 652: 653: $matches++; 654: } 655: } 656: } 657: if ($matches == 0) { 658: $string = $title.'No match found for the above receipt.'; 659: } else { 660: $string = &jscriptNform($symb).$title. 661: 'The above receipt matches the following student'. 662: ($matches <= 1 ? '.' : 's.')."\n". 663: '<table border="0"><tr><td bgcolor="#777777">'."\n". 664: '<table border="0"><tr bgcolor="#e6ffff">'."\n". 665: '<td><b> Fullname </b></td>'."\n". 666: '<td><b> Username </b></td>'."\n". 667: '<td><b> Domain </b></td>'; 668: if ($receiptparts) { 669: $string.='<td> Problem Part </td>'; 670: } 671: $string.='</tr>'."\n".$contents. 672: '</table></td></tr></table>'."\n"; 673: } 674: return $string.&show_grading_menu_form($symb); 675: } 676: 677: #--- This is called by a number of programs. 678: #--- Called from the Grading Menu - View/Grade an individual student 679: #--- Also called directly when one clicks on the subm button 680: # on the problem page. 681: sub listStudents { 682: my ($request) = shift; 683: 684: my ($symb) = &get_symb($request); 685: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 686: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 687: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 688: my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; 689: 690: my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; 691: $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 692: &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; 693: 694: my $result='<h3><span class="LC_info"> '.$viewgrade. 695: ' Submissions for a Student or a Group of Students</span></h3>'; 696: 697: my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); 698: 699: $request->print(<<LISTJAVASCRIPT); 700: <script type="text/javascript" language="javascript"> 701: function checkSelect(checkBox) { 702: var ctr=0; 703: var sense=""; 704: if (checkBox.length > 1) { 705: for (var i=0; i<checkBox.length; i++) { 706: if (checkBox[i].checked) { 707: ctr++; 708: } 709: } 710: sense = "a student or group of students"; 711: } else { 712: if (checkBox.checked) { 713: ctr = 1; 714: } 715: sense = "the student"; 716: } 717: if (ctr == 0) { 718: alert("Please select "+sense+" before clicking on the Next button."); 719: return false; 720: } 721: document.gradesub.submit(); 722: } 723: 724: function reLoadList(formname) { 725: if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;} 726: formname.command.value = 'submission'; 727: formname.submit(); 728: } 729: </script> 730: LISTJAVASCRIPT 731: 732: &commonJSfunctions($request); 733: $request->print($result); 734: 735: my $checkhdgrade = ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked="checked"' : ''; 736: my $checklastsub = $checkhdgrade eq '' ? 'checked="checked"' : ''; 737: my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'. 738: "\n".$table. 739: ' <b>View Problem Text: </b><label><input type="radio" name="vProb" value="no" checked="checked" /> no </label>'."\n". 740: '<label><input type="radio" name="vProb" value="yes" /> one student </label>'."\n". 741: '<label><input type="radio" name="vProb" value="all" /> all students </label><br />'."\n". 742: ' <b>View Answer: </b><label><input type="radio" name="vAns" value="no" /> no </label>'."\n". 743: '<label><input type="radio" name="vAns" value="yes" /> one student </label>'."\n". 744: '<label><input type="radio" name="vAns" value="all" checked="checked" /> all students </label><br />'."\n". 745: ' <b>Submissions: </b>'."\n"; 746: if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { 747: $gradeTable.='<label><input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> essay part only </label>'."\n"; 748: } 749: 750: my $saveStatus = $env{'form.Status'} eq '' ? 'Active' : $env{'form.Status'}; 751: $env{'form.Status'} = $saveStatus; 752: $gradeTable.='<label><input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last submission only </label>'."\n". 753: '<label><input type="radio" name="lastSub" value="last" /> last submission & parts info </label>'."\n". 754: '<label><input type="radio" name="lastSub" value="datesub" /> by dates and submissions </label>'."\n". 755: '<label><input type="radio" name="lastSub" value="all" /> all details</label><br />'."\n". 756: ' <b>Grading Increments:</b> <select name="increment">'. 757: '<option value="1">Whole Points</option>'. 758: '<option value=".5">Half Points</option>'. 759: '<option value=".25">Quarter Points</option>'. 760: '<option value=".1">Tenths of a Point</option>'. 761: '</select>'. 762: &build_section_inputs(). 763: '<input type="hidden" name="submitonly" value="'.$submitonly.'" />'."\n". 764: '<input type="hidden" name="handgrade" value="'.$env{'form.handgrade'}.'" /><br />'."\n". 765: '<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" /><br />'."\n". 766: '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n". 767: '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n". 768: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 769: '<input type="hidden" name="saveStatusOld" value="'.$saveStatus.'" />'."\n"; 770: 771: if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) { 772: $gradeTable.='<input type="hidden" name="Status" value="'.$env{'form.Status'}.'" />'."\n"; 773: } else { 774: $gradeTable.='<b>Student Status:</b> '. 775: &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);').'<br />'; 776: } 777: 778: $gradeTable.='To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '. 779: 'next to the student\'s name(s). Then click on the Next button.<br />'."\n". 780: '<input type="hidden" name="command" value="processGroup" />'."\n"; 781: 782: # checkall buttons 783: $gradeTable.=&check_script('gradesub', 'stuinfo'); 784: $gradeTable.='<input type="button" '."\n". 785: 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 786: 'value="Next->" /> <br />'."\n"; 787: $gradeTable.=&check_buttons(); 788: $gradeTable.='<label><input type="checkbox" name="checkPlag" checked="checked" />Check For Plagiarism</label>'; 789: my ($classlist, undef, $fullname) = &getclasslist($getsec,'1'); 790: $gradeTable.='<table border="0"><tr><td bgcolor="#777777">'. 791: '<table border="0"><tr bgcolor="#e6ffff">'; 792: my $loop = 0; 793: while ($loop < 2) { 794: $gradeTable.='<td><b> No.</b> </td><td><b> Select </b></td>'. 795: '<td>'.&nameUserString('header').' Section/Group</td>'; 796: if ($env{'form.showgrading'} eq 'yes' 797: && $submitonly ne 'queued' 798: && $submitonly ne 'all') { 799: foreach (sort(@$partlist)) { 800: my $display_part=&get_display_part((split(/_/))[0],$symb); 801: $gradeTable.='<td><b> Part: '.$display_part. 802: ' Status </b></td>'; 803: } 804: } elsif ($submitonly eq 'queued') { 805: $gradeTable.='<td><b> '.&mt('Queue Status').' </b></td>'; 806: } 807: $loop++; 808: # $gradeTable.='<td></td>' if ($loop%2 ==1); 809: } 810: $gradeTable.='</tr>'."\n"; 811: 812: my $ctr = 0; 813: foreach my $student (sort 814: { 815: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 816: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 817: } 818: return $a cmp $b; 819: } 820: (keys(%$fullname))) { 821: my ($uname,$udom) = split(/:/,$student); 822: 823: my %status = (); 824: 825: if ($submitonly eq 'queued') { 826: my %queue_status = 827: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 828: $udom,$uname); 829: next if (!defined($queue_status{'gradingqueue'})); 830: $status{'gradingqueue'} = $queue_status{'gradingqueue'}; 831: } 832: 833: if ($env{'form.showgrading'} eq 'yes' 834: && $submitonly ne 'queued' 835: && $submitonly ne 'all') { 836: (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); 837: my $submitted = 0; 838: my $graded = 0; 839: my $incorrect = 0; 840: foreach (keys(%status)) { 841: $submitted = 1 if ($status{$_} ne 'nothing'); 842: $graded = 1 if ($status{$_} =~ /^ungraded/); 843: $incorrect = 1 if ($status{$_} =~ /^incorrect/); 844: 845: my ($foo,$partid,$foo1) = split(/\./,$_); 846: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 847: $submitted = 0; 848: my ($part)=split(/\./,$partid); 849: $gradeTable.='<input type="hidden" name="'. 850: $student.':'.$part.':submitted_by" value="'. 851: $status{'resource.'.$partid.'.submitted_by'}.'" />'; 852: } 853: } 854: 855: next if (!$submitted && ($submitonly eq 'yes' || 856: $submitonly eq 'incorrect' || 857: $submitonly eq 'graded')); 858: next if (!$graded && ($submitonly eq 'graded')); 859: next if (!$incorrect && $submitonly eq 'incorrect'); 860: } 861: 862: $ctr++; 863: my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; 864: 865: if ( $perm{'vgr'} eq 'F' ) { 866: $gradeTable.='<tr bgcolor="#ffffe6">' if ($ctr%2 ==1); 867: $gradeTable.='<td align="right">'.$ctr.' </td>'. 868: '<td align="center"><label><input type=checkbox name="stuinfo" value="'. 869: $student.':'.$$fullname{$student}.':::SECTION'.$section. 870: ') " />  </label></td>'."\n".'<td>'. 871: &nameUserString(undef,$$fullname{$student},$uname,$udom). 872: ' '.$section.'</td>'."\n"; 873: 874: if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { 875: foreach (sort keys(%status)) { 876: next if (/^resource.*?submitted_by$/); 877: $gradeTable.='<td align="center"> '.$status{$_}.' </td>'."\n"; 878: } 879: } 880: # $gradeTable.='<td></td>' if ($ctr%2 ==1); 881: $gradeTable.='</tr>'."\n" if ($ctr%2 ==0); 882: } 883: } 884: if ($ctr%2 ==1) { 885: $gradeTable.='<td> </td><td> </td><td> </td>'; 886: if ($env{'form.showgrading'} eq 'yes' 887: && $submitonly ne 'queued' 888: && $submitonly ne 'all') { 889: foreach (@$partlist) { 890: $gradeTable.='<td> </td>'; 891: } 892: } elsif ($submitonly eq 'queued') { 893: $gradeTable.='<td> </td>'; 894: } 895: $gradeTable.='</tr>'; 896: } 897: 898: $gradeTable.='</table></td></tr></table>'."\n". 899: '<input type="button" '. 900: 'onClick="javascript:checkSelect(this.form.stuinfo);" '. 901: 'value="Next->" /></form>'."\n"; 902: if ($ctr == 0) { 903: my $num_students=(scalar(keys(%$fullname))); 904: if ($num_students eq 0) { 905: $gradeTable='<br /> <span class="LC_warning">There are no students currently enrolled.</span>'; 906: } else { 907: my $submissions='submissions'; 908: if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } 909: if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } 910: if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } 911: $gradeTable='<br /> <span class="LC_warning">'. 912: 'No '.$submissions.' found for this resource for any students. ('.$num_students. 913: ' students checked for '.$submissions.')</span><br />'; 914: } 915: } elsif ($ctr == 1) { 916: $gradeTable =~ s/type=checkbox/type=checkbox checked/; 917: } 918: $gradeTable.=&show_grading_menu_form($symb); 919: $request->print($gradeTable); 920: return ''; 921: } 922: 923: #---- Called from the listStudents routine 924: 925: sub check_script { 926: my ($form, $type)=@_; 927: my $chkallscript='<script type="text/javascript"> 928: function checkall() { 929: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 930: ele = document.forms.'.$form.'.elements[i]; 931: if (ele.name == "'.$type.'") { 932: document.forms.'.$form.'.elements[i].checked=true; 933: } 934: } 935: } 936: 937: function checksec() { 938: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 939: ele = document.forms.'.$form.'.elements[i]; 940: string = document.forms.'.$form.'.chksec.value; 941: if 942: (ele.value.indexOf(":::SECTION"+string)>0) { 943: document.forms.'.$form.'.elements[i].checked=true; 944: } 945: } 946: } 947: 948: 949: function uncheckall() { 950: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 951: ele = document.forms.'.$form.'.elements[i]; 952: if (ele.name == "'.$type.'") { 953: document.forms.'.$form.'.elements[i].checked=false; 954: } 955: } 956: } 957: 958: </script>'."\n"; 959: return $chkallscript; 960: } 961: 962: sub check_buttons { 963: my $buttons.='<input type="button" onclick="checkall()" value="Check All" />'; 964: $buttons.='<input type="button" onclick="uncheckall()" value="Uncheck All" /> '; 965: $buttons.='<input type="button" onclick="checksec()" value="Check Section/Group" />'; 966: $buttons.='<input type="text" size="5" name="chksec" /> '; 967: return $buttons; 968: } 969: 970: # Displays the submissions for one student or a group of students 971: sub processGroup { 972: my ($request) = shift; 973: my $ctr = 0; 974: my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); 975: my $total = scalar(@stuchecked)-1; 976: 977: foreach my $student (@stuchecked) { 978: my ($uname,$udom,$fullname) = split(/:/,$student); 979: $env{'form.student'} = $uname; 980: $env{'form.userdom'} = $udom; 981: $env{'form.fullname'} = $fullname; 982: &submission($request,$ctr,$total); 983: $ctr++; 984: } 985: return ''; 986: } 987: 988: #------------------------------------------------------------------------------------ 989: # 990: #-------------------------- Next few routines handles grading by student, essentially 991: # handles essay response type problem/part 992: # 993: #--- Javascript to handle the submission page functionality --- 994: sub sub_page_js { 995: my $request = shift; 996: $request->print(<<SUBJAVASCRIPT); 997: <script type="text/javascript" language="javascript"> 998: function updateRadio(formname,id,weight) { 999: var gradeBox = formname["GD_BOX"+id]; 1000: var radioButton = formname["RADVAL"+id]; 1001: var oldpts = formname["oldpts"+id].value; 1002: var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts; 1003: gradeBox.value = pts; 1004: var resetbox = false; 1005: if (isNaN(pts) || pts < 0) { 1006: alert("A number equal or greater than 0 is expected. Entered value = "+pts); 1007: for (var i=0; i<radioButton.length; i++) { 1008: if (radioButton[i].checked) { 1009: gradeBox.value = i; 1010: resetbox = true; 1011: } 1012: } 1013: if (!resetbox) { 1014: formtextbox.value = ""; 1015: } 1016: return; 1017: } 1018: 1019: if (pts > weight) { 1020: var resp = confirm("You entered a value ("+pts+ 1021: ") greater than the weight for the part. Accept?"); 1022: if (resp == false) { 1023: gradeBox.value = oldpts; 1024: return; 1025: } 1026: } 1027: 1028: for (var i=0; i<radioButton.length; i++) { 1029: radioButton[i].checked=false; 1030: if (pts == i && pts != "") { 1031: radioButton[i].checked=true; 1032: } 1033: } 1034: updateSelect(formname,id); 1035: formname["stores"+id].value = "0"; 1036: } 1037: 1038: function writeBox(formname,id,pts) { 1039: var gradeBox = formname["GD_BOX"+id]; 1040: if (checkSolved(formname,id) == 'update') { 1041: gradeBox.value = pts; 1042: } else { 1043: var oldpts = formname["oldpts"+id].value; 1044: gradeBox.value = oldpts; 1045: var radioButton = formname["RADVAL"+id]; 1046: for (var i=0; i<radioButton.length; i++) { 1047: radioButton[i].checked=false; 1048: if (i == oldpts) { 1049: radioButton[i].checked=true; 1050: } 1051: } 1052: } 1053: formname["stores"+id].value = "0"; 1054: updateSelect(formname,id); 1055: return; 1056: } 1057: 1058: function clearRadBox(formname,id) { 1059: if (checkSolved(formname,id) == 'noupdate') { 1060: updateSelect(formname,id); 1061: return; 1062: } 1063: gradeSelect = formname["GD_SEL"+id]; 1064: for (var i=0; i<gradeSelect.length; i++) { 1065: if (gradeSelect[i].selected) { 1066: var selectx=i; 1067: } 1068: } 1069: var stores = formname["stores"+id]; 1070: if (selectx == stores.value) { return }; 1071: var gradeBox = formname["GD_BOX"+id]; 1072: gradeBox.value = ""; 1073: var radioButton = formname["RADVAL"+id]; 1074: for (var i=0; i<radioButton.length; i++) { 1075: radioButton[i].checked=false; 1076: } 1077: stores.value = selectx; 1078: } 1079: 1080: function checkSolved(formname,id) { 1081: if (formname["solved"+id].value == "correct_by_student" && formname.overRideScore.value == 'no') { 1082: var reply = confirm("This problem has been graded correct by the computer. Do you want to change the score?"); 1083: if (!reply) {return "noupdate";} 1084: formname.overRideScore.value = 'yes'; 1085: } 1086: return "update"; 1087: } 1088: 1089: function updateSelect(formname,id) { 1090: formname["GD_SEL"+id][0].selected = true; 1091: return; 1092: } 1093: 1094: //=========== Check that a point is assigned for all the parts ============ 1095: function checksubmit(formname,val,total,parttot) { 1096: formname.gradeOpt.value = val; 1097: if (val == "Save & Next") { 1098: for (i=0;i<=total;i++) { 1099: for (j=0;j<parttot;j++) { 1100: var partid = formname["partid"+i+"_"+j].value; 1101: if (formname["GD_SEL"+i+"_"+partid][0].selected) { 1102: var points = formname["GD_BOX"+i+"_"+partid].value; 1103: if (points == "") { 1104: var name = formname["name"+i].value; 1105: var studentID = (name != '' ? name : formname["unamedom"+i].value); 1106: var resp = confirm("You did not assign a score for "+studentID+ 1107: ", part "+partid+". Continue?"); 1108: if (resp == false) { 1109: formname["GD_BOX"+i+"_"+partid].focus(); 1110: return false; 1111: } 1112: } 1113: } 1114: 1115: } 1116: } 1117: 1118: } 1119: if (val == "Grade Student") { 1120: formname.showgrading.value = "yes"; 1121: if (formname.Status.value == "") { 1122: formname.Status.value = "Active"; 1123: } 1124: formname.studentNo.value = total; 1125: } 1126: formname.submit(); 1127: } 1128: 1129: //======= Check that a score is assigned for all the problems (page/sequence grading only) ========= 1130: function checkSubmitPage(formname,total) { 1131: noscore = new Array(100); 1132: var ptr = 0; 1133: for (i=1;i<total;i++) { 1134: var partid = formname["q_"+i].value; 1135: if (formname["GD_SEL"+i+"_"+partid][0].selected) { 1136: var points = formname["GD_BOX"+i+"_"+partid].value; 1137: var status = formname["solved"+i+"_"+partid].value; 1138: if (points == "" && status != "correct_by_student") { 1139: noscore[ptr] = i; 1140: ptr++; 1141: } 1142: } 1143: } 1144: if (ptr != 0) { 1145: var sense = ptr == 1 ? ": " : "s: "; 1146: var prolist = ""; 1147: if (ptr == 1) { 1148: prolist = noscore[0]; 1149: } else { 1150: var i = 0; 1151: while (i < ptr-1) { 1152: prolist += noscore[i]+", "; 1153: i++; 1154: } 1155: prolist += "and "+noscore[i]; 1156: } 1157: var resp = confirm("You did not assign any score for the following problem"+sense+prolist+". Continue?"); 1158: if (resp == false) { 1159: return false; 1160: } 1161: } 1162: 1163: formname.submit(); 1164: } 1165: </script> 1166: SUBJAVASCRIPT 1167: } 1168: 1169: #--- javascript for essay type problem -- 1170: sub sub_page_kw_js { 1171: my $request = shift; 1172: my $iconpath = $request->dir_config('lonIconsURL'); 1173: &commonJSfunctions($request); 1174: 1175: my $inner_js_msg_central=<<INNERJS; 1176: <script text="text/javascript"> 1177: function checkInput() { 1178: opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value); 1179: var nmsg = opener.document.SCORE.savemsgN.value; 1180: var usrctr = document.msgcenter.usrctr.value; 1181: var newval = opener.document.SCORE["newmsg"+usrctr]; 1182: newval.value = opener.checkEntities(document.msgcenter.newmsg.value); 1183: 1184: var msgchk = ""; 1185: if (document.msgcenter.subchk.checked) { 1186: msgchk = "msgsub,"; 1187: } 1188: var includemsg = 0; 1189: for (var i=1; i<=nmsg; i++) { 1190: var opnmsg = opener.document.SCORE["savemsg"+i]; 1191: var frmmsg = document.msgcenter["msg"+i]; 1192: opnmsg.value = opener.checkEntities(frmmsg.value); 1193: var showflg = opener.document.SCORE["shownOnce"+i]; 1194: showflg.value = "1"; 1195: var chkbox = document.msgcenter["msgn"+i]; 1196: if (chkbox.checked) { 1197: msgchk += "savemsg"+i+","; 1198: includemsg = 1; 1199: } 1200: } 1201: if (document.msgcenter.newmsgchk.checked) { 1202: msgchk += "newmsg"+usrctr; 1203: includemsg = 1; 1204: } 1205: imgformname = opener.document.SCORE["mailicon"+usrctr]; 1206: imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif"); 1207: var includemsg = opener.document.SCORE["includemsg"+usrctr]; 1208: includemsg.value = msgchk; 1209: 1210: self.close() 1211: 1212: } 1213: </script> 1214: INNERJS 1215: 1216: my $inner_js_highlight_central=<<INNERJS; 1217: <script type="text/javascript"> 1218: function updateChoice(flag) { 1219: opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr); 1220: opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize); 1221: opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle); 1222: opener.document.SCORE.refresh.value = "on"; 1223: if (opener.document.SCORE.keywords.value!=""){ 1224: opener.document.SCORE.submit(); 1225: } 1226: self.close() 1227: } 1228: </script> 1229: INNERJS 1230: 1231: my $start_page_msg_central = 1232: &Apache::loncommon::start_page('Message Central',$inner_js_msg_central, 1233: {'js_ready' => 1, 1234: 'only_body' => 1, 1235: 'bgcolor' =>'#FFFFFF',}); 1236: my $end_page_msg_central = 1237: &Apache::loncommon::end_page({'js_ready' => 1}); 1238: 1239: 1240: my $start_page_highlight_central = 1241: &Apache::loncommon::start_page('Highlight Central', 1242: $inner_js_highlight_central, 1243: {'js_ready' => 1, 1244: 'only_body' => 1, 1245: 'bgcolor' =>'#FFFFFF',}); 1246: my $end_page_highlight_central = 1247: &Apache::loncommon::end_page({'js_ready' => 1}); 1248: 1249: my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); 1250: $docopen=~s/^document\.//; 1251: $request->print(<<SUBJAVASCRIPT); 1252: <script type="text/javascript" language="javascript"> 1253: 1254: //===================== Show list of keywords ==================== 1255: function keywords(formname) { 1256: var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",formname.keywords.value); 1257: if (nret==null) return; 1258: formname.keywords.value = nret; 1259: 1260: if (formname.keywords.value != "") { 1261: formname.refresh.value = "on"; 1262: formname.submit(); 1263: } 1264: return; 1265: } 1266: 1267: //===================== Script to view submitted by ================== 1268: function viewSubmitter(submitter) { 1269: document.SCORE.refresh.value = "on"; 1270: document.SCORE.NCT.value = "1"; 1271: document.SCORE.unamedom0.value = submitter; 1272: document.SCORE.submit(); 1273: return; 1274: } 1275: 1276: //===================== Script to add keyword(s) ================== 1277: function getSel() { 1278: if (document.getSelection) txt = document.getSelection(); 1279: else if (document.selection) txt = document.selection.createRange().text; 1280: else return; 1281: var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," "); 1282: if (cleantxt=="") { 1283: alert("Please select a word or group of words from document and then click this link."); 1284: return; 1285: } 1286: var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt); 1287: if (nret==null) return; 1288: document.SCORE.keywords.value = document.SCORE.keywords.value+" "+nret; 1289: if (document.SCORE.keywords.value != "") { 1290: document.SCORE.refresh.value = "on"; 1291: document.SCORE.submit(); 1292: } 1293: return; 1294: } 1295: 1296: //====================== Script for composing message ============== 1297: // preload images 1298: img1 = new Image(); 1299: img1.src = "$iconpath/mailbkgrd.gif"; 1300: img2 = new Image(); 1301: img2.src = "$iconpath/mailto.gif"; 1302: 1303: function msgCenter(msgform,usrctr,fullname) { 1304: var Nmsg = msgform.savemsgN.value; 1305: savedMsgHeader(Nmsg,usrctr,fullname); 1306: var subject = msgform.msgsub.value; 1307: var msgchk = document.SCORE["includemsg"+usrctr].value; 1308: re = /msgsub/; 1309: var shwsel = ""; 1310: if (re.test(msgchk)) { shwsel = "checked" } 1311: subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject); 1312: displaySubject(checkEntities(subject),shwsel); 1313: for (var i=1; i<=Nmsg; i++) { 1314: var testmsg = "savemsg"+i+","; 1315: re = new RegExp(testmsg,"g"); 1316: shwsel = ""; 1317: if (re.test(msgchk)) { shwsel = "checked" } 1318: var message = document.SCORE["savemsg"+i].value; 1319: message = (document.SCORE["shownOnce"+i].value == 0 ? checkEntities(message) : message); 1320: displaySavedMsg(i,message,shwsel); //I do not get it. w/o checkEntities on saved messages, 1321: //any < is already converted to <, etc. However, only once!! 1322: } 1323: newmsg = document.SCORE["newmsg"+usrctr].value; 1324: shwsel = ""; 1325: re = /newmsg/; 1326: if (re.test(msgchk)) { shwsel = "checked" } 1327: newMsg(newmsg,shwsel); 1328: msgTail(); 1329: return; 1330: } 1331: 1332: function checkEntities(strx) { 1333: if (strx.length == 0) return strx; 1334: var orgStr = ["&", "<", ">", '"']; 1335: var newStr = ["&", "<", ">", """]; 1336: var counter = 0; 1337: while (counter < 4) { 1338: strx = strReplace(strx,orgStr[counter],newStr[counter]); 1339: counter++; 1340: } 1341: return strx; 1342: } 1343: 1344: function strReplace(strx, orgStr, newStr) { 1345: return strx.split(orgStr).join(newStr); 1346: } 1347: 1348: function savedMsgHeader(Nmsg,usrctr,fullname) { 1349: var height = 70*Nmsg+250; 1350: var scrollbar = "no"; 1351: if (height > 600) { 1352: height = 600; 1353: scrollbar = "yes"; 1354: } 1355: var xpos = (screen.width-600)/2; 1356: xpos = (xpos < 0) ? '0' : xpos; 1357: var ypos = (screen.height-height)/2-30; 1358: ypos = (ypos < 0) ? '0' : ypos; 1359: 1360: pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); 1361: pWin.focus(); 1362: pDoc = pWin.document; 1363: pDoc.$docopen; 1364: pDoc.write('$start_page_msg_central'); 1365: 1366: pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">"); 1367: pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">"); 1368: pDoc.write("<h3><span class=\\"LC_info\\"> Compose Message for \"+fullname+\"</span></h3><br /><br />"); 1369: 1370: pDoc.write("<table border=0 width=100%><tr><td bgcolor=\\"#777777\\">"); 1371: pDoc.write("<table border=0 width=100%><tr bgcolor=\\"#ddffff\\">"); 1372: pDoc.write("<td><b>Type</b></td><td><b>Include</b></td><td><b>Message</td></tr>"); 1373: } 1374: function displaySubject(msg,shwsel) { 1375: pDoc = pWin.document; 1376: pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); 1377: pDoc.write("<td>Subject</td>"); 1378: pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"></td>"); 1379: pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"60\\" maxlength=\\"80\\"></td></tr>"); 1380: } 1381: 1382: function displaySavedMsg(ctr,msg,shwsel) { 1383: pDoc = pWin.document; 1384: pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); 1385: pDoc.write("<td align=\\"center\\">"+ctr+"</td>"); 1386: pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"></td>"); 1387: pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"</textarea></td></tr>"); 1388: } 1389: 1390: function newMsg(newmsg,shwsel) { 1391: pDoc = pWin.document; 1392: pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); 1393: pDoc.write("<td align=\\"center\\">New</td>"); 1394: pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"></td>"); 1395: pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"</textarea></td></tr>"); 1396: } 1397: 1398: function msgTail() { 1399: pDoc = pWin.document; 1400: pDoc.write("</table>"); 1401: pDoc.write("</td></tr></table> "); 1402: pDoc.write("<input type=\\"button\\" value=\\"Save\\" onClick=\\"javascript:checkInput()\\">  "); 1403: pDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onClick=\\"self.close()\\"><br /><br />"); 1404: pDoc.write("</form>"); 1405: pDoc.write('$end_page_msg_central'); 1406: pDoc.close(); 1407: } 1408: 1409: //====================== Script for keyword highlight options ============== 1410: function kwhighlight() { 1411: var kwclr = document.SCORE.kwclr.value; 1412: var kwsize = document.SCORE.kwsize.value; 1413: var kwstyle = document.SCORE.kwstyle.value; 1414: var redsel = ""; 1415: var grnsel = ""; 1416: var blusel = ""; 1417: if (kwclr=="red") {var redsel="checked"}; 1418: if (kwclr=="green") {var grnsel="checked"}; 1419: if (kwclr=="blue") {var blusel="checked"}; 1420: var sznsel = ""; 1421: var sz1sel = ""; 1422: var sz2sel = ""; 1423: if (kwsize=="0") {var sznsel="checked"}; 1424: if (kwsize=="+1") {var sz1sel="checked"}; 1425: if (kwsize=="+2") {var sz2sel="checked"}; 1426: var synsel = ""; 1427: var syisel = ""; 1428: var sybsel = ""; 1429: if (kwstyle=="") {var synsel="checked"}; 1430: if (kwstyle=="<i>") {var syisel="checked"}; 1431: if (kwstyle=="<b>") {var sybsel="checked"}; 1432: highlightCentral(); 1433: highlightbody('red','red',redsel,'0','normal',sznsel,'','normal',synsel); 1434: highlightbody('green','green',grnsel,'+1','+1',sz1sel,'<i>','italic',syisel); 1435: highlightbody('blue','blue',blusel,'+2','+2',sz2sel,'<b>','bold',sybsel); 1436: highlightend(); 1437: return; 1438: } 1439: 1440: function highlightCentral() { 1441: // if (window.hwdWin) window.hwdWin.close(); 1442: var xpos = (screen.width-400)/2; 1443: xpos = (xpos < 0) ? '0' : xpos; 1444: var ypos = (screen.height-330)/2-30; 1445: ypos = (ypos < 0) ? '0' : ypos; 1446: 1447: hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); 1448: hwdWin.focus(); 1449: var hDoc = hwdWin.document; 1450: hDoc.$docopen; 1451: hDoc.write('$start_page_highlight_central'); 1452: hDoc.write("<form action=\\"inactive\\" name=\\"hlCenter\\">"); 1453: hDoc.write("<h3><span class=\\"LC_info\\"> Keyword Highlight Options</span></h3><br /><br />"); 1454: 1455: hDoc.write("<table border=0 width=100%><tr><td bgcolor=\\"#777777\\">"); 1456: hDoc.write("<table border=0 width=100%><tr bgcolor=\\"#ddffff\\">"); 1457: hDoc.write("<td><b>Text Color</b></td><td><b>Font Size</b></td><td><b>Font Style</td></tr>"); 1458: } 1459: 1460: function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) { 1461: var hDoc = hwdWin.document; 1462: hDoc.write("<tr bgcolor=\\"#ffffdd\\">"); 1463: hDoc.write("<td align=\\"left\\">"); 1464: hDoc.write("<input name=\\"kwdclr\\" type=\\"radio\\" value=\\""+clrval+"\\" "+clrsel+"> "+clrtxt+"</td>"); 1465: hDoc.write("<td align=\\"left\\">"); 1466: hDoc.write("<input name=\\"kwdsize\\" type=\\"radio\\" value=\\""+szval+"\\" "+szsel+"> "+sztxt+"</td>"); 1467: hDoc.write("<td align=\\"left\\">"); 1468: hDoc.write("<input name=\\"kwdstyle\\" type=\\"radio\\" value=\\""+syval+"\\" "+sysel+"> "+sytxt+"</td>"); 1469: hDoc.write("</tr>"); 1470: } 1471: 1472: function highlightend() { 1473: var hDoc = hwdWin.document; 1474: hDoc.write("</table>"); 1475: hDoc.write("</td></tr></table> "); 1476: hDoc.write("<input type=\\"button\\" value=\\"Save\\" onClick=\\"javascript:updateChoice(1)\\">  "); 1477: hDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onClick=\\"self.close()\\"><br /><br />"); 1478: hDoc.write("</form>"); 1479: hDoc.write('$end_page_highlight_central'); 1480: hDoc.close(); 1481: } 1482: 1483: </script> 1484: SUBJAVASCRIPT 1485: } 1486: 1487: sub get_increment { 1488: my $increment = $env{'form.increment'}; 1489: if ($increment != 1 && $increment != .5 && $increment != .25 && 1490: $increment != .1) { 1491: $increment = 1; 1492: } 1493: return $increment; 1494: } 1495: 1496: #--- displays the grading box, used in essay type problem and grading by page/sequence 1497: sub gradeBox { 1498: my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; 1499: my $checkIcon = '<img alt="'.&mt('Check Mark'). 1500: '" src="'.$request->dir_config('lonIconsURL'). 1501: '/check.gif" height="16" border="0" />'; 1502: my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); 1503: my $wgtmsg = ($wgt > 0 ? '(problem weight)' : 1504: '<span class="LC_info">problem weight assigned by computer</span>'); 1505: $wgt = ($wgt > 0 ? $wgt : '1'); 1506: my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? 1507: '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); 1508: my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n"; 1509: my $display_part=&get_display_part($partid,$symb); 1510: my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, 1511: [$partid]); 1512: my $aggtries = $$record{'resource.'.$partid.'.tries'}; 1513: if ($last_resets{$partid}) { 1514: $aggtries = &get_num_tries($record,$last_resets{$partid},$partid); 1515: } 1516: $result.='<table border="0"><tr><td>'. 1517: '<b>Part: </b>'.$display_part.' <b>Points: </b></td><td>'."\n"; 1518: my $ctr = 0; 1519: my $thisweight = 0; 1520: my $increment = &get_increment(); 1521: $result.='<table border="0"><tr>'."\n"; # display radio buttons in a nice table 10 across 1522: while ($thisweight<=$wgt) { 1523: $result.= '<td><span style="white-space: nowrap;"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '. 1524: 'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','. 1525: $thisweight.')" value="'.$thisweight.'" '. 1526: ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n"; 1527: $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); 1528: $thisweight += $increment; 1529: $ctr++; 1530: } 1531: $result.='</tr></table>'; 1532: $result.='</td><td> <b>or</b> </td>'."\n"; 1533: $result.='<td><input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'. 1534: ($score ne ''? ' value = "'.$score.'"':'').' size="4" '. 1535: 'onChange="javascript:updateRadio(this.form,\''.$counter.'_'.$partid.'\','. 1536: $wgt.')" /></td>'."\n"; 1537: $result.='<td>/'.$wgt.' '.$wgtmsg. 1538: ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : ''). 1539: ' </td><td>'."\n"; 1540: $result.='<select name="GD_SEL'.$counter.'_'.$partid.'" '. 1541: 'onChange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n"; 1542: if ($$record{'resource.'.$partid.'.solved'} eq 'excused') { 1543: $result.='<option></option>'. 1544: '<option selected="selected">excused</option>'; 1545: } else { 1546: $result.='<option selected="selected"></option>'. 1547: '<option>excused</option>'; 1548: } 1549: $result.='<option>reset status</option></select>'."\n"; 1550: $result.="  \n"; 1551: $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n". 1552: '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n". 1553: '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'. 1554: $$record{'resource.'.$partid.'.solved'}.'" />'."\n". 1555: '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'. 1556: $$record{'resource.'.$partid.'.tries'}.'" />'."\n". 1557: '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'. 1558: $aggtries.'" />'."\n"; 1559: $result.='</td></tr></table>'."\n"; 1560: $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record); 1561: return $result; 1562: } 1563: 1564: sub handback_box { 1565: my ($symb,$uname,$udom,$counter,$partid,$record) = @_; 1566: my ($partlist,$handgrade,$responseType) = &response_type($symb); 1567: my (@respids); 1568: my @part_response_id = &flatten_responseType($responseType); 1569: foreach my $part_response_id (@part_response_id) { 1570: my ($part,$resp) = @{ $part_response_id }; 1571: if ($part eq $partid) { 1572: push(@respids,$resp); 1573: } 1574: } 1575: my $result; 1576: foreach my $respid (@respids) { 1577: my $prefix = $counter.'_'.$partid.'_'.$respid.'_'; 1578: my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record); 1579: next if (!@$files); 1580: my $file_counter = 1; 1581: foreach my $file (@$files) { 1582: if ($file =~ /\/portfolio\//) { 1583: my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|); 1584: my ($name,$version,$ext) = &file_name_version_ext($file_disp); 1585: $file_disp = "$name.$ext"; 1586: $file = $file_path.$file_disp; 1587: $result.=&mt('Return commented version of [_1] to student.', 1588: '<span class="LC_filename">'.$file_disp.'</span>'); 1589: $result.='<input type="file" name="'.$prefix.'returndoc'.$file_counter.'" />'."\n"; 1590: $result.='<input type="hidden" name="'.$prefix.'origdoc'.$file_counter.'" value="'.$file.'" /><br />'; 1591: $result.='(File will be uploaded when you click on Save & Next below.)<br />'; 1592: $file_counter++; 1593: } 1594: } 1595: } 1596: return $result; 1597: } 1598: 1599: sub show_problem { 1600: my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_; 1601: my $rendered; 1602: my %form = ((ref($form) eq 'HASH')? %{$form} : ()); 1603: &Apache::lonxml::remember_problem_counter(); 1604: if ($mode eq 'both' or $mode eq 'text') { 1605: $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, 1606: $env{'request.course.id'}, 1607: undef,\%form); 1608: } 1609: if ($removeform) { 1610: $rendered=~s|<form(.*?)>||g; 1611: $rendered=~s|</form>||g; 1612: $rendered=~s|(<input[^>]*name\s*=\s*"?)(\w+)("?)|$1would_have_been_$2$3|g; 1613: } 1614: my $companswer; 1615: if ($mode eq 'both' or $mode eq 'answer') { 1616: &Apache::lonxml::restore_problem_counter(); 1617: $companswer= 1618: &Apache::loncommon::get_student_answers($symb,$uname,$udom, 1619: $env{'request.course.id'}, 1620: %form); 1621: } 1622: if ($removeform) { 1623: $companswer=~s|<form(.*?)>||g; 1624: $companswer=~s|</form>||g; 1625: $companswer=~s|name="submit"|name="would_have_been_submit"|g; 1626: } 1627: my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">'; 1628: $result.='<table border="0" width="100%">'; 1629: if ($viewon) { 1630: $result.='<tr><td bgcolor="#e6ffff"><b> '; 1631: if ($mode eq 'both' or $mode eq 'text') { 1632: $result.='View of the problem - '; 1633: } else { 1634: $result.='Correct answer: '; 1635: } 1636: $result.=$env{'form.fullname'}.'</b></td></tr>'; 1637: } 1638: if ($mode eq 'both') { 1639: $result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />'; 1640: $result.='<b>Correct answer:</b><br />'.$companswer; 1641: } elsif ($mode eq 'text') { 1642: $result.='<tr><td bgcolor="#ffffff">'.$rendered; 1643: } elsif ($mode eq 'answer') { 1644: $result.='<tr><td bgcolor="#ffffff">'.$companswer; 1645: } 1646: $result.='</td></tr></table>'; 1647: $result.='</td></tr></table><br />'; 1648: return $result; 1649: } 1650: 1651: sub files_exist { 1652: my ($r, $symb) = @_; 1653: my @students = &Apache::loncommon::get_env_multiple('form.stuinfo'); 1654: 1655: foreach my $student (@students) { 1656: my ($uname,$udom,$fullname) = split(/:/,$student); 1657: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, 1658: $udom,$uname); 1659: my ($string,$timestamp)= &get_last_submission(\%record); 1660: foreach my $submission (@$string) { 1661: my ($partid,$respid) = 1662: ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); 1663: my $files=&get_submitted_files($udom,$uname,$partid,$respid, 1664: \%record); 1665: return 1 if (@$files); 1666: } 1667: } 1668: return 0; 1669: } 1670: 1671: sub download_all_link { 1672: my ($r,$symb) = @_; 1673: my $all_students = 1674: join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo')); 1675: 1676: my $parts = 1677: join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); 1678: 1679: my $identifier = &Apache::loncommon::get_cgi_id(); 1680: &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students, 1681: 'cgi.'.$identifier.'.symb' => $symb, 1682: 'cgi.'.$identifier.'.parts' => $parts,); 1683: $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'. 1684: &mt('Download All Submitted Documents').'</a>'); 1685: return 1686: } 1687: 1688: sub build_section_inputs { 1689: my $section_inputs; 1690: if ($env{'form.section'} eq '') { 1691: $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n"; 1692: } else { 1693: my @sections = &Apache::loncommon::get_env_multiple('form.section'); 1694: foreach my $section (@sections) { 1695: $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n"; 1696: } 1697: } 1698: return $section_inputs; 1699: } 1700: 1701: # --------------------------- show submissions of a student, option to grade 1702: sub submission { 1703: my ($request,$counter,$total) = @_; 1704: 1705: my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); 1706: $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student? 1707: my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); 1708: $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq ''; 1709: 1710: my $symb = &get_symb($request); 1711: if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } 1712: 1713: if (!&canview($usec)) { 1714: $request->print('<span class="LC_warning">Unable to view requested student.('. 1715: $uname.':'.$udom.' in section '.$usec.' in course id '. 1716: $env{'request.course.id'}.')</span>'); 1717: $request->print(&show_grading_menu_form($symb)); 1718: return; 1719: } 1720: 1721: if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; } 1722: if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; } 1723: if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; } 1724: my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); 1725: my $checkIcon = '<img alt="'.&mt('Check Mark'). 1726: '" src="'.$request->dir_config('lonIconsURL'). 1727: '/check.gif" height="16" border="0" />'; 1728: 1729: my %old_essays; 1730: # header info 1731: if ($counter == 0) { 1732: &sub_page_js($request); 1733: &sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes'); 1734: $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 1735: &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; 1736: if ($env{'form.handgrade'} eq 'yes' && &files_exist($request, $symb)) { 1737: &download_all_link($request, $symb); 1738: } 1739: $request->print('<h3> <span class="LC_info">Submission Record</span></h3>'."\n". 1740: '<h4> <b>Resource: </b>'.$env{'form.probTitle'}.'</h4>'."\n"); 1741: 1742: if ($env{'form.handgrade'} eq 'no') { 1743: my $checkMark='<br /><br /> <b>Note:</b> Part(s) graded correct by the computer is marked with a '. 1744: $checkIcon.' symbol.'."\n"; 1745: $request->print($checkMark); 1746: } 1747: 1748: # option to display problem, only once else it cause problems 1749: # with the form later since the problem has a form. 1750: if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') { 1751: my $mode; 1752: if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') { 1753: $mode='both'; 1754: } elsif ($env{'form.vProb'} eq 'yes') { 1755: $mode='text'; 1756: } elsif ($env{'form.vAns'} eq 'yes') { 1757: $mode='answer'; 1758: } 1759: &Apache::lonxml::clear_problem_counter(); 1760: $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); 1761: } 1762: 1763: # kwclr is the only variable that is guaranteed to be non blank 1764: # if this subroutine has been called once. 1765: my %keyhash = (); 1766: if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') { 1767: %keyhash = &Apache::lonnet::dump('nohist_handgrade', 1768: $env{'course.'.$env{'request.course.id'}.'.domain'}, 1769: $env{'course.'.$env{'request.course.id'}.'.num'}); 1770: 1771: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 1772: $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; 1773: $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; 1774: $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; 1775: $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; 1776: $env{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? 1777: $keyhash{$symb.'_subject'} : $env{'form.probTitle'}; 1778: $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; 1779: } 1780: my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'}; 1781: $request->print('<form action="/adm/grades" method="post" name="SCORE" enctype="multipart/form-data">'."\n". 1782: '<input type="hidden" name="command" value="handgrade" />'."\n". 1783: '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n". 1784: '<input type="hidden" name="Status" value="'.$env{'form.Status'}.'" />'."\n". 1785: '<input type="hidden" name="overRideScore" value="'.$overRideScore.'" />'."\n". 1786: '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n". 1787: '<input type="hidden" name="refresh" value="off" />'."\n". 1788: '<input type="hidden" name="studentNo" value="" />'."\n". 1789: '<input type="hidden" name="gradeOpt" value="" />'."\n". 1790: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 1791: '<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" />'."\n". 1792: '<input type="hidden" name="vProb" value="'.$env{'form.vProb'}.'" />'."\n". 1793: '<input type="hidden" name="vAns" value="'.$env{'form.vAns'}.'" />'."\n". 1794: '<input type="hidden" name="lastSub" value="'.$env{'form.lastSub'}.'" />'."\n". 1795: &build_section_inputs(). 1796: '<input type="hidden" name="submitonly" value="'.$env{'form.submitonly'}.'" />'."\n". 1797: '<input type="hidden" name="handgrade" value="'.$env{'form.handgrade'}.'" />'."\n". 1798: '<input type="hidden" name="NCT"'. 1799: ' value="'.($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : $total+1).'" />'."\n"); 1800: if ($env{'form.handgrade'} eq 'yes') { 1801: $request->print('<input type="hidden" name="keywords" value="'.$env{'form.keywords'}.'" />'."\n". 1802: '<input type="hidden" name="kwclr" value="'.$env{'form.kwclr'}.'" />'."\n". 1803: '<input type="hidden" name="kwsize" value="'.$env{'form.kwsize'}.'" />'."\n". 1804: '<input type="hidden" name="kwstyle" value="'.$env{'form.kwstyle'}.'" />'."\n". 1805: '<input type="hidden" name="msgsub" value="'.$env{'form.msgsub'}.'" />'."\n". 1806: '<input type="hidden" name="shownSub" value="0" />'."\n". 1807: '<input type="hidden" name="savemsgN" value="'.$env{'form.savemsgN'}.'" />'."\n"); 1808: foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { 1809: $request->print('<input type="hidden" name="vPart" value="'.$partid.'" />'."\n"); 1810: } 1811: } 1812: 1813: my ($cts,$prnmsg) = (1,''); 1814: while ($cts <= $env{'form.savemsgN'}) { 1815: $prnmsg.='<input type="hidden" name="savemsg'.$cts.'" value="'. 1816: (!exists($keyhash{$symb.'_savemsg'.$cts}) ? 1817: &Apache::lonfeedback::clear_out_html($env{'form.savemsg'.$cts}) : 1818: &Apache::lonfeedback::clear_out_html($keyhash{$symb.'_savemsg'.$cts})). 1819: '" />'."\n". 1820: '<input type="hidden" name="shownOnce'.$cts.'" value="0" />'."\n"; 1821: $cts++; 1822: } 1823: $request->print($prnmsg); 1824: 1825: if ($env{'form.handgrade'} eq 'yes' && $env{'form.showgrading'} eq 'yes') { 1826: # 1827: # Print out the keyword options line 1828: # 1829: $request->print(<<KEYWORDS); 1830:  <b>Keyword Options:</b>  1831: <a href="javascript:keywords(document.SCORE);" target="_self">List</a>    1832: <a href="#" onMouseDown="javascript:getSel(); return false" 1833: CLASS="page">Paste Selection to List</a>    1834: <a href="javascript:kwhighlight();" target="_self">Highlight Attribute</a><br /><br /> 1835: KEYWORDS 1836: # 1837: # Load the other essays for similarity check 1838: # 1839: my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); 1840: my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); 1841: $apath=&escape($apath); 1842: $apath=~s/\W/\_/gs; 1843: %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); 1844: } 1845: } 1846: 1847: if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') { 1848: $request->print('<br /><br /><br />') if ($counter > 0); 1849: my $mode; 1850: if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') { 1851: $mode='both'; 1852: } elsif ($env{'form.vProb'} eq 'all' ) { 1853: $mode='text'; 1854: } elsif ($env{'form.vAns'} eq 'all') { 1855: $mode='answer'; 1856: } 1857: &Apache::lonxml::clear_problem_counter(); 1858: $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode)); 1859: } 1860: 1861: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 1862: my ($partlist,$handgrade,$responseType) = &response_type($symb); 1863: 1864: # Display student info 1865: $request->print(($counter == 0 ? '' : '<br />')); 1866: my $result='<table border="0" width="100%"><tr><td bgcolor="#777777">'."\n". 1867: '<table border="0" width="100%"><tr bgcolor="#edffff"><td>'."\n"; 1868: 1869: $result.='<b>Fullname: </b>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).'<br />'."\n"; 1870: $result.='<input type="hidden" name="name'.$counter. 1871: '" value="'.$env{'form.fullname'}.'" />'."\n"; 1872: 1873: # If any part of the problem is an essay-response (handgraded), then check for collaborators 1874: my @col_fullnames; 1875: my ($classlist,$fullname); 1876: if ($env{'form.handgrade'} eq 'yes') { 1877: ($classlist,undef,$fullname) = &getclasslist('all','0'); 1878: for (keys (%$handgrade)) { 1879: my $ncol = &Apache::lonnet::EXT('resource.'.$_. 1880: '.maxcollaborators', 1881: $symb,$udom,$uname); 1882: next if ($ncol <= 0); 1883: s/\_/\./g; 1884: next if ($record{'resource.'.$_.'.collaborators'} eq ''); 1885: my @goodcollaborators = (); 1886: my @badcollaborators = (); 1887: foreach (split(/,?\s+/,$record{'resource.'.$_.'.collaborators'})) { 1888: $_ =~ s/[\$\^]//g; 1889: next if ($_ eq ''); 1890: my ($co_name,$co_dom) = split /\@|:/,$_; 1891: $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i); 1892: next if ($co_name eq $uname && $co_dom eq $udom); 1893: # Doing this grep allows 'fuzzy' specification 1894: my @Matches = grep /^$co_name:$co_dom$/i,keys %$classlist; 1895: if (! scalar(@Matches)) { 1896: push @badcollaborators,$_; 1897: } else { 1898: push @goodcollaborators, @Matches; 1899: } 1900: } 1901: if (scalar(@goodcollaborators) != 0) { 1902: $result.='<b>Collaborators: </b>'; 1903: foreach (@goodcollaborators) { 1904: my ($lastname,$givenn) = split(/,/,$$fullname{$_}); 1905: push @col_fullnames, $givenn.' '.$lastname; 1906: $result.=$$fullname{$_}.'     '; 1907: } 1908: $result.='<br />'."\n"; 1909: my ($part)=split(/\./,$_); 1910: $result.='<input type="hidden" name="collaborator'.$counter. 1911: '" value="'.$part.':'.(join ':',@goodcollaborators).'" />'. 1912: "\n"; 1913: } 1914: if (scalar(@badcollaborators) > 0) { 1915: $result.='<table border="0"><tr bgcolor="#ffbbbb"><td>'; 1916: $result.='This student has submitted '; 1917: $result.=(scalar(@badcollaborators) == 1) ? 'an invalid collaborator' : 'invalid collaborators'; 1918: $result .= ': '.join(', ',@badcollaborators); 1919: $result .= '</td></tr></table>'; 1920: } 1921: if (scalar(@badcollaborators > $ncol)) { 1922: $result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>'; 1923: $result .= 'This student has submitted too many '. 1924: 'collaborators. Maximum is '.$ncol.'.'; 1925: $result .= '</td></tr></table>'; 1926: } 1927: } 1928: } 1929: $request->print($result."\n"); 1930: 1931: # print student answer/submission 1932: # Options are (1) Handgaded submission only 1933: # (2) Last submission, includes submission that is not handgraded 1934: # (for multi-response type part) 1935: # (3) Last submission plus the parts info 1936: # (4) The whole record for this student 1937: if ($env{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { 1938: my ($string,$timestamp)= &get_last_submission(\%record); 1939: my $lastsubonly=''. 1940: ($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '. 1941: $$timestamp)."</td></tr>\n"; 1942: if ($$timestamp eq '') { 1943: $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0]; 1944: } else { 1945: my %seenparts; 1946: my @part_response_id = &flatten_responseType($responseType); 1947: foreach my $part (@part_response_id) { 1948: next if ($env{'form.lastSub'} eq 'hdgrade' 1949: && $$handgrade{$$part[0].'_'.$$part[1]} ne 'yes'); 1950: 1951: my ($partid,$respid) = @{ $part }; 1952: my $display_part=&get_display_part($partid,$symb); 1953: if ($env{"form.$uname:$udom:$partid:submitted_by"}) { 1954: if (exists($seenparts{$partid})) { next; } 1955: $seenparts{$partid}=1; 1956: my $submitby='<b>Part:</b> '.$display_part. 1957: ' <b>Collaborative submission by:</b> '. 1958: '<a href="javascript:viewSubmitter(\''. 1959: $env{"form.$uname:$udom:$partid:submitted_by"}. 1960: '\');" target="_self">'. 1961: $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />'; 1962: $request->print($submitby); 1963: next; 1964: } 1965: my $responsetype = $responseType->{$partid}->{$respid}; 1966: if (!exists($record{"resource.$partid.$respid.submission"})) { 1967: $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '. 1968: $display_part.' <span class="LC_internal_info">( ID '.$respid. 1969: ' )</span>   '. 1970: '<span class="LC_warning">Nothing submitted - no attempts</span><br /><br />'; 1971: next; 1972: } 1973: foreach (@$string) { 1974: my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; 1975: if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; } 1976: my ($ressub,$subval) = split(/:/,$_,2); 1977: # Similarity check 1978: my $similar=''; 1979: if($env{'form.checkPlag'}){ 1980: my ($oname,$odom,$ocrsid,$oessay,$osim)= 1981: &most_similar($uname,$udom,$subval,\%old_essays); 1982: if ($osim) { 1983: $osim=int($osim*100.0); 1984: my %old_course_desc = 1985: &Apache::lonnet::coursedescription($ocrsid, 1986: {'one_time' => 1}); 1987: 1988: $similar="<hr /><h3><span class=\"LC_warning\">". 1989: &mt('Essay is [_1]% similar to an essay by [_2] ([_3]:[_4]) in course [_5] (course id [_6]:[_7])', 1990: $osim, 1991: &Apache::loncommon::plainname($oname,$odom), 1992: $oname,$odom, 1993: $old_course_desc{'description'}, 1994: $old_course_desc{'num'}, 1995: $old_course_desc{'domain'}). 1996: '</span></h3><blockquote><i>'. 1997: &keywords_highlight($oessay). 1998: '</i></blockquote><hr />'; 1999: } 2000: } 2001: my $order=&get_order($partid,$respid,$symb,$uname,$udom); 2002: if ($env{'form.lastSub'} eq 'lastonly' || 2003: ($env{'form.lastSub'} eq 'hdgrade' && 2004: $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) { 2005: my $display_part=&get_display_part($partid,$symb); 2006: $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '. 2007: $display_part.' <span class="LC_internal_info">( ID '.$respid. 2008: ' )</span>   '; 2009: my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record); 2010: if (@$files) { 2011: $lastsubonly.='<br /><span class="LC_warning">Like all files provided by users, this file may contain virusses</span><br />'; 2012: my $file_counter = 0; 2013: foreach my $file (@$files) { 2014: $file_counter ++; 2015: &Apache::lonnet::allowuploaded('/adm/grades',$file); 2016: $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border=0"> '.$file.'</a>'; 2017: } 2018: $lastsubonly.='<br />'; 2019: } 2020: $lastsubonly.='<b>Submitted Answer: </b>'. 2021: &cleanRecord($subval,$responsetype,$symb,$partid, 2022: $respid,\%record,$order); 2023: if ($similar) {$lastsubonly.="<br /><br />$similar\n";} 2024: } 2025: } 2026: } 2027: } 2028: $lastsubonly.='</td></tr><tr bgcolor="#ffffff"><td>'."\n"; 2029: $request->print($lastsubonly); 2030: } elsif ($env{'form.lastSub'} eq 'datesub') { 2031: my (undef,$responseType,undef,$parts) = &showResourceInfo($symb); 2032: $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); 2033: } elsif ($env{'form.lastSub'} =~ /^(last|all)$/) { 2034: $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, 2035: $env{'request.course.id'}, 2036: $last,'.submission', 2037: 'Apache::grades::keywords_highlight')); 2038: } 2039: 2040: $request->print('<input type="hidden" name="unamedom'.$counter.'" value="'.$uname.':' 2041: .$udom.'" />'."\n"); 2042: 2043: # return if view submission with no grading option 2044: if ($env{'form.showgrading'} eq '' || (!&canmodify($usec))) { 2045: my $toGrade.='<input type="button" value="Grade Student" '. 2046: 'onClick="javascript:checksubmit(this.form,\'Grade Student\',\'' 2047: .$counter.'\');" target="_self" />  '."\n" if (&canmodify($usec)); 2048: $toGrade.='</td></tr></table></td></tr></table>'."\n"; 2049: if (($env{'form.command'} eq 'submission') || 2050: ($env{'form.command'} eq 'processGroup' && $counter == $total)) { 2051: $toGrade.='</form>'.&show_grading_menu_form($symb); 2052: } 2053: $request->print($toGrade); 2054: return; 2055: } else { 2056: $request->print('</td></tr></table></td></tr></table>'."\n"); 2057: } 2058: 2059: # essay grading message center 2060: if ($env{'form.handgrade'} eq 'yes') { 2061: my ($lastname,$givenn) = split(/,/,$env{'form.fullname'}); 2062: my $msgfor = $givenn.' '.$lastname; 2063: if (scalar(@col_fullnames) > 0) { 2064: my $lastone = pop @col_fullnames; 2065: $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; 2066: } 2067: $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript 2068: $result='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n". 2069: '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n"; 2070: $result.=' <a href="javascript:msgCenter(document.SCORE,'.$counter. 2071: ',\''.$msgfor.'\');" target="_self">'. 2072: &mt('Compose message to student').(scalar(@col_fullnames) >= 1 ? 's' : '').'</a><label> ('. 2073: &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'. 2074: '<img src="'.$request->dir_config('lonIconsURL'). 2075: '/mailbkgrd.gif" width="14" height="10" name="mailicon'.$counter.'" />'."\n". 2076: '<br /> ('. 2077: &mt('Message will be sent when you click on Save & Next below.').")\n"; 2078: $request->print($result); 2079: } 2080: if ($perm{'vgr'}) { 2081: $request->print('<br />'. 2082: &Apache::loncommon::track_student_link(&mt('View recent activity'), 2083: $uname,$udom,'check')); 2084: } 2085: if ($perm{'opa'}) { 2086: $request->print('<br />'. 2087: &Apache::loncommon::pprmlink(&mt('Set/Change parameters'), 2088: $uname,$udom,$symb,'check')); 2089: } 2090: 2091: my %seen = (); 2092: my @partlist; 2093: my @gradePartRespid; 2094: my @part_response_id = &flatten_responseType($responseType); 2095: foreach my $part_response_id (@part_response_id) { 2096: my ($partid,$respid) = @{ $part_response_id }; 2097: my $part_resp = join('_',@{ $part_response_id }); 2098: next if ($seen{$partid} > 0); 2099: $seen{$partid}++; 2100: next if ($$handgrade{$part_resp} ne 'yes' 2101: && $env{'form.lastSub'} eq 'hdgrade'); 2102: push @partlist,$partid; 2103: push @gradePartRespid,$partid.'.'.$respid; 2104: $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); 2105: } 2106: $result='<input type="hidden" name="partlist'.$counter. 2107: '" value="'.(join ":",@partlist).'" />'."\n"; 2108: $result.='<input type="hidden" name="gradePartRespid'. 2109: '" value="'.(join ":",@gradePartRespid).'" />'."\n" if ($counter == 0); 2110: my $ctr = 0; 2111: while ($ctr < scalar(@partlist)) { 2112: $result.='<input type="hidden" name="partid'.$counter.'_'.$ctr.'" value="'. 2113: $partlist[$ctr].'" />'."\n"; 2114: $ctr++; 2115: } 2116: $request->print($result.'</td></tr></table></td></tr></table>'."\n"); 2117: 2118: # print end of form 2119: if ($counter == $total) { 2120: my $endform='<table border="0"><tr><td>'."\n"; 2121: $endform.='<input type="button" value="Save & Next" '. 2122: 'onClick="javascript:checksubmit(this.form,\'Save & Next\','. 2123: $total.','.scalar(@partlist).');" target="_self" />  '."\n"; 2124: my $ntstu ='<select name="NTSTU">'. 2125: '<option>1</option><option>2</option>'. 2126: '<option>3</option><option>5</option>'. 2127: '<option>7</option><option>10</option></select>'."\n"; 2128: my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1'); 2129: $ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</; 2130: $endform.=$ntstu.'student(s)   '; 2131: $endform.='<input type="button" value="Previous" '. 2132: 'onClick="javascript:checksubmit(this.form,\'Previous\');" target="_self" />  '."\n". 2133: '<input type="button" value="Next" '. 2134: 'onClick="javascript:checksubmit(this.form,\'Next\');" target="_self" />  '; 2135: $endform.='(Next and Previous (student) do not save the scores.)'."\n" ; 2136: $endform.="<input type='hidden' value='".&get_increment(). 2137: "' name='increment' />"; 2138: $endform.='</td><tr></table></form>'; 2139: $endform.=&show_grading_menu_form($symb); 2140: $request->print($endform); 2141: } 2142: return ''; 2143: } 2144: 2145: #--- Retrieve the last submission for all the parts 2146: sub get_last_submission { 2147: my ($returnhash)=@_; 2148: my (@string,$timestamp); 2149: if ($$returnhash{'version'}) { 2150: my %lasthash=(); 2151: my ($version); 2152: for ($version=1;$version<=$$returnhash{'version'};$version++) { 2153: foreach my $key (sort(split(/\:/, 2154: $$returnhash{$version.':keys'}))) { 2155: $lasthash{$key}=$$returnhash{$version.':'.$key}; 2156: $timestamp = 2157: scalar(localtime($$returnhash{$version.':timestamp'})); 2158: } 2159: } 2160: foreach my $key (keys(%lasthash)) { 2161: next if ($key !~ /\.submission$/); 2162: 2163: my ($partid,$foo) = split(/submission$/,$key); 2164: my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? 2165: '<span class="LC_warning">Draft Copy</span> ' : ''; 2166: push(@string, join(':', $key, $draft.$lasthash{$key})); 2167: } 2168: } 2169: if (!@string) { 2170: $string[0] = 2171: '<span class="LC_warning">Nothing submitted - no attempts.</span>'; 2172: } 2173: return (\@string,\$timestamp); 2174: } 2175: 2176: #--- High light keywords, with style choosen by user. 2177: sub keywords_highlight { 2178: my $string = shift; 2179: my $size = $env{'form.kwsize'} eq '0' ? '' : 'size='.$env{'form.kwsize'}; 2180: my $styleon = $env{'form.kwstyle'} eq '' ? '' : $env{'form.kwstyle'}; 2181: (my $styleoff = $styleon) =~ s/\</\<\//; 2182: my @keylist = split(/[,\s+]/,$env{'form.keywords'}); 2183: foreach my $keyword (@keylist) { 2184: $string =~ s/\b\Q$keyword\E(\b|\.)/<font color\=$env{'form.kwclr'} $size\>$styleon$keyword$styleoff<\/font>/gi; 2185: } 2186: return $string; 2187: } 2188: 2189: #--- Called from submission routine 2190: sub processHandGrade { 2191: my ($request) = shift; 2192: my $symb = &get_symb($request); 2193: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 2194: my $button = $env{'form.gradeOpt'}; 2195: my $ngrade = $env{'form.NCT'}; 2196: my $ntstu = $env{'form.NTSTU'}; 2197: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2198: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2199: 2200: if ($button eq 'Save & Next') { 2201: my $ctr = 0; 2202: while ($ctr < $ngrade) { 2203: my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr}); 2204: my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$symb,$uname,$udom,$ctr); 2205: if ($errorflag eq 'no_score') { 2206: $ctr++; 2207: next; 2208: } 2209: if ($errorflag eq 'not_allowed') { 2210: $request->print("<span class=\"LC_warning\">Not allowed to modify grades for $uname:$udom</span>"); 2211: $ctr++; 2212: next; 2213: } 2214: my $includemsg = $env{'form.includemsg'.$ctr}; 2215: my ($subject,$message,$msgstatus) = ('','',''); 2216: my $restitle = &Apache::lonnet::gettitle($symb); 2217: my ($feedurl,$showsymb) = 2218: &get_feedurl_and_symb($symb,$uname,$udom); 2219: my $messagetail; 2220: if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { 2221: $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); 2222: unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } 2223: $subject.=' ['.$restitle.']'; 2224: my (@msgnum) = split(/,/,$includemsg); 2225: foreach (@msgnum) { 2226: $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); 2227: } 2228: $message =&Apache::lonfeedback::clear_out_html($message); 2229: if ($env{'form.withgrades'.$ctr}) { 2230: $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; 2231: $messagetail = " for <a href=\"". 2232: $feedurl."?symb=$showsymb\">$env{'form.probTitle'}</a>"; 2233: } 2234: $msgstatus = 2235: &Apache::lonmsg::user_normal_msg($uname,$udom,$subject, 2236: $message.$messagetail, 2237: undef,$feedurl,undef, 2238: undef,undef,$showsymb, 2239: $restitle); 2240: $request->print('<br />'.&mt('Sending message to [_1]:[_2]',$uname,$udom).': '. 2241: $msgstatus); 2242: } 2243: if ($env{'form.collaborator'.$ctr}) { 2244: my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); 2245: foreach my $collabstr (@collabstrs) { 2246: my ($part,@collaborators) = split(/:/,$collabstr); 2247: foreach my $collaborator (@collaborators) { 2248: my ($errorflag,$pts,$wgt) = 2249: &saveHandGrade($request,$symb,$collaborator,$udom,$ctr, 2250: $env{'form.unamedom'.$ctr},$part); 2251: if ($errorflag eq 'not_allowed') { 2252: $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>"); 2253: next; 2254: } elsif ($message ne '') { 2255: my ($baseurl,$showsymb) = 2256: &get_feedurl_and_symb($symb,$collaborator, 2257: $udom); 2258: if ($env{'form.withgrades'.$ctr}) { 2259: $messagetail = " for <a href=\"". 2260: $baseurl."?symb=$showsymb\">$env{'form.probTitle'}</a>"; 2261: } 2262: $msgstatus = 2263: &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); 2264: } 2265: } 2266: } 2267: } 2268: $ctr++; 2269: } 2270: } 2271: 2272: if ($env{'form.handgrade'} eq 'yes') { 2273: # Keywords sorted in alphabatical order 2274: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 2275: my %keyhash = (); 2276: $env{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; 2277: $env{'form.keywords'} =~ s/^\s+|\s+$//; 2278: my (@keywords) = sort(split(/\s+/,$env{'form.keywords'})); 2279: $env{'form.keywords'} = join(' ',@keywords); 2280: $keyhash{$symb.'_keywords'} = $env{'form.keywords'}; 2281: $keyhash{$symb.'_subject'} = $env{'form.msgsub'}; 2282: $keyhash{$loginuser.'_kwclr'} = $env{'form.kwclr'}; 2283: $keyhash{$loginuser.'_kwsize'} = $env{'form.kwsize'}; 2284: $keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'}; 2285: 2286: # message center - Order of message gets changed. Blank line is eliminated. 2287: # New messages are saved in env for the next student. 2288: # All messages are saved in nohist_handgrade.db 2289: my ($ctr,$idx) = (1,1); 2290: while ($ctr <= $env{'form.savemsgN'}) { 2291: if ($env{'form.savemsg'.$ctr} ne '') { 2292: $keyhash{$symb.'_savemsg'.$idx} = $env{'form.savemsg'.$ctr}; 2293: $idx++; 2294: } 2295: $ctr++; 2296: } 2297: $ctr = 0; 2298: while ($ctr < $ngrade) { 2299: if ($env{'form.newmsg'.$ctr} ne '') { 2300: $keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr}; 2301: $env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr}; 2302: $idx++; 2303: } 2304: $ctr++; 2305: } 2306: $env{'form.savemsgN'} = --$idx; 2307: $keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'}; 2308: my $putresult = &Apache::lonnet::put 2309: ('nohist_handgrade',\%keyhash,$cdom,$cnum); 2310: } 2311: # Called by Save & Refresh from Highlight Attribute Window 2312: my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); 2313: if ($env{'form.refresh'} eq 'on') { 2314: my ($ctr,$total) = (0,0); 2315: while ($ctr < $ngrade) { 2316: $total++ if $env{'form.unamedom'.$ctr} ne ''; 2317: $ctr++; 2318: } 2319: $env{'form.NTSTU'}=$ngrade; 2320: $ctr = 0; 2321: while ($ctr < $total) { 2322: my $processUser = $env{'form.unamedom'.$ctr}; 2323: ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); 2324: $env{'form.fullname'} = $$fullname{$processUser}; 2325: &submission($request,$ctr,$total-1); 2326: $ctr++; 2327: } 2328: return ''; 2329: } 2330: 2331: # Go directly to grade student - from submission or link from chart page 2332: if ($button eq 'Grade Student') { 2333: (undef,undef,$env{'form.handgrade'},undef,undef) = &showResourceInfo($symb); 2334: my $processUser = $env{'form.unamedom'.$env{'form.studentNo'}}; 2335: ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); 2336: $env{'form.fullname'} = $$fullname{$processUser}; 2337: &submission($request,0,0); 2338: return ''; 2339: } 2340: 2341: # Get the next/previous one or group of students 2342: my $firststu = $env{'form.unamedom0'}; 2343: my $laststu = $env{'form.unamedom'.($ngrade-1)}; 2344: my $ctr = 2; 2345: while ($laststu eq '') { 2346: $laststu = $env{'form.unamedom'.($ngrade-$ctr)}; 2347: $ctr++; 2348: $laststu = $firststu if ($ctr > $ngrade); 2349: } 2350: 2351: my (@parsedlist,@nextlist); 2352: my ($nextflg) = 0; 2353: foreach (sort 2354: { 2355: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 2356: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 2357: } 2358: return $a cmp $b; 2359: } (keys(%$fullname))) { 2360: if ($nextflg == 1 && $button =~ /Next$/) { 2361: push @parsedlist,$_; 2362: } 2363: $nextflg = 1 if ($_ eq $laststu); 2364: if ($button eq 'Previous') { 2365: last if ($_ eq $firststu); 2366: push @parsedlist,$_; 2367: } 2368: } 2369: $ctr = 0; 2370: @parsedlist = reverse @parsedlist if ($button eq 'Previous'); 2371: my ($partlist) = &response_type($symb); 2372: foreach my $student (@parsedlist) { 2373: my $submitonly=$env{'form.submitonly'}; 2374: my ($uname,$udom) = split(/:/,$student); 2375: 2376: if ($submitonly eq 'queued') { 2377: my %queue_status = 2378: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 2379: $udom,$uname); 2380: next if (!defined($queue_status{'gradingqueue'})); 2381: } 2382: 2383: if ($submitonly =~ /^(yes|graded|incorrect)$/) { 2384: # my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 2385: my %status=&student_gradeStatus($symb,$udom,$uname,$partlist); 2386: my $submitted = 0; 2387: my $ungraded = 0; 2388: my $incorrect = 0; 2389: foreach (keys(%status)) { 2390: $submitted = 1 if ($status{$_} ne 'nothing'); 2391: $ungraded = 1 if ($status{$_} =~ /^ungraded/); 2392: $incorrect = 1 if ($status{$_} =~ /^incorrect/); 2393: my ($foo,$partid,$foo1) = split(/\./,$_); 2394: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 2395: $submitted = 0; 2396: } 2397: } 2398: next if (!$submitted && ($submitonly eq 'yes' || 2399: $submitonly eq 'incorrect' || 2400: $submitonly eq 'graded')); 2401: next if (!$ungraded && ($submitonly eq 'graded')); 2402: next if (!$incorrect && $submitonly eq 'incorrect'); 2403: } 2404: push @nextlist,$student if ($ctr < $ntstu); 2405: last if ($ctr == $ntstu); 2406: $ctr++; 2407: } 2408: 2409: $ctr = 0; 2410: my $total = scalar(@nextlist)-1; 2411: 2412: foreach (sort @nextlist) { 2413: my ($uname,$udom,$submitter) = split(/:/); 2414: $env{'form.student'} = $uname; 2415: $env{'form.userdom'} = $udom; 2416: $env{'form.fullname'} = $$fullname{$_}; 2417: &submission($request,$ctr,$total); 2418: $ctr++; 2419: } 2420: if ($total < 0) { 2421: my $the_end = '<h3><span class="LC_info">LON-CAPA User Message</span></h3><br />'."\n"; 2422: $the_end.='<b>Message: </b> No more students for this section or class.<br /><br />'."\n"; 2423: $the_end.='Click on the button below to return to the grading menu.<br /><br />'."\n"; 2424: $the_end.=&show_grading_menu_form($symb); 2425: $request->print($the_end); 2426: } 2427: return ''; 2428: } 2429: 2430: #---- Save the score and award for each student, if changed 2431: sub saveHandGrade { 2432: my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; 2433: my @version_parts; 2434: my $usec = &Apache::lonnet::getsection($domain,$stuname, 2435: $env{'request.course.id'}); 2436: if (!&canmodify($usec)) { return('not_allowed'); } 2437: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); 2438: my @parts_graded; 2439: my %newrecord = (); 2440: my ($pts,$wgt) = ('',''); 2441: my %aggregate = (); 2442: my $aggregateflag = 0; 2443: my @parts = split(/:/,$env{'form.partlist'.$newflg}); 2444: foreach my $new_part (@parts) { 2445: #collaborator ($submi may vary for different parts 2446: if ($submitter && $new_part ne $part) { next; } 2447: my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; 2448: if ($dropMenu eq 'excused') { 2449: if ($record{'resource.'.$new_part.'.solved'} ne 'excused') { 2450: $newrecord{'resource.'.$new_part.'.solved'} = 'excused'; 2451: if (exists($record{'resource.'.$new_part.'.awarded'})) { 2452: $newrecord{'resource.'.$new_part.'.awarded'} = ''; 2453: } 2454: $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; 2455: } 2456: } elsif ($dropMenu eq 'reset status' 2457: && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts 2458: foreach my $key (keys (%record)) { 2459: if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } 2460: } 2461: $newrecord{'resource.'.$new_part.'.regrader'}= 2462: "$env{'user.name'}:$env{'user.domain'}"; 2463: my $totaltries = $record{'resource.'.$part.'.tries'}; 2464: 2465: my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, 2466: [$new_part]); 2467: my $aggtries =$totaltries; 2468: if ($last_resets{$new_part}) { 2469: $aggtries = &get_num_tries(\%record,$last_resets{$new_part}, 2470: $new_part); 2471: } 2472: 2473: my $solvedstatus = $record{'resource.'.$new_part.'.solved'}; 2474: if ($aggtries > 0) { 2475: &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); 2476: $aggregateflag = 1; 2477: } 2478: } elsif ($dropMenu eq '') { 2479: $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 2480: $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 2481: $env{'form.RADVAL'.$newflg.'_'.$new_part}); 2482: if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$new_part} eq '') { 2483: next; 2484: } 2485: $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : 2486: $env{'form.WGT'.$newflg.'_'.$new_part}; 2487: my $partial= $pts/$wgt; 2488: if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { 2489: #do not update score for part if not changed. 2490: &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); 2491: next; 2492: } else { 2493: push @parts_graded, $new_part; 2494: } 2495: if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { 2496: $newrecord{'resource.'.$new_part.'.awarded'} = $partial; 2497: } 2498: my $reckey = 'resource.'.$new_part.'.solved'; 2499: if ($partial == 0) { 2500: if ($record{$reckey} ne 'incorrect_by_override') { 2501: $newrecord{$reckey} = 'incorrect_by_override'; 2502: } 2503: } else { 2504: if ($record{$reckey} ne 'correct_by_override') { 2505: $newrecord{$reckey} = 'correct_by_override'; 2506: } 2507: } 2508: if ($submitter && 2509: ($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) { 2510: $newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter; 2511: } 2512: $newrecord{'resource.'.$new_part.'.regrader'}= 2513: "$env{'user.name'}:$env{'user.domain'}"; 2514: } 2515: # unless problem has been graded, set flag to version the submitted files 2516: unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || 2517: $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' || 2518: $dropMenu eq 'reset status') 2519: { 2520: push (@version_parts,$new_part); 2521: } 2522: } 2523: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2524: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2525: 2526: if (%newrecord) { 2527: if (@version_parts) { 2528: my @changed_keys = &version_portfiles(\%record, \@parts_graded, 2529: $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts); 2530: @newrecord{@changed_keys} = @record{@changed_keys}; 2531: foreach my $new_part (@version_parts) { 2532: &handback_files($request,$symb,$stuname,$domain,$newflg, 2533: $new_part,\%newrecord); 2534: } 2535: } 2536: &Apache::lonnet::cstore(\%newrecord,$symb, 2537: $env{'request.course.id'},$domain,$stuname); 2538: &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb, 2539: $cdom,$cnum,$domain,$stuname); 2540: } 2541: if ($aggregateflag) { 2542: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 2543: $cdom,$cnum); 2544: } 2545: return ('',$pts,$wgt); 2546: } 2547: 2548: sub check_and_remove_from_queue { 2549: my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_; 2550: my @ungraded_parts; 2551: foreach my $part (@{$parts}) { 2552: if ( $record->{ 'resource.'.$part.'.awarded'} eq '' 2553: && $record->{ 'resource.'.$part.'.solved' } ne 'excused' 2554: && $newrecord->{'resource.'.$part.'.awarded'} eq '' 2555: && $newrecord->{'resource.'.$part.'.solved' } ne 'excused' 2556: ) { 2557: push(@ungraded_parts, $part); 2558: } 2559: } 2560: if ( !@ungraded_parts ) { 2561: &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom, 2562: $cnum,$domain,$stuname); 2563: } 2564: } 2565: 2566: sub handback_files { 2567: my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; 2568: my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio'; 2569: my ($partlist,$handgrade,$responseType) = &response_type($symb); 2570: 2571: my @part_response_id = &flatten_responseType($responseType); 2572: foreach my $part_response_id (@part_response_id) { 2573: my ($part_id,$resp_id) = @{ $part_response_id }; 2574: my $part_resp = join('_',@{ $part_response_id }); 2575: if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) { 2576: # if multiple files are uploaded names will be 'returndoc2','returndoc3' 2577: my $file_counter = 1; 2578: my $file_msg; 2579: while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) { 2580: my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'}; 2581: my ($directory,$answer_file) = 2582: ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/); 2583: my ($answer_name,$answer_ver,$answer_ext) = 2584: &file_name_version_ext($answer_file); 2585: my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); 2586: my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root); 2587: my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); 2588: # fix file name 2589: my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); 2590: my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, 2591: $newflg.'_'.$part_resp.'_returndoc'.$file_counter, 2592: $save_file_name); 2593: if ($result !~ m|^/uploaded/|) { 2594: $request->print('<span class="LC_error">An error occurred ('.$result. 2595: ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'</span><br />'); 2596: } else { 2597: # mark the file as read only 2598: my @files = ($save_file_name); 2599: my @what = ($symb,$env{'request.course.id'},'handback'); 2600: &Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what); 2601: if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) { 2602: $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; 2603: } 2604: $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; 2605: $file_msg.= "\n".'<br /><span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span><br />"; 2606: 2607: } 2608: $request->print("<br />".$fname." will be the uploaded file name"); 2609: $request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter}); 2610: $file_counter++; 2611: } 2612: my $subject = "File Handed Back by Instructor "; 2613: my $message = "A file has been returned that was originally submitted in reponse to: <br />"; 2614: $message .= "<strong>".&Apache::lonnet::gettitle($symb)."</strong><br />"; 2615: $message .= ' The returned file(s) are named: '. $file_msg; 2616: $message .= " and can be found in your portfolio space."; 2617: my ($feedurl,$showsymb) = 2618: &get_feedurl_and_symb($symb,$domain,$stuname); 2619: my $restitle = &Apache::lonnet::gettitle($symb); 2620: my $msgstatus = 2621: &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject. 2622: ' (File Returned) ['.$restitle.']',$message,undef, 2623: $feedurl,undef,undef,undef,$showsymb,$restitle); 2624: } 2625: } 2626: return; 2627: } 2628: 2629: sub get_feedurl_and_symb { 2630: my ($symb,$uname,$udom) = @_; 2631: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 2632: $url = &Apache::lonnet::clutter($url); 2633: my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', 2634: $symb,$udom,$uname); 2635: if ($encrypturl =~ /^yes$/i) { 2636: &Apache::lonenc::encrypted(\$url,1); 2637: &Apache::lonenc::encrypted(\$symb,1); 2638: } 2639: return ($url,$symb); 2640: } 2641: 2642: sub get_submitted_files { 2643: my ($udom,$uname,$partid,$respid,$record) = @_; 2644: my @files; 2645: if ($$record{"resource.$partid.$respid.portfiles"}) { 2646: my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; 2647: foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) { 2648: push(@files,$file_url.$file); 2649: } 2650: } 2651: if ($$record{"resource.$partid.$respid.uploadedurl"}) { 2652: push(@files,$$record{"resource.$partid.$respid.uploadedurl"}); 2653: } 2654: return (\@files); 2655: } 2656: 2657: # ----------- Provides number of tries since last reset. 2658: sub get_num_tries { 2659: my ($record,$last_reset,$part) = @_; 2660: my $timestamp = ''; 2661: my $num_tries = 0; 2662: if ($$record{'version'}) { 2663: for (my $version=$$record{'version'};$version>=1;$version--) { 2664: if (exists($$record{$version.':resource.'.$part.'.solved'})) { 2665: $timestamp = $$record{$version.':timestamp'}; 2666: if ($timestamp > $last_reset) { 2667: $num_tries ++; 2668: } else { 2669: last; 2670: } 2671: } 2672: } 2673: } 2674: return $num_tries; 2675: } 2676: 2677: # ----------- Determine decrements required in aggregate totals 2678: sub decrement_aggs { 2679: my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_; 2680: my %decrement = ( 2681: attempts => 0, 2682: users => 0, 2683: correct => 0 2684: ); 2685: $decrement{'attempts'} = $aggtries; 2686: if ($solvedstatus =~ /^correct/) { 2687: $decrement{'correct'} = 1; 2688: } 2689: if ($aggtries == $totaltries) { 2690: $decrement{'users'} = 1; 2691: } 2692: foreach my $type (keys (%decrement)) { 2693: $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type}; 2694: } 2695: return; 2696: } 2697: 2698: # ----------- Determine timestamps for last reset of aggregate totals for parts 2699: sub get_last_resets { 2700: my ($symb,$courseid,$partids) =@_; 2701: my %last_resets; 2702: my $cdom = $env{'course.'.$courseid.'.domain'}; 2703: my $cname = $env{'course.'.$courseid.'.num'}; 2704: my @keys; 2705: foreach my $part (@{$partids}) { 2706: push(@keys,"$symb\0$part\0resettime"); 2707: } 2708: my %results=&Apache::lonnet::get('nohist_resourcetracker',\@keys, 2709: $cdom,$cname); 2710: foreach my $part (@{$partids}) { 2711: $last_resets{$part}=$results{"$symb\0$part\0resettime"}; 2712: } 2713: return %last_resets; 2714: } 2715: 2716: # ----------- Handles creating versions for portfolio files as answers 2717: sub version_portfiles { 2718: my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_; 2719: my $version_parts = join('|',@$v_flag); 2720: my @returned_keys; 2721: my $parts = join('|', @$parts_graded); 2722: my $portfolio_root = &propath($domain,$stu_name). 2723: '/userfiles/portfolio'; 2724: foreach my $key (keys(%$record)) { 2725: my $new_portfiles; 2726: if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { 2727: my @versioned_portfiles; 2728: my @portfiles = split(/\s*,\s*/,$$record{$key}); 2729: foreach my $file (@portfiles) { 2730: &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file); 2731: my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); 2732: my ($answer_name,$answer_ver,$answer_ext) = 2733: &file_name_version_ext($answer_file); 2734: my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root); 2735: my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); 2736: my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); 2737: if ($new_answer ne 'problem getting file') { 2738: push(@versioned_portfiles, $directory.$new_answer); 2739: &Apache::lonnet::mark_as_readonly($domain,$stu_name, 2740: [$directory.$new_answer], 2741: [$symb,$env{'request.course.id'},'graded']); 2742: } 2743: } 2744: $$record{$key} = join(',',@versioned_portfiles); 2745: push(@returned_keys,$key); 2746: } 2747: } 2748: return (@returned_keys); 2749: } 2750: 2751: sub get_next_version { 2752: my ($answer_name, $answer_ext, $dir_list) = @_; 2753: my $version; 2754: foreach my $row (@$dir_list) { 2755: my ($file) = split(/\&/,$row,2); 2756: my ($file_name,$file_version,$file_ext) = 2757: &file_name_version_ext($file); 2758: if (($file_name eq $answer_name) && 2759: ($file_ext eq $answer_ext)) { 2760: # gets here if filename and extension match, regardless of version 2761: if ($file_version ne '') { 2762: # a versioned file is found so save it for later 2763: if ($file_version > $version) { 2764: $version = $file_version; 2765: } 2766: } 2767: } 2768: } 2769: $version ++; 2770: return($version); 2771: } 2772: 2773: sub version_selected_portfile { 2774: my ($domain,$stu_name,$directory,$file_name,$version) = @_; 2775: my ($answer_name,$answer_ver,$answer_ext) = 2776: &file_name_version_ext($file_name); 2777: my $new_answer; 2778: $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name"); 2779: if($env{'form.copy'} eq '-1') { 2780: &Apache::lonnet::logthis('problem getting file '.$file_name); 2781: $new_answer = 'problem getting file'; 2782: } else { 2783: $new_answer = $answer_name.'.'.$version.'.'.$answer_ext; 2784: my $copy_result = &Apache::lonnet::finishuserfileupload( 2785: $stu_name,$domain,'copy', 2786: '/portfolio'.$directory.$new_answer); 2787: } 2788: return ($new_answer); 2789: } 2790: 2791: sub file_name_version_ext { 2792: my ($file)=@_; 2793: my @file_parts = split(/\./, $file); 2794: my ($name,$version,$ext); 2795: if (@file_parts > 1) { 2796: $ext=pop(@file_parts); 2797: if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) { 2798: $version=pop(@file_parts); 2799: } 2800: $name=join('.',@file_parts); 2801: } else { 2802: $name=join('.',@file_parts); 2803: } 2804: return($name,$version,$ext); 2805: } 2806: 2807: #-------------------------------------------------------------------------------------- 2808: # 2809: #-------------------------- Next few routines handles grading by section or whole class 2810: # 2811: #--- Javascript to handle grading by section or whole class 2812: sub viewgrades_js { 2813: my ($request) = shift; 2814: 2815: $request->print(<<VIEWJAVASCRIPT); 2816: <script type="text/javascript" language="javascript"> 2817: function writePoint(partid,weight,point) { 2818: var radioButton = document.classgrade["RADVAL_"+partid]; 2819: var textbox = document.classgrade["TEXTVAL_"+partid]; 2820: if (point == "textval") { 2821: point = document.classgrade["TEXTVAL_"+partid].value; 2822: if (isNaN(point) || parseFloat(point) < 0) { 2823: alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point)); 2824: var resetbox = false; 2825: for (var i=0; i<radioButton.length; i++) { 2826: if (radioButton[i].checked) { 2827: textbox.value = i; 2828: resetbox = true; 2829: } 2830: } 2831: if (!resetbox) { 2832: textbox.value = ""; 2833: } 2834: return; 2835: } 2836: if (parseFloat(point) > parseFloat(weight)) { 2837: var resp = confirm("You entered a value ("+parseFloat(point)+ 2838: ") greater than the weight for the part. Accept?"); 2839: if (resp == false) { 2840: textbox.value = ""; 2841: return; 2842: } 2843: } 2844: for (var i=0; i<radioButton.length; i++) { 2845: radioButton[i].checked=false; 2846: if (parseFloat(point) == i) { 2847: radioButton[i].checked=true; 2848: } 2849: } 2850: 2851: } else { 2852: textbox.value = parseFloat(point); 2853: } 2854: for (i=0;i<document.classgrade.total.value;i++) { 2855: var user = document.classgrade["ctr"+i].value; 2856: user = user.replace(new RegExp(':', 'g'),"_"); 2857: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 2858: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 2859: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 2860: if (saveval != "correct") { 2861: scorename.value = point; 2862: if (selname[0].selected != true) { 2863: selname[0].selected = true; 2864: } 2865: } 2866: } 2867: document.classgrade["SELVAL_"+partid][0].selected = true; 2868: } 2869: 2870: function writeRadText(partid,weight) { 2871: var selval = document.classgrade["SELVAL_"+partid]; 2872: var radioButton = document.classgrade["RADVAL_"+partid]; 2873: var override = document.classgrade["FORCE_"+partid].checked; 2874: var textbox = document.classgrade["TEXTVAL_"+partid]; 2875: if (selval[1].selected || selval[2].selected) { 2876: for (var i=0; i<radioButton.length; i++) { 2877: radioButton[i].checked=false; 2878: 2879: } 2880: textbox.value = ""; 2881: 2882: for (i=0;i<document.classgrade.total.value;i++) { 2883: var user = document.classgrade["ctr"+i].value; 2884: user = user.replace(new RegExp(':', 'g'),"_"); 2885: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 2886: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 2887: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 2888: if ((saveval != "correct") || override) { 2889: scorename.value = ""; 2890: if (selval[1].selected) { 2891: selname[1].selected = true; 2892: } else { 2893: selname[2].selected = true; 2894: if (Number(document.classgrade["GD_"+user+"_"+partid+"_tries"].value)) 2895: {document.classgrade["GD_"+user+"_"+partid+"_tries"].value = '0';} 2896: } 2897: } 2898: } 2899: } else { 2900: for (i=0;i<document.classgrade.total.value;i++) { 2901: var user = document.classgrade["ctr"+i].value; 2902: user = user.replace(new RegExp(':', 'g'),"_"); 2903: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 2904: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 2905: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 2906: if ((saveval != "correct") || override) { 2907: scorename.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value; 2908: selname[0].selected = true; 2909: } 2910: } 2911: } 2912: } 2913: 2914: function changeSelect(partid,user) { 2915: var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"]; 2916: var textbox = document.classgrade["GD_"+user+'_'+partid+"_awarded"]; 2917: var point = textbox.value; 2918: var weight = document.classgrade["weight_"+partid].value; 2919: 2920: if (isNaN(point) || parseFloat(point) < 0) { 2921: alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point)); 2922: textbox.value = ""; 2923: return; 2924: } 2925: if (parseFloat(point) > parseFloat(weight)) { 2926: var resp = confirm("You entered a value ("+parseFloat(point)+ 2927: ") greater than the weight of the part. Accept?"); 2928: if (resp == false) { 2929: textbox.value = ""; 2930: return; 2931: } 2932: } 2933: selval[0].selected = true; 2934: } 2935: 2936: function changeOneScore(partid,user) { 2937: var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"]; 2938: if (selval[1].selected || selval[2].selected) { 2939: document.classgrade["GD_"+user+'_'+partid+"_awarded"].value = ""; 2940: if (selval[2].selected) { 2941: document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0"; 2942: } 2943: } 2944: } 2945: 2946: function resetEntry(numpart) { 2947: for (ctpart=0;ctpart<numpart;ctpart++) { 2948: var partid = document.classgrade["partid_"+ctpart].value; 2949: var radioButton = document.classgrade["RADVAL_"+partid]; 2950: var textbox = document.classgrade["TEXTVAL_"+partid]; 2951: var selval = document.classgrade["SELVAL_"+partid]; 2952: for (var i=0; i<radioButton.length; i++) { 2953: radioButton[i].checked=false; 2954: 2955: } 2956: textbox.value = ""; 2957: selval[0].selected = true; 2958: 2959: for (i=0;i<document.classgrade.total.value;i++) { 2960: var user = document.classgrade["ctr"+i].value; 2961: user = user.replace(new RegExp(':', 'g'),"_"); 2962: var resetscore = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 2963: resetscore.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value; 2964: var resettries = document.classgrade["GD_"+user+"_"+partid+"_tries"]; 2965: resettries.value = document.classgrade["GD_"+user+"_"+partid+"_tries_s"].value; 2966: var saveselval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 2967: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 2968: if (saveselval == "excused") { 2969: if (selname[1].selected == false) { selname[1].selected = true;} 2970: } else { 2971: if (selname[0].selected == false) {selname[0].selected = true}; 2972: } 2973: } 2974: } 2975: } 2976: 2977: </script> 2978: VIEWJAVASCRIPT 2979: } 2980: 2981: #--- show scores for a section or whole class w/ option to change/update a score 2982: sub viewgrades { 2983: my ($request) = shift; 2984: &viewgrades_js($request); 2985: 2986: my ($symb) = &get_symb($request); 2987: #need to make sure we have the correct data for later EXT calls, 2988: #thus invalidate the cache 2989: &Apache::lonnet::devalidatecourseresdata( 2990: $env{'course.'.$env{'request.course.id'}.'.num'}, 2991: $env{'course.'.$env{'request.course.id'}.'.domain'}); 2992: &Apache::lonnet::clear_EXT_cache_status(); 2993: 2994: my $result='<h3><span class="LC_info">'.&mt('Manual Grading').'</span></h3>'; 2995: $result.='<h4><b>Current Resource: </b>'.$env{'form.probTitle'}.'</h4>'."\n"; 2996: 2997: #view individual student submission form - called using Javascript viewOneStudent 2998: $result.=&jscriptNform($symb); 2999: 3000: #beginning of class grading form 3001: $result.= '<form action="/adm/grades" method="post" name="classgrade">'."\n". 3002: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 3003: '<input type="hidden" name="command" value="editgrades" />'."\n". 3004: &build_section_inputs(). 3005: '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n". 3006: '<input type="hidden" name="Status" value="'.$env{'form.Status'}.'" />'."\n". 3007: '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n"; 3008: 3009: my $sectionClass; 3010: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3011: if ($env{'form.section'} eq 'all') { 3012: $sectionClass='Class </h3>'; 3013: } elsif ($env{'form.section'} eq 'none') { 3014: $sectionClass=&mt('Students in no Section').'</h3>'; 3015: } else { 3016: $sectionClass=&mt('Students in Section(s) [_1]',$section_display).'</h3>'; 3017: } 3018: $result.='<h3>'.&mt('Assign Common Grade To [_1]',$sectionClass); 3019: $result.= '<table border=0><tr><td bgcolor="#777777">'."\n". 3020: '<table border=0><tr bgcolor="#ffffdd"><td>'; 3021: #radio buttons/text box for assigning points for a section or class. 3022: #handles different parts of a problem 3023: my ($partlist,$handgrade,$responseType) = &response_type($symb); 3024: my %weight = (); 3025: my $ctsparts = 0; 3026: $result.='<table border="0">'; 3027: my %seen = (); 3028: my @part_response_id = &flatten_responseType($responseType); 3029: foreach my $part_response_id (@part_response_id) { 3030: my ($partid,$respid) = @{ $part_response_id }; 3031: my $part_resp = join('_',@{ $part_response_id }); 3032: next if $seen{$partid}; 3033: $seen{$partid}++; 3034: my $handgrade=$$handgrade{$part_resp}; 3035: my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); 3036: $weight{$partid} = $wgt eq '' ? '1' : $wgt; 3037: 3038: $result.='<input type="hidden" name="partid_'. 3039: $ctsparts.'" value="'.$partid.'" />'."\n"; 3040: $result.='<input type="hidden" name="weight_'. 3041: $partid.'" value="'.$weight{$partid}.'" />'."\n"; 3042: my $display_part=&get_display_part($partid,$symb); 3043: $result.='<tr><td><b>Part:</b> '.$display_part.'   <b>Point:</b> </td><td>'; 3044: $result.='<table border="0"><tr>'; 3045: my $ctr = 0; 3046: while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across 3047: $result.= '<td><label><input type="radio" name="RADVAL_'.$partid.'" '. 3048: 'onclick="javascript:writePoint(\''.$partid.'\','.$weight{$partid}. 3049: ','.$ctr.')" />'.$ctr."</label></td>\n"; 3050: $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); 3051: $ctr++; 3052: } 3053: $result.='</tr></table>'; 3054: $result.= '</td><td><b> or </b><input type="text" name="TEXTVAL_'. 3055: $partid.'" size="4" '.'onChange="javascript:writePoint(\''. 3056: $partid.'\','.$weight{$partid}.',\'textval\')" /> /'. 3057: $weight{$partid}.' (problem weight)</td>'."\n"; 3058: $result.= '</td><td><select name="SELVAL_'.$partid.'"'. 3059: 'onChange="javascript:writeRadText(\''.$partid.'\','. 3060: $weight{$partid}.')"> '. 3061: '<option selected="selected"> </option>'. 3062: '<option>excused</option>'. 3063: '<option>reset status</option></select></td>'. 3064: '<td><label><input type="checkbox" name="FORCE_'.$partid.'" /> Override "Correct"</label></td></tr>'."\n"; 3065: $ctsparts++; 3066: } 3067: $result.='</table>'.'</td></tr></table>'.'</td></tr></table>'."\n". 3068: '<input type="hidden" name="totalparts" value="'.$ctsparts.'" />'; 3069: $result.='<input type="button" value="Revert to Default" '. 3070: 'onClick="javascript:resetEntry('.$ctsparts.');" target="_self" />'; 3071: 3072: #table listing all the students in a section/class 3073: #header of table 3074: $result.= '<h3>Assign Grade to Specific Students in '.$sectionClass; 3075: $result.= '<table border=0><tr><td bgcolor="#777777">'."\n". 3076: '<table border=0><tr bgcolor="#deffff"><td> <b>No.</b> </td>'. 3077: '<td>'.&nameUserString('header')."</td>\n"; 3078: my (@parts) = sort(&getpartlist($symb)); 3079: my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); 3080: my @partids = (); 3081: foreach my $part (@parts) { 3082: my $display=&Apache::lonnet::metadata($url,$part.'.display'); 3083: $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower 3084: if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } 3085: my ($partid) = &split_part_type($part); 3086: push(@partids, $partid); 3087: my $display_part=&get_display_part($partid,$symb); 3088: if ($display =~ /^Partial Credit Factor/) { 3089: $result.='<td><b>Score Part:</b> '.$display_part. 3090: ' <br /><b>(weight = '.$weight{$partid}.')</b></td>'."\n"; 3091: next; 3092: } else { 3093: $display =~s/\[Part: \Q$partid\E\]/Part:<\/b> $display_part/; 3094: } 3095: $display =~ s|Problem Status|Grade Status<br />|; 3096: $result.='<td><b>'.$display.'</td>'."\n"; 3097: } 3098: $result.='</tr>'; 3099: 3100: my %last_resets = 3101: &get_last_resets($symb,$env{'request.course.id'},\@partids); 3102: 3103: #get info for each student 3104: #list all the students - with points and grade status 3105: my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); 3106: my $ctr = 0; 3107: foreach (sort 3108: { 3109: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 3110: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 3111: } 3112: return $a cmp $b; 3113: } (keys(%$fullname))) { 3114: $ctr++; 3115: $result.=&viewstudentgrade($symb,$env{'request.course.id'}, 3116: $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets); 3117: } 3118: $result.='</table></td></tr></table>'; 3119: $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n"; 3120: $result.='<input type="button" value="Save" '. 3121: 'onClick="javascript:submit();" target="_self" /></form>'."\n"; 3122: if (scalar(%$fullname) eq 0) { 3123: my $colspan=3+scalar(@parts); 3124: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3125: $result='<span class="LC_warning">'. 3126: &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade', 3127: $section_display, $env{'form.Status'}). 3128: '</span>'; 3129: } 3130: $result.=&show_grading_menu_form($symb); 3131: return $result; 3132: } 3133: 3134: #--- call by previous routine to display each student 3135: sub viewstudentgrade { 3136: my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_; 3137: my ($uname,$udom) = split(/:/,$student); 3138: my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); 3139: my %aggregates = (); 3140: my $result='<tr bgcolor="#ffffdd"><td align="right">'. 3141: '<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'. 3142: "\n".$ctr.' </td><td> '. 3143: '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. 3144: '\');" target="_self">'.$fullname.'</a> '. 3145: '<span class="LC_internal_info">('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')</span></td>'."\n"; 3146: $student=~s/:/_/; # colon doen't work in javascript for names 3147: foreach my $apart (@$parts) { 3148: my ($part,$type) = &split_part_type($apart); 3149: my $score=$record{"resource.$part.$type"}; 3150: $result.='<td align="center">'; 3151: my ($aggtries,$totaltries); 3152: unless (exists($aggregates{$part})) { 3153: $totaltries = $record{'resource.'.$part.'.tries'}; 3154: 3155: $aggtries = $totaltries; 3156: if ($$last_resets{$part}) { 3157: $aggtries = &get_num_tries(\%record,$$last_resets{$part}, 3158: $part); 3159: } 3160: $result.='<input type="hidden" name="'. 3161: 'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n"; 3162: $result.='<input type="hidden" name="'. 3163: 'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n"; 3164: $aggregates{$part} = 1; 3165: } 3166: if ($type eq 'awarded') { 3167: my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part}); 3168: $result.='<input type="hidden" name="'. 3169: 'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n"; 3170: $result.='<input type="text" name="'. 3171: 'GD_'.$student.'_'.$part.'_awarded" '. 3172: 'onChange="javascript:changeSelect(\''.$part.'\',\''.$student. 3173: '\')" value="'.$pts.'" size="4" /></td>'."\n"; 3174: } elsif ($type eq 'solved') { 3175: my ($status,$foo)=split(/_/,$score,2); 3176: $status = 'nothing' if ($status eq ''); 3177: $result.='<input type="hidden" name="'.'GD_'.$student.'_'. 3178: $part.'_solved_s" value="'.$status.'" />'."\n"; 3179: $result.=' <select name="'. 3180: 'GD_'.$student.'_'.$part.'_solved" '. 3181: 'onChange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n"; 3182: $result.= (($status eq 'excused') ? '<option> </option><option selected="selected">excused</option>' 3183: : '<option selected="selected"> </option><option>excused</option>')."\n"; 3184: $result.='<option>reset status</option>'; 3185: $result.="</select> </td>\n"; 3186: } else { 3187: $result.='<input type="hidden" name="'. 3188: 'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'. 3189: "\n"; 3190: $result.='<input type="text" name="'. 3191: 'GD_'.$student.'_'.$part.'_'.$type.'" '. 3192: 'value="'.$score.'" size="4" /></td>'."\n"; 3193: } 3194: } 3195: $result.='</tr>'; 3196: return $result; 3197: } 3198: 3199: #--- change scores for all the students in a section/class 3200: # record does not get update if unchanged 3201: sub editgrades { 3202: my ($request) = @_; 3203: 3204: my $symb=&get_symb($request); 3205: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3206: my $title='<h3><span class="LC_info">'.&mt('Current Grade Status').'</span></h3>'; 3207: $title.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4><br />'."\n"; 3208: $title.='<h4>'.&mt('<b>Section: </b>[_1]',$section_display).'</h4>'."\n"; 3209: 3210: my $result= '<table border="0"><tr><td bgcolor="#777777">'."\n"; 3211: $result.= '<table border="0"><tr bgcolor="#deffff">'. 3212: '<td rowspan=2 valign="center"> <b>No.</b> </td>'. 3213: '<td rowspan=2 valign="center">'.&nameUserString('header')."</td>\n"; 3214: 3215: my %scoreptr = ( 3216: 'correct' =>'correct_by_override', 3217: 'incorrect'=>'incorrect_by_override', 3218: 'excused' =>'excused', 3219: 'ungraded' =>'ungraded_attempted', 3220: 'nothing' => '', 3221: ); 3222: my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0'); 3223: 3224: my (@partid); 3225: my %weight = (); 3226: my %columns = (); 3227: my ($i,$ctr,$count,$rec_update) = (0,0,0,0); 3228: 3229: my (@parts) = sort(&getpartlist($symb)); 3230: my $header; 3231: while ($ctr < $env{'form.totalparts'}) { 3232: my $partid = $env{'form.partid_'.$ctr}; 3233: push @partid,$partid; 3234: $weight{$partid} = $env{'form.weight_'.$partid}; 3235: $ctr++; 3236: } 3237: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 3238: foreach my $partid (@partid) { 3239: $header .= '<td align="center"> <b>Old Score</b> </td>'. 3240: '<td align="center"> <b>New Score</b> </td>'; 3241: $columns{$partid}=2; 3242: foreach my $stores (@parts) { 3243: my ($part,$type) = &split_part_type($stores); 3244: if ($part !~ m/^\Q$partid\E/) { next;} 3245: if ($type eq 'awarded' || $type eq 'solved') { next; } 3246: my $display=&Apache::lonnet::metadata($url,$stores.'.display'); 3247: $display =~ s/\[Part: (\w)+\]//; 3248: $display =~ s/Number of Attempts/Tries/; 3249: $header .= '<td align="center"> <b>Old '.$display.'</b> </td>'. 3250: '<td align="center"> <b>New '.$display.'</b> </td>'; 3251: $columns{$partid}+=2; 3252: } 3253: } 3254: foreach my $partid (@partid) { 3255: my $display_part=&get_display_part($partid,$symb); 3256: $result .= '<td colspan="'.$columns{$partid}. 3257: '" align="center"><b>Part:</b> '.$display_part. 3258: ' (Weight = '.$weight{$partid}.')</td>'; 3259: 3260: } 3261: $result .= '</tr><tr bgcolor="#deffff">'; 3262: $result .= $header; 3263: $result .= '</tr>'."\n"; 3264: my $noupdate; 3265: my ($updateCtr,$noupdateCtr) = (1,1); 3266: for ($i=0; $i<$env{'form.total'}; $i++) { 3267: my $line; 3268: my $user = $env{'form.ctr'.$i}; 3269: my ($uname,$udom)=split(/:/,$user); 3270: my %newrecord; 3271: my $updateflag = 0; 3272: $line .= '<td>'.&nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>'; 3273: my $usec=$classlist->{"$uname:$udom"}[5]; 3274: if (!&canmodify($usec)) { 3275: my $numcols=scalar(@partid)*4+2; 3276: $noupdate.=$line."<td colspan=\"$numcols\"><span class=\"LC_warning\">Not allowed to modify student</span></td></tr>"; 3277: next; 3278: } 3279: my %aggregate = (); 3280: my $aggregateflag = 0; 3281: $user=~s/:/_/; # colon doen't work in javascript for names 3282: foreach (@partid) { 3283: my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'}; 3284: my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1); 3285: my $old_part = $old_aw eq '' ? '' : $old_part_pcr; 3286: my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; 3287: my $awarded = $env{'form.GD_'.$user.'_'.$_.'_awarded'}; 3288: my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1); 3289: my $partial = $awarded eq '' ? '' : $pcr; 3290: my $score; 3291: if ($partial eq '') { 3292: $score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; 3293: } elsif ($partial > 0) { 3294: $score = 'correct_by_override'; 3295: } elsif ($partial == 0) { 3296: $score = 'incorrect_by_override'; 3297: } 3298: my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'}; 3299: $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused')); 3300: 3301: $newrecord{'resource.'.$_.'.regrader'}= 3302: "$env{'user.name'}:$env{'user.domain'}"; 3303: if ($dropMenu eq 'reset status' && 3304: $old_score ne '') { # ignore if no previous attempts => nothing to reset 3305: $newrecord{'resource.'.$_.'.tries'} = ''; 3306: $newrecord{'resource.'.$_.'.solved'} = ''; 3307: $newrecord{'resource.'.$_.'.award'} = ''; 3308: $newrecord{'resource.'.$_.'.awarded'} = ''; 3309: $updateflag = 1; 3310: if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) { 3311: my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'}; 3312: my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'}; 3313: my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'}; 3314: &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus); 3315: $aggregateflag = 1; 3316: } 3317: } elsif (!($old_part eq $partial && $old_score eq $score)) { 3318: $updateflag = 1; 3319: $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; 3320: $newrecord{'resource.'.$_.'.solved'} = $score; 3321: $rec_update++; 3322: } 3323: 3324: $line .= '<td align="center">'.$old_aw.' </td>'. 3325: '<td align="center">'.$awarded. 3326: ($score eq 'excused' ? $score : '').' </td>'; 3327: 3328: 3329: my $partid=$_; 3330: foreach my $stores (@parts) { 3331: my ($part,$type) = &split_part_type($stores); 3332: if ($part !~ m/^\Q$partid\E/) { next;} 3333: if ($type eq 'awarded' || $type eq 'solved') { next; } 3334: my $old_aw = $env{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'}; 3335: my $awarded = $env{'form.GD_'.$user.'_'.$part.'_'.$type}; 3336: if ($awarded ne '' && $awarded ne $old_aw) { 3337: $newrecord{'resource.'.$part.'.'.$type}= $awarded; 3338: $newrecord{'resource.'.$part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; 3339: $updateflag=1; 3340: } 3341: $line .= '<td align="center">'.$old_aw.' </td>'. 3342: '<td align="center">'.$awarded.' </td>'; 3343: } 3344: } 3345: $line.='</tr>'."\n"; 3346: 3347: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 3348: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 3349: 3350: if ($updateflag) { 3351: $count++; 3352: &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'}, 3353: $udom,$uname); 3354: 3355: if (&Apache::bridgetask::in_queue('gradingqueue',$symb,$cdom, 3356: $cnum,$udom,$uname)) { 3357: # need to figure out if should be in queue. 3358: my %record = 3359: &Apache::lonnet::restore($symb,$env{'request.course.id'}, 3360: $udom,$uname); 3361: my $all_graded = 1; 3362: my $none_graded = 1; 3363: foreach my $part (@parts) { 3364: if ( $record{'resource.'.$part.'.awarded'} eq '' ) { 3365: $all_graded = 0; 3366: } else { 3367: $none_graded = 0; 3368: } 3369: } 3370: 3371: if ($all_graded || $none_graded) { 3372: &Apache::bridgetask::remove_from_queue('gradingqueue', 3373: $symb,$cdom,$cnum, 3374: $udom,$uname); 3375: } 3376: } 3377: 3378: $result.='<tr bgcolor="#ffffde"><td align="right"> '.$updateCtr.' </td>'.$line; 3379: $updateCtr++; 3380: } else { 3381: $noupdate.='<tr bgcolor="#ffffde"><td align="right"> '.$noupdateCtr.' </td>'.$line; 3382: $noupdateCtr++; 3383: } 3384: if ($aggregateflag) { 3385: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 3386: $cdom,$cnum); 3387: } 3388: } 3389: if ($noupdate) { 3390: # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; 3391: my $numcols=scalar(@partid)*4+2; 3392: $result .= '<tr bgcolor="#ffffff"><td align="center" colspan="'.$numcols.'">No Changes Occurred For the Students Below</td></tr><tr bgcolor="#ffffde">'.$noupdate; 3393: } 3394: $result .= '</table></td></tr></table>'."\n". 3395: &show_grading_menu_form ($symb); 3396: my $msg = '<br /><b>Number of records updated = '.$rec_update. 3397: ' for '.$count.' student'.($count <= 1 ? '' : 's').'.</b><br />'. 3398: '<b>Total number of students = '.$env{'form.total'}.'</b><br />'; 3399: return $title.$msg.$result; 3400: } 3401: 3402: sub split_part_type { 3403: my ($partstr) = @_; 3404: my ($temp,@allparts)=split(/_/,$partstr); 3405: my $type=pop(@allparts); 3406: my $part=join('_',@allparts); 3407: return ($part,$type); 3408: } 3409: 3410: #------------- end of section for handling grading by section/class --------- 3411: # 3412: #---------------------------------------------------------------------------- 3413: 3414: 3415: #---------------------------------------------------------------------------- 3416: # 3417: #-------------------------- Next few routines handles grading by csv upload 3418: # 3419: #--- Javascript to handle csv upload 3420: sub csvupload_javascript_reverse_associate { 3421: my $error1=&mt('You need to specify the username or ID'); 3422: my $error2=&mt('You need to specify at least one grading field'); 3423: return(<<ENDPICK); 3424: function verify(vf) { 3425: var foundsomething=0; 3426: var founduname=0; 3427: var foundID=0; 3428: for (i=0;i<=vf.nfields.value;i++) { 3429: tw=eval('vf.f'+i+'.selectedIndex'); 3430: if (i==0 && tw!=0) { foundID=1; } 3431: if (i==1 && tw!=0) { founduname=1; } 3432: if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; } 3433: } 3434: if (founduname==0 && foundID==0) { 3435: alert('$error1'); 3436: return; 3437: } 3438: if (foundsomething==0) { 3439: alert('$error2'); 3440: return; 3441: } 3442: vf.submit(); 3443: } 3444: function flip(vf,tf) { 3445: var nw=eval('vf.f'+tf+'.selectedIndex'); 3446: var i; 3447: for (i=0;i<=vf.nfields.value;i++) { 3448: //can not pick the same destination field for both name and domain 3449: if (((i ==0)||(i ==1)) && 3450: ((tf==0)||(tf==1)) && 3451: (i!=tf) && 3452: (eval('vf.f'+i+'.selectedIndex')==nw)) { 3453: eval('vf.f'+i+'.selectedIndex=0;') 3454: } 3455: } 3456: } 3457: ENDPICK 3458: } 3459: 3460: sub csvupload_javascript_forward_associate { 3461: my $error1=&mt('You need to specify the username or ID'); 3462: my $error2=&mt('You need to specify at least one grading field'); 3463: return(<<ENDPICK); 3464: function verify(vf) { 3465: var foundsomething=0; 3466: var founduname=0; 3467: var foundID=0; 3468: for (i=0;i<=vf.nfields.value;i++) { 3469: tw=eval('vf.f'+i+'.selectedIndex'); 3470: if (tw==1) { foundID=1; } 3471: if (tw==2) { founduname=1; } 3472: if (tw>3) { foundsomething=1; } 3473: } 3474: if (founduname==0 && foundID==0) { 3475: alert('$error1'); 3476: return; 3477: } 3478: if (foundsomething==0) { 3479: alert('$error2'); 3480: return; 3481: } 3482: vf.submit(); 3483: } 3484: function flip(vf,tf) { 3485: var nw=eval('vf.f'+tf+'.selectedIndex'); 3486: var i; 3487: //can not pick the same destination field twice 3488: for (i=0;i<=vf.nfields.value;i++) { 3489: if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) { 3490: eval('vf.f'+i+'.selectedIndex=0;') 3491: } 3492: } 3493: } 3494: ENDPICK 3495: } 3496: 3497: sub csvuploadmap_header { 3498: my ($request,$symb,$datatoken,$distotal)= @_; 3499: my $javascript; 3500: if ($env{'form.upfile_associate'} eq 'reverse') { 3501: $javascript=&csvupload_javascript_reverse_associate(); 3502: } else { 3503: $javascript=&csvupload_javascript_forward_associate(); 3504: } 3505: 3506: my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); 3507: my $checked=(($env{'form.noFirstLine'})?' checked="checked"':''); 3508: my $ignore=&mt('Ignore First Line'); 3509: $symb = &Apache::lonenc::check_encrypt($symb); 3510: $request->print(<<ENDPICK); 3511: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 3512: <h3><span class="LC_info">Uploading Class Grades</span></h3> 3513: $result 3514: <hr /> 3515: <h3>Identify fields</h3> 3516: Total number of records found in file: $distotal <hr /> 3517: Enter as many fields as you can. The system will inform you and bring you back 3518: to this page if the data selected is insufficient to run your class.<hr /> 3519: <input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" /> 3520: <label><input type="checkbox" name="noFirstLine" $checked />$ignore</label> 3521: <input type="hidden" name="associate" value="" /> 3522: <input type="hidden" name="phase" value="three" /> 3523: <input type="hidden" name="datatoken" value="$datatoken" /> 3524: <input type="hidden" name="fileupload" value="$env{'form.fileupload'}" /> 3525: <input type="hidden" name="upfiletype" value="$env{'form.upfiletype'}" /> 3526: <input type="hidden" name="upfile_associate" 3527: value="$env{'form.upfile_associate'}" /> 3528: <input type="hidden" name="symb" value="$symb" /> 3529: <input type="hidden" name="saveState" value="$env{'form.saveState'}" /> 3530: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" /> 3531: <input type="hidden" name="command" value="csvuploadoptions" /> 3532: <hr /> 3533: <script type="text/javascript" language="Javascript"> 3534: $javascript 3535: </script> 3536: ENDPICK 3537: return ''; 3538: 3539: } 3540: 3541: sub csvupload_fields { 3542: my ($symb) = @_; 3543: my (@parts) = &getpartlist($symb); 3544: my @fields=(['ID','Student ID'], 3545: ['username','Student Username'], 3546: ['domain','Student Domain']); 3547: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 3548: foreach my $part (sort(@parts)) { 3549: my @datum; 3550: my $display=&Apache::lonnet::metadata($url,$part.'.display'); 3551: my $name=$part; 3552: if (!$display) { $display = $name; } 3553: @datum=($name,$display); 3554: if ($name=~/^stores_(.*)_awarded/) { 3555: push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]); 3556: } 3557: push(@fields,\@datum); 3558: } 3559: return (@fields); 3560: } 3561: 3562: sub csvuploadmap_footer { 3563: my ($request,$i,$keyfields) =@_; 3564: $request->print(<<ENDPICK); 3565: </table> 3566: <input type="hidden" name="nfields" value="$i" /> 3567: <input type="hidden" name="keyfields" value="$keyfields" /> 3568: <input type="button" onClick="javascript:verify(this.form)" value="Assign Grades" /><br /> 3569: </form> 3570: ENDPICK 3571: } 3572: 3573: sub checkforfile_js { 3574: my $result =<<CSVFORMJS; 3575: <script type="text/javascript" language="javascript"> 3576: function checkUpload(formname) { 3577: if (formname.upfile.value == "") { 3578: alert("Please use the browse button to select a file from your local directory."); 3579: return false; 3580: } 3581: formname.submit(); 3582: } 3583: </script> 3584: CSVFORMJS 3585: return $result; 3586: } 3587: 3588: sub upcsvScores_form { 3589: my ($request) = shift; 3590: my ($symb)=&get_symb($request); 3591: if (!$symb) {return '';} 3592: my $result=&checkforfile_js(); 3593: $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb); 3594: my ($table) = &showResourceInfo($symb,$env{'form.probTitle'}); 3595: $result.=$table; 3596: $result.='<br /><table width="100%" border="0"><tr><td bgcolor="#777777">'."\n"; 3597: $result.='<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>'."\n"; 3598: $result.=' <b>'.&mt('Specify a file containing the class scores for current resource'). 3599: '.</b></td></tr>'."\n"; 3600: $result.='<tr bgcolor=#ffffe6><td>'."\n"; 3601: my $upload=&mt("Upload Scores"); 3602: my $upfile_select=&Apache::loncommon::upfile_select_html(); 3603: my $ignore=&mt('Ignore First Line'); 3604: $symb = &Apache::lonenc::check_encrypt($symb); 3605: $result.=<<ENDUPFORM; 3606: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 3607: <input type="hidden" name="symb" value="$symb" /> 3608: <input type="hidden" name="command" value="csvuploadmap" /> 3609: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" /> 3610: <input type="hidden" name="saveState" value="$env{'form.saveState'}" /> 3611: $upfile_select 3612: <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="$upload" /> 3613: <label><input type="checkbox" name="noFirstLine" />$ignore</label> 3614: </form> 3615: ENDUPFORM 3616: $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV", 3617: &mt("How do I create a CSV file from a spreadsheet")) 3618: .'</td></tr></table>'."\n"; 3619: $result.='</td></tr></table><br /><br />'."\n"; 3620: $result.=&show_grading_menu_form($symb); 3621: return $result; 3622: } 3623: 3624: 3625: sub csvuploadmap { 3626: my ($request)= @_; 3627: my ($symb)=&get_symb($request); 3628: if (!$symb) {return '';} 3629: 3630: my $datatoken; 3631: if (!$env{'form.datatoken'}) { 3632: $datatoken=&Apache::loncommon::upfile_store($request); 3633: } else { 3634: $datatoken=$env{'form.datatoken'}; 3635: &Apache::loncommon::load_tmp_file($request); 3636: } 3637: my @records=&Apache::loncommon::upfile_record_sep(); 3638: if ($env{'form.noFirstLine'}) { shift(@records); } 3639: &csvuploadmap_header($request,$symb,$datatoken,$#records+1); 3640: my ($i,$keyfields); 3641: if (@records) { 3642: my @fields=&csvupload_fields($symb); 3643: 3644: if ($env{'form.upfile_associate'} eq 'reverse') { 3645: &Apache::loncommon::csv_print_samples($request,\@records); 3646: $i=&Apache::loncommon::csv_print_select_table($request,\@records, 3647: \@fields); 3648: foreach (@fields) { $keyfields.=$_->[0].','; } 3649: chop($keyfields); 3650: } else { 3651: unshift(@fields,['none','']); 3652: $i=&Apache::loncommon::csv_samples_select_table($request,\@records, 3653: \@fields); 3654: foreach my $rec (@records) { 3655: my %temp = &Apache::loncommon::record_sep($rec); 3656: if (%temp) { 3657: $keyfields=join(',',sort(keys(%temp))); 3658: last; 3659: } 3660: } 3661: } 3662: } 3663: &csvuploadmap_footer($request,$i,$keyfields); 3664: $request->print(&show_grading_menu_form($symb)); 3665: 3666: return ''; 3667: } 3668: 3669: sub csvuploadoptions { 3670: my ($request)= @_; 3671: my ($symb)=&get_symb($request); 3672: my $checked=(($env{'form.noFirstLine'})?'1':'0'); 3673: my $ignore=&mt('Ignore First Line'); 3674: $request->print(<<ENDPICK); 3675: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 3676: <h3><span class="LC_info">Uploading Class Grade Options</span></h3> 3677: <input type="hidden" name="command" value="csvuploadassign" /> 3678:  3686: <p> 3687: <label> 3688: <input type="checkbox" name="overwite_scores" checked="checked" /> 3689: Overwrite any existing score 3690: </label> 3691: </p> 3692: ENDPICK 3693: my %fields=&get_fields(); 3694: if (!defined($fields{'domain'})) { 3695: my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); 3696: $request->print("\n<p> Users are in domain: ".$domform."</p>\n"); 3697: } 3698: foreach my $key (sort(keys(%env))) { 3699: if ($key !~ /^form\.(.*)$/) { next; } 3700: my $cleankey=$1; 3701: if ($cleankey eq 'command') { next; } 3702: $request->print('<input type="hidden" name="'.$cleankey. 3703: '" value="'.$env{$key}.'" />'."\n"); 3704: } 3705: # FIXME do a check for any duplicated user ids... 3706: # FIXME do a check for any invalid user ids?... 3707: $request->print('<input type="submit" value="Assign Grades" /><br /> 3708: <hr /></form>'."\n"); 3709: $request->print(&show_grading_menu_form($symb)); 3710: return ''; 3711: } 3712: 3713: sub get_fields { 3714: my %fields; 3715: my @keyfields = split(/\,/,$env{'form.keyfields'}); 3716: for (my $i=0; $i<=$env{'form.nfields'}; $i++) { 3717: if ($env{'form.upfile_associate'} eq 'reverse') { 3718: if ($env{'form.f'.$i} ne 'none') { 3719: $fields{$keyfields[$i]}=$env{'form.f'.$i}; 3720: } 3721: } else { 3722: if ($env{'form.f'.$i} ne 'none') { 3723: $fields{$env{'form.f'.$i}}=$keyfields[$i]; 3724: } 3725: } 3726: } 3727: return %fields; 3728: } 3729: 3730: sub csvuploadassign { 3731: my ($request)= @_; 3732: my ($symb)=&get_symb($request); 3733: if (!$symb) {return '';} 3734: my $error_msg = ''; 3735: &Apache::loncommon::load_tmp_file($request); 3736: my @gradedata = &Apache::loncommon::upfile_record_sep(); 3737: if ($env{'form.noFirstLine'}) { shift(@gradedata); } 3738: my %fields=&get_fields(); 3739: $request->print('<h3>Assigning Grades</h3>'); 3740: my $courseid=$env{'request.course.id'}; 3741: my ($classlist) = &getclasslist('all',0); 3742: my @notallowed; 3743: my @skipped; 3744: my $countdone=0; 3745: foreach my $grade (@gradedata) { 3746: my %entries=&Apache::loncommon::record_sep($grade); 3747: my $domain; 3748: if ($entries{$fields{'domain'}}) { 3749: $domain=$entries{$fields{'domain'}}; 3750: } else { 3751: $domain=$env{'form.default_domain'}; 3752: } 3753: $domain=~s/\s//g; 3754: my $username=$entries{$fields{'username'}}; 3755: $username=~s/\s//g; 3756: if (!$username) { 3757: my $id=$entries{$fields{'ID'}}; 3758: $id=~s/\s//g; 3759: my %ids=&Apache::lonnet::idget($domain,$id); 3760: $username=$ids{$id}; 3761: } 3762: if (!exists($$classlist{"$username:$domain"})) { 3763: my $id=$entries{$fields{'ID'}}; 3764: $id=~s/\s//g; 3765: if ($id) { 3766: push(@skipped,"$id:$domain"); 3767: } else { 3768: push(@skipped,"$username:$domain"); 3769: } 3770: next; 3771: } 3772: my $usec=$classlist->{"$username:$domain"}[5]; 3773: if (!&canmodify($usec)) { 3774: push(@notallowed,"$username:$domain"); 3775: next; 3776: } 3777: my %points; 3778: my %grades; 3779: foreach my $dest (keys(%fields)) { 3780: if ($dest eq 'ID' || $dest eq 'username' || 3781: $dest eq 'domain') { next; } 3782: if ($entries{$fields{$dest}} =~ /^\s*$/) { next; } 3783: if ($dest=~/stores_(.*)_points/) { 3784: my $part=$1; 3785: my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', 3786: $symb,$domain,$username); 3787: if ($wgt) { 3788: $entries{$fields{$dest}}=~s/\s//g; 3789: my $pcr=$entries{$fields{$dest}} / $wgt; 3790: my $award='correct_by_override'; 3791: $grades{"resource.$part.awarded"}=$pcr; 3792: $grades{"resource.$part.solved"}=$award; 3793: $points{$part}=1; 3794: } else { 3795: $error_msg = "<br />" . 3796: &mt("Some point values were assigned" 3797: ." for problems with a weight " 3798: ."of zero. These values were " 3799: ."ignored."); 3800: } 3801: } else { 3802: if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } 3803: if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } 3804: my $store_key=$dest; 3805: $store_key=~s/^stores/resource/; 3806: $store_key=~s/_/\./g; 3807: $grades{$store_key}=$entries{$fields{$dest}}; 3808: } 3809: } 3810: if (! %grades) { push(@skipped,"$username:$domain no data to save"); } 3811: $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; 3812: # &Apache::lonnet::logthis(" storing ".(join('-',%grades))); 3813: my $result=&Apache::lonnet::cstore(\%grades,$symb, 3814: $env{'request.course.id'}, 3815: $domain,$username); 3816: if ($result eq 'ok') { 3817: $request->print('.'); 3818: } else { 3819: $request->print("<p> 3820: <span class=\"LC_error\"> 3821: Failed to save student $username:$domain. 3822: Message when trying to save was ($result) 3823: </span> 3824: </p>" ); 3825: } 3826: $request->rflush(); 3827: $countdone++; 3828: } 3829: $request->print("<br />Saved $countdone students\n"); 3830: if (@skipped) { 3831: $request->print('<p><h4><b>Skipped Students</b></h4></p>'); 3832: foreach my $student (@skipped) { $request->print("$student<br />\n"); } 3833: } 3834: if (@notallowed) { 3835: $request->print('<p><span class="LC_error">Students Not Allowed to Modify</span></p>'); 3836: foreach my $student (@notallowed) { $request->print("$student<br />\n"); } 3837: } 3838: $request->print("<br />\n"); 3839: $request->print(&show_grading_menu_form($symb)); 3840: return $error_msg; 3841: } 3842: #------------- end of section for handling csv file upload --------- 3843: # 3844: #------------------------------------------------------------------- 3845: # 3846: #-------------- Next few routines handle grading by page/sequence 3847: # 3848: #--- Select a page/sequence and a student to grade 3849: sub pickStudentPage { 3850: my ($request) = shift; 3851: 3852: $request->print(<<LISTJAVASCRIPT); 3853: <script type="text/javascript" language="javascript"> 3854: 3855: function checkPickOne(formname) { 3856: if (radioSelection(formname.student) == null) { 3857: alert("Please select the student you wish to grade."); 3858: return; 3859: } 3860: ptr = pullDownSelection(formname.selectpage); 3861: formname.page.value = formname["page"+ptr].value; 3862: formname.title.value = formname["title"+ptr].value; 3863: formname.submit(); 3864: } 3865: 3866: </script> 3867: LISTJAVASCRIPT 3868: &commonJSfunctions($request); 3869: my ($symb) = &get_symb($request); 3870: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 3871: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 3872: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 3873: 3874: my $result='<h3><span class="LC_info"> '. 3875: 'Manual Grading by Page or Sequence</span></h3>'; 3876: 3877: $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n"; 3878: $result.=' <b>Problems from:</b> <select name="selectpage">'."\n"; 3879: my ($titles,$symbx) = &getSymbMap(); 3880: my ($curpage) =&Apache::lonnet::decode_symb($symb); 3881: # my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 3882: # my $type=($curpage =~ /\.(page|sequence)/); 3883: my $ctr=0; 3884: foreach (@$titles) { 3885: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 3886: $result.='<option value="'.$ctr.'" '. 3887: ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : ''). 3888: '>'.$showtitle.'</option>'."\n"; 3889: $ctr++; 3890: } 3891: $result.= '</select>'."<br />\n"; 3892: $ctr=0; 3893: foreach (@$titles) { 3894: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 3895: $result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n"; 3896: $result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n"; 3897: $ctr++; 3898: } 3899: $result.='<input type="hidden" name="page" />'."\n". 3900: '<input type="hidden" name="title" />'."\n"; 3901: 3902: $result.=' <b>View Problems Text: </b><label><input type="radio" name="vProb" value="no" checked="checked" /> no </label>'."\n". 3903: '<label><input type="radio" name="vProb" value="yes" /> yes </label>'."<br />\n"; 3904: 3905: $result.=' <b>Submission Details: </b>'. 3906: '<label><input type="radio" name="lastSub" value="none" /> none</label>'."\n". 3907: '<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> by dates and submissions</label>'."\n". 3908: '<label><input type="radio" name="lastSub" value="all" /> all details</label>'."\n"; 3909: 3910: $result.=&build_section_inputs(); 3911: $result.='<input type="hidden" name="Status" value="'.$env{'form.Status'}.'" />'."\n". 3912: '<input type="hidden" name="command" value="displayPage" />'."\n". 3913: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 3914: '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."<br />\n"; 3915: 3916: $result.=' <b>'.&mt('Use CODE:').' </b>'. 3917: '<input type="text" name="CODE" value="" /><br />'."\n"; 3918: 3919: $result.=' <input type="button" '. 3920: 'onClick="javascript:checkPickOne(this.form);"value="Next->" /><br />'."\n"; 3921: 3922: $request->print($result); 3923: 3924: my $studentTable.=' <b>Select a student you wish to grade and then click on the Next button.</b><br />'. 3925: '<table border="0"><tr><td bgcolor="#777777">'. 3926: '<table border="0"><tr bgcolor="#e6ffff">'. 3927: '<td align="right"> <b>No.</b></td>'. 3928: '<td>'.&nameUserString('header').'</td>'. 3929: '<td align="right"> <b>No.</b></td>'. 3930: '<td>'.&nameUserString('header').'</td></tr>'; 3931: 3932: my (undef,undef,$fullname) = &getclasslist($getsec,'1'); 3933: my $ptr = 1; 3934: foreach my $student (sort 3935: { 3936: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 3937: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 3938: } 3939: return $a cmp $b; 3940: } (keys(%$fullname))) { 3941: my ($uname,$udom) = split(/:/,$student); 3942: $studentTable.=($ptr%2 == 1 ? '<tr bgcolor="#ffffe6">' : '</td>'); 3943: $studentTable.='<td align="right">'.$ptr.' </td>'; 3944: $studentTable.='<td> <label><input type="radio" name="student" value="'.$student.'" /> ' 3945: .&nameUserString(undef,$$fullname{$student},$uname,$udom)."</label>\n"; 3946: $studentTable.=($ptr%2 == 0 ? '</td></tr>' : ''); 3947: $ptr++; 3948: } 3949: $studentTable.='</td><td> </td><td> </td></tr>' if ($ptr%2 == 0); 3950: $studentTable.='</table></td></tr></table>'."\n"; 3951: $studentTable.='<input type="button" '. 3952: 'onClick="javascript:checkPickOne(this.form);"value="Next->" /></form>'."\n"; 3953: 3954: $studentTable.=&show_grading_menu_form($symb); 3955: $request->print($studentTable); 3956: 3957: return ''; 3958: } 3959: 3960: sub getSymbMap { 3961: my $navmap = Apache::lonnavmaps::navmap->new(); 3962: 3963: my %symbx = (); 3964: my @titles = (); 3965: my $minder = 0; 3966: 3967: # Gather every sequence that has problems. 3968: my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 3969: 1,0,1); 3970: for my $sequence ($navmap->getById('0.0'), @sequences) { 3971: if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { 3972: my $title = $minder.'.'. 3973: &HTML::Entities::encode($sequence->compTitle(),'"\'&'); 3974: push(@titles, $title); # minder in case two titles are identical 3975: $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); 3976: $minder++; 3977: } 3978: } 3979: return \@titles,\%symbx; 3980: } 3981: 3982: # 3983: #--- Displays a page/sequence w/wo problems, w/wo submissions 3984: sub displayPage { 3985: my ($request) = shift; 3986: 3987: my ($symb) = &get_symb($request); 3988: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 3989: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 3990: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 3991: my $pageTitle = $env{'form.page'}; 3992: my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); 3993: my ($uname,$udom) = split(/:/,$env{'form.student'}); 3994: my $usec=$classlist->{$env{'form.student'}}[5]; 3995: 3996: #need to make sure we have the correct data for later EXT calls, 3997: #thus invalidate the cache 3998: &Apache::lonnet::devalidatecourseresdata( 3999: $env{'course.'.$env{'request.course.id'}.'.num'}, 4000: $env{'course.'.$env{'request.course.id'}.'.domain'}); 4001: &Apache::lonnet::clear_EXT_cache_status(); 4002: 4003: if (!&canview($usec)) { 4004: $request->print('<span class="LC_warning">Unable to view requested student.('.$env{'form.student'}.')</span>'); 4005: $request->print(&show_grading_menu_form($symb)); 4006: return; 4007: } 4008: my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; 4009: $result.='<h3> Student: '.&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom). 4010: '</h3>'."\n"; 4011: if (&Apache::lonnet::validCODE($env{'form.CODE'})) { 4012: $result.='<h3> CODE: '.$env{'form.CODE'}.'</h3>'."\n"; 4013: } else { 4014: delete($env{'form.CODE'}); 4015: } 4016: &sub_page_js($request); 4017: $request->print($result); 4018: 4019: my $navmap = Apache::lonnavmaps::navmap->new(); 4020: my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'}); 4021: my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps 4022: if (!$map) { 4023: $request->print('<span class="LC_warning">Unable to view requested sequence. ('.$resUrl.')</span>'); 4024: $request->print(&show_grading_menu_form($symb)); 4025: return; 4026: } 4027: my $iterator = $navmap->getIterator($map->map_start(), 4028: $map->map_finish()); 4029: 4030: my $studentTable='<form action="/adm/grades" method="post" name="gradePage">'."\n". 4031: '<input type="hidden" name="command" value="gradeByPage" />'."\n". 4032: '<input type="hidden" name="fullname" value="'.$$fullname{$env{'form.student'}}.'" />'."\n". 4033: '<input type="hidden" name="student" value="'.$env{'form.student'}.'" />'."\n". 4034: '<input type="hidden" name="page" value="'.$pageTitle.'" />'."\n". 4035: '<input type="hidden" name="title" value="'.$env{'form.title'}.'" />'."\n". 4036: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 4037: '<input type="hidden" name="overRideScore" value="no" />'."\n". 4038: '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n"; 4039: 4040: if (defined($env{'form.CODE'})) { 4041: $studentTable.= 4042: '<input type="hidden" name="CODE" value="'.$env{'form.CODE'}.'" />'."\n"; 4043: } 4044: my $checkIcon = '<img alt="'.&mt('Check Mark'). 4045: '" src="'.$request->dir_config('lonIconsURL'). 4046: '/check.gif" height="16" border="0" />'; 4047: 4048: $studentTable.=' <b>Note:</b> Problems graded correct by the computer are marked with a '.$checkIcon. 4049: ' symbol.'."\n". 4050: '<table border="0"><tr><td bgcolor="#777777">'. 4051: '<table border="0"><tr bgcolor="#e6ffff">'. 4052: '<td align="center"><b> Prob. </b></td>'. 4053: '<td><b> '.($env{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade</b></td></tr>'; 4054: 4055: &Apache::lonxml::clear_problem_counter(); 4056: my ($depth,$question,$prob) = (1,1,1); 4057: $iterator->next(); # skip the first BEGIN_MAP 4058: my $curRes = $iterator->next(); # for "current resource" 4059: while ($depth > 0) { 4060: if($curRes == $iterator->BEGIN_MAP) { $depth++; } 4061: if($curRes == $iterator->END_MAP) { $depth--; } 4062: 4063: if (ref($curRes) && $curRes->is_problem()) { 4064: my $parts = $curRes->parts(); 4065: my $title = $curRes->compTitle(); 4066: my $symbx = $curRes->symb(); 4067: $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$prob. 4068: (scalar(@{$parts}) == 1 ? '' : '<br />('.scalar(@{$parts}).' parts)').'</td>'; 4069: $studentTable.='<td valign="top">'; 4070: my %form = ('CODE' => $env{'form.CODE'},); 4071: if ($env{'form.vProb'} eq 'yes' ) { 4072: $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, 4073: undef,'both',\%form); 4074: } else { 4075: my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form); 4076: $companswer =~ s|<form(.*?)>||g; 4077: $companswer =~ s|</form>||g; 4078: # while ($companswer =~ /(<a href\=\"javascript:newWindow.*?Script Vars<\/a>)/s) { #<a href="javascript:newWindow</a> 4079: # $companswer =~ s/$1/ /ms; 4080: # $request->print('match='.$1."<br />\n"); 4081: # } 4082: # $companswer =~ s|<table border=\"1\">|<table border=\"0\">|g; 4083: $studentTable.=' <b>'.$title.'</b> <br /> <b>Correct answer:</b><br />'.$companswer; 4084: } 4085: 4086: my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); 4087: 4088: if ($env{'form.lastSub'} eq 'datesub') { 4089: if ($record{'version'} eq '') { 4090: $studentTable.='<br /> <span class="LC_warning">No recorded submission for this problem</span><br />'; 4091: } else { 4092: my %responseType = (); 4093: foreach my $partid (@{$parts}) { 4094: my @responseIds =$curRes->responseIds($partid); 4095: my @responseType =$curRes->responseType($partid); 4096: my %responseIds; 4097: for (my $i=0;$i<=$#responseIds;$i++) { 4098: $responseIds{$responseIds[$i]}=$responseType[$i]; 4099: } 4100: $responseType{$partid} = \%responseIds; 4101: } 4102: $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom); 4103: 4104: } 4105: } elsif ($env{'form.lastSub'} eq 'all') { 4106: my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); 4107: $studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom, 4108: $env{'request.course.id'}, 4109: '','.submission'); 4110: 4111: } 4112: if (&canmodify($usec)) { 4113: foreach my $partid (@{$parts}) { 4114: $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record); 4115: $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n"; 4116: $question++; 4117: } 4118: $prob++; 4119: } 4120: $studentTable.='</td></tr>'; 4121: 4122: } 4123: $curRes = $iterator->next(); 4124: } 4125: 4126: $studentTable.='</table></td></tr></table>'."\n". 4127: '<input type="button" value="Save" '. 4128: 'onClick="javascript:checkSubmitPage(this.form,'.$question.');" />'. 4129: '</form>'."\n"; 4130: $studentTable.=&show_grading_menu_form($symb); 4131: $request->print($studentTable); 4132: 4133: return ''; 4134: } 4135: 4136: sub displaySubByDates { 4137: my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; 4138: my $isCODE=0; 4139: my $isTask = ($symb =~/\.task$/); 4140: if (exists($record->{'resource.CODE'})) { $isCODE=1; } 4141: my $studentTable='<table border="0" width="100%"><tr><td bgcolor="#777777">'. 4142: '<table border="0" width="100%"><tr bgcolor="#e6ffff">'. 4143: '<td><b>Date/Time</b></td>'. 4144: ($isCODE?'<td><b>CODE</b></td>':''). 4145: '<td><b>Submission</b></td>'. 4146: '<td><b>Status </b></td></tr>'; 4147: my ($version); 4148: my %mark; 4149: my %orders; 4150: $mark{'correct_by_student'} = $checkIcon; 4151: if (!exists($$record{'1:timestamp'})) { 4152: return '<br /> <span class="LC_warning">Nothing submitted - no attempts</span><br />'; 4153: } 4154: 4155: my $interaction; 4156: for ($version=1;$version<=$$record{'version'};$version++) { 4157: my $timestamp = scalar(localtime($$record{$version.':timestamp'})); 4158: if (exists($$record{$version.':resource.0.version'})) { 4159: $interaction = $$record{$version.':resource.0.version'}; 4160: } 4161: 4162: my $where = ($isTask ? "$version:resource.$interaction" 4163: : "$version:resource"); 4164: #&Apache::lonnet::logthis(" got $where"); 4165: $studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>'; 4166: if ($isCODE) { 4167: $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>'; 4168: } 4169: my @versionKeys = split(/\:/,$$record{$version.':keys'}); 4170: my @displaySub = (); 4171: foreach my $partid (@{$parts}) { 4172: my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys) 4173: : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); 4174: 4175: 4176: # next if ($$record{"$version:resource.$partid.solved"} eq ''); 4177: my $display_part=&get_display_part($partid,$symb); 4178: foreach my $matchKey (@matchKey) { 4179: if (exists($$record{$version.':'.$matchKey}) && 4180: $$record{$version.':'.$matchKey} ne '') { 4181: 4182: my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) 4183: : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); 4184: #&Apache::lonnet::logthis("match $matchKey $responseId (".$$record{$version.':'.$matchKey}); 4185: $displaySub[0].='<b>Part:</b> '.$display_part.' '; 4186: $displaySub[0].='<span class="LC_internal_info">(ID '. 4187: $responseId.')</span> <b>'; 4188: if ($$record{"$where.$partid.tries"} eq '') { 4189: $displaySub[0].='Trial not counted'; 4190: } else { 4191: $displaySub[0].='Trial '. 4192: $$record{"$where.$partid.tries"}; 4193: } 4194: my $responseType=($isTask ? 'Task' 4195: : $responseType->{$partid}->{$responseId}); 4196: if (!exists($orders{$partid})) { $orders{$partid}={}; } 4197: if (!exists($orders{$partid}->{$responseId})) { 4198: $orders{$partid}->{$responseId}= 4199: &get_order($partid,$responseId,$symb,$uname,$udom); 4200: } 4201: $displaySub[0].='</b>  '. 4202: &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'<br />'; 4203: } 4204: } 4205: if (exists($$record{"$where.$partid.checkedin"})) { 4206: $displaySub[1].='Checked in by '. 4207: $$record{"$where.$partid.checkedin"}.' into slot '. 4208: $$record{"$where.$partid.checkedin.slot"}. 4209: '<br />'; 4210: } 4211: if (exists $$record{"$where.$partid.award"}) { 4212: $displaySub[1].='<b>Part:</b> '.$display_part.'  '. 4213: lc($$record{"$where.$partid.award"}).' '. 4214: $mark{$$record{"$where.$partid.solved"}}. 4215: '<br />'; 4216: } 4217: if (exists $$record{"$where.$partid.regrader"}) { 4218: $displaySub[2].=$$record{"$where.$partid.regrader"}. 4219: ' (<b>'.&mt('Part').':</b> '.$display_part.')'; 4220: } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { 4221: $displaySub[2].= 4222: $$record{"$version:resource.$partid.regrader"}. 4223: ' (<b>'.&mt('Part').':</b> '.$display_part.')'; 4224: } 4225: } 4226: # needed because old essay regrader has not parts info 4227: if (exists $$record{"$version:resource.regrader"}) { 4228: $displaySub[2].=$$record{"$version:resource.regrader"}; 4229: } 4230: $studentTable.='<td>'.$displaySub[0].' </td><td>'.$displaySub[1]; 4231: if ($displaySub[2]) { 4232: $studentTable.='Manually graded by '.$displaySub[2]; 4233: } 4234: $studentTable.=' </td></tr>'; 4235: 4236: } 4237: $studentTable.='</table></td></tr></table>'; 4238: return $studentTable; 4239: } 4240: 4241: sub updateGradeByPage { 4242: my ($request) = shift; 4243: 4244: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 4245: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 4246: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 4247: my $pageTitle = $env{'form.page'}; 4248: my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); 4249: my ($uname,$udom) = split(/:/,$env{'form.student'}); 4250: my $usec=$classlist->{$env{'form.student'}}[5]; 4251: if (!&canmodify($usec)) { 4252: $request->print('<span class="LC_warning">Unable to modify requested student.('.$env{'form.student'}.'</span>'); 4253: $request->print(&show_grading_menu_form($env{'form.symb'})); 4254: return; 4255: } 4256: my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; 4257: $result.='<h3> Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom). 4258: '</h3>'."\n"; 4259: 4260: $request->print($result); 4261: 4262: my $navmap = Apache::lonnavmaps::navmap->new(); 4263: my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'}); 4264: my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps 4265: if (!$map) { 4266: $request->print('<span class="LC_warning">Unable to grade requested sequence. ('.$resUrl.')</span>'); 4267: my ($symb)=&get_symb($request); 4268: $request->print(&show_grading_menu_form($symb)); 4269: return; 4270: } 4271: my $iterator = $navmap->getIterator($map->map_start(), 4272: $map->map_finish()); 4273: 4274: my $studentTable='<table border="0"><tr><td bgcolor="#777777">'. 4275: '<table border="0"><tr bgcolor="#e6ffff">'. 4276: '<td align="center"><b> Prob. </b></td>'. 4277: '<td><b> Title </b></td>'. 4278: '<td><b> Previous Score </b></td>'. 4279: '<td><b> New Score </b></td></tr>'; 4280: 4281: $iterator->next(); # skip the first BEGIN_MAP 4282: my $curRes = $iterator->next(); # for "current resource" 4283: my ($depth,$question,$prob,$changeflag)= (1,1,1,0); 4284: while ($depth > 0) { 4285: if($curRes == $iterator->BEGIN_MAP) { $depth++; } 4286: if($curRes == $iterator->END_MAP) { $depth--; } 4287: 4288: if (ref($curRes) && $curRes->is_problem()) { 4289: my $parts = $curRes->parts(); 4290: my $title = $curRes->compTitle(); 4291: my $symbx = $curRes->symb(); 4292: $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$prob. 4293: (scalar(@{$parts}) == 1 ? '' : '<br />('.scalar(@{$parts}).' parts)').'</td>'; 4294: $studentTable.='<td valign="top"> <b>'.$title.'</b> </td>'; 4295: 4296: my %newrecord=(); 4297: my @displayPts=(); 4298: my %aggregate = (); 4299: my $aggregateflag = 0; 4300: foreach my $partid (@{$parts}) { 4301: my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid}; 4302: my $oldpts = $env{'form.oldpts'.$question.'_'.$partid}; 4303: 4304: my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? 4305: $env{'form.WGT'.$question.'_'.$partid} : 1; 4306: my $partial = $newpts/$wgt; 4307: my $score; 4308: if ($partial > 0) { 4309: $score = 'correct_by_override'; 4310: } elsif ($newpts ne '') { #empty is taken as 0 4311: $score = 'incorrect_by_override'; 4312: } 4313: my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid}; 4314: if ($dropMenu eq 'excused') { 4315: $partial = ''; 4316: $score = 'excused'; 4317: } elsif ($dropMenu eq 'reset status' 4318: && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists 4319: $newrecord{'resource.'.$partid.'.tries'} = 0; 4320: $newrecord{'resource.'.$partid.'.solved'} = ''; 4321: $newrecord{'resource.'.$partid.'.award'} = ''; 4322: $newrecord{'resource.'.$partid.'.awarded'} = 0; 4323: $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"; 4324: $changeflag++; 4325: $newpts = ''; 4326: 4327: my $aggtries = $env{'form.aggtries'.$question.'_'.$partid}; 4328: my $totaltries = $env{'form.totaltries'.$question.'_'.$partid}; 4329: my $solvedstatus = $env{'form.solved'.$question.'_'.$partid}; 4330: if ($aggtries > 0) { 4331: &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus); 4332: $aggregateflag = 1; 4333: } 4334: } 4335: my $display_part=&get_display_part($partid,$curRes->symb()); 4336: my $oldstatus = $env{'form.solved'.$question.'_'.$partid}; 4337: $displayPts[0].=' <b>Part:</b> '.$display_part.' = '. 4338: (($oldstatus eq 'excused') ? 'excused' : $oldpts). 4339: ' <br />'; 4340: $displayPts[1].=' <b>Part:</b> '.$display_part.' = '. 4341: (($score eq 'excused') ? 'excused' : $newpts). 4342: ' <br />'; 4343: $question++; 4344: next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); 4345: 4346: $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; 4347: $newrecord{'resource.'.$partid.'.solved'} = $score if $score ne ''; 4348: $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}" 4349: if (scalar(keys(%newrecord)) > 0); 4350: 4351: $changeflag++; 4352: } 4353: if (scalar(keys(%newrecord)) > 0) { 4354: my %record = 4355: &Apache::lonnet::restore($symbx,$env{'request.course.id'}, 4356: $udom,$uname); 4357: 4358: if (&Apache::lonnet::validCODE($env{'form.CODE'})) { 4359: $newrecord{'resource.CODE'} = $env{'form.CODE'}; 4360: } elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) { 4361: $newrecord{'resource.CODE'} = ''; 4362: } 4363: &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, 4364: $udom,$uname); 4365: %record = &Apache::lonnet::restore($symbx, 4366: $env{'request.course.id'}, 4367: $udom,$uname); 4368: &check_and_remove_from_queue($parts,\%record,undef,$symbx, 4369: $cdom,$cnum,$udom,$uname); 4370: } 4371: 4372: if ($aggregateflag) { 4373: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 4374: $env{'course.'.$env{'request.course.id'}.'.domain'}, 4375: $env{'course.'.$env{'request.course.id'}.'.num'}); 4376: } 4377: 4378: $studentTable.='<td valign="top">'.$displayPts[0].'</td>'. 4379: '<td valign="top">'.$displayPts[1].'</td>'. 4380: '</tr>'; 4381: 4382: $prob++; 4383: } 4384: $curRes = $iterator->next(); 4385: } 4386: 4387: $studentTable.='</td></tr></table></td></tr></table>'; 4388: $studentTable.=&show_grading_menu_form($env{'form.symb'}); 4389: my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' : 4390: 'The scores were changed for '. 4391: $changeflag.' problem'.($changeflag == 1 ? '.' : 's.')); 4392: $request->print($grademsg.$studentTable); 4393: 4394: return ''; 4395: } 4396: 4397: #-------- end of section for handling grading by page/sequence --------- 4398: # 4399: #------------------------------------------------------------------- 4400: 4401: #--------------------Scantron Grading----------------------------------- 4402: # 4403: #------ start of section for handling grading by page/sequence --------- 4404: 4405: =pod 4406: 4407: =head1 Bubble sheet grading routines 4408: 4409: For this documentation: 4410: 4411: 'scanline' refers to the full line of characters 4412: from the file that we are parsing that represents one entire sheet 4413: 4414: 'bubble line' refers to the data 4415: representing the line of bubbles that are on the physical bubble sheet 4416: 4417: 4418: The overall process is that a scanned in bubble sheet data is uploaded 4419: into a course. When a user wants to grade, they select a 4420: sequence/folder of resources, a file of bubble sheet info, and pick 4421: one of the predefined configurations for what each scanline looks 4422: like. 4423: 4424: Next each scanline is checked for any errors of either 'missing 4425: bubbles' (it's an error because it may have been mis-scanned 4426: because too light bubbling), 'double bubble' (each bubble line should 4427: have no more that one letter picked), invalid or duplicated CODE, 4428: invalid student ID 4429: 4430: If the CODE option is used that determines the randomization of the 4431: homework problems, either way the student ID is looked up into a 4432: username:domain. 4433: 4434: During the validation phase the instructor can choose to skip scanlines. 4435: 4436: After the validation phase, there are now 3 bubble sheet files 4437: 4438: scantron_original_filename (unmodified original file) 4439: scantron_corrected_filename (file where the corrected information has replaced the original information) 4440: scantron_skipped_filename (contains the exact text of scanlines that where skipped) 4441: 4442: Also there is a separate hash nohist_scantrondata that contains extra 4443: correction information that isn't representable in the bubble sheet 4444: file (see &scantron_getfile() for more information) 4445: 4446: After all scanlines are either valid, marked as valid or skipped, then 4447: foreach line foreach problem in the picked sequence, an ssi request is 4448: made that simulates a user submitting their selected letter(s) against 4449: the homework problem. 4450: 4451: =over 4 4452: 4453: =cut 4454: 4455: 4456: =pod 4457: 4458: =item defaultFormData 4459: 4460: Returns html hidden inputs used to hold context/default values. 4461: 4462: Arguments: 4463: $symb - $symb of the current resource 4464: 4465: =cut 4466: 4467: sub defaultFormData { 4468: my ($symb)=@_; 4469: return ' 4470: <input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 4471: '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n". 4472: '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n"; 4473: } 4474: 4475: =pod 4476: 4477: =item getSequenceDropDown 4478: 4479: Return html dropdown of possible sequences to grade 4480: 4481: Arguments: 4482: $symb - $symb of the current resource 4483: 4484: =cut 4485: 4486: sub getSequenceDropDown { 4487: my ($symb)=@_; 4488: my $result='<select name="selectpage">'."\n"; 4489: my ($titles,$symbx) = &getSymbMap(); 4490: my ($curpage)=&Apache::lonnet::decode_symb($symb); 4491: my $ctr=0; 4492: foreach (@$titles) { 4493: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 4494: $result.='<option value="'.$$symbx{$_}.'" '. 4495: ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : ''). 4496: '>'.$showtitle.'</option>'."\n"; 4497: $ctr++; 4498: } 4499: $result.= '</select>'; 4500: return $result; 4501: } 4502: 4503: 4504: =pod 4505: 4506: =item scantron_filenames 4507: 4508: Returns a list of the scantron files in the current course 4509: 4510: =cut 4511: 4512: sub scantron_filenames { 4513: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 4514: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 4515: my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, 4516: &propath($cdom,$cname)); 4517: my @possiblenames; 4518: foreach my $filename (sort(@files)) { 4519: ($filename)=split(/&/,$filename); 4520: if ($filename!~/^scantron_orig_/) { next ; } 4521: $filename=~s/^scantron_orig_//; 4522: push(@possiblenames,$filename); 4523: } 4524: return @possiblenames; 4525: } 4526: 4527: =pod 4528: 4529: =item scantron_uploads 4530: 4531: Returns html drop-down list of scantron files in current course. 4532: 4533: Arguments: 4534: $file2grade - filename to set as selected in the dropdown 4535: 4536: =cut 4537: 4538: sub scantron_uploads { 4539: my ($file2grade) = @_; 4540: my $result= '<select name="scantron_selectfile">'; 4541: $result.="<option></option>"; 4542: foreach my $filename (sort(&scantron_filenames())) { 4543: $result.="<option".($filename eq $file2grade ? ' selected="selected"':'').">$filename</option>\n"; 4544: } 4545: $result.="</select>"; 4546: return $result; 4547: } 4548: 4549: =pod 4550: 4551: =item scantron_scantab 4552: 4553: Returns html drop down of the scantron formats in the scantronformat.tab 4554: file. 4555: 4556: =cut 4557: 4558: sub scantron_scantab { 4559: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); 4560: my $result='<select name="scantron_format">'."\n"; 4561: $result.='<option></option>'."\n"; 4562: foreach my $line (<$fh>) { 4563: my ($name,$descrip)=split(/:/,$line); 4564: if ($name =~ /^\#/) { next; } 4565: $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n"; 4566: } 4567: $result.='</select>'."\n"; 4568: 4569: return $result; 4570: } 4571: 4572: =pod 4573: 4574: =item scantron_CODElist 4575: 4576: Returns html drop down of the saved CODE lists from current course, 4577: generated from earlier printings. 4578: 4579: =cut 4580: 4581: sub scantron_CODElist { 4582: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 4583: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 4584: my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum); 4585: my $namechoice='<option></option>'; 4586: foreach my $name (sort {uc($a) cmp uc($b)} @names) { 4587: if ($name =~ /^error: 2 /) { next; } 4588: if ($name =~ /^type\0/) { next; } 4589: $namechoice.='<option value="'.$name.'">'.$name.'</option>'; 4590: } 4591: $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>'; 4592: return $namechoice; 4593: } 4594: 4595: =pod 4596: 4597: =item scantron_CODEunique 4598: 4599: Returns the html for "Each CODE to be used once" radio. 4600: 4601: =cut 4602: 4603: sub scantron_CODEunique { 4604: my $result='<span style="white-space: nowrap;"> 4605: <label><input type="radio" name="scantron_CODEunique" 4606: value="yes" checked="checked" />'.&mt('Yes').' </label> 4607: </span> 4608: <span style="white-space: nowrap;"> 4609: <label><input type="radio" name="scantron_CODEunique" 4610: value="no" />'.&mt('No').' </label> 4611: </span>'; 4612: return $result; 4613: } 4614: 4615: =pod 4616: 4617: =item scantron_selectphase 4618: 4619: Generates the initial screen to start the bubble sheet process. 4620: Allows for - starting a grading run. 4621: - downloading existing scan data (original, corrected 4622: or skipped info) 4623: 4624: - uploading new scan data 4625: 4626: Arguments: 4627: $r - The Apache request object 4628: $file2grade - name of the file that contain the scanned data to score 4629: 4630: =cut 4631: 4632: sub scantron_selectphase { 4633: my ($r,$file2grade) = @_; 4634: my ($symb)=&get_symb($r); 4635: if (!$symb) {return '';} 4636: my $sequence_selector=&getSequenceDropDown($symb); 4637: my $default_form_data=&defaultFormData($symb); 4638: my $grading_menu_button=&show_grading_menu_form($symb); 4639: my $file_selector=&scantron_uploads($file2grade); 4640: my $format_selector=&scantron_scantab(); 4641: my $CODE_selector=&scantron_CODElist(); 4642: my $CODE_unique=&scantron_CODEunique(); 4643: my $result; 4644: 4645: # Chunk of form to prompt for a file to grade and how: 4646: 4647: $result.= <<SCANTRONFORM; 4648: <table width="100%" border="0"> 4649: <tr> 4650: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process"> 4651: <td bgcolor="#777777"> 4652: <input type="hidden" name="command" value="scantron_warning" /> 4653: $default_form_data 4654: <table width="100%" border="0"> 4655: <tr bgcolor="#e6ffff"> 4656: <td colspan="2"> 4657:  <b>Specify file and which Folder/Sequence to grade</b> 4658: </td> 4659: </tr> 4660: <tr bgcolor="#ffffe6"> 4661: <td> Sequence to grade: </td><td> $sequence_selector </td> 4662: </tr> 4663: <tr bgcolor="#ffffe6"> 4664: <td> Filename of scoring office file: </td><td> $file_selector </td> 4665: </tr> 4666: <tr bgcolor="#ffffe6"> 4667: <td> Format of data file: </td><td> $format_selector </td> 4668: </tr> 4669: <tr bgcolor="#ffffe6"> 4670: <td> Saved CODEs to validate against: </td><td> $CODE_selector</td> 4671: </tr> 4672: <tr bgcolor="#ffffe6"> 4673: <td> Each CODE is only to be used once:</td><td> $CODE_unique </td> 4674: </tr> 4675: <tr bgcolor="#ffffe6"> 4676: <td> Options: </td> 4677: <td> 4678: <label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> Do only previously skipped records</label> <br /> 4679: <label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> Remove all existing corrections</label> <br /> 4680: <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> Skip hidden resources when grading</label> 4681: </td> 4682: </tr> 4683: <tr bgcolor="#ffffe6"> 4684: <td colspan="2"> 4685: <input type="submit" value="Grading: Validate Scantron Records" /> 4686: </td> 4687: </tr> 4688: </table> 4689: </td> 4690: </form> 4691: </tr> 4692: SCANTRONFORM 4693: 4694: $r->print($result); 4695: 4696: if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || 4697: &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { 4698: 4699: # Chunk of form to prompt for a scantron file upload. 4700: 4701: $r->print(<<SCANTRONFORM); 4702: <tr> 4703: <td bgcolor="#777777"> 4704: <table width="100%" border="0"> 4705: <tr bgcolor="#e6ffff"> 4706: <td> 4707:  <b>Specify a Scantron data file to upload.</b> 4708: </td> 4709: </tr> 4710: <tr bgcolor="#ffffe6"> 4711: <td> 4712: SCANTRONFORM 4713: my $default_form_data=&defaultFormData(&get_symb($r,1)); 4714: my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; 4715: my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'}; 4716: $r->print(<<UPLOAD); 4717: <script type="text/javascript" language="javascript"> 4718: function checkUpload(formname) { 4719: if (formname.upfile.value == "") { 4720: alert("Please use the browse button to select a file from your local directory."); 4721: return false; 4722: } 4723: formname.submit(); 4724: } 4725: </script> 4726: 4727: <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'> 4728: $default_form_data 4729: <input name='courseid' type='hidden' value='$cnum' /> 4730: <input name='domainid' type='hidden' value='$cdom' /> 4731: <input name='command' value='scantronupload_save' type='hidden' /> 4732: File to upload:<input type="file" name="upfile" size="50" /> 4733: <br /> 4734: <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" /> 4735: </form> 4736: UPLOAD 4737: 4738: $r->print(<<SCANTRONFORM); 4739: </td> 4740: </tr> 4741: </table> 4742: </td> 4743: </tr> 4744: SCANTRONFORM 4745: } 4746: 4747: # Chunk of the form that prompts to view a scoring office file, 4748: # corrected file, skipped records in a file. 4749: 4750: $r->print(<<SCANTRONFORM); 4751: <tr> 4752: <form action='/adm/grades' name='scantron_download'> 4753: <td bgcolor="#777777"> 4754: $default_form_data 4755: <input type="hidden" name="command" value="scantron_download" /> 4756: <table width="100%" border="0"> 4757: <tr bgcolor="#e6ffff"> 4758: <td colspan="2"> 4759:  <b>Download a scoring office file</b> 4760: </td> 4761: </tr> 4762: <tr bgcolor="#ffffe6"> 4763: <td> Filename of scoring office file: </td><td> $file_selector </td> 4764: </tr> 4765: <tr bgcolor="#ffffe6"> 4766: <td colspan="2"> 4767: <input type="submit" value="Download: Show List of Associated Files" /> 4768: </td> 4769: </tr> 4770: </table> 4771: </td> 4772: </form> 4773: </tr> 4774: SCANTRONFORM 4775: 4776: $r->print(<<SCANTRONFORM); 4777: </table> 4778: $grading_menu_button 4779: SCANTRONFORM 4780: 4781: return 4782: } 4783: 4784: =pod 4785: 4786: =item get_scantron_config 4787: 4788: Parse and return the scantron configuration line selected as a 4789: hash of configuration file fields. 4790: 4791: Arguments: 4792: which - the name of the configuration to parse from the file. 4793: 4794: 4795: Returns: 4796: If the named configuration is not in the file, an empty 4797: hash is returned. 4798: a hash with the fields 4799: name - internal name for the this configuration setup 4800: description - text to display to operator that describes this config 4801: CODElocation - if 0 or the string 'none' 4802: - no CODE exists for this config 4803: if -1 || the string 'letter' 4804: - a CODE exists for this config and is 4805: a string of letters 4806: Unsupported value (but planned for future support) 4807: if a positive integer 4808: - The CODE exists as the first n items from 4809: the question section of the form 4810: if the string 'number' 4811: - The CODE exists for this config and is 4812: a string of numbers 4813: CODEstart - (only matter if a CODE exists) column in the line where 4814: the CODE starts 4815: CODElength - length of the CODE 4816: IDstart - column where the student ID number starts 4817: IDlength - length of the student ID info 4818: Qstart - column where the information from the bubbled 4819: 'questions' start 4820: Qlength - number of columns comprising a single bubble line from 4821: the sheet. (usually either 1 or 10) 4822: Qon - either a single character representing the character used 4823: to signal a bubble was chosen in the positional setup, or 4824: the string 'letter' if the letter of the chosen bubble is 4825: in the final, or 'number' if a number representing the 4826: chosen bubble is in the file (1->A 0->J) 4827: Qoff - the character used to represent that a bubble was 4828: left blank 4829: PaperID - if the scanning process generates a unique number for each 4830: sheet scanned the column that this ID number starts in 4831: PaperIDlength - number of columns that comprise the unique ID number 4832: for the sheet of paper 4833: FirstName - column that the first name starts in 4834: FirstNameLength - number of columns that the first name spans 4835: 4836: LastName - column that the last name starts in 4837: LastNameLength - number of columns that the last name spans 4838: 4839: =cut 4840: 4841: sub get_scantron_config { 4842: my ($which) = @_; 4843: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); 4844: my %config; 4845: #FIXME probably should move to XML it has already gotten a bit much now 4846: foreach my $line (<$fh>) { 4847: my ($name,$descrip)=split(/:/,$line); 4848: if ($name ne $which ) { next; } 4849: chomp($line); 4850: my @config=split(/:/,$line); 4851: $config{'name'}=$config[0]; 4852: $config{'description'}=$config[1]; 4853: $config{'CODElocation'}=$config[2]; 4854: $config{'CODEstart'}=$config[3]; 4855: $config{'CODElength'}=$config[4]; 4856: $config{'IDstart'}=$config[5]; 4857: $config{'IDlength'}=$config[6]; 4858: $config{'Qstart'}=$config[7]; 4859: $config{'Qlength'}=$config[8]; 4860: $config{'Qoff'}=$config[9]; 4861: $config{'Qon'}=$config[10]; 4862: $config{'PaperID'}=$config[11]; 4863: $config{'PaperIDlength'}=$config[12]; 4864: $config{'FirstName'}=$config[13]; 4865: $config{'FirstNamelength'}=$config[14]; 4866: $config{'LastName'}=$config[15]; 4867: $config{'LastNamelength'}=$config[16]; 4868: last; 4869: } 4870: return %config; 4871: } 4872: 4873: =pod 4874: 4875: =item username_to_idmap 4876: 4877: creates a hash keyed by student id with values of the corresponding 4878: student username:domain. 4879: 4880: Arguments: 4881: 4882: $classlist - reference to the class list hash. This is a hash 4883: keyed by student name:domain whose elements are references 4884: to arrays containing various chunks of information 4885: about the student. (See loncoursedata for more info). 4886: 4887: Returns 4888: %idmap - the constructed hash 4889: 4890: =cut 4891: 4892: sub username_to_idmap { 4893: my ($classlist)= @_; 4894: my %idmap; 4895: foreach my $student (keys(%$classlist)) { 4896: $idmap{$classlist->{$student}->[&Apache::loncoursedata::CL_ID]}= 4897: $student; 4898: } 4899: return %idmap; 4900: } 4901: 4902: =pod 4903: 4904: =item scantron_fixup_scanline 4905: 4906: Process a requested correction to a scanline. 4907: 4908: Arguments: 4909: $scantron_config - hash from &get_scantron_config() 4910: $scan_data - hash of correction information 4911: (see &scantron_getfile()) 4912: $line - existing scanline 4913: $whichline - line number of the passed in scanline 4914: $field - type of change to process 4915: (either 4916: 'ID' -> correct the student ID number 4917: 'CODE' -> correct the CODE 4918: 'answer' -> fixup the submitted answers) 4919: 4920: $args - hash of additional info, 4921: - 'ID' 4922: 'newid' -> studentID to use in replacement 4923: of existing one 4924: - 'CODE' 4925: 'CODE_ignore_dup' - set to true if duplicates 4926: should be ignored. 4927: 'CODE' - is new code or 'use_unfound' 4928: if the existing unfound code should 4929: be used as is 4930: - 'answer' 4931: 'response' - new answer or 'none' if blank 4932: 'question' - the bubble line to change 4933: 4934: Returns: 4935: $line - the modified scanline 4936: 4937: Side effects: 4938: $scan_data - may be updated 4939: 4940: =cut 4941: 4942: 4943: sub scantron_fixup_scanline { 4944: my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; 4945: 4946: if ($field eq 'ID') { 4947: if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { 4948: return ($line,1,'New value too large'); 4949: } 4950: if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { 4951: $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', 4952: $args->{'newid'}); 4953: } 4954: substr($line,$$scantron_config{'IDstart'}-1, 4955: $$scantron_config{'IDlength'})=$args->{'newid'}; 4956: if ($args->{'newid'}=~/^\s*$/) { 4957: &scan_data($scan_data,"$whichline.user", 4958: $args->{'username'}.':'.$args->{'domain'}); 4959: } 4960: } elsif ($field eq 'CODE') { 4961: if ($args->{'CODE_ignore_dup'}) { 4962: &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); 4963: } 4964: &scan_data($scan_data,"$whichline.useCODE",'1'); 4965: if ($args->{'CODE'} ne 'use_unfound') { 4966: if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { 4967: return ($line,1,'New CODE value too large'); 4968: } 4969: if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) { 4970: $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'}); 4971: } 4972: substr($line,$$scantron_config{'CODEstart'}-1, 4973: $$scantron_config{'CODElength'})=$args->{'CODE'}; 4974: } 4975: } elsif ($field eq 'answer') { 4976: my $length=$scantron_config->{'Qlength'}; 4977: my $off=$scantron_config->{'Qoff'}; 4978: my $on=$scantron_config->{'Qon'}; 4979: my $answer=${off}x$length; 4980: if ($args->{'response'} eq 'none') { 4981: &scan_data($scan_data, 4982: "$whichline.no_bubble.".$args->{'question'},'1'); 4983: } else { 4984: if ($on eq 'letter') { 4985: my @alphabet=('A'..'Z'); 4986: $answer=$alphabet[$args->{'response'}]; 4987: } elsif ($on eq 'number') { 4988: $answer=$args->{'response'}+1; 4989: if ($answer == 10) { $answer = '0'; } 4990: } else { 4991: substr($answer,$args->{'response'},1)=$on; 4992: } 4993: &scan_data($scan_data, 4994: "$whichline.no_bubble.".$args->{'question'},undef,'1'); 4995: } 4996: my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; 4997: substr($line,$where-1,$length)=$answer; 4998: } 4999: return $line; 5000: } 5001: 5002: =pod 5003: 5004: =item scan_data 5005: 5006: Edit or look up an item in the scan_data hash. 5007: 5008: Arguments: 5009: $scan_data - The hash (see scantron_getfile) 5010: $key - shorthand of the key to edit (actual key is 5011: scantronfilename_key). 5012: $data - New value of the hash entry. 5013: $delete - If true, the entry is removed from the hash. 5014: 5015: Returns: 5016: The new value of the hash table field (undefined if deleted). 5017: 5018: =cut 5019: 5020: 5021: sub scan_data { 5022: my ($scan_data,$key,$value,$delete)=@_; 5023: my $filename=$env{'form.scantron_selectfile'}; 5024: if (defined($value)) { 5025: $scan_data->{$filename.'_'.$key} = $value; 5026: } 5027: if ($delete) { delete($scan_data->{$filename.'_'.$key}); } 5028: return $scan_data->{$filename.'_'.$key}; 5029: } 5030: 5031: =pod 5032: 5033: =item scantron_parse_scanline 5034: 5035: Decodes a scanline from the selected scantron file 5036: 5037: Arguments: 5038: line - The text of the scantron file line to process 5039: whichline - Line number 5040: scantron_config - Hash describing the format of the scantron lines. 5041: scan_data - Hash of extra information about the scanline 5042: (see scantron_getfile for more information) 5043: just_header - True if should not process question answers but only 5044: the stuff to the left of the answers. 5045: Returns: 5046: Hash containing the result of parsing the scanline 5047: 5048: Keys are all proceeded by the string 'scantron.' 5049: 5050: CODE - the CODE in use for this scanline 5051: useCODE - 1 if the CODE is invalid but it usage has been forced 5052: by the operator 5053: CODE_ignore_dup - 1 if the CODE is a duplicated use when unique 5054: CODEs were selected, but the usage has been 5055: forced by the operator 5056: ID - student ID 5057: PaperID - if used, the ID number printed on the sheet when the 5058: paper was scanned 5059: FirstName - first name from the sheet 5060: LastName - last name from the sheet 5061: 5062: if just_header was not true these key may also exist 5063: 5064: missingerror - a list of bubbled line numbers that had a blank bubble 5065: that is considered an error (if the operator had already 5066: okayed a blank bubble line as really being blank then 5067: that bubble line number won't appear here. 5068: doubleerror - a list of bubbled line numbers that had more than one 5069: bubble filled in and has not been corrected by the 5070: operator 5071: maxquest - the number of the last bubble line that was parsed 5072: 5073: (<number> starts at 1) 5074: <number>.answer - zero or more letters representing the selected 5075: letters from the scanline for the bubble line 5076: <number>. 5077: if blank there was either no bubble or there where 5078: multiple bubbles, (consult the keys missingerror and 5079: doubleerror if this is an error condition) 5080: 5081: =cut 5082: 5083: sub scantron_parse_scanline { 5084: my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_; 5085: my %record; 5086: my $questions=substr($line,$$scantron_config{'Qstart'}-1); # Answers 5087: my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff 5088: if (!($$scantron_config{'CODElocation'} eq 0 || 5089: $$scantron_config{'CODElocation'} eq 'none')) { 5090: if ($$scantron_config{'CODElocation'} < 0 || 5091: $$scantron_config{'CODElocation'} eq 'letter' || 5092: $$scantron_config{'CODElocation'} eq 'number') { 5093: $record{'scantron.CODE'}=substr($data, 5094: $$scantron_config{'CODEstart'}-1, 5095: $$scantron_config{'CODElength'}); 5096: if (&scan_data($scan_data,"$whichline.useCODE")) { 5097: $record{'scantron.useCODE'}=1; 5098: } 5099: if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) { 5100: $record{'scantron.CODE_ignore_dup'}=1; 5101: } 5102: } else { 5103: #FIXME interpret first N questions 5104: } 5105: } 5106: $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, 5107: $$scantron_config{'IDlength'}); 5108: $record{'scantron.PaperID'}= 5109: substr($data,$$scantron_config{'PaperID'}-1, 5110: $$scantron_config{'PaperIDlength'}); 5111: $record{'scantron.FirstName'}= 5112: substr($data,$$scantron_config{'FirstName'}-1, 5113: $$scantron_config{'FirstNamelength'}); 5114: $record{'scantron.LastName'}= 5115: substr($data,$$scantron_config{'LastName'}-1, 5116: $$scantron_config{'LastNamelength'}); 5117: if ($just_header) { return \%record; } 5118: 5119: my @alphabet=('A'..'Z'); 5120: my $questnum=0; 5121: while ($questions) { 5122: $questnum++; 5123: my $currentquest=substr($questions,0,$$scantron_config{'Qlength'}); 5124: substr($questions,0,$$scantron_config{'Qlength'})=''; 5125: if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } 5126: if ($$scantron_config{'Qon'} eq 'letter') { 5127: if ($currentquest eq '?' 5128: || $currentquest eq '*') { 5129: push(@{$record{'scantron.doubleerror'}},$questnum); 5130: $record{"scantron.$questnum.answer"}=''; 5131: } elsif (!defined($currentquest) 5132: || $currentquest eq $$scantron_config{'Qoff'} 5133: || $currentquest !~ /^[A-Z]$/) { 5134: $record{"scantron.$questnum.answer"}=''; 5135: if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { 5136: push(@{$record{"scantron.missingerror"}},$questnum); 5137: } 5138: } else { 5139: $record{"scantron.$questnum.answer"}=$currentquest; 5140: } 5141: } elsif ($$scantron_config{'Qon'} eq 'number') { 5142: if ($currentquest eq '?' 5143: || $currentquest eq '*') { 5144: push(@{$record{'scantron.doubleerror'}},$questnum); 5145: $record{"scantron.$questnum.answer"}=''; 5146: } elsif (!defined($currentquest) 5147: || $currentquest eq $$scantron_config{'Qoff'} 5148: || $currentquest !~ /^\d$/) { 5149: $record{"scantron.$questnum.answer"}=''; 5150: if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { 5151: push(@{$record{"scantron.missingerror"}},$questnum); 5152: } 5153: } else { 5154: # wrap zero back to J 5155: if ($currentquest eq '0') { 5156: $record{"scantron.$questnum.answer"}= 5157: $alphabet[9]; 5158: } else { 5159: $record{"scantron.$questnum.answer"}= 5160: $alphabet[$currentquest-1]; 5161: } 5162: } 5163: } else { 5164: my @array=split($$scantron_config{'Qon'},$currentquest,-1); 5165: if (length($array[0]) eq $$scantron_config{'Qlength'}) { 5166: $record{"scantron.$questnum.answer"}=''; 5167: if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { 5168: push(@{$record{"scantron.missingerror"}},$questnum); 5169: } 5170: } else { 5171: $record{"scantron.$questnum.answer"}= 5172: $alphabet[length($array[0])]; 5173: } 5174: if (scalar(@array) gt 2) { 5175: push(@{$record{'scantron.doubleerror'}},$questnum); 5176: my @ans=@array; 5177: my $i=length($ans[0]);shift(@ans); 5178: while ($#ans) { 5179: $i+=length($ans[0])+1; 5180: $record{"scantron.$questnum.answer"}.=$alphabet[$i]; 5181: shift(@ans); 5182: } 5183: } 5184: } 5185: } 5186: $record{'scantron.maxquest'}=$questnum; 5187: return \%record; 5188: } 5189: 5190: =pod 5191: 5192: =item scantron_add_delay 5193: 5194: Adds an error message that occurred during the grading phase to a 5195: queue of messages to be shown after grading pass is complete 5196: 5197: Arguments: 5198: $delayqueue - arrary ref of hash ref of error messages 5199: $scanline - the scanline that caused the error 5200: $errormesage - the error message 5201: $errorcode - a numeric code for the error 5202: 5203: Side Effects: 5204: updates the $delayqueue to have a new hash ref of the error 5205: 5206: =cut 5207: 5208: sub scantron_add_delay { 5209: my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; 5210: push(@$delayqueue, 5211: {'line' => $scanline, 'emsg' => $errormessage, 5212: 'ecode' => $errorcode } 5213: ); 5214: } 5215: 5216: =pod 5217: 5218: =item scantron_find_student 5219: 5220: Finds the username for the current scanline 5221: 5222: Arguments: 5223: $scantron_record - hash result from scantron_parse_scanline 5224: $scan_data - hash of correction information 5225: (see &scantron_getfile() form more information) 5226: $idmap - hash from &username_to_idmap() 5227: $line - number of current scanline 5228: 5229: Returns: 5230: Either 'username:domain' or undef if unknown 5231: 5232: =cut 5233: 5234: sub scantron_find_student { 5235: my ($scantron_record,$scan_data,$idmap,$line)=@_; 5236: my $scanID=$$scantron_record{'scantron.ID'}; 5237: if ($scanID =~ /^\s*$/) { 5238: return &scan_data($scan_data,"$line.user"); 5239: } 5240: foreach my $id (keys(%$idmap)) { 5241: if (lc($id) eq lc($scanID)) { 5242: return $$idmap{$id}; 5243: } 5244: } 5245: return undef; 5246: } 5247: 5248: =pod 5249: 5250: =item scantron_filter 5251: 5252: Filter sub for lonnavmaps, filters out hidden resources if ignore 5253: hidden resources was selected 5254: 5255: =cut 5256: 5257: sub scantron_filter { 5258: my ($curres)=@_; 5259: 5260: if (ref($curres) && $curres->is_problem()) { 5261: # if the user has asked to not have either hidden 5262: # or 'randomout' controlled resources to be graded 5263: # don't include them 5264: if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' 5265: && $curres->randomout) { 5266: return 0; 5267: } 5268: return 1; 5269: } 5270: return 0; 5271: } 5272: 5273: =pod 5274: 5275: =item scantron_process_corrections 5276: 5277: Gets correction information out of submitted form data and corrects 5278: the scanline 5279: 5280: =cut 5281: 5282: sub scantron_process_corrections { 5283: my ($r) = @_; 5284: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 5285: my ($scanlines,$scan_data)=&scantron_getfile(); 5286: my $classlist=&Apache::loncoursedata::get_classlist(); 5287: my $which=$env{'form.scantron_line'}; 5288: my $line=&scantron_get_line($scanlines,$scan_data,$which); 5289: my ($skip,$err,$errmsg); 5290: if ($env{'form.scantron_skip_record'}) { 5291: $skip=1; 5292: } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { 5293: my $newstudent=$env{'form.scantron_username'}.':'. 5294: $env{'form.scantron_domain'}; 5295: my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; 5296: ($line,$err,$errmsg)= 5297: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 5298: 'ID',{'newid'=>$newid, 5299: 'username'=>$env{'form.scantron_username'}, 5300: 'domain'=>$env{'form.scantron_domain'}}); 5301: } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { 5302: my $resolution=$env{'form.scantron_CODE_resolution'}; 5303: my $newCODE; 5304: my %args; 5305: if ($resolution eq 'use_unfound') { 5306: $newCODE='use_unfound'; 5307: } elsif ($resolution eq 'use_found') { 5308: $newCODE=$env{'form.scantron_CODE_selectedvalue'}; 5309: } elsif ($resolution eq 'use_typed') { 5310: $newCODE=$env{'form.scantron_CODE_newvalue'}; 5311: } elsif ($resolution =~ /^use_closest_(\d+)/) { 5312: $newCODE=$env{"form.scantron_CODE_closest_$1"}; 5313: } 5314: if ($env{'form.scantron_corrections'} eq 'duplicateCODE') { 5315: $args{'CODE_ignore_dup'}=1; 5316: } 5317: $args{'CODE'}=$newCODE; 5318: ($line,$err,$errmsg)= 5319: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 5320: 'CODE',\%args); 5321: } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { 5322: foreach my $question (split(',',$env{'form.scantron_questions'})) { 5323: ($line,$err,$errmsg)= 5324: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, 5325: $which,'answer', 5326: { 'question'=>$question, 5327: 'response'=>$env{"form.scantron_correct_Q_$question"}}); 5328: if ($err) { last; } 5329: } 5330: } 5331: if ($err) { 5332: $r->print("<span class=\"LC_warning\">Unable to accept last correction, an error occurred :$errmsg:</span>"); 5333: } else { 5334: &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); 5335: &scantron_putfile($scanlines,$scan_data); 5336: } 5337: } 5338: 5339: =pod 5340: 5341: =item reset_skipping_status 5342: 5343: Forgets the current set of remember skipped scanlines (and thus 5344: reverts back to considering all lines in the 5345: scantron_skipped_<filename> file) 5346: 5347: =cut 5348: 5349: sub reset_skipping_status { 5350: my ($scanlines,$scan_data)=&scantron_getfile(); 5351: &scan_data($scan_data,'remember_skipping',undef,1); 5352: &scantron_putfile(undef,$scan_data); 5353: } 5354: 5355: =pod 5356: 5357: =item start_skipping 5358: 5359: Marks a scanline to be skipped. 5360: 5361: =cut 5362: 5363: sub start_skipping { 5364: my ($scan_data,$i)=@_; 5365: my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); 5366: if ($env{'form.scantron_options_redo'} =~ /^redo_/) { 5367: $remembered{$i}=2; 5368: } else { 5369: $remembered{$i}=1; 5370: } 5371: &scan_data($scan_data,'remember_skipping',join(':',%remembered)); 5372: } 5373: 5374: =pod 5375: 5376: =item should_be_skipped 5377: 5378: Checks whether a scanline should be skipped. 5379: 5380: =cut 5381: 5382: sub should_be_skipped { 5383: my ($scanlines,$scan_data,$i)=@_; 5384: if ($env{'form.scantron_options_redo'} !~ /^redo_/) { 5385: # not redoing old skips 5386: if ($scanlines->{'skipped'}[$i]) { return 1; } 5387: return 0; 5388: } 5389: my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); 5390: 5391: if (exists($remembered{$i}) && $remembered{$i} != 2 ) { 5392: return 0; 5393: } 5394: return 1; 5395: } 5396: 5397: =pod 5398: 5399: =item remember_current_skipped 5400: 5401: Discovers what scanlines are in the scantron_skipped_<filename> 5402: file and remembers them into scan_data for later use. 5403: 5404: =cut 5405: 5406: sub remember_current_skipped { 5407: my ($scanlines,$scan_data)=&scantron_getfile(); 5408: my %to_remember; 5409: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 5410: if ($scanlines->{'skipped'}[$i]) { 5411: $to_remember{$i}=1; 5412: } 5413: } 5414: 5415: &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); 5416: &scantron_putfile(undef,$scan_data); 5417: } 5418: 5419: =pod 5420: 5421: =item check_for_error 5422: 5423: Checks if there was an error when attempting to remove a specific 5424: scantron_.. bubble sheet data file. Prints out an error if 5425: something went wrong. 5426: 5427: =cut 5428: 5429: sub check_for_error { 5430: my ($r,$result)=@_; 5431: if ($result ne 'ok' && $result ne 'not_found' ) { 5432: $r->print("An error occurred ($result) when trying to Remove the existing corrections."); 5433: } 5434: } 5435: 5436: =pod 5437: 5438: =item scantron_warning_screen 5439: 5440: Interstitial screen to make sure the operator has selected the 5441: correct options before we start the validation phase. 5442: 5443: =cut 5444: 5445: sub scantron_warning_screen { 5446: my ($button_text)=@_; 5447: my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); 5448: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 5449: my $CODElist; 5450: if ($scantron_config{'CODElocation'} && 5451: $scantron_config{'CODEstart'} && 5452: $scantron_config{'CODElength'}) { 5453: $CODElist=$env{'form.scantron_CODElist'}; 5454: if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">None</span>'; } 5455: $CODElist= 5456: '<tr><td><b>List of CODES to validate against:</b></td><td><tt>'. 5457: $env{'form.scantron_CODElist'}.'</tt></td></tr>'; 5458: } 5459: return (<<STUFF); 5460: <p> 5461: <span class="LC_warning">Please double check the information 5462: below before clicking on '$button_text'</span> 5463: </p> 5464: <table> 5465: <tr><td><b>Sequence to be Graded:</b></td><td>$title</td></tr> 5466: <tr><td><b>Data File that will be used:</b></td><td><tt>$env{'form.scantron_selectfile'}</tt></td></tr> 5467: $CODElist 5468: </table> 5469: <br /> 5470: <p> If this information is correct, please click on '$button_text'.</p> 5471: <p> If something is incorrect, please click the 'Grading Menu' button to start over.</p> 5472: 5473: <br /> 5474: STUFF 5475: } 5476: 5477: =pod 5478: 5479: =item scantron_do_warning 5480: 5481: Check if the operator has picked something for all required 5482: fields. Error out if something is missing. 5483: 5484: =cut 5485: 5486: sub scantron_do_warning { 5487: my ($r)=@_; 5488: my ($symb)=&get_symb($r); 5489: if (!$symb) {return '';} 5490: my $default_form_data=&defaultFormData($symb); 5491: $r->print(&scantron_form_start().$default_form_data); 5492: if ( $env{'form.selectpage'} eq '' || 5493: $env{'form.scantron_selectfile'} eq '' || 5494: $env{'form.scantron_format'} eq '' ) { 5495: $r->print("<p>You have forgetten to specify some information. Please go Back and try again.</p>"); 5496: if ( $env{'form.selectpage'} eq '') { 5497: $r->print('<p><span class="LC_error">You have not selected a Sequence to grade</span></p>'); 5498: } 5499: if ( $env{'form.scantron_selectfile'} eq '') { 5500: $r->print('<p><span class="LC_error">You have not selected a file that contains the student\'s response data.</span></p>'); 5501: } 5502: if ( $env{'form.scantron_format'} eq '') { 5503: $r->print('<p><span class="LC_error">You have not selected a the format of the student\'s response data.</span></p>'); 5504: } 5505: } else { 5506: my $warning=&scantron_warning_screen('Grading: Validate Records'); 5507: $r->print(<<STUFF); 5508: $warning 5509: <input type="submit" name="submit" value="Grading: Validate Records" /> 5510: <input type="hidden" name="command" value="scantron_validate" /> 5511: STUFF 5512: } 5513: $r->print("</form><br />".&show_grading_menu_form($symb)); 5514: return ''; 5515: } 5516: 5517: =pod 5518: 5519: =item scantron_form_start 5520: 5521: html hidden input for remembering all selected grading options 5522: 5523: =cut 5524: 5525: sub scantron_form_start { 5526: my ($max_bubble)=@_; 5527: my $result= <<SCANTRONFORM; 5528: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> 5529: <input type="hidden" name="selectpage" value="$env{'form.selectpage'}" /> 5530: <input type="hidden" name="scantron_format" value="$env{'form.scantron_format'}" /> 5531: <input type="hidden" name="scantron_selectfile" value="$env{'form.scantron_selectfile'}" /> 5532: <input type="hidden" name="scantron_maxbubble" value="$max_bubble" /> 5533: <input type="hidden" name="scantron_CODElist" value="$env{'form.scantron_CODElist'}" /> 5534: <input type="hidden" name="scantron_CODEunique" value="$env{'form.scantron_CODEunique'}" /> 5535: <input type="hidden" name="scantron_options_redo" value="$env{'form.scantron_options_redo'}" /> 5536: <input type="hidden" name="scantron_options_ignore" value="$env{'form.scantron_options_ignore'}" /> 5537: <input type="hidden" name="scantron_options_hidden" value="$env{'form.scantron_options_hidden'}" /> 5538: SCANTRONFORM 5539: return $result; 5540: } 5541: 5542: =pod 5543: 5544: =item scantron_validate_file 5545: 5546: Dispatch routine for doing validation of a bubble sheet data file. 5547: 5548: Also processes any necessary information resets that need to 5549: occur before validation begins (ignore previous corrections, 5550: restarting the skipped records processing) 5551: 5552: =cut 5553: 5554: sub scantron_validate_file { 5555: my ($r) = @_; 5556: my ($symb)=&get_symb($r); 5557: if (!$symb) {return '';} 5558: my $default_form_data=&defaultFormData($symb); 5559: 5560: # do the detection of only doing skipped records first befroe we delete 5561: # them when doing the corrections reset 5562: if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') { 5563: &reset_skipping_status(); 5564: } 5565: if ($env{'form.scantron_options_redo'} eq 'redo_skipped') { 5566: &remember_current_skipped(); 5567: $env{'form.scantron_options_redo'}='redo_skipped_ready'; 5568: } 5569: 5570: if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') { 5571: &check_for_error($r,&scantron_remove_file('corrected')); 5572: &check_for_error($r,&scantron_remove_file('skipped')); 5573: &check_for_error($r,&scantron_remove_scan_data()); 5574: $env{'form.scantron_options_ignore'}='done'; 5575: } 5576: 5577: if ($env{'form.scantron_corrections'}) { 5578: &scantron_process_corrections($r); 5579: } 5580: $r->print("<p>Gathering necessary info.</p>");$r->rflush(); 5581: #get the student pick code ready 5582: $r->print(&Apache::loncommon::studentbrowser_javascript()); 5583: my $max_bubble=&scantron_get_maxbubble(); 5584: my $result=&scantron_form_start($max_bubble).$default_form_data; 5585: $r->print($result); 5586: 5587: my @validate_phases=( 'sequence', 5588: 'ID', 5589: 'CODE', 5590: 'doublebubble', 5591: 'missingbubbles'); 5592: if (!$env{'form.validatepass'}) { 5593: $env{'form.validatepass'} = 0; 5594: } 5595: my $currentphase=$env{'form.validatepass'}; 5596: 5597: my $stop=0; 5598: while (!$stop && $currentphase < scalar(@validate_phases)) { 5599: $r->print("<p> Validating ".$validate_phases[$currentphase]."</p>"); 5600: $r->rflush(); 5601: my $which="scantron_validate_".$validate_phases[$currentphase]; 5602: { 5603: no strict 'refs'; 5604: ($stop,$currentphase)=&$which($r,$currentphase); 5605: } 5606: } 5607: if (!$stop) { 5608: my $warning=&scantron_warning_screen('Start Grading'); 5609: $r->print(<<STUFF); 5610: Validation process complete.<br /> 5611: $warning 5612: <input type="submit" name="submit" value="Start Grading" /> 5613: <input type="hidden" name="command" value="scantron_process" /> 5614: STUFF 5615: 5616: } else { 5617: $r->print('<input type="hidden" name="command" value="scantron_validate" />'); 5618: $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />"); 5619: } 5620: if ($stop) { 5621: if ($validate_phases[$currentphase] eq 'sequence') { 5622: $r->print('<input type="submit" name="submit" value="Ignore -> " />'); 5623: $r->print(' this error <br />'); 5624: 5625: $r->print(" <p>Or click the 'Grading Menu' button to start over.</p>"); 5626: } else { 5627: $r->print('<input type="submit" name="submit" value="Continue ->" />'); 5628: $r->print(' using corrected info <br />'); 5629: $r->print("<input type='submit' value='Skip' name='scantron_skip_record' />"); 5630: $r->print(" this scanline saving it for later."); 5631: } 5632: } 5633: $r->print(" </form><br />".&show_grading_menu_form($symb)); 5634: return ''; 5635: } 5636: 5637: 5638: =pod 5639: 5640: =item scantron_remove_file 5641: 5642: Removes the requested bubble sheet data file, makes sure that 5643: scantron_original_<filename> is never removed 5644: 5645: 5646: =cut 5647: 5648: sub scantron_remove_file { 5649: my ($which)=@_; 5650: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 5651: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 5652: my $file='scantron_'; 5653: if ($which eq 'corrected' || $which eq 'skipped') { 5654: $file.=$which.'_'; 5655: } else { 5656: return 'refused'; 5657: } 5658: $file.=$env{'form.scantron_selectfile'}; 5659: return &Apache::lonnet::removeuserfile($cname,$cdom,$file); 5660: } 5661: 5662: 5663: =pod 5664: 5665: =item scantron_remove_scan_data 5666: 5667: Removes all scan_data correction for the requested bubble sheet 5668: data file. (In the case that both the are doing skipped records we need 5669: to remember the old skipped lines for the time being so that element 5670: persists for a while.) 5671: 5672: =cut 5673: 5674: sub scantron_remove_scan_data { 5675: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 5676: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 5677: my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname); 5678: my @todelete; 5679: my $filename=$env{'form.scantron_selectfile'}; 5680: foreach my $key (@keys) { 5681: if ($key=~/^\Q$filename\E_/) { 5682: if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' && 5683: $key=~/remember_skipping/) { 5684: next; 5685: } 5686: push(@todelete,$key); 5687: } 5688: } 5689: my $result; 5690: if (@todelete) { 5691: $result=&Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname); 5692: } 5693: return $result; 5694: } 5695: 5696: 5697: =pod 5698: 5699: =item scantron_getfile 5700: 5701: Fetches the requested bubble sheet data file (all 3 versions), and 5702: the scan_data hash 5703: 5704: Arguments: 5705: None 5706: 5707: Returns: 5708: 2 hash references 5709: 5710: - first one has 5711: orig - 5712: corrected - 5713: skipped - each of which points to an array ref of the specified 5714: file broken up into individual lines 5715: count - number of scanlines 5716: 5717: - second is the scan_data hash possible keys are 5718: ($number refers to scanline numbered $number and thus the key affects 5719: only that scanline 5720: $bubline refers to the specific bubble line element and the aspects 5721: refers to that specific bubble line element) 5722: 5723: $number.user - username:domain to use 5724: $number.CODE_ignore_dup 5725: - ignore the duplicate CODE error 5726: $number.useCODE 5727: - use the CODE in the scanline as is 5728: $number.no_bubble.$bubline 5729: - it is valid that there is no bubbled in bubble 5730: at $number $bubline 5731: remember_skipping 5732: - a frozen hash containing keys of $number and values 5733: of either 5734: 1 - we are on a 'do skipped records pass' and plan 5735: on processing this line 5736: 2 - we are on a 'do skipped records pass' and this 5737: scanline has been marked to skip yet again 5738: 5739: =cut 5740: 5741: sub scantron_getfile { 5742: #FIXME really would prefer a scantron directory 5743: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 5744: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 5745: my $lines; 5746: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 5747: 'scantron_orig_'.$env{'form.scantron_selectfile'}); 5748: my %scanlines; 5749: $scanlines{'orig'}=[(split("\n",$lines,-1))]; 5750: my $temp=$scanlines{'orig'}; 5751: $scanlines{'count'}=$#$temp; 5752: 5753: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 5754: 'scantron_corrected_'.$env{'form.scantron_selectfile'}); 5755: if ($lines eq '-1') { 5756: $scanlines{'corrected'}=[]; 5757: } else { 5758: $scanlines{'corrected'}=[(split("\n",$lines,-1))]; 5759: } 5760: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 5761: 'scantron_skipped_'.$env{'form.scantron_selectfile'}); 5762: if ($lines eq '-1') { 5763: $scanlines{'skipped'}=[]; 5764: } else { 5765: $scanlines{'skipped'}=[(split("\n",$lines,-1))]; 5766: } 5767: my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname); 5768: if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } 5769: my %scan_data = @tmp; 5770: return (\%scanlines,\%scan_data); 5771: } 5772: 5773: =pod 5774: 5775: =item lonnet_putfile 5776: 5777: Wrapper routine to call &Apache::lonnet::finishuserfileupload 5778: 5779: Arguments: 5780: $contents - data to store 5781: $filename - filename to store $contents into 5782: 5783: Returns: 5784: result value from &Apache::lonnet::finishuserfileupload 5785: 5786: =cut 5787: 5788: sub lonnet_putfile { 5789: my ($contents,$filename)=@_; 5790: my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; 5791: my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 5792: $env{'form.sillywaytopassafilearound'}=$contents; 5793: &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename); 5794: 5795: } 5796: 5797: =pod 5798: 5799: =item scantron_putfile 5800: 5801: Stores the current version of the bubble sheet data files, and the 5802: scan_data hash. (Does not modify the original version only the 5803: corrected and skipped versions. 5804: 5805: Arguments: 5806: $scanlines - hash ref that looks like the first return value from 5807: &scantron_getfile() 5808: $scan_data - hash ref that looks like the second return value from 5809: &scantron_getfile() 5810: 5811: =cut 5812: 5813: sub scantron_putfile { 5814: my ($scanlines,$scan_data) = @_; 5815: #FIXME really would prefer a scantron directory 5816: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 5817: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 5818: if ($scanlines) { 5819: my $prefix='scantron_'; 5820: # no need to update orig, shouldn't change 5821: # &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'. 5822: # $env{'form.scantron_selectfile'}); 5823: &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}), 5824: $prefix.'corrected_'. 5825: $env{'form.scantron_selectfile'}); 5826: &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), 5827: $prefix.'skipped_'. 5828: $env{'form.scantron_selectfile'}); 5829: } 5830: &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); 5831: } 5832: 5833: =pod 5834: 5835: =item scantron_get_line 5836: 5837: Returns the correct version of the scanline 5838: 5839: Arguments: 5840: $scanlines - hash ref that looks like the first return value from 5841: &scantron_getfile() 5842: $scan_data - hash ref that looks like the second return value from 5843: &scantron_getfile() 5844: $i - number of the requested line (starts at 0) 5845: 5846: Returns: 5847: A scanline, (either the original or the corrected one if it 5848: exists), or undef if the requested scanline should be 5849: skipped. (Either because it's an skipped scanline, or it's an 5850: unskipped scanline and we are not doing a 'do skipped scanlines' 5851: pass. 5852: 5853: =cut 5854: 5855: sub scantron_get_line { 5856: my ($scanlines,$scan_data,$i)=@_; 5857: if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } 5858: #if ($scanlines->{'skipped'}[$i]) { return undef; } 5859: if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} 5860: return $scanlines->{'orig'}[$i]; 5861: } 5862: 5863: =pod 5864: 5865: =item scantron_todo_count 5866: 5867: Counts the number of scanlines that need processing. 5868: 5869: Arguments: 5870: $scanlines - hash ref that looks like the first return value from 5871: &scantron_getfile() 5872: $scan_data - hash ref that looks like the second return value from 5873: &scantron_getfile() 5874: 5875: Returns: 5876: $count - number of scanlines to process 5877: 5878: =cut 5879: 5880: sub get_todo_count { 5881: my ($scanlines,$scan_data)=@_; 5882: my $count=0; 5883: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 5884: my $line=&scantron_get_line($scanlines,$scan_data,$i); 5885: if ($line=~/^[\s\cz]*$/) { next; } 5886: $count++; 5887: } 5888: return $count; 5889: } 5890: 5891: =pod 5892: 5893: =item scantron_put_line 5894: 5895: Updates the 'corrected' or 'skipped' versions of the bubble sheet 5896: data file. 5897: 5898: Arguments: 5899: $scanlines - hash ref that looks like the first return value from 5900: &scantron_getfile() 5901: $scan_data - hash ref that looks like the second return value from 5902: &scantron_getfile() 5903: $i - line number to update 5904: $newline - contents of the updated scanline 5905: $skip - if true make the line for skipping and update the 5906: 'skipped' file 5907: 5908: =cut 5909: 5910: sub scantron_put_line { 5911: my ($scanlines,$scan_data,$i,$newline,$skip)=@_; 5912: if ($skip) { 5913: $scanlines->{'skipped'}[$i]=$newline; 5914: &start_skipping($scan_data,$i); 5915: return; 5916: } 5917: $scanlines->{'corrected'}[$i]=$newline; 5918: } 5919: 5920: =pod 5921: 5922: =item scantron_clear_skip 5923: 5924: Remove a line from the 'skipped' file 5925: 5926: Arguments: 5927: $scanlines - hash ref that looks like the first return value from 5928: &scantron_getfile() 5929: $scan_data - hash ref that looks like the second return value from 5930: &scantron_getfile() 5931: $i - line number to update 5932: 5933: =cut 5934: 5935: sub scantron_clear_skip { 5936: my ($scanlines,$scan_data,$i)=@_; 5937: if (exists($scanlines->{'skipped'}[$i])) { 5938: undef($scanlines->{'skipped'}[$i]); 5939: return 1; 5940: } 5941: return 0; 5942: } 5943: 5944: =pod 5945: 5946: =item scantron_filter_not_exam 5947: 5948: Filter routine used by &Apache::lonnavmaps::retrieveResources(), to 5949: filter out resources that are not marked as 'exam' mode 5950: 5951: =cut 5952: 5953: sub scantron_filter_not_exam { 5954: my ($curres)=@_; 5955: 5956: if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) { 5957: # if the user has asked to not have either hidden 5958: # or 'randomout' controlled resources to be graded 5959: # don't include them 5960: if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' 5961: && $curres->randomout) { 5962: return 0; 5963: } 5964: return 1; 5965: } 5966: return 0; 5967: } 5968: 5969: =pod 5970: 5971: =item scantron_validate_sequence 5972: 5973: Validates the selected sequence, checking for resource that are 5974: not set to exam mode. 5975: 5976: =cut 5977: 5978: sub scantron_validate_sequence { 5979: my ($r,$currentphase) = @_; 5980: 5981: my $navmap=Apache::lonnavmaps::navmap->new(); 5982: my (undef,undef,$sequence)= 5983: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 5984: 5985: my $map=$navmap->getResourceByUrl($sequence); 5986: 5987: $r->print('<input type="hidden" name="validate_sequence_exam" 5988: value="ignore" />'); 5989: if ($env{'form.validate_sequence_exam'} ne 'ignore') { 5990: my @resources= 5991: $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); 5992: if (@resources) { 5993: $r->print("<p>".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."</p>"); 5994: return (1,$currentphase); 5995: } 5996: } 5997: 5998: return (0,$currentphase+1); 5999: } 6000: 6001: =pod 6002: 6003: =item scantron_validate_ID 6004: 6005: Validates all scanlines in the selected file to not have any 6006: invalid or underspecified student IDs 6007: 6008: =cut 6009: 6010: sub scantron_validate_ID { 6011: my ($r,$currentphase) = @_; 6012: 6013: #get student info 6014: my $classlist=&Apache::loncoursedata::get_classlist(); 6015: my %idmap=&username_to_idmap($classlist); 6016: 6017: #get scantron line setup 6018: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6019: my ($scanlines,$scan_data)=&scantron_getfile(); 6020: 6021: my %found=('ids'=>{},'usernames'=>{}); 6022: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 6023: my $line=&scantron_get_line($scanlines,$scan_data,$i); 6024: if ($line=~/^[\s\cz]*$/) { next; } 6025: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 6026: $scan_data); 6027: my $id=$$scan_record{'scantron.ID'}; 6028: my $found; 6029: foreach my $checkid (keys(%idmap)) { 6030: if (lc($checkid) eq lc($id)) { $found=$checkid;last; } 6031: } 6032: if ($found) { 6033: my $username=$idmap{$found}; 6034: if ($found{'ids'}{$found}) { 6035: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 6036: $line,'duplicateID',$found); 6037: return(1,$currentphase); 6038: } elsif ($found{'usernames'}{$username}) { 6039: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 6040: $line,'duplicateID',$username); 6041: return(1,$currentphase); 6042: } 6043: #FIXME store away line we previously saw the ID on to use above 6044: $found{'ids'}{$found}++; 6045: $found{'usernames'}{$username}++; 6046: } else { 6047: if ($id =~ /^\s*$/) { 6048: my $username=&scan_data($scan_data,"$i.user"); 6049: if (defined($username) && $found{'usernames'}{$username}) { 6050: &scantron_get_correction($r,$i,$scan_record, 6051: \%scantron_config, 6052: $line,'duplicateID',$username); 6053: return(1,$currentphase); 6054: } elsif (!defined($username)) { 6055: &scantron_get_correction($r,$i,$scan_record, 6056: \%scantron_config, 6057: $line,'incorrectID'); 6058: return(1,$currentphase); 6059: } 6060: $found{'usernames'}{$username}++; 6061: } else { 6062: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 6063: $line,'incorrectID'); 6064: return(1,$currentphase); 6065: } 6066: } 6067: } 6068: 6069: return (0,$currentphase+1); 6070: } 6071: 6072: =pod 6073: 6074: =item scantron_get_correction 6075: 6076: Builds the interface screen to interact with the operator to fix a 6077: specific error condition in a specific scanline 6078: 6079: Arguments: 6080: $r - Apache request object 6081: $i - number of the current scanline 6082: $scan_record - hash ref as returned from &scantron_parse_scanline() 6083: $scan_config - hash ref as returned from &get_scantron_config() 6084: $line - full contents of the current scanline 6085: $error - error condition, valid values are 6086: 'incorrectCODE', 'duplicateCODE', 6087: 'doublebubble', 'missingbubble', 6088: 'duplicateID', 'incorrectID' 6089: $arg - extra information needed 6090: For errors: 6091: - duplicateID - paper number that this studentID was seen before on 6092: - duplicateCODE - array ref of the paper numbers this CODE was 6093: seen on before 6094: - incorrectCODE - current incorrect CODE 6095: - doublebubble - array ref of the bubble lines that have double 6096: bubble errors 6097: - missingbubble - array ref of the bubble lines that have missing 6098: bubble errors 6099: 6100: =cut 6101: 6102: sub scantron_get_correction { 6103: my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; 6104: 6105: #FIXME in the case of a duplicated ID the previous line, probaly need 6106: #to show both the current line and the previous one and allow skipping 6107: #the previous one or the current one 6108: 6109: $r->print("<p><b>An error was detected ($error)</b>"); 6110: if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { 6111: $r->print(" for PaperID <tt>". 6112: $$scan_record{'scantron.PaperID'}."</tt> \n"); 6113: } else { 6114: $r->print(" in scanline $i <pre>". 6115: $line."</pre> \n"); 6116: } 6117: my $message="<p>The ID on the form is <tt>". 6118: $$scan_record{'scantron.ID'}."</tt><br />\n". 6119: "The name on the paper is ". 6120: $$scan_record{'scantron.LastName'}.",". 6121: $$scan_record{'scantron.FirstName'}."</p>"; 6122: 6123: $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); 6124: $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n"); 6125: if ($error =~ /ID$/) { 6126: if ($error eq 'incorrectID') { 6127: $r->print("The encoded ID is not in the classlist</p>\n"); 6128: } elsif ($error eq 'duplicateID') { 6129: $r->print("The encoded ID has also been used by a previous paper $arg</p>\n"); 6130: } 6131: $r->print($message); 6132: $r->print("<p>How should I handle this? <br /> \n"); 6133: $r->print("\n<ul><li> "); 6134: #FIXME it would be nice if this sent back the user ID and 6135: #could do partial userID matches 6136: $r->print(&Apache::loncommon::selectstudent_link('scantronupload', 6137: 'scantron_username','scantron_domain')); 6138: $r->print(": <input type='text' name='scantron_username' value='' />"); 6139: $r->print("\n@". 6140: &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain')); 6141: 6142: $r->print('</li>'); 6143: } elsif ($error =~ /CODE$/) { 6144: if ($error eq 'incorrectCODE') { 6145: $r->print("</p><p>The encoded CODE is not in the list of possible CODEs</p>\n"); 6146: } elsif ($error eq 'duplicateCODE') { 6147: $r->print("</p><p>The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique</p>\n"); 6148: } 6149: $r->print("<p>The CODE on the form is <tt>'". 6150: $$scan_record{'scantron.CODE'}."'</tt><br />\n"); 6151: $r->print($message); 6152: $r->print("<p>How should I handle this? <br /> \n"); 6153: $r->print("\n<br /> "); 6154: my $i=0; 6155: if ($error eq 'incorrectCODE' 6156: && $$scan_record{'scantron.CODE'}=~/\S/ ) { 6157: my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); 6158: if ($closest > 0) { 6159: foreach my $testcode (@{$closest}) { 6160: my $checked=''; 6161: if (!$i) { $checked=' checked="checked" '; } 6162: $r->print("<label><input type='radio' name='scantron_CODE_resolution' value='use_closest_$i' $checked /> Use the similar CODE <b><tt>".$testcode."</tt></b> instead.</label><input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />"); 6163: $r->print("\n<br />"); 6164: $i++; 6165: } 6166: } 6167: } 6168: if ($$scan_record{'scantron.CODE'}=~/\S/ ) { 6169: my $checked; if (!$i) { $checked=' checked="checked" '; } 6170: $r->print("<label><input type='radio' name='scantron_CODE_resolution' value='use_unfound' $checked /> Use the CODE <b><tt>".$$scan_record{'scantron.CODE'}."</tt></b> that is was on the paper, ignoring the error.</label>"); 6171: $r->print("\n<br />"); 6172: } 6173: 6174: $r->print(<<ENDSCRIPT); 6175: <script type="text/javascript"> 6176: function change_radio(field) { 6177: var slct=document.scantronupload.scantron_CODE_resolution; 6178: var i; 6179: for (i=0;i<slct.length;i++) { 6180: if (slct[i].value==field) { slct[i].checked=true; } 6181: } 6182: } 6183: </script> 6184: ENDSCRIPT 6185: my $href="/adm/pickcode?". 6186: "form=".&escape("scantronupload"). 6187: "&scantron_format=".&escape($env{'form.scantron_format'}). 6188: "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). 6189: "&curCODE=".&escape($$scan_record{'scantron.CODE'}). 6190: "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); 6191: if ($env{'form.scantron_CODElist'} =~ /\S/) { 6192: $r->print("<label><input type='radio' name='scantron_CODE_resolution' value='use_found' /> <a target='_blank' href='$href'>Select</a> a CODE from the list of all CODEs and use it.</label> Selected CODE is <input readonly='true' type='text' size='8' name='scantron_CODE_selectedvalue' onfocus=\"javascript:change_radio('use_found')\" onchange=\"javascript:change_radio('use_found')\" />"); 6193: $r->print("\n<br />"); 6194: } 6195: $r->print("<label><input type='radio' name='scantron_CODE_resolution' value='use_typed' /> Use </label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" /> as the CODE."); 6196: $r->print("\n<br /><br />"); 6197: } elsif ($error eq 'doublebubble') { 6198: $r->print("<p>There have been multiple bubbles scanned for a some question(s)</p>\n"); 6199: $r->print('<input type="hidden" name="scantron_questions" value="'. 6200: join(',',@{$arg}).'" />'); 6201: $r->print($message); 6202: $r->print("<p>Please indicate which bubble should be used for grading</p>"); 6203: foreach my $question (@{$arg}) { 6204: my $selected=$$scan_record{"scantron.$question.answer"}; 6205: &scantron_bubble_selector($r,$scan_config,$question, 6206: split('',$selected)); 6207: } 6208: } elsif ($error eq 'missingbubble') { 6209: $r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n"); 6210: $r->print($message); 6211: $r->print("<p>Please indicate which bubble should be used for grading</p>"); 6212: $r->print("Some questions have no scanned bubbles\n"); 6213: $r->print('<input type="hidden" name="scantron_questions" value="'. 6214: join(',',@{$arg}).'" />'); 6215: foreach my $question (@{$arg}) { 6216: my $selected=$$scan_record{"scantron.$question.answer"}; 6217: &scantron_bubble_selector($r,$scan_config,$question); 6218: } 6219: } else { 6220: $r->print("\n<ul>"); 6221: } 6222: $r->print("\n</li></ul>"); 6223: 6224: } 6225: 6226: =pod 6227: 6228: =item scantron_bubble_selector 6229: 6230: Generates the html radiobuttons to correct a single bubble line 6231: possibly showing the existing the selected bubbles if known 6232: 6233: Arguments: 6234: $r - Apache request object 6235: $scan_config - hash from &get_scantron_config() 6236: $quest - number of the bubble line to make a corrector for 6237: $selected - array of letters of previously selected bubbles 6238: $lines - if present, number of bubble lines to show 6239: 6240: =cut 6241: 6242: sub scantron_bubble_selector { 6243: my ($r,$scan_config,$quest,@selected, $lines)=@_; 6244: my $max=$$scan_config{'Qlength'}; 6245: 6246: my $scmode=$$scan_config{'Qon'}; 6247: if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } 6248: 6249: 6250: if (!defined($lines)) { 6251: $lines = 1; 6252: } 6253: my $total_lines = $lines*2; 6254: my @alphabet=('A'..'Z'); 6255: $r->print("<table border='1'><tr><td rowspan='".$total_lines."'>$quest</td>"); 6256: 6257: for (my $l = 0; $l < $lines; $l++) { 6258: if ($l != 0) { 6259: $r->print('<tr>'); 6260: } 6261: 6262: # FIXME: This loop probably has to be considerably more clever for 6263: # multiline bubbles: User can multibubble by having bubbles in 6264: # several lines. User can skip lines legitimately etc. etc. 6265: 6266: for (my $i=0;$i<$max;$i++) { 6267: $r->print("\n".'<td align="center">'); 6268: if ($selected[0] eq $alphabet[$i]) { 6269: $r->print('X'); 6270: shift(@selected) ; 6271: } else { 6272: $r->print(' '); 6273: } 6274: $r->print('</td>'); 6275: 6276: } 6277: 6278: if ($l == 0) { 6279: my $lspan = $total_lines * 2; # 2 table rows per bubble line. 6280: 6281: $r->print('<td rowspan='.$lspan.'><label><input type="radio" name="scantron_correct_Q_'. 6282: $quest.'" value="none" /> No bubble </label></td>'); 6283: 6284: } 6285: 6286: $r->print('</tr><tr>'); 6287: 6288: # FIXME: This may have to be a bit more clever for 6289: # multiline questions (different values e.g..). 6290: 6291: for (my $i=0;$i<$max;$i++) { 6292: $r->print("\n". 6293: '<td><label><input type="radio" name="scantron_correct_Q_'. 6294: $quest.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>"); 6295: } 6296: $r->print('</tr>'); 6297: 6298: 6299: } 6300: $r->print('</table>'); 6301: } 6302: 6303: =pod 6304: 6305: =item num_matches 6306: 6307: Counts the number of characters that are the same between the two arguments. 6308: 6309: Arguments: 6310: $orig - CODE from the scanline 6311: $code - CODE to match against 6312: 6313: Returns: 6314: $count - integer count of the number of same characters between the 6315: two arguments 6316: 6317: =cut 6318: 6319: sub num_matches { 6320: my ($orig,$code) = @_; 6321: my @code=split(//,$code); 6322: my @orig=split(//,$orig); 6323: my $same=0; 6324: for (my $i=0;$i<scalar(@code);$i++) { 6325: if ($code[$i] eq $orig[$i]) { $same++; } 6326: } 6327: return $same; 6328: } 6329: 6330: =pod 6331: 6332: =item scantron_get_closely_matching_CODEs 6333: 6334: Cycles through all CODEs and finds the set that has the greatest 6335: number of same characters as the provided CODE 6336: 6337: Arguments: 6338: $allcodes - hash ref returned by &get_codes() 6339: $CODE - CODE from the current scanline 6340: 6341: Returns: 6342: 2 element list 6343: - first elements is number of how closely matching the best fit is 6344: (5 means best set has 5 matching characters) 6345: - second element is an arrary ref containing the set of valid CODEs 6346: that best fit the passed in CODE 6347: 6348: =cut 6349: 6350: sub scantron_get_closely_matching_CODEs { 6351: my ($allcodes,$CODE)=@_; 6352: my @CODEs; 6353: foreach my $testcode (sort(keys(%{$allcodes}))) { 6354: push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode); 6355: } 6356: 6357: return ($#CODEs,$CODEs[-1]); 6358: } 6359: 6360: =pod 6361: 6362: =item get_codes 6363: 6364: Builds a hash which has keys of all of the valid CODEs from the selected 6365: set of remembered CODEs. 6366: 6367: Arguments: 6368: $old_name - name of the set of remembered CODEs 6369: $cdom - domain of the course 6370: $cnum - internal course name 6371: 6372: Returns: 6373: %allcodes - keys are the valid CODEs, values are all 1 6374: 6375: =cut 6376: 6377: sub get_codes { 6378: my ($old_name, $cdom, $cnum) = @_; 6379: if (!$old_name) { 6380: $old_name=$env{'form.scantron_CODElist'}; 6381: } 6382: if (!$cdom) { 6383: $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'}; 6384: } 6385: if (!$cnum) { 6386: $cnum =$env{'course.'.$env{'request.course.id'}.'.num'}; 6387: } 6388: my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"], 6389: $cdom,$cnum); 6390: my %allcodes; 6391: if ($result{"type\0$old_name"} eq 'number') { 6392: %allcodes=map {($_,1)} split(',',$result{$old_name}); 6393: } else { 6394: %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); 6395: } 6396: return %allcodes; 6397: } 6398: 6399: =pod 6400: 6401: =item scantron_validate_CODE 6402: 6403: Validates all scanlines in the selected file to not have any 6404: invalid or underspecified CODEs and that none of the codes are 6405: duplicated if this was requested. 6406: 6407: =cut 6408: 6409: sub scantron_validate_CODE { 6410: my ($r,$currentphase) = @_; 6411: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6412: if ($scantron_config{'CODElocation'} && 6413: $scantron_config{'CODEstart'} && 6414: $scantron_config{'CODElength'}) { 6415: if (!defined($env{'form.scantron_CODElist'})) { 6416: &FIXME_blow_up() 6417: } 6418: } else { 6419: return (0,$currentphase+1); 6420: } 6421: 6422: my %usedCODEs; 6423: 6424: my %allcodes=&get_codes(); 6425: 6426: my ($scanlines,$scan_data)=&scantron_getfile(); 6427: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 6428: my $line=&scantron_get_line($scanlines,$scan_data,$i); 6429: if ($line=~/^[\s\cz]*$/) { next; } 6430: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 6431: $scan_data); 6432: my $CODE=$$scan_record{'scantron.CODE'}; 6433: my $error=0; 6434: if (!&Apache::lonnet::validCODE($CODE)) { 6435: &scantron_get_correction($r,$i,$scan_record, 6436: \%scantron_config, 6437: $line,'incorrectCODE',\%allcodes); 6438: return(1,$currentphase); 6439: } 6440: if (%allcodes && !exists($allcodes{$CODE}) 6441: && !$$scan_record{'scantron.useCODE'}) { 6442: &scantron_get_correction($r,$i,$scan_record, 6443: \%scantron_config, 6444: $line,'incorrectCODE',\%allcodes); 6445: return(1,$currentphase); 6446: } 6447: if (exists($usedCODEs{$CODE}) 6448: && $env{'form.scantron_CODEunique'} eq 'yes' 6449: && !$$scan_record{'scantron.CODE_ignore_dup'}) { 6450: &scantron_get_correction($r,$i,$scan_record, 6451: \%scantron_config, 6452: $line,'duplicateCODE',$usedCODEs{$CODE}); 6453: return(1,$currentphase); 6454: } 6455: push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); 6456: } 6457: return (0,$currentphase+1); 6458: } 6459: 6460: =pod 6461: 6462: =item scantron_validate_doublebubble 6463: 6464: Validates all scanlines in the selected file to not have any 6465: bubble lines with multiple bubbles marked. 6466: 6467: =cut 6468: 6469: sub scantron_validate_doublebubble { 6470: my ($r,$currentphase) = @_; 6471: #get student info 6472: my $classlist=&Apache::loncoursedata::get_classlist(); 6473: my %idmap=&username_to_idmap($classlist); 6474: 6475: #get scantron line setup 6476: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6477: my ($scanlines,$scan_data)=&scantron_getfile(); 6478: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 6479: my $line=&scantron_get_line($scanlines,$scan_data,$i); 6480: if ($line=~/^[\s\cz]*$/) { next; } 6481: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 6482: $scan_data); 6483: if (!defined($$scan_record{'scantron.doubleerror'})) { next; } 6484: &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, 6485: 'doublebubble', 6486: $$scan_record{'scantron.doubleerror'}); 6487: return (1,$currentphase); 6488: } 6489: return (0,$currentphase+1); 6490: } 6491: 6492: =pod 6493: 6494: =item scantron_get_maxbubble 6495: 6496: Returns the maximum number of bubble lines that are expected to 6497: occur. Does this by walking the selected sequence rendering the 6498: resource and then checking &Apache::lonxml::get_problem_counter() 6499: for what the current value of the problem counter is. 6500: 6501: Caches the result to $env{'form.scantron_maxbubble'} 6502: 6503: =cut 6504: 6505: sub scantron_get_maxbubble { 6506: 6507: if (defined($env{'form.scantron_maxbubble'}) && 6508: $env{'form.scantron_maxbubble'}) { 6509: return $env{'form.scantron_maxbubble'}; 6510: } 6511: 6512: my $navmap=Apache::lonnavmaps::navmap->new(); 6513: my (undef,undef,$sequence)= 6514: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 6515: 6516: my $map=$navmap->getResourceByUrl($sequence); 6517: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 6518: 6519: &Apache::lonxml::clear_problem_counter(); 6520: 6521: my $uname = $env{'form.student'}; 6522: my $udom = $env{'form.userdom'}; 6523: my $cid = $env{'request.course.id'}; 6524: my $total_lines = 0; 6525: %bubble_lines_per_response = (); 6526: 6527: foreach my $resource (@resources) { 6528: my $symb = $resource->symb(); 6529: my $result=&Apache::lonnet::ssi($resource->src(), 6530: ('symb' => $resource->symb()), 6531: ('grade_target' => 'analyze'), 6532: ('grade_courseid' => $cid), 6533: ('grade_domain' => $udom), 6534: ('grade_username' => $uname)); 6535: my (undef, $an) = 6536: split(/_HASH_REF__/,$result, 2); 6537: 6538: my %analysis = &Apache::lonnet::str2hash($an); 6539: 6540: 6541: 6542: foreach my $part_id (@{$analysis{'parts'}}) { 6543: my $bubble_lines = $analysis{"$part_id.bubble_lines"}[0]; 6544: if (!$bubble_lines) { 6545: $bubble_lines = 1; 6546: } 6547: $bubble_lines_per_response{"$symb.$part_id"} = $bubble_lines; 6548: $total_lines = $total_lines + $bubble_lines; 6549: } 6550: 6551: } 6552: &Apache::lonnet::delenv('scantron\.'); 6553: $env{'form.scantron_maxbubble'} = 6554: $total_lines; 6555: return $env{'form.scantron_maxbubble'}; 6556: } 6557: 6558: =pod 6559: 6560: =item scantron_validate_missingbubbles 6561: 6562: Validates all scanlines in the selected file to not have any 6563: bubble lines with missing bubbles that haven't been verified as missing. 6564: 6565: =cut 6566: 6567: sub scantron_validate_missingbubbles { 6568: my ($r,$currentphase) = @_; 6569: #get student info 6570: my $classlist=&Apache::loncoursedata::get_classlist(); 6571: my %idmap=&username_to_idmap($classlist); 6572: 6573: #get scantron line setup 6574: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6575: my ($scanlines,$scan_data)=&scantron_getfile(); 6576: my $max_bubble=&scantron_get_maxbubble(); 6577: if (!$max_bubble) { $max_bubble=2**31; } 6578: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 6579: my $line=&scantron_get_line($scanlines,$scan_data,$i); 6580: if ($line=~/^[\s\cz]*$/) { next; } 6581: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 6582: $scan_data); 6583: if (!defined($$scan_record{'scantron.missingerror'})) { next; } 6584: my @to_correct; 6585: foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { 6586: if ($missing > $max_bubble) { next; } 6587: push(@to_correct,$missing); 6588: } 6589: if (@to_correct) { 6590: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 6591: $line,'missingbubble',\@to_correct); 6592: return (1,$currentphase); 6593: } 6594: 6595: } 6596: return (0,$currentphase+1); 6597: } 6598: 6599: =pod 6600: 6601: =item scantron_process_students 6602: 6603: Routine that does the actual grading of the bubble sheet information. 6604: 6605: The parsed scanline hash is added to %env 6606: 6607: Then foreach unskipped scanline it does an &Apache::lonnet::ssi() 6608: foreach resource , with the form data of 6609: 6610: 'submitted' =>'scantron' 6611: 'grade_target' =>'grade', 6612: 'grade_username'=> username of student 6613: 'grade_domain' => domain of student 6614: 'grade_courseid'=> of course 6615: 'grade_symb' => symb of resource to grade 6616: 6617: This triggers a grading pass. The problem grading code takes care 6618: of converting the bubbled letter information (now in %env) into a 6619: valid submission. 6620: 6621: =cut 6622: 6623: sub scantron_process_students { 6624: my ($r) = @_; 6625: my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); 6626: my ($symb)=&get_symb($r); 6627: if (!$symb) {return '';} 6628: my $default_form_data=&defaultFormData($symb); 6629: 6630: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6631: my ($scanlines,$scan_data)=&scantron_getfile(); 6632: my $classlist=&Apache::loncoursedata::get_classlist(); 6633: my %idmap=&username_to_idmap($classlist); 6634: my $navmap=Apache::lonnavmaps::navmap->new(); 6635: my $map=$navmap->getResourceByUrl($sequence); 6636: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 6637: # $r->print("geto ".scalar(@resources)."<br />"); 6638: my $result= <<SCANTRONFORM; 6639: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> 6640: <input type="hidden" name="command" value="scantron_configphase" /> 6641: $default_form_data 6642: SCANTRONFORM 6643: $r->print($result); 6644: 6645: my @delayqueue; 6646: my %completedstudents; 6647: 6648: my $count=&get_todo_count($scanlines,$scan_data); 6649: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', 6650: 'Scantron Progress',$count, 6651: 'inline',undef,'scantronupload'); 6652: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 6653: 'Processing first student'); 6654: my $start=&Time::HiRes::time(); 6655: my $i=-1; 6656: my ($uname,$udom,$started); 6657: while ($i<$scanlines->{'count'}) { 6658: ($uname,$udom)=('',''); 6659: $i++; 6660: my $line=&scantron_get_line($scanlines,$scan_data,$i); 6661: if ($line=~/^[\s\cz]*$/) { next; } 6662: if ($started) { 6663: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, 6664: 'last student'); 6665: } 6666: $started=1; 6667: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 6668: $scan_data); 6669: unless ($uname=&scantron_find_student($scan_record,$scan_data, 6670: \%idmap,$i)) { 6671: &scantron_add_delay(\@delayqueue,$line, 6672: 'Unable to find a student that matches',1); 6673: next; 6674: } 6675: if (exists $completedstudents{$uname}) { 6676: &scantron_add_delay(\@delayqueue,$line, 6677: 'Student '.$uname.' has multiple sheets',2); 6678: next; 6679: } 6680: ($uname,$udom)=split(/:/,$uname); 6681: 6682: &Apache::lonxml::clear_problem_counter(); 6683: &Apache::lonnet::appenv(%$scan_record); 6684: 6685: if (&scantron_clear_skip($scanlines,$scan_data,$i)) { 6686: &scantron_putfile($scanlines,$scan_data); 6687: } 6688: 6689: my $i=0; 6690: foreach my $resource (@resources) { 6691: $i++; 6692: my %form=('submitted' =>'scantron', 6693: 'grade_target' =>'grade', 6694: 'grade_username'=>$uname, 6695: 'grade_domain' =>$udom, 6696: 'grade_courseid'=>$env{'request.course.id'}, 6697: 'grade_symb' =>$resource->symb()); 6698: if (exists($scan_record->{'scantron.CODE'}) 6699: && 6700: &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) { 6701: $form{'CODE'}=$scan_record->{'scantron.CODE'}; 6702: } else { 6703: $form{'CODE'}=''; 6704: } 6705: my $result=&Apache::lonnet::ssi($resource->src(),%form); 6706: if ($result ne '') { 6707: &Apache::lonnet::logthis("scantron grading error -> $result"); 6708: &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $env{'request.course.id'} url ".$resource->src()); 6709: } 6710: if (&Apache::loncommon::connection_aborted($r)) { last; } 6711: } 6712: $completedstudents{$uname}={'line'=>$line}; 6713: if (&Apache::loncommon::connection_aborted($r)) { last; } 6714: } continue { 6715: &Apache::lonxml::clear_problem_counter(); 6716: &Apache::lonnet::delenv('scantron\.'); 6717: } 6718: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 6719: # my $lasttime = &Time::HiRes::time()-$start; 6720: # $r->print("<p>took $lasttime</p>"); 6721: 6722: $r->print("</form>"); 6723: $r->print(&show_grading_menu_form($symb)); 6724: return ''; 6725: } 6726: 6727: =pod 6728: 6729: =item scantron_upload_scantron_data 6730: 6731: Creates the screen for adding a new bubble sheet data file to a course. 6732: 6733: =cut 6734: 6735: sub scantron_upload_scantron_data { 6736: my ($r)=@_; 6737: $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'})); 6738: my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', 6739: 'domainid', 6740: 'coursename'); 6741: my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, 6742: 'domainid'); 6743: my $default_form_data=&defaultFormData(&get_symb($r,1)); 6744: $r->print(<<UPLOAD); 6745: <script type="text/javascript" language="javascript"> 6746: function checkUpload(formname) { 6747: if (formname.upfile.value == "") { 6748: alert("Please use the browse button to select a file from your local directory."); 6749: return false; 6750: } 6751: formname.submit(); 6752: } 6753: </script> 6754: 6755: <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'> 6756: $default_form_data 6757: <table> 6758: <tr><td>$select_link </td></tr> 6759: <tr><td>Course ID: </td><td><input name='courseid' type='text' /> </td></tr> 6760: <tr><td>Course Name: </td><td><input name='coursename' type='text' /></td></tr> 6761: <tr><td>Domain: </td><td>$domsel </td></tr> 6762: <tr><td>File to upload:</td><td><input type="file" name="upfile" size="50" /></td></tr> 6763: </table> 6764: <input name='command' value='scantronupload_save' type='hidden' /> 6765: <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" /> 6766: </form> 6767: UPLOAD 6768: return ''; 6769: } 6770: 6771: =pod 6772: 6773: =item scantron_upload_scantron_data_save 6774: 6775: Adds a provided bubble information data file to the course if user 6776: has the correct privileges to do so. 6777: 6778: =cut 6779: 6780: sub scantron_upload_scantron_data_save { 6781: my($r)=@_; 6782: my ($symb)=&get_symb($r,1); 6783: my $doanotherupload= 6784: '<br /><form action="/adm/grades" method="post">'."\n". 6785: '<input type="hidden" name="command" value="scantronupload" />'."\n". 6786: '<input type="submit" name="submit" value="Do Another Upload" />'."\n". 6787: '</form>'."\n"; 6788: if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && 6789: !&Apache::lonnet::allowed('usc', 6790: $env{'form.domainid'}.'_'.$env{'form.courseid'})) { 6791: $r->print("You are not allowed to upload Scantron data to the requested course.<br />"); 6792: if ($symb) { 6793: $r->print(&show_grading_menu_form($symb)); 6794: } else { 6795: $r->print($doanotherupload); 6796: } 6797: return ''; 6798: } 6799: my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); 6800: $r->print("Doing upload to ".$coursedata{'description'}." <br />"); 6801: my $fname=$env{'form.upfile.filename'}; 6802: #FIXME 6803: #copied from lonnet::userfileupload() 6804: #make that function able to target a specified course 6805: # Replace Windows backslashes by forward slashes 6806: $fname=~s/\\/\//g; 6807: # Get rid of everything but the actual filename 6808: $fname=~s/^.*\/([^\/]+)$/$1/; 6809: # Replace spaces by underscores 6810: $fname=~s/\s+/\_/g; 6811: # Replace all other weird characters by nothing 6812: $fname=~s/[^\w\.\-]//g; 6813: # See if there is anything left 6814: unless ($fname) { return 'error: no uploaded file'; } 6815: my $uploadedfile=$fname; 6816: $fname='scantron_orig_'.$fname; 6817: if (length($env{'form.upfile'}) < 2) { 6818: $r->print("<span class=\"LC_error\">Error:</span> The file you attempted to upload, <tt>".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</tt>, contained no information. Please check that you entered the correct filename."); 6819: } else { 6820: my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname); 6821: if ($result =~ m|^/uploaded/|) { 6822: $r->print("<span class=\"LC_success\">Success:</span> Successfully uploaded ".(length($env{'form.upfile'})-1)." bytes of data into location <tt>".$result."</tt>"); 6823: } else { 6824: $r->print("<span class=\"LC_error\">Error:</span> An error (".$result.") occurred when attempting to upload the file, <tt>".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</tt>"); 6825: } 6826: } 6827: if ($symb) { 6828: $r->print(&scantron_selectphase($r,$uploadedfile)); 6829: } else { 6830: $r->print($doanotherupload); 6831: } 6832: return ''; 6833: } 6834: 6835: =pod 6836: 6837: =item valid_file 6838: 6839: Validates that the requested bubble data file exists in the course. 6840: 6841: =cut 6842: 6843: sub valid_file { 6844: my ($requested_file)=@_; 6845: foreach my $filename (sort(&scantron_filenames())) { 6846: if ($requested_file eq $filename) { return 1; } 6847: } 6848: return 0; 6849: } 6850: 6851: =pod 6852: 6853: =item scantron_download_scantron_data 6854: 6855: Shows a list of the three internal files (original, corrected, 6856: skipped) for a specific bubble sheet data file that exists in the 6857: course. 6858: 6859: =cut 6860: 6861: sub scantron_download_scantron_data { 6862: my ($r)=@_; 6863: my $default_form_data=&defaultFormData(&get_symb($r,1)); 6864: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6865: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6866: my $file=$env{'form.scantron_selectfile'}; 6867: if (! &valid_file($file)) { 6868: $r->print(<<ERROR); 6869: <p> 6870: The requested file name was invalid. 6871: </p> 6872: ERROR 6873: $r->print(&show_grading_menu_form(&get_symb($r,1))); 6874: return; 6875: } 6876: my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; 6877: my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file; 6878: my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file; 6879: &Apache::lonnet::allowuploaded('/adm/grades',$orig); 6880: &Apache::lonnet::allowuploaded('/adm/grades',$corrected); 6881: &Apache::lonnet::allowuploaded('/adm/grades',$skipped); 6882: $r->print(<<DOWNLOAD); 6883: <p> 6884: <a href="$orig">Original</a> file as uploaded by the scantron office. 6885: </p> 6886: <p> 6887: <a href="$corrected">Corrections</a>, a file of corrected records that were used in grading. 6888: </p> 6889: <p> 6890: <a href="$skipped">Skipped</a>, a file of records that were skipped. 6891: </p> 6892: DOWNLOAD 6893: $r->print(&show_grading_menu_form(&get_symb($r,1))); 6894: return ''; 6895: } 6896: 6897: =pod 6898: 6899: =back 6900: 6901: =cut 6902: 6903: #-------- end of section for handling grading scantron forms ------- 6904: # 6905: #------------------------------------------------------------------- 6906: 6907: #-------------------------- Menu interface ------------------------- 6908: # 6909: #--- Show a Grading Menu button - Calls the next routine --- 6910: sub show_grading_menu_form { 6911: my ($symb)=@_; 6912: my $result.='<br /><form action="/adm/grades" method="post">'."\n". 6913: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 6914: '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n". 6915: '<input type="hidden" name="command" value="gradingmenu" />'."\n". 6916: '<input type="submit" name="submit" value="Grading Menu" />'."\n". 6917: '</form>'."\n"; 6918: return $result; 6919: } 6920: 6921: # -- Retrieve choices for grading form 6922: sub savedState { 6923: my %savedState = (); 6924: if ($env{'form.saveState'}) { 6925: foreach (split(/:/,$env{'form.saveState'})) { 6926: my ($key,$value) = split(/=/,$_,2); 6927: $savedState{$key} = $value; 6928: } 6929: } 6930: return \%savedState; 6931: } 6932: 6933: #--- Displays the main menu page ------- 6934: sub gradingmenu { 6935: my ($request) = @_; 6936: my ($symb)=&get_symb($request); 6937: if (!$symb) {return '';} 6938: my $probTitle = &Apache::lonnet::gettitle($symb); 6939: 6940: $request->print(<<GRADINGMENUJS); 6941: <script type="text/javascript" language="javascript"> 6942: function checkChoice(formname,val,cmdx) { 6943: if (val <= 2) { 6944: var cmd = radioSelection(formname.radioChoice); 6945: var cmdsave = cmd; 6946: } else { 6947: cmd = cmdx; 6948: cmdsave = 'submission'; 6949: } 6950: formname.command.value = cmd; 6951: formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+ 6952: ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); 6953: if (val < 5) formname.submit(); 6954: if (val == 5) { 6955: if (!checkReceiptNo(formname,'notOK')) { return false;} 6956: formname.submit(); 6957: } 6958: if (val < 7) formname.submit(); 6959: } 6960: 6961: function checkReceiptNo(formname,nospace) { 6962: var receiptNo = formname.receipt.value; 6963: var checkOpt = false; 6964: if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;} 6965: if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;} 6966: if (checkOpt) { 6967: alert("Please enter a receipt number given by a student in the receipt box."); 6968: formname.receipt.value = ""; 6969: formname.receipt.focus(); 6970: return false; 6971: } 6972: return true; 6973: } 6974: </script> 6975: GRADINGMENUJS 6976: &commonJSfunctions($request); 6977: my $result='<h3> <span class="LC_info">Manual Grading/View Submission</span></h3>'; 6978: my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); 6979: $result.=$table; 6980: my (undef,$sections) = &getclasslist('all','0'); 6981: my $savedState = &savedState(); 6982: my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'}); 6983: my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'}); 6984: my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'}); 6985: my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'}); 6986: 6987: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 6988: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 6989: '<input type="hidden" name="handgrade" value="'.$hdgrade.'" />'."\n". 6990: '<input type="hidden" name="probTitle" value="'.$probTitle.'" />'."\n". 6991: '<input type="hidden" name="command" value="" />'."\n". 6992: '<input type="hidden" name="saveState" value="" />'."\n". 6993: '<input type="hidden" name="gradingMenu" value="1" />'."\n". 6994: '<input type="hidden" name="showgrading" value="yes" />'."\n"; 6995: 6996: $result.='<table width="100%" border="0"><tr><td bgcolor=#777777>'."\n". 6997: '<table width="100%" border="0"><tr bgcolor="#e6ffff"><td colspan="2">'."\n". 6998: ' <b>Select a Grading/Viewing Option</b></td></tr>'."\n". 6999: '<tr bgcolor="#ffffe6" valign="top"><td>'."\n"; 7000: 7001: $result.='<table width="100%" border="0">'; 7002: $result.='<tr bgcolor="#ffffe6" valign="top"><td>'."\n". 7003: ' '.&mt('Select Section').': <select name="section" multiple="multiple" size="3">'."\n"; 7004: if (ref($sections)) { 7005: foreach (sort (@$sections)) { 7006: $result.='<option value="'.$_.'" '. 7007: ($saveSec eq $_ ? 'selected="selected"':'').'>'.$_.'</option>'."\n"; 7008: } 7009: } 7010: $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="selected"' : ''). '>all</option></select>   '; 7011: 7012: $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); 7013: 7014: $result.='</td></tr>'; 7015: 7016: $result.='<tr bgcolor="#ffffe6"valign="top"><td><label>'. 7017: '<input type="radio" name="radioChoice" value="submission" '. 7018: ($saveCmd eq 'submission' ? 'checked="checked"' : '').' /> '.'<b>'.&mt('Current Resource').':</b> '.&mt('For one or more students'). 7019: '</label> <select name="submitonly">'. 7020: '<option value="yes" '. 7021: ($saveSub eq 'yes' ? 'selected="selected"' : '').'>'.&mt('with submissions').'</option>'. 7022: '<option value="queued" '. 7023: ($saveSub eq 'queued' ? 'selected="selected"' : '').'>'.&mt('in grading queue').'</option>'. 7024: '<option value="graded" '. 7025: ($saveSub eq 'graded' ? 'selected="selected"' : '').'>'.&mt('with ungraded submissions').'</option>'. 7026: '<option value="incorrect" '. 7027: ($saveSub eq 'incorrect' ? 'selected="selected"' : '').'>'.&mt('with incorrect submissions').'</option>'. 7028: '<option value="all" '. 7029: ($saveSub eq 'all' ? 'selected="selected"' : '').'>'.&mt('with any status').'</option></select></td></tr>'."\n"; 7030: 7031: $result.='<tr bgcolor="#ffffe6"valign="top"><td>'. 7032: '<label><input type="radio" name="radioChoice" value="viewgrades" '. 7033: ($saveCmd eq 'viewgrades' ? 'checked="checked"' : '').' /> '. 7034: '<b>Current Resource:</b> For all students in selected section or course</label></td></tr>'."\n"; 7035: 7036: $result.='<tr bgcolor="#ffffe6" valign="top"><td>'. 7037: '<label><input type="radio" name="radioChoice" value="pickStudentPage" '. 7038: ($saveCmd eq 'pickStudentPage' ? 'checked="checked"' : '').' /> '. 7039: 'The <b>complete</b> set/page/sequence: For one student</label></td></tr>'."\n"; 7040: 7041: $result.='<tr bgcolor="#ffffe6"><td><br />'. 7042: '<input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="Next->" />'. 7043: '</td></tr></table>'."\n"; 7044: 7045: $result.='</td><td valign="top">'; 7046: 7047: $result.='<table width="100%" border="0">'; 7048: $result.='<tr bgcolor="#ffffe6"><td>'. 7049: '<input type="button" onClick="javascript:checkChoice(this.form,\'3\',\'csvform\');" value="'.&mt('Upload').'" />'. 7050: ' '.&mt('scores from file').' </td></tr>'."\n"; 7051: 7052: $result.='<tr bgcolor="#ffffe6"><td>'. 7053: '<input type="button" onClick="javascript:checkChoice(this.form,\'6\',\'processclicker\');" value="'.&mt('Process').'" />'. 7054: ' '.&mt('clicker file').' </td></tr>'."\n"; 7055: 7056: $result.='<tr bgcolor="#ffffe6"valign="top"><td colspan="2">'. 7057: '<input type="button" onClick="javascript:checkChoice(this.form,\'4\',\'scantron_selectphase\');'. 7058: '" value="'.&mt('Grade').'" /> scantron forms</td></tr>'."\n"; 7059: 7060: if ((&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) && ($symb)) { 7061: $result.='<tr bgcolor="#ffffe6"valign="top"><td>'. 7062: '<input type="button" onClick="javascript:checkChoice(this.form,\'5\',\'verify\');" value="'.&mt('Verify').'" />'. 7063: ' '.&mt('receipt').': '. 7064: &Apache::lonnet::recprefix($env{'request.course.id'}). 7065: '-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')" />'. 7066: '</td></tr>'."\n"; 7067: } 7068: $result.='<tr bgcolor="#ffffe6"valign="top"><td colspan="2">'. 7069: '<input type="button" onClick="javascript:this.form.action=\'/adm/helper/resettimes.helper\';this.form.submit();'. 7070: '" value="'.&mt('Manage').'" /> access times.</td></tr>'."\n"; 7071: $result.='<tr bgcolor="#ffffe6"valign="top"><td colspan="2">'. 7072: '<input type="button" onClick="javascript:this.form.command.value=\'codelist\';this.form.action=\'/adm/pickcode\';this.form.submit();'. 7073: '" value="'.&mt('View').'" /> saved CODEs.</td></tr>'."\n"; 7074: 7075: $result.='</table>'."\n". 7076: '</td></tr></table>'."\n". 7077: '</td></tr></table></form>'."\n"; 7078: return $result; 7079: } 7080: 7081: sub reset_perm { 7082: undef(%perm); 7083: } 7084: 7085: sub init_perm { 7086: &reset_perm(); 7087: foreach my $test_perm ('vgr','mgr','opa') { 7088: 7089: my $scope = $env{'request.course.id'}; 7090: if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) { 7091: 7092: $scope .= '/'.$env{'request.course.sec'}; 7093: if ( $perm{$test_perm}= 7094: &Apache::lonnet::allowed($test_perm,$scope)) { 7095: $perm{$test_perm.'_section'}=$env{'request.course.sec'}; 7096: } else { 7097: delete($perm{$test_perm}); 7098: } 7099: } 7100: } 7101: } 7102: 7103: sub gather_clicker_ids { 7104: my %clicker_ids; 7105: 7106: my $classlist = &Apache::loncoursedata::get_classlist(); 7107: 7108: # Set up a couple variables. 7109: my $username_idx = &Apache::loncoursedata::CL_SNAME(); 7110: my $domain_idx = &Apache::loncoursedata::CL_SDOM(); 7111: my $status_idx = &Apache::loncoursedata::CL_STATUS(); 7112: 7113: foreach my $student (keys(%$classlist)) { 7114: if ($classlist->{$student}->[$status_idx] ne 'Active') { next; } 7115: my $username = $classlist->{$student}->[$username_idx]; 7116: my $domain = $classlist->{$student}->[$domain_idx]; 7117: my $clickers = 7118: (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; 7119: foreach my $id (split(/\,/,$clickers)) { 7120: $id=~s/^[\#0]+//; 7121: $id=~s/[\-\:]//g; 7122: if (exists($clicker_ids{$id})) { 7123: $clicker_ids{$id}.=','.$username.':'.$domain; 7124: } else { 7125: $clicker_ids{$id}=$username.':'.$domain; 7126: } 7127: } 7128: } 7129: return %clicker_ids; 7130: } 7131: 7132: sub gather_adv_clicker_ids { 7133: my %clicker_ids; 7134: my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; 7135: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 7136: my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum); 7137: foreach my $element (sort(keys(%coursepersonnel))) { 7138: foreach my $person (split(/\,/,$coursepersonnel{$element})) { 7139: my ($puname,$pudom)=split(/\:/,$person); 7140: my $clickers = 7141: (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; 7142: foreach my $id (split(/\,/,$clickers)) { 7143: $id=~s/^[\#0]+//; 7144: $id=~s/[\-\:]//g; 7145: if (exists($clicker_ids{$id})) { 7146: $clicker_ids{$id}.=','.$puname.':'.$pudom; 7147: } else { 7148: $clicker_ids{$id}=$puname.':'.$pudom; 7149: } 7150: } 7151: } 7152: } 7153: return %clicker_ids; 7154: } 7155: 7156: sub clicker_grading_parameters { 7157: return ('gradingmechanism' => 'scalar', 7158: 'upfiletype' => 'scalar', 7159: 'specificid' => 'scalar', 7160: 'pcorrect' => 'scalar', 7161: 'pincorrect' => 'scalar'); 7162: } 7163: 7164: sub process_clicker { 7165: my ($r)=@_; 7166: my ($symb)=&get_symb($r); 7167: if (!$symb) {return '';} 7168: my $result=&checkforfile_js(); 7169: $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb); 7170: my ($table) = &showResourceInfo($symb,$env{'form.probTitle'}); 7171: $result.=$table; 7172: $result.='<br /><table width="100%" border="0"><tr><td bgcolor="#777777">'."\n"; 7173: $result.='<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>'."\n"; 7174: $result.=' <b>'.&mt('Specify a file containing the clicker information for this resource'). 7175: '.</b></td></tr>'."\n"; 7176: $result.='<tr bgcolor=#ffffe6><td>'."\n"; 7177: # Attempt to restore parameters from last session, set defaults if not present 7178: my %Saveable_Parameters=&clicker_grading_parameters(); 7179: &Apache::loncommon::restore_course_settings('grades_clicker', 7180: \%Saveable_Parameters); 7181: if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; } 7182: if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; } 7183: if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; } 7184: if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; } 7185: 7186: my %checked; 7187: foreach my $gradingmechanism ('attendance','personnel','specific') { 7188: if ($env{'form.gradingmechanism'} eq $gradingmechanism) { 7189: $checked{$gradingmechanism}="checked='checked'"; 7190: } 7191: } 7192: 7193: my $upload=&mt("Upload File"); 7194: my $type=&mt("Type"); 7195: my $attendance=&mt("Award points just for participation"); 7196: my $personnel=&mt("Correctness determined from response by course personnel"); 7197: my $specific=&mt("Correctness determined from response with clicker ID(s)"); 7198: my $pcorrect=&mt("Percentage points for correct solution"); 7199: my $pincorrect=&mt("Percentage points for incorrect solution"); 7200: my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', 7201: ('iclicker' => 'i>clicker', 7202: 'interwrite' => 'interwrite PRS')); 7203: $symb = &Apache::lonenc::check_encrypt($symb); 7204: $result.=<<ENDUPFORM; 7205: <script type="text/javascript"> 7206: function sanitycheck() { 7207: // Accept only integer percentages 7208: document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value); 7209: document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value); 7210: // Find out grading choice 7211: for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) { 7212: if (document.forms.gradesupload.gradingmechanism[i].checked) { 7213: gradingchoice=document.forms.gradesupload.gradingmechanism[i].value; 7214: } 7215: } 7216: // By default, new choice equals user selection 7217: newgradingchoice=gradingchoice; 7218: // Not good to give more points for false answers than correct ones 7219: if (Math.round(document.forms.gradesupload.pcorrect.value)<Math.round(document.forms.gradesupload.pincorrect.value)) { 7220: document.forms.gradesupload.pcorrect.value=document.forms.gradesupload.pincorrect.value; 7221: } 7222: // If new choice is attendance only, and old choice was correctness-based, restore defaults 7223: if ((gradingchoice=='attendance') && (document.forms.gradesupload.waschecked.value!='attendance')) { 7224: document.forms.gradesupload.pcorrect.value=100; 7225: document.forms.gradesupload.pincorrect.value=100; 7226: } 7227: // If the values are different, cannot be attendance only 7228: if ((Math.round(document.forms.gradesupload.pcorrect.value)!=Math.round(document.forms.gradesupload.pincorrect.value)) && 7229: (gradingchoice=='attendance')) { 7230: newgradingchoice='personnel'; 7231: } 7232: // Change grading choice to new one 7233: for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) { 7234: if (document.forms.gradesupload.gradingmechanism[i].value==newgradingchoice) { 7235: document.forms.gradesupload.gradingmechanism[i].checked=true; 7236: } else { 7237: document.forms.gradesupload.gradingmechanism[i].checked=false; 7238: } 7239: } 7240: // Remember the old state 7241: document.forms.gradesupload.waschecked.value=newgradingchoice; 7242: } 7243: </script> 7244: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 7245: <input type="hidden" name="symb" value="$symb" /> 7246: <input type="hidden" name="command" value="processclickerfile" /> 7247: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" /> 7248: <input type="hidden" name="saveState" value="$env{'form.saveState'}" /> 7249: <input type="file" name="upfile" size="50" /> 7250: <br /><label>$type: $selectform</label> 7251: <br /><label>$attendance: <input type="radio" name="gradingmechanism" value="attendance" $checked{'attendance'} onClick="sanitycheck()" /></label> 7252: <br /><label>$personnel: <input type="radio" name="gradingmechanism" value="personnel" $checked{'personnel'} onClick="sanitycheck()" /></label> 7253: <br /><label>$specific: <input type="radio" name="gradingmechanism" value="specific" $checked{'specific'} onClick="sanitycheck()" /></label> 7254: <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" /> 7255: <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" /> 7256: <br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onChange="sanitycheck()" /></label> 7257: <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onChange="sanitycheck()" /></label> 7258: <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="$upload" /> 7259: </form> 7260: ENDUPFORM 7261: $result.='</td></tr></table>'."\n". 7262: '</td></tr></table><br /><br />'."\n"; 7263: $result.=&show_grading_menu_form($symb); 7264: return $result; 7265: } 7266: 7267: sub process_clicker_file { 7268: my ($r)=@_; 7269: my ($symb)=&get_symb($r); 7270: if (!$symb) {return '';} 7271: 7272: my %Saveable_Parameters=&clicker_grading_parameters(); 7273: &Apache::loncommon::store_course_settings('grades_clicker', 7274: \%Saveable_Parameters); 7275: 7276: my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); 7277: if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { 7278: $result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>'; 7279: return $result.&show_grading_menu_form($symb); 7280: } 7281: my %clicker_ids=&gather_clicker_ids(); 7282: my %correct_ids; 7283: if ($env{'form.gradingmechanism'} eq 'personnel') { 7284: %correct_ids=&gather_adv_clicker_ids(); 7285: } 7286: if ($env{'form.gradingmechanism'} eq 'specific') { 7287: foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; 7288: $correct_id=~tr/a-z/A-Z/; 7289: $correct_id=~s/\s//gs; 7290: $correct_id=~s/^[\#0]+//; 7291: $correct_id=~s/[\-\:]//g; 7292: if ($correct_id) { 7293: $correct_ids{$correct_id}='specified'; 7294: } 7295: } 7296: } 7297: if ($env{'form.gradingmechanism'} eq 'attendance') { 7298: $result.=&mt('Score based on attendance only'); 7299: } else { 7300: my $number=0; 7301: $result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>'; 7302: foreach my $id (sort(keys(%correct_ids))) { 7303: $result.='<br /><tt>'.$id.'</tt> - '; 7304: if ($correct_ids{$id} eq 'specified') { 7305: $result.=&mt('specified'); 7306: } else { 7307: my ($uname,$udom)=split(/\:/,$correct_ids{$id}); 7308: $result.=&Apache::loncommon::plainname($uname,$udom); 7309: } 7310: $number++; 7311: } 7312: $result.="</p>\n"; 7313: if ($number==0) { 7314: $result.='<span class="LC_error">'.&mt('No IDs found to determine correct answer').'</span>'; 7315: return $result.&show_grading_menu_form($symb); 7316: } 7317: } 7318: if (length($env{'form.upfile'}) < 2) { 7319: $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.', 7320: '<span class="LC_error">', 7321: '</span>', 7322: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'); 7323: return $result.&show_grading_menu_form($symb); 7324: } 7325: 7326: # Were able to get all the info needed, now analyze the file 7327: 7328: $result.=&Apache::loncommon::studentbrowser_javascript(); 7329: $symb = &Apache::lonenc::check_encrypt($symb); 7330: my $heading=&mt('Scanning clicker file'); 7331: $result.=(<<ENDHEADER); 7332: <br /><table width="100%" border="0"><tr><td bgcolor="#777777"> 7333: <table width="100%" border="0"><tr bgcolor="#e6ffff"><td> 7334: <b>$heading</b></td></tr><tr bgcolor=#ffffe6><td> 7335: <form method="post" action="/adm/grades" name="clickeranalysis"> 7336: <input type="hidden" name="symb" value="$symb" /> 7337: <input type="hidden" name="command" value="assignclickergrades" /> 7338: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" /> 7339: <input type="hidden" name="saveState" value="$env{'form.saveState'}" /> 7340: <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" /> 7341: <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" /> 7342: <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" /> 7343: ENDHEADER 7344: my %responses; 7345: my @questiontitles; 7346: my $errormsg=''; 7347: my $number=0; 7348: if ($env{'form.upfiletype'} eq 'iclicker') { 7349: ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); 7350: } 7351: if ($env{'form.upfiletype'} eq 'interwrite') { 7352: ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); 7353: } 7354: $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'. 7355: '<input type="hidden" name="number" value="'.$number.'" />'. 7356: &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', 7357: $env{'form.pcorrect'},$env{'form.pincorrect'}). 7358: '<br />'; 7359: # Remember Question Titles 7360: # FIXME: Possibly need delimiter other than ":" 7361: for (my $i=0;$i<$number;$i++) { 7362: $result.='<input type="hidden" name="question:'.$i.'" value="'. 7363: &HTML::Entities::encode($questiontitles[$i],'"&<>').'" />'; 7364: } 7365: my $correct_count=0; 7366: my $student_count=0; 7367: my $unknown_count=0; 7368: # Match answers with usernames 7369: # FIXME: Possibly need delimiter other than ":" 7370: foreach my $id (keys(%responses)) { 7371: if ($correct_ids{$id}) { 7372: $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />'; 7373: $correct_count++; 7374: } elsif ($clicker_ids{$id}) { 7375: if ($clicker_ids{$id}=~/\,/) { 7376: # More than one user with the same clicker! 7377: $result.="\n<hr />".&mt('Clicker registered more than once').": <tt>".$id."</tt><br />"; 7378: $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'. 7379: "<select name='multi".$id."'>"; 7380: foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) { 7381: $result.="<option value='".$reguser."'>".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.')</option>'; 7382: } 7383: $result.='</select>'; 7384: $unknown_count++; 7385: } else { 7386: # Good: found one and only one user with the right clicker 7387: $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />'; 7388: $student_count++; 7389: } 7390: } else { 7391: $result.="\n<hr />".&mt('Unregistered Clicker')." <tt>".$id."</tt><br />"; 7392: $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'. 7393: "\n".&mt("Username").": <input type='text' name='uname".$id."' /> ". 7394: "\n".&mt("Domain").": ". 7395: &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '. 7396: &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id); 7397: $unknown_count++; 7398: } 7399: } 7400: $result.='<hr />'. 7401: &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); 7402: if ($env{'form.gradingmechanism'} ne 'attendance') { 7403: if ($correct_count==0) { 7404: $errormsg.="Found no correct answers answers for grading!"; 7405: } elsif ($correct_count>1) { 7406: $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>'; 7407: } 7408: } 7409: if ($number<1) { 7410: $errormsg.="Found no questions."; 7411: } 7412: if ($errormsg) { 7413: $result.='<br /><span class="LC_error">'.&mt($errormsg).'</span>'; 7414: } else { 7415: $result.='<br /><input type="submit" name="finalize" value="'.&mt('Finalize Grading').'" />'; 7416: } 7417: $result.='</form></td></tr></table>'."\n". 7418: '</td></tr></table><br /><br />'."\n"; 7419: return $result.&show_grading_menu_form($symb); 7420: } 7421: 7422: sub iclicker_eval { 7423: my ($questiontitles,$responses)=@_; 7424: my $number=0; 7425: my $errormsg=''; 7426: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 7427: my %components=&Apache::loncommon::record_sep($line); 7428: my @entries=map {$components{$_}} (sort(keys(%components))); 7429: if ($entries[0] eq 'Question') { 7430: for (my $i=3;$i<$#entries;$i+=6) { 7431: $$questiontitles[$number]=$entries[$i]; 7432: $number++; 7433: } 7434: } 7435: if ($entries[0]=~/^\#/) { 7436: my $id=$entries[0]; 7437: my @idresponses; 7438: $id=~s/^[\#0]+//; 7439: for (my $i=0;$i<$number;$i++) { 7440: my $idx=3+$i*6; 7441: push(@idresponses,$entries[$idx]); 7442: } 7443: $$responses{$id}=join(',',@idresponses); 7444: } 7445: } 7446: return ($errormsg,$number); 7447: } 7448: 7449: sub interwrite_eval { 7450: my ($questiontitles,$responses)=@_; 7451: my $number=0; 7452: my $errormsg=''; 7453: my $skipline=1; 7454: my $questionnumber=0; 7455: my %idresponses=(); 7456: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 7457: my %components=&Apache::loncommon::record_sep($line); 7458: my @entries=map {$components{$_}} (sort(keys(%components))); 7459: if ($entries[1] eq 'Time') { $skipline=0; next; } 7460: if ($entries[1] eq 'Response') { $skipline=1; } 7461: next if $skipline; 7462: if ($entries[0]!=$questionnumber) { 7463: $questionnumber=$entries[0]; 7464: $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); 7465: $number++; 7466: } 7467: my $id=$entries[4]; 7468: $id=~s/^[\#0]+//; 7469: $id=~s/^v\d*\://i; 7470: $id=~s/[\-\:]//g; 7471: $idresponses{$id}[$number]=$entries[6]; 7472: } 7473: foreach my $id (keys %idresponses) { 7474: $$responses{$id}=join(',',@{$idresponses{$id}}); 7475: $$responses{$id}=~s/^\s*\,//; 7476: } 7477: return ($errormsg,$number); 7478: } 7479: 7480: sub assign_clicker_grades { 7481: my ($r)=@_; 7482: my ($symb)=&get_symb($r); 7483: if (!$symb) {return '';} 7484: # See which part we are saving to 7485: my ($partlist,$handgrade,$responseType) = &response_type($symb); 7486: # FIXME: This should probably look for the first handgradeable part 7487: my $part=$$partlist[0]; 7488: # Start screen output 7489: my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); 7490: 7491: my $heading=&mt('Assigning grades based on clicker file'); 7492: $result.=(<<ENDHEADER); 7493: <br /><table width="100%" border="0"><tr><td bgcolor="#777777"> 7494: <table width="100%" border="0"><tr bgcolor="#e6ffff"><td> 7495: <b>$heading</b></td></tr><tr bgcolor=#ffffe6><td> 7496: ENDHEADER 7497: # Get correct result 7498: # FIXME: Possibly need delimiter other than ":" 7499: my @correct=(); 7500: my $gradingmechanism=$env{'form.gradingmechanism'}; 7501: my $number=$env{'form.number'}; 7502: if ($gradingmechanism ne 'attendance') { 7503: foreach my $key (keys(%env)) { 7504: if ($key=~/^form\.correct\:/) { 7505: my @input=split(/\,/,$env{$key}); 7506: for (my $i=0;$i<=$#input;$i++) { 7507: if (($correct[$i]) && ($input[$i]) && 7508: ($correct[$i] ne $input[$i])) { 7509: $result.='<br /><span class="LC_warning">'. 7510: &mt('More than one correct result given for question "[_1]": [_2] versus [_3].', 7511: $env{'form.question:'.$i},$correct[$i],$input[$i]).'</span>'; 7512: } elsif ($input[$i]) { 7513: $correct[$i]=$input[$i]; 7514: } 7515: } 7516: } 7517: } 7518: for (my $i=0;$i<$number;$i++) { 7519: if (!$correct[$i]) { 7520: $result.='<br /><span class="LC_error">'. 7521: &mt('No correct result given for question "[_1]"!', 7522: $env{'form.question:'.$i}).'</span>'; 7523: } 7524: } 7525: $result.='<br />'.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct)); 7526: } 7527: # Start grading 7528: my $pcorrect=$env{'form.pcorrect'}; 7529: my $pincorrect=$env{'form.pincorrect'}; 7530: my $storecount=0; 7531: foreach my $key (keys(%env)) { 7532: my $user=''; 7533: if ($key=~/^form\.student\:(.*)$/) { 7534: $user=$1; 7535: } 7536: if ($key=~/^form\.unknown\:(.*)$/) { 7537: my $id=$1; 7538: if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) { 7539: $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id}; 7540: } elsif ($env{'form.multi'.$id}) { 7541: $user=$env{'form.multi'.$id}; 7542: } 7543: } 7544: if ($user) { 7545: my @answer=split(/\,/,$env{$key}); 7546: my $sum=0; 7547: for (my $i=0;$i<$number;$i++) { 7548: if ($answer[$i]) { 7549: if ($gradingmechanism eq 'attendance') { 7550: $sum+=$pcorrect; 7551: } else { 7552: if ($answer[$i] eq $correct[$i]) { 7553: $sum+=$pcorrect; 7554: } else { 7555: $sum+=$pincorrect; 7556: } 7557: } 7558: } 7559: } 7560: my $ave=$sum/(100*$number); 7561: # Store 7562: my ($username,$domain)=split(/\:/,$user); 7563: my %grades=(); 7564: $grades{"resource.$part.solved"}='correct_by_override'; 7565: $grades{"resource.$part.awarded"}=$ave; 7566: $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; 7567: my $returncode=&Apache::lonnet::cstore(\%grades,$symb, 7568: $env{'request.course.id'}, 7569: $domain,$username); 7570: if ($returncode ne 'ok') { 7571: $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>"; 7572: } else { 7573: $storecount++; 7574: } 7575: } 7576: } 7577: # We are done 7578: $result.='<br />'.&mt('Successfully stored grades for [_1] student(s).',$storecount). 7579: '</td></tr></table>'."\n". 7580: '</td></tr></table><br /><br />'."\n"; 7581: return $result.&show_grading_menu_form($symb); 7582: } 7583: 7584: sub handler { 7585: my $request=$_[0]; 7586: 7587: &reset_caches(); 7588: if ($env{'browser.mathml'}) { 7589: &Apache::loncommon::content_type($request,'text/xml'); 7590: } else { 7591: &Apache::loncommon::content_type($request,'text/html'); 7592: } 7593: $request->send_http_header; 7594: return '' if $request->header_only; 7595: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); 7596: my $symb=&get_symb($request,1); 7597: my @commands=&Apache::loncommon::get_env_multiple('form.command'); 7598: my $command=$commands[0]; 7599: if ($#commands > 0) { 7600: &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); 7601: } 7602: $request->print(&Apache::loncommon::start_page('Grading')); 7603: if ($symb eq '' && $command eq '') { 7604: if ($env{'user.adv'}) { 7605: if (($env{'form.codeone'}) && ($env{'form.codetwo'}) && 7606: ($env{'form.codethree'})) { 7607: my $token=$env{'form.codeone'}.'*'.$env{'form.codetwo'}.'*'. 7608: $env{'form.codethree'}; 7609: my ($tsymb,$tuname,$tudom,$tcrsid)= 7610: &Apache::lonnet::checkin($token); 7611: if ($tsymb) { 7612: my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb); 7613: if (&Apache::lonnet::allowed('mgr',$tcrsid)) { 7614: $request->print(&Apache::lonnet::ssi_body('/res/'.$url, 7615: ('grade_username' => $tuname, 7616: 'grade_domain' => $tudom, 7617: 'grade_courseid' => $tcrsid, 7618: 'grade_symb' => $tsymb))); 7619: } else { 7620: $request->print('<h3>Not authorized: '.$token.'</h3>'); 7621: } 7622: } else { 7623: $request->print('<h3>Not a valid DocID: '.$token.'</h3>'); 7624: } 7625: } else { 7626: $request->print(&Apache::lonxml::tokeninputfield()); 7627: } 7628: } 7629: } else { 7630: &init_perm(); 7631: if ($command eq 'submission' && $perm{'vgr'}) { 7632: ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); 7633: } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { 7634: &pickStudentPage($request); 7635: } elsif ($command eq 'displayPage' && $perm{'vgr'}) { 7636: &displayPage($request); 7637: } elsif ($command eq 'gradeByPage' && $perm{'mgr'}) { 7638: &updateGradeByPage($request); 7639: } elsif ($command eq 'processGroup' && $perm{'vgr'}) { 7640: &processGroup($request); 7641: } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) { 7642: $request->print(&gradingmenu($request)); 7643: } elsif ($command eq 'viewgrades' && $perm{'vgr'}) { 7644: $request->print(&viewgrades($request)); 7645: } elsif ($command eq 'handgrade' && $perm{'mgr'}) { 7646: $request->print(&processHandGrade($request)); 7647: } elsif ($command eq 'editgrades' && $perm{'mgr'}) { 7648: $request->print(&editgrades($request)); 7649: } elsif ($command eq 'verify' && $perm{'vgr'}) { 7650: $request->print(&verifyreceipt($request)); 7651: } elsif ($command eq 'processclicker' && $perm{'mgr'}) { 7652: $request->print(&process_clicker($request)); 7653: } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { 7654: $request->print(&process_clicker_file($request)); 7655: } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) { 7656: $request->print(&assign_clicker_grades($request)); 7657: } elsif ($command eq 'csvform' && $perm{'mgr'}) { 7658: $request->print(&upcsvScores_form($request)); 7659: } elsif ($command eq 'csvupload' && $perm{'mgr'}) { 7660: $request->print(&csvupload($request)); 7661: } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) { 7662: $request->print(&csvuploadmap($request)); 7663: } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) { 7664: if ($env{'form.associate'} ne 'Reverse Association') { 7665: $request->print(&csvuploadoptions($request)); 7666: } else { 7667: if ( $env{'form.upfile_associate'} ne 'reverse' ) { 7668: $env{'form.upfile_associate'} = 'reverse'; 7669: } else { 7670: $env{'form.upfile_associate'} = 'forward'; 7671: } 7672: $request->print(&csvuploadmap($request)); 7673: } 7674: } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) { 7675: $request->print(&csvuploadassign($request)); 7676: } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { 7677: $request->print(&scantron_selectphase($request)); 7678: } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) { 7679: $request->print(&scantron_do_warning($request)); 7680: } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { 7681: $request->print(&scantron_validate_file($request)); 7682: } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { 7683: $request->print(&scantron_process_students($request)); 7684: } elsif ($command eq 'scantronupload' && 7685: (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| 7686: &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { 7687: $request->print(&scantron_upload_scantron_data($request)); 7688: } elsif ($command eq 'scantronupload_save' && 7689: (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| 7690: &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { 7691: $request->print(&scantron_upload_scantron_data_save($request)); 7692: } elsif ($command eq 'scantron_download' && 7693: &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { 7694: $request->print(&scantron_download_scantron_data($request)); 7695: } elsif ($command) { 7696: $request->print("Access Denied ($command)"); 7697: } 7698: } 7699: $request->print(&Apache::loncommon::end_page()); 7700: &reset_caches(); 7701: return ''; 7702: } 7703: 7704: 1; 7705: 7706: __END__;