loncom/homework/grades.pm - view

File: [LON-CAPA] / loncom / homework / grades.pm
Revision 1.648: download - view: text, annotated - select for diffs
Fri May 27 14:39:50 2011 UTC (12 years, 11 months ago) by bisitz
Branches: MAIN
CVS tags: HEAD

Bug 5853: Don't use tradmarked brandname "scantron" in interface anymore.
Some rests have been found and changed to "bubblesheet":
- Updated related scripts
- Consistent wording
- Tidy up translation files: Synchronized existing entries with used phrases in the current scripts.
  If the translation of an updated phrase is unclear, the old translation is kept as a comment and the original English phrase is used instead.

1: # The LearningOnline Network with CAPA 2: # The LON-CAPA Grading handler 3: # 4: # $Id: grades.pm,v 1.648 2011/05/27 14:39:50 bisitz 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: 30: 31: package Apache::grades; 32: use strict; 33: use Apache::style; 34: use Apache::lonxml; 35: use Apache::lonnet; 36: use Apache::loncommon; 37: use Apache::lonhtmlcommon; 38: use Apache::lonnavmaps; 39: use Apache::lonhomework; 40: use Apache::lonpickcode; 41: use Apache::loncoursedata; 42: use Apache::lonmsg(); 43: use Apache::Constants qw(:common :http); 44: use Apache::lonlocal; 45: use Apache::lonenc; 46: use Apache::lonstathelpers; 47: use Apache::lonquickgrades; 48: use String::Similarity; 49: use LONCAPA; 50: 51: use POSIX qw(floor); 52: 53: 54: 55: my %perm=(); 56: 57: # These variables are used to recover from ssi errors 58: 59: my $ssi_retries = 5; 60: my $ssi_error; 61: my $ssi_error_resource; 62: my $ssi_error_message; 63: 64: 65: sub ssi_with_retries { 66: my ($resource, $retries, %form) = @_; 67: my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form); 68: if ($response->is_error) { 69: $ssi_error = 1; 70: $ssi_error_resource = $resource; 71: $ssi_error_message = $response->code . " " . $response->message; 72: } 73: 74: return $content; 75: 76: } 77: # 78: # Prodcuces an ssi retry failure error message to the user: 79: # 80: 81: sub ssi_print_error { 82: my ($r) = @_; 83: my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk'); 84: $r->print(' 85: <br /> 86: <h2>'.&mt('An unrecoverable network error occurred:').'</h2> 87: <p> 88: '.&mt('Unable to retrieve a resource from a server:').'<br /> 89: '.&mt('Resource:').' '.$ssi_error_resource.'<br /> 90: '.&mt('Error:').' '.$ssi_error_message.' 91: </p> 92: <p>'. 93: &mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'<br />'. 94: &mt('If the error persists, please contact the [_1] for assistance.',$helpurl). 95: '</p>'); 96: return; 97: } 98: 99: # 100: # --- Retrieve the parts from the metadata file.--- 101: # Returns an array of everything that the resources stores away 102: # 103: 104: sub getpartlist { 105: my ($symb,$errorref) = @_; 106: 107: my $navmap = Apache::lonnavmaps::navmap->new(); 108: unless (ref($navmap)) { 109: if (ref($errorref)) { 110: $$errorref = 'navmap'; 111: return; 112: } 113: } 114: my $res = $navmap->getBySymb($symb); 115: my $partlist = $res->parts(); 116: my $url = $res->src(); 117: my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys')); 118: 119: my @stores; 120: foreach my $part (@{ $partlist }) { 121: foreach my $key (@metakeys) { 122: if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } 123: } 124: } 125: return @stores; 126: } 127: 128: #--- Format fullname, username:domain if different for display 129: #--- Use anywhere where the student names are listed 130: sub nameUserString { 131: my ($type,$fullname,$uname,$udom) = @_; 132: if ($type eq 'header') { 133: return '<b> '.&mt('Fullname').' </b><span class="LC_internal_info">('.&mt('Username').')</span>'; 134: } else { 135: return ' '.$fullname.'<span class="LC_internal_info"> ('.$uname. 136: ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')</span>'; 137: } 138: } 139: 140: #--- Get the partlist and the response type for a given problem. --- 141: #--- Indicate if a response type is coded handgraded or not. --- 142: #--- Sets response_error pointer to "1" if navmaps object broken --- 143: sub response_type { 144: my ($symb,$response_error) = @_; 145: 146: my $navmap = Apache::lonnavmaps::navmap->new(); 147: unless (ref($navmap)) { 148: if (ref($response_error)) { 149: $$response_error = 1; 150: } 151: return; 152: } 153: my $res = $navmap->getBySymb($symb); 154: unless (ref($res)) { 155: $$response_error = 1; 156: return; 157: } 158: my $partlist = $res->parts(); 159: my %vPart = 160: map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); 161: my (%response_types,%handgrade); 162: foreach my $part (@{ $partlist }) { 163: next if (%vPart && !exists($vPart{$part})); 164: 165: my @types = $res->responseType($part); 166: my @ids = $res->responseIds($part); 167: for (my $i=0; $i < scalar(@ids); $i++) { 168: $response_types{$part}{$ids[$i]} = $types[$i]; 169: $handgrade{$part.'_'.$ids[$i]} = 170: &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. 171: '.handgrade',$symb); 172: } 173: } 174: return ($partlist,\%handgrade,\%response_types); 175: } 176: 177: sub flatten_responseType { 178: my ($responseType) = @_; 179: my @part_response_id = 180: map { 181: my $part = $_; 182: map { 183: [$part,$_] 184: } sort(keys(%{ $responseType->{$part} })); 185: } sort(keys(%$responseType)); 186: return @part_response_id; 187: } 188: 189: sub get_display_part { 190: my ($partID,$symb)=@_; 191: my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); 192: if (defined($display) and $display ne '') { 193: $display.= ' (<span class="LC_internal_info">' 194: .&mt('Part ID: [_1]',$partID).'</span>)'; 195: } else { 196: $display=$partID; 197: } 198: return $display; 199: } 200: 201: sub reset_caches { 202: &reset_analyze_cache(); 203: &reset_perm(); 204: } 205: 206: { 207: my %analyze_cache; 208: my %analyze_cache_formkeys; 209: 210: sub reset_analyze_cache { 211: undef(%analyze_cache); 212: undef(%analyze_cache_formkeys); 213: } 214: 215: sub get_analyze { 216: my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed)=@_; 217: my $key = "$symb\0$uname\0$udom"; 218: if ($type eq 'randomizetry') { 219: if ($trial ne '') { 220: $key .= "\0".$trial; 221: } 222: } 223: if (exists($analyze_cache{$key})) { 224: my $getupdate = 0; 225: if (ref($add_to_hash) eq 'HASH') { 226: foreach my $item (keys(%{$add_to_hash})) { 227: if (ref($analyze_cache_formkeys{$key}) eq 'HASH') { 228: if (!exists($analyze_cache_formkeys{$key}{$item})) { 229: $getupdate = 1; 230: last; 231: } 232: } else { 233: $getupdate = 1; 234: } 235: } 236: } 237: if (!$getupdate) { 238: return $analyze_cache{$key}; 239: } 240: } 241: 242: my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); 243: $url=&Apache::lonnet::clutter($url); 244: my %form = ('grade_target' => 'analyze', 245: 'grade_domain' => $udom, 246: 'grade_symb' => $symb, 247: 'grade_courseid' => $env{'request.course.id'}, 248: 'grade_username' => $uname, 249: 'grade_noincrement' => $no_increment); 250: if ($type eq 'randomizetry') { 251: $form{'grade_questiontype'} = $type; 252: if ($rndseed ne '') { 253: $form{'grade_rndseed'} = $rndseed; 254: } 255: } 256: if (ref($add_to_hash)) { 257: %form = (%form,%{$add_to_hash}); 258: } 259: my $subresult=&ssi_with_retries($url, $ssi_retries,%form); 260: (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); 261: my %analyze=&Apache::lonnet::str2hash($subresult); 262: if (ref($add_to_hash) eq 'HASH') { 263: $analyze_cache_formkeys{$key} = $add_to_hash; 264: } else { 265: $analyze_cache_formkeys{$key} = {}; 266: } 267: return $analyze_cache{$key} = \%analyze; 268: } 269: 270: sub get_order { 271: my ($partid,$respid,$symb,$uname,$udom,$no_increment,$type,$trial,$rndseed)=@_; 272: my $analyze = &get_analyze($symb,$uname,$udom,$no_increment,undef,$type,$trial,$rndseed); 273: return $analyze->{"$partid.$respid.shown"}; 274: } 275: 276: sub get_radiobutton_correct_foil { 277: my ($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed)=@_; 278: my $analyze = &get_analyze($symb,$uname,$udom,undef,undef,$type,$trial,$rndseed); 279: my $foils = &get_order($partid,$respid,$symb,$uname,$udom,undef,$type,$trial,$rndseed); 280: if (ref($foils) eq 'ARRAY') { 281: foreach my $foil (@{$foils}) { 282: if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { 283: return $foil; 284: } 285: } 286: } 287: } 288: 289: sub scantron_partids_tograde { 290: my ($resource,$cid,$uname,$udom,$check_for_randomlist) = @_; 291: my (%analysis,@parts); 292: if (ref($resource)) { 293: my $symb = $resource->symb(); 294: my $add_to_form; 295: if ($check_for_randomlist) { 296: $add_to_form = { 'check_parts_withrandomlist' => 1,}; 297: } 298: my $analyze = &get_analyze($symb,$uname,$udom,undef,$add_to_form); 299: if (ref($analyze) eq 'HASH') { 300: %analysis = %{$analyze}; 301: } 302: if (ref($analysis{'parts'}) eq 'ARRAY') { 303: foreach my $part (@{$analysis{'parts'}}) { 304: my ($id,$respid) = split(/\./,$part); 305: if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { 306: push(@parts,$part); 307: } 308: } 309: } 310: } 311: return (\%analysis,\@parts); 312: } 313: 314: } 315: 316: #--- Clean response type for display 317: #--- Currently filters option/rank/radiobutton/match/essay/Task 318: # response types only. 319: sub cleanRecord { 320: my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, 321: $uname,$udom,$type,$trial,$rndseed) = @_; 322: my $grayFont = '<span class="LC_internal_info">'; 323: if ($response =~ /^(option|rank)$/) { 324: my %answer=&Apache::lonnet::str2hash($answer); 325: my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); 326: my ($toprow,$bottomrow); 327: foreach my $foil (@$order) { 328: if ($grading{$foil} == 1) { 329: $toprow.='<td><b>'.$answer{$foil}.' </b></td>'; 330: } else { 331: $toprow.='<td><i>'.$answer{$foil}.' </i></td>'; 332: } 333: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 334: } 335: return '<blockquote><table border="1">'. 336: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 337: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 338: $grayFont.$bottomrow.'</tr>'.'</table></blockquote>'; 339: } elsif ($response eq 'match') { 340: my %answer=&Apache::lonnet::str2hash($answer); 341: my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); 342: my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); 343: my ($toprow,$middlerow,$bottomrow); 344: foreach my $foil (@$order) { 345: my $item=shift(@items); 346: if ($grading{$foil} == 1) { 347: $toprow.='<td><b>'.$item.' </b></td>'; 348: $middlerow.='<td><b>'.$grayFont.$answer{$foil}.' </span></b></td>'; 349: } else { 350: $toprow.='<td><i>'.$item.' </i></td>'; 351: $middlerow.='<td><i>'.$grayFont.$answer{$foil}.' </span></i></td>'; 352: } 353: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 354: } 355: return '<blockquote><table border="1">'. 356: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 357: '<tr valign="top"><td>'.$grayFont.&mt('Item ID').'</span></td>'. 358: $middlerow.'</tr>'. 359: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 360: $bottomrow.'</tr>'.'</table></blockquote>'; 361: } elsif ($response eq 'radiobutton') { 362: my %answer=&Apache::lonnet::str2hash($answer); 363: my ($toprow,$bottomrow); 364: my $correct = 365: &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed); 366: foreach my $foil (@$order) { 367: if (exists($answer{$foil})) { 368: if ($foil eq $correct) { 369: $toprow.='<td><b>'.&mt('true').'</b></td>'; 370: } else { 371: $toprow.='<td><i>'.&mt('true').'</i></td>'; 372: } 373: } else { 374: $toprow.='<td>'.&mt('false').'</td>'; 375: } 376: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 377: } 378: return '<blockquote><table border="1">'. 379: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 380: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 381: $bottomrow.'</tr>'.'</table></blockquote>'; 382: } elsif ($response eq 'essay') { 383: if (! exists ($env{'form.'.$symb})) { 384: my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', 385: $env{'course.'.$env{'request.course.id'}.'.domain'}, 386: $env{'course.'.$env{'request.course.id'}.'.num'}); 387: 388: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 389: $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; 390: $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; 391: $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; 392: $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; 393: $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. 394: } 395: $answer =~ s-\n-<br />-g; 396: return '<br /><br /><blockquote><tt>'.&keywords_highlight($answer).'</tt></blockquote>'; 397: } elsif ( $response eq 'organic') { 398: my $result='Smile representation: "<tt>'.$answer.'</tt>"'; 399: my $jme=$record->{$version."resource.$partid.$respid.molecule"}; 400: $result.=&Apache::chemresponse::jme_img($jme,$answer,400); 401: return $result; 402: } elsif ( $response eq 'Task') { 403: if ( $answer eq 'SUBMITTED') { 404: my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; 405: my $result = &Apache::bridgetask::file_list($files,$uname,$udom); 406: return $result; 407: } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { 408: my @matches = grep(/^\Q$version\E.*?\.instance$/, 409: keys(%{$record})); 410: return join('<br />',($version,@matches)); 411: 412: 413: } else { 414: my $result = 415: '<p>' 416: .&mt('Overall result: [_1]', 417: $record->{$version."resource.$respid.$partid.status"}) 418: .'</p>'; 419: 420: $result .= '<ul>'; 421: my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/, 422: keys(%{$record})); 423: foreach my $grade (sort(@grade)) { 424: my ($dim) = ($grade =~/[.]([^.]+)[.]status$/); 425: $result.= '<li>'.&mt("Dimension: [_1], status [_2] ", 426: $dim, $record->{$grade}). 427: '</li>'; 428: } 429: $result.='</ul>'; 430: return $result; 431: } 432: } elsif ( $response =~ m/(?:numerical|formula)/) { 433: $answer = 434: &Apache::loncommon::format_previous_attempt_value('submission', 435: $answer); 436: } 437: return $answer; 438: } 439: 440: #-- A couple of common js functions 441: sub commonJSfunctions { 442: my $request = shift; 443: $request->print(&Apache::lonhtmlcommon::scripttag(<<COMMONJSFUNCTIONS)); 444: function radioSelection(radioButton) { 445: var selection=null; 446: if (radioButton.length > 1) { 447: for (var i=0; i<radioButton.length; i++) { 448: if (radioButton[i].checked) { 449: return radioButton[i].value; 450: } 451: } 452: } else { 453: if (radioButton.checked) return radioButton.value; 454: } 455: return selection; 456: } 457: 458: function pullDownSelection(selectOne) { 459: var selection=""; 460: if (selectOne.length > 1) { 461: for (var i=0; i<selectOne.length; i++) { 462: if (selectOne[i].selected) { 463: return selectOne[i].value; 464: } 465: } 466: } else { 467: // only one value it must be the selected one 468: return selectOne.value; 469: } 470: } 471: COMMONJSFUNCTIONS 472: } 473: 474: #--- Dumps the class list with usernames,list of sections, 475: #--- section, ids and fullnames for each user. 476: sub getclasslist { 477: my ($getsec,$filterlist,$getgroup) = @_; 478: my @getsec; 479: my @getgroup; 480: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 481: if (!ref($getsec)) { 482: if ($getsec ne '' && $getsec ne 'all') { 483: @getsec=($getsec); 484: } 485: } else { 486: @getsec=@{$getsec}; 487: } 488: if (grep(/^all$/,@getsec)) { undef(@getsec); } 489: if (!ref($getgroup)) { 490: if ($getgroup ne '' && $getgroup ne 'all') { 491: @getgroup=($getgroup); 492: } 493: } else { 494: @getgroup=@{$getgroup}; 495: } 496: if (grep(/^all$/,@getgroup)) { undef(@getgroup); } 497: 498: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist(); 499: # Bail out if we were unable to get the classlist 500: return if (! defined($classlist)); 501: &Apache::loncoursedata::get_group_memberships($classlist,$keylist); 502: # 503: my %sections; 504: my %fullnames; 505: foreach my $student (keys(%$classlist)) { 506: my $end = 507: $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; 508: my $start = 509: $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; 510: my $id = 511: $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; 512: my $section = 513: $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; 514: my $fullname = 515: $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; 516: my $status = 517: $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; 518: my $group = 519: $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; 520: # filter students according to status selected 521: if ($filterlist && (!($stu_status =~ /Any/))) { 522: if (!($stu_status =~ $status)) { 523: delete($classlist->{$student}); 524: next; 525: } 526: } 527: # filter students according to groups selected 528: my @stu_groups = split(/,/,$group); 529: if (@getgroup) { 530: my $exclude = 1; 531: foreach my $grp (@getgroup) { 532: foreach my $stu_group (@stu_groups) { 533: if ($stu_group eq $grp) { 534: $exclude = 0; 535: } 536: } 537: if (($grp eq 'none') && !$group) { 538: $exclude = 0; 539: } 540: } 541: if ($exclude) { 542: delete($classlist->{$student}); 543: } 544: } 545: $section = ($section ne '' ? $section : 'none'); 546: if (&canview($section)) { 547: if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { 548: $sections{$section}++; 549: if ($classlist->{$student}) { 550: $fullnames{$student}=$fullname; 551: } 552: } else { 553: delete($classlist->{$student}); 554: } 555: } else { 556: delete($classlist->{$student}); 557: } 558: } 559: my %seen = (); 560: my @sections = sort(keys(%sections)); 561: return ($classlist,\@sections,\%fullnames); 562: } 563: 564: sub canmodify { 565: my ($sec)=@_; 566: if ($perm{'mgr'}) { 567: if (!defined($perm{'mgr_section'})) { 568: # can modify whole class 569: return 1; 570: } else { 571: if ($sec eq $perm{'mgr_section'}) { 572: #can modify the requested section 573: return 1; 574: } else { 575: # can't modify the request section 576: return 0; 577: } 578: } 579: } 580: #can't modify 581: return 0; 582: } 583: 584: sub canview { 585: my ($sec)=@_; 586: if ($perm{'vgr'}) { 587: if (!defined($perm{'vgr_section'})) { 588: # can modify whole class 589: return 1; 590: } else { 591: if ($sec eq $perm{'vgr_section'}) { 592: #can modify the requested section 593: return 1; 594: } else { 595: # can't modify the request section 596: return 0; 597: } 598: } 599: } 600: #can't modify 601: return 0; 602: } 603: 604: #--- Retrieve the grade status of a student for all the parts 605: sub student_gradeStatus { 606: my ($symb,$udom,$uname,$partlist) = @_; 607: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 608: my %partstatus = (); 609: foreach (@$partlist) { 610: my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); 611: $status = 'nothing' if ($status eq ''); 612: $partstatus{$_} = $status; 613: my $subkey = "resource.$_.submitted_by"; 614: $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); 615: } 616: return %partstatus; 617: } 618: 619: # hidden form and javascript that calls the form 620: # Use by verifyscript and viewgrades 621: # Shows a student's view of problem and submission 622: sub jscriptNform { 623: my ($symb) = @_; 624: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 625: my $jscript= &Apache::lonhtmlcommon::scripttag( 626: ' function viewOneStudent(user,domain) {'."\n". 627: ' document.onestudent.student.value = user;'."\n". 628: ' document.onestudent.userdom.value = domain;'."\n". 629: ' document.onestudent.submit();'."\n". 630: ' }'."\n". 631: "\n"); 632: $jscript.= '<form action="/adm/grades" method="post" name="onestudent">'."\n". 633: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 634: '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 635: '<input type="hidden" name="command" value="submission" />'."\n". 636: '<input type="hidden" name="student" value="" />'."\n". 637: '<input type="hidden" name="userdom" value="" />'."\n". 638: '</form>'."\n"; 639: return $jscript; 640: } 641: 642: 643: 644: # Given the score (as a number [0-1] and the weight) what is the final 645: # point value? This function will round to the nearest tenth, third, 646: # or quarter if one of those is within the tolerance of .00001. 647: sub compute_points { 648: my ($score, $weight) = @_; 649: 650: my $tolerance = .00001; 651: my $points = $score * $weight; 652: 653: # Check for nearness to 1/x. 654: my $check_for_nearness = sub { 655: my ($factor) = @_; 656: my $num = ($points * $factor) + $tolerance; 657: my $floored_num = floor($num); 658: if ($num - $floored_num < 2 * $tolerance * $factor) { 659: return $floored_num / $factor; 660: } 661: return $points; 662: }; 663: 664: $points = $check_for_nearness->(10); 665: $points = $check_for_nearness->(3); 666: $points = $check_for_nearness->(4); 667: 668: return $points; 669: } 670: 671: #------------------ End of general use routines -------------------- 672: 673: # 674: # Find most similar essay 675: # 676: 677: sub most_similar { 678: my ($uname,$udom,$uessay,$old_essays)=@_; 679: 680: # ignore spaces and punctuation 681: 682: $uessay=~s/\W+/ /gs; 683: 684: # ignore empty submissions (occuring when only files are sent) 685: 686: unless ($uessay=~/\w+/s) { return ''; } 687: 688: # these will be returned. Do not care if not at least 50 percent similar 689: my $limit=0.6; 690: my $sname=''; 691: my $sdom=''; 692: my $scrsid=''; 693: my $sessay=''; 694: # go through all essays ... 695: foreach my $tkey (keys(%$old_essays)) { 696: my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); 697: # ... except the same student 698: next if (($tname eq $uname) && ($tdom eq $udom)); 699: my $tessay=$old_essays->{$tkey}; 700: $tessay=~s/\W+/ /gs; 701: # String similarity gives up if not even limit 702: my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); 703: # Found one 704: if ($tsimilar>$limit) { 705: $limit=$tsimilar; 706: $sname=$tname; 707: $sdom=$tdom; 708: $scrsid=$tcrsid; 709: $sessay=$old_essays->{$tkey}; 710: } 711: } 712: if ($limit>0.6) { 713: return ($sname,$sdom,$scrsid,$sessay,$limit); 714: } else { 715: return ('','','','',0); 716: } 717: } 718: 719: #------------------------------------------------------------------- 720: 721: #------------------------------------ Receipt Verification Routines 722: # 723: 724: sub initialverifyreceipt { 725: my ($request,$symb) = @_; 726: &commonJSfunctions($request); 727: return '<form name="gradingMenu"><input type="submit" value="'.&mt('Verify Receipt Number.').'" />'. 728: &Apache::lonnet::recprefix($env{'request.course.id'}). 729: '-<input type="text" name="receipt" size="4" />'. 730: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 731: '<input type="hidden" name="command" value="verify" />'. 732: "</form>\n"; 733: } 734: 735: #--- Check whether a receipt number is valid.--- 736: sub verifyreceipt { 737: my ($request,$symb) = @_; 738: 739: my $courseid = $env{'request.course.id'}; 740: my $receipt = &Apache::lonnet::recprefix($courseid).'-'. 741: $env{'form.receipt'}; 742: $receipt =~ s/[^\-\d]//g; 743: 744: my $title.= 745: '<h3><span class="LC_info">'. 746: &mt('Verifying Receipt Number [_1]',$receipt). 747: '</span></h3>'."\n"; 748: 749: my ($string,$contents,$matches) = ('','',0); 750: my (undef,undef,$fullname) = &getclasslist('all','0'); 751: 752: my $receiptparts=0; 753: if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || 754: $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } 755: my $parts=['0']; 756: if ($receiptparts) { 757: my $res_error; 758: ($parts)=&response_type($symb,\$res_error); 759: if ($res_error) { 760: return &navmap_errormsg(); 761: } 762: } 763: 764: my $header = 765: &Apache::loncommon::start_data_table(). 766: &Apache::loncommon::start_data_table_header_row(). 767: '<th> '.&mt('Fullname').' </th>'."\n". 768: '<th> '.&mt('Username').' </th>'."\n". 769: '<th> '.&mt('Domain').' </th>'; 770: if ($receiptparts) { 771: $header.='<th> '.&mt('Problem Part').' </th>'; 772: } 773: $header.= 774: &Apache::loncommon::end_data_table_header_row(); 775: 776: foreach (sort 777: { 778: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 779: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 780: } 781: return $a cmp $b; 782: } (keys(%$fullname))) { 783: my ($uname,$udom)=split(/\:/); 784: foreach my $part (@$parts) { 785: if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { 786: $contents.= 787: &Apache::loncommon::start_data_table_row(). 788: '<td> '."\n". 789: '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. 790: '\');" target="_self">'.$$fullname{$_}.'</a> </td>'."\n". 791: '<td> '.$uname.' </td>'. 792: '<td> '.$udom.' </td>'; 793: if ($receiptparts) { 794: $contents.='<td> '.$part.' </td>'; 795: } 796: $contents.= 797: &Apache::loncommon::end_data_table_row()."\n"; 798: 799: $matches++; 800: } 801: } 802: } 803: if ($matches == 0) { 804: $string = $title 805: .'<p class="LC_warning">' 806: .&mt('No match found for the above receipt number.') 807: .'</p>'; 808: } else { 809: $string = &jscriptNform($symb).$title. 810: '<p>'. 811: &mt('The above receipt number matches the following [quant,_1,student].',$matches). 812: '</p>'. 813: $header. 814: $contents. 815: &Apache::loncommon::end_data_table()."\n"; 816: } 817: return $string; 818: } 819: 820: #--- This is called by a number of programs. 821: #--- Called from the Grading Menu - View/Grade an individual student 822: #--- Also called directly when one clicks on the subm button 823: # on the problem page. 824: sub listStudents { 825: my ($request,$symb,$submitonly) = @_; 826: 827: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 828: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 829: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 830: my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; 831: unless ($submitonly) { 832: $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; 833: } 834: 835: my $result=''; 836: my $res_error; 837: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 838: 839: my %lt = &Apache::lonlocal::texthash ( 840: 'multiple' => 'Please select a student or group of students before clicking on the Next button.', 841: 'single' => 'Please select the student before clicking on the Next button.', 842: ); 843: $request->print(&Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT)); 844: function checkSelect(checkBox) { 845: var ctr=0; 846: var sense=""; 847: if (checkBox.length > 1) { 848: for (var i=0; i<checkBox.length; i++) { 849: if (checkBox[i].checked) { 850: ctr++; 851: } 852: } 853: sense = '$lt{'multiple'}'; 854: } else { 855: if (checkBox.checked) { 856: ctr = 1; 857: } 858: sense = '$lt{'single'}'; 859: } 860: if (ctr == 0) { 861: alert(sense); 862: return false; 863: } 864: document.gradesub.submit(); 865: } 866: 867: function reLoadList(formname) { 868: if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;} 869: formname.command.value = 'submission'; 870: formname.submit(); 871: } 872: LISTJAVASCRIPT 873: 874: &commonJSfunctions($request); 875: $request->print($result); 876: 877: my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'. 878: "\n"; 879: 880: $gradeTable .= &Apache::lonhtmlcommon::start_pick_box(); 881: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) 882: .'<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n" 883: .'<label><input type="radio" name="vProb" value="yes" /> '.&mt('one student').' </label>'."\n" 884: .'<label><input type="radio" name="vProb" value="all" /> '.&mt('all students').' </label><br />'."\n" 885: .&Apache::lonhtmlcommon::row_closure(); 886: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer')) 887: .'<label><input type="radio" name="vAns" value="no" /> '.&mt('no').' </label>'."\n" 888: .'<label><input type="radio" name="vAns" value="yes" /> '.&mt('one student').' </label>'."\n" 889: .'<label><input type="radio" name="vAns" value="all" checked="checked" /> '.&mt('all students').' </label><br />'."\n" 890: .&Apache::lonhtmlcommon::row_closure(); 891: 892: my $submission_options; 893: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 894: my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status; 895: $env{'form.Status'} = $saveStatus; 896: $submission_options.= 897: '<span class="LC_nobreak">'. 898: '<label><input type="radio" name="lastSub" value="lastonly" /> '. 899: &mt('last submission only').' </label></span>'."\n". 900: '<span class="LC_nobreak">'. 901: '<label><input type="radio" name="lastSub" value="last" /> '. 902: &mt('last submission & parts info').' </label></span>'."\n". 903: '<span class="LC_nobreak">'. 904: '<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '. 905: &mt('by dates and submissions').'</label></span>'."\n". 906: '<span class="LC_nobreak">'. 907: '<label><input type="radio" name="lastSub" value="all" /> '. 908: &mt('all details').'</label></span>'; 909: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Submissions')) 910: .$submission_options 911: .&Apache::lonhtmlcommon::row_closure(); 912: 913: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Grading Increments')) 914: .'<select name="increment">' 915: .'<option value="1">'.&mt('Whole Points').'</option>' 916: .'<option value=".5">'.&mt('Half Points').'</option>' 917: .'<option value=".25">'.&mt('Quarter Points').'</option>' 918: .'<option value=".1">'.&mt('Tenths of a Point').'</option>' 919: .'</select>' 920: .&Apache::lonhtmlcommon::row_closure(); 921: 922: $gradeTable .= 923: &build_section_inputs(). 924: '<input type="hidden" name="submitonly" value="'.$submitonly.'" />'."\n". 925: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 926: '<input type="hidden" name="saveStatusOld" value="'.$saveStatus.'" />'."\n"; 927: 928: if (exists($env{'form.Status'})) { 929: $gradeTable .= '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n"; 930: } else { 931: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Student Status')) 932: .&Apache::lonhtmlcommon::StatusOptions( 933: $saveStatus,undef,1,'javascript:reLoadList(this.form);') 934: .&Apache::lonhtmlcommon::row_closure(); 935: } 936: 937: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism')) 938: .'<input type="checkbox" name="checkPlag" checked="checked" />' 939: .&Apache::lonhtmlcommon::row_closure(1) 940: .&Apache::lonhtmlcommon::end_pick_box(); 941: 942: $gradeTable .= '<p>' 943: .&mt("To view/grade/regrade a submission or a group of submissions, click on the check box(es) next to the student's name(s). Then click on the Next button.")."\n" 944: .'<input type="hidden" name="command" value="processGroup" />' 945: .'</p>'; 946: 947: # checkall buttons 948: $gradeTable.=&check_script('gradesub', 'stuinfo'); 949: $gradeTable.='<input type="button" '."\n". 950: 'onclick="javascript:checkSelect(this.form.stuinfo);" '."\n". 951: 'value="'.&mt('Next').' →" /> <br />'."\n"; 952: $gradeTable.=&check_buttons(); 953: my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup); 954: $gradeTable.= &Apache::loncommon::start_data_table(). 955: &Apache::loncommon::start_data_table_header_row(); 956: my $loop = 0; 957: while ($loop < 2) { 958: $gradeTable.='<th>'.&mt('No.').'</th><th>'.&mt('Select').'</th>'. 959: '<th>'.&nameUserString('header').' '.&mt('Section/Group').'</th>'; 960: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 961: foreach my $part (sort(@$partlist)) { 962: my $display_part= 963: &get_display_part((split(/_/,$part))[0],$symb); 964: $gradeTable.= 965: '<th>'.&mt('Part: [_1] Status',$display_part).'</th>'; 966: } 967: } elsif ($submitonly eq 'queued') { 968: $gradeTable.='<th>'.&mt('Queue Status').' </th>'; 969: } 970: $loop++; 971: # $gradeTable.='<td></td>' if ($loop%2 ==1); 972: } 973: $gradeTable.=&Apache::loncommon::end_data_table_header_row()."\n"; 974: 975: my $ctr = 0; 976: foreach my $student (sort 977: { 978: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 979: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 980: } 981: return $a cmp $b; 982: } 983: (keys(%$fullname))) { 984: my ($uname,$udom) = split(/:/,$student); 985: 986: my %status = (); 987: 988: if ($submitonly eq 'queued') { 989: my %queue_status = 990: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 991: $udom,$uname); 992: next if (!defined($queue_status{'gradingqueue'})); 993: $status{'gradingqueue'} = $queue_status{'gradingqueue'}; 994: } 995: 996: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 997: (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); 998: my $submitted = 0; 999: my $graded = 0; 1000: my $incorrect = 0; 1001: foreach (keys(%status)) { 1002: $submitted = 1 if ($status{$_} ne 'nothing'); 1003: $graded = 1 if ($status{$_} =~ /^ungraded/); 1004: $incorrect = 1 if ($status{$_} =~ /^incorrect/); 1005: 1006: my ($foo,$partid,$foo1) = split(/\./,$_); 1007: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 1008: $submitted = 0; 1009: my ($part)=split(/\./,$partid); 1010: $gradeTable.='<input type="hidden" name="'. 1011: $student.':'.$part.':submitted_by" value="'. 1012: $status{'resource.'.$partid.'.submitted_by'}.'" />'; 1013: } 1014: } 1015: 1016: next if (!$submitted && ($submitonly eq 'yes' || 1017: $submitonly eq 'incorrect' || 1018: $submitonly eq 'graded')); 1019: next if (!$graded && ($submitonly eq 'graded')); 1020: next if (!$incorrect && $submitonly eq 'incorrect'); 1021: } 1022: 1023: $ctr++; 1024: my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; 1025: my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; 1026: if ( $perm{'vgr'} eq 'F' ) { 1027: if ($ctr%2 ==1) { 1028: $gradeTable.= &Apache::loncommon::start_data_table_row(); 1029: } 1030: $gradeTable.='<td align="right">'.$ctr.' </td>'. 1031: '<td align="center"><label><input type="checkbox" name="stuinfo" value="'. 1032: $student.':'.$$fullname{$student}.':::SECTION'.$section. 1033: ') " />  </label></td>'."\n".'<td>'. 1034: &nameUserString(undef,$$fullname{$student},$uname,$udom). 1035: ' '.$section.($group ne '' ?'/'.$group:'').'</td>'."\n"; 1036: 1037: if ($submitonly ne 'all') { 1038: foreach (sort(keys(%status))) { 1039: next if ($_ =~ /^resource.*?submitted_by$/); 1040: $gradeTable.='<td align="center"> '.&mt($status{$_}).' </td>'."\n"; 1041: } 1042: } 1043: # $gradeTable.='<td></td>' if ($ctr%2 ==1); 1044: if ($ctr%2 ==0) { 1045: $gradeTable.=&Apache::loncommon::end_data_table_row()."\n"; 1046: } 1047: } 1048: } 1049: if ($ctr%2 ==1) { 1050: $gradeTable.='<td> </td><td> </td><td> </td>'; 1051: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 1052: foreach (@$partlist) { 1053: $gradeTable.='<td> </td>'; 1054: } 1055: } elsif ($submitonly eq 'queued') { 1056: $gradeTable.='<td> </td>'; 1057: } 1058: $gradeTable.=&Apache::loncommon::end_data_table_row(); 1059: } 1060: 1061: $gradeTable.=&Apache::loncommon::end_data_table()."\n". 1062: '<input type="button" '. 1063: 'onclick="javascript:checkSelect(this.form.stuinfo);" '. 1064: 'value="'.&mt('Next').' →" /></form>'."\n"; 1065: if ($ctr == 0) { 1066: my $num_students=(scalar(keys(%$fullname))); 1067: if ($num_students eq 0) { 1068: $gradeTable='<br /> <span class="LC_warning">'.&mt('There are no students currently enrolled.').'</span>'; 1069: } else { 1070: my $submissions='submissions'; 1071: if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } 1072: if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } 1073: if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } 1074: $gradeTable='<br /> <span class="LC_warning">'. 1075: &mt('No '.$submissions.' found for this resource for any students. ([_1] students checked for '.$submissions.')', 1076: $num_students). 1077: '</span><br />'; 1078: } 1079: } elsif ($ctr == 1) { 1080: $gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/; 1081: } 1082: $request->print($gradeTable); 1083: return ''; 1084: } 1085: 1086: #---- Called from the listStudents routine 1087: 1088: sub check_script { 1089: my ($form, $type)=@_; 1090: my $chkallscript= &Apache::lonhtmlcommon::scripttag(' 1091: function checkall() { 1092: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1093: ele = document.forms.'.$form.'.elements[i]; 1094: if (ele.name == "'.$type.'") { 1095: document.forms.'.$form.'.elements[i].checked=true; 1096: } 1097: } 1098: } 1099: 1100: function checksec() { 1101: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1102: ele = document.forms.'.$form.'.elements[i]; 1103: string = document.forms.'.$form.'.chksec.value; 1104: if 1105: (ele.value.indexOf(":::SECTION"+string)>0) { 1106: document.forms.'.$form.'.elements[i].checked=true; 1107: } 1108: } 1109: } 1110: 1111: 1112: function uncheckall() { 1113: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1114: ele = document.forms.'.$form.'.elements[i]; 1115: if (ele.name == "'.$type.'") { 1116: document.forms.'.$form.'.elements[i].checked=false; 1117: } 1118: } 1119: } 1120: 1121: '."\n"); 1122: return $chkallscript; 1123: } 1124: 1125: sub check_buttons { 1126: my $buttons.='<input type="button" onclick="checkall()" value="'.&mt('Check All').'" />'; 1127: $buttons.='<input type="button" onclick="uncheckall()" value="'.&mt('Uncheck All').'" /> '; 1128: $buttons.='<input type="button" onclick="checksec()" value="'.&mt('Check Section/Group').'" />'; 1129: $buttons.='<input type="text" size="5" name="chksec" /> '; 1130: return $buttons; 1131: } 1132: 1133: # Displays the submissions for one student or a group of students 1134: sub processGroup { 1135: my ($request,$symb) = @_; 1136: my $ctr = 0; 1137: my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); 1138: my $total = scalar(@stuchecked)-1; 1139: 1140: foreach my $student (@stuchecked) { 1141: my ($uname,$udom,$fullname) = split(/:/,$student); 1142: $env{'form.student'} = $uname; 1143: $env{'form.userdom'} = $udom; 1144: $env{'form.fullname'} = $fullname; 1145: &submission($request,$ctr,$total,$symb); 1146: $ctr++; 1147: } 1148: return ''; 1149: } 1150: 1151: #------------------------------------------------------------------------------------ 1152: # 1153: #-------------------------- Next few routines handles grading by student, essentially 1154: # handles essay response type problem/part 1155: # 1156: #--- Javascript to handle the submission page functionality --- 1157: sub sub_page_js { 1158: my $request = shift; 1159: my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); 1160: $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT)); 1161: function updateRadio(formname,id,weight) { 1162: var gradeBox = formname["GD_BOX"+id]; 1163: var radioButton = formname["RADVAL"+id]; 1164: var oldpts = formname["oldpts"+id].value; 1165: var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts; 1166: gradeBox.value = pts; 1167: var resetbox = false; 1168: if (isNaN(pts) || pts < 0) { 1169: alert("$alertmsg"+pts); 1170: for (var i=0; i<radioButton.length; i++) { 1171: if (radioButton[i].checked) { 1172: gradeBox.value = i; 1173: resetbox = true; 1174: } 1175: } 1176: if (!resetbox) { 1177: formtextbox.value = ""; 1178: } 1179: return; 1180: } 1181: 1182: if (pts > weight) { 1183: var resp = confirm("You entered a value ("+pts+ 1184: ") greater than the weight for the part. Accept?"); 1185: if (resp == false) { 1186: gradeBox.value = oldpts; 1187: return; 1188: } 1189: } 1190: 1191: for (var i=0; i<radioButton.length; i++) { 1192: radioButton[i].checked=false; 1193: if (pts == i && pts != "") { 1194: radioButton[i].checked=true; 1195: } 1196: } 1197: updateSelect(formname,id); 1198: formname["stores"+id].value = "0"; 1199: } 1200: 1201: function writeBox(formname,id,pts) { 1202: var gradeBox = formname["GD_BOX"+id]; 1203: if (checkSolved(formname,id) == 'update') { 1204: gradeBox.value = pts; 1205: } else { 1206: var oldpts = formname["oldpts"+id].value; 1207: gradeBox.value = oldpts; 1208: var radioButton = formname["RADVAL"+id]; 1209: for (var i=0; i<radioButton.length; i++) { 1210: radioButton[i].checked=false; 1211: if (i == oldpts) { 1212: radioButton[i].checked=true; 1213: } 1214: } 1215: } 1216: formname["stores"+id].value = "0"; 1217: updateSelect(formname,id); 1218: return; 1219: } 1220: 1221: function clearRadBox(formname,id) { 1222: if (checkSolved(formname,id) == 'noupdate') { 1223: updateSelect(formname,id); 1224: return; 1225: } 1226: gradeSelect = formname["GD_SEL"+id]; 1227: for (var i=0; i<gradeSelect.length; i++) { 1228: if (gradeSelect[i].selected) { 1229: var selectx=i; 1230: } 1231: } 1232: var stores = formname["stores"+id]; 1233: if (selectx == stores.value) { return }; 1234: var gradeBox = formname["GD_BOX"+id]; 1235: gradeBox.value = ""; 1236: var radioButton = formname["RADVAL"+id]; 1237: for (var i=0; i<radioButton.length; i++) { 1238: radioButton[i].checked=false; 1239: } 1240: stores.value = selectx; 1241: } 1242: 1243: function checkSolved(formname,id) { 1244: if (formname["solved"+id].value == "correct_by_student" && formname.overRideScore.value == 'no') { 1245: var reply = confirm("This problem has been graded correct by the computer. Do you want to change the score?"); 1246: if (!reply) {return "noupdate";} 1247: formname.overRideScore.value = 'yes'; 1248: } 1249: return "update"; 1250: } 1251: 1252: function updateSelect(formname,id) { 1253: formname["GD_SEL"+id][0].selected = true; 1254: return; 1255: } 1256: 1257: //=========== Check that a point is assigned for all the parts ============ 1258: function checksubmit(formname,val,total,parttot) { 1259: formname.gradeOpt.value = val; 1260: if (val == "Save & Next") { 1261: for (i=0;i<=total;i++) { 1262: for (j=0;j<parttot;j++) { 1263: var partid = formname["partid"+i+"_"+j].value; 1264: if (formname["GD_SEL"+i+"_"+partid][0].selected) { 1265: var points = formname["GD_BOX"+i+"_"+partid].value; 1266: if (points == "") { 1267: var name = formname["name"+i].value; 1268: var studentID = (name != '' ? name : formname["unamedom"+i].value); 1269: var resp = confirm("You did not assign a score for "+studentID+ 1270: ", part "+partid+". Continue?"); 1271: if (resp == false) { 1272: formname["GD_BOX"+i+"_"+partid].focus(); 1273: return false; 1274: } 1275: } 1276: } 1277: 1278: } 1279: } 1280: 1281: } 1282: formname.submit(); 1283: } 1284: 1285: //======= Check that a score is assigned for all the problems (page/sequence grading only) ========= 1286: function checkSubmitPage(formname,total) { 1287: noscore = new Array(100); 1288: var ptr = 0; 1289: for (i=1;i<total;i++) { 1290: var partid = formname["q_"+i].value; 1291: if (formname["GD_SEL"+i+"_"+partid][0].selected) { 1292: var points = formname["GD_BOX"+i+"_"+partid].value; 1293: var status = formname["solved"+i+"_"+partid].value; 1294: if (points == "" && status != "correct_by_student") { 1295: noscore[ptr] = i; 1296: ptr++; 1297: } 1298: } 1299: } 1300: if (ptr != 0) { 1301: var sense = ptr == 1 ? ": " : "s: "; 1302: var prolist = ""; 1303: if (ptr == 1) { 1304: prolist = noscore[0]; 1305: } else { 1306: var i = 0; 1307: while (i < ptr-1) { 1308: prolist += noscore[i]+", "; 1309: i++; 1310: } 1311: prolist += "and "+noscore[i]; 1312: } 1313: var resp = confirm("You did not assign any score for the following problem"+sense+prolist+". Continue?"); 1314: if (resp == false) { 1315: return false; 1316: } 1317: } 1318: 1319: formname.submit(); 1320: } 1321: SUBJAVASCRIPT 1322: } 1323: 1324: #--- javascript for essay type problem -- 1325: sub sub_page_kw_js { 1326: my $request = shift; 1327: my $iconpath = $request->dir_config('lonIconsURL'); 1328: &commonJSfunctions($request); 1329: 1330: my $inner_js_msg_central= (<<INNERJS); 1331: <script type="text/javascript"> 1332: function checkInput() { 1333: opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value); 1334: var nmsg = opener.document.SCORE.savemsgN.value; 1335: var usrctr = document.msgcenter.usrctr.value; 1336: var newval = opener.document.SCORE["newmsg"+usrctr]; 1337: newval.value = opener.checkEntities(document.msgcenter.newmsg.value); 1338: 1339: var msgchk = ""; 1340: if (document.msgcenter.subchk.checked) { 1341: msgchk = "msgsub,"; 1342: } 1343: var includemsg = 0; 1344: for (var i=1; i<=nmsg; i++) { 1345: var opnmsg = opener.document.SCORE["savemsg"+i]; 1346: var frmmsg = document.msgcenter["msg"+i]; 1347: opnmsg.value = opener.checkEntities(frmmsg.value); 1348: var showflg = opener.document.SCORE["shownOnce"+i]; 1349: showflg.value = "1"; 1350: var chkbox = document.msgcenter["msgn"+i]; 1351: if (chkbox.checked) { 1352: msgchk += "savemsg"+i+","; 1353: includemsg = 1; 1354: } 1355: } 1356: if (document.msgcenter.newmsgchk.checked) { 1357: msgchk += "newmsg"+usrctr; 1358: includemsg = 1; 1359: } 1360: imgformname = opener.document.SCORE["mailicon"+usrctr]; 1361: imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif"); 1362: var includemsg = opener.document.SCORE["includemsg"+usrctr]; 1363: includemsg.value = msgchk; 1364: 1365: self.close() 1366: 1367: } 1368: </script> 1369: INNERJS 1370: 1371: my $inner_js_highlight_central= (<<INNERJS); 1372: <script type="text/javascript"> 1373: function updateChoice(flag) { 1374: opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr); 1375: opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize); 1376: opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle); 1377: opener.document.SCORE.refresh.value = "on"; 1378: if (opener.document.SCORE.keywords.value!=""){ 1379: opener.document.SCORE.submit(); 1380: } 1381: self.close() 1382: } 1383: </script> 1384: INNERJS 1385: 1386: my $start_page_msg_central = 1387: &Apache::loncommon::start_page('Message Central',$inner_js_msg_central, 1388: {'js_ready' => 1, 1389: 'only_body' => 1, 1390: 'bgcolor' =>'#FFFFFF',}); 1391: my $end_page_msg_central = 1392: &Apache::loncommon::end_page({'js_ready' => 1}); 1393: 1394: 1395: my $start_page_highlight_central = 1396: &Apache::loncommon::start_page('Highlight Central', 1397: $inner_js_highlight_central, 1398: {'js_ready' => 1, 1399: 'only_body' => 1, 1400: 'bgcolor' =>'#FFFFFF',}); 1401: my $end_page_highlight_central = 1402: &Apache::loncommon::end_page({'js_ready' => 1}); 1403: 1404: my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); 1405: $docopen=~s/^document\.//; 1406: my $alertmsg = &mt('Please select a word or group of words from document and then click this link.'); 1407: $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT)); 1408: 1409: //===================== Show list of keywords ==================== 1410: function keywords(formname) { 1411: var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",formname.keywords.value); 1412: if (nret==null) return; 1413: formname.keywords.value = nret; 1414: 1415: if (formname.keywords.value != "") { 1416: formname.refresh.value = "on"; 1417: formname.submit(); 1418: } 1419: return; 1420: } 1421: 1422: //===================== Script to view submitted by ================== 1423: function viewSubmitter(submitter) { 1424: document.SCORE.refresh.value = "on"; 1425: document.SCORE.NCT.value = "1"; 1426: document.SCORE.unamedom0.value = submitter; 1427: document.SCORE.submit(); 1428: return; 1429: } 1430: 1431: //===================== Script to add keyword(s) ================== 1432: function getSel() { 1433: if (document.getSelection) txt = document.getSelection(); 1434: else if (document.selection) txt = document.selection.createRange().text; 1435: else return; 1436: var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," "); 1437: if (cleantxt=="") { 1438: alert("$alertmsg"); 1439: return; 1440: } 1441: var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt); 1442: if (nret==null) return; 1443: document.SCORE.keywords.value = document.SCORE.keywords.value+" "+nret; 1444: if (document.SCORE.keywords.value != "") { 1445: document.SCORE.refresh.value = "on"; 1446: document.SCORE.submit(); 1447: } 1448: return; 1449: } 1450: 1451: //====================== Script for composing message ============== 1452: // preload images 1453: img1 = new Image(); 1454: img1.src = "$iconpath/mailbkgrd.gif"; 1455: img2 = new Image(); 1456: img2.src = "$iconpath/mailto.gif"; 1457: 1458: function msgCenter(msgform,usrctr,fullname) { 1459: var Nmsg = msgform.savemsgN.value; 1460: savedMsgHeader(Nmsg,usrctr,fullname); 1461: var subject = msgform.msgsub.value; 1462: var msgchk = document.SCORE["includemsg"+usrctr].value; 1463: re = /msgsub/; 1464: var shwsel = ""; 1465: if (re.test(msgchk)) { shwsel = "checked" } 1466: subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject); 1467: displaySubject(checkEntities(subject),shwsel); 1468: for (var i=1; i<=Nmsg; i++) { 1469: var testmsg = "savemsg"+i+","; 1470: re = new RegExp(testmsg,"g"); 1471: shwsel = ""; 1472: if (re.test(msgchk)) { shwsel = "checked" } 1473: var message = document.SCORE["savemsg"+i].value; 1474: message = (document.SCORE["shownOnce"+i].value == 0 ? checkEntities(message) : message); 1475: displaySavedMsg(i,message,shwsel); //I do not get it. w/o checkEntities on saved messages, 1476: //any < is already converted to <, etc. However, only once!! 1477: } 1478: newmsg = document.SCORE["newmsg"+usrctr].value; 1479: shwsel = ""; 1480: re = /newmsg/; 1481: if (re.test(msgchk)) { shwsel = "checked" } 1482: newMsg(newmsg,shwsel); 1483: msgTail(); 1484: return; 1485: } 1486: 1487: function checkEntities(strx) { 1488: if (strx.length == 0) return strx; 1489: var orgStr = ["&", "<", ">", '"']; 1490: var newStr = ["&", "<", ">", """]; 1491: var counter = 0; 1492: while (counter < 4) { 1493: strx = strReplace(strx,orgStr[counter],newStr[counter]); 1494: counter++; 1495: } 1496: return strx; 1497: } 1498: 1499: function strReplace(strx, orgStr, newStr) { 1500: return strx.split(orgStr).join(newStr); 1501: } 1502: 1503: function savedMsgHeader(Nmsg,usrctr,fullname) { 1504: var height = 70*Nmsg+250; 1505: var scrollbar = "no"; 1506: if (height > 600) { 1507: height = 600; 1508: scrollbar = "yes"; 1509: } 1510: var xpos = (screen.width-600)/2; 1511: xpos = (xpos < 0) ? '0' : xpos; 1512: var ypos = (screen.height-height)/2-30; 1513: ypos = (ypos < 0) ? '0' : ypos; 1514: 1515: pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=700,height='+height); 1516: pWin.focus(); 1517: pDoc = pWin.document; 1518: pDoc.$docopen; 1519: pDoc.write('$start_page_msg_central'); 1520: 1521: pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">"); 1522: pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">"); 1523: pDoc.write("<h3><span class=\\"LC_info\\"> Compose Message for \"+fullname+\"<\\/span><\\/h3><br /><br />"); 1524: 1525: pDoc.write('<table border="0" width="100%"><tr><td bgcolor="#777777">'); 1526: pDoc.write('<table border="0" width="100%"><tr bgcolor="#DDFFFF">'); 1527: pDoc.write("<td><b>Type<\\/b><\\/td><td><b>Include<\\/b><\\/td><td><b>Message<\\/td><\\/tr>"); 1528: } 1529: function displaySubject(msg,shwsel) { 1530: pDoc = pWin.document; 1531: pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); 1532: pDoc.write("<td>Subject<\\/td>"); 1533: pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1534: pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"60\\" maxlength=\\"80\\"><\\/td><\\/tr>"); 1535: } 1536: 1537: function displaySavedMsg(ctr,msg,shwsel) { 1538: pDoc = pWin.document; 1539: pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); 1540: pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>"); 1541: pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1542: pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>"); 1543: } 1544: 1545: function newMsg(newmsg,shwsel) { 1546: pDoc = pWin.document; 1547: pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); 1548: pDoc.write("<td align=\\"center\\">New<\\/td>"); 1549: pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1550: pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>"); 1551: } 1552: 1553: function msgTail() { 1554: pDoc = pWin.document; 1555: pDoc.write("<\\/table>"); 1556: pDoc.write("<\\/td><\\/tr><\\/table> "); 1557: pDoc.write("<input type=\\"button\\" value=\\"Save\\" onclick=\\"javascript:checkInput()\\">  "); 1558: pDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onclick=\\"self.close()\\"><br /><br />"); 1559: pDoc.write("<\\/form>"); 1560: pDoc.write('$end_page_msg_central'); 1561: pDoc.close(); 1562: } 1563: 1564: //====================== Script for keyword highlight options ============== 1565: function kwhighlight() { 1566: var kwclr = document.SCORE.kwclr.value; 1567: var kwsize = document.SCORE.kwsize.value; 1568: var kwstyle = document.SCORE.kwstyle.value; 1569: var redsel = ""; 1570: var grnsel = ""; 1571: var blusel = ""; 1572: if (kwclr=="red") {var redsel="checked"}; 1573: if (kwclr=="green") {var grnsel="checked"}; 1574: if (kwclr=="blue") {var blusel="checked"}; 1575: var sznsel = ""; 1576: var sz1sel = ""; 1577: var sz2sel = ""; 1578: if (kwsize=="0") {var sznsel="checked"}; 1579: if (kwsize=="+1") {var sz1sel="checked"}; 1580: if (kwsize=="+2") {var sz2sel="checked"}; 1581: var synsel = ""; 1582: var syisel = ""; 1583: var sybsel = ""; 1584: if (kwstyle=="") {var synsel="checked"}; 1585: if (kwstyle=="<i>") {var syisel="checked"}; 1586: if (kwstyle=="<b>") {var sybsel="checked"}; 1587: highlightCentral(); 1588: highlightbody('red','red',redsel,'0','normal',sznsel,'','normal',synsel); 1589: highlightbody('green','green',grnsel,'+1','+1',sz1sel,'<i>','italic',syisel); 1590: highlightbody('blue','blue',blusel,'+2','+2',sz2sel,'<b>','bold',sybsel); 1591: highlightend(); 1592: return; 1593: } 1594: 1595: function highlightCentral() { 1596: // if (window.hwdWin) window.hwdWin.close(); 1597: var xpos = (screen.width-400)/2; 1598: xpos = (xpos < 0) ? '0' : xpos; 1599: var ypos = (screen.height-330)/2-30; 1600: ypos = (ypos < 0) ? '0' : ypos; 1601: 1602: hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); 1603: hwdWin.focus(); 1604: var hDoc = hwdWin.document; 1605: hDoc.$docopen; 1606: hDoc.write('$start_page_highlight_central'); 1607: hDoc.write("<form action=\\"inactive\\" name=\\"hlCenter\\">"); 1608: hDoc.write("<h3><span class=\\"LC_info\\"> Keyword Highlight Options<\\/span><\\/h3><br /><br />"); 1609: 1610: hDoc.write('<table border="0" width="100%"><tr><td bgcolor="#777777">'); 1611: hDoc.write('<table border="0" width="100%"><tr bgcolor="#DDFFFF">'); 1612: hDoc.write("<td><b>Text Color<\\/b><\\/td><td><b>Font Size<\\/b><\\/td><td><b>Font Style<\\/td><\\/tr>"); 1613: } 1614: 1615: function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) { 1616: var hDoc = hwdWin.document; 1617: hDoc.write("<tr bgcolor=\\"#ffffdd\\">"); 1618: hDoc.write("<td align=\\"left\\">"); 1619: hDoc.write("<input name=\\"kwdclr\\" type=\\"radio\\" value=\\""+clrval+"\\" "+clrsel+"> "+clrtxt+"<\\/td>"); 1620: hDoc.write("<td align=\\"left\\">"); 1621: hDoc.write("<input name=\\"kwdsize\\" type=\\"radio\\" value=\\""+szval+"\\" "+szsel+"> "+sztxt+"<\\/td>"); 1622: hDoc.write("<td align=\\"left\\">"); 1623: hDoc.write("<input name=\\"kwdstyle\\" type=\\"radio\\" value=\\""+syval+"\\" "+sysel+"> "+sytxt+"<\\/td>"); 1624: hDoc.write("<\\/tr>"); 1625: } 1626: 1627: function highlightend() { 1628: var hDoc = hwdWin.document; 1629: hDoc.write("<\\/table>"); 1630: hDoc.write("<\\/td><\\/tr><\\/table> "); 1631: hDoc.write("<input type=\\"button\\" value=\\"Save\\" onclick=\\"javascript:updateChoice(1)\\">  "); 1632: hDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onclick=\\"self.close()\\"><br /><br />"); 1633: hDoc.write("<\\/form>"); 1634: hDoc.write('$end_page_highlight_central'); 1635: hDoc.close(); 1636: } 1637: 1638: SUBJAVASCRIPT 1639: } 1640: 1641: sub get_increment { 1642: my $increment = $env{'form.increment'}; 1643: if ($increment != 1 && $increment != .5 && $increment != .25 && 1644: $increment != .1) { 1645: $increment = 1; 1646: } 1647: return $increment; 1648: } 1649: 1650: sub gradeBox_start { 1651: return ( 1652: &Apache::loncommon::start_data_table() 1653: .&Apache::loncommon::start_data_table_header_row() 1654: .'<th>'.&mt('Part').'</th>' 1655: .'<th>'.&mt('Points').'</th>' 1656: .'<th> </th>' 1657: .'<th>'.&mt('Assign Grade').'</th>' 1658: .'<th>'.&mt('Weight').'</th>' 1659: .'<th>'.&mt('Grade Status').'</th>' 1660: .&Apache::loncommon::end_data_table_header_row() 1661: ); 1662: } 1663: 1664: sub gradeBox_end { 1665: return ( 1666: &Apache::loncommon::end_data_table() 1667: ); 1668: } 1669: #--- displays the grading box, used in essay type problem and grading by page/sequence 1670: sub gradeBox { 1671: my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; 1672: my $checkIcon = '<img alt="'.&mt('Check Mark'). 1673: '" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />'; 1674: my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); 1675: my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)') 1676: : '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>'; 1677: $wgt = ($wgt > 0 ? $wgt : '1'); 1678: my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? 1679: '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); 1680: my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n"; 1681: my $display_part= &get_display_part($partid,$symb); 1682: my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, 1683: [$partid]); 1684: my $aggtries = $$record{'resource.'.$partid.'.tries'}; 1685: if ($last_resets{$partid}) { 1686: $aggtries = &get_num_tries($record,$last_resets{$partid},$partid); 1687: } 1688: $result.=&Apache::loncommon::start_data_table_row(); 1689: my $ctr = 0; 1690: my $thisweight = 0; 1691: my $increment = &get_increment(); 1692: 1693: my $radio.='<table border="0"><tr>'."\n"; # display radio buttons in a nice table 10 across 1694: while ($thisweight<=$wgt) { 1695: $radio.= '<td><span class="LC_nobreak"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '. 1696: 'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','. 1697: $thisweight.')" value="'.$thisweight.'" '. 1698: ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n"; 1699: $radio.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); 1700: $thisweight += $increment; 1701: $ctr++; 1702: } 1703: $radio.='</tr></table>'; 1704: 1705: my $line.='<input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'. 1706: ($score ne ''? ' value = "'.$score.'"':'').' size="4" '. 1707: 'onchange="javascript:updateRadio(this.form,\''.$counter.'_'.$partid.'\','. 1708: $wgt.')" /></td>'."\n"; 1709: $line.='<td>/'.$wgt.' '.$wgtmsg. 1710: ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : ''). 1711: ' </td>'."\n"; 1712: $line.='<td><select name="GD_SEL'.$counter.'_'.$partid.'" '. 1713: 'onchange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n"; 1714: if ($$record{'resource.'.$partid.'.solved'} eq 'excused') { 1715: $line.='<option></option>'. 1716: '<option value="excused" selected="selected">'.&mt('excused').'</option>'; 1717: } else { 1718: $line.='<option selected="selected"></option>'. 1719: '<option value="excused" >'.&mt('excused').'</option>'; 1720: } 1721: $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n"; 1722: 1723: 1724: $result .= 1725: '<td>'.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'; 1726: $result.=&Apache::loncommon::end_data_table_row(); 1727: $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n". 1728: '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n". 1729: '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'. 1730: $$record{'resource.'.$partid.'.solved'}.'" />'."\n". 1731: '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'. 1732: $$record{'resource.'.$partid.'.tries'}.'" />'."\n". 1733: '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'. 1734: $aggtries.'" />'."\n"; 1735: my $res_error; 1736: $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record,\$res_error); 1737: if ($res_error) { 1738: return &navmap_errormsg(); 1739: } 1740: return $result; 1741: } 1742: 1743: sub handback_box { 1744: my ($symb,$uname,$udom,$counter,$partid,$record,$res_error_pointer) = @_; 1745: my ($partlist,$handgrade,$responseType) = &response_type($symb,$res_error_pointer); 1746: my (@respids); 1747: my @part_response_id = &flatten_responseType($responseType); 1748: foreach my $part_response_id (@part_response_id) { 1749: my ($part,$resp) = @{ $part_response_id }; 1750: if ($part eq $partid) { 1751: push(@respids,$resp); 1752: } 1753: } 1754: my $result; 1755: foreach my $respid (@respids) { 1756: my $prefix = $counter.'_'.$partid.'_'.$respid.'_'; 1757: my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record); 1758: next if (!@$files); 1759: my $file_counter = 1; 1760: foreach my $file (@$files) { 1761: if ($file =~ /\/portfolio\//) { 1762: my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|); 1763: my ($name,$version,$ext) = &file_name_version_ext($file_disp); 1764: $file_disp = "$name.$ext"; 1765: $file = $file_path.$file_disp; 1766: $result.=&mt('Return commented version of [_1] to student.', 1767: '<span class="LC_filename">'.$file_disp.'</span>'); 1768: $result.='<input type="file" name="'.$prefix.'returndoc'.$file_counter.'" />'."\n"; 1769: $result.='<input type="hidden" name="'.$prefix.'origdoc'.$file_counter.'" value="'.$file.'" /><br />'; 1770: $result.='('.&mt('File will be uploaded when you click on Save & Next below.').')<br />'; 1771: $file_counter++; 1772: } 1773: } 1774: } 1775: return $result; 1776: } 1777: 1778: sub show_problem { 1779: my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_; 1780: my $rendered; 1781: my %form = ((ref($form) eq 'HASH')? %{$form} : ()); 1782: &Apache::lonxml::remember_problem_counter(); 1783: if ($mode eq 'both' or $mode eq 'text') { 1784: $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, 1785: $env{'request.course.id'}, 1786: undef,\%form); 1787: } 1788: if ($removeform) { 1789: $rendered=~s|<form(.*?)>||g; 1790: $rendered=~s|</form>||g; 1791: $rendered=~s|(<input[^>]*name\s*=\s*"?)(\w+)("?)|$1would_have_been_$2$3|g; 1792: } 1793: my $companswer; 1794: if ($mode eq 'both' or $mode eq 'answer') { 1795: &Apache::lonxml::restore_problem_counter(); 1796: $companswer= 1797: &Apache::loncommon::get_student_answers($symb,$uname,$udom, 1798: $env{'request.course.id'}, 1799: %form); 1800: } 1801: if ($removeform) { 1802: $companswer=~s|<form(.*?)>||g; 1803: $companswer=~s|</form>||g; 1804: $companswer=~s|name="submit"|name="would_have_been_submit"|g; 1805: } 1806: $rendered= 1807: '<div class="LC_Box">' 1808: .'<h3 class="LC_hcell">'.&mt('View of the problem').'</h3>' 1809: .$rendered 1810: .'</div>'; 1811: $companswer= 1812: '<div class="LC_Box">' 1813: .'<h3 class="LC_hcell">'.&mt('Correct answer').'</h3>' 1814: .$companswer 1815: .'</div>'; 1816: my $result; 1817: if ($mode eq 'both') { 1818: $result=$rendered.$companswer; 1819: } elsif ($mode eq 'text') { 1820: $result=$rendered; 1821: } elsif ($mode eq 'answer') { 1822: $result=$companswer; 1823: } 1824: return $result; 1825: } 1826: 1827: sub files_exist { 1828: my ($r, $symb) = @_; 1829: my @students = &Apache::loncommon::get_env_multiple('form.stuinfo'); 1830: 1831: foreach my $student (@students) { 1832: my ($uname,$udom,$fullname) = split(/:/,$student); 1833: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, 1834: $udom,$uname); 1835: my ($string,$timestamp)= &get_last_submission(\%record); 1836: foreach my $submission (@$string) { 1837: my ($partid,$respid) = 1838: ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); 1839: my $files=&get_submitted_files($udom,$uname,$partid,$respid, 1840: \%record); 1841: return 1 if (@$files); 1842: } 1843: } 1844: return 0; 1845: } 1846: 1847: sub download_all_link { 1848: my ($r,$symb) = @_; 1849: unless (&files_exist($r, $symb)) { 1850: $r->print(&mt('There are currently no submitted documents.')); 1851: return; 1852: } 1853: 1854: my $all_students = 1855: join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo')); 1856: 1857: my $parts = 1858: join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); 1859: 1860: my $identifier = &Apache::loncommon::get_cgi_id(); 1861: &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, 1862: 'cgi.'.$identifier.'.symb' => $symb, 1863: 'cgi.'.$identifier.'.parts' => $parts,}); 1864: $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'. 1865: &mt('Download All Submitted Documents').'</a>'); 1866: return; 1867: } 1868: 1869: sub submit_download_link { 1870: my ($request,$symb) = @_; 1871: if (!$symb) { return ''; } 1872: #FIXME: Figure out which type of problem this is and provide appropriate download 1873: &download_all_link($request,$symb); 1874: } 1875: 1876: sub build_section_inputs { 1877: my $section_inputs; 1878: if ($env{'form.section'} eq '') { 1879: $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n"; 1880: } else { 1881: my @sections = &Apache::loncommon::get_env_multiple('form.section'); 1882: foreach my $section (@sections) { 1883: $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n"; 1884: } 1885: } 1886: return $section_inputs; 1887: } 1888: 1889: # --------------------------- show submissions of a student, option to grade 1890: sub submission { 1891: my ($request,$counter,$total,$symb) = @_; 1892: my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); 1893: $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student? 1894: my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); 1895: $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq ''; 1896: 1897: my $probtitle=&Apache::lonnet::gettitle($symb); 1898: if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } 1899: 1900: if (!&canview($usec)) { 1901: $request->print('<span class="LC_warning">Unable to view requested student.('. 1902: $uname.':'.$udom.' in section '.$usec.' in course id '. 1903: $env{'request.course.id'}.')</span>'); 1904: return; 1905: } 1906: 1907: if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; } 1908: if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; } 1909: if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; } 1910: my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); 1911: my $checkIcon = '<img alt="'.&mt('Check Mark'). 1912: '" src="'.$request->dir_config('lonIconsURL'). 1913: '/check.gif" height="16" border="0" />'; 1914: 1915: my %old_essays; 1916: # header info 1917: if ($counter == 0) { 1918: &sub_page_js($request); 1919: &sub_page_kw_js($request); 1920: 1921: # option to display problem, only once else it cause problems 1922: # with the form later since the problem has a form. 1923: if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') { 1924: my $mode; 1925: if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') { 1926: $mode='both'; 1927: } elsif ($env{'form.vProb'} eq 'yes') { 1928: $mode='text'; 1929: } elsif ($env{'form.vAns'} eq 'yes') { 1930: $mode='answer'; 1931: } 1932: &Apache::lonxml::clear_problem_counter(); 1933: $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); 1934: } 1935: 1936: # kwclr is the only variable that is guaranteed to be non blank 1937: # if this subroutine has been called once. 1938: my %keyhash = (); 1939: # if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') { 1940: if (1) { 1941: %keyhash = &Apache::lonnet::dump('nohist_handgrade', 1942: $env{'course.'.$env{'request.course.id'}.'.domain'}, 1943: $env{'course.'.$env{'request.course.id'}.'.num'}); 1944: 1945: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 1946: $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; 1947: $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; 1948: $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; 1949: $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; 1950: $env{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? 1951: $keyhash{$symb.'_subject'} : $probtitle; 1952: $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; 1953: } 1954: my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'}; 1955: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 1956: $request->print('<form action="/adm/grades" method="post" name="SCORE" enctype="multipart/form-data">'."\n". 1957: '<input type="hidden" name="command" value="handgrade" />'."\n". 1958: '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 1959: '<input type="hidden" name="overRideScore" value="'.$overRideScore.'" />'."\n". 1960: '<input type="hidden" name="refresh" value="off" />'."\n". 1961: '<input type="hidden" name="studentNo" value="" />'."\n". 1962: '<input type="hidden" name="gradeOpt" value="" />'."\n". 1963: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 1964: '<input type="hidden" name="vProb" value="'.$env{'form.vProb'}.'" />'."\n". 1965: '<input type="hidden" name="vAns" value="'.$env{'form.vAns'}.'" />'."\n". 1966: '<input type="hidden" name="lastSub" value="'.$env{'form.lastSub'}.'" />'."\n". 1967: &build_section_inputs(). 1968: '<input type="hidden" name="submitonly" value="'.$env{'form.submitonly'}.'" />'."\n". 1969: '<input type="hidden" name="NCT"'. 1970: ' value="'.($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : $total+1).'" />'."\n"); 1971: # if ($env{'form.handgrade'} eq 'yes') { 1972: if (1) { 1973: $request->print('<input type="hidden" name="keywords" value="'.$env{'form.keywords'}.'" />'."\n". 1974: '<input type="hidden" name="kwclr" value="'.$env{'form.kwclr'}.'" />'."\n". 1975: '<input type="hidden" name="kwsize" value="'.$env{'form.kwsize'}.'" />'."\n". 1976: '<input type="hidden" name="kwstyle" value="'.$env{'form.kwstyle'}.'" />'."\n". 1977: '<input type="hidden" name="msgsub" value="'.$env{'form.msgsub'}.'" />'."\n". 1978: '<input type="hidden" name="shownSub" value="0" />'."\n". 1979: '<input type="hidden" name="savemsgN" value="'.$env{'form.savemsgN'}.'" />'."\n"); 1980: foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { 1981: $request->print('<input type="hidden" name="vPart" value="'.$partid.'" />'."\n"); 1982: } 1983: } 1984: 1985: my ($cts,$prnmsg) = (1,''); 1986: while ($cts <= $env{'form.savemsgN'}) { 1987: $prnmsg.='<input type="hidden" name="savemsg'.$cts.'" value="'. 1988: (!exists($keyhash{$symb.'_savemsg'.$cts}) ? 1989: &Apache::lonfeedback::clear_out_html($env{'form.savemsg'.$cts}) : 1990: &Apache::lonfeedback::clear_out_html($keyhash{$symb.'_savemsg'.$cts})). 1991: '" />'."\n". 1992: '<input type="hidden" name="shownOnce'.$cts.'" value="0" />'."\n"; 1993: $cts++; 1994: } 1995: $request->print($prnmsg); 1996: 1997: # if ($env{'form.handgrade'} eq 'yes') { 1998: if (1) { 1999: # 2000: # Print out the keyword options line 2001: # 2002: $request->print(<<KEYWORDS); 2003:  <b>Keyword Options:</b>  2004: <a href="javascript:keywords(document.SCORE);" target="_self">List</a>    2005: <a href="#" onmousedown="javascript:getSel(); return false" 2006: CLASS="page">Paste Selection to List</a>    2007: <a href="javascript:kwhighlight();" target="_self">Highlight Attribute</a><br /><br /> 2008: KEYWORDS 2009: # 2010: # Load the other essays for similarity check 2011: # 2012: my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); 2013: my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); 2014: $apath=&escape($apath); 2015: $apath=~s/\W/\_/gs; 2016: %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); 2017: } 2018: } 2019: 2020: # This is where output for one specific student would start 2021: my $add_class = ($counter%2) ? ' LC_grade_show_user_odd_row' : ''; 2022: $request->print( 2023: "\n\n" 2024: .'<div class="LC_grade_show_user'.$add_class.'">' 2025: .'<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).'</h2>' 2026: ."\n" 2027: ); 2028: 2029: # Show additional functions if allowed 2030: if ($perm{'vgr'}) { 2031: $request->print( 2032: &Apache::loncommon::track_student_link( 2033: &mt('View recent activity'), 2034: $uname,$udom,'check') 2035: .' ' 2036: ); 2037: } 2038: if ($perm{'opa'}) { 2039: $request->print( 2040: &Apache::loncommon::pprmlink( 2041: &mt('Set/Change parameters'), 2042: $uname,$udom,$symb,'check')); 2043: } 2044: 2045: # Show Problem 2046: if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') { 2047: my $mode; 2048: if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') { 2049: $mode='both'; 2050: } elsif ($env{'form.vProb'} eq 'all' ) { 2051: $mode='text'; 2052: } elsif ($env{'form.vAns'} eq 'all') { 2053: $mode='answer'; 2054: } 2055: &Apache::lonxml::clear_problem_counter(); 2056: $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode,{'request.prefix' => 'ctr'.$counter})); 2057: } 2058: 2059: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 2060: my $res_error; 2061: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 2062: if ($res_error) { 2063: $request->print(&navmap_errormsg()); 2064: return; 2065: } 2066: 2067: # Display student info 2068: $request->print(($counter == 0 ? '' : '<br />')); 2069: 2070: my $result='<div class="LC_Box">' 2071: .'<h3 class="LC_hcell">'.&mt('Submissions').'</h3>'; 2072: $result.='<input type="hidden" name="name'.$counter. 2073: '" value="'.$env{'form.fullname'}.'" />'."\n"; 2074: # if ($env{'form.handgrade'} eq 'no') { 2075: if (1) { 2076: $result.='<p class="LC_info">' 2077: .&mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon) 2078: ."</p>\n"; 2079: } 2080: 2081: # If any part of the problem is an essay-response (handgraded), then check for collaborators 2082: my $fullname; 2083: my $col_fullnames = []; 2084: # if ($env{'form.handgrade'} eq 'yes') { 2085: if (1) { 2086: (my $sub_result,$fullname,$col_fullnames)= 2087: &check_collaborators($symb,$uname,$udom,\%record,$handgrade, 2088: $counter); 2089: $result.=$sub_result; 2090: } 2091: $request->print($result."\n"); 2092: 2093: # print student answer/submission 2094: # Options are (1) Handgraded submission only 2095: # (2) Last submission, includes submission that is not handgraded 2096: # (for multi-response type part) 2097: # (3) Last submission plus the parts info 2098: # (4) The whole record for this student 2099: if ($env{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { 2100: my ($string,$timestamp)= &get_last_submission(\%record); 2101: 2102: my $lastsubonly; 2103: 2104: if ($$timestamp eq '') { 2105: $lastsubonly.='<div class="LC_grade_submissions_body">'.$$string[0].'</div>'; 2106: } else { 2107: $lastsubonly = 2108: '<div class="LC_grade_submissions_body">' 2109: .'<b>'.&mt('Date Submitted:').'</b> '.$$timestamp."\n"; 2110: 2111: my %seenparts; 2112: my @part_response_id = &flatten_responseType($responseType); 2113: foreach my $part (@part_response_id) { 2114: next if ($env{'form.lastSub'} eq 'hdgrade' 2115: && $$handgrade{$$part[0].'_'.$$part[1]} ne 'yes'); 2116: 2117: my ($partid,$respid) = @{ $part }; 2118: my $display_part=&get_display_part($partid,$symb); 2119: if ($env{"form.$uname:$udom:$partid:submitted_by"}) { 2120: if (exists($seenparts{$partid})) { next; } 2121: $seenparts{$partid}=1; 2122: my $submitby='<b>Part:</b> '.$display_part. 2123: ' <b>Collaborative submission by:</b> '. 2124: '<a href="javascript:viewSubmitter(\''. 2125: $env{"form.$uname:$udom:$partid:submitted_by"}. 2126: '\');" target="_self">'. 2127: $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />'; 2128: $request->print($submitby); 2129: next; 2130: } 2131: my $responsetype = $responseType->{$partid}->{$respid}; 2132: if (!exists($record{"resource.$partid.$respid.submission"})) { 2133: $lastsubonly.="\n".'<div class="LC_grade_submission_part">'. 2134: '<b>'.&mt('Part: [_1]',$display_part).'</b>'. 2135: ' <span class="LC_internal_info">'. 2136: '('.&mt('Response ID: [_1]',$respid).')'. 2137: '</span>   '. 2138: '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br /><br /></div>'; 2139: next; 2140: } 2141: foreach my $submission (@$string) { 2142: my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); 2143: if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; } 2144: my ($ressub,$hide,$subval) = split(/:/,$submission,3); 2145: # Similarity check 2146: my $similar=''; 2147: my ($type,$trial,$rndseed); 2148: if ($hide eq 'rand') { 2149: $type = 'randomizetry'; 2150: $trial = $record{"resource.$partid.tries"}; 2151: $rndseed = $record{"resource.$partid.rndseed"}; 2152: } 2153: if($env{'form.checkPlag'}){ 2154: my ($oname,$odom,$ocrsid,$oessay,$osim)= 2155: &most_similar($uname,$udom,$subval,\%old_essays); 2156: if ($osim) { 2157: $osim=int($osim*100.0); 2158: my %old_course_desc = 2159: &Apache::lonnet::coursedescription($ocrsid, 2160: {'one_time' => 1}); 2161: 2162: if ($hide eq 'anon') { 2163: $similar='<hr /><span class="LC_warning">'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'<br />'. 2164: &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />'; 2165: } else { 2166: $similar="<hr /><h3><span class=\"LC_warning\">". 2167: &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])', 2168: $osim, 2169: &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')', 2170: $old_course_desc{'description'}, 2171: $old_course_desc{'num'}, 2172: $old_course_desc{'domain'}). 2173: '</span></h3><blockquote><i>'. 2174: &keywords_highlight($oessay). 2175: '</i></blockquote><hr />'; 2176: } 2177: } 2178: } 2179: my $order=&get_order($partid,$respid,$symb,$uname,$udom, 2180: undef,$type,$trial,$rndseed); 2181: if ($env{'form.lastSub'} eq 'lastonly' || 2182: ($env{'form.lastSub'} eq 'hdgrade' && 2183: $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) { 2184: my $display_part=&get_display_part($partid,$symb); 2185: $lastsubonly.='<div class="LC_grade_submission_part">'. 2186: '<b>'.&mt('Part: [_1]',$display_part).'</b>'. 2187: ' <span class="LC_internal_info">'. 2188: '('.&mt('Response ID: [_1]',$respid).')'. 2189: '</span>   '; 2190: my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record); 2191: if (@$files) { 2192: if ($hide eq 'anon') { 2193: $lastsubonly.='<br />'.&mt('[quant,_1,file] uploaded to this anonymous survey',scalar(@{$files})); 2194: } else { 2195: $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain viruses').'</span><br />'; 2196: foreach my $file (@$files) { 2197: &Apache::lonnet::allowuploaded('/adm/grades',$file); 2198: $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" /> '.$file.'</a>'; 2199: } 2200: } 2201: $lastsubonly.='<br />'; 2202: } 2203: if ($hide eq 'anon') { 2204: $lastsubonly.='<b>'.&mt('Anonymous Survey').'</b>'; 2205: } else { 2206: $lastsubonly.='<b>'.&mt('Submitted Answer:').' </b>'. 2207: &cleanRecord($subval,$responsetype,$symb,$partid, 2208: $respid,\%record,$order,undef,$uname,$udom,$type,$trial,$rndseed); 2209: } 2210: if ($similar) {$lastsubonly.="<br /><br />$similar\n";} 2211: $lastsubonly.='</div>'; 2212: } 2213: } 2214: } 2215: $lastsubonly.='</div>'."\n"; # End: LC_grade_submissions_body 2216: } 2217: $request->print($lastsubonly); 2218: } elsif ($env{'form.lastSub'} eq 'datesub') { 2219: my ($parts,$handgrade,$responseType) = &response_type($symb,\$res_error); 2220: $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); 2221: } elsif ($env{'form.lastSub'} =~ /^(last|all)$/) { 2222: $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, 2223: $env{'request.course.id'}, 2224: $last,'.submission', 2225: 'Apache::grades::keywords_highlight')); 2226: } 2227: $request->print('<input type="hidden" name="unamedom'.$counter.'" value="'.$uname.':' 2228: .$udom.'" />'."\n"); 2229: # return if view submission with no grading option 2230: if (!&canmodify($usec)) { 2231: $request->print('<p><span class="LC_warning">'.&mt('No grading privileges').'</span></p></div>'); 2232: return; 2233: } else { 2234: $request->print('</div>'."\n"); 2235: } 2236: 2237: # essay grading message center 2238: # if ($env{'form.handgrade'} eq 'yes') { 2239: if (1) { 2240: my $result='<div class="LC_grade_message_center">'; 2241: 2242: $result.='<div class="LC_grade_message_center_header">'. 2243: &mt('Send Message').'</div><div class="LC_grade_message_center_body">'; 2244: my ($lastname,$givenn) = split(/,/,$env{'form.fullname'}); 2245: my $msgfor = $givenn.' '.$lastname; 2246: if (scalar(@$col_fullnames) > 0) { 2247: my $lastone = pop(@$col_fullnames); 2248: $msgfor .= ', '.(join ', ',@$col_fullnames).' and '.$lastone.'.'; 2249: } 2250: $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript 2251: $result.='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n". 2252: '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n"; 2253: $result.=' <a href="javascript:msgCenter(document.SCORE,'.$counter. 2254: ',\''.$msgfor.'\');" target="_self">'. 2255: &mt('Compose message to student').(scalar(@$col_fullnames) >= 1 ? 's' : '').'</a><label> ('. 2256: &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'. 2257: '<img src="'.$request->dir_config('lonIconsURL'). 2258: '/mailbkgrd.gif" width="14" height="10" name="mailicon'.$counter.'" />'."\n". 2259: '<br /> ('. 2260: &mt('Message will be sent when you click on Save & Next below.').")\n"; 2261: $result.='</div></div>'; 2262: $request->print($result); 2263: } 2264: 2265: my %seen = (); 2266: my @partlist; 2267: my @gradePartRespid; 2268: my @part_response_id = &flatten_responseType($responseType); 2269: $request->print( 2270: '<div class="LC_Box">' 2271: .'<h3 class="LC_hcell">'.&mt('Assign Grades').'</h3>' 2272: ); 2273: $request->print(&gradeBox_start()); 2274: foreach my $part_response_id (@part_response_id) { 2275: my ($partid,$respid) = @{ $part_response_id }; 2276: my $part_resp = join('_',@{ $part_response_id }); 2277: next if ($seen{$partid} > 0); 2278: $seen{$partid}++; 2279: next if ($$handgrade{$part_resp} ne 'yes' 2280: && $env{'form.lastSub'} eq 'hdgrade'); 2281: push(@partlist,$partid); 2282: push(@gradePartRespid,$partid.'.'.$respid); 2283: $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); 2284: } 2285: $request->print(&gradeBox_end()); # </div> 2286: $request->print('</div>'); 2287: 2288: $request->print('<div class="LC_grade_info_links">'); 2289: $request->print('</div>'); 2290: 2291: $result='<input type="hidden" name="partlist'.$counter. 2292: '" value="'.(join ":",@partlist).'" />'."\n"; 2293: $result.='<input type="hidden" name="gradePartRespid'. 2294: '" value="'.(join ":",@gradePartRespid).'" />'."\n" if ($counter == 0); 2295: my $ctr = 0; 2296: while ($ctr < scalar(@partlist)) { 2297: $result.='<input type="hidden" name="partid'.$counter.'_'.$ctr.'" value="'. 2298: $partlist[$ctr].'" />'."\n"; 2299: $ctr++; 2300: } 2301: $request->print($result.''."\n"); 2302: 2303: # Done with printing info for one student 2304: 2305: $request->print('</div>');#LC_grade_show_user 2306: 2307: 2308: # print end of form 2309: if ($counter == $total) { 2310: my $endform='<br /><hr /><table border="0"><tr><td>'."\n"; 2311: $endform.='<input type="button" value="'.&mt('Save & Next').'" '. 2312: 'onclick="javascript:checksubmit(this.form,\'Save & Next\','. 2313: $total.','.scalar(@partlist).');" target="_self" />  '."\n"; 2314: my $ntstu ='<select name="NTSTU">'. 2315: '<option>1</option><option>2</option>'. 2316: '<option>3</option><option>5</option>'. 2317: '<option>7</option><option>10</option></select>'."\n"; 2318: my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1'); 2319: $ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</; 2320: $endform.=&mt('[_1]student(s)',$ntstu); 2321: $endform.='  <input type="button" value="'.&mt('Previous').'" '. 2322: 'onclick="javascript:checksubmit(this.form,\'Previous\');" target="_self" />  '."\n". 2323: '<input type="button" value="'.&mt('Next').'" '. 2324: 'onclick="javascript:checksubmit(this.form,\'Next\');" target="_self" />  '; 2325: $endform.='<span class="LC_warning">'. 2326: &mt('(Next and Previous (student) do not save the scores.)'). 2327: '</span>'."\n" ; 2328: $endform.="<input type='hidden' value='".&get_increment(). 2329: "' name='increment' />"; 2330: $endform.='</td></tr></table></form>'; 2331: $request->print($endform); 2332: } 2333: return ''; 2334: } 2335: 2336: sub check_collaborators { 2337: my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_; 2338: my ($result,@col_fullnames); 2339: my ($classlist,undef,$fullname) = &getclasslist('all','0'); 2340: foreach my $part (keys(%$handgrade)) { 2341: my $ncol = &Apache::lonnet::EXT('resource.'.$part. 2342: '.maxcollaborators', 2343: $symb,$udom,$uname); 2344: next if ($ncol <= 0); 2345: $part =~ s/\_/\./g; 2346: next if ($record->{'resource.'.$part.'.collaborators'} eq ''); 2347: my (@good_collaborators, @bad_collaborators); 2348: foreach my $possible_collaborator 2349: (split(/[,;\s]+/,$record->{'resource.'.$part.'.collaborators'})) { 2350: $possible_collaborator =~ s/[\$\^]//g; 2351: next if ($possible_collaborator eq ''); 2352: my ($co_name,$co_dom) = split(/:/,$possible_collaborator); 2353: $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i); 2354: next if ($co_name eq $uname && $co_dom eq $udom); 2355: # Doing this grep allows 'fuzzy' specification 2356: my @matches = grep(/^\Q$co_name\E:\Q$co_dom\E$/i, 2357: keys(%$classlist)); 2358: if (! scalar(@matches)) { 2359: push(@bad_collaborators, $possible_collaborator); 2360: } else { 2361: push(@good_collaborators, @matches); 2362: } 2363: } 2364: if (scalar(@good_collaborators) != 0) { 2365: $result.='<br />'.&mt('Collaborators:').'<ol>'; 2366: foreach my $name (@good_collaborators) { 2367: my ($lastname,$givenn) = split(/,/,$$fullname{$name}); 2368: push(@col_fullnames, $givenn.' '.$lastname); 2369: $result.='<li>'.$fullname->{$name}.'</li>'; 2370: } 2371: $result.='</ol><br />'."\n"; 2372: my ($part)=split(/\./,$part); 2373: $result.='<input type="hidden" name="collaborator'.$counter. 2374: '" value="'.$part.':'.(join ':',@good_collaborators).'" />'. 2375: "\n"; 2376: } 2377: if (scalar(@bad_collaborators) > 0) { 2378: $result.='<div class="LC_warning">'; 2379: $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators)); 2380: $result .= '</div>'; 2381: } 2382: if (scalar(@bad_collaborators > $ncol)) { 2383: $result .= '<div class="LC_warning">'; 2384: $result .= &mt('This student has submitted too many '. 2385: 'collaborators. Maximum is [_1].',$ncol); 2386: $result .= '</div>'; 2387: } 2388: } 2389: return ($result,$fullname,\@col_fullnames); 2390: } 2391: 2392: #--- Retrieve the last submission for all the parts 2393: sub get_last_submission { 2394: my ($returnhash)=@_; 2395: my (@string,$timestamp,%lasthidden); 2396: if ($$returnhash{'version'}) { 2397: my %lasthash=(); 2398: my ($version); 2399: for ($version=1;$version<=$$returnhash{'version'};$version++) { 2400: foreach my $key (sort(split(/\:/, 2401: $$returnhash{$version.':keys'}))) { 2402: $lasthash{$key}=$$returnhash{$version.':'.$key}; 2403: $timestamp = 2404: &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'}); 2405: } 2406: } 2407: my (%typeparts,%randombytry); 2408: my $showsurv = 2409: &Apache::lonnet::allowed('vas',$env{'request.course.id'}); 2410: foreach my $key (sort(keys(%lasthash))) { 2411: if ($key =~ /\.type$/) { 2412: if (($lasthash{$key} eq 'anonsurvey') || 2413: ($lasthash{$key} eq 'anonsurveycred') || 2414: ($lasthash{$key} eq 'randomizetry')) { 2415: my ($ign,@parts) = split(/\./,$key); 2416: pop(@parts); 2417: my $id = join('.',@parts); 2418: if ($lasthash{$key} eq 'randomizetry') { 2419: $randombytry{$ign.'.'.$id} = $lasthash{$key}; 2420: } else { 2421: unless ($showsurv) { 2422: $typeparts{$ign.'.'.$id} = $lasthash{$key}; 2423: } 2424: } 2425: delete($lasthash{$key}); 2426: } 2427: } 2428: } 2429: my @hidden = keys(%typeparts); 2430: my @randomize = keys(%randombytry); 2431: foreach my $key (keys(%lasthash)) { 2432: next if ($key !~ /\.submission$/); 2433: my $hide; 2434: if (@hidden) { 2435: foreach my $id (@hidden) { 2436: if ($key =~ /^\Q$id\E/) { 2437: $hide = 'anon'; 2438: last; 2439: } 2440: } 2441: } 2442: unless ($hide) { 2443: if (@randomize) { 2444: foreach my $id (@hidden) { 2445: if ($key =~ /^\Q$id\E/) { 2446: $hide = 'rand'; 2447: last; 2448: } 2449: } 2450: } 2451: } 2452: my ($partid,$foo) = split(/submission$/,$key); 2453: my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? 2454: '<span class="LC_warning">Draft Copy</span> ' : ''; 2455: push(@string, join(':', $key, $hide, $draft.$lasthash{$key})); 2456: } 2457: } 2458: if (!@string) { 2459: $string[0] = 2460: '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span>'; 2461: } 2462: return (\@string,\$timestamp); 2463: } 2464: 2465: #--- High light keywords, with style choosen by user. 2466: sub keywords_highlight { 2467: my $string = shift; 2468: my $size = $env{'form.kwsize'} eq '0' ? '' : 'size='.$env{'form.kwsize'}; 2469: my $styleon = $env{'form.kwstyle'} eq '' ? '' : $env{'form.kwstyle'}; 2470: (my $styleoff = $styleon) =~ s/\</\<\//; 2471: my @keylist = split(/[,\s+]/,$env{'form.keywords'}); 2472: foreach my $keyword (@keylist) { 2473: $string =~ s/\b\Q$keyword\E(\b|\.)/<font color\=$env{'form.kwclr'} $size\>$styleon$keyword$styleoff<\/font>/gi; 2474: } 2475: return $string; 2476: } 2477: 2478: #--- Called from submission routine 2479: sub processHandGrade { 2480: my ($request,$symb) = @_; 2481: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 2482: my $button = $env{'form.gradeOpt'}; 2483: my $ngrade = $env{'form.NCT'}; 2484: my $ntstu = $env{'form.NTSTU'}; 2485: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2486: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2487: 2488: if ($button eq 'Save & Next') { 2489: my $ctr = 0; 2490: while ($ctr < $ngrade) { 2491: my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr}); 2492: my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$symb,$uname,$udom,$ctr); 2493: if ($errorflag eq 'no_score') { 2494: $ctr++; 2495: next; 2496: } 2497: if ($errorflag eq 'not_allowed') { 2498: $request->print("<span class=\"LC_warning\">Not allowed to modify grades for $uname:$udom</span>"); 2499: $ctr++; 2500: next; 2501: } 2502: my $includemsg = $env{'form.includemsg'.$ctr}; 2503: my ($subject,$message,$msgstatus) = ('','',''); 2504: my $restitle = &Apache::lonnet::gettitle($symb); 2505: my ($feedurl,$showsymb) = 2506: &get_feedurl_and_symb($symb,$uname,$udom); 2507: my $messagetail; 2508: if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { 2509: $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); 2510: unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } 2511: $subject.=' ['.$restitle.']'; 2512: my (@msgnum) = split(/,/,$includemsg); 2513: foreach (@msgnum) { 2514: $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); 2515: } 2516: $message =&Apache::lonfeedback::clear_out_html($message); 2517: if ($env{'form.withgrades'.$ctr}) { 2518: $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; 2519: $messagetail = " for <a href=\"". 2520: $feedurl."?symb=$showsymb\">$restitle</a>"; 2521: } 2522: $msgstatus = 2523: &Apache::lonmsg::user_normal_msg($uname,$udom,$subject, 2524: $message.$messagetail, 2525: undef,$feedurl,undef, 2526: undef,undef,$showsymb, 2527: $restitle); 2528: $request->print('<br />'.&mt('Sending message to [_1]',$uname.':'.$udom).': '. 2529: $msgstatus); 2530: } 2531: if ($env{'form.collaborator'.$ctr}) { 2532: my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); 2533: foreach my $collabstr (@collabstrs) { 2534: my ($part,@collaborators) = split(/:/,$collabstr); 2535: foreach my $collaborator (@collaborators) { 2536: my ($errorflag,$pts,$wgt) = 2537: &saveHandGrade($request,$symb,$collaborator,$udom,$ctr, 2538: $env{'form.unamedom'.$ctr},$part); 2539: if ($errorflag eq 'not_allowed') { 2540: $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>"); 2541: next; 2542: } elsif ($message ne '') { 2543: my ($baseurl,$showsymb) = 2544: &get_feedurl_and_symb($symb,$collaborator, 2545: $udom); 2546: if ($env{'form.withgrades'.$ctr}) { 2547: $messagetail = " for <a href=\"". 2548: $baseurl."?symb=$showsymb\">$restitle</a>"; 2549: } 2550: $msgstatus = 2551: &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); 2552: } 2553: } 2554: } 2555: } 2556: $ctr++; 2557: } 2558: } 2559: 2560: # if ($env{'form.handgrade'} eq 'yes') { 2561: if (1) { 2562: # Keywords sorted in alphabatical order 2563: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 2564: my %keyhash = (); 2565: $env{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; 2566: $env{'form.keywords'} =~ s/^\s+|\s+$//; 2567: my (@keywords) = sort(split(/\s+/,$env{'form.keywords'})); 2568: $env{'form.keywords'} = join(' ',@keywords); 2569: $keyhash{$symb.'_keywords'} = $env{'form.keywords'}; 2570: $keyhash{$symb.'_subject'} = $env{'form.msgsub'}; 2571: $keyhash{$loginuser.'_kwclr'} = $env{'form.kwclr'}; 2572: $keyhash{$loginuser.'_kwsize'} = $env{'form.kwsize'}; 2573: $keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'}; 2574: 2575: # message center - Order of message gets changed. Blank line is eliminated. 2576: # New messages are saved in env for the next student. 2577: # All messages are saved in nohist_handgrade.db 2578: my ($ctr,$idx) = (1,1); 2579: while ($ctr <= $env{'form.savemsgN'}) { 2580: if ($env{'form.savemsg'.$ctr} ne '') { 2581: $keyhash{$symb.'_savemsg'.$idx} = $env{'form.savemsg'.$ctr}; 2582: $idx++; 2583: } 2584: $ctr++; 2585: } 2586: $ctr = 0; 2587: while ($ctr < $ngrade) { 2588: if ($env{'form.newmsg'.$ctr} ne '') { 2589: $keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr}; 2590: $env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr}; 2591: $idx++; 2592: } 2593: $ctr++; 2594: } 2595: $env{'form.savemsgN'} = --$idx; 2596: $keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'}; 2597: my $putresult = &Apache::lonnet::put 2598: ('nohist_handgrade',\%keyhash,$cdom,$cnum); 2599: } 2600: # Called by Save & Refresh from Highlight Attribute Window 2601: my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); 2602: if ($env{'form.refresh'} eq 'on') { 2603: my ($ctr,$total) = (0,0); 2604: while ($ctr < $ngrade) { 2605: $total++ if $env{'form.unamedom'.$ctr} ne ''; 2606: $ctr++; 2607: } 2608: $env{'form.NTSTU'}=$ngrade; 2609: $ctr = 0; 2610: while ($ctr < $total) { 2611: my $processUser = $env{'form.unamedom'.$ctr}; 2612: ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); 2613: $env{'form.fullname'} = $$fullname{$processUser}; 2614: &submission($request,$ctr,$total-1,$symb); 2615: $ctr++; 2616: } 2617: return ''; 2618: } 2619: 2620: # Get the next/previous one or group of students 2621: my $firststu = $env{'form.unamedom0'}; 2622: my $laststu = $env{'form.unamedom'.($ngrade-1)}; 2623: my $ctr = 2; 2624: while ($laststu eq '') { 2625: $laststu = $env{'form.unamedom'.($ngrade-$ctr)}; 2626: $ctr++; 2627: $laststu = $firststu if ($ctr > $ngrade); 2628: } 2629: 2630: my (@parsedlist,@nextlist); 2631: my ($nextflg) = 0; 2632: foreach my $item (sort 2633: { 2634: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 2635: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 2636: } 2637: return $a cmp $b; 2638: } (keys(%$fullname))) { 2639: # FIXME: this is fishy, looks like the button label 2640: if ($nextflg == 1 && $button =~ /Next$/) { 2641: push(@parsedlist,$item); 2642: } 2643: $nextflg = 1 if ($item eq $laststu); 2644: if ($button eq 'Previous') { 2645: last if ($item eq $firststu); 2646: push(@parsedlist,$item); 2647: } 2648: } 2649: $ctr = 0; 2650: # FIXME: this is fishy, looks like the button label 2651: @parsedlist = reverse @parsedlist if ($button eq 'Previous'); 2652: my $res_error; 2653: my ($partlist) = &response_type($symb,\$res_error); 2654: if ($res_error) { 2655: $request->print(&navmap_errormsg()); 2656: return; 2657: } 2658: foreach my $student (@parsedlist) { 2659: my $submitonly=$env{'form.submitonly'}; 2660: my ($uname,$udom) = split(/:/,$student); 2661: 2662: if ($submitonly eq 'queued') { 2663: my %queue_status = 2664: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 2665: $udom,$uname); 2666: next if (!defined($queue_status{'gradingqueue'})); 2667: } 2668: 2669: if ($submitonly =~ /^(yes|graded|incorrect)$/) { 2670: # my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 2671: my %status=&student_gradeStatus($symb,$udom,$uname,$partlist); 2672: my $submitted = 0; 2673: my $ungraded = 0; 2674: my $incorrect = 0; 2675: foreach my $item (keys(%status)) { 2676: $submitted = 1 if ($status{$item} ne 'nothing'); 2677: $ungraded = 1 if ($status{$item} =~ /^ungraded/); 2678: $incorrect = 1 if ($status{$item} =~ /^incorrect/); 2679: my ($foo,$partid,$foo1) = split(/\./,$item); 2680: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 2681: $submitted = 0; 2682: } 2683: } 2684: next if (!$submitted && ($submitonly eq 'yes' || 2685: $submitonly eq 'incorrect' || 2686: $submitonly eq 'graded')); 2687: next if (!$ungraded && ($submitonly eq 'graded')); 2688: next if (!$incorrect && $submitonly eq 'incorrect'); 2689: } 2690: push(@nextlist,$student) if ($ctr < $ntstu); 2691: last if ($ctr == $ntstu); 2692: $ctr++; 2693: } 2694: 2695: $ctr = 0; 2696: my $total = scalar(@nextlist)-1; 2697: 2698: foreach (sort(@nextlist)) { 2699: my ($uname,$udom,$submitter) = split(/:/); 2700: $env{'form.student'} = $uname; 2701: $env{'form.userdom'} = $udom; 2702: $env{'form.fullname'} = $$fullname{$_}; 2703: &submission($request,$ctr,$total,$symb); 2704: $ctr++; 2705: } 2706: if ($total < 0) { 2707: my $the_end.=&mt('<b>Message: </b> No more students for this section or class.').'<br /><br />'."\n"; 2708: $request->print($the_end); 2709: } 2710: return ''; 2711: } 2712: 2713: #---- Save the score and award for each student, if changed 2714: sub saveHandGrade { 2715: my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; 2716: my @version_parts; 2717: my $usec = &Apache::lonnet::getsection($domain,$stuname, 2718: $env{'request.course.id'}); 2719: if (!&canmodify($usec)) { return('not_allowed'); } 2720: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); 2721: my @parts_graded; 2722: my %newrecord = (); 2723: my ($pts,$wgt) = ('',''); 2724: my %aggregate = (); 2725: my $aggregateflag = 0; 2726: my @parts = split(/:/,$env{'form.partlist'.$newflg}); 2727: foreach my $new_part (@parts) { 2728: #collaborator ($submi may vary for different parts 2729: if ($submitter && $new_part ne $part) { next; } 2730: my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; 2731: if ($dropMenu eq 'excused') { 2732: if ($record{'resource.'.$new_part.'.solved'} ne 'excused') { 2733: $newrecord{'resource.'.$new_part.'.solved'} = 'excused'; 2734: if (exists($record{'resource.'.$new_part.'.awarded'})) { 2735: $newrecord{'resource.'.$new_part.'.awarded'} = ''; 2736: } 2737: $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; 2738: } 2739: } elsif ($dropMenu eq 'reset status' 2740: && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts 2741: foreach my $key (keys(%record)) { 2742: if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } 2743: } 2744: $newrecord{'resource.'.$new_part.'.regrader'}= 2745: "$env{'user.name'}:$env{'user.domain'}"; 2746: my $totaltries = $record{'resource.'.$part.'.tries'}; 2747: 2748: my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, 2749: [$new_part]); 2750: my $aggtries =$totaltries; 2751: if ($last_resets{$new_part}) { 2752: $aggtries = &get_num_tries(\%record,$last_resets{$new_part}, 2753: $new_part); 2754: } 2755: 2756: my $solvedstatus = $record{'resource.'.$new_part.'.solved'}; 2757: if ($aggtries > 0) { 2758: &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); 2759: $aggregateflag = 1; 2760: } 2761: } elsif ($dropMenu eq '') { 2762: $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 2763: $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 2764: $env{'form.RADVAL'.$newflg.'_'.$new_part}); 2765: if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$new_part} eq '') { 2766: next; 2767: } 2768: $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : 2769: $env{'form.WGT'.$newflg.'_'.$new_part}; 2770: my $partial= $pts/$wgt; 2771: if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { 2772: #do not update score for part if not changed. 2773: &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); 2774: next; 2775: } else { 2776: push(@parts_graded,$new_part); 2777: } 2778: if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { 2779: $newrecord{'resource.'.$new_part.'.awarded'} = $partial; 2780: } 2781: my $reckey = 'resource.'.$new_part.'.solved'; 2782: if ($partial == 0) { 2783: if ($record{$reckey} ne 'incorrect_by_override') { 2784: $newrecord{$reckey} = 'incorrect_by_override'; 2785: } 2786: } else { 2787: if ($record{$reckey} ne 'correct_by_override') { 2788: $newrecord{$reckey} = 'correct_by_override'; 2789: } 2790: } 2791: if ($submitter && 2792: ($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) { 2793: $newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter; 2794: } 2795: $newrecord{'resource.'.$new_part.'.regrader'}= 2796: "$env{'user.name'}:$env{'user.domain'}"; 2797: } 2798: # unless problem has been graded, set flag to version the submitted files 2799: unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || 2800: $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' || 2801: $dropMenu eq 'reset status') 2802: { 2803: push(@version_parts,$new_part); 2804: } 2805: } 2806: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2807: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2808: 2809: if (%newrecord) { 2810: if (@version_parts) { 2811: my @changed_keys = &version_portfiles(\%record, \@parts_graded, 2812: $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts); 2813: @newrecord{@changed_keys} = @record{@changed_keys}; 2814: foreach my $new_part (@version_parts) { 2815: &handback_files($request,$symb,$stuname,$domain,$newflg, 2816: $new_part,\%newrecord); 2817: } 2818: } 2819: &Apache::lonnet::cstore(\%newrecord,$symb, 2820: $env{'request.course.id'},$domain,$stuname); 2821: &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb, 2822: $cdom,$cnum,$domain,$stuname); 2823: } 2824: if ($aggregateflag) { 2825: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 2826: $cdom,$cnum); 2827: } 2828: return ('',$pts,$wgt); 2829: } 2830: 2831: sub check_and_remove_from_queue { 2832: my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_; 2833: my @ungraded_parts; 2834: foreach my $part (@{$parts}) { 2835: if ( $record->{ 'resource.'.$part.'.awarded'} eq '' 2836: && $record->{ 'resource.'.$part.'.solved' } ne 'excused' 2837: && $newrecord->{'resource.'.$part.'.awarded'} eq '' 2838: && $newrecord->{'resource.'.$part.'.solved' } ne 'excused' 2839: ) { 2840: push(@ungraded_parts, $part); 2841: } 2842: } 2843: if ( !@ungraded_parts ) { 2844: &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom, 2845: $cnum,$domain,$stuname); 2846: } 2847: } 2848: 2849: sub handback_files { 2850: my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; 2851: my $portfolio_root = '/userfiles/portfolio'; 2852: my $res_error; 2853: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 2854: if ($res_error) { 2855: $request->print('<br />'.&navmap_errormsg().'<br />'); 2856: return; 2857: } 2858: my @part_response_id = &flatten_responseType($responseType); 2859: foreach my $part_response_id (@part_response_id) { 2860: my ($part_id,$resp_id) = @{ $part_response_id }; 2861: my $part_resp = join('_',@{ $part_response_id }); 2862: if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) { 2863: # if multiple files are uploaded names will be 'returndoc2','returndoc3' 2864: my $file_counter = 1; 2865: my $file_msg; 2866: while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) { 2867: my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'}; 2868: my ($directory,$answer_file) = 2869: ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/); 2870: my ($answer_name,$answer_ver,$answer_ext) = 2871: &file_name_version_ext($answer_file); 2872: my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); 2873: my $getpropath = 1; 2874: my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath); 2875: my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); 2876: # fix file name 2877: my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); 2878: my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, 2879: $newflg.'_'.$part_resp.'_returndoc'.$file_counter, 2880: $save_file_name); 2881: if ($result !~ m|^/uploaded/|) { 2882: $request->print('<br /><span class="LC_error">'. 2883: &mt('An error occurred ([_1]) while trying to upload [_2].', 2884: $result,$newflg.'_'.$part_resp.'_returndoc'.$file_counter). 2885: '</span>'); 2886: } else { 2887: # mark the file as read only 2888: my @files = ($save_file_name); 2889: my @what = ($symb,$env{'request.course.id'},'handback'); 2890: &Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what); 2891: if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) { 2892: $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; 2893: } 2894: $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; 2895: $file_msg.= "\n".'<br /><span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span><br />"; 2896: 2897: } 2898: $request->print("<br />".$fname." will be the uploaded file name"); 2899: $request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter}); 2900: $file_counter++; 2901: } 2902: my $subject = "File Handed Back by Instructor "; 2903: my $message = "A file has been returned that was originally submitted in reponse to: <br />"; 2904: $message .= "<strong>".&Apache::lonnet::gettitle($symb)."</strong><br />"; 2905: $message .= ' The returned file(s) are named: '. $file_msg; 2906: $message .= " and can be found in your portfolio space."; 2907: my ($feedurl,$showsymb) = 2908: &get_feedurl_and_symb($symb,$domain,$stuname); 2909: my $restitle = &Apache::lonnet::gettitle($symb); 2910: my $msgstatus = 2911: &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject. 2912: ' (File Returned) ['.$restitle.']',$message,undef, 2913: $feedurl,undef,undef,undef,$showsymb,$restitle); 2914: } 2915: } 2916: return; 2917: } 2918: 2919: sub get_feedurl_and_symb { 2920: my ($symb,$uname,$udom) = @_; 2921: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 2922: $url = &Apache::lonnet::clutter($url); 2923: my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', 2924: $symb,$udom,$uname); 2925: if ($encrypturl =~ /^yes$/i) { 2926: &Apache::lonenc::encrypted(\$url,1); 2927: &Apache::lonenc::encrypted(\$symb,1); 2928: } 2929: return ($url,$symb); 2930: } 2931: 2932: sub get_submitted_files { 2933: my ($udom,$uname,$partid,$respid,$record) = @_; 2934: my @files; 2935: if ($$record{"resource.$partid.$respid.portfiles"}) { 2936: my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; 2937: foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) { 2938: push(@files,$file_url.$file); 2939: } 2940: } 2941: if ($$record{"resource.$partid.$respid.uploadedurl"}) { 2942: push(@files,$$record{"resource.$partid.$respid.uploadedurl"}); 2943: } 2944: return (\@files); 2945: } 2946: 2947: # ----------- Provides number of tries since last reset. 2948: sub get_num_tries { 2949: my ($record,$last_reset,$part) = @_; 2950: my $timestamp = ''; 2951: my $num_tries = 0; 2952: if ($$record{'version'}) { 2953: for (my $version=$$record{'version'};$version>=1;$version--) { 2954: if (exists($$record{$version.':resource.'.$part.'.solved'})) { 2955: $timestamp = $$record{$version.':timestamp'}; 2956: if ($timestamp > $last_reset) { 2957: $num_tries ++; 2958: } else { 2959: last; 2960: } 2961: } 2962: } 2963: } 2964: return $num_tries; 2965: } 2966: 2967: # ----------- Determine decrements required in aggregate totals 2968: sub decrement_aggs { 2969: my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_; 2970: my %decrement = ( 2971: attempts => 0, 2972: users => 0, 2973: correct => 0 2974: ); 2975: $decrement{'attempts'} = $aggtries; 2976: if ($solvedstatus =~ /^correct/) { 2977: $decrement{'correct'} = 1; 2978: } 2979: if ($aggtries == $totaltries) { 2980: $decrement{'users'} = 1; 2981: } 2982: foreach my $type (keys(%decrement)) { 2983: $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type}; 2984: } 2985: return; 2986: } 2987: 2988: # ----------- Determine timestamps for last reset of aggregate totals for parts 2989: sub get_last_resets { 2990: my ($symb,$courseid,$partids) =@_; 2991: my %last_resets; 2992: my $cdom = $env{'course.'.$courseid.'.domain'}; 2993: my $cname = $env{'course.'.$courseid.'.num'}; 2994: my @keys; 2995: foreach my $part (@{$partids}) { 2996: push(@keys,"$symb\0$part\0resettime"); 2997: } 2998: my %results=&Apache::lonnet::get('nohist_resourcetracker',\@keys, 2999: $cdom,$cname); 3000: foreach my $part (@{$partids}) { 3001: $last_resets{$part}=$results{"$symb\0$part\0resettime"}; 3002: } 3003: return %last_resets; 3004: } 3005: 3006: # ----------- Handles creating versions for portfolio files as answers 3007: sub version_portfiles { 3008: my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_; 3009: my $version_parts = join('|',@$v_flag); 3010: my @returned_keys; 3011: my $parts = join('|', @$parts_graded); 3012: my $portfolio_root = '/userfiles/portfolio'; 3013: foreach my $key (keys(%$record)) { 3014: my $new_portfiles; 3015: if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { 3016: my @versioned_portfiles; 3017: my @portfiles = split(/\s*,\s*/,$$record{$key}); 3018: foreach my $file (@portfiles) { 3019: &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file); 3020: my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); 3021: my ($answer_name,$answer_ver,$answer_ext) = 3022: &file_name_version_ext($answer_file); 3023: my $getpropath = 1; 3024: my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath); 3025: my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); 3026: my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); 3027: if ($new_answer ne 'problem getting file') { 3028: push(@versioned_portfiles, $directory.$new_answer); 3029: &Apache::lonnet::mark_as_readonly($domain,$stu_name, 3030: [$directory.$new_answer], 3031: [$symb,$env{'request.course.id'},'graded']); 3032: } 3033: } 3034: $$record{$key} = join(',',@versioned_portfiles); 3035: push(@returned_keys,$key); 3036: } 3037: } 3038: return (@returned_keys); 3039: } 3040: 3041: sub get_next_version { 3042: my ($answer_name, $answer_ext, $dir_list) = @_; 3043: my $version; 3044: foreach my $row (@$dir_list) { 3045: my ($file) = split(/\&/,$row,2); 3046: my ($file_name,$file_version,$file_ext) = 3047: &file_name_version_ext($file); 3048: if (($file_name eq $answer_name) && 3049: ($file_ext eq $answer_ext)) { 3050: # gets here if filename and extension match, regardless of version 3051: if ($file_version ne '') { 3052: # a versioned file is found so save it for later 3053: if ($file_version > $version) { 3054: $version = $file_version; 3055: } 3056: } 3057: } 3058: } 3059: $version ++; 3060: return($version); 3061: } 3062: 3063: sub version_selected_portfile { 3064: my ($domain,$stu_name,$directory,$file_name,$version) = @_; 3065: my ($answer_name,$answer_ver,$answer_ext) = 3066: &file_name_version_ext($file_name); 3067: my $new_answer; 3068: $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name"); 3069: if($env{'form.copy'} eq '-1') { 3070: $new_answer = 'problem getting file'; 3071: } else { 3072: $new_answer = $answer_name.'.'.$version.'.'.$answer_ext; 3073: my $copy_result = &Apache::lonnet::finishuserfileupload( 3074: $stu_name,$domain,'copy', 3075: '/portfolio'.$directory.$new_answer); 3076: } 3077: return ($new_answer); 3078: } 3079: 3080: sub file_name_version_ext { 3081: my ($file)=@_; 3082: my @file_parts = split(/\./, $file); 3083: my ($name,$version,$ext); 3084: if (@file_parts > 1) { 3085: $ext=pop(@file_parts); 3086: if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) { 3087: $version=pop(@file_parts); 3088: } 3089: $name=join('.',@file_parts); 3090: } else { 3091: $name=join('.',@file_parts); 3092: } 3093: return($name,$version,$ext); 3094: } 3095: 3096: #-------------------------------------------------------------------------------------- 3097: # 3098: #-------------------------- Next few routines handles grading by section or whole class 3099: # 3100: #--- Javascript to handle grading by section or whole class 3101: sub viewgrades_js { 3102: my ($request) = shift; 3103: 3104: my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); 3105: $request->print(&Apache::lonhtmlcommon::scripttag(<<VIEWJAVASCRIPT)); 3106: function writePoint(partid,weight,point) { 3107: var radioButton = document.classgrade["RADVAL_"+partid]; 3108: var textbox = document.classgrade["TEXTVAL_"+partid]; 3109: if (point == "textval") { 3110: point = document.classgrade["TEXTVAL_"+partid].value; 3111: if (isNaN(point) || parseFloat(point) < 0) { 3112: alert("$alertmsg"+parseFloat(point)); 3113: var resetbox = false; 3114: for (var i=0; i<radioButton.length; i++) { 3115: if (radioButton[i].checked) { 3116: textbox.value = i; 3117: resetbox = true; 3118: } 3119: } 3120: if (!resetbox) { 3121: textbox.value = ""; 3122: } 3123: return; 3124: } 3125: if (parseFloat(point) > parseFloat(weight)) { 3126: var resp = confirm("You entered a value ("+parseFloat(point)+ 3127: ") greater than the weight for the part. Accept?"); 3128: if (resp == false) { 3129: textbox.value = ""; 3130: return; 3131: } 3132: } 3133: for (var i=0; i<radioButton.length; i++) { 3134: radioButton[i].checked=false; 3135: if (parseFloat(point) == i) { 3136: radioButton[i].checked=true; 3137: } 3138: } 3139: 3140: } else { 3141: textbox.value = parseFloat(point); 3142: } 3143: for (i=0;i<document.classgrade.total.value;i++) { 3144: var user = document.classgrade["ctr"+i].value; 3145: user = user.replace(new RegExp(':', 'g'),"_"); 3146: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3147: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3148: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3149: if (saveval != "correct") { 3150: scorename.value = point; 3151: if (selname[0].selected != true) { 3152: selname[0].selected = true; 3153: } 3154: } 3155: } 3156: document.classgrade["SELVAL_"+partid][0].selected = true; 3157: } 3158: 3159: function writeRadText(partid,weight) { 3160: var selval = document.classgrade["SELVAL_"+partid]; 3161: var radioButton = document.classgrade["RADVAL_"+partid]; 3162: var override = document.classgrade["FORCE_"+partid].checked; 3163: var textbox = document.classgrade["TEXTVAL_"+partid]; 3164: if (selval[1].selected || selval[2].selected) { 3165: for (var i=0; i<radioButton.length; i++) { 3166: radioButton[i].checked=false; 3167: 3168: } 3169: textbox.value = ""; 3170: 3171: for (i=0;i<document.classgrade.total.value;i++) { 3172: var user = document.classgrade["ctr"+i].value; 3173: user = user.replace(new RegExp(':', 'g'),"_"); 3174: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3175: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3176: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3177: if ((saveval != "correct") || override) { 3178: scorename.value = ""; 3179: if (selval[1].selected) { 3180: selname[1].selected = true; 3181: } else { 3182: selname[2].selected = true; 3183: if (Number(document.classgrade["GD_"+user+"_"+partid+"_tries"].value)) 3184: {document.classgrade["GD_"+user+"_"+partid+"_tries"].value = '0';} 3185: } 3186: } 3187: } 3188: } else { 3189: for (i=0;i<document.classgrade.total.value;i++) { 3190: var user = document.classgrade["ctr"+i].value; 3191: user = user.replace(new RegExp(':', 'g'),"_"); 3192: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3193: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3194: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3195: if ((saveval != "correct") || override) { 3196: scorename.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value; 3197: selname[0].selected = true; 3198: } 3199: } 3200: } 3201: } 3202: 3203: function changeSelect(partid,user) { 3204: var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"]; 3205: var textbox = document.classgrade["GD_"+user+'_'+partid+"_awarded"]; 3206: var point = textbox.value; 3207: var weight = document.classgrade["weight_"+partid].value; 3208: 3209: if (isNaN(point) || parseFloat(point) < 0) { 3210: alert("$alertmsg"+parseFloat(point)); 3211: textbox.value = ""; 3212: return; 3213: } 3214: if (parseFloat(point) > parseFloat(weight)) { 3215: var resp = confirm("You entered a value ("+parseFloat(point)+ 3216: ") greater than the weight of the part. Accept?"); 3217: if (resp == false) { 3218: textbox.value = ""; 3219: return; 3220: } 3221: } 3222: selval[0].selected = true; 3223: } 3224: 3225: function changeOneScore(partid,user) { 3226: var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"]; 3227: if (selval[1].selected || selval[2].selected) { 3228: document.classgrade["GD_"+user+'_'+partid+"_awarded"].value = ""; 3229: if (selval[2].selected) { 3230: document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0"; 3231: } 3232: } 3233: } 3234: 3235: function resetEntry(numpart) { 3236: for (ctpart=0;ctpart<numpart;ctpart++) { 3237: var partid = document.classgrade["partid_"+ctpart].value; 3238: var radioButton = document.classgrade["RADVAL_"+partid]; 3239: var textbox = document.classgrade["TEXTVAL_"+partid]; 3240: var selval = document.classgrade["SELVAL_"+partid]; 3241: for (var i=0; i<radioButton.length; i++) { 3242: radioButton[i].checked=false; 3243: 3244: } 3245: textbox.value = ""; 3246: selval[0].selected = true; 3247: 3248: for (i=0;i<document.classgrade.total.value;i++) { 3249: var user = document.classgrade["ctr"+i].value; 3250: user = user.replace(new RegExp(':', 'g'),"_"); 3251: var resetscore = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3252: resetscore.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value; 3253: var resettries = document.classgrade["GD_"+user+"_"+partid+"_tries"]; 3254: resettries.value = document.classgrade["GD_"+user+"_"+partid+"_tries_s"].value; 3255: var saveselval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3256: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3257: if (saveselval == "excused") { 3258: if (selname[1].selected == false) { selname[1].selected = true;} 3259: } else { 3260: if (selname[0].selected == false) {selname[0].selected = true}; 3261: } 3262: } 3263: } 3264: } 3265: 3266: VIEWJAVASCRIPT 3267: } 3268: 3269: #--- show scores for a section or whole class w/ option to change/update a score 3270: sub viewgrades { 3271: my ($request,$symb) = @_; 3272: &viewgrades_js($request); 3273: 3274: #need to make sure we have the correct data for later EXT calls, 3275: #thus invalidate the cache 3276: &Apache::lonnet::devalidatecourseresdata( 3277: $env{'course.'.$env{'request.course.id'}.'.num'}, 3278: $env{'course.'.$env{'request.course.id'}.'.domain'}); 3279: &Apache::lonnet::clear_EXT_cache_status(); 3280: 3281: my $result='<h3><span class="LC_info">'.&mt('Manual Grading').'</span></h3>'; 3282: 3283: #view individual student submission form - called using Javascript viewOneStudent 3284: $result.=&jscriptNform($symb); 3285: 3286: #beginning of class grading form 3287: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 3288: $result.= '<form action="/adm/grades" method="post" name="classgrade">'."\n". 3289: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 3290: '<input type="hidden" name="command" value="editgrades" />'."\n". 3291: &build_section_inputs(). 3292: '<input type="hidden" name="Status" value="'.$env{'stu_status'}.'" />'."\n". 3293: 3294: my ($common_header,$specific_header); 3295: if ($env{'form.section'} eq 'all') { 3296: $common_header = &mt('Assign Common Grade to Class'); 3297: $specific_header = &mt('Assign Grade to Specific Students in Class'); 3298: } elsif ($env{'form.section'} eq 'none') { 3299: $common_header = &mt('Assign Common Grade to Students in no Section'); 3300: $specific_header = &mt('Assign Grade to Specific Students in no Section'); 3301: } else { 3302: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3303: $common_header = &mt('Assign Common Grade to Students in Section(s) [_1]',$section_display); 3304: $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1]',$section_display); 3305: } 3306: $result.= '<h3>'.$common_header.'</h3>'.&Apache::loncommon::start_data_table(); 3307: #radio buttons/text box for assigning points for a section or class. 3308: #handles different parts of a problem 3309: my $res_error; 3310: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 3311: if ($res_error) { 3312: return &navmap_errormsg(); 3313: } 3314: my %weight = (); 3315: my $ctsparts = 0; 3316: my %seen = (); 3317: my @part_response_id = &flatten_responseType($responseType); 3318: foreach my $part_response_id (@part_response_id) { 3319: my ($partid,$respid) = @{ $part_response_id }; 3320: my $part_resp = join('_',@{ $part_response_id }); 3321: next if $seen{$partid}; 3322: $seen{$partid}++; 3323: my $handgrade=$$handgrade{$part_resp}; 3324: my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); 3325: $weight{$partid} = $wgt eq '' ? '1' : $wgt; 3326: 3327: my $display_part=&get_display_part($partid,$symb); 3328: my $radio.='<table border="0"><tr>'; 3329: my $ctr = 0; 3330: while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across 3331: $radio.= '<td><label><input type="radio" name="RADVAL_'.$partid.'" '. 3332: 'onclick="javascript:writePoint(\''.$partid.'\','.$weight{$partid}. 3333: ','.$ctr.')" />'.$ctr."</label></td>\n"; 3334: $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); 3335: $ctr++; 3336: } 3337: $radio.='</tr></table>'; 3338: my $line = '<input type="text" name="TEXTVAL_'. 3339: $partid.'" size="4" '.'onchange="javascript:writePoint(\''. 3340: $partid.'\','.$weight{$partid}.',\'textval\')" /> /'. 3341: $weight{$partid}.' '.&mt('(problem weight)').'</td>'."\n"; 3342: $line.= '<td><b>'.&mt('Grade Status').':</b><select name="SELVAL_'.$partid.'"'. 3343: 'onchange="javascript:writeRadText(\''.$partid.'\','. 3344: $weight{$partid}.')"> '. 3345: '<option selected="selected"> </option>'. 3346: '<option value="excused">'.&mt('excused').'</option>'. 3347: '<option value="reset status">'.&mt('reset status').'</option>'. 3348: '</select></td>'. 3349: '<td><label><input type="checkbox" name="FORCE_'.$partid.'" />'.&mt('Override "Correct"').'</label>'; 3350: $line.='<input type="hidden" name="partid_'. 3351: $ctsparts.'" value="'.$partid.'" />'."\n"; 3352: $line.='<input type="hidden" name="weight_'. 3353: $partid.'" value="'.$weight{$partid}.'" />'."\n"; 3354: 3355: $result.= 3356: &Apache::loncommon::start_data_table_row()."\n". 3357: '<td><b>'.&mt('Part:').'</b></td><td>'.$display_part.'</td><td><b>'.&mt('Points:').'</b></td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'. 3358: &Apache::loncommon::end_data_table_row()."\n"; 3359: $ctsparts++; 3360: } 3361: $result.=&Apache::loncommon::end_data_table()."\n". 3362: '<input type="hidden" name="totalparts" value="'.$ctsparts.'" />'; 3363: $result.='<input type="button" value="'.&mt('Revert to Default').'" '. 3364: 'onclick="javascript:resetEntry('.$ctsparts.');" />'; 3365: 3366: #table listing all the students in a section/class 3367: #header of table 3368: $result.= '<h3>'.$specific_header.'</h3>'. 3369: &Apache::loncommon::start_data_table(). 3370: &Apache::loncommon::start_data_table_header_row(). 3371: '<th>'.&mt('No.').'</th>'. 3372: '<th>'.&nameUserString('header')."</th>\n"; 3373: my $partserror; 3374: my (@parts) = sort(&getpartlist($symb,\$partserror)); 3375: if ($partserror) { 3376: return &navmap_errormsg(); 3377: } 3378: my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); 3379: my @partids = (); 3380: foreach my $part (@parts) { 3381: my $display=&Apache::lonnet::metadata($url,$part.'.display'); 3382: my $narrowtext = &mt('Tries'); 3383: $display =~ s|^Number of Attempts|$narrowtext <br />|; # makes the column narrower 3384: if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } 3385: my ($partid) = &split_part_type($part); 3386: push(@partids,$partid); 3387: # 3388: # FIXME: Looks like $display looks at English text 3389: # 3390: my $display_part=&get_display_part($partid,$symb); 3391: if ($display =~ /^Partial Credit Factor/) { 3392: $result.='<th>'. 3393: &mt('Score Part: [_1]<br /> (weight = [_2])', 3394: $display_part,$weight{$partid}).'</th>'."\n"; 3395: next; 3396: 3397: } else { 3398: if ($display =~ /Problem Status/) { 3399: my $grade_status_mt = &mt('Grade Status'); 3400: $display =~ s{Problem Status}{$grade_status_mt<br />}; 3401: } 3402: my $part_mt = &mt('Part:'); 3403: $display =~s{\[Part: \Q$partid\E\]}{$part_mt $display_part}; 3404: } 3405: 3406: $result.='<th>'.$display.'</th>'."\n"; 3407: } 3408: $result.=&Apache::loncommon::end_data_table_header_row(); 3409: 3410: my %last_resets = 3411: &get_last_resets($symb,$env{'request.course.id'},\@partids); 3412: 3413: #get info for each student 3414: #list all the students - with points and grade status 3415: my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); 3416: my $ctr = 0; 3417: foreach (sort 3418: { 3419: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 3420: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 3421: } 3422: return $a cmp $b; 3423: } (keys(%$fullname))) { 3424: $ctr++; 3425: $result.=&viewstudentgrade($symb,$env{'request.course.id'}, 3426: $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets); 3427: } 3428: $result.=&Apache::loncommon::end_data_table(); 3429: $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n"; 3430: $result.='<input type="button" value="'.&mt('Save').'" '. 3431: 'onclick="javascript:submit();" target="_self" /></form>'."\n"; 3432: if (scalar(%$fullname) eq 0) { 3433: my $colspan=3+scalar(@parts); 3434: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3435: my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status')); 3436: $result='<span class="LC_warning">'. 3437: &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.', 3438: $section_display, $stu_status). 3439: '</span>'; 3440: } 3441: return $result; 3442: } 3443: 3444: #--- call by previous routine to display each student 3445: sub viewstudentgrade { 3446: my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_; 3447: my ($uname,$udom) = split(/:/,$student); 3448: my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); 3449: my %aggregates = (); 3450: my $result=&Apache::loncommon::start_data_table_row().'<td align="right">'. 3451: '<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'. 3452: "\n".$ctr.' </td><td> '. 3453: '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. 3454: '\');" target="_self">'.$fullname.'</a> '. 3455: '<span class="LC_internal_info">('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')</span></td>'."\n"; 3456: $student=~s/:/_/; # colon doen't work in javascript for names 3457: foreach my $apart (@$parts) { 3458: my ($part,$type) = &split_part_type($apart); 3459: my $score=$record{"resource.$part.$type"}; 3460: $result.='<td align="center">'; 3461: my ($aggtries,$totaltries); 3462: unless (exists($aggregates{$part})) { 3463: $totaltries = $record{'resource.'.$part.'.tries'}; 3464: 3465: $aggtries = $totaltries; 3466: if ($$last_resets{$part}) { 3467: $aggtries = &get_num_tries(\%record,$$last_resets{$part}, 3468: $part); 3469: } 3470: $result.='<input type="hidden" name="'. 3471: 'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n"; 3472: $result.='<input type="hidden" name="'. 3473: 'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n"; 3474: $aggregates{$part} = 1; 3475: } 3476: if ($type eq 'awarded') { 3477: my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part}); 3478: $result.='<input type="hidden" name="'. 3479: 'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n"; 3480: $result.='<input type="text" name="'. 3481: 'GD_'.$student.'_'.$part.'_awarded" '. 3482: 'onchange="javascript:changeSelect(\''.$part.'\',\''.$student. 3483: '\')" value="'.$pts.'" size="4" /></td>'."\n"; 3484: } elsif ($type eq 'solved') { 3485: my ($status,$foo)=split(/_/,$score,2); 3486: $status = 'nothing' if ($status eq ''); 3487: $result.='<input type="hidden" name="'.'GD_'.$student.'_'. 3488: $part.'_solved_s" value="'.$status.'" />'."\n"; 3489: $result.=' <select name="'. 3490: 'GD_'.$student.'_'.$part.'_solved" '. 3491: 'onchange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n"; 3492: $result.= (($status eq 'excused') ? '<option> </option><option selected="selected" value="excused">'.&mt('excused').'</option>' 3493: : '<option selected="selected"> </option><option value="excused">'.&mt('excused').'</option>')."\n"; 3494: $result.='<option value="reset status">'.&mt('reset status').'</option>'; 3495: $result.="</select> </td>\n"; 3496: } else { 3497: $result.='<input type="hidden" name="'. 3498: 'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'. 3499: "\n"; 3500: $result.='<input type="text" name="'. 3501: 'GD_'.$student.'_'.$part.'_'.$type.'" '. 3502: 'value="'.$score.'" size="4" /></td>'."\n"; 3503: } 3504: } 3505: $result.=&Apache::loncommon::end_data_table_row(); 3506: return $result; 3507: } 3508: 3509: #--- change scores for all the students in a section/class 3510: # record does not get update if unchanged 3511: sub editgrades { 3512: my ($request,$symb) = @_; 3513: 3514: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3515: my $title='<h2>'.&mt('Current Grade Status').'</h2>'; 3516: $title.='<h4>'.&mt('<b>Section: </b>[_1]',$section_display).'</h4>'."\n"; 3517: 3518: my $result= &Apache::loncommon::start_data_table(). 3519: &Apache::loncommon::start_data_table_header_row(). 3520: '<th rowspan="2" valign="middle">'.&mt('No.').'</th>'. 3521: '<th rowspan="2" valign="middle">'.&nameUserString('header')."</th>\n"; 3522: my %scoreptr = ( 3523: 'correct' =>'correct_by_override', 3524: 'incorrect'=>'incorrect_by_override', 3525: 'excused' =>'excused', 3526: 'ungraded' =>'ungraded_attempted', 3527: 'credited' =>'credit_attempted', 3528: 'nothing' => '', 3529: ); 3530: my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0'); 3531: 3532: my (@partid); 3533: my %weight = (); 3534: my %columns = (); 3535: my ($i,$ctr,$count,$rec_update) = (0,0,0,0); 3536: 3537: my $partserror; 3538: my (@parts) = sort(&getpartlist($symb,\$partserror)); 3539: if ($partserror) { 3540: return &navmap_errormsg(); 3541: } 3542: my $header; 3543: while ($ctr < $env{'form.totalparts'}) { 3544: my $partid = $env{'form.partid_'.$ctr}; 3545: push(@partid,$partid); 3546: $weight{$partid} = $env{'form.weight_'.$partid}; 3547: $ctr++; 3548: } 3549: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 3550: foreach my $partid (@partid) { 3551: $header .= '<th align="center">'.&mt('Old Score').'</th>'. 3552: '<th align="center">'.&mt('New Score').'</th>'; 3553: $columns{$partid}=2; 3554: foreach my $stores (@parts) { 3555: my ($part,$type) = &split_part_type($stores); 3556: if ($part !~ m/^\Q$partid\E/) { next;} 3557: if ($type eq 'awarded' || $type eq 'solved') { next; } 3558: my $display=&Apache::lonnet::metadata($url,$stores.'.display'); 3559: $display =~ s/\[Part: \Q$part\E\]//; 3560: my $narrowtext = &mt('Tries'); 3561: $display =~ s/Number of Attempts/$narrowtext/; 3562: $header .= '<th align="center">'.&mt('Old').' '.$display.'</th>'. 3563: '<th align="center">'.&mt('New').' '.$display.'</th>'; 3564: $columns{$partid}+=2; 3565: } 3566: } 3567: foreach my $partid (@partid) { 3568: my $display_part=&get_display_part($partid,$symb); 3569: $result .= '<th colspan="'.$columns{$partid}.'" align="center">'. 3570: &mt('Part: [_1] (Weight = [_2])',$display_part,$weight{$partid}). 3571: '</th>'; 3572: 3573: } 3574: $result .= &Apache::loncommon::end_data_table_header_row(). 3575: &Apache::loncommon::start_data_table_header_row(). 3576: $header. 3577: &Apache::loncommon::end_data_table_header_row(); 3578: my @noupdate; 3579: my ($updateCtr,$noupdateCtr) = (1,1); 3580: for ($i=0; $i<$env{'form.total'}; $i++) { 3581: my $line; 3582: my $user = $env{'form.ctr'.$i}; 3583: my ($uname,$udom)=split(/:/,$user); 3584: my %newrecord; 3585: my $updateflag = 0; 3586: $line .= '<td>'.&nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>'; 3587: my $usec=$classlist->{"$uname:$udom"}[5]; 3588: if (!&canmodify($usec)) { 3589: my $numcols=scalar(@partid)*4+2; 3590: push(@noupdate, 3591: $line."<td colspan=\"$numcols\"><span class=\"LC_warning\">". 3592: &mt('Not allowed to modify student')."</span></td></tr>"); 3593: next; 3594: } 3595: my %aggregate = (); 3596: my $aggregateflag = 0; 3597: $user=~s/:/_/; # colon doen't work in javascript for names 3598: foreach (@partid) { 3599: my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'}; 3600: my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1); 3601: my $old_part = $old_aw eq '' ? '' : $old_part_pcr; 3602: my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; 3603: my $awarded = $env{'form.GD_'.$user.'_'.$_.'_awarded'}; 3604: my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1); 3605: my $partial = $awarded eq '' ? '' : $pcr; 3606: my $score; 3607: if ($partial eq '') { 3608: $score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; 3609: } elsif ($partial > 0) { 3610: $score = 'correct_by_override'; 3611: } elsif ($partial == 0) { 3612: $score = 'incorrect_by_override'; 3613: } 3614: my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'}; 3615: $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused')); 3616: 3617: $newrecord{'resource.'.$_.'.regrader'}= 3618: "$env{'user.name'}:$env{'user.domain'}"; 3619: if ($dropMenu eq 'reset status' && 3620: $old_score ne '') { # ignore if no previous attempts => nothing to reset 3621: $newrecord{'resource.'.$_.'.tries'} = ''; 3622: $newrecord{'resource.'.$_.'.solved'} = ''; 3623: $newrecord{'resource.'.$_.'.award'} = ''; 3624: $newrecord{'resource.'.$_.'.awarded'} = ''; 3625: $updateflag = 1; 3626: if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) { 3627: my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'}; 3628: my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'}; 3629: my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'}; 3630: &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus); 3631: $aggregateflag = 1; 3632: } 3633: } elsif (!($old_part eq $partial && $old_score eq $score)) { 3634: $updateflag = 1; 3635: $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; 3636: $newrecord{'resource.'.$_.'.solved'} = $score; 3637: $rec_update++; 3638: } 3639: 3640: $line .= '<td align="center">'.$old_aw.' </td>'. 3641: '<td align="center">'.$awarded. 3642: ($score eq 'excused' ? $score : '').' </td>'; 3643: 3644: 3645: my $partid=$_; 3646: foreach my $stores (@parts) { 3647: my ($part,$type) = &split_part_type($stores); 3648: if ($part !~ m/^\Q$partid\E/) { next;} 3649: if ($type eq 'awarded' || $type eq 'solved') { next; } 3650: my $old_aw = $env{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'}; 3651: my $awarded = $env{'form.GD_'.$user.'_'.$part.'_'.$type}; 3652: if ($awarded ne '' && $awarded ne $old_aw) { 3653: $newrecord{'resource.'.$part.'.'.$type}= $awarded; 3654: $newrecord{'resource.'.$part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; 3655: $updateflag=1; 3656: } 3657: $line .= '<td align="center">'.$old_aw.' </td>'. 3658: '<td align="center">'.$awarded.' </td>'; 3659: } 3660: } 3661: $line.="\n"; 3662: 3663: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 3664: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 3665: 3666: if ($updateflag) { 3667: $count++; 3668: &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'}, 3669: $udom,$uname); 3670: 3671: if (&Apache::bridgetask::in_queue('gradingqueue',$symb,$cdom, 3672: $cnum,$udom,$uname)) { 3673: # need to figure out if should be in queue. 3674: my %record = 3675: &Apache::lonnet::restore($symb,$env{'request.course.id'}, 3676: $udom,$uname); 3677: my $all_graded = 1; 3678: my $none_graded = 1; 3679: foreach my $part (@parts) { 3680: if ( $record{'resource.'.$part.'.awarded'} eq '' ) { 3681: $all_graded = 0; 3682: } else { 3683: $none_graded = 0; 3684: } 3685: } 3686: 3687: if ($all_graded || $none_graded) { 3688: &Apache::bridgetask::remove_from_queue('gradingqueue', 3689: $symb,$cdom,$cnum, 3690: $udom,$uname); 3691: } 3692: } 3693: 3694: $result.=&Apache::loncommon::start_data_table_row(). 3695: '<td align="right"> '.$updateCtr.' </td>'.$line. 3696: &Apache::loncommon::end_data_table_row(); 3697: $updateCtr++; 3698: } else { 3699: push(@noupdate, 3700: '<td align="right"> '.$noupdateCtr.' </td>'.$line); 3701: $noupdateCtr++; 3702: } 3703: if ($aggregateflag) { 3704: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 3705: $cdom,$cnum); 3706: } 3707: } 3708: if (@noupdate) { 3709: # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; 3710: my $numcols=scalar(@partid)*4+2; 3711: $result .= &Apache::loncommon::start_data_table_row('LC_empty_row'). 3712: '<td align="center" colspan="'.$numcols.'">'. 3713: &mt('No Changes Occurred For the Students Below'). 3714: '</td>'. 3715: &Apache::loncommon::end_data_table_row(); 3716: foreach my $line (@noupdate) { 3717: $result.= 3718: &Apache::loncommon::start_data_table_row(). 3719: $line. 3720: &Apache::loncommon::end_data_table_row(); 3721: } 3722: } 3723: $result .= &Apache::loncommon::end_data_table(); 3724: my $msg = '<p><b>'. 3725: &mt('Number of records updated = [_1] for [quant,_2,student].', 3726: $rec_update,$count).'</b><br />'. 3727: '<b>'.&mt('Total number of students = [_1]',$env{'form.total'}). 3728: '</b></p>'; 3729: return $title.$msg.$result; 3730: } 3731: 3732: sub split_part_type { 3733: my ($partstr) = @_; 3734: my ($temp,@allparts)=split(/_/,$partstr); 3735: my $type=pop(@allparts); 3736: my $part=join('_',@allparts); 3737: return ($part,$type); 3738: } 3739: 3740: #------------- end of section for handling grading by section/class --------- 3741: # 3742: #---------------------------------------------------------------------------- 3743: 3744: 3745: #---------------------------------------------------------------------------- 3746: # 3747: #-------------------------- Next few routines handles grading by csv upload 3748: # 3749: #--- Javascript to handle csv upload 3750: sub csvupload_javascript_reverse_associate { 3751: my $error1=&mt('You need to specify the username or the student/employee ID'); 3752: my $error2=&mt('You need to specify at least one grading field'); 3753: return(<<ENDPICK); 3754: function verify(vf) { 3755: var foundsomething=0; 3756: var founduname=0; 3757: var foundID=0; 3758: for (i=0;i<=vf.nfields.value;i++) { 3759: tw=eval('vf.f'+i+'.selectedIndex'); 3760: if (i==0 && tw!=0) { foundID=1; } 3761: if (i==1 && tw!=0) { founduname=1; } 3762: if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; } 3763: } 3764: if (founduname==0 && foundID==0) { 3765: alert('$error1'); 3766: return; 3767: } 3768: if (foundsomething==0) { 3769: alert('$error2'); 3770: return; 3771: } 3772: vf.submit(); 3773: } 3774: function flip(vf,tf) { 3775: var nw=eval('vf.f'+tf+'.selectedIndex'); 3776: var i; 3777: for (i=0;i<=vf.nfields.value;i++) { 3778: //can not pick the same destination field for both name and domain 3779: if (((i ==0)||(i ==1)) && 3780: ((tf==0)||(tf==1)) && 3781: (i!=tf) && 3782: (eval('vf.f'+i+'.selectedIndex')==nw)) { 3783: eval('vf.f'+i+'.selectedIndex=0;') 3784: } 3785: } 3786: } 3787: ENDPICK 3788: } 3789: 3790: sub csvupload_javascript_forward_associate { 3791: my $error1=&mt('You need to specify the username or the student/employee ID'); 3792: my $error2=&mt('You need to specify at least one grading field'); 3793: return(<<ENDPICK); 3794: function verify(vf) { 3795: var foundsomething=0; 3796: var founduname=0; 3797: var foundID=0; 3798: for (i=0;i<=vf.nfields.value;i++) { 3799: tw=eval('vf.f'+i+'.selectedIndex'); 3800: if (tw==1) { foundID=1; } 3801: if (tw==2) { founduname=1; } 3802: if (tw>3) { foundsomething=1; } 3803: } 3804: if (founduname==0 && foundID==0) { 3805: alert('$error1'); 3806: return; 3807: } 3808: if (foundsomething==0) { 3809: alert('$error2'); 3810: return; 3811: } 3812: vf.submit(); 3813: } 3814: function flip(vf,tf) { 3815: var nw=eval('vf.f'+tf+'.selectedIndex'); 3816: var i; 3817: //can not pick the same destination field twice 3818: for (i=0;i<=vf.nfields.value;i++) { 3819: if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) { 3820: eval('vf.f'+i+'.selectedIndex=0;') 3821: } 3822: } 3823: } 3824: ENDPICK 3825: } 3826: 3827: sub csvuploadmap_header { 3828: my ($request,$symb,$datatoken,$distotal)= @_; 3829: my $javascript; 3830: if ($env{'form.upfile_associate'} eq 'reverse') { 3831: $javascript=&csvupload_javascript_reverse_associate(); 3832: } else { 3833: $javascript=&csvupload_javascript_forward_associate(); 3834: } 3835: 3836: $symb = &Apache::lonenc::check_encrypt($symb); 3837: $request->print('<form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">'. 3838: &mt('Total number of records found in file: [_1]',$distotal).'<hr />'. 3839: &mt('Associate entries from the uploaded file with as many fields as you can.')); 3840: my $reverse=&mt("Reverse Association"); 3841: $request->print(<<ENDPICK); 3842: <br /> 3843: <input type="button" value="$reverse" onclick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" /> 3844: <input type="hidden" name="associate" value="" /> 3845: <input type="hidden" name="phase" value="three" /> 3846: <input type="hidden" name="datatoken" value="$datatoken" /> 3847: <input type="hidden" name="fileupload" value="$env{'form.fileupload'}" /> 3848: <input type="hidden" name="upfiletype" value="$env{'form.upfiletype'}" /> 3849: <input type="hidden" name="upfile_associate" 3850: value="$env{'form.upfile_associate'}" /> 3851: <input type="hidden" name="symb" value="$symb" /> 3852: <input type="hidden" name="command" value="csvuploadoptions" /> 3853: <hr /> 3854: ENDPICK 3855: $request->print(&Apache::lonhtmlcommon::scripttag($javascript)); 3856: return ''; 3857: 3858: } 3859: 3860: sub csvupload_fields { 3861: my ($symb,$errorref) = @_; 3862: my (@parts) = &getpartlist($symb,$errorref); 3863: if (ref($errorref)) { 3864: if ($$errorref) { 3865: return; 3866: } 3867: } 3868: 3869: my @fields=(['ID','Student/Employee ID'], 3870: ['username','Student Username'], 3871: ['domain','Student Domain']); 3872: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 3873: foreach my $part (sort(@parts)) { 3874: my @datum; 3875: my $display=&Apache::lonnet::metadata($url,$part.'.display'); 3876: my $name=$part; 3877: if (!$display) { $display = $name; } 3878: @datum=($name,$display); 3879: if ($name=~/^stores_(.*)_awarded/) { 3880: push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]); 3881: } 3882: push(@fields,\@datum); 3883: } 3884: return (@fields); 3885: } 3886: 3887: sub csvuploadmap_footer { 3888: my ($request,$i,$keyfields) =@_; 3889: $request->print(<<ENDPICK); 3890: </table> 3891: <input type="hidden" name="nfields" value="$i" /> 3892: <input type="hidden" name="keyfields" value="$keyfields" /> 3893: <input type="button" onclick="javascript:verify(this.form)" value="Assign Grades" /><br /> 3894: </form> 3895: ENDPICK 3896: } 3897: 3898: sub checkforfile_js { 3899: my $alertmsg = &mt('Please use the browse button to select a file from your local directory.'); 3900: my $result = &Apache::lonhtmlcommon::scripttag(<<CSVFORMJS); 3901: function checkUpload(formname) { 3902: if (formname.upfile.value == "") { 3903: alert("$alertmsg"); 3904: return false; 3905: } 3906: formname.submit(); 3907: } 3908: CSVFORMJS 3909: return $result; 3910: } 3911: 3912: sub upcsvScores_form { 3913: my ($request,$symb) = @_; 3914: if (!$symb) {return '';} 3915: my $result=&checkforfile_js(); 3916: $result.=&Apache::loncommon::start_data_table(). 3917: &Apache::loncommon::start_data_table_header_row(). 3918: '<th>'.&mt('Specify a file containing the class scores for current resource.').'</th>'. 3919: &Apache::loncommon::end_data_table_header_row(). 3920: &Apache::loncommon::start_data_table_row().'<td>'; 3921: my $upload=&mt("Upload Scores"); 3922: my $upfile_select=&Apache::loncommon::upfile_select_html(); 3923: my $ignore=&mt('Ignore First Line'); 3924: $symb = &Apache::lonenc::check_encrypt($symb); 3925: $result.=<<ENDUPFORM; 3926: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 3927: <input type="hidden" name="symb" value="$symb" /> 3928: <input type="hidden" name="command" value="csvuploadmap" /> 3929: $upfile_select 3930: <br /><input type="button" onclick="javascript:checkUpload(this.form);" value="$upload" /> 3931: </form> 3932: ENDUPFORM 3933: $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV", 3934: &mt("How do I create a CSV file from a spreadsheet")). 3935: '</td>'. 3936: &Apache::loncommon::end_data_table_row(). 3937: &Apache::loncommon::end_data_table(); 3938: return $result; 3939: } 3940: 3941: 3942: sub csvuploadmap { 3943: my ($request,$symb)= @_; 3944: if (!$symb) {return '';} 3945: 3946: my $datatoken; 3947: if (!$env{'form.datatoken'}) { 3948: $datatoken=&Apache::loncommon::upfile_store($request); 3949: } else { 3950: $datatoken=$env{'form.datatoken'}; 3951: &Apache::loncommon::load_tmp_file($request); 3952: } 3953: my @records=&Apache::loncommon::upfile_record_sep(); 3954: &csvuploadmap_header($request,$symb,$datatoken,$#records+1); 3955: my ($i,$keyfields); 3956: if (@records) { 3957: my $fieldserror; 3958: my @fields=&csvupload_fields($symb,\$fieldserror); 3959: if ($fieldserror) { 3960: $request->print(&navmap_errormsg()); 3961: return; 3962: } 3963: if ($env{'form.upfile_associate'} eq 'reverse') { 3964: &Apache::loncommon::csv_print_samples($request,\@records); 3965: $i=&Apache::loncommon::csv_print_select_table($request,\@records, 3966: \@fields); 3967: foreach (@fields) { $keyfields.=$_->[0].','; } 3968: chop($keyfields); 3969: } else { 3970: unshift(@fields,['none','']); 3971: $i=&Apache::loncommon::csv_samples_select_table($request,\@records, 3972: \@fields); 3973: foreach my $rec (@records) { 3974: my %temp = &Apache::loncommon::record_sep($rec); 3975: if (%temp) { 3976: $keyfields=join(',',sort(keys(%temp))); 3977: last; 3978: } 3979: } 3980: } 3981: } 3982: &csvuploadmap_footer($request,$i,$keyfields); 3983: 3984: return ''; 3985: } 3986: 3987: sub csvuploadoptions { 3988: my ($request,$symb)= @_; 3989: my $overwrite=&mt('Overwrite any existing score'); 3990: $request->print(<<ENDPICK); 3991: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 3992: <input type="hidden" name="command" value="csvuploadassign" /> 3993: <p> 3994: <label> 3995: <input type="checkbox" name="overwite_scores" checked="checked" /> 3996: $overwrite 3997: </label> 3998: </p> 3999: ENDPICK 4000: my %fields=&get_fields(); 4001: if (!defined($fields{'domain'})) { 4002: my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); 4003: $request->print("\n<p>".&mt('Users are in domain: [_1]',$domform)."</p>\n"); 4004: } 4005: foreach my $key (sort(keys(%env))) { 4006: if ($key !~ /^form\.(.*)$/) { next; } 4007: my $cleankey=$1; 4008: if ($cleankey eq 'command') { next; } 4009: $request->print('<input type="hidden" name="'.$cleankey. 4010: '" value="'.$env{$key}.'" />'."\n"); 4011: } 4012: # FIXME do a check for any duplicated user ids... 4013: # FIXME do a check for any invalid user ids?... 4014: $request->print('<input type="submit" value="Assign Grades" /><br /> 4015: <hr /></form>'."\n"); 4016: return ''; 4017: } 4018: 4019: sub get_fields { 4020: my %fields; 4021: my @keyfields = split(/\,/,$env{'form.keyfields'}); 4022: for (my $i=0; $i<=$env{'form.nfields'}; $i++) { 4023: if ($env{'form.upfile_associate'} eq 'reverse') { 4024: if ($env{'form.f'.$i} ne 'none') { 4025: $fields{$keyfields[$i]}=$env{'form.f'.$i}; 4026: } 4027: } else { 4028: if ($env{'form.f'.$i} ne 'none') { 4029: $fields{$env{'form.f'.$i}}=$keyfields[$i]; 4030: } 4031: } 4032: } 4033: return %fields; 4034: } 4035: 4036: sub csvuploadassign { 4037: my ($request,$symb)= @_; 4038: if (!$symb) {return '';} 4039: my $error_msg = ''; 4040: &Apache::loncommon::load_tmp_file($request); 4041: my @gradedata = &Apache::loncommon::upfile_record_sep(); 4042: my %fields=&get_fields(); 4043: my $courseid=$env{'request.course.id'}; 4044: my ($classlist) = &getclasslist('all',0); 4045: my @notallowed; 4046: my @skipped; 4047: my $countdone=0; 4048: foreach my $grade (@gradedata) { 4049: my %entries=&Apache::loncommon::record_sep($grade); 4050: my $domain; 4051: if ($entries{$fields{'domain'}}) { 4052: $domain=$entries{$fields{'domain'}}; 4053: } else { 4054: $domain=$env{'form.default_domain'}; 4055: } 4056: $domain=~s/\s//g; 4057: my $username=$entries{$fields{'username'}}; 4058: $username=~s/\s//g; 4059: if (!$username) { 4060: my $id=$entries{$fields{'ID'}}; 4061: $id=~s/\s//g; 4062: my %ids=&Apache::lonnet::idget($domain,$id); 4063: $username=$ids{$id}; 4064: } 4065: if (!exists($$classlist{"$username:$domain"})) { 4066: my $id=$entries{$fields{'ID'}}; 4067: $id=~s/\s//g; 4068: if ($id) { 4069: push(@skipped,"$id:$domain"); 4070: } else { 4071: push(@skipped,"$username:$domain"); 4072: } 4073: next; 4074: } 4075: my $usec=$classlist->{"$username:$domain"}[5]; 4076: if (!&canmodify($usec)) { 4077: push(@notallowed,"$username:$domain"); 4078: next; 4079: } 4080: my %points; 4081: my %grades; 4082: foreach my $dest (keys(%fields)) { 4083: if ($dest eq 'ID' || $dest eq 'username' || 4084: $dest eq 'domain') { next; } 4085: if ($entries{$fields{$dest}} =~ /^\s*$/) { next; } 4086: if ($dest=~/stores_(.*)_points/) { 4087: my $part=$1; 4088: my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', 4089: $symb,$domain,$username); 4090: if ($wgt) { 4091: $entries{$fields{$dest}}=~s/\s//g; 4092: my $pcr=$entries{$fields{$dest}} / $wgt; 4093: my $award=($pcr == 0) ? 'incorrect_by_override' 4094: : 'correct_by_override'; 4095: if ($pcr>1) { 4096: push(@skipped,&mt("[_1]: point value larger than weight","$username:$domain")); 4097: } 4098: $grades{"resource.$part.awarded"}=$pcr; 4099: $grades{"resource.$part.solved"}=$award; 4100: $points{$part}=1; 4101: } else { 4102: $error_msg = "<br />" . 4103: &mt("Some point values were assigned" 4104: ." for problems with a weight " 4105: ."of zero. These values were " 4106: ."ignored."); 4107: } 4108: } else { 4109: if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } 4110: if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } 4111: my $store_key=$dest; 4112: $store_key=~s/^stores/resource/; 4113: $store_key=~s/_/\./g; 4114: $grades{$store_key}=$entries{$fields{$dest}}; 4115: } 4116: } 4117: if (! %grades) { 4118: push(@skipped,&mt("[_1]: no data to save","$username:$domain")); 4119: } else { 4120: $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; 4121: my $result=&Apache::lonnet::cstore(\%grades,$symb, 4122: $env{'request.course.id'}, 4123: $domain,$username); 4124: if ($result eq 'ok') { 4125: # Successfully stored 4126: $request->print('.'); 4127: # Remove from grading queue 4128: &Apache::bridgetask::remove_from_queue('gradingqueue',$symb, 4129: $env{'course.'.$env{'request.course.id'}.'.domain'}, 4130: $env{'course.'.$env{'request.course.id'}.'.num'}, 4131: $domain,$username); 4132: $countdone++; 4133: } else { 4134: $request->print("<p><span class=\"LC_error\">". 4135: &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", 4136: "$username:$domain",$result)."</span></p>"); 4137: } 4138: $request->rflush(); 4139: } 4140: } 4141: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0)); 4142: if (@skipped) { 4143: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('No scores stored for the following username(s):'),1).'<br />'); 4144: $request->print(join(', ',@skipped)); 4145: } 4146: if (@notallowed) { 4147: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('Modification of scores not allowed for the following username(s):'),1).'<br />'); 4148: $request->print(join(', ',@notallowed)); 4149: } 4150: $request->print("<br />\n"); 4151: return $error_msg; 4152: } 4153: #------------- end of section for handling csv file upload --------- 4154: # 4155: #------------------------------------------------------------------- 4156: # 4157: #-------------- Next few routines handle grading by page/sequence 4158: # 4159: #--- Select a page/sequence and a student to grade 4160: sub pickStudentPage { 4161: my ($request,$symb) = @_; 4162: 4163: my $alertmsg = &mt('Please select the student you wish to grade.'); 4164: $request->print(&Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT)); 4165: 4166: function checkPickOne(formname) { 4167: if (radioSelection(formname.student) == null) { 4168: alert("$alertmsg"); 4169: return; 4170: } 4171: ptr = pullDownSelection(formname.selectpage); 4172: formname.page.value = formname["page"+ptr].value; 4173: formname.title.value = formname["title"+ptr].value; 4174: formname.submit(); 4175: } 4176: 4177: LISTJAVASCRIPT 4178: &commonJSfunctions($request); 4179: 4180: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 4181: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 4182: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 4183: 4184: my $result='<h3><span class="LC_info"> '. 4185: &mt('Manual Grading by Page or Sequence').'</span></h3>'; 4186: 4187: $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n"; 4188: my $map_error; 4189: my ($titles,$symbx) = &getSymbMap($map_error); 4190: if ($map_error) { 4191: $request->print(&navmap_errormsg()); 4192: return; 4193: } 4194: my ($curpage) =&Apache::lonnet::decode_symb($symb); 4195: # my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 4196: # my $type=($curpage =~ /\.(page|sequence)/); 4197: my $select = '<select name="selectpage">'."\n"; 4198: my $ctr=0; 4199: foreach (@$titles) { 4200: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 4201: $select.='<option value="'.$ctr.'" '. 4202: ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : ''). 4203: '>'.$showtitle.'</option>'."\n"; 4204: $ctr++; 4205: } 4206: $select.= '</select>'; 4207: $result.=' <b>'.&mt('Problems from').':</b> '.$select."<br />\n"; 4208: 4209: $ctr=0; 4210: foreach (@$titles) { 4211: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 4212: $result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n"; 4213: $result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n"; 4214: $ctr++; 4215: } 4216: $result.='<input type="hidden" name="page" />'."\n". 4217: '<input type="hidden" name="title" />'."\n"; 4218: 4219: my $options = 4220: '<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n". 4221: '<label><input type="radio" name="vProb" value="yes" /> '.&mt('yes').' </label>'."<br />\n"; 4222: $result.=' <b>'.&mt('View Problem Text').': </b>'.$options; 4223: 4224: $options = 4225: '<label><input type="radio" name="lastSub" value="none" /> '.&mt('none').' </label>'."\n". 4226: '<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '.&mt('by dates and submissions').'</label>'."\n". 4227: '<label><input type="radio" name="lastSub" value="all" /> '.&mt('all details').' </label>'."\n"; 4228: $result.=' <b>'.&mt('Submissions').': </b>'.$options; 4229: 4230: $result.=&build_section_inputs(); 4231: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 4232: $result.='<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 4233: '<input type="hidden" name="command" value="displayPage" />'."\n". 4234: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."<br />\n"; 4235: 4236: $result.=' <b>'.&mt('Use CODE').': </b> <input type="text" name="CODE" value="" /> <br />'."\n"; 4237: 4238: $result.=' <input type="button" '. 4239: 'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /><br />'."\n"; 4240: 4241: $request->print($result); 4242: 4243: my $studentTable.=' <b>'.&mt('Select a student you wish to grade and then click on the Next button.').'</b><br />'. 4244: &Apache::loncommon::start_data_table(). 4245: &Apache::loncommon::start_data_table_header_row(). 4246: '<th align="right"> '.&mt('No.').'</th>'. 4247: '<th>'.&nameUserString('header').'</th>'. 4248: '<th align="right"> '.&mt('No.').'</th>'. 4249: '<th>'.&nameUserString('header').'</th>'. 4250: &Apache::loncommon::end_data_table_header_row(); 4251: 4252: my (undef,undef,$fullname) = &getclasslist($getsec,'1'); 4253: my $ptr = 1; 4254: foreach my $student (sort 4255: { 4256: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 4257: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 4258: } 4259: return $a cmp $b; 4260: } (keys(%$fullname))) { 4261: my ($uname,$udom) = split(/:/,$student); 4262: $studentTable.=($ptr%2==1 ? &Apache::loncommon::start_data_table_row() 4263: : '</td>'); 4264: $studentTable.='<td align="right">'.$ptr.' </td>'; 4265: $studentTable.='<td> <label><input type="radio" name="student" value="'.$student.'" /> ' 4266: .&nameUserString(undef,$$fullname{$student},$uname,$udom)."</label>\n"; 4267: $studentTable.= 4268: ($ptr%2 == 0 ? '</td>'.&Apache::loncommon::end_data_table_row() 4269: : ''); 4270: $ptr++; 4271: } 4272: if ($ptr%2 == 0) { 4273: $studentTable.='</td><td> </td><td> </td>'. 4274: &Apache::loncommon::end_data_table_row(); 4275: } 4276: $studentTable.=&Apache::loncommon::end_data_table()."\n"; 4277: $studentTable.='<input type="button" '. 4278: 'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /></form>'."\n"; 4279: 4280: $request->print($studentTable); 4281: 4282: return ''; 4283: } 4284: 4285: sub getSymbMap { 4286: my ($map_error) = @_; 4287: my $navmap = Apache::lonnavmaps::navmap->new(); 4288: unless (ref($navmap)) { 4289: if (ref($map_error)) { 4290: $$map_error = 'navmap'; 4291: } 4292: return; 4293: } 4294: my %symbx = (); 4295: my @titles = (); 4296: my $minder = 0; 4297: 4298: # Gather every sequence that has problems. 4299: my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 4300: 1,0,1); 4301: for my $sequence ($navmap->getById('0.0'), @sequences) { 4302: if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { 4303: my $title = $minder.'.'. 4304: &HTML::Entities::encode($sequence->compTitle(),'"\'&'); 4305: push(@titles, $title); # minder in case two titles are identical 4306: $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); 4307: $minder++; 4308: } 4309: } 4310: return \@titles,\%symbx; 4311: } 4312: 4313: # 4314: #--- Displays a page/sequence w/wo problems, w/wo submissions 4315: sub displayPage { 4316: my ($request,$symb) = @_; 4317: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 4318: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 4319: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 4320: my $pageTitle = $env{'form.page'}; 4321: my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); 4322: my ($uname,$udom) = split(/:/,$env{'form.student'}); 4323: my $usec=$classlist->{$env{'form.student'}}[5]; 4324: 4325: #need to make sure we have the correct data for later EXT calls, 4326: #thus invalidate the cache 4327: &Apache::lonnet::devalidatecourseresdata( 4328: $env{'course.'.$env{'request.course.id'}.'.num'}, 4329: $env{'course.'.$env{'request.course.id'}.'.domain'}); 4330: &Apache::lonnet::clear_EXT_cache_status(); 4331: 4332: if (!&canview($usec)) { 4333: $request->print('<span class="LC_warning">'.&mt('Unable to view requested student. ([_1])',$env{'form.student'}).'</span>'); 4334: return; 4335: } 4336: my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; 4337: $result.='<h3> '.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)). 4338: '</h3>'."\n"; 4339: $env{'form.CODE'} = uc($env{'form.CODE'}); 4340: if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) { 4341: $result.='<h3> '.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n"; 4342: } else { 4343: delete($env{'form.CODE'}); 4344: } 4345: &sub_page_js($request); 4346: $request->print($result); 4347: 4348: my $navmap = Apache::lonnavmaps::navmap->new(); 4349: unless (ref($navmap)) { 4350: $request->print(&navmap_errormsg()); 4351: return; 4352: } 4353: my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'}); 4354: my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps 4355: if (!$map) { 4356: $request->print('<span class="LC_warning">'.&mt('Unable to view requested sequence. ([_1])',$resUrl).'</span>'); 4357: return; 4358: } 4359: my $iterator = $navmap->getIterator($map->map_start(), 4360: $map->map_finish()); 4361: 4362: my $studentTable='<form action="/adm/grades" method="post" name="gradePage">'."\n". 4363: '<input type="hidden" name="command" value="gradeByPage" />'."\n". 4364: '<input type="hidden" name="fullname" value="'.$$fullname{$env{'form.student'}}.'" />'."\n". 4365: '<input type="hidden" name="student" value="'.$env{'form.student'}.'" />'."\n". 4366: '<input type="hidden" name="page" value="'.$pageTitle.'" />'."\n". 4367: '<input type="hidden" name="title" value="'.$env{'form.title'}.'" />'."\n". 4368: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 4369: '<input type="hidden" name="overRideScore" value="no" />'."\n"; 4370: 4371: if (defined($env{'form.CODE'})) { 4372: $studentTable.= 4373: '<input type="hidden" name="CODE" value="'.$env{'form.CODE'}.'" />'."\n"; 4374: } 4375: my $checkIcon = '<img alt="'.&mt('Check Mark'). 4376: '" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />'; 4377: 4378: $studentTable.=' <span class="LC_info">'. 4379: &mt('Problems graded correct by the computer are marked with a [_1] symbol.',$checkIcon). 4380: '</span>'."\n". 4381: &Apache::loncommon::start_data_table(). 4382: &Apache::loncommon::start_data_table_header_row(). 4383: '<th align="center"> Prob. </th>'. 4384: '<th> '.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').'</th>'. 4385: &Apache::loncommon::end_data_table_header_row(); 4386: 4387: &Apache::lonxml::clear_problem_counter(); 4388: my ($depth,$question,$prob) = (1,1,1); 4389: $iterator->next(); # skip the first BEGIN_MAP 4390: my $curRes = $iterator->next(); # for "current resource" 4391: while ($depth > 0) { 4392: if($curRes == $iterator->BEGIN_MAP) { $depth++; } 4393: if($curRes == $iterator->END_MAP) { $depth--; } 4394: 4395: if (ref($curRes) && $curRes->is_problem()) { 4396: my $parts = $curRes->parts(); 4397: my $title = $curRes->compTitle(); 4398: my $symbx = $curRes->symb(); 4399: $studentTable.= 4400: &Apache::loncommon::start_data_table_row(). 4401: '<td align="center" valign="top" >'.$prob. 4402: (scalar(@{$parts}) == 1 ? '' 4403: : '<br />('.&mt('[_1]parts)', 4404: scalar(@{$parts}).' ') 4405: ). 4406: '</td>'; 4407: $studentTable.='<td valign="top">'; 4408: my %form = ('CODE' => $env{'form.CODE'},); 4409: if ($env{'form.vProb'} eq 'yes' ) { 4410: $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, 4411: undef,'both',\%form); 4412: } else { 4413: my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form); 4414: $companswer =~ s|<form(.*?)>||g; 4415: $companswer =~ s|</form>||g; 4416: # while ($companswer =~ /(<a href\=\"javascript:newWindow.*?Script Vars<\/a>)/s) { #<a href="javascript:newWindow</a> 4417: # $companswer =~ s/$1/ /ms; 4418: # $request->print('match='.$1."<br />\n"); 4419: # } 4420: # $companswer =~ s|<table border=\"1\">|<table border=\"0\">|g; 4421: $studentTable.=' <b>'.$title.'</b> <br /> <b>'.&mt('Correct answer').':</b><br />'.$companswer; 4422: } 4423: 4424: my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); 4425: 4426: if ($env{'form.lastSub'} eq 'datesub') { 4427: if ($record{'version'} eq '') { 4428: $studentTable.='<br /> <span class="LC_warning">'.&mt('No recorded submission for this problem.').'</span><br />'; 4429: } else { 4430: my %responseType = (); 4431: foreach my $partid (@{$parts}) { 4432: my @responseIds =$curRes->responseIds($partid); 4433: my @responseType =$curRes->responseType($partid); 4434: my %responseIds; 4435: for (my $i=0;$i<=$#responseIds;$i++) { 4436: $responseIds{$responseIds[$i]}=$responseType[$i]; 4437: } 4438: $responseType{$partid} = \%responseIds; 4439: } 4440: $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom); 4441: 4442: } 4443: } elsif ($env{'form.lastSub'} eq 'all') { 4444: my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); 4445: $studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom, 4446: $env{'request.course.id'}, 4447: '','.submission'); 4448: 4449: } 4450: if (&canmodify($usec)) { 4451: $studentTable.=&gradeBox_start(); 4452: foreach my $partid (@{$parts}) { 4453: $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record); 4454: $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n"; 4455: $question++; 4456: } 4457: $studentTable.=&gradeBox_end(); 4458: $prob++; 4459: } 4460: $studentTable.='</td></tr>'; 4461: 4462: } 4463: $curRes = $iterator->next(); 4464: } 4465: 4466: $studentTable.= 4467: '</table>'."\n". 4468: '<input type="button" value="'.&mt('Save').'" '. 4469: 'onclick="javascript:checkSubmitPage(this.form,'.$question.');" />'. 4470: '</form>'."\n"; 4471: $request->print($studentTable); 4472: 4473: return ''; 4474: } 4475: 4476: sub displaySubByDates { 4477: my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; 4478: my $isCODE=0; 4479: my $isTask = ($symb =~/\.task$/); 4480: if (exists($record->{'resource.CODE'})) { $isCODE=1; } 4481: my $studentTable=&Apache::loncommon::start_data_table(). 4482: &Apache::loncommon::start_data_table_header_row(). 4483: '<th>'.&mt('Date/Time').'</th>'. 4484: ($isCODE?'<th>'.&mt('CODE').'</th>':''). 4485: '<th>'.&mt('Submission').'</th>'. 4486: '<th>'.&mt('Status').'</th>'. 4487: &Apache::loncommon::end_data_table_header_row(); 4488: my ($version); 4489: my %mark; 4490: my %orders; 4491: $mark{'correct_by_student'} = $checkIcon; 4492: if (!exists($$record{'1:timestamp'})) { 4493: return '<br /> <span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br />'; 4494: } 4495: 4496: my $interaction; 4497: my $no_increment = 1; 4498: my %lastrndseed; 4499: for ($version=1;$version<=$$record{'version'};$version++) { 4500: my $timestamp = 4501: &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'}); 4502: if (exists($$record{$version.':resource.0.version'})) { 4503: $interaction = $$record{$version.':resource.0.version'}; 4504: } 4505: 4506: my $where = ($isTask ? "$version:resource.$interaction" 4507: : "$version:resource"); 4508: $studentTable.=&Apache::loncommon::start_data_table_row(). 4509: '<td>'.$timestamp.'</td>'; 4510: if ($isCODE) { 4511: $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>'; 4512: } 4513: my @versionKeys = split(/\:/,$$record{$version.':keys'}); 4514: my @displaySub = (); 4515: foreach my $partid (@{$parts}) { 4516: my ($hidden,$type); 4517: $type = $$record{$version.':resource.'.$partid.'.type'}; 4518: if (($type eq 'anonsurvey') || ($type eq 'anonsurveycred')) { 4519: $hidden = 1; 4520: } 4521: my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys) 4522: : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); 4523: 4524: # next if ($$record{"$version:resource.$partid.solved"} eq ''); 4525: my $display_part=&get_display_part($partid,$symb); 4526: foreach my $matchKey (@matchKey) { 4527: if (exists($$record{$version.':'.$matchKey}) && 4528: $$record{$version.':'.$matchKey} ne '') { 4529: 4530: my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) 4531: : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); 4532: $displaySub[0].='<span class="LC_nobreak"'; 4533: $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>' 4534: .' <span class="LC_internal_info">' 4535: .'('.&mt('Response ID: [_1]',$responseId).')' 4536: .'</span>' 4537: .' <b>'; 4538: if ($hidden) { 4539: $displaySub[0].= &mt('Anonymous Survey').'</b>'; 4540: } else { 4541: my ($trial,$rndseed,$newvariation); 4542: if ($type eq 'randomizetry') { 4543: $trial = $$record{"$where.$partid.tries"}; 4544: $rndseed = $$record{"$where.$partid.rndseed"}; 4545: } 4546: if ($$record{"$where.$partid.tries"} eq '') { 4547: $displaySub[0].=&mt('Trial not counted'); 4548: } else { 4549: $displaySub[0].=&mt('Trial: [_1]', 4550: $$record{"$where.$partid.tries"}); 4551: if ($rndseed || $lastrndseed{$partid}) { 4552: if ($rndseed ne $lastrndseed{$partid}) { 4553: $newvariation = ' ('.&mt('New variation this try').')'; 4554: } 4555: } 4556: $lastrndseed{$partid} = $rndseed; 4557: } 4558: my $responseType=($isTask ? 'Task' 4559: : $responseType->{$partid}->{$responseId}); 4560: if (!exists($orders{$partid})) { $orders{$partid}={}; } 4561: if ((!exists($orders{$partid}->{$responseId})) || ($trial)) { 4562: $orders{$partid}->{$responseId}= 4563: &get_order($partid,$responseId,$symb,$uname,$udom, 4564: $no_increment,$type,$trial,$rndseed); 4565: } 4566: $displaySub[0].='</b>'.$newvariation.'</span>'; # /nobreak 4567: $displaySub[0].='  '. 4568: &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'<br />'; 4569: } 4570: } 4571: } 4572: if (exists($$record{"$where.$partid.checkedin"})) { 4573: $displaySub[1].=&mt('Checked in by [_1] into slot [_2]', 4574: $$record{"$where.$partid.checkedin"}, 4575: $$record{"$where.$partid.checkedin.slot"}). 4576: '<br />'; 4577: } 4578: if (exists $$record{"$where.$partid.award"}) { 4579: $displaySub[1].='<b>'.&mt('Part:').'</b> '.$display_part.'  '. 4580: lc($$record{"$where.$partid.award"}).' '. 4581: $mark{$$record{"$where.$partid.solved"}}. 4582: '<br />'; 4583: } 4584: if (exists $$record{"$where.$partid.regrader"}) { 4585: $displaySub[2].=$$record{"$where.$partid.regrader"}. 4586: ' (<b>'.&mt('Part').':</b> '.$display_part.')'; 4587: } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { 4588: $displaySub[2].= 4589: $$record{"$version:resource.$partid.regrader"}. 4590: ' (<b>'.&mt('Part').':</b> '.$display_part.')'; 4591: } 4592: } 4593: # needed because old essay regrader has not parts info 4594: if (exists $$record{"$version:resource.regrader"}) { 4595: $displaySub[2].=$$record{"$version:resource.regrader"}; 4596: } 4597: $studentTable.='<td>'.$displaySub[0].' </td><td>'.$displaySub[1]; 4598: if ($displaySub[2]) { 4599: $studentTable.=&mt('Manually graded by [_1]',$displaySub[2]); 4600: } 4601: $studentTable.=' </td>'. 4602: &Apache::loncommon::end_data_table_row(); 4603: } 4604: $studentTable.=&Apache::loncommon::end_data_table(); 4605: return $studentTable; 4606: } 4607: 4608: sub updateGradeByPage { 4609: my ($request,$symb) = @_; 4610: 4611: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 4612: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 4613: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 4614: my $pageTitle = $env{'form.page'}; 4615: my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); 4616: my ($uname,$udom) = split(/:/,$env{'form.student'}); 4617: my $usec=$classlist->{$env{'form.student'}}[5]; 4618: if (!&canmodify($usec)) { 4619: $request->print('<span class="LC_warning">'.&mt('Unable to modify requested student ([_1])',$env{'form.student'}).'</span>'); 4620: return; 4621: } 4622: my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; 4623: $result.='<h3> '.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom). 4624: '</h3>'."\n"; 4625: 4626: $request->print($result); 4627: 4628: 4629: my $navmap = Apache::lonnavmaps::navmap->new(); 4630: unless (ref($navmap)) { 4631: $request->print(&navmap_errormsg()); 4632: return; 4633: } 4634: my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'}); 4635: my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps 4636: if (!$map) { 4637: $request->print('<span class="LC_warning">'.&mt('Unable to grade requested sequence ([_1]).',$resUrl).'</span>'); 4638: return; 4639: } 4640: my $iterator = $navmap->getIterator($map->map_start(), 4641: $map->map_finish()); 4642: 4643: my $studentTable= 4644: &Apache::loncommon::start_data_table(). 4645: &Apache::loncommon::start_data_table_header_row(). 4646: '<th align="center"> '.&mt('Prob.').' </th>'. 4647: '<th> '.&mt('Title').' </th>'. 4648: '<th> '.&mt('Previous Score').' </th>'. 4649: '<th> '.&mt('New Score').' </th>'. 4650: &Apache::loncommon::end_data_table_header_row(); 4651: 4652: $iterator->next(); # skip the first BEGIN_MAP 4653: my $curRes = $iterator->next(); # for "current resource" 4654: my ($depth,$question,$prob,$changeflag)= (1,1,1,0); 4655: while ($depth > 0) { 4656: if($curRes == $iterator->BEGIN_MAP) { $depth++; } 4657: if($curRes == $iterator->END_MAP) { $depth--; } 4658: 4659: if (ref($curRes) && $curRes->is_problem()) { 4660: my $parts = $curRes->parts(); 4661: my $title = $curRes->compTitle(); 4662: my $symbx = $curRes->symb(); 4663: $studentTable.= 4664: &Apache::loncommon::start_data_table_row(). 4665: '<td align="center" valign="top" >'.$prob. 4666: (scalar(@{$parts}) == 1 ? '' 4667: : '<br />('.&mt('[quant,_1,part]',scalar(@{$parts})) 4668: .')').'</td>'; 4669: $studentTable.='<td valign="top"> <b>'.$title.'</b> </td>'; 4670: 4671: my %newrecord=(); 4672: my @displayPts=(); 4673: my %aggregate = (); 4674: my $aggregateflag = 0; 4675: foreach my $partid (@{$parts}) { 4676: my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid}; 4677: my $oldpts = $env{'form.oldpts'.$question.'_'.$partid}; 4678: 4679: my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? 4680: $env{'form.WGT'.$question.'_'.$partid} : 1; 4681: my $partial = $newpts/$wgt; 4682: my $score; 4683: if ($partial > 0) { 4684: $score = 'correct_by_override'; 4685: } elsif ($newpts ne '') { #empty is taken as 0 4686: $score = 'incorrect_by_override'; 4687: } 4688: my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid}; 4689: if ($dropMenu eq 'excused') { 4690: $partial = ''; 4691: $score = 'excused'; 4692: } elsif ($dropMenu eq 'reset status' 4693: && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists 4694: $newrecord{'resource.'.$partid.'.tries'} = 0; 4695: $newrecord{'resource.'.$partid.'.solved'} = ''; 4696: $newrecord{'resource.'.$partid.'.award'} = ''; 4697: $newrecord{'resource.'.$partid.'.awarded'} = 0; 4698: $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"; 4699: $changeflag++; 4700: $newpts = ''; 4701: 4702: my $aggtries = $env{'form.aggtries'.$question.'_'.$partid}; 4703: my $totaltries = $env{'form.totaltries'.$question.'_'.$partid}; 4704: my $solvedstatus = $env{'form.solved'.$question.'_'.$partid}; 4705: if ($aggtries > 0) { 4706: &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus); 4707: $aggregateflag = 1; 4708: } 4709: } 4710: my $display_part=&get_display_part($partid,$curRes->symb()); 4711: my $oldstatus = $env{'form.solved'.$question.'_'.$partid}; 4712: $displayPts[0].=' <b>'.&mt('Part').':</b> '.$display_part.' = '. 4713: (($oldstatus eq 'excused') ? 'excused' : $oldpts). 4714: ' <br />'; 4715: $displayPts[1].=' <b>'.&mt('Part').':</b> '.$display_part.' = '. 4716: (($score eq 'excused') ? 'excused' : $newpts). 4717: ' <br />'; 4718: $question++; 4719: next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); 4720: 4721: $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; 4722: $newrecord{'resource.'.$partid.'.solved'} = $score if $score ne ''; 4723: $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}" 4724: if (scalar(keys(%newrecord)) > 0); 4725: 4726: $changeflag++; 4727: } 4728: if (scalar(keys(%newrecord)) > 0) { 4729: my %record = 4730: &Apache::lonnet::restore($symbx,$env{'request.course.id'}, 4731: $udom,$uname); 4732: 4733: if (&Apache::lonnet::validCODE($env{'form.CODE'})) { 4734: $newrecord{'resource.CODE'} = $env{'form.CODE'}; 4735: } elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) { 4736: $newrecord{'resource.CODE'} = ''; 4737: } 4738: &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, 4739: $udom,$uname); 4740: %record = &Apache::lonnet::restore($symbx, 4741: $env{'request.course.id'}, 4742: $udom,$uname); 4743: &check_and_remove_from_queue($parts,\%record,undef,$symbx, 4744: $cdom,$cnum,$udom,$uname); 4745: } 4746: 4747: if ($aggregateflag) { 4748: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 4749: $env{'course.'.$env{'request.course.id'}.'.domain'}, 4750: $env{'course.'.$env{'request.course.id'}.'.num'}); 4751: } 4752: 4753: $studentTable.='<td valign="top">'.$displayPts[0].'</td>'. 4754: '<td valign="top">'.$displayPts[1].'</td>'. 4755: &Apache::loncommon::end_data_table_row(); 4756: 4757: $prob++; 4758: } 4759: $curRes = $iterator->next(); 4760: } 4761: 4762: $studentTable.=&Apache::loncommon::end_data_table(); 4763: my $grademsg=($changeflag == 0 ? &mt('No score was changed or updated.') : 4764: &mt('The scores were changed for [quant,_1,problem].', 4765: $changeflag)); 4766: $request->print($grademsg.$studentTable); 4767: 4768: return ''; 4769: } 4770: 4771: #-------- end of section for handling grading by page/sequence --------- 4772: # 4773: #------------------------------------------------------------------- 4774: 4775: #-------------------- Bubblesheet (Scantron) Grading ------------------- 4776: # 4777: #------ start of section for handling grading by page/sequence --------- 4778: 4779: =pod 4780: 4781: =head1 Bubble sheet grading routines 4782: 4783: For this documentation: 4784: 4785: 'scanline' refers to the full line of characters 4786: from the file that we are parsing that represents one entire sheet 4787: 4788: 'bubble line' refers to the data 4789: representing the line of bubbles that are on the physical bubble sheet 4790: 4791: 4792: The overall process is that a scanned in bubble sheet data is uploaded 4793: into a course. When a user wants to grade, they select a 4794: sequence/folder of resources, a file of bubble sheet info, and pick 4795: one of the predefined configurations for what each scanline looks 4796: like. 4797: 4798: Next each scanline is checked for any errors of either 'missing 4799: bubbles' (it's an error because it may have been mis-scanned 4800: because too light bubbling), 'double bubble' (each bubble line should 4801: have no more that one letter picked), invalid or duplicated CODE, 4802: invalid student/employee ID 4803: 4804: If the CODE option is used that determines the randomization of the 4805: homework problems, either way the student/employee ID is looked up into a 4806: username:domain. 4807: 4808: During the validation phase the instructor can choose to skip scanlines. 4809: 4810: After the validation phase, there are now 3 bubble sheet files 4811: 4812: scantron_original_filename (unmodified original file) 4813: scantron_corrected_filename (file where the corrected information has replaced the original information) 4814: scantron_skipped_filename (contains the exact text of scanlines that where skipped) 4815: 4816: Also there is a separate hash nohist_scantrondata that contains extra 4817: correction information that isn't representable in the bubble sheet 4818: file (see &scantron_getfile() for more information) 4819: 4820: After all scanlines are either valid, marked as valid or skipped, then 4821: foreach line foreach problem in the picked sequence, an ssi request is 4822: made that simulates a user submitting their selected letter(s) against 4823: the homework problem. 4824: 4825: =over 4 4826: 4827: 4828: 4829: =item defaultFormData 4830: 4831: Returns html hidden inputs used to hold context/default values. 4832: 4833: Arguments: 4834: $symb - $symb of the current resource 4835: 4836: =cut 4837: 4838: sub defaultFormData { 4839: my ($symb)=@_; 4840: return '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'; 4841: } 4842: 4843: 4844: =pod 4845: 4846: =item getSequenceDropDown 4847: 4848: Return html dropdown of possible sequences to grade 4849: 4850: Arguments: 4851: $symb - $symb of the current resource 4852: $map_error - ref to scalar which will container error if 4853: $navmap object is unavailable in &getSymbMap(). 4854: 4855: =cut 4856: 4857: sub getSequenceDropDown { 4858: my ($symb,$map_error)=@_; 4859: my $result='<select name="selectpage">'."\n"; 4860: my ($titles,$symbx) = &getSymbMap($map_error); 4861: if (ref($map_error)) { 4862: return if ($$map_error); 4863: } 4864: my ($curpage)=&Apache::lonnet::decode_symb($symb); 4865: my $ctr=0; 4866: foreach (@$titles) { 4867: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 4868: $result.='<option value="'.$$symbx{$_}.'" '. 4869: ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : ''). 4870: '>'.$showtitle.'</option>'."\n"; 4871: $ctr++; 4872: } 4873: $result.= '</select>'; 4874: return $result; 4875: } 4876: 4877: my %bubble_lines_per_response; # no. bubble lines for each response. 4878: # key is zero-based index - 0, 1, 2 ... 4879: 4880: my %first_bubble_line; # First bubble line no. for each bubble. 4881: 4882: my %subdivided_bubble_lines; # no. bubble lines for optionresponse, 4883: # matchresponse or rankresponse, where 4884: # an individual response can have multiple 4885: # lines 4886: 4887: my %responsetype_per_response; # responsetype for each response 4888: 4889: # Save and restore the bubble lines array to the form env. 4890: 4891: 4892: sub save_bubble_lines { 4893: foreach my $line (keys(%bubble_lines_per_response)) { 4894: $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; 4895: $env{"form.scantron.first_bubble_line.$line"} = 4896: $first_bubble_line{$line}; 4897: $env{"form.scantron.sub_bubblelines.$line"} = 4898: $subdivided_bubble_lines{$line}; 4899: $env{"form.scantron.responsetype.$line"} = 4900: $responsetype_per_response{$line}; 4901: } 4902: } 4903: 4904: 4905: sub restore_bubble_lines { 4906: my $line = 0; 4907: %bubble_lines_per_response = (); 4908: while ($env{"form.scantron.bubblelines.$line"}) { 4909: my $value = $env{"form.scantron.bubblelines.$line"}; 4910: $bubble_lines_per_response{$line} = $value; 4911: $first_bubble_line{$line} = 4912: $env{"form.scantron.first_bubble_line.$line"}; 4913: $subdivided_bubble_lines{$line} = 4914: $env{"form.scantron.sub_bubblelines.$line"}; 4915: $responsetype_per_response{$line} = 4916: $env{"form.scantron.responsetype.$line"}; 4917: $line++; 4918: } 4919: } 4920: 4921: # Given the parsed scanline, get the response for 4922: # 'answer' number n: 4923: 4924: sub get_response_bubbles { 4925: my ($parsed_line, $response) = @_; 4926: 4927: my $bubble_line = $first_bubble_line{$response-1} +1; 4928: my $bubble_lines= $bubble_lines_per_response{$response-1}; 4929: 4930: my $selected = ""; 4931: 4932: for (my $bline = 0; $bline < $bubble_lines; $bline++) { 4933: $selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; 4934: $bubble_line++; 4935: } 4936: return $selected; 4937: } 4938: 4939: =pod 4940: 4941: =item scantron_filenames 4942: 4943: Returns a list of the scantron files in the current course 4944: 4945: =cut 4946: 4947: sub scantron_filenames { 4948: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 4949: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 4950: my $getpropath = 1; 4951: my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, 4952: $getpropath); 4953: my @possiblenames; 4954: foreach my $filename (sort(@files)) { 4955: ($filename)=split(/&/,$filename); 4956: if ($filename!~/^scantron_orig_/) { next ; } 4957: $filename=~s/^scantron_orig_//; 4958: push(@possiblenames,$filename); 4959: } 4960: return @possiblenames; 4961: } 4962: 4963: =pod 4964: 4965: =item scantron_uploads 4966: 4967: Returns html drop-down list of scantron files in current course. 4968: 4969: Arguments: 4970: $file2grade - filename to set as selected in the dropdown 4971: 4972: =cut 4973: 4974: sub scantron_uploads { 4975: my ($file2grade) = @_; 4976: my $result= '<select name="scantron_selectfile">'; 4977: $result.="<option></option>"; 4978: foreach my $filename (sort(&scantron_filenames())) { 4979: $result.="<option".($filename eq $file2grade ? ' selected="selected"':'').">$filename</option>\n"; 4980: } 4981: $result.="</select>"; 4982: return $result; 4983: } 4984: 4985: =pod 4986: 4987: =item scantron_scantab 4988: 4989: Returns html drop down of the scantron formats in the scantronformat.tab 4990: file. 4991: 4992: =cut 4993: 4994: sub scantron_scantab { 4995: my $result='<select name="scantron_format">'."\n"; 4996: $result.='<option></option>'."\n"; 4997: my @lines = &get_scantronformat_file(); 4998: if (@lines > 0) { 4999: foreach my $line (@lines) { 5000: next if (($line =~ /^\#/) || ($line eq '')); 5001: my ($name,$descrip)=split(/:/,$line); 5002: $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n"; 5003: } 5004: } 5005: $result.='</select>'."\n"; 5006: return $result; 5007: } 5008: 5009: =pod 5010: 5011: =item get_scantronformat_file 5012: 5013: Returns an array containing lines from the scantron format file for 5014: the domain of the course. 5015: 5016: If a url for a custom.tab file is listed in domain's configuration.db, 5017: lines are from this file. 5018: 5019: Otherwise, if a default.tab has been published in RES space by the 5020: domainconfig user, lines are from this file. 5021: 5022: Otherwise, fall back to getting lines from the legacy file on the 5023: local server: /home/httpd/lonTabs/default_scantronformat.tab 5024: 5025: =cut 5026: 5027: sub get_scantronformat_file { 5028: my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; 5029: my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom); 5030: my $gottab = 0; 5031: my @lines; 5032: if (ref($domconfig{'scantron'}) eq 'HASH') { 5033: if ($domconfig{'scantron'}{'scantronformat'} ne '') { 5034: my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'}); 5035: if ($formatfile ne '-1') { 5036: @lines = split("\n",$formatfile,-1); 5037: $gottab = 1; 5038: } 5039: } 5040: } 5041: if (!$gottab) { 5042: my $confname = $cdom.'-domainconfig'; 5043: my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab'; 5044: my $formatfile = &Apache::lonnet::getfile($default); 5045: if ($formatfile ne '-1') { 5046: @lines = split("\n",$formatfile,-1); 5047: $gottab = 1; 5048: } 5049: } 5050: if (!$gottab) { 5051: my @domains = &Apache::lonnet::current_machine_domains(); 5052: if (grep(/^\Q$cdom\E$/,@domains)) { 5053: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); 5054: @lines = <$fh>; 5055: close($fh); 5056: } else { 5057: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab'); 5058: @lines = <$fh>; 5059: close($fh); 5060: } 5061: } 5062: return @lines; 5063: } 5064: 5065: =pod 5066: 5067: =item scantron_CODElist 5068: 5069: Returns html drop down of the saved CODE lists from current course, 5070: generated from earlier printings. 5071: 5072: =cut 5073: 5074: sub scantron_CODElist { 5075: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 5076: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 5077: my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum); 5078: my $namechoice='<option></option>'; 5079: foreach my $name (sort {uc($a) cmp uc($b)} @names) { 5080: if ($name =~ /^error: 2 /) { next; } 5081: if ($name =~ /^type\0/) { next; } 5082: $namechoice.='<option value="'.$name.'">'.$name.'</option>'; 5083: } 5084: $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>'; 5085: return $namechoice; 5086: } 5087: 5088: =pod 5089: 5090: =item scantron_CODEunique 5091: 5092: Returns the html for "Each CODE to be used once" radio. 5093: 5094: =cut 5095: 5096: sub scantron_CODEunique { 5097: my $result='<span class="LC_nobreak"> 5098: <label><input type="radio" name="scantron_CODEunique" 5099: value="yes" checked="checked" />'.&mt('Yes').' </label> 5100: </span> 5101: <span class="LC_nobreak"> 5102: <label><input type="radio" name="scantron_CODEunique" 5103: value="no" />'.&mt('No').' </label> 5104: </span>'; 5105: return $result; 5106: } 5107: 5108: =pod 5109: 5110: =item scantron_selectphase 5111: 5112: Generates the initial screen to start the bubble sheet process. 5113: Allows for - starting a grading run. 5114: - downloading existing scan data (original, corrected 5115: or skipped info) 5116: 5117: - uploading new scan data 5118: 5119: Arguments: 5120: $r - The Apache request object 5121: $file2grade - name of the file that contain the scanned data to score 5122: 5123: =cut 5124: 5125: sub scantron_selectphase { 5126: my ($r,$file2grade,$symb) = @_; 5127: if (!$symb) {return '';} 5128: my $map_error; 5129: my $sequence_selector=&getSequenceDropDown($symb,\$map_error); 5130: if ($map_error) { 5131: $r->print('<br />'.&navmap_errormsg().'<br />'); 5132: return; 5133: } 5134: my $default_form_data=&defaultFormData($symb); 5135: my $file_selector=&scantron_uploads($file2grade); 5136: my $format_selector=&scantron_scantab(); 5137: my $CODE_selector=&scantron_CODElist(); 5138: my $CODE_unique=&scantron_CODEunique(); 5139: my $result; 5140: 5141: $ssi_error = 0; 5142: 5143: if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || 5144: &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { 5145: 5146: # Chunk of form to prompt for a scantron file upload. 5147: 5148: $r->print(' 5149: <br /> 5150: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 5151: '.&Apache::loncommon::start_data_table_header_row().' 5152: <th> 5153:  '.&mt('Specify a bubblesheet data file to upload.').' 5154: </th> 5155: '.&Apache::loncommon::end_data_table_header_row().' 5156: '.&Apache::loncommon::start_data_table_row().' 5157: <td> 5158: '); 5159: my $default_form_data=&defaultFormData($symb); 5160: my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; 5161: my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'}; 5162: $r->print(&Apache::lonhtmlcommon::scripttag(' 5163: function checkUpload(formname) { 5164: if (formname.upfile.value == "") { 5165: alert("'.&mt('Please use the browse button to select a file from your local directory.').'"); 5166: return false; 5167: } 5168: formname.submit(); 5169: }')); 5170: $r->print(' 5171: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post"> 5172: '.$default_form_data.' 5173: <input name="courseid" type="hidden" value="'.$cnum.'" /> 5174: <input name="domainid" type="hidden" value="'.$cdom.'" /> 5175: <input name="command" value="scantronupload_save" type="hidden" /> 5176: '.&mt('File to upload: [_1]','<input type="file" name="upfile" size="50" />').' 5177: <br /> 5178: <input type="button" onclick="javascript:checkUpload(this.form);" value="'.&mt('Upload Bubblesheet Data').'" /> 5179: </form> 5180: '); 5181: 5182: $r->print(' 5183: </td> 5184: '.&Apache::loncommon::end_data_table_row().' 5185: '.&Apache::loncommon::end_data_table().' 5186: '); 5187: } 5188: 5189: # Chunk of form to prompt for a file to grade and how: 5190: 5191: $result.= ' 5192: <br /> 5193: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process"> 5194: <input type="hidden" name="command" value="scantron_warning" /> 5195: '.$default_form_data.' 5196: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 5197: '.&Apache::loncommon::start_data_table_header_row().' 5198: <th colspan="2"> 5199:  '.&mt('Specify file and which Folder/Sequence to grade').' 5200: </th> 5201: '.&Apache::loncommon::end_data_table_header_row().' 5202: '.&Apache::loncommon::start_data_table_row().' 5203: <td> '.&mt('Sequence to grade:').' </td><td> '.$sequence_selector.' </td> 5204: '.&Apache::loncommon::end_data_table_row().' 5205: '.&Apache::loncommon::start_data_table_row().' 5206: <td> '.&mt('Filename of bubblesheet data file:').' </td><td> '.$file_selector.' </td> 5207: '.&Apache::loncommon::end_data_table_row().' 5208: '.&Apache::loncommon::start_data_table_row().' 5209: <td> '.&mt('Format of bubblesheet data file:').' </td><td> '.$format_selector.' </td> 5210: '.&Apache::loncommon::end_data_table_row().' 5211: '.&Apache::loncommon::start_data_table_row().' 5212: <td> '.&mt('Saved CODEs to validate against:').' </td><td> '.$CODE_selector.' </td> 5213: '.&Apache::loncommon::end_data_table_row().' 5214: '.&Apache::loncommon::start_data_table_row().' 5215: <td> '.&mt('Each CODE is only to be used once:').'</td><td> '.$CODE_unique.' </td> 5216: '.&Apache::loncommon::end_data_table_row().' 5217: '.&Apache::loncommon::start_data_table_row().' 5218: <td> '.&mt('Options:').' </td> 5219: <td> 5220: <label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> '.&mt('Do only previously skipped records').'</label> <br /> 5221: <label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> '.&mt('Remove all existing corrections').'</label> <br /> 5222: <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources when grading').'</label> 5223: </td> 5224: '.&Apache::loncommon::end_data_table_row().' 5225: '.&Apache::loncommon::start_data_table_row().' 5226: <td colspan="2"> 5227: <input type="submit" value="'.&mt('Grading: Validate Bubblesheet Records').'" /> 5228: </td> 5229: '.&Apache::loncommon::end_data_table_row().' 5230: '.&Apache::loncommon::end_data_table().' 5231: </form> 5232: '; 5233: 5234: $r->print($result); 5235: 5236: 5237: 5238: # Chunk of the form that prompts to view a scoring office file, 5239: # corrected file, skipped records in a file. 5240: 5241: $r->print(' 5242: <br /> 5243: <form action="/adm/grades" name="scantron_download"> 5244: '.$default_form_data.' 5245: <input type="hidden" name="command" value="scantron_download" /> 5246: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 5247: '.&Apache::loncommon::start_data_table_header_row().' 5248: <th> 5249:  '.&mt('Download a scoring office file').' 5250: </th> 5251: '.&Apache::loncommon::end_data_table_header_row().' 5252: '.&Apache::loncommon::start_data_table_row().' 5253: <td> '.&mt('Filename of scoring office file: [_1]',$file_selector).' 5254: <br /> 5255: <input type="submit" value="'.&mt('Download: Show List of Associated Files').'" /> 5256: '.&Apache::loncommon::end_data_table_row().' 5257: '.&Apache::loncommon::end_data_table().' 5258: </form> 5259: <br /> 5260: '); 5261: 5262: &Apache::lonpickcode::code_list($r,2); 5263: 5264: $r->print('<br /><form method="post" name="checkscantron">'. 5265: $default_form_data."\n". 5266: &Apache::loncommon::start_data_table('LC_scantron_action')."\n". 5267: &Apache::loncommon::start_data_table_header_row()."\n". 5268: '<th colspan="2"> 5269:  '.&mt('Review bubblesheet data and submissions for a previously graded folder/sequence')."\n". 5270: '</th>'."\n". 5271: &Apache::loncommon::end_data_table_header_row()."\n". 5272: &Apache::loncommon::start_data_table_row()."\n". 5273: '<td> '.&mt('Graded folder/sequence:').' </td>'."\n". 5274: '<td> '.$sequence_selector.' </td>'. 5275: &Apache::loncommon::end_data_table_row()."\n". 5276: &Apache::loncommon::start_data_table_row()."\n". 5277: '<td> '.&mt('Filename of scoring office file:').' </td>'."\n". 5278: '<td> '.$file_selector.' </td>'."\n". 5279: &Apache::loncommon::end_data_table_row()."\n". 5280: &Apache::loncommon::start_data_table_row()."\n". 5281: '<td> '.&mt('Format of data file:').' </td>'."\n". 5282: '<td> '.$format_selector.' </td>'."\n". 5283: &Apache::loncommon::end_data_table_row()."\n". 5284: &Apache::loncommon::start_data_table_row()."\n". 5285: '<td> '.&mt('Options').' </td>'."\n". 5286: '<td> <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources').'</label></td>'. 5287: &Apache::loncommon::end_data_table_row()."\n". 5288: &Apache::loncommon::start_data_table_row()."\n". 5289: '<td colspan="2">'."\n". 5290: '<input type="hidden" name="command" value="checksubmissions" />'."\n". 5291: '<input type="submit" value="'.&mt('Review Bubblesheet Data and Submission Records').'" />'."\n". 5292: '</td>'."\n". 5293: &Apache::loncommon::end_data_table_row()."\n". 5294: &Apache::loncommon::end_data_table()."\n". 5295: '</form><br />'); 5296: return; 5297: } 5298: 5299: =pod 5300: 5301: =item get_scantron_config 5302: 5303: Parse and return the scantron configuration line selected as a 5304: hash of configuration file fields. 5305: 5306: Arguments: 5307: which - the name of the configuration to parse from the file. 5308: 5309: 5310: Returns: 5311: If the named configuration is not in the file, an empty 5312: hash is returned. 5313: a hash with the fields 5314: name - internal name for the this configuration setup 5315: description - text to display to operator that describes this config 5316: CODElocation - if 0 or the string 'none' 5317: - no CODE exists for this config 5318: if -1 || the string 'letter' 5319: - a CODE exists for this config and is 5320: a string of letters 5321: Unsupported value (but planned for future support) 5322: if a positive integer 5323: - The CODE exists as the first n items from 5324: the question section of the form 5325: if the string 'number' 5326: - The CODE exists for this config and is 5327: a string of numbers 5328: CODEstart - (only matter if a CODE exists) column in the line where 5329: the CODE starts 5330: CODElength - length of the CODE 5331: IDstart - column where the student/employee ID starts 5332: IDlength - length of the student/employee ID info 5333: Qstart - column where the information from the bubbled 5334: 'questions' start 5335: Qlength - number of columns comprising a single bubble line from 5336: the sheet. (usually either 1 or 10) 5337: Qon - either a single character representing the character used 5338: to signal a bubble was chosen in the positional setup, or 5339: the string 'letter' if the letter of the chosen bubble is 5340: in the final, or 'number' if a number representing the 5341: chosen bubble is in the file (1->A 0->J) 5342: Qoff - the character used to represent that a bubble was 5343: left blank 5344: PaperID - if the scanning process generates a unique number for each 5345: sheet scanned the column that this ID number starts in 5346: PaperIDlength - number of columns that comprise the unique ID number 5347: for the sheet of paper 5348: FirstName - column that the first name starts in 5349: FirstNameLength - number of columns that the first name spans 5350: 5351: LastName - column that the last name starts in 5352: LastNameLength - number of columns that the last name spans 5353: 5354: =cut 5355: 5356: sub get_scantron_config { 5357: my ($which) = @_; 5358: my @lines = &get_scantronformat_file(); 5359: my %config; 5360: #FIXME probably should move to XML it has already gotten a bit much now 5361: foreach my $line (@lines) { 5362: my ($name,$descrip)=split(/:/,$line); 5363: if ($name ne $which ) { next; } 5364: chomp($line); 5365: my @config=split(/:/,$line); 5366: $config{'name'}=$config[0]; 5367: $config{'description'}=$config[1]; 5368: $config{'CODElocation'}=$config[2]; 5369: $config{'CODEstart'}=$config[3]; 5370: $config{'CODElength'}=$config[4]; 5371: $config{'IDstart'}=$config[5]; 5372: $config{'IDlength'}=$config[6]; 5373: $config{'Qstart'}=$config[7]; 5374: $config{'Qlength'}=$config[8]; 5375: $config{'Qoff'}=$config[9]; 5376: $config{'Qon'}=$config[10]; 5377: $config{'PaperID'}=$config[11]; 5378: $config{'PaperIDlength'}=$config[12]; 5379: $config{'FirstName'}=$config[13]; 5380: $config{'FirstNamelength'}=$config[14]; 5381: $config{'LastName'}=$config[15]; 5382: $config{'LastNamelength'}=$config[16]; 5383: last; 5384: } 5385: return %config; 5386: } 5387: 5388: =pod 5389: 5390: =item username_to_idmap 5391: 5392: creates a hash keyed by student/employee ID with values of the corresponding 5393: student username:domain. 5394: 5395: Arguments: 5396: 5397: $classlist - reference to the class list hash. This is a hash 5398: keyed by student name:domain whose elements are references 5399: to arrays containing various chunks of information 5400: about the student. (See loncoursedata for more info). 5401: 5402: Returns 5403: %idmap - the constructed hash 5404: 5405: =cut 5406: 5407: sub username_to_idmap { 5408: my ($classlist)= @_; 5409: my %idmap; 5410: foreach my $student (keys(%$classlist)) { 5411: $idmap{$classlist->{$student}->[&Apache::loncoursedata::CL_ID]}= 5412: $student; 5413: } 5414: return %idmap; 5415: } 5416: 5417: =pod 5418: 5419: =item scantron_fixup_scanline 5420: 5421: Process a requested correction to a scanline. 5422: 5423: Arguments: 5424: $scantron_config - hash from &get_scantron_config() 5425: $scan_data - hash of correction information 5426: (see &scantron_getfile()) 5427: $line - existing scanline 5428: $whichline - line number of the passed in scanline 5429: $field - type of change to process 5430: (either 5431: 'ID' -> correct the student/employee ID 5432: 'CODE' -> correct the CODE 5433: 'answer' -> fixup the submitted answers) 5434: 5435: $args - hash of additional info, 5436: - 'ID' 5437: 'newid' -> studentID to use in replacement 5438: of existing one 5439: - 'CODE' 5440: 'CODE_ignore_dup' - set to true if duplicates 5441: should be ignored. 5442: 'CODE' - is new code or 'use_unfound' 5443: if the existing unfound code should 5444: be used as is 5445: - 'answer' 5446: 'response' - new answer or 'none' if blank 5447: 'question' - the bubble line to change 5448: 'questionnum' - the question identifier, 5449: may include subquestion. 5450: 5451: Returns: 5452: $line - the modified scanline 5453: 5454: Side effects: 5455: $scan_data - may be updated 5456: 5457: =cut 5458: 5459: 5460: sub scantron_fixup_scanline { 5461: my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; 5462: if ($field eq 'ID') { 5463: if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { 5464: return ($line,1,'New value too large'); 5465: } 5466: if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { 5467: $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', 5468: $args->{'newid'}); 5469: } 5470: substr($line,$$scantron_config{'IDstart'}-1, 5471: $$scantron_config{'IDlength'})=$args->{'newid'}; 5472: if ($args->{'newid'}=~/^\s*$/) { 5473: &scan_data($scan_data,"$whichline.user", 5474: $args->{'username'}.':'.$args->{'domain'}); 5475: } 5476: } elsif ($field eq 'CODE') { 5477: if ($args->{'CODE_ignore_dup'}) { 5478: &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); 5479: } 5480: &scan_data($scan_data,"$whichline.useCODE",'1'); 5481: if ($args->{'CODE'} ne 'use_unfound') { 5482: if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { 5483: return ($line,1,'New CODE value too large'); 5484: } 5485: if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) { 5486: $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'}); 5487: } 5488: substr($line,$$scantron_config{'CODEstart'}-1, 5489: $$scantron_config{'CODElength'})=$args->{'CODE'}; 5490: } 5491: } elsif ($field eq 'answer') { 5492: my $length=$scantron_config->{'Qlength'}; 5493: my $off=$scantron_config->{'Qoff'}; 5494: my $on=$scantron_config->{'Qon'}; 5495: my $answer=${off}x$length; 5496: if ($args->{'response'} eq 'none') { 5497: &scan_data($scan_data, 5498: "$whichline.no_bubble.".$args->{'questionnum'},'1'); 5499: } else { 5500: if ($on eq 'letter') { 5501: my @alphabet=('A'..'Z'); 5502: $answer=$alphabet[$args->{'response'}]; 5503: } elsif ($on eq 'number') { 5504: $answer=$args->{'response'}+1; 5505: if ($answer == 10) { $answer = '0'; } 5506: } else { 5507: substr($answer,$args->{'response'},1)=$on; 5508: } 5509: &scan_data($scan_data, 5510: "$whichline.no_bubble.".$args->{'questionnum'},undef,'1'); 5511: } 5512: my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; 5513: substr($line,$where-1,$length)=$answer; 5514: } 5515: return $line; 5516: } 5517: 5518: =pod 5519: 5520: =item scan_data 5521: 5522: Edit or look up an item in the scan_data hash. 5523: 5524: Arguments: 5525: $scan_data - The hash (see scantron_getfile) 5526: $key - shorthand of the key to edit (actual key is 5527: scantronfilename_key). 5528: $data - New value of the hash entry. 5529: $delete - If true, the entry is removed from the hash. 5530: 5531: Returns: 5532: The new value of the hash table field (undefined if deleted). 5533: 5534: =cut 5535: 5536: 5537: sub scan_data { 5538: my ($scan_data,$key,$value,$delete)=@_; 5539: my $filename=$env{'form.scantron_selectfile'}; 5540: if (defined($value)) { 5541: $scan_data->{$filename.'_'.$key} = $value; 5542: } 5543: if ($delete) { delete($scan_data->{$filename.'_'.$key}); } 5544: return $scan_data->{$filename.'_'.$key}; 5545: } 5546: 5547: # ----- These first few routines are general use routines.---- 5548: 5549: # Return the number of occurences of a pattern in a string. 5550: 5551: sub occurence_count { 5552: my ($string, $pattern) = @_; 5553: 5554: my @matches = ($string =~ /$pattern/g); 5555: 5556: return scalar(@matches); 5557: } 5558: 5559: 5560: # Take a string known to have digits and convert all the 5561: # digits into letters in the range J,A..I. 5562: 5563: sub digits_to_letters { 5564: my ($input) = @_; 5565: 5566: my @alphabet = ('J', 'A'..'I'); 5567: 5568: my @input = split(//, $input); 5569: my $output =''; 5570: for (my $i = 0; $i < scalar(@input); $i++) { 5571: if ($input[$i] =~ /\d/) { 5572: $output .= $alphabet[$input[$i]]; 5573: } else { 5574: $output .= $input[$i]; 5575: } 5576: } 5577: return $output; 5578: } 5579: 5580: =pod 5581: 5582: =item scantron_parse_scanline 5583: 5584: Decodes a scanline from the selected scantron file 5585: 5586: Arguments: 5587: line - The text of the scantron file line to process 5588: whichline - Line number 5589: scantron_config - Hash describing the format of the scantron lines. 5590: scan_data - Hash of extra information about the scanline 5591: (see scantron_getfile for more information) 5592: just_header - True if should not process question answers but only 5593: the stuff to the left of the answers. 5594: Returns: 5595: Hash containing the result of parsing the scanline 5596: 5597: Keys are all proceeded by the string 'scantron.' 5598: 5599: CODE - the CODE in use for this scanline 5600: useCODE - 1 if the CODE is invalid but it usage has been forced 5601: by the operator 5602: CODE_ignore_dup - 1 if the CODE is a duplicated use when unique 5603: CODEs were selected, but the usage has been 5604: forced by the operator 5605: ID - student/employee ID 5606: PaperID - if used, the ID number printed on the sheet when the 5607: paper was scanned 5608: FirstName - first name from the sheet 5609: LastName - last name from the sheet 5610: 5611: if just_header was not true these key may also exist 5612: 5613: missingerror - a list of bubble ranges that are considered to be answers 5614: to a single question that don't have any bubbles filled in. 5615: Of the form questionnumber:firstbubblenumber:count. 5616: doubleerror - a list of bubble ranges that are considered to be answers 5617: to a single question that have more than one bubble filled in. 5618: Of the form questionnumber::firstbubblenumber:count 5619: 5620: In the above, count is the number of bubble responses in the 5621: input line needed to represent the possible answers to the question. 5622: e.g. a radioresponse with 15 choices in an answer sheet with 10 choices 5623: per line would have count = 2. 5624: 5625: maxquest - the number of the last bubble line that was parsed 5626: 5627: (<number> starts at 1) 5628: <number>.answer - zero or more letters representing the selected 5629: letters from the scanline for the bubble line 5630: <number>. 5631: if blank there was either no bubble or there where 5632: multiple bubbles, (consult the keys missingerror and 5633: doubleerror if this is an error condition) 5634: 5635: =cut 5636: 5637: sub scantron_parse_scanline { 5638: my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_; 5639: 5640: my %record; 5641: my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'}; 5642: my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos); # Answers 5643: my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff 5644: if (!($$scantron_config{'CODElocation'} eq 0 || 5645: $$scantron_config{'CODElocation'} eq 'none')) { 5646: if ($$scantron_config{'CODElocation'} < 0 || 5647: $$scantron_config{'CODElocation'} eq 'letter' || 5648: $$scantron_config{'CODElocation'} eq 'number') { 5649: $record{'scantron.CODE'}=substr($data, 5650: $$scantron_config{'CODEstart'}-1, 5651: $$scantron_config{'CODElength'}); 5652: if (&scan_data($scan_data,"$whichline.useCODE")) { 5653: $record{'scantron.useCODE'}=1; 5654: } 5655: if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) { 5656: $record{'scantron.CODE_ignore_dup'}=1; 5657: } 5658: } else { 5659: #FIXME interpret first N questions 5660: } 5661: } 5662: $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, 5663: $$scantron_config{'IDlength'}); 5664: $record{'scantron.PaperID'}= 5665: substr($data,$$scantron_config{'PaperID'}-1, 5666: $$scantron_config{'PaperIDlength'}); 5667: $record{'scantron.FirstName'}= 5668: substr($data,$$scantron_config{'FirstName'}-1, 5669: $$scantron_config{'FirstNamelength'}); 5670: $record{'scantron.LastName'}= 5671: substr($data,$$scantron_config{'LastName'}-1, 5672: $$scantron_config{'LastNamelength'}); 5673: if ($just_header) { return \%record; } 5674: 5675: my @alphabet=('A'..'Z'); 5676: my $questnum=0; 5677: my $ansnum =1; # Multiple 'answer lines'/question. 5678: 5679: chomp($questions); # Get rid of any trailing \n. 5680: $questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads). 5681: while (length($questions)) { 5682: my $answers_needed = $bubble_lines_per_response{$questnum}; 5683: my $answer_length = ($$scantron_config{'Qlength'} * $answers_needed) 5684: || 1; 5685: $questnum++; 5686: my $quest_id = $questnum; 5687: my $currentquest = substr($questions,0,$answer_length); 5688: $questions = substr($questions,$answer_length); 5689: if (length($currentquest) < $answer_length) { next; } 5690: 5691: if ($subdivided_bubble_lines{$questnum-1} =~ /,/) { 5692: my $subquestnum = 1; 5693: my $subquestions = $currentquest; 5694: my @subanswers_needed = 5695: split(/,/,$subdivided_bubble_lines{$questnum-1}); 5696: foreach my $subans (@subanswers_needed) { 5697: my $subans_length = 5698: ($$scantron_config{'Qlength'} * $subans) || 1; 5699: my $currsubquest = substr($subquestions,0,$subans_length); 5700: $subquestions = substr($subquestions,$subans_length); 5701: $quest_id = "$questnum.$subquestnum"; 5702: if (($$scantron_config{'Qon'} eq 'letter') || 5703: ($$scantron_config{'Qon'} eq 'number')) { 5704: $ansnum = &scantron_validator_lettnum($ansnum, 5705: $questnum,$quest_id,$subans,$currsubquest,$whichline, 5706: \@alphabet,\%record,$scantron_config,$scan_data); 5707: } else { 5708: $ansnum = &scantron_validator_positional($ansnum, 5709: $questnum,$quest_id,$subans,$currsubquest,$whichline, \@alphabet,\%record,$scantron_config,$scan_data); 5710: } 5711: $subquestnum ++; 5712: } 5713: } else { 5714: if (($$scantron_config{'Qon'} eq 'letter') || 5715: ($$scantron_config{'Qon'} eq 'number')) { 5716: $ansnum = &scantron_validator_lettnum($ansnum,$questnum, 5717: $quest_id,$answers_needed,$currentquest,$whichline, 5718: \@alphabet,\%record,$scantron_config,$scan_data); 5719: } else { 5720: $ansnum = &scantron_validator_positional($ansnum,$questnum, 5721: $quest_id,$answers_needed,$currentquest,$whichline, 5722: \@alphabet,\%record,$scantron_config,$scan_data); 5723: } 5724: } 5725: } 5726: $record{'scantron.maxquest'}=$questnum; 5727: return \%record; 5728: } 5729: 5730: sub scantron_validator_lettnum { 5731: my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline, 5732: $alphabet,$record,$scantron_config,$scan_data) = @_; 5733: 5734: # Qon 'letter' implies for each slot in currquest we have: 5735: # ? or * for doubles, a letter in A-Z for a bubble, and 5736: # about anything else (esp. a value of Qoff) for missing 5737: # bubbles. 5738: # 5739: # Qon 'number' implies each slot gives a digit that indexes the 5740: # bubbles filled, or Qoff, or a non-number for unbubbled lines, 5741: # and * or ? for double bubbles on a single line. 5742: # 5743: 5744: my $matchon; 5745: if ($$scantron_config{'Qon'} eq 'letter') { 5746: $matchon = '[A-Z]'; 5747: } elsif ($$scantron_config{'Qon'} eq 'number') { 5748: $matchon = '\d'; 5749: } 5750: my $occurrences = 0; 5751: if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || 5752: ($responsetype_per_response{$questnum-1} eq 'formularesponse') || 5753: ($responsetype_per_response{$questnum-1} eq 'stringresponse') || 5754: ($responsetype_per_response{$questnum-1} eq 'imageresponse') || 5755: ($responsetype_per_response{$questnum-1} eq 'reactionresponse') || 5756: ($responsetype_per_response{$questnum-1} eq 'organicresponse')) { 5757: my @singlelines = split('',$currquest); 5758: foreach my $entry (@singlelines) { 5759: $occurrences = &occurence_count($entry,$matchon); 5760: if ($occurrences > 1) { 5761: last; 5762: } 5763: } 5764: } else { 5765: $occurrences = &occurence_count($currquest,$matchon); 5766: } 5767: if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) { 5768: push(@{$record->{'scantron.doubleerror'}},$quest_id); 5769: for (my $ans=0; $ans<$answers_needed; $ans++) { 5770: my $bubble = substr($currquest,$ans,1); 5771: if ($bubble =~ /$matchon/ ) { 5772: if ($$scantron_config{'Qon'} eq 'number') { 5773: if ($bubble == 0) { 5774: $bubble = 10; 5775: } 5776: $record->{"scantron.$ansnum.answer"} = 5777: $alphabet->[$bubble-1]; 5778: } else { 5779: $record->{"scantron.$ansnum.answer"} = $bubble; 5780: } 5781: } else { 5782: $record->{"scantron.$ansnum.answer"}=''; 5783: } 5784: $ansnum++; 5785: } 5786: } elsif (!defined($currquest) 5787: || (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest)) 5788: || (&occurence_count($currquest,$matchon) == 0)) { 5789: for (my $ans=0; $ans<$answers_needed; $ans++ ) { 5790: $record->{"scantron.$ansnum.answer"}=''; 5791: $ansnum++; 5792: } 5793: if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { 5794: push(@{$record->{'scantron.missingerror'}},$quest_id); 5795: } 5796: } else { 5797: if ($$scantron_config{'Qon'} eq 'number') { 5798: $currquest = &digits_to_letters($currquest); 5799: } 5800: for (my $ans=0; $ans<$answers_needed; $ans++) { 5801: my $bubble = substr($currquest,$ans,1); 5802: $record->{"scantron.$ansnum.answer"} = $bubble; 5803: $ansnum++; 5804: } 5805: } 5806: return $ansnum; 5807: } 5808: 5809: sub scantron_validator_positional { 5810: my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest, 5811: $whichline,$alphabet,$record,$scantron_config,$scan_data) = @_; 5812: 5813: # Otherwise there's a positional notation; 5814: # each bubble line requires Qlength items, and there are filled in 5815: # bubbles for each case where there 'Qon' characters. 5816: # 5817: 5818: my @array=split($$scantron_config{'Qon'},$currquest,-1); 5819: 5820: # If the split only gives us one element.. the full length of the 5821: # answer string, no bubbles are filled in: 5822: 5823: if ($answers_needed eq '') { 5824: return; 5825: } 5826: 5827: if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { 5828: for (my $ans=0; $ans<$answers_needed; $ans++ ) { 5829: $record->{"scantron.$ansnum.answer"}=''; 5830: $ansnum++; 5831: } 5832: if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { 5833: push(@{$record->{"scantron.missingerror"}},$quest_id); 5834: } 5835: } elsif (scalar(@array) == 2) { 5836: my $location = length($array[0]); 5837: my $line_num = int($location / $$scantron_config{'Qlength'}); 5838: my $bubble = $alphabet->[$location % $$scantron_config{'Qlength'}]; 5839: for (my $ans=0; $ans<$answers_needed; $ans++) { 5840: if ($ans eq $line_num) { 5841: $record->{"scantron.$ansnum.answer"} = $bubble; 5842: } else { 5843: $record->{"scantron.$ansnum.answer"} = ' '; 5844: } 5845: $ansnum++; 5846: } 5847: } else { 5848: # If there's more than one instance of a bubble character 5849: # That's a double bubble; with positional notation we can 5850: # record all the bubbles filled in as well as the 5851: # fact this response consists of multiple bubbles. 5852: # 5853: if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || 5854: ($responsetype_per_response{$questnum-1} eq 'formularesponse') || 5855: ($responsetype_per_response{$questnum-1} eq 'stringresponse') || 5856: ($responsetype_per_response{$questnum-1} eq 'imageresponse') || 5857: ($responsetype_per_response{$questnum-1} eq 'reactionresponse') || 5858: ($responsetype_per_response{$questnum-1} eq 'organicresponse')) { 5859: my $doubleerror = 0; 5860: while (($currquest >= $$scantron_config{'Qlength'}) && 5861: (!$doubleerror)) { 5862: my $currline = substr($currquest,0,$$scantron_config{'Qlength'}); 5863: $currquest = substr($currquest,$$scantron_config{'Qlength'}); 5864: my @currarray = split($$scantron_config{'Qon'},$currline,-1); 5865: if (length(@currarray) > 2) { 5866: $doubleerror = 1; 5867: } 5868: } 5869: if ($doubleerror) { 5870: push(@{$record->{'scantron.doubleerror'}},$quest_id); 5871: } 5872: } else { 5873: push(@{$record->{'scantron.doubleerror'}},$quest_id); 5874: } 5875: my $item = $ansnum; 5876: for (my $ans=0; $ans<$answers_needed; $ans++) { 5877: $record->{"scantron.$item.answer"} = ''; 5878: $item ++; 5879: } 5880: 5881: my @ans=@array; 5882: my $i=0; 5883: my $increment = 0; 5884: while ($#ans) { 5885: $i+=length($ans[0]) + $increment; 5886: my $line = int($i/$$scantron_config{'Qlength'} + $ansnum); 5887: my $bubble = $i%$$scantron_config{'Qlength'}; 5888: $record->{"scantron.$line.answer"}.=$alphabet->[$bubble]; 5889: shift(@ans); 5890: $increment = 1; 5891: } 5892: $ansnum += $answers_needed; 5893: } 5894: return $ansnum; 5895: } 5896: 5897: =pod 5898: 5899: =item scantron_add_delay 5900: 5901: Adds an error message that occurred during the grading phase to a 5902: queue of messages to be shown after grading pass is complete 5903: 5904: Arguments: 5905: $delayqueue - arrary ref of hash ref of error messages 5906: $scanline - the scanline that caused the error 5907: $errormesage - the error message 5908: $errorcode - a numeric code for the error 5909: 5910: Side Effects: 5911: updates the $delayqueue to have a new hash ref of the error 5912: 5913: =cut 5914: 5915: sub scantron_add_delay { 5916: my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; 5917: push(@$delayqueue, 5918: {'line' => $scanline, 'emsg' => $errormessage, 5919: 'ecode' => $errorcode } 5920: ); 5921: } 5922: 5923: =pod 5924: 5925: =item scantron_find_student 5926: 5927: Finds the username for the current scanline 5928: 5929: Arguments: 5930: $scantron_record - hash result from scantron_parse_scanline 5931: $scan_data - hash of correction information 5932: (see &scantron_getfile() form more information) 5933: $idmap - hash from &username_to_idmap() 5934: $line - number of current scanline 5935: 5936: Returns: 5937: Either 'username:domain' or undef if unknown 5938: 5939: =cut 5940: 5941: sub scantron_find_student { 5942: my ($scantron_record,$scan_data,$idmap,$line)=@_; 5943: my $scanID=$$scantron_record{'scantron.ID'}; 5944: if ($scanID =~ /^\s*$/) { 5945: return &scan_data($scan_data,"$line.user"); 5946: } 5947: foreach my $id (keys(%$idmap)) { 5948: if (lc($id) eq lc($scanID)) { 5949: return $$idmap{$id}; 5950: } 5951: } 5952: return undef; 5953: } 5954: 5955: =pod 5956: 5957: =item scantron_filter 5958: 5959: Filter sub for lonnavmaps, filters out hidden resources if ignore 5960: hidden resources was selected 5961: 5962: =cut 5963: 5964: sub scantron_filter { 5965: my ($curres)=@_; 5966: 5967: if (ref($curres) && $curres->is_problem()) { 5968: # if the user has asked to not have either hidden 5969: # or 'randomout' controlled resources to be graded 5970: # don't include them 5971: if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' 5972: && $curres->randomout) { 5973: return 0; 5974: } 5975: return 1; 5976: } 5977: return 0; 5978: } 5979: 5980: =pod 5981: 5982: =item scantron_process_corrections 5983: 5984: Gets correction information out of submitted form data and corrects 5985: the scanline 5986: 5987: =cut 5988: 5989: sub scantron_process_corrections { 5990: my ($r) = @_; 5991: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 5992: my ($scanlines,$scan_data)=&scantron_getfile(); 5993: my $classlist=&Apache::loncoursedata::get_classlist(); 5994: my $which=$env{'form.scantron_line'}; 5995: my $line=&scantron_get_line($scanlines,$scan_data,$which); 5996: my ($skip,$err,$errmsg); 5997: if ($env{'form.scantron_skip_record'}) { 5998: $skip=1; 5999: } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { 6000: my $newstudent=$env{'form.scantron_username'}.':'. 6001: $env{'form.scantron_domain'}; 6002: my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; 6003: ($line,$err,$errmsg)= 6004: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 6005: 'ID',{'newid'=>$newid, 6006: 'username'=>$env{'form.scantron_username'}, 6007: 'domain'=>$env{'form.scantron_domain'}}); 6008: } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { 6009: my $resolution=$env{'form.scantron_CODE_resolution'}; 6010: my $newCODE; 6011: my %args; 6012: if ($resolution eq 'use_unfound') { 6013: $newCODE='use_unfound'; 6014: } elsif ($resolution eq 'use_found') { 6015: $newCODE=$env{'form.scantron_CODE_selectedvalue'}; 6016: } elsif ($resolution eq 'use_typed') { 6017: $newCODE=$env{'form.scantron_CODE_newvalue'}; 6018: } elsif ($resolution =~ /^use_closest_(\d+)/) { 6019: $newCODE=$env{"form.scantron_CODE_closest_$1"}; 6020: } 6021: if ($env{'form.scantron_corrections'} eq 'duplicateCODE') { 6022: $args{'CODE_ignore_dup'}=1; 6023: } 6024: $args{'CODE'}=$newCODE; 6025: ($line,$err,$errmsg)= 6026: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 6027: 'CODE',\%args); 6028: } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { 6029: foreach my $question (split(',',$env{'form.scantron_questions'})) { 6030: ($line,$err,$errmsg)= 6031: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, 6032: $which,'answer', 6033: { 'question'=>$question, 6034: 'response'=>$env{"form.scantron_correct_Q_$question"}, 6035: 'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}}); 6036: if ($err) { last; } 6037: } 6038: } 6039: if ($err) { 6040: $r->print("<span class=\"LC_warning\">Unable to accept last correction, an error occurred :$errmsg:</span>"); 6041: } else { 6042: &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); 6043: &scantron_putfile($scanlines,$scan_data); 6044: } 6045: } 6046: 6047: =pod 6048: 6049: =item reset_skipping_status 6050: 6051: Forgets the current set of remember skipped scanlines (and thus 6052: reverts back to considering all lines in the 6053: scantron_skipped_<filename> file) 6054: 6055: =cut 6056: 6057: sub reset_skipping_status { 6058: my ($scanlines,$scan_data)=&scantron_getfile(); 6059: &scan_data($scan_data,'remember_skipping',undef,1); 6060: &scantron_putfile(undef,$scan_data); 6061: } 6062: 6063: =pod 6064: 6065: =item start_skipping 6066: 6067: Marks a scanline to be skipped. 6068: 6069: =cut 6070: 6071: sub start_skipping { 6072: my ($scan_data,$i)=@_; 6073: my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); 6074: if ($env{'form.scantron_options_redo'} =~ /^redo_/) { 6075: $remembered{$i}=2; 6076: } else { 6077: $remembered{$i}=1; 6078: } 6079: &scan_data($scan_data,'remember_skipping',join(':',%remembered)); 6080: } 6081: 6082: =pod 6083: 6084: =item should_be_skipped 6085: 6086: Checks whether a scanline should be skipped. 6087: 6088: =cut 6089: 6090: sub should_be_skipped { 6091: my ($scanlines,$scan_data,$i)=@_; 6092: if ($env{'form.scantron_options_redo'} !~ /^redo_/) { 6093: # not redoing old skips 6094: if ($scanlines->{'skipped'}[$i]) { return 1; } 6095: return 0; 6096: } 6097: my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); 6098: 6099: if (exists($remembered{$i}) && $remembered{$i} != 2 ) { 6100: return 0; 6101: } 6102: return 1; 6103: } 6104: 6105: =pod 6106: 6107: =item remember_current_skipped 6108: 6109: Discovers what scanlines are in the scantron_skipped_<filename> 6110: file and remembers them into scan_data for later use. 6111: 6112: =cut 6113: 6114: sub remember_current_skipped { 6115: my ($scanlines,$scan_data)=&scantron_getfile(); 6116: my %to_remember; 6117: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 6118: if ($scanlines->{'skipped'}[$i]) { 6119: $to_remember{$i}=1; 6120: } 6121: } 6122: 6123: &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); 6124: &scantron_putfile(undef,$scan_data); 6125: } 6126: 6127: =pod 6128: 6129: =item check_for_error 6130: 6131: Checks if there was an error when attempting to remove a specific 6132: scantron_.. bubble sheet data file. Prints out an error if 6133: something went wrong. 6134: 6135: =cut 6136: 6137: sub check_for_error { 6138: my ($r,$result)=@_; 6139: if ($result ne 'ok' && $result ne 'not_found' ) { 6140: $r->print(&mt("An error occurred ([_1]) when trying to remove the existing corrections.",$result)); 6141: } 6142: } 6143: 6144: =pod 6145: 6146: =item scantron_warning_screen 6147: 6148: Interstitial screen to make sure the operator has selected the 6149: correct options before we start the validation phase. 6150: 6151: =cut 6152: 6153: sub scantron_warning_screen { 6154: my ($button_text)=@_; 6155: my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); 6156: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6157: my $CODElist; 6158: if ($scantron_config{'CODElocation'} && 6159: $scantron_config{'CODEstart'} && 6160: $scantron_config{'CODElength'}) { 6161: $CODElist=$env{'form.scantron_CODElist'}; 6162: if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">None</span>'; } 6163: $CODElist= 6164: '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'. 6165: $env{'form.scantron_CODElist'}.'</tt></td></tr>'; 6166: } 6167: return (' 6168: <p> 6169: <span class="LC_warning"> 6170: '.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).'</span> 6171: </p> 6172: <table> 6173: <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr> 6174: <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr> 6175: '.$CODElist.' 6176: </table> 6177: <br /> 6178: <p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p> 6179: <p> '.&mt('If something is incorrect, please click the \'Grading Menu\' button to start over.').'</p> 6180: 6181: <br /> 6182: '); 6183: } 6184: 6185: =pod 6186: 6187: =item scantron_do_warning 6188: 6189: Check if the operator has picked something for all required 6190: fields. Error out if something is missing. 6191: 6192: =cut 6193: 6194: sub scantron_do_warning { 6195: my ($r,$symb)=@_; 6196: if (!$symb) {return '';} 6197: my $default_form_data=&defaultFormData($symb); 6198: $r->print(&scantron_form_start().$default_form_data); 6199: if ( $env{'form.selectpage'} eq '' || 6200: $env{'form.scantron_selectfile'} eq '' || 6201: $env{'form.scantron_format'} eq '' ) { 6202: $r->print("<p>".&mt('You have forgotten to specify some information. Please go Back and try again.')."</p>"); 6203: if ( $env{'form.selectpage'} eq '') { 6204: $r->print('<p><span class="LC_error">'.&mt('You have not selected a Sequence to grade').'</span></p>'); 6205: } 6206: if ( $env{'form.scantron_selectfile'} eq '') { 6207: $r->print('<p><span class="LC_error">'.&mt("You have not selected a file that contains the student's response data.").'</span></p>'); 6208: } 6209: if ( $env{'form.scantron_format'} eq '') { 6210: $r->print('<p><span class="LC_error">'.&mt("You have not selected the format of the student's response data.").'</span></p>'); 6211: } 6212: } else { 6213: my $warning=&scantron_warning_screen('Grading: Validate Records'); 6214: $r->print(' 6215: '.$warning.' 6216: <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" /> 6217: <input type="hidden" name="command" value="scantron_validate" /> 6218: '); 6219: } 6220: $r->print("</form><br />"); 6221: return ''; 6222: } 6223: 6224: =pod 6225: 6226: =item scantron_form_start 6227: 6228: html hidden input for remembering all selected grading options 6229: 6230: =cut 6231: 6232: sub scantron_form_start { 6233: my ($max_bubble)=@_; 6234: my $result= <<SCANTRONFORM; 6235: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> 6236: <input type="hidden" name="selectpage" value="$env{'form.selectpage'}" /> 6237: <input type="hidden" name="scantron_format" value="$env{'form.scantron_format'}" /> 6238: <input type="hidden" name="scantron_selectfile" value="$env{'form.scantron_selectfile'}" /> 6239: <input type="hidden" name="scantron_maxbubble" value="$max_bubble" /> 6240: <input type="hidden" name="scantron_CODElist" value="$env{'form.scantron_CODElist'}" /> 6241: <input type="hidden" name="scantron_CODEunique" value="$env{'form.scantron_CODEunique'}" /> 6242: <input type="hidden" name="scantron_options_redo" value="$env{'form.scantron_options_redo'}" /> 6243: <input type="hidden" name="scantron_options_ignore" value="$env{'form.scantron_options_ignore'}" /> 6244: <input type="hidden" name="scantron_options_hidden" value="$env{'form.scantron_options_hidden'}" /> 6245: SCANTRONFORM 6246: 6247: my $line = 0; 6248: while (defined($env{"form.scantron.bubblelines.$line"})) { 6249: my $chunk = 6250: '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n"; 6251: $chunk .= 6252: '<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n"; 6253: $chunk .= 6254: '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n"; 6255: $chunk .= 6256: '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n"; 6257: $result .= $chunk; 6258: $line++; 6259: } 6260: return $result; 6261: } 6262: 6263: =pod 6264: 6265: =item scantron_validate_file 6266: 6267: Dispatch routine for doing validation of a bubble sheet data file. 6268: 6269: Also processes any necessary information resets that need to 6270: occur before validation begins (ignore previous corrections, 6271: restarting the skipped records processing) 6272: 6273: =cut 6274: 6275: sub scantron_validate_file { 6276: my ($r,$symb) = @_; 6277: if (!$symb) {return '';} 6278: my $default_form_data=&defaultFormData($symb); 6279: 6280: # do the detection of only doing skipped records first befroe we delete 6281: # them when doing the corrections reset 6282: if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') { 6283: &reset_skipping_status(); 6284: } 6285: if ($env{'form.scantron_options_redo'} eq 'redo_skipped') { 6286: &remember_current_skipped(); 6287: $env{'form.scantron_options_redo'}='redo_skipped_ready'; 6288: } 6289: 6290: if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') { 6291: &check_for_error($r,&scantron_remove_file('corrected')); 6292: &check_for_error($r,&scantron_remove_file('skipped')); 6293: &check_for_error($r,&scantron_remove_scan_data()); 6294: $env{'form.scantron_options_ignore'}='done'; 6295: } 6296: 6297: if ($env{'form.scantron_corrections'}) { 6298: &scantron_process_corrections($r); 6299: } 6300: $r->print('<p>'.&mt('Gathering necessary information.').'</p>');$r->rflush(); 6301: #get the student pick code ready 6302: $r->print(&Apache::loncommon::studentbrowser_javascript()); 6303: my $nav_error; 6304: my $max_bubble=&scantron_get_maxbubble(\$nav_error); 6305: if ($nav_error) { 6306: $r->print(&navmap_errormsg()); 6307: return ''; 6308: } 6309: my $result=&scantron_form_start($max_bubble).$default_form_data; 6310: $r->print($result); 6311: 6312: my @validate_phases=( 'sequence', 6313: 'ID', 6314: 'CODE', 6315: 'doublebubble', 6316: 'missingbubbles'); 6317: if (!$env{'form.validatepass'}) { 6318: $env{'form.validatepass'} = 0; 6319: } 6320: my $currentphase=$env{'form.validatepass'}; 6321: 6322: 6323: my $stop=0; 6324: while (!$stop && $currentphase < scalar(@validate_phases)) { 6325: $r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />'); 6326: $r->rflush(); 6327: my $which="scantron_validate_".$validate_phases[$currentphase]; 6328: { 6329: no strict 'refs'; 6330: ($stop,$currentphase)=&$which($r,$currentphase); 6331: } 6332: } 6333: if (!$stop) { 6334: my $warning=&scantron_warning_screen('Start Grading'); 6335: $r->print(&mt('Validation process complete.').'<br />'. 6336: $warning. 6337: &mt('Perform verification for each student after storage of submissions?'). 6338: ' <span class="LC_nobreak"><label>'. 6339: '<input type="radio" name="verifyrecord" value="1" />'.&mt('Yes').'</label>'. 6340: (' 'x3).'<label>'. 6341: '<input type="radio" name="verifyrecord" value="0" checked="checked" />'.&mt('No'). 6342: '</label></span><br />'. 6343: &mt('Grading will take longer if you use verification.').'<br />'. 6344: &mt("Alternatively, the 'Review bubblesheet data' utility (see grading menu) can be used for all students after grading is complete.").'<br /><br />'. 6345: '<input type="submit" name="submit" value="'.&mt('Start Grading').'" />'. 6346: '<input type="hidden" name="command" value="scantron_process" />'."\n"); 6347: } else { 6348: $r->print('<input type="hidden" name="command" value="scantron_validate" />'); 6349: $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />"); 6350: } 6351: if ($stop) { 6352: if ($validate_phases[$currentphase] eq 'sequence') { 6353: $r->print('<input type="submit" name="submit" value="'.&mt('Ignore').' → " />'); 6354: $r->print(' '.&mt('this error').' <br />'); 6355: 6356: $r->print(" <p>".&mt("Or click the 'Grading Menu' button to start over.")."</p>"); 6357: } else { 6358: if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') { 6359: $r->print('<input type="button" name="submitbutton" value="'.&mt('Continue').' →" onclick="javascript:verify_bubble_radio(this.form)" />'); 6360: } else { 6361: $r->print('<input type="submit" name="submit" value="'.&mt('Continue').' →" />'); 6362: } 6363: $r->print(' '.&mt('using corrected info').' <br />'); 6364: $r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />"); 6365: $r->print(" ".&mt("this scanline saving it for later.")); 6366: } 6367: } 6368: $r->print(" </form><br />"); 6369: return ''; 6370: } 6371: 6372: 6373: =pod 6374: 6375: =item scantron_remove_file 6376: 6377: Removes the requested bubble sheet data file, makes sure that 6378: scantron_original_<filename> is never removed 6379: 6380: 6381: =cut 6382: 6383: sub scantron_remove_file { 6384: my ($which)=@_; 6385: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6386: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6387: my $file='scantron_'; 6388: if ($which eq 'corrected' || $which eq 'skipped') { 6389: $file.=$which.'_'; 6390: } else { 6391: return 'refused'; 6392: } 6393: $file.=$env{'form.scantron_selectfile'}; 6394: return &Apache::lonnet::removeuserfile($cname,$cdom,$file); 6395: } 6396: 6397: 6398: =pod 6399: 6400: =item scantron_remove_scan_data 6401: 6402: Removes all scan_data correction for the requested bubble sheet 6403: data file. (In the case that both the are doing skipped records we need 6404: to remember the old skipped lines for the time being so that element 6405: persists for a while.) 6406: 6407: =cut 6408: 6409: sub scantron_remove_scan_data { 6410: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6411: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6412: my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname); 6413: my @todelete; 6414: my $filename=$env{'form.scantron_selectfile'}; 6415: foreach my $key (@keys) { 6416: if ($key=~/^\Q$filename\E_/) { 6417: if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' && 6418: $key=~/remember_skipping/) { 6419: next; 6420: } 6421: push(@todelete,$key); 6422: } 6423: } 6424: my $result; 6425: if (@todelete) { 6426: $result = &Apache::lonnet::del('nohist_scantrondata', 6427: \@todelete,$cdom,$cname); 6428: } else { 6429: $result = 'ok'; 6430: } 6431: return $result; 6432: } 6433: 6434: 6435: =pod 6436: 6437: =item scantron_getfile 6438: 6439: Fetches the requested bubble sheet data file (all 3 versions), and 6440: the scan_data hash 6441: 6442: Arguments: 6443: None 6444: 6445: Returns: 6446: 2 hash references 6447: 6448: - first one has 6449: orig - 6450: corrected - 6451: skipped - each of which points to an array ref of the specified 6452: file broken up into individual lines 6453: count - number of scanlines 6454: 6455: - second is the scan_data hash possible keys are 6456: ($number refers to scanline numbered $number and thus the key affects 6457: only that scanline 6458: $bubline refers to the specific bubble line element and the aspects 6459: refers to that specific bubble line element) 6460: 6461: $number.user - username:domain to use 6462: $number.CODE_ignore_dup 6463: - ignore the duplicate CODE error 6464: $number.useCODE 6465: - use the CODE in the scanline as is 6466: $number.no_bubble.$bubline 6467: - it is valid that there is no bubbled in bubble 6468: at $number $bubline 6469: remember_skipping 6470: - a frozen hash containing keys of $number and values 6471: of either 6472: 1 - we are on a 'do skipped records pass' and plan 6473: on processing this line 6474: 2 - we are on a 'do skipped records pass' and this 6475: scanline has been marked to skip yet again 6476: 6477: =cut 6478: 6479: sub scantron_getfile { 6480: #FIXME really would prefer a scantron directory 6481: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6482: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6483: my $lines; 6484: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 6485: 'scantron_orig_'.$env{'form.scantron_selectfile'}); 6486: my %scanlines; 6487: $scanlines{'orig'}=[(split("\n",$lines,-1))]; 6488: my $temp=$scanlines{'orig'}; 6489: $scanlines{'count'}=$#$temp; 6490: 6491: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 6492: 'scantron_corrected_'.$env{'form.scantron_selectfile'}); 6493: if ($lines eq '-1') { 6494: $scanlines{'corrected'}=[]; 6495: } else { 6496: $scanlines{'corrected'}=[(split("\n",$lines,-1))]; 6497: } 6498: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 6499: 'scantron_skipped_'.$env{'form.scantron_selectfile'}); 6500: if ($lines eq '-1') { 6501: $scanlines{'skipped'}=[]; 6502: } else { 6503: $scanlines{'skipped'}=[(split("\n",$lines,-1))]; 6504: } 6505: my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname); 6506: if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } 6507: my %scan_data = @tmp; 6508: return (\%scanlines,\%scan_data); 6509: } 6510: 6511: =pod 6512: 6513: =item lonnet_putfile 6514: 6515: Wrapper routine to call &Apache::lonnet::finishuserfileupload 6516: 6517: Arguments: 6518: $contents - data to store 6519: $filename - filename to store $contents into 6520: 6521: Returns: 6522: result value from &Apache::lonnet::finishuserfileupload 6523: 6524: =cut 6525: 6526: sub lonnet_putfile { 6527: my ($contents,$filename)=@_; 6528: my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6529: my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6530: $env{'form.sillywaytopassafilearound'}=$contents; 6531: &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename); 6532: 6533: } 6534: 6535: =pod 6536: 6537: =item scantron_putfile 6538: 6539: Stores the current version of the bubble sheet data files, and the 6540: scan_data hash. (Does not modify the original version only the 6541: corrected and skipped versions. 6542: 6543: Arguments: 6544: $scanlines - hash ref that looks like the first return value from 6545: &scantron_getfile() 6546: $scan_data - hash ref that looks like the second return value from 6547: &scantron_getfile() 6548: 6549: =cut 6550: 6551: sub scantron_putfile { 6552: my ($scanlines,$scan_data) = @_; 6553: #FIXME really would prefer a scantron directory 6554: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6555: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6556: if ($scanlines) { 6557: my $prefix='scantron_'; 6558: # no need to update orig, shouldn't change 6559: # &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'. 6560: # $env{'form.scantron_selectfile'}); 6561: &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}), 6562: $prefix.'corrected_'. 6563: $env{'form.scantron_selectfile'}); 6564: &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), 6565: $prefix.'skipped_'. 6566: $env{'form.scantron_selectfile'}); 6567: } 6568: &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); 6569: } 6570: 6571: =pod 6572: 6573: =item scantron_get_line 6574: 6575: Returns the correct version of the scanline 6576: 6577: Arguments: 6578: $scanlines - hash ref that looks like the first return value from 6579: &scantron_getfile() 6580: $scan_data - hash ref that looks like the second return value from 6581: &scantron_getfile() 6582: $i - number of the requested line (starts at 0) 6583: 6584: Returns: 6585: A scanline, (either the original or the corrected one if it 6586: exists), or undef if the requested scanline should be 6587: skipped. (Either because it's an skipped scanline, or it's an 6588: unskipped scanline and we are not doing a 'do skipped scanlines' 6589: pass. 6590: 6591: =cut 6592: 6593: sub scantron_get_line { 6594: my ($scanlines,$scan_data,$i)=@_; 6595: if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } 6596: #if ($scanlines->{'skipped'}[$i]) { return undef; } 6597: if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} 6598: return $scanlines->{'orig'}[$i]; 6599: } 6600: 6601: =pod 6602: 6603: =item scantron_todo_count 6604: 6605: Counts the number of scanlines that need processing. 6606: 6607: Arguments: 6608: $scanlines - hash ref that looks like the first return value from 6609: &scantron_getfile() 6610: $scan_data - hash ref that looks like the second return value from 6611: &scantron_getfile() 6612: 6613: Returns: 6614: $count - number of scanlines to process 6615: 6616: =cut 6617: 6618: sub get_todo_count { 6619: my ($scanlines,$scan_data)=@_; 6620: my $count=0; 6621: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 6622: my $line=&scantron_get_line($scanlines,$scan_data,$i); 6623: if ($line=~/^[\s\cz]*$/) { next; } 6624: $count++; 6625: } 6626: return $count; 6627: } 6628: 6629: =pod 6630: 6631: =item scantron_put_line 6632: 6633: Updates the 'corrected' or 'skipped' versions of the bubble sheet 6634: data file. 6635: 6636: Arguments: 6637: $scanlines - hash ref that looks like the first return value from 6638: &scantron_getfile() 6639: $scan_data - hash ref that looks like the second return value from 6640: &scantron_getfile() 6641: $i - line number to update 6642: $newline - contents of the updated scanline 6643: $skip - if true make the line for skipping and update the 6644: 'skipped' file 6645: 6646: =cut 6647: 6648: sub scantron_put_line { 6649: my ($scanlines,$scan_data,$i,$newline,$skip)=@_; 6650: if ($skip) { 6651: $scanlines->{'skipped'}[$i]=$newline; 6652: &start_skipping($scan_data,$i); 6653: return; 6654: } 6655: $scanlines->{'corrected'}[$i]=$newline; 6656: } 6657: 6658: =pod 6659: 6660: =item scantron_clear_skip 6661: 6662: Remove a line from the 'skipped' file 6663: 6664: Arguments: 6665: $scanlines - hash ref that looks like the first return value from 6666: &scantron_getfile() 6667: $scan_data - hash ref that looks like the second return value from 6668: &scantron_getfile() 6669: $i - line number to update 6670: 6671: =cut 6672: 6673: sub scantron_clear_skip { 6674: my ($scanlines,$scan_data,$i)=@_; 6675: if (exists($scanlines->{'skipped'}[$i])) { 6676: undef($scanlines->{'skipped'}[$i]); 6677: return 1; 6678: } 6679: return 0; 6680: } 6681: 6682: =pod 6683: 6684: =item scantron_filter_not_exam 6685: 6686: Filter routine used by &Apache::lonnavmaps::retrieveResources(), to 6687: filter out resources that are not marked as 'exam' mode 6688: 6689: =cut 6690: 6691: sub scantron_filter_not_exam { 6692: my ($curres)=@_; 6693: 6694: if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) { 6695: # if the user has asked to not have either hidden 6696: # or 'randomout' controlled resources to be graded 6697: # don't include them 6698: if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' 6699: && $curres->randomout) { 6700: return 0; 6701: } 6702: return 1; 6703: } 6704: return 0; 6705: } 6706: 6707: =pod 6708: 6709: =item scantron_validate_sequence 6710: 6711: Validates the selected sequence, checking for resource that are 6712: not set to exam mode. 6713: 6714: =cut 6715: 6716: sub scantron_validate_sequence { 6717: my ($r,$currentphase) = @_; 6718: 6719: my $navmap=Apache::lonnavmaps::navmap->new(); 6720: unless (ref($navmap)) { 6721: $r->print(&navmap_errormsg()); 6722: return (1,$currentphase); 6723: } 6724: my (undef,undef,$sequence)= 6725: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 6726: 6727: my $map=$navmap->getResourceByUrl($sequence); 6728: 6729: $r->print('<input type="hidden" name="validate_sequence_exam" 6730: value="ignore" />'); 6731: if ($env{'form.validate_sequence_exam'} ne 'ignore') { 6732: my @resources= 6733: $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); 6734: if (@resources) { 6735: $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>"); 6736: return (1,$currentphase); 6737: } 6738: } 6739: 6740: return (0,$currentphase+1); 6741: } 6742: 6743: 6744: 6745: sub scantron_validate_ID { 6746: my ($r,$currentphase) = @_; 6747: 6748: #get student info 6749: my $classlist=&Apache::loncoursedata::get_classlist(); 6750: my %idmap=&username_to_idmap($classlist); 6751: 6752: #get scantron line setup 6753: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6754: my ($scanlines,$scan_data)=&scantron_getfile(); 6755: 6756: my $nav_error; 6757: &scantron_get_maxbubble(\$nav_error); # parse needs the bubble_lines.. array. 6758: if ($nav_error) { 6759: $r->print(&navmap_errormsg()); 6760: return(1,$currentphase); 6761: } 6762: 6763: my %found=('ids'=>{},'usernames'=>{}); 6764: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 6765: my $line=&scantron_get_line($scanlines,$scan_data,$i); 6766: if ($line=~/^[\s\cz]*$/) { next; } 6767: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 6768: $scan_data); 6769: my $id=$$scan_record{'scantron.ID'}; 6770: my $found; 6771: foreach my $checkid (keys(%idmap)) { 6772: if (lc($checkid) eq lc($id)) { $found=$checkid;last; } 6773: } 6774: if ($found) { 6775: my $username=$idmap{$found}; 6776: if ($found{'ids'}{$found}) { 6777: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 6778: $line,'duplicateID',$found); 6779: return(1,$currentphase); 6780: } elsif ($found{'usernames'}{$username}) { 6781: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 6782: $line,'duplicateID',$username); 6783: return(1,$currentphase); 6784: } 6785: #FIXME store away line we previously saw the ID on to use above 6786: $found{'ids'}{$found}++; 6787: $found{'usernames'}{$username}++; 6788: } else { 6789: if ($id =~ /^\s*$/) { 6790: my $username=&scan_data($scan_data,"$i.user"); 6791: if (defined($username) && $found{'usernames'}{$username}) { 6792: &scantron_get_correction($r,$i,$scan_record, 6793: \%scantron_config, 6794: $line,'duplicateID',$username); 6795: return(1,$currentphase); 6796: } elsif (!defined($username)) { 6797: &scantron_get_correction($r,$i,$scan_record, 6798: \%scantron_config, 6799: $line,'incorrectID'); 6800: return(1,$currentphase); 6801: } 6802: $found{'usernames'}{$username}++; 6803: } else { 6804: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 6805: $line,'incorrectID'); 6806: return(1,$currentphase); 6807: } 6808: } 6809: } 6810: 6811: return (0,$currentphase+1); 6812: } 6813: 6814: 6815: sub scantron_get_correction { 6816: my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; 6817: #FIXME in the case of a duplicated ID the previous line, probably need 6818: #to show both the current line and the previous one and allow skipping 6819: #the previous one or the current one 6820: 6821: if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { 6822: $r->print("<p>".&mt("<b>An error was detected ($error)</b>". 6823: " for PaperID <tt>[_1]</tt>", 6824: $$scan_record{'scantron.PaperID'})."</p> \n"); 6825: } else { 6826: $r->print("<p>".&mt("<b>An error was detected ($error)</b>". 6827: " in scanline [_1] <pre>[_2]</pre>", 6828: $i,$line)."</p> \n"); 6829: } 6830: my $message="<p>".&mt("The ID on the form is <tt>[_1]</tt><br />". 6831: "The name on the paper is [_2],[_3]", 6832: $$scan_record{'scantron.ID'}, 6833: $$scan_record{'scantron.LastName'}, 6834: $$scan_record{'scantron.FirstName'})."</p>"; 6835: 6836: $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); 6837: $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n"); 6838: # Array populated for doublebubble or 6839: my @lines_to_correct; # missingbubble errors to build javascript 6840: # to validate radio button checking 6841: 6842: if ($error =~ /ID$/) { 6843: if ($error eq 'incorrectID') { 6844: $r->print("<p>".&mt("The encoded ID is not in the classlist"). 6845: "</p>\n"); 6846: } elsif ($error eq 'duplicateID') { 6847: $r->print("<p>".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n"); 6848: } 6849: $r->print($message); 6850: $r->print("<p>".&mt("How should I handle this?")." <br /> \n"); 6851: $r->print("\n<ul><li> "); 6852: #FIXME it would be nice if this sent back the user ID and 6853: #could do partial userID matches 6854: $r->print(&Apache::loncommon::selectstudent_link('scantronupload', 6855: 'scantron_username','scantron_domain')); 6856: $r->print(": <input type='text' name='scantron_username' value='' />"); 6857: $r->print("\n@". 6858: &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain')); 6859: 6860: $r->print('</li>'); 6861: } elsif ($error =~ /CODE$/) { 6862: if ($error eq 'incorrectCODE') { 6863: $r->print("<p>".&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n"); 6864: } elsif ($error eq 'duplicateCODE') { 6865: $r->print("<p>".&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."</p>\n"); 6866: } 6867: $r->print("<p>".&mt("The CODE on the form is <tt>'[_1]'</tt>", 6868: $$scan_record{'scantron.CODE'})."<br />\n"); 6869: $r->print($message); 6870: $r->print("<p>".&mt("How should I handle this?")." <br /> \n"); 6871: $r->print("\n<br /> "); 6872: my $i=0; 6873: if ($error eq 'incorrectCODE' 6874: && $$scan_record{'scantron.CODE'}=~/\S/ ) { 6875: my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); 6876: if ($closest > 0) { 6877: foreach my $testcode (@{$closest}) { 6878: my $checked=''; 6879: if (!$i) { $checked=' checked="checked"'; } 6880: $r->print(" 6881: <label> 6882: <input type='radio' name='scantron_CODE_resolution' value='use_closest_$i'$checked /> 6883: ".&mt("Use the similar CODE [_1] instead.", 6884: "<b><tt>".$testcode."</tt></b>")." 6885: </label> 6886: <input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />"); 6887: $r->print("\n<br />"); 6888: $i++; 6889: } 6890: } 6891: } 6892: if ($$scan_record{'scantron.CODE'}=~/\S/ ) { 6893: my $checked; if (!$i) { $checked=' checked="checked"'; } 6894: $r->print(" 6895: <label> 6896: <input type='radio' name='scantron_CODE_resolution' value='use_unfound'$checked /> 6897: ".&mt("Use the CODE [_1] that is was on the paper, ignoring the error.", 6898: "<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")." 6899: </label>"); 6900: $r->print("\n<br />"); 6901: } 6902: 6903: $r->print(&Apache::lonhtmlcommon::scripttag(<<ENDSCRIPT)); 6904: function change_radio(field) { 6905: var slct=document.scantronupload.scantron_CODE_resolution; 6906: var i; 6907: for (i=0;i<slct.length;i++) { 6908: if (slct[i].value==field) { slct[i].checked=true; } 6909: } 6910: } 6911: ENDSCRIPT 6912: my $href="/adm/pickcode?". 6913: "form=".&escape("scantronupload"). 6914: "&scantron_format=".&escape($env{'form.scantron_format'}). 6915: "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). 6916: "&curCODE=".&escape($$scan_record{'scantron.CODE'}). 6917: "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); 6918: if ($env{'form.scantron_CODElist'} =~ /\S/) { 6919: $r->print(" 6920: <label> 6921: <input type='radio' name='scantron_CODE_resolution' value='use_found' /> 6922: ".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.", 6923: "<a target='_blank' href='$href'>","</a>")." 6924: </label> 6925: ".&mt("Selected CODE is [_1]",'<input readonly="readonly" type="text" size="8" name="scantron_CODE_selectedvalue" onfocus="javascript:change_radio(\'use_found\')" onchange="javascript:change_radio(\'use_found\')" />')); 6926: $r->print("\n<br />"); 6927: } 6928: $r->print(" 6929: <label> 6930: <input type='radio' name='scantron_CODE_resolution' value='use_typed' /> 6931: ".&mt("Use [_1] as the CODE.", 6932: "</label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" />")); 6933: $r->print("\n<br /><br />"); 6934: } elsif ($error eq 'doublebubble') { 6935: $r->print("<p>".&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n"); 6936: 6937: # The form field scantron_questions is acutally a list of line numbers. 6938: # represented by this form so: 6939: 6940: my $line_list = &questions_to_line_list($arg); 6941: 6942: $r->print('<input type="hidden" name="scantron_questions" value="'. 6943: $line_list.'" />'); 6944: $r->print($message); 6945: $r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>"); 6946: foreach my $question (@{$arg}) { 6947: my @linenums = &prompt_for_corrections($r,$question,$scan_config, 6948: $scan_record, $error); 6949: push(@lines_to_correct,@linenums); 6950: } 6951: $r->print(&verify_bubbles_checked(@lines_to_correct)); 6952: } elsif ($error eq 'missingbubble') { 6953: $r->print("<p>".&mt("There have been <b>no</b> bubbles scanned for some question(s)")."</p>\n"); 6954: $r->print($message); 6955: $r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>"); 6956: $r->print(&mt("Some questions have no scanned bubbles.")."\n"); 6957: 6958: # The form field scantron_questions is actually a list of line numbers not 6959: # a list of question numbers. Therefore: 6960: # 6961: 6962: my $line_list = &questions_to_line_list($arg); 6963: 6964: $r->print('<input type="hidden" name="scantron_questions" value="'. 6965: $line_list.'" />'); 6966: foreach my $question (@{$arg}) { 6967: my @linenums = &prompt_for_corrections($r,$question,$scan_config, 6968: $scan_record, $error); 6969: push(@lines_to_correct,@linenums); 6970: } 6971: $r->print(&verify_bubbles_checked(@lines_to_correct)); 6972: } else { 6973: $r->print("\n<ul>"); 6974: } 6975: $r->print("\n</li></ul>"); 6976: } 6977: 6978: sub verify_bubbles_checked { 6979: my (@ansnums) = @_; 6980: my $ansnumstr = join('","',@ansnums); 6981: my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines."); 6982: my $output = &Apache::lonhtmlcommon::scripttag((<<ENDSCRIPT)); 6983: function verify_bubble_radio(form) { 6984: var ansnumArray = new Array ("$ansnumstr"); 6985: var need_bubble_count = 0; 6986: for (var i=0; i<ansnumArray.length; i++) { 6987: if (form.elements["scantron_correct_Q_"+ansnumArray[i]].length > 1) { 6988: var bubble_picked = 0; 6989: for (var j=0; j<form.elements["scantron_correct_Q_"+ansnumArray[i]].length; j++) { 6990: if (form.elements["scantron_correct_Q_"+ansnumArray[i]][j].checked == true) { 6991: bubble_picked = 1; 6992: } 6993: } 6994: if (bubble_picked == 0) { 6995: need_bubble_count ++; 6996: } 6997: } 6998: } 6999: if (need_bubble_count) { 7000: alert("$warning"); 7001: return; 7002: } 7003: form.submit(); 7004: } 7005: ENDSCRIPT 7006: return $output; 7007: } 7008: 7009: =pod 7010: 7011: =item questions_to_line_list 7012: 7013: Converts a list of questions into a string of comma separated 7014: line numbers in the answer sheet used by the questions. This is 7015: used to fill in the scantron_questions form field. 7016: 7017: Arguments: 7018: questions - Reference to an array of questions. 7019: 7020: =cut 7021: 7022: 7023: sub questions_to_line_list { 7024: my ($questions) = @_; 7025: my @lines; 7026: 7027: foreach my $item (@{$questions}) { 7028: my $question = $item; 7029: my ($first,$count,$last); 7030: if ($item =~ /^(\d+)\.(\d+)$/) { 7031: $question = $1; 7032: my $subquestion = $2; 7033: $first = $first_bubble_line{$question-1} + 1; 7034: my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); 7035: my $subcount = 1; 7036: while ($subcount<$subquestion) { 7037: $first += $subans[$subcount-1]; 7038: $subcount ++; 7039: } 7040: $count = $subans[$subquestion-1]; 7041: } else { 7042: $first = $first_bubble_line{$question-1} + 1; 7043: $count = $bubble_lines_per_response{$question-1}; 7044: } 7045: $last = $first+$count-1; 7046: push(@lines, ($first..$last)); 7047: } 7048: return join(',', @lines); 7049: } 7050: 7051: =pod 7052: 7053: =item prompt_for_corrections 7054: 7055: Prompts for a potentially multiline correction to the 7056: user's bubbling (factors out common code from scantron_get_correction 7057: for multi and missing bubble cases). 7058: 7059: Arguments: 7060: $r - Apache request object. 7061: $question - The question number to prompt for. 7062: $scan_config - The scantron file configuration hash. 7063: $scan_record - Reference to the hash that has the the parsed scanlines. 7064: $error - Type of error 7065: 7066: Implicit inputs: 7067: %bubble_lines_per_response - Starting line numbers for each question. 7068: Numbered from 0 (but question numbers are from 7069: 1. 7070: %first_bubble_line - Starting bubble line for each question. 7071: %subdivided_bubble_lines - optionresponse, matchresponse and rankresponse 7072: type problems render as separate sub-questions, 7073: in exam mode. This hash contains a 7074: comma-separated list of the lines per 7075: sub-question. 7076: %responsetype_per_response - essayresponse, formularesponse, 7077: stringresponse, imageresponse, reactionresponse, 7078: and organicresponse type problem parts can have 7079: multiple lines per response if the weight 7080: assigned exceeds 10. In this case, only 7081: one bubble per line is permitted, but more 7082: than one line might contain bubbles, e.g. 7083: bubbling of: line 1 - J, line 2 - J, 7084: line 3 - B would assign 22 points. 7085: 7086: =cut 7087: 7088: sub prompt_for_corrections { 7089: my ($r, $question, $scan_config, $scan_record, $error) = @_; 7090: my ($current_line,$lines); 7091: my @linenums; 7092: my $questionnum = $question; 7093: if ($question =~ /^(\d+)\.(\d+)$/) { 7094: $question = $1; 7095: $current_line = $first_bubble_line{$question-1} + 1 ; 7096: my $subquestion = $2; 7097: my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); 7098: my $subcount = 1; 7099: while ($subcount<$subquestion) { 7100: $current_line += $subans[$subcount-1]; 7101: $subcount ++; 7102: } 7103: $lines = $subans[$subquestion-1]; 7104: } else { 7105: $current_line = $first_bubble_line{$question-1} + 1 ; 7106: $lines = $bubble_lines_per_response{$question-1}; 7107: } 7108: if ($lines > 1) { 7109: $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />'); 7110: if (($responsetype_per_response{$question-1} eq 'essayresponse') || 7111: ($responsetype_per_response{$question-1} eq 'formularesponse') || 7112: ($responsetype_per_response{$question-1} eq 'stringresponse') || 7113: ($responsetype_per_response{$question-1} eq 'imageresponse') || 7114: ($responsetype_per_response{$question-1} eq 'reactionresponse') || 7115: ($responsetype_per_response{$question-1} eq 'organicresponse')) { 7116: $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.').'<br />'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'<br />'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'<br /><br />'); 7117: } else { 7118: $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />"); 7119: } 7120: } 7121: for (my $i =0; $i < $lines; $i++) { 7122: my $selected = $$scan_record{"scantron.$current_line.answer"}; 7123: &scantron_bubble_selector($r,$scan_config,$current_line, 7124: $questionnum,$error,split('', $selected)); 7125: push(@linenums,$current_line); 7126: $current_line++; 7127: } 7128: if ($lines > 1) { 7129: $r->print("<hr /><br />"); 7130: } 7131: return @linenums; 7132: } 7133: 7134: =pod 7135: 7136: =item scantron_bubble_selector 7137: 7138: Generates the html radiobuttons to correct a single bubble line 7139: possibly showing the existing the selected bubbles if known 7140: 7141: Arguments: 7142: $r - Apache request object 7143: $scan_config - hash from &get_scantron_config() 7144: $line - Number of the line being displayed. 7145: $questionnum - Question number (may include subquestion) 7146: $error - Type of error. 7147: @selected - Array of bubbles picked on this line. 7148: 7149: =cut 7150: 7151: sub scantron_bubble_selector { 7152: my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_; 7153: my $max=$$scan_config{'Qlength'}; 7154: 7155: my $scmode=$$scan_config{'Qon'}; 7156: if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } 7157: 7158: my @alphabet=('A'..'Z'); 7159: $r->print(&Apache::loncommon::start_data_table(). 7160: &Apache::loncommon::start_data_table_row()); 7161: $r->print('<td rowspan="2" class="LC_leftcol_header">'.$line.'</td>'); 7162: for (my $i=0;$i<$max+1;$i++) { 7163: $r->print("\n".'<td align="center">'); 7164: if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } 7165: else { $r->print(' '); } 7166: $r->print('</td>'); 7167: } 7168: $r->print(&Apache::loncommon::end_data_table_row(). 7169: &Apache::loncommon::start_data_table_row()); 7170: for (my $i=0;$i<$max;$i++) { 7171: $r->print("\n". 7172: '<td><label><input type="radio" name="scantron_correct_Q_'. 7173: $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>"); 7174: } 7175: my $nobub_checked = ' '; 7176: if ($error eq 'missingbubble') { 7177: $nobub_checked = ' checked = "checked" '; 7178: } 7179: $r->print("\n".'<td><label><input type="radio" name="scantron_correct_Q_'. 7180: $line.'" value="none"'.$nobub_checked.'/>'.&mt('No bubble'). 7181: '</label>'."\n".'<input type="hidden" name="scantron_questionnum_Q_'. 7182: $line.'" value="'.$questionnum.'" /></td>'); 7183: $r->print(&Apache::loncommon::end_data_table_row(). 7184: &Apache::loncommon::end_data_table()); 7185: } 7186: 7187: =pod 7188: 7189: =item num_matches 7190: 7191: Counts the number of characters that are the same between the two arguments. 7192: 7193: Arguments: 7194: $orig - CODE from the scanline 7195: $code - CODE to match against 7196: 7197: Returns: 7198: $count - integer count of the number of same characters between the 7199: two arguments 7200: 7201: =cut 7202: 7203: sub num_matches { 7204: my ($orig,$code) = @_; 7205: my @code=split(//,$code); 7206: my @orig=split(//,$orig); 7207: my $same=0; 7208: for (my $i=0;$i<scalar(@code);$i++) { 7209: if ($code[$i] eq $orig[$i]) { $same++; } 7210: } 7211: return $same; 7212: } 7213: 7214: =pod 7215: 7216: =item scantron_get_closely_matching_CODEs 7217: 7218: Cycles through all CODEs and finds the set that has the greatest 7219: number of same characters as the provided CODE 7220: 7221: Arguments: 7222: $allcodes - hash ref returned by &get_codes() 7223: $CODE - CODE from the current scanline 7224: 7225: Returns: 7226: 2 element list 7227: - first elements is number of how closely matching the best fit is 7228: (5 means best set has 5 matching characters) 7229: - second element is an arrary ref containing the set of valid CODEs 7230: that best fit the passed in CODE 7231: 7232: =cut 7233: 7234: sub scantron_get_closely_matching_CODEs { 7235: my ($allcodes,$CODE)=@_; 7236: my @CODEs; 7237: foreach my $testcode (sort(keys(%{$allcodes}))) { 7238: push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode); 7239: } 7240: 7241: return ($#CODEs,$CODEs[-1]); 7242: } 7243: 7244: =pod 7245: 7246: =item get_codes 7247: 7248: Builds a hash which has keys of all of the valid CODEs from the selected 7249: set of remembered CODEs. 7250: 7251: Arguments: 7252: $old_name - name of the set of remembered CODEs 7253: $cdom - domain of the course 7254: $cnum - internal course name 7255: 7256: Returns: 7257: %allcodes - keys are the valid CODEs, values are all 1 7258: 7259: =cut 7260: 7261: sub get_codes { 7262: my ($old_name, $cdom, $cnum) = @_; 7263: if (!$old_name) { 7264: $old_name=$env{'form.scantron_CODElist'}; 7265: } 7266: if (!$cdom) { 7267: $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'}; 7268: } 7269: if (!$cnum) { 7270: $cnum =$env{'course.'.$env{'request.course.id'}.'.num'}; 7271: } 7272: my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"], 7273: $cdom,$cnum); 7274: my %allcodes; 7275: if ($result{"type\0$old_name"} eq 'number') { 7276: %allcodes=map {($_,1)} split(',',$result{$old_name}); 7277: } else { 7278: %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); 7279: } 7280: return %allcodes; 7281: } 7282: 7283: =pod 7284: 7285: =item scantron_validate_CODE 7286: 7287: Validates all scanlines in the selected file to not have any 7288: invalid or underspecified CODEs and that none of the codes are 7289: duplicated if this was requested. 7290: 7291: =cut 7292: 7293: sub scantron_validate_CODE { 7294: my ($r,$currentphase) = @_; 7295: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 7296: if ($scantron_config{'CODElocation'} && 7297: $scantron_config{'CODEstart'} && 7298: $scantron_config{'CODElength'}) { 7299: if (!defined($env{'form.scantron_CODElist'})) { 7300: &FIXME_blow_up() 7301: } 7302: } else { 7303: return (0,$currentphase+1); 7304: } 7305: 7306: my %usedCODEs; 7307: 7308: my %allcodes=&get_codes(); 7309: 7310: my $nav_error; 7311: &scantron_get_maxbubble(\$nav_error); # parse needs the lines per response array. 7312: if ($nav_error) { 7313: $r->print(&navmap_errormsg()); 7314: return(1,$currentphase); 7315: } 7316: 7317: my ($scanlines,$scan_data)=&scantron_getfile(); 7318: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7319: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7320: if ($line=~/^[\s\cz]*$/) { next; } 7321: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 7322: $scan_data); 7323: my $CODE=$$scan_record{'scantron.CODE'}; 7324: my $error=0; 7325: if (!&Apache::lonnet::validCODE($CODE)) { 7326: &scantron_get_correction($r,$i,$scan_record, 7327: \%scantron_config, 7328: $line,'incorrectCODE',\%allcodes); 7329: return(1,$currentphase); 7330: } 7331: if (%allcodes && !exists($allcodes{$CODE}) 7332: && !$$scan_record{'scantron.useCODE'}) { 7333: &scantron_get_correction($r,$i,$scan_record, 7334: \%scantron_config, 7335: $line,'incorrectCODE',\%allcodes); 7336: return(1,$currentphase); 7337: } 7338: if (exists($usedCODEs{$CODE}) 7339: && $env{'form.scantron_CODEunique'} eq 'yes' 7340: && !$$scan_record{'scantron.CODE_ignore_dup'}) { 7341: &scantron_get_correction($r,$i,$scan_record, 7342: \%scantron_config, 7343: $line,'duplicateCODE',$usedCODEs{$CODE}); 7344: return(1,$currentphase); 7345: } 7346: push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); 7347: } 7348: return (0,$currentphase+1); 7349: } 7350: 7351: =pod 7352: 7353: =item scantron_validate_doublebubble 7354: 7355: Validates all scanlines in the selected file to not have any 7356: bubble lines with multiple bubbles marked. 7357: 7358: =cut 7359: 7360: sub scantron_validate_doublebubble { 7361: my ($r,$currentphase) = @_; 7362: #get student info 7363: my $classlist=&Apache::loncoursedata::get_classlist(); 7364: my %idmap=&username_to_idmap($classlist); 7365: 7366: #get scantron line setup 7367: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 7368: my ($scanlines,$scan_data)=&scantron_getfile(); 7369: my $nav_error; 7370: &scantron_get_maxbubble(\$nav_error); # parse needs the bubble line array. 7371: if ($nav_error) { 7372: $r->print(&navmap_errormsg()); 7373: return(1,$currentphase); 7374: } 7375: 7376: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7377: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7378: if ($line=~/^[\s\cz]*$/) { next; } 7379: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 7380: $scan_data); 7381: if (!defined($$scan_record{'scantron.doubleerror'})) { next; } 7382: &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, 7383: 'doublebubble', 7384: $$scan_record{'scantron.doubleerror'}); 7385: return (1,$currentphase); 7386: } 7387: return (0,$currentphase+1); 7388: } 7389: 7390: 7391: sub scantron_get_maxbubble { 7392: my ($nav_error) = @_; 7393: if (defined($env{'form.scantron_maxbubble'}) && 7394: $env{'form.scantron_maxbubble'}) { 7395: &restore_bubble_lines(); 7396: return $env{'form.scantron_maxbubble'}; 7397: } 7398: 7399: my (undef, undef, $sequence) = 7400: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 7401: 7402: my $navmap=Apache::lonnavmaps::navmap->new(); 7403: unless (ref($navmap)) { 7404: if (ref($nav_error)) { 7405: $$nav_error = 1; 7406: } 7407: return; 7408: } 7409: my $map=$navmap->getResourceByUrl($sequence); 7410: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 7411: 7412: &Apache::lonxml::clear_problem_counter(); 7413: 7414: my $uname = $env{'user.name'}; 7415: my $udom = $env{'user.domain'}; 7416: my $cid = $env{'request.course.id'}; 7417: my $total_lines = 0; 7418: %bubble_lines_per_response = (); 7419: %first_bubble_line = (); 7420: %subdivided_bubble_lines = (); 7421: %responsetype_per_response = (); 7422: 7423: my $response_number = 0; 7424: my $bubble_line = 0; 7425: foreach my $resource (@resources) { 7426: my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom); 7427: if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) { 7428: foreach my $part_id (@{$parts}) { 7429: my $lines; 7430: 7431: # TODO - make this a persistent hash not an array. 7432: 7433: # optionresponse, matchresponse and rankresponse type items 7434: # render as separate sub-questions in exam mode. 7435: if (($analysis->{$part_id.'.type'} eq 'optionresponse') || 7436: ($analysis->{$part_id.'.type'} eq 'matchresponse') || 7437: ($analysis->{$part_id.'.type'} eq 'rankresponse')) { 7438: my ($numbub,$numshown); 7439: if ($analysis->{$part_id.'.type'} eq 'optionresponse') { 7440: if (ref($analysis->{$part_id.'.options'}) eq 'ARRAY') { 7441: $numbub = scalar(@{$analysis->{$part_id.'.options'}}); 7442: } 7443: } elsif ($analysis->{$part_id.'.type'} eq 'matchresponse') { 7444: if (ref($analysis->{$part_id.'.items'}) eq 'ARRAY') { 7445: $numbub = scalar(@{$analysis->{$part_id.'.items'}}); 7446: } 7447: } elsif ($analysis->{$part_id.'.type'} eq 'rankresponse') { 7448: if (ref($analysis->{$part_id.'.foils'}) eq 'ARRAY') { 7449: $numbub = scalar(@{$analysis->{$part_id.'.foils'}}); 7450: } 7451: } 7452: if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') { 7453: $numshown = scalar(@{$analysis->{$part_id.'.shown'}}); 7454: } 7455: my $bubbles_per_line = 10; 7456: my $inner_bubble_lines = int($numbub/$bubbles_per_line); 7457: if (($numbub % $bubbles_per_line) != 0) { 7458: $inner_bubble_lines++; 7459: } 7460: for (my $i=0; $i<$numshown; $i++) { 7461: $subdivided_bubble_lines{$response_number} .= 7462: $inner_bubble_lines.','; 7463: } 7464: $subdivided_bubble_lines{$response_number} =~ s/,$//; 7465: $lines = $numshown * $inner_bubble_lines; 7466: } else { 7467: $lines = $analysis->{"$part_id.bubble_lines"}; 7468: } 7469: 7470: $first_bubble_line{$response_number} = $bubble_line; 7471: $bubble_lines_per_response{$response_number} = $lines; 7472: $responsetype_per_response{$response_number} = 7473: $analysis->{$part_id.'.type'}; 7474: $response_number++; 7475: 7476: $bubble_line += $lines; 7477: $total_lines += $lines; 7478: } 7479: } 7480: } 7481: &Apache::lonnet::delenv('scantron.'); 7482: 7483: &save_bubble_lines(); 7484: $env{'form.scantron_maxbubble'} = 7485: $total_lines; 7486: return $env{'form.scantron_maxbubble'}; 7487: } 7488: 7489: sub scantron_validate_missingbubbles { 7490: my ($r,$currentphase) = @_; 7491: #get student info 7492: my $classlist=&Apache::loncoursedata::get_classlist(); 7493: my %idmap=&username_to_idmap($classlist); 7494: 7495: #get scantron line setup 7496: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 7497: my ($scanlines,$scan_data)=&scantron_getfile(); 7498: my $nav_error; 7499: my $max_bubble=&scantron_get_maxbubble(\$nav_error); 7500: if ($nav_error) { 7501: return(1,$currentphase); 7502: } 7503: if (!$max_bubble) { $max_bubble=2**31; } 7504: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7505: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7506: if ($line=~/^[\s\cz]*$/) { next; } 7507: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 7508: $scan_data); 7509: if (!defined($$scan_record{'scantron.missingerror'})) { next; } 7510: my @to_correct; 7511: 7512: # Probably here's where the error is... 7513: 7514: foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { 7515: my $lastbubble; 7516: if ($missing =~ /^(\d+)\.(\d+)$/) { 7517: my $question = $1; 7518: my $subquestion = $2; 7519: if (!defined($first_bubble_line{$question -1})) { next; } 7520: my $first = $first_bubble_line{$question-1}; 7521: my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); 7522: my $subcount = 1; 7523: while ($subcount<$subquestion) { 7524: $first += $subans[$subcount-1]; 7525: $subcount ++; 7526: } 7527: my $count = $subans[$subquestion-1]; 7528: $lastbubble = $first + $count; 7529: } else { 7530: if (!defined($first_bubble_line{$missing - 1})) { next; } 7531: $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1}; 7532: } 7533: if ($lastbubble > $max_bubble) { next; } 7534: push(@to_correct,$missing); 7535: } 7536: if (@to_correct) { 7537: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 7538: $line,'missingbubble',\@to_correct); 7539: return (1,$currentphase); 7540: } 7541: 7542: } 7543: return (0,$currentphase+1); 7544: } 7545: 7546: 7547: sub scantron_process_students { 7548: my ($r,$symb) = @_; 7549: 7550: my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); 7551: if (!$symb) { 7552: return ''; 7553: } 7554: my $default_form_data=&defaultFormData($symb); 7555: 7556: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 7557: my ($scanlines,$scan_data)=&scantron_getfile(); 7558: my $classlist=&Apache::loncoursedata::get_classlist(); 7559: my %idmap=&username_to_idmap($classlist); 7560: my $navmap=Apache::lonnavmaps::navmap->new(); 7561: unless (ref($navmap)) { 7562: $r->print(&navmap_errormsg()); 7563: return ''; 7564: } 7565: my $map=$navmap->getResourceByUrl($sequence); 7566: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 7567: my (%grader_partids_by_symb,%grader_randomlists_by_symb); 7568: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 7569: \%grader_randomlists_by_symb); 7570: my $resource_error; 7571: foreach my $resource (@resources) { 7572: my $ressymb; 7573: if (ref($resource)) { 7574: $ressymb = $resource->symb(); 7575: } else { 7576: $resource_error = 1; 7577: last; 7578: } 7579: my ($analysis,$parts) = 7580: &scantron_partids_tograde($resource,$env{'request.course.id'}, 7581: $env{'user.name'},$env{'user.domain'},1); 7582: $grader_partids_by_symb{$ressymb} = $parts; 7583: if (ref($analysis) eq 'HASH') { 7584: if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { 7585: $grader_randomlists_by_symb{$ressymb} = 7586: $analysis->{'parts_withrandomlist'}; 7587: } 7588: } 7589: } 7590: if ($resource_error) { 7591: $r->print(&navmap_errormsg()); 7592: return ''; 7593: } 7594: 7595: my ($uname,$udom); 7596: my $result= <<SCANTRONFORM; 7597: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> 7598: <input type="hidden" name="command" value="scantron_configphase" /> 7599: $default_form_data 7600: SCANTRONFORM 7601: $r->print($result); 7602: 7603: my @delayqueue; 7604: my (%completedstudents,%scandata); 7605: 7606: my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam')); 7607: my $count=&get_todo_count($scanlines,$scan_data); 7608: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet Status', 7609: 'Bubblesheet Progress',$count, 7610: 'inline',undef,'scantronupload'); 7611: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 7612: 'Processing first student'); 7613: $r->print('<br />'); 7614: my $start=&Time::HiRes::time(); 7615: my $i=-1; 7616: my $started; 7617: 7618: my $nav_error; 7619: &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse. 7620: if ($nav_error) { 7621: $r->print(&navmap_errormsg()); 7622: return ''; 7623: } 7624: 7625: # If an ssi failed in scantron_get_maxbubble, put an error message out to 7626: # the user and return. 7627: 7628: if ($ssi_error) { 7629: $r->print("</form>"); 7630: &ssi_print_error($r); 7631: &Apache::lonnet::remove_lock($lock); 7632: return ''; # Dunno why the other returns return '' rather than just returning. 7633: } 7634: 7635: my %lettdig = &letter_to_digits(); 7636: my $numletts = scalar(keys(%lettdig)); 7637: 7638: while ($i<$scanlines->{'count'}) { 7639: ($uname,$udom)=('',''); 7640: $i++; 7641: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7642: if ($line=~/^[\s\cz]*$/) { next; } 7643: if ($started) { 7644: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, 7645: 'last student'); 7646: } 7647: $started=1; 7648: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 7649: $scan_data); 7650: unless ($uname=&scantron_find_student($scan_record,$scan_data, 7651: \%idmap,$i)) { 7652: &scantron_add_delay(\@delayqueue,$line, 7653: 'Unable to find a student that matches',1); 7654: next; 7655: } 7656: if (exists $completedstudents{$uname}) { 7657: &scantron_add_delay(\@delayqueue,$line, 7658: 'Student '.$uname.' has multiple sheets',2); 7659: next; 7660: } 7661: ($uname,$udom)=split(/:/,$uname); 7662: 7663: my (%partids_by_symb,$res_error); 7664: foreach my $resource (@resources) { 7665: my $ressymb; 7666: if (ref($resource)) { 7667: $ressymb = $resource->symb(); 7668: } else { 7669: $res_error = 1; 7670: last; 7671: } 7672: if ((exists($grader_randomlists_by_symb{$ressymb})) || 7673: (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { 7674: my ($analysis,$parts) = 7675: &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom); 7676: $partids_by_symb{$ressymb} = $parts; 7677: } else { 7678: $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb}; 7679: } 7680: } 7681: 7682: if ($res_error) { 7683: &scantron_add_delay(\@delayqueue,$line, 7684: 'An error occurred while grading student '.$uname,2); 7685: next; 7686: } 7687: 7688: &Apache::lonxml::clear_problem_counter(); 7689: &Apache::lonnet::appenv($scan_record); 7690: 7691: if (&scantron_clear_skip($scanlines,$scan_data,$i)) { 7692: &scantron_putfile($scanlines,$scan_data); 7693: } 7694: 7695: my $scancode; 7696: if ((exists($scan_record->{'scantron.CODE'})) && 7697: (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { 7698: $scancode = $scan_record->{'scantron.CODE'}; 7699: } else { 7700: $scancode = ''; 7701: } 7702: 7703: if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, 7704: \@resources,\%partids_by_symb) eq 'ssi_error') { 7705: $ssi_error = 0; # So end of handler error message does not trigger. 7706: $r->print("</form>"); 7707: &ssi_print_error($r); 7708: &Apache::lonnet::remove_lock($lock); 7709: return ''; # Why return ''? Beats me. 7710: } 7711: 7712: $completedstudents{$uname}={'line'=>$line}; 7713: if ($env{'form.verifyrecord'}) { 7714: my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; 7715: my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos); 7716: chomp($studentdata); 7717: $studentdata =~ s/\r$//; 7718: my $studentrecord = ''; 7719: my $counter = -1; 7720: foreach my $resource (@resources) { 7721: my $ressymb = $resource->symb(); 7722: ($counter,my $recording) = 7723: &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, 7724: $counter,$studentdata,$partids_by_symb{$ressymb}, 7725: \%scantron_config,\%lettdig,$numletts); 7726: $studentrecord .= $recording; 7727: } 7728: if ($studentrecord ne $studentdata) { 7729: &Apache::lonxml::clear_problem_counter(); 7730: if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, 7731: \@resources,\%partids_by_symb) eq 'ssi_error') { 7732: $ssi_error = 0; # So end of handler error message does not trigger. 7733: $r->print("</form>"); 7734: &ssi_print_error($r); 7735: &Apache::lonnet::remove_lock($lock); 7736: delete($completedstudents{$uname}); 7737: return ''; 7738: } 7739: $counter = -1; 7740: $studentrecord = ''; 7741: foreach my $resource (@resources) { 7742: my $ressymb = $resource->symb(); 7743: ($counter,my $recording) = 7744: &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, 7745: $counter,$studentdata,$partids_by_symb{$ressymb}, 7746: \%scantron_config,\%lettdig,$numletts); 7747: $studentrecord .= $recording; 7748: } 7749: if ($studentrecord ne $studentdata) { 7750: $r->print('<p><span class="LC_error">'); 7751: if ($scancode eq '') { 7752: $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].', 7753: $uname.':'.$udom,$scan_record->{'scantron.ID'})); 7754: } else { 7755: $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2] and CODE: [_3].', 7756: $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode)); 7757: } 7758: $r->print('</span><br />'.&Apache::loncommon::start_data_table()."\n". 7759: &Apache::loncommon::start_data_table_header_row()."\n". 7760: '<th>'.&mt('Source').'</th><th>'.&mt('Bubbled responses').'</th>'. 7761: &Apache::loncommon::end_data_table_header_row()."\n". 7762: &Apache::loncommon::start_data_table_row(). 7763: '<td>'.&mt('Bubble Sheet').'</td>'. 7764: '<td><span class="LC_nobreak">'.$studentdata.'</span></td>'. 7765: &Apache::loncommon::end_data_table_row(). 7766: &Apache::loncommon::start_data_table_row(). 7767: '<td>Stored submissions</td>'. 7768: '<td><span class="LC_nobreak">'.$studentrecord.'</span></td>'."\n". 7769: &Apache::loncommon::end_data_table_row(). 7770: &Apache::loncommon::end_data_table().'</p>'); 7771: } else { 7772: $r->print('<br /><span class="LC_warning">'. 7773: &mt('A second grading pass was needed for user: [_1] with ID: [_2], because a mismatch was seen on the first pass.',$uname.':'.$udom,$scan_record->{'scantron.ID'}).'<br />'. 7774: &mt("As a consequence, this user's submission history records two tries."). 7775: '</span><br />'); 7776: } 7777: } 7778: } 7779: if (&Apache::loncommon::connection_aborted($r)) { last; } 7780: } continue { 7781: &Apache::lonxml::clear_problem_counter(); 7782: &Apache::lonnet::delenv('scantron.'); 7783: } 7784: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 7785: &Apache::lonnet::remove_lock($lock); 7786: # my $lasttime = &Time::HiRes::time()-$start; 7787: # $r->print("<p>took $lasttime</p>"); 7788: 7789: $r->print("</form>"); 7790: return ''; 7791: } 7792: 7793: sub graders_resources_pass { 7794: my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb) = @_; 7795: if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && 7796: (ref($grader_randomlists_by_symb) eq 'HASH')) { 7797: foreach my $resource (@{$resources}) { 7798: my $ressymb = $resource->symb(); 7799: my ($analysis,$parts) = 7800: &scantron_partids_tograde($resource,$env{'request.course.id'}, 7801: $env{'user.name'},$env{'user.domain'},1); 7802: $grader_partids_by_symb->{$ressymb} = $parts; 7803: if (ref($analysis) eq 'HASH') { 7804: if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { 7805: $grader_randomlists_by_symb->{$ressymb} = 7806: $analysis->{'parts_withrandomlist'}; 7807: } 7808: } 7809: } 7810: } 7811: return; 7812: } 7813: 7814: sub grade_student_bubbles { 7815: my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts) = @_; 7816: if (ref($resources) eq 'ARRAY') { 7817: my $count = 0; 7818: foreach my $resource (@{$resources}) { 7819: my $ressymb = $resource->symb(); 7820: my %form = ('submitted' => 'scantron', 7821: 'grade_target' => 'grade', 7822: 'grade_username' => $uname, 7823: 'grade_domain' => $udom, 7824: 'grade_courseid' => $env{'request.course.id'}, 7825: 'grade_symb' => $ressymb, 7826: 'CODE' => $scancode 7827: ); 7828: if (ref($parts) eq 'HASH') { 7829: if (ref($parts->{$ressymb}) eq 'ARRAY') { 7830: foreach my $part (@{$parts->{$ressymb}}) { 7831: $form{'scantron_questnum_start.'.$part} = 7832: 1+$env{'form.scantron.first_bubble_line.'.$count}; 7833: $count++; 7834: } 7835: } 7836: } 7837: my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form); 7838: return 'ssi_error' if ($ssi_error); 7839: last if (&Apache::loncommon::connection_aborted($r)); 7840: } 7841: } 7842: return; 7843: } 7844: 7845: sub scantron_upload_scantron_data { 7846: my ($r,$symb)=@_; 7847: my $dom = $env{'request.role.domain'}; 7848: my $domdesc = &Apache::lonnet::domain($dom,'description'); 7849: $r->print(&Apache::loncommon::coursebrowser_javascript($dom)); 7850: my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', 7851: 'domainid', 7852: 'coursename',$dom); 7853: my $syllabuslink = '<a href="javascript:ToSyllabus();">'.&mt('Syllabus').'</a>'. 7854: ('&nbsp'x2).&mt('(shows course personnel)'); 7855: my $default_form_data=&defaultFormData($symb); 7856: my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.'); 7857: my $nocourseid_alert = &mt("Please use the 'Select Course' link to open a separate window where you can search for a course to which a file can be uploaded."); 7858: $r->print(&Apache::lonhtmlcommon::scripttag(' 7859: function checkUpload(formname) { 7860: if (formname.upfile.value == "") { 7861: alert("'.$nofile_alert.'"); 7862: return false; 7863: } 7864: if (formname.courseid.value == "") { 7865: alert("'.$nocourseid_alert.'"); 7866: return false; 7867: } 7868: formname.submit(); 7869: } 7870: 7871: function ToSyllabus() { 7872: var cdom = '."'$dom'".'; 7873: var cnum = document.rules.courseid.value; 7874: if (cdom == "" || cdom == null) { 7875: return; 7876: } 7877: if (cnum == "" || cnum == null) { 7878: return; 7879: } 7880: syllwin=window.open("/public/"+cdom+"/"+cnum+"/syllabus","LONCAPASyllabus", 7881: "height=350,width=350,scrollbars=yes,menubar=no"); 7882: return; 7883: } 7884: 7885: ')); 7886: $r->print(' 7887: <h3>'.&mt('Send bubblesheet data to a course').'</h3> 7888: 7889: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post"> 7890: '.$default_form_data. 7891: &Apache::lonhtmlcommon::start_pick_box(). 7892: &Apache::lonhtmlcommon::row_title(&mt('Course ID')). 7893: '<input name="courseid" type="text" size="30" />'.$select_link. 7894: &Apache::lonhtmlcommon::row_closure(). 7895: &Apache::lonhtmlcommon::row_title(&mt('Course Name')). 7896: '<input name="coursename" type="text" size="30" />'.$syllabuslink. 7897: &Apache::lonhtmlcommon::row_closure(). 7898: &Apache::lonhtmlcommon::row_title(&mt('Domain')). 7899: '<input name="domainid" type="hidden" />'.$domdesc. 7900: &Apache::lonhtmlcommon::row_closure(). 7901: &Apache::lonhtmlcommon::row_title(&mt('File to upload')). 7902: '<input type="file" name="upfile" size="50" />'. 7903: &Apache::lonhtmlcommon::row_closure(1). 7904: &Apache::lonhtmlcommon::end_pick_box().'<br /> 7905: 7906: <input name="command" value="scantronupload_save" type="hidden" /> 7907: <input type="button" onclick="javascript:checkUpload(this.form);" value="'.&mt('Upload Bubblesheet Data').'" /> 7908: </form> 7909: '); 7910: return ''; 7911: } 7912: 7913: 7914: sub scantron_upload_scantron_data_save { 7915: my($r,$symb)=@_; 7916: my $doanotherupload= 7917: '<br /><form action="/adm/grades" method="post">'."\n". 7918: '<input type="hidden" name="command" value="scantronupload" />'."\n". 7919: '<input type="submit" name="submit" value="'.&mt('Do Another Upload').'" />'."\n". 7920: '</form>'."\n"; 7921: if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && 7922: !&Apache::lonnet::allowed('usc', 7923: $env{'form.domainid'}.'_'.$env{'form.courseid'})) { 7924: $r->print(&mt("You are not allowed to upload bubblesheet data to the requested course.")."<br />"); 7925: unless ($symb) { 7926: $r->print($doanotherupload); 7927: } 7928: return ''; 7929: } 7930: my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); 7931: my $uploadedfile; 7932: $r->print('<h3>'.&mt("Uploading file to [_1]",$coursedata{'description'}).'</h3>'); 7933: if (length($env{'form.upfile'}) < 2) { 7934: $r->print(&mt('[_1]Error:[_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.','<span class="LC_error">','</span>','<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>')); 7935: } else { 7936: my $result = 7937: &Apache::lonnet::userfileupload('upfile','','scantron','','','', 7938: $env{'form.courseid'},$env{'form.domainid'}); 7939: if ($result =~ m{^/uploaded/}) { 7940: $r->print(&mt('[_1]Success:[_2] Successfully uploaded [_3] bytes of data into location: [_4]', 7941: '<span class="LC_success">','</span>',(length($env{'form.upfile'})-1), 7942: '<span class="LC_filename">'.$result.'</span>')); 7943: ($uploadedfile) = ($result =~ m{/([^/]+)$}); 7944: $r->print(&validate_uploaded_scantron_file($env{'form.domainid'}, 7945: $env{'form.courseid'},$uploadedfile)); 7946: } else { 7947: $r->print(&mt('[_1]Error:[_2] An error ([_3]) occurred when attempting to upload the file, [_4]', 7948: '<span class="LC_error">','</span>',$result, 7949: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>')); 7950: } 7951: } 7952: if ($symb) { 7953: $r->print(&scantron_selectphase($r,$uploadedfile,$symb)); 7954: } else { 7955: $r->print($doanotherupload); 7956: } 7957: return ''; 7958: } 7959: 7960: sub validate_uploaded_scantron_file { 7961: my ($cdom,$cname,$fname) = @_; 7962: my $scanlines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.$fname); 7963: my @lines; 7964: if ($scanlines ne '-1') { 7965: @lines=split("\n",$scanlines,-1); 7966: } 7967: my $output; 7968: if (@lines) { 7969: my (%counts,$max_match_format); 7970: my ($max_match_count,$max_match_pct) = (0,0); 7971: my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cname); 7972: my %idmap = &username_to_idmap($classlist); 7973: foreach my $key (keys(%idmap)) { 7974: my $lckey = lc($key); 7975: $idmap{$lckey} = $idmap{$key}; 7976: } 7977: my %unique_formats; 7978: my @formatlines = &get_scantronformat_file(); 7979: foreach my $line (@formatlines) { 7980: chomp($line); 7981: my @config = split(/:/,$line); 7982: my $idstart = $config[5]; 7983: my $idlength = $config[6]; 7984: if (($idstart ne '') && ($idlength > 0)) { 7985: if (ref($unique_formats{$idstart.':'.$idlength}) eq 'ARRAY') { 7986: push(@{$unique_formats{$idstart.':'.$idlength}},$config[0].':'.$config[1]); 7987: } else { 7988: $unique_formats{$idstart.':'.$idlength} = [$config[0].':'.$config[1]]; 7989: } 7990: } 7991: } 7992: foreach my $key (keys(%unique_formats)) { 7993: my ($idstart,$idlength) = split(':',$key); 7994: %{$counts{$key}} = ( 7995: 'found' => 0, 7996: 'total' => 0, 7997: ); 7998: foreach my $line (@lines) { 7999: next if ($line =~ /^#/); 8000: next if ($line =~ /^[\s\cz]*$/); 8001: my $id = substr($line,$idstart-1,$idlength); 8002: $id = lc($id); 8003: if (exists($idmap{$id})) { 8004: $counts{$key}{'found'} ++; 8005: } 8006: $counts{$key}{'total'} ++; 8007: } 8008: if ($counts{$key}{'total'}) { 8009: my $percent_match = (100*$counts{$key}{'found'})/($counts{$key}{'total'}); 8010: if (($max_match_format eq '') || ($percent_match > $max_match_pct)) { 8011: $max_match_pct = $percent_match; 8012: $max_match_format = $key; 8013: $max_match_count = $counts{$key}{'total'}; 8014: } 8015: } 8016: } 8017: if (ref($unique_formats{$max_match_format}) eq 'ARRAY') { 8018: my $format_descs; 8019: my $numwithformat = @{$unique_formats{$max_match_format}}; 8020: for (my $i=0; $i<$numwithformat; $i++) { 8021: my ($name,$desc) = split(':',$unique_formats{$max_match_format}[$i]); 8022: if ($i<$numwithformat-2) { 8023: $format_descs .= '"<i>'.$desc.'</i>", '; 8024: } elsif ($i==$numwithformat-2) { 8025: $format_descs .= '"<i>'.$desc.'</i>" '.&mt('and').' '; 8026: } elsif ($i==$numwithformat-1) { 8027: $format_descs .= '"<i>'.$desc.'</i>"'; 8028: } 8029: } 8030: my $showpct = sprintf("%.0f",$max_match_pct).'%'; 8031: $output .= '<br />'.&mt('Comparison of student IDs in the uploaded file with the course roster found matches for [_1] of the [_2] entries in the file (for the format defined for [_3]).','<b>'.$showpct.'</b>','<b>'.$max_match_count.'</b>',$format_descs). 8032: '<br />'.&mt('A low percentage of matches results from one of the following:').'<ul>'. 8033: '<li>'.&mt('The file was uploaded to the wrong course').'</li>'. 8034: '<li>'.&mt('The data are not in the format expected for the domain: [_1]', 8035: '<i>'.$cdom.'</i>').'</li>'. 8036: '<li>'.&mt('Students did not bubble their IDs, or mis-bubbled them').'</li>'. 8037: '<li>'.&mt('The course roster is not up to date').'</li>'. 8038: '</ul>'; 8039: } 8040: } else { 8041: $output = '<span class="LC_warning">'.&mt('Uploaded file contained no data').'</span>'; 8042: } 8043: return $output; 8044: } 8045: 8046: sub valid_file { 8047: my ($requested_file)=@_; 8048: foreach my $filename (sort(&scantron_filenames())) { 8049: if ($requested_file eq $filename) { return 1; } 8050: } 8051: return 0; 8052: } 8053: 8054: sub scantron_download_scantron_data { 8055: my ($r,$symb)=@_; 8056: my $default_form_data=&defaultFormData($symb); 8057: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 8058: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 8059: my $file=$env{'form.scantron_selectfile'}; 8060: if (! &valid_file($file)) { 8061: $r->print(' 8062: <p> 8063: '.&mt('The requested file name was invalid.').' 8064: </p> 8065: '); 8066: return; 8067: } 8068: my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; 8069: my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file; 8070: my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file; 8071: &Apache::lonnet::allowuploaded('/adm/grades',$orig); 8072: &Apache::lonnet::allowuploaded('/adm/grades',$corrected); 8073: &Apache::lonnet::allowuploaded('/adm/grades',$skipped); 8074: $r->print(' 8075: <p> 8076: '.&mt('[_1]Original[_2] file as uploaded by the scantron office.', 8077: '<a href="'.$orig.'">','</a>').' 8078: </p> 8079: <p> 8080: '.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.', 8081: '<a href="'.$corrected.'">','</a>').' 8082: </p> 8083: <p> 8084: '.&mt('[_1]Skipped[_2], a file of records that were skipped.', 8085: '<a href="'.$skipped.'">','</a>').' 8086: </p> 8087: '); 8088: return ''; 8089: } 8090: 8091: sub checkscantron_results { 8092: my ($r,$symb) = @_; 8093: if (!$symb) {return '';} 8094: my $cid = $env{'request.course.id'}; 8095: my %lettdig = &letter_to_digits(); 8096: my $numletts = scalar(keys(%lettdig)); 8097: my $cnum = $env{'course.'.$cid.'.num'}; 8098: my $cdom = $env{'course.'.$cid.'.domain'}; 8099: my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); 8100: my %record; 8101: my %scantron_config = 8102: &Apache::grades::get_scantron_config($env{'form.scantron_format'}); 8103: my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile(); 8104: my $classlist=&Apache::loncoursedata::get_classlist(); 8105: my %idmap=&Apache::grades::username_to_idmap($classlist); 8106: my $navmap=Apache::lonnavmaps::navmap->new(); 8107: unless (ref($navmap)) { 8108: $r->print(&navmap_errormsg()); 8109: return ''; 8110: } 8111: my $map=$navmap->getResourceByUrl($sequence); 8112: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8113: my (%grader_partids_by_symb,%grader_randomlists_by_symb); 8114: &graders_resources_pass(\@resources,\%grader_partids_by_symb, \%grader_randomlists_by_symb); 8115: 8116: my ($uname,$udom); 8117: my (%scandata,%lastname,%bylast); 8118: $r->print(' 8119: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n"); 8120: 8121: my @delayqueue; 8122: my %completedstudents; 8123: 8124: my $count=&Apache::grades::get_todo_count($scanlines,$scan_data); 8125: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet/Submissions Comparison Status', 8126: 'Progress of Bubblesheet Data/Submission Records Comparison',$count, 8127: 'inline',undef,'checkscantron'); 8128: my ($username,$domain,$started); 8129: my $nav_error; 8130: &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse. 8131: if ($nav_error) { 8132: $r->print(&navmap_errormsg()); 8133: return ''; 8134: } 8135: 8136: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 8137: 'Processing first student'); 8138: my $start=&Time::HiRes::time(); 8139: my $i=-1; 8140: 8141: while ($i<$scanlines->{'count'}) { 8142: ($username,$domain,$uname)=('','',''); 8143: $i++; 8144: my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i); 8145: if ($line=~/^[\s\cz]*$/) { next; } 8146: if ($started) { 8147: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, 8148: 'last student'); 8149: } 8150: $started=1; 8151: my $scan_record= 8152: &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config, 8153: $scan_data); 8154: unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data, 8155: \%idmap,$i)) { 8156: &Apache::grades::scantron_add_delay(\@delayqueue,$line, 8157: 'Unable to find a student that matches',1); 8158: next; 8159: } 8160: if (exists $completedstudents{$uname}) { 8161: &Apache::grades::scantron_add_delay(\@delayqueue,$line, 8162: 'Student '.$uname.' has multiple sheets',2); 8163: next; 8164: } 8165: my $pid = $scan_record->{'scantron.ID'}; 8166: $lastname{$pid} = $scan_record->{'scantron.LastName'}; 8167: push(@{$bylast{$lastname{$pid}}},$pid); 8168: my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; 8169: $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos); 8170: chomp($scandata{$pid}); 8171: $scandata{$pid} =~ s/\r$//; 8172: ($username,$domain)=split(/:/,$uname); 8173: my $counter = -1; 8174: foreach my $resource (@resources) { 8175: my $parts; 8176: my $ressymb = $resource->symb(); 8177: if ((exists($grader_randomlists_by_symb{$ressymb})) || 8178: (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { 8179: (my $analysis,$parts) = 8180: &scantron_partids_tograde($resource,$env{'request.course.id'},$username,$domain); 8181: } else { 8182: $parts = $grader_partids_by_symb{$ressymb}; 8183: } 8184: ($counter,my $recording) = 8185: &verify_scantron_grading($resource,$domain,$username,$cid,$counter, 8186: $scandata{$pid},$parts, 8187: \%scantron_config,\%lettdig,$numletts); 8188: $record{$pid} .= $recording; 8189: } 8190: } 8191: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 8192: $r->print('<br />'); 8193: my ($okstudents,$badstudents,$numstudents,$passed,$failed); 8194: $passed = 0; 8195: $failed = 0; 8196: $numstudents = 0; 8197: foreach my $last (sort(keys(%bylast))) { 8198: if (ref($bylast{$last}) eq 'ARRAY') { 8199: foreach my $pid (sort(@{$bylast{$last}})) { 8200: my $showscandata = $scandata{$pid}; 8201: my $showrecord = $record{$pid}; 8202: $showscandata =~ s/\s/ /g; 8203: $showrecord =~ s/\s/ /g; 8204: if ($scandata{$pid} eq $record{$pid}) { 8205: my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row'; 8206: $okstudents .= '<tr class="'.$css_class.'">'. 8207: '<td>'.&mt('Bubblesheet').'</td><td>'.$showscandata.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n". 8208: '</tr>'."\n". 8209: '<tr class="'.$css_class.'">'."\n". 8210: '<td>Submissions</td><td>'.$showrecord.'</td></tr>'."\n"; 8211: $passed ++; 8212: } else { 8213: my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row'; 8214: $badstudents .= '<tr class="'.$css_class.'"><td>'.&mt('Bubblesheet').'</td><td><span class="LC_nobreak">'.$scandata{$pid}.'</span></td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n". 8215: '</tr>'."\n". 8216: '<tr class="'.$css_class.'">'."\n". 8217: '<td>Submissions</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n". 8218: '</tr>'."\n"; 8219: $failed ++; 8220: } 8221: $numstudents ++; 8222: } 8223: } 8224: } 8225: $r->print( 8226: '<p>' 8227: .&mt('Comparison of bubblesheet data (including corrections) with corresponding submission records (most recent submission) for [_1][quant,_2,student][_3] ([quant,_4,bubblesheet line] per student).', 8228: '<b>', 8229: $numstudents, 8230: '</b>', 8231: $env{'form.scantron_maxbubble'}) 8232: .'</p>' 8233: ); 8234: $r->print('<p>'.&mt('Exact matches for <b>[quant,_1,student]</b>.',$passed).'<br />'.&mt('Discrepancies detected for <b>[quant,_1,student]</b>.',$failed).'</p>'); 8235: if ($passed) { 8236: $r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />'); 8237: $r->print(&Apache::loncommon::start_data_table()."\n". 8238: &Apache::loncommon::start_data_table_header_row()."\n". 8239: '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'. 8240: &Apache::loncommon::end_data_table_header_row()."\n". 8241: $okstudents."\n". 8242: &Apache::loncommon::end_data_table().'<br />'); 8243: } 8244: if ($failed) { 8245: $r->print(&mt('Students with differences between bubblesheet data and submissions are as follows:').'<br /><br />'); 8246: $r->print(&Apache::loncommon::start_data_table()."\n". 8247: &Apache::loncommon::start_data_table_header_row()."\n". 8248: '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'. 8249: &Apache::loncommon::end_data_table_header_row()."\n". 8250: $badstudents."\n". 8251: &Apache::loncommon::end_data_table()).'<br />'. 8252: &mt('Differences can occur if submissions were modified using manual grading after a bubblesheet grading pass.').'<br />'.&mt('If unexpected discrepancies were detected, it is recommended that you inspect the original bubblesheets.'); 8253: } 8254: $r->print('</form><br />'); 8255: return; 8256: } 8257: 8258: sub verify_scantron_grading { 8259: my ($resource,$domain,$username,$cid,$counter,$scandata,$partids, 8260: $scantron_config,$lettdig,$numletts) = @_; 8261: my ($record,%expected,%startpos); 8262: return ($counter,$record) if (!ref($resource)); 8263: return ($counter,$record) if (!$resource->is_problem()); 8264: my $symb = $resource->symb(); 8265: return ($counter,$record) if (ref($partids) ne 'ARRAY'); 8266: foreach my $part_id (@{$partids}) { 8267: $counter ++; 8268: $expected{$part_id} = 0; 8269: if ($env{"form.scantron.sub_bubblelines.$counter"}) { 8270: my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"}); 8271: foreach my $item (@sub_lines) { 8272: $expected{$part_id} += $item; 8273: } 8274: } else { 8275: $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"}; 8276: } 8277: $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"}; 8278: } 8279: if ($symb) { 8280: my %recorded; 8281: my (%returnhash) = &Apache::lonnet::restore($symb,$cid,$domain,$username); 8282: if ($returnhash{'version'}) { 8283: my %lasthash=(); 8284: my $version; 8285: for ($version=1;$version<=$returnhash{'version'};$version++) { 8286: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) { 8287: $lasthash{$key}=$returnhash{$version.':'.$key}; 8288: } 8289: } 8290: foreach my $key (keys(%lasthash)) { 8291: if ($key =~ /\.scantron$/) { 8292: my $value = &unescape($lasthash{$key}); 8293: my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/); 8294: if ($value eq '') { 8295: for (my $i=0; $i<$expected{$part_id}; $i++) { 8296: for (my $j=0; $j<$scantron_config->{'length'}; $j++) { 8297: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 8298: } 8299: } 8300: } else { 8301: my @tocheck; 8302: my @items = split(//,$value); 8303: if (($scantron_config->{'Qon'} eq 'letter') || 8304: ($scantron_config->{'Qon'} eq 'number')) { 8305: if (@items < $expected{$part_id}) { 8306: my $fragment = substr($scandata,$startpos{$part_id},$expected{$part_id}); 8307: my @singles = split(//,$fragment); 8308: foreach my $pos (@singles) { 8309: if ($pos eq ' ') { 8310: push(@tocheck,$pos); 8311: } else { 8312: my $next = shift(@items); 8313: push(@tocheck,$next); 8314: } 8315: } 8316: } else { 8317: @tocheck = @items; 8318: } 8319: foreach my $letter (@tocheck) { 8320: if ($scantron_config->{'Qon'} eq 'letter') { 8321: if ($letter !~ /^[A-J]$/) { 8322: $letter = $scantron_config->{'Qoff'}; 8323: } 8324: $recorded{$part_id} .= $letter; 8325: } elsif ($scantron_config->{'Qon'} eq 'number') { 8326: my $digit; 8327: if ($letter !~ /^[A-J]$/) { 8328: $digit = $scantron_config->{'Qoff'}; 8329: } else { 8330: $digit = $lettdig->{$letter}; 8331: } 8332: $recorded{$part_id} .= $digit; 8333: } 8334: } 8335: } else { 8336: @tocheck = @items; 8337: for (my $i=0; $i<$expected{$part_id}; $i++) { 8338: my $curr_sub = shift(@tocheck); 8339: my $digit; 8340: if ($curr_sub =~ /^[A-J]$/) { 8341: $digit = $lettdig->{$curr_sub}-1; 8342: } 8343: if ($curr_sub eq 'J') { 8344: $digit += scalar($numletts); 8345: } 8346: for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) { 8347: if ($j == $digit) { 8348: $recorded{$part_id} .= $scantron_config->{'Qon'}; 8349: } else { 8350: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 8351: } 8352: } 8353: } 8354: } 8355: } 8356: } 8357: } 8358: } 8359: foreach my $part_id (@{$partids}) { 8360: if ($recorded{$part_id} eq '') { 8361: for (my $i=0; $i<$expected{$part_id}; $i++) { 8362: for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) { 8363: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 8364: } 8365: } 8366: } 8367: $record .= $recorded{$part_id}; 8368: } 8369: } 8370: return ($counter,$record); 8371: } 8372: 8373: sub letter_to_digits { 8374: my %lettdig = ( 8375: A => 1, 8376: B => 2, 8377: C => 3, 8378: D => 4, 8379: E => 5, 8380: F => 6, 8381: G => 7, 8382: H => 8, 8383: I => 9, 8384: J => 0, 8385: ); 8386: return %lettdig; 8387: } 8388: 8389: 8390: #-------- end of section for handling grading scantron forms ------- 8391: # 8392: #------------------------------------------------------------------- 8393: 8394: #-------------------------- Menu interface ------------------------- 8395: # 8396: #--- Href with symb and command --- 8397: 8398: sub href_symb_cmd { 8399: my ($symb,$cmd)=@_; 8400: return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&command='.$cmd; 8401: } 8402: 8403: sub grading_menu { 8404: my ($request,$symb) = @_; 8405: if (!$symb) {return '';} 8406: 8407: my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb), 8408: 'command'=>'individual'); 8409: 8410: my $url1a = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 8411: 8412: $fields{'command'}='ungraded'; 8413: my $url1b=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 8414: 8415: $fields{'command'}='table'; 8416: my $url1c=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 8417: 8418: $fields{'command'}='all_for_one'; 8419: my $url1d=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 8420: 8421: $fields{'command'}='downloadfilesselect'; 8422: my $url1e=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 8423: 8424: $fields{'command'} = 'csvform'; 8425: my $url2 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 8426: 8427: $fields{'command'} = 'processclicker'; 8428: my $url3 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 8429: 8430: $fields{'command'} = 'scantron_selectphase'; 8431: my $url4 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 8432: 8433: $fields{'command'} = 'initialverifyreceipt'; 8434: my $url5 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 8435: 8436: my @menu = ({ categorytitle=>'Hand Grading', 8437: items =>[ 8438: { linktext => 'Select individual students to grade', 8439: url => $url1a, 8440: permission => 'F', 8441: icon => 'grade_students.png', 8442: linktitle => 'Grade current resource for a selection of students.' 8443: }, 8444: { linktext => 'Grade ungraded submissions.', 8445: url => $url1b, 8446: permission => 'F', 8447: icon => 'ungrade_sub.png', 8448: linktitle => 'Grade all submissions that have not been graded yet.' 8449: }, 8450: 8451: { linktext => 'Grading table', 8452: url => $url1c, 8453: permission => 'F', 8454: icon => 'grading_table.png', 8455: linktitle => 'Grade current resource for all students.' 8456: }, 8457: { linktext => 'Grade page/folder for one student', 8458: url => $url1d, 8459: permission => 'F', 8460: icon => 'grade_PageFolder.png', 8461: linktitle => 'Grade all resources in current page/sequence/folder for one student.' 8462: }, 8463: { linktext => 'Download submissions', 8464: url => $url1e, 8465: permission => 'F', 8466: icon => 'download_sub.png', 8467: linktitle => 'Download all students submissions.' 8468: }]}, 8469: { categorytitle=>'Automated Grading', 8470: items =>[ 8471: 8472: { linktext => 'Upload Scores', 8473: url => $url2, 8474: permission => 'F', 8475: icon => 'uploadscores.png', 8476: linktitle => 'Specify a file containing the class scores for current resource.' 8477: }, 8478: { linktext => 'Process Clicker', 8479: url => $url3, 8480: permission => 'F', 8481: icon => 'addClickerInfoFile.png', 8482: linktitle => 'Specify a file containing the clicker information for this resource.' 8483: }, 8484: { linktext => 'Grade/Manage/Review Bubblesheets', 8485: url => $url4, 8486: permission => 'F', 8487: icon => 'bubblesheet.png', 8488: linktitle => 'Grade bubblesheet exams, upload/download bubblesheet data files, and review previously graded bubblesheet exams.' 8489: }, 8490: { linktext => 'Verify Receipt Number', 8491: url => $url5, 8492: permission => 'F', 8493: icon => 'receipt_number.png', 8494: linktitle => 'Verify a system-generated receipt number for correct problem solution.' 8495: } 8496: 8497: ] 8498: }); 8499: 8500: # Create the menu 8501: my $Str; 8502: $Str .= '<form method="post" action="" name="gradingMenu">'; 8503: $Str .= '<input type="hidden" name="command" value="" />'. 8504: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 8505: 8506: $Str .= &Apache::lonhtmlcommon::generate_menu(@menu); 8507: return $Str; 8508: } 8509: 8510: 8511: sub ungraded { 8512: my ($request)=@_; 8513: &submit_options($request); 8514: } 8515: 8516: sub submit_options_sequence { 8517: my ($request,$symb) = @_; 8518: if (!$symb) {return '';} 8519: &commonJSfunctions($request); 8520: my $result; 8521: 8522: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 8523: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 8524: $result.=&selectfield(0). 8525: '<input type="hidden" name="command" value="pickStudentPage" /> 8526: <div> 8527: <input type="submit" value="'.&mt('Next').' →" /> 8528: </div> 8529: </div> 8530: </form>'; 8531: return $result; 8532: } 8533: 8534: sub submit_options_table { 8535: my ($request,$symb) = @_; 8536: if (!$symb) {return '';} 8537: &commonJSfunctions($request); 8538: my $result; 8539: 8540: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 8541: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 8542: 8543: $result.=&selectfield(0). 8544: '<input type="hidden" name="command" value="viewgrades" /> 8545: <div> 8546: <input type="submit" value="'.&mt('Next').' →" /> 8547: </div> 8548: </div> 8549: </form>'; 8550: return $result; 8551: } 8552: 8553: sub submit_options_download { 8554: my ($request,$symb) = @_; 8555: if (!$symb) {return '';} 8556: 8557: &commonJSfunctions($request); 8558: 8559: my $result='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 8560: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 8561: $result.=' 8562: <h2> 8563: '.&mt('Select Students for Which to Download Submissions').' 8564: </h2>'.&selectfield(1).' 8565: <input type="hidden" name="command" value="downloadfileslink" /> 8566: <input type="submit" value="'.&mt('Next').' →" /> 8567: </div> 8568: </div> 8569: 8570: 8571: </form>'; 8572: return $result; 8573: } 8574: 8575: #--- Displays the submissions first page ------- 8576: sub submit_options { 8577: my ($request,$symb) = @_; 8578: if (!$symb) {return '';} 8579: 8580: &commonJSfunctions($request); 8581: my $result; 8582: 8583: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 8584: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 8585: $result.=&selectfield(1).' 8586: <input type="hidden" name="command" value="submission" /> 8587: <input type="submit" value="'.&mt('Next').' →" /> 8588: </div> 8589: </div> 8590: 8591: 8592: </form>'; 8593: return $result; 8594: } 8595: 8596: sub selectfield { 8597: my ($full)=@_; 8598: my %options = 8599: (&Apache::lonlocal::texthash( 8600: 'yes' => 'with submissions', 8601: 'queued' => 'in grading queue', 8602: 'graded' => 'with ungraded submissions', 8603: 'incorrect' => 'with incorrect submissions', 8604: 'all' => 'with any status'), 8605: 'select_form_order' => ['yes','queued','graded','incorrect','all']); 8606: my $result='<div class="LC_columnSection"> 8607: 8608: <fieldset> 8609: <legend> 8610: '.&mt('Sections').' 8611: </legend> 8612: '.&Apache::lonstatistics::SectionSelect('section','multiple',5).' 8613: </fieldset> 8614: 8615: <fieldset> 8616: <legend> 8617: '.&mt('Groups').' 8618: </legend> 8619: '.&Apache::lonstatistics::GroupSelect('group','multiple',5).' 8620: </fieldset> 8621: 8622: <fieldset> 8623: <legend> 8624: '.&mt('Access Status').' 8625: </legend> 8626: '.&Apache::lonhtmlcommon::StatusOptions(undef,undef,5,undef,'mult').' 8627: </fieldset>'; 8628: if ($full) { 8629: $result.=' 8630: <fieldset> 8631: <legend> 8632: '.&mt('Submission Status').' 8633: </legend>'. 8634: &Apache::loncommon::select_form('all','submitonly',\%options). 8635: '</fieldset>'; 8636: } 8637: $result.='</div><br />'; 8638: return $result; 8639: } 8640: 8641: sub reset_perm { 8642: undef(%perm); 8643: } 8644: 8645: sub init_perm { 8646: &reset_perm(); 8647: foreach my $test_perm ('vgr','mgr','opa') { 8648: 8649: my $scope = $env{'request.course.id'}; 8650: if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) { 8651: 8652: $scope .= '/'.$env{'request.course.sec'}; 8653: if ( $perm{$test_perm}= 8654: &Apache::lonnet::allowed($test_perm,$scope)) { 8655: $perm{$test_perm.'_section'}=$env{'request.course.sec'}; 8656: } else { 8657: delete($perm{$test_perm}); 8658: } 8659: } 8660: } 8661: } 8662: 8663: sub gather_clicker_ids { 8664: my %clicker_ids; 8665: 8666: my $classlist = &Apache::loncoursedata::get_classlist(); 8667: 8668: # Set up a couple variables. 8669: my $username_idx = &Apache::loncoursedata::CL_SNAME(); 8670: my $domain_idx = &Apache::loncoursedata::CL_SDOM(); 8671: my $status_idx = &Apache::loncoursedata::CL_STATUS(); 8672: 8673: foreach my $student (keys(%$classlist)) { 8674: if ($classlist->{$student}->[$status_idx] ne 'Active') { next; } 8675: my $username = $classlist->{$student}->[$username_idx]; 8676: my $domain = $classlist->{$student}->[$domain_idx]; 8677: my $clickers = 8678: (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; 8679: foreach my $id (split(/\,/,$clickers)) { 8680: $id=~s/^[\#0]+//; 8681: $id=~s/[\-\:]//g; 8682: if (exists($clicker_ids{$id})) { 8683: $clicker_ids{$id}.=','.$username.':'.$domain; 8684: } else { 8685: $clicker_ids{$id}=$username.':'.$domain; 8686: } 8687: } 8688: } 8689: return %clicker_ids; 8690: } 8691: 8692: sub gather_adv_clicker_ids { 8693: my %clicker_ids; 8694: my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; 8695: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 8696: my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum); 8697: foreach my $element (sort(keys(%coursepersonnel))) { 8698: foreach my $person (split(/\,/,$coursepersonnel{$element})) { 8699: my ($puname,$pudom)=split(/\:/,$person); 8700: my $clickers = 8701: (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; 8702: foreach my $id (split(/\,/,$clickers)) { 8703: $id=~s/^[\#0]+//; 8704: $id=~s/[\-\:]//g; 8705: if (exists($clicker_ids{$id})) { 8706: $clicker_ids{$id}.=','.$puname.':'.$pudom; 8707: } else { 8708: $clicker_ids{$id}=$puname.':'.$pudom; 8709: } 8710: } 8711: } 8712: } 8713: return %clicker_ids; 8714: } 8715: 8716: sub clicker_grading_parameters { 8717: return ('gradingmechanism' => 'scalar', 8718: 'upfiletype' => 'scalar', 8719: 'specificid' => 'scalar', 8720: 'pcorrect' => 'scalar', 8721: 'pincorrect' => 'scalar'); 8722: } 8723: 8724: sub process_clicker { 8725: my ($r,$symb)=@_; 8726: if (!$symb) {return '';} 8727: my $result=&checkforfile_js(); 8728: $result.=&Apache::loncommon::start_data_table(). 8729: &Apache::loncommon::start_data_table_header_row(). 8730: '<th>'.&mt('Specify a file containing clicker information and set grading options.').'</th>'. 8731: &Apache::loncommon::end_data_table_header_row(). 8732: &Apache::loncommon::start_data_table_row()."<td>\n"; 8733: # Attempt to restore parameters from last session, set defaults if not present 8734: my %Saveable_Parameters=&clicker_grading_parameters(); 8735: &Apache::loncommon::restore_course_settings('grades_clicker', 8736: \%Saveable_Parameters); 8737: if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; } 8738: if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; } 8739: if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; } 8740: if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; } 8741: 8742: my %checked; 8743: foreach my $gradingmechanism ('attendance','personnel','specific','given') { 8744: if ($env{'form.gradingmechanism'} eq $gradingmechanism) { 8745: $checked{$gradingmechanism}=' checked="checked"'; 8746: } 8747: } 8748: 8749: my $upload=&mt("Evaluate File"); 8750: my $type=&mt("Type"); 8751: my $attendance=&mt("Award points just for participation"); 8752: my $personnel=&mt("Correctness determined from response by course personnel"); 8753: my $specific=&mt("Correctness determined from response with clicker ID(s)"); 8754: my $given=&mt("Correctness determined from given list of answers").' '. 8755: '<font size="-2"><tt>('.&mt("Provide comma-separated list. Use '*' for any answer correct, '-' for skip").')</tt></font>'; 8756: my $pcorrect=&mt("Percentage points for correct solution"); 8757: my $pincorrect=&mt("Percentage points for incorrect solution"); 8758: my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', 8759: {'iclicker' => 'i>clicker', 8760: 'interwrite' => 'interwrite PRS'}); 8761: $symb = &Apache::lonenc::check_encrypt($symb); 8762: $result.= &Apache::lonhtmlcommon::scripttag(<<ENDUPFORM); 8763: function sanitycheck() { 8764: // Accept only integer percentages 8765: document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value); 8766: document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value); 8767: // Find out grading choice 8768: for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) { 8769: if (document.forms.gradesupload.gradingmechanism[i].checked) { 8770: gradingchoice=document.forms.gradesupload.gradingmechanism[i].value; 8771: } 8772: } 8773: // By default, new choice equals user selection 8774: newgradingchoice=gradingchoice; 8775: // Not good to give more points for false answers than correct ones 8776: if (Math.round(document.forms.gradesupload.pcorrect.value)<Math.round(document.forms.gradesupload.pincorrect.value)) { 8777: document.forms.gradesupload.pcorrect.value=document.forms.gradesupload.pincorrect.value; 8778: } 8779: // If new choice is attendance only, and old choice was correctness-based, restore defaults 8780: if ((gradingchoice=='attendance') && (document.forms.gradesupload.waschecked.value!='attendance')) { 8781: document.forms.gradesupload.pcorrect.value=100; 8782: document.forms.gradesupload.pincorrect.value=100; 8783: } 8784: // If the values are different, cannot be attendance only 8785: if ((Math.round(document.forms.gradesupload.pcorrect.value)!=Math.round(document.forms.gradesupload.pincorrect.value)) && 8786: (gradingchoice=='attendance')) { 8787: newgradingchoice='personnel'; 8788: } 8789: // Change grading choice to new one 8790: for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) { 8791: if (document.forms.gradesupload.gradingmechanism[i].value==newgradingchoice) { 8792: document.forms.gradesupload.gradingmechanism[i].checked=true; 8793: } else { 8794: document.forms.gradesupload.gradingmechanism[i].checked=false; 8795: } 8796: } 8797: // Remember the old state 8798: document.forms.gradesupload.waschecked.value=newgradingchoice; 8799: } 8800: ENDUPFORM 8801: $result.= <<ENDUPFORM; 8802: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 8803: <input type="hidden" name="symb" value="$symb" /> 8804: <input type="hidden" name="command" value="processclickerfile" /> 8805: <input type="file" name="upfile" size="50" /> 8806: <br /><label>$type: $selectform</label> 8807: ENDUPFORM 8808: $result.='</td>'.&Apache::loncommon::end_data_table_row(). 8809: &Apache::loncommon::start_data_table_row().'<td>'.(<<ENDGRADINGFORM); 8810: <label><input type="radio" name="gradingmechanism" value="attendance"$checked{'attendance'} onclick="sanitycheck()" />$attendance </label> 8811: <br /><label><input type="radio" name="gradingmechanism" value="personnel"$checked{'personnel'} onclick="sanitycheck()" />$personnel</label> 8812: <br /><label><input type="radio" name="gradingmechanism" value="specific"$checked{'specific'} onclick="sanitycheck()" />$specific </label> 8813: <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" /> 8814: <br /><label><input type="radio" name="gradingmechanism" value="given"$checked{'given'} onclick="sanitycheck()" />$given </label> 8815: <br />    8816: <input type="text" name="givenanswer" size="50" /> 8817: <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" /> 8818: ENDGRADINGFORM 8819: $result.='</td>'.&Apache::loncommon::end_data_table_row(). 8820: &Apache::loncommon::start_data_table_row().'<td>'.(<<ENDPERCFORM); 8821: <label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onchange="sanitycheck()" /></label> 8822: <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onchange="sanitycheck()" /></label> 8823: <br /><input type="button" onclick="javascript:checkUpload(this.form);" value="$upload" /> 8824: </form>' 8825: ENDPERCFORM 8826: $result.='</td>'. 8827: &Apache::loncommon::end_data_table_row(). 8828: &Apache::loncommon::end_data_table(); 8829: return $result; 8830: } 8831: 8832: sub process_clicker_file { 8833: my ($r,$symb)=@_; 8834: if (!$symb) {return '';} 8835: 8836: my %Saveable_Parameters=&clicker_grading_parameters(); 8837: &Apache::loncommon::store_course_settings('grades_clicker', 8838: \%Saveable_Parameters); 8839: my $result=''; 8840: if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { 8841: $result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>'; 8842: return $result; 8843: } 8844: if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\S/)) { 8845: $result.='<span class="LC_error">'.&mt('You need to specify the correct answer').'</span>'; 8846: return $result; 8847: } 8848: my $foundgiven=0; 8849: if ($env{'form.gradingmechanism'} eq 'given') { 8850: $env{'form.givenanswer'}=~s/^\s*//gs; 8851: $env{'form.givenanswer'}=~s/\s*$//gs; 8852: $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-\+]+/\,/g; 8853: $env{'form.givenanswer'}=uc($env{'form.givenanswer'}); 8854: my @answers=split(/\,/,$env{'form.givenanswer'}); 8855: $foundgiven=$#answers+1; 8856: } 8857: my %clicker_ids=&gather_clicker_ids(); 8858: my %correct_ids; 8859: if ($env{'form.gradingmechanism'} eq 'personnel') { 8860: %correct_ids=&gather_adv_clicker_ids(); 8861: } 8862: if ($env{'form.gradingmechanism'} eq 'specific') { 8863: foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; 8864: $correct_id=~tr/a-z/A-Z/; 8865: $correct_id=~s/\s//gs; 8866: $correct_id=~s/^[\#0]+//; 8867: $correct_id=~s/[\-\:]//g; 8868: if ($correct_id) { 8869: $correct_ids{$correct_id}='specified'; 8870: } 8871: } 8872: } 8873: if ($env{'form.gradingmechanism'} eq 'attendance') { 8874: $result.=&mt('Score based on attendance only'); 8875: } elsif ($env{'form.gradingmechanism'} eq 'given') { 8876: $result.=&mt('Score based on [_1] ([_2] answers)','<tt>'.$env{'form.givenanswer'}.'</tt>',$foundgiven); 8877: } else { 8878: my $number=0; 8879: $result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>'; 8880: foreach my $id (sort(keys(%correct_ids))) { 8881: $result.='<br /><tt>'.$id.'</tt> - '; 8882: if ($correct_ids{$id} eq 'specified') { 8883: $result.=&mt('specified'); 8884: } else { 8885: my ($uname,$udom)=split(/\:/,$correct_ids{$id}); 8886: $result.=&Apache::loncommon::plainname($uname,$udom); 8887: } 8888: $number++; 8889: } 8890: $result.="</p>\n"; 8891: if ($number==0) { 8892: $result.='<span class="LC_error">'.&mt('No IDs found to determine correct answer').'</span>'; 8893: return $result; 8894: } 8895: } 8896: if (length($env{'form.upfile'}) < 2) { 8897: $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.', 8898: '<span class="LC_error">', 8899: '</span>', 8900: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'); 8901: return $result; 8902: } 8903: 8904: # Were able to get all the info needed, now analyze the file 8905: 8906: $result.=&Apache::loncommon::studentbrowser_javascript(); 8907: $symb = &Apache::lonenc::check_encrypt($symb); 8908: $result.=&Apache::loncommon::start_data_table(). 8909: &Apache::loncommon::start_data_table_header_row(). 8910: '<th>'.&mt('Evaluate clicker file').'</th>'. 8911: &Apache::loncommon::end_data_table_header_row(). 8912: &Apache::loncommon::start_data_table_row().(<<ENDHEADER); 8913: <td> 8914: <form method="post" action="/adm/grades" name="clickeranalysis"> 8915: <input type="hidden" name="symb" value="$symb" /> 8916: <input type="hidden" name="command" value="assignclickergrades" /> 8917: <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" /> 8918: <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" /> 8919: <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" /> 8920: ENDHEADER 8921: if ($env{'form.gradingmechanism'} eq 'given') { 8922: $result.='<input type="hidden" name="correct:given" value="'.$env{'form.givenanswer'}.'" />'; 8923: } 8924: my %responses; 8925: my @questiontitles; 8926: my $errormsg=''; 8927: my $number=0; 8928: if ($env{'form.upfiletype'} eq 'iclicker') { 8929: ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); 8930: } 8931: if ($env{'form.upfiletype'} eq 'interwrite') { 8932: ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); 8933: } 8934: $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'. 8935: '<input type="hidden" name="number" value="'.$number.'" />'. 8936: &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', 8937: $env{'form.pcorrect'},$env{'form.pincorrect'}). 8938: '<br />'; 8939: if (($env{'form.gradingmechanism'} eq 'given') && ($number!=$foundgiven)) { 8940: $result.='<span class="LC_error">'.&mt('Number of given answers does not agree with number of questions in file.').'</span>'; 8941: return $result; 8942: } 8943: # Remember Question Titles 8944: # FIXME: Possibly need delimiter other than ":" 8945: for (my $i=0;$i<$number;$i++) { 8946: $result.='<input type="hidden" name="question:'.$i.'" value="'. 8947: &HTML::Entities::encode($questiontitles[$i],'"&<>').'" />'; 8948: } 8949: my $correct_count=0; 8950: my $student_count=0; 8951: my $unknown_count=0; 8952: # Match answers with usernames 8953: # FIXME: Possibly need delimiter other than ":" 8954: foreach my $id (keys(%responses)) { 8955: if ($correct_ids{$id}) { 8956: $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />'; 8957: $correct_count++; 8958: } elsif ($clicker_ids{$id}) { 8959: if ($clicker_ids{$id}=~/\,/) { 8960: # More than one user with the same clicker! 8961: $result.="</td>".&Apache::loncommon::end_data_table_row(). 8962: &Apache::loncommon::start_data_table_row()."<td>". 8963: &mt('Clicker registered more than once').": <tt>".$id."</tt><br />"; 8964: $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'. 8965: "<select name='multi".$id."'>"; 8966: foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) { 8967: $result.="<option value='".$reguser."'>".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.')</option>'; 8968: } 8969: $result.='</select>'; 8970: $unknown_count++; 8971: } else { 8972: # Good: found one and only one user with the right clicker 8973: $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />'; 8974: $student_count++; 8975: } 8976: } else { 8977: $result.="</td>".&Apache::loncommon::end_data_table_row(). 8978: &Apache::loncommon::start_data_table_row()."<td>". 8979: &mt('Unregistered Clicker')." <tt>".$id."</tt><br />"; 8980: $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'. 8981: "\n".&mt("Username").": <input type='text' name='uname".$id."' /> ". 8982: "\n".&mt("Domain").": ". 8983: &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '. 8984: &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id,0,$id); 8985: $unknown_count++; 8986: } 8987: } 8988: $result.='<hr />'. 8989: &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); 8990: if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) { 8991: if ($correct_count==0) { 8992: $errormsg.="Found no correct answers answers for grading!"; 8993: } elsif ($correct_count>1) { 8994: $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>'; 8995: } 8996: } 8997: if ($number<1) { 8998: $errormsg.="Found no questions."; 8999: } 9000: if ($errormsg) { 9001: $result.='<br /><span class="LC_error">'.&mt($errormsg).'</span>'; 9002: } else { 9003: $result.='<br /><input type="submit" name="finalize" value="'.&mt('Finalize Grading').'" />'; 9004: } 9005: $result.='</form></td>'. 9006: &Apache::loncommon::end_data_table_row(). 9007: &Apache::loncommon::end_data_table(); 9008: return $result; 9009: } 9010: 9011: sub iclicker_eval { 9012: my ($questiontitles,$responses)=@_; 9013: my $number=0; 9014: my $errormsg=''; 9015: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 9016: my %components=&Apache::loncommon::record_sep($line); 9017: my @entries=map {$components{$_}} (sort(keys(%components))); 9018: if ($entries[0] eq 'Question') { 9019: for (my $i=3;$i<$#entries;$i+=6) { 9020: $$questiontitles[$number]=$entries[$i]; 9021: $number++; 9022: } 9023: } 9024: if ($entries[0]=~/^\#/) { 9025: my $id=$entries[0]; 9026: my @idresponses; 9027: $id=~s/^[\#0]+//; 9028: for (my $i=0;$i<$number;$i++) { 9029: my $idx=3+$i*6; 9030: $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+]+//g; 9031: push(@idresponses,$entries[$idx]); 9032: } 9033: $$responses{$id}=join(',',@idresponses); 9034: } 9035: } 9036: return ($errormsg,$number); 9037: } 9038: 9039: sub interwrite_eval { 9040: my ($questiontitles,$responses)=@_; 9041: my $number=0; 9042: my $errormsg=''; 9043: my $skipline=1; 9044: my $questionnumber=0; 9045: my %idresponses=(); 9046: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 9047: my %components=&Apache::loncommon::record_sep($line); 9048: my @entries=map {$components{$_}} (sort(keys(%components))); 9049: if ($entries[1] eq 'Time') { $skipline=0; next; } 9050: if ($entries[1] eq 'Response') { $skipline=1; } 9051: next if $skipline; 9052: if ($entries[0]!=$questionnumber) { 9053: $questionnumber=$entries[0]; 9054: $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); 9055: $number++; 9056: } 9057: my $id=$entries[4]; 9058: $id=~s/^[\#0]+//; 9059: $id=~s/^v\d*\://i; 9060: $id=~s/[\-\:]//g; 9061: $idresponses{$id}[$number]=$entries[6]; 9062: } 9063: foreach my $id (keys(%idresponses)) { 9064: $$responses{$id}=join(',',@{$idresponses{$id}}); 9065: $$responses{$id}=~s/^\s*\,//; 9066: } 9067: return ($errormsg,$number); 9068: } 9069: 9070: sub assign_clicker_grades { 9071: my ($r,$symb)=@_; 9072: if (!$symb) {return '';} 9073: # See which part we are saving to 9074: my $res_error; 9075: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 9076: if ($res_error) { 9077: return &navmap_errormsg(); 9078: } 9079: # FIXME: This should probably look for the first handgradeable part 9080: my $part=$$partlist[0]; 9081: # Start screen output 9082: my $result=&Apache::loncommon::start_data_table(). 9083: &Apache::loncommon::start_data_table_header_row(). 9084: '<th>'.&mt('Assigning grades based on clicker file').'</th>'. 9085: &Apache::loncommon::end_data_table_header_row(). 9086: &Apache::loncommon::start_data_table_row().'<td>'; 9087: # Get correct result 9088: # FIXME: Possibly need delimiter other than ":" 9089: my @correct=(); 9090: my $gradingmechanism=$env{'form.gradingmechanism'}; 9091: my $number=$env{'form.number'}; 9092: if ($gradingmechanism ne 'attendance') { 9093: foreach my $key (keys(%env)) { 9094: if ($key=~/^form\.correct\:/) { 9095: my @input=split(/\,/,$env{$key}); 9096: for (my $i=0;$i<=$#input;$i++) { 9097: if (($correct[$i]) && ($input[$i]) && 9098: ($correct[$i] ne $input[$i])) { 9099: $result.='<br /><span class="LC_warning">'. 9100: &mt('More than one correct result given for question "[_1]": [_2] versus [_3].', 9101: $env{'form.question:'.$i},$correct[$i],$input[$i]).'</span>'; 9102: } elsif (($input[$i]) || ($input[$i] eq '0')) { 9103: $correct[$i]=$input[$i]; 9104: } 9105: } 9106: } 9107: } 9108: for (my $i=0;$i<$number;$i++) { 9109: if ((!$correct[$i]) && ($correct[$i] ne '0')) { 9110: $result.='<br /><span class="LC_error">'. 9111: &mt('No correct result given for question "[_1]"!', 9112: $env{'form.question:'.$i}).'</span>'; 9113: } 9114: } 9115: $result.='<br />'.&mt("Correct answer: [_1]",join(', ',map { ((($_) || ($_ eq '0'))?$_:'-') } @correct)); 9116: } 9117: # Start grading 9118: my $pcorrect=$env{'form.pcorrect'}; 9119: my $pincorrect=$env{'form.pincorrect'}; 9120: my $storecount=0; 9121: my %users=(); 9122: foreach my $key (keys(%env)) { 9123: my $user=''; 9124: if ($key=~/^form\.student\:(.*)$/) { 9125: $user=$1; 9126: } 9127: if ($key=~/^form\.unknown\:(.*)$/) { 9128: my $id=$1; 9129: if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) { 9130: $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id}; 9131: } elsif ($env{'form.multi'.$id}) { 9132: $user=$env{'form.multi'.$id}; 9133: } 9134: } 9135: if ($user) { 9136: if ($users{$user}) { 9137: $result.='<br /><span class="LC_warning">'. 9138: &mt("More than one entry found for <tt>[_1]</tt>!",$user). 9139: '</span><br />'; 9140: } 9141: $users{$user}=1; 9142: my @answer=split(/\,/,$env{$key}); 9143: my $sum=0; 9144: my $realnumber=$number; 9145: for (my $i=0;$i<$number;$i++) { 9146: if ($correct[$i] eq '-') { 9147: $realnumber--; 9148: } elsif (($answer[$i]) || ($answer[$i]=~/^[0\.]+$/)) { 9149: if ($gradingmechanism eq 'attendance') { 9150: $sum+=$pcorrect; 9151: } elsif ($correct[$i] eq '*') { 9152: $sum+=$pcorrect; 9153: } else { 9154: # We actually grade if correct or not 9155: my $increment=$pincorrect; 9156: # Special case: numerical answer "0" 9157: if ($correct[$i] eq '0') { 9158: if ($answer[$i]=~/^[0\.]+$/) { 9159: $increment=$pcorrect; 9160: } 9161: # General numerical answer, both evaluate to something non-zero 9162: } elsif ((1.0*$correct[$i]!=0) && (1.0*$answer[$i]!=0)) { 9163: if (1.0*$correct[$i]==1.0*$answer[$i]) { 9164: $increment=$pcorrect; 9165: } 9166: # Must be just alphanumeric 9167: } elsif ($answer[$i] eq $correct[$i]) { 9168: $increment=$pcorrect; 9169: } 9170: $sum+=$increment; 9171: } 9172: } 9173: } 9174: my $ave=$sum/(100*$realnumber); 9175: # Store 9176: my ($username,$domain)=split(/\:/,$user); 9177: my %grades=(); 9178: $grades{"resource.$part.solved"}='correct_by_override'; 9179: $grades{"resource.$part.awarded"}=$ave; 9180: $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; 9181: my $returncode=&Apache::lonnet::cstore(\%grades,$symb, 9182: $env{'request.course.id'}, 9183: $domain,$username); 9184: if ($returncode ne 'ok') { 9185: $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>"; 9186: } else { 9187: $storecount++; 9188: } 9189: } 9190: } 9191: # We are done 9192: $result.='<br />'.&mt('Successfully stored grades for [quant,_1,student].',$storecount). 9193: '</td>'. 9194: &Apache::loncommon::end_data_table_row(). 9195: &Apache::loncommon::end_data_table(); 9196: return $result; 9197: } 9198: 9199: sub navmap_errormsg { 9200: return '<div class="LC_error">'. 9201: &mt('An error occurred retrieving information about resources in the course.').'<br />'. 9202: &mt('It is recommended that you [_1]re-initialize the course[_2] and then return to this grading page.','<a href="/adm/roles?selectrole=1&newrole='.$env{'request.role'}.'">','</a>'). 9203: '</div>'; 9204: } 9205: 9206: sub startpage { 9207: my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag) = @_; 9208: unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"}); 9209: $r->print(&Apache::loncommon::start_page('Grading',undef, 9210: {'bread_crumbs' => $crumbs})); 9211: &Apache::lonquickgrades::startGradeScreen($r,($env{'form.symb'}?'probgrading':'grading')); 9212: unless ($nodisplayflag) { 9213: $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag)); 9214: } 9215: } 9216: 9217: sub select_problem { 9218: my ($r)=@_; 9219: $r->print('<h3>'.&mt('Select the problem or one of the problems you want to grade').'</h3><form action="/adm/grades">'); 9220: $r->print(&Apache::lonstathelpers::problem_selector('.',undef,1)); 9221: $r->print('<input type="hidden" name="command" value="gradingmenu" />'); 9222: $r->print('<input type="submit" value="'.&mt('Next').' →" /></form>'); 9223: } 9224: 9225: sub handler { 9226: my $request=$_[0]; 9227: &reset_caches(); 9228: if ($request->header_only) { 9229: &Apache::loncommon::content_type($request,'text/html'); 9230: $request->send_http_header; 9231: return OK; 9232: } 9233: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); 9234: 9235: &init_perm(); 9236: if (!$env{'request.course.id'}) { 9237: # Not in a course. 9238: $env{'user.error.msg'}="/adm/grades::vgr:0:0:Cannot display grades page outside course context"; 9239: return HTTP_NOT_ACCEPTABLE; 9240: } elsif (!%perm) { 9241: $request->internal_redirect('/adm/quickgrades'); 9242: } 9243: &Apache::loncommon::content_type($request,'text/html'); 9244: $request->send_http_header; 9245: 9246: 9247: # see what command we need to execute 9248: 9249: my @commands=&Apache::loncommon::get_env_multiple('form.command'); 9250: my $command=$commands[0]; 9251: 9252: if ($#commands > 0) { 9253: &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); 9254: } 9255: 9256: # see what the symb is 9257: 9258: my $symb=$env{'form.symb'}; 9259: unless ($symb) { 9260: (my $url=$env{'form.url'}) =~ s-^https*://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; 9261: $symb=&Apache::lonnet::symbread($url); 9262: } 9263: &Apache::lonenc::check_decrypt(\$symb); 9264: 9265: $ssi_error = 0; 9266: if (($symb eq '' || $command eq '') && ($env{'request.course.id'})) { 9267: # 9268: # Not called from a resource, but inside a course 9269: # 9270: &startpage($request,undef,[],1,1); 9271: &select_problem($request); 9272: } else { 9273: if ($command eq 'submission' && $perm{'vgr'}) { 9274: &startpage($request,$symb,[{href=>"", text=>"Student Submissions"}]); 9275: ($env{'form.student'} eq '' ? &listStudents($request,$symb) : &submission($request,0,0,$symb)); 9276: } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { 9277: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 9278: {href=>'',text=>'Select student'}],1,1); 9279: &pickStudentPage($request,$symb); 9280: } elsif ($command eq 'displayPage' && $perm{'vgr'}) { 9281: &startpage($request,$symb, 9282: [{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 9283: {href=>'',text=>'Select student'}, 9284: {href=>'',text=>'Grade student'}],1,1); 9285: &displayPage($request,$symb); 9286: } elsif ($command eq 'gradeByPage' && $perm{'mgr'}) { 9287: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 9288: {href=>'',text=>'Select student'}, 9289: {href=>'',text=>'Grade student'}, 9290: {href=>'',text=>'Store grades'}],1,1); 9291: &updateGradeByPage($request,$symb); 9292: } elsif ($command eq 'processGroup' && $perm{'vgr'}) { 9293: &startpage($request,$symb,[{href=>'',text=>'...'}, 9294: {href=>'',text=>'Modify grades'}]); 9295: &processGroup($request,$symb); 9296: } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) { 9297: &startpage($request,$symb); 9298: $request->print(&grading_menu($request,$symb)); 9299: } elsif ($command eq 'individual' && $perm{'vgr'}) { 9300: &startpage($request,$symb,[{href=>'',text=>'Select individual students to grade'}]); 9301: $request->print(&submit_options($request,$symb)); 9302: } elsif ($command eq 'ungraded' && $perm{'vgr'}) { 9303: &startpage($request,$symb,[{href=>'',text=>'Grade ungraded submissions'}]); 9304: $request->print(&listStudents($request,$symb,'graded')); 9305: } elsif ($command eq 'table' && $perm{'vgr'}) { 9306: &startpage($request,$symb,[{href=>"", text=>"Grading table"}]); 9307: $request->print(&submit_options_table($request,$symb)); 9308: } elsif ($command eq 'all_for_one' && $perm{'vgr'}) { 9309: &startpage($request,$symb,[{href=>'',text=>'Grade page/folder for one student'}],1,1); 9310: $request->print(&submit_options_sequence($request,$symb)); 9311: } elsif ($command eq 'viewgrades' && $perm{'vgr'}) { 9312: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"table"), text=>"Grading table"},{href=>'', text=>"Modify grades"}]); 9313: $request->print(&viewgrades($request,$symb)); 9314: } elsif ($command eq 'handgrade' && $perm{'mgr'}) { 9315: &startpage($request,$symb,[{href=>'',text=>'...'}, 9316: {href=>'',text=>'Store grades'}]); 9317: $request->print(&processHandGrade($request,$symb)); 9318: } elsif ($command eq 'editgrades' && $perm{'mgr'}) { 9319: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"table"), text=>"Grading table"}, 9320: {href=>&href_symb_cmd($symb,'viewgrades').'&group=all&section=all&Status=Active', 9321: text=>"Modify grades"}, 9322: {href=>'', text=>"Store grades"}]); 9323: $request->print(&editgrades($request,$symb)); 9324: } elsif ($command eq 'initialverifyreceipt' && $perm{'vgr'}) { 9325: &startpage($request,$symb,[{href=>'',text=>'Verify Receipt Number'}]); 9326: $request->print(&initialverifyreceipt($request,$symb)); 9327: } elsif ($command eq 'verify' && $perm{'vgr'}) { 9328: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"initialverifyreceipt"),text=>'Verify Receipt Number'}, 9329: {href=>'',text=>'Verification Result'}]); 9330: $request->print(&verifyreceipt($request,$symb)); 9331: } elsif ($command eq 'processclicker' && $perm{'mgr'}) { 9332: &startpage($request,$symb,[{href=>'', text=>'Process clicker'}]); 9333: $request->print(&process_clicker($request,$symb)); 9334: } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { 9335: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'processclicker'), text=>'Process clicker'}, 9336: {href=>'', text=>'Process clicker file'}]); 9337: $request->print(&process_clicker_file($request,$symb)); 9338: } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) { 9339: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'processclicker'), text=>'Process clicker'}, 9340: {href=>'', text=>'Process clicker file'}, 9341: {href=>'', text=>'Store grades'}]); 9342: $request->print(&assign_clicker_grades($request,$symb)); 9343: } elsif ($command eq 'csvform' && $perm{'mgr'}) { 9344: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 9345: $request->print(&upcsvScores_form($request,$symb)); 9346: } elsif ($command eq 'csvupload' && $perm{'mgr'}) { 9347: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 9348: $request->print(&csvupload($request,$symb)); 9349: } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) { 9350: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 9351: $request->print(&csvuploadmap($request,$symb)); 9352: } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) { 9353: if ($env{'form.associate'} ne 'Reverse Association') { 9354: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 9355: $request->print(&csvuploadoptions($request,$symb)); 9356: } else { 9357: if ( $env{'form.upfile_associate'} ne 'reverse' ) { 9358: $env{'form.upfile_associate'} = 'reverse'; 9359: } else { 9360: $env{'form.upfile_associate'} = 'forward'; 9361: } 9362: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 9363: $request->print(&csvuploadmap($request,$symb)); 9364: } 9365: } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) { 9366: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 9367: $request->print(&csvuploadassign($request,$symb)); 9368: } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { 9369: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 9370: $request->print(&scantron_selectphase($request,undef,$symb)); 9371: } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) { 9372: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 9373: $request->print(&scantron_do_warning($request,$symb)); 9374: } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { 9375: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 9376: $request->print(&scantron_validate_file($request,$symb)); 9377: } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { 9378: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 9379: $request->print(&scantron_process_students($request,$symb)); 9380: } elsif ($command eq 'scantronupload' && 9381: (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| 9382: &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { 9383: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 9384: $request->print(&scantron_upload_scantron_data($request,$symb)); 9385: } elsif ($command eq 'scantronupload_save' && 9386: (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| 9387: &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { 9388: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 9389: $request->print(&scantron_upload_scantron_data_save($request,$symb)); 9390: } elsif ($command eq 'scantron_download' && 9391: &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { 9392: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 9393: $request->print(&scantron_download_scantron_data($request,$symb)); 9394: } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) { 9395: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 9396: $request->print(&checkscantron_results($request,$symb)); 9397: } elsif ($command eq 'downloadfilesselect' && $perm{'vgr'}) { 9398: &startpage($request,$symb,[{href=>'', text=>'Select which submissions to download'}]); 9399: $request->print(&submit_options_download($request,$symb)); 9400: } elsif ($command eq 'downloadfileslink' && $perm{'vgr'}) { 9401: &startpage($request,$symb, 9402: [{href=>&href_symb_cmd($symb,'downloadfilesselect'), text=>'Select which submissions to download'}, 9403: {href=>'', text=>'Download submissions'}]); 9404: &submit_download_link($request,$symb); 9405: } elsif ($command) { 9406: &startpage($request,$symb,[{href=>'', text=>'Access denied'}]); 9407: $request->print('<p class="LC_error">'.&mt('Access Denied ([_1])',$command).'</p>'); 9408: } 9409: } 9410: if ($ssi_error) { 9411: &ssi_print_error($request); 9412: } 9413: &Apache::lonquickgrades::endGradeScreen($request); 9414: $request->print(&Apache::loncommon::end_page()); 9415: &reset_caches(); 9416: return OK; 9417: } 9418: 9419: 1; 9420: 9421: __END__; 9422: 9423: 9424: =head1 NAME 9425: 9426: Apache::grades 9427: 9428: =head1 SYNOPSIS 9429: 9430: Handles the viewing of grades. 9431: 9432: This is part of the LearningOnline Network with CAPA project 9433: described at http://www.lon-capa.org. 9434: 9435: =head1 OVERVIEW 9436: 9437: Do an ssi with retries: 9438: While I'd love to factor out this with the vesrion in lonprintout, 9439: that would either require a data coupling between modules, which I refuse to perpetuate (there's quite enough of that already), or would require the invention of another infrastructure 9440: I'm not quite ready to invent (e.g. an ssi_with_retry object). 9441: 9442: At least the logic that drives this has been pulled out into loncommon. 9443: 9444: 9445: 9446: ssi_with_retries - Does the server side include of a resource. 9447: if the ssi call returns an error we'll retry it up to 9448: the number of times requested by the caller. 9449: If we still have a proble, no text is appended to the 9450: output and we set some global variables. 9451: to indicate to the caller an SSI error occurred. 9452: All of this is supposed to deal with the issues described 9453: in LonCAPA BZ 5631 see: 9454: http://bugs.lon-capa.org/show_bug.cgi?id=5631 9455: by informing the user that this happened. 9456: 9457: Parameters: 9458: resource - The resource to include. This is passed directly, without 9459: interpretation to lonnet::ssi. 9460: form - The form hash parameters that guide the interpretation of the resource 9461: 9462: retries - Number of retries allowed before giving up completely. 9463: Returns: 9464: On success, returns the rendered resource identified by the resource parameter. 9465: Side Effects: 9466: The following global variables can be set: 9467: ssi_error - If an unrecoverable error occurred this becomes true. 9468: It is up to the caller to initialize this to false 9469: if desired. 9470: ssi_error_resource - If an unrecoverable error occurred, this is the value 9471: of the resource that could not be rendered by the ssi 9472: call. 9473: ssi_error_message - The error string fetched from the ssi response 9474: in the event of an error. 9475: 9476: 9477: =head1 HANDLER SUBROUTINE 9478: 9479: ssi_with_retries() 9480: 9481: =head1 SUBROUTINES 9482: 9483: =over 9484: 9485: =item scantron_get_correction() : 9486: 9487: Builds the interface screen to interact with the operator to fix a 9488: specific error condition in a specific scanline 9489: 9490: Arguments: 9491: $r - Apache request object 9492: $i - number of the current scanline 9493: $scan_record - hash ref as returned from &scantron_parse_scanline() 9494: $scan_config - hash ref as returned from &get_scantron_config() 9495: $line - full contents of the current scanline 9496: $error - error condition, valid values are 9497: 'incorrectCODE', 'duplicateCODE', 9498: 'doublebubble', 'missingbubble', 9499: 'duplicateID', 'incorrectID' 9500: $arg - extra information needed 9501: For errors: 9502: - duplicateID - paper number that this studentID was seen before on 9503: - duplicateCODE - array ref of the paper numbers this CODE was 9504: seen on before 9505: - incorrectCODE - current incorrect CODE 9506: - doublebubble - array ref of the bubble lines that have double 9507: bubble errors 9508: - missingbubble - array ref of the bubble lines that have missing 9509: bubble errors 9510: 9511: =item scantron_get_maxbubble() : 9512: 9513: Arguments: 9514: $nav_error - Reference to scalar which is a flag to indicate a 9515: failure to retrieve a navmap object. 9516: if $nav_error is set to 1 by scantron_get_maxbubble(), the 9517: calling routine should trap the error condition and display the warning 9518: found in &navmap_errormsg(). 9519: 9520: Returns the maximum number of bubble lines that are expected to 9521: occur. Does this by walking the selected sequence rendering the 9522: resource and then checking &Apache::lonxml::get_problem_counter() 9523: for what the current value of the problem counter is. 9524: 9525: Caches the results to $env{'form.scantron_maxbubble'}, 9526: $env{'form.scantron.bubble_lines.n'}, 9527: $env{'form.scantron.first_bubble_line.n'} and 9528: $env{"form.scantron.sub_bubblelines.n"} 9529: which are the total number of bubble, lines, the number of bubble 9530: lines for response n and number of the first bubble line for response n, 9531: and a comma separated list of numbers of bubble lines for sub-questions 9532: (for optionresponse, matchresponse, and rankresponse items), for response n. 9533: 9534: 9535: =item scantron_validate_missingbubbles() : 9536: 9537: Validates all scanlines in the selected file to not have any 9538: answers that don't have bubbles that have not been verified 9539: to be bubble free. 9540: 9541: =item scantron_process_students() : 9542: 9543: Routine that does the actual grading of the bubble sheet information. 9544: 9545: The parsed scanline hash is added to %env 9546: 9547: Then foreach unskipped scanline it does an &Apache::lonnet::ssi() 9548: foreach resource , with the form data of 9549: 9550: 'submitted' =>'scantron' 9551: 'grade_target' =>'grade', 9552: 'grade_username'=> username of student 9553: 'grade_domain' => domain of student 9554: 'grade_courseid'=> of course 9555: 'grade_symb' => symb of resource to grade 9556: 9557: This triggers a grading pass. The problem grading code takes care 9558: of converting the bubbled letter information (now in %env) into a 9559: valid submission. 9560: 9561: =item scantron_upload_scantron_data() : 9562: 9563: Creates the screen for adding a new bubble sheet data file to a course. 9564: 9565: =item scantron_upload_scantron_data_save() : 9566: 9567: Adds a provided bubble information data file to the course if user 9568: has the correct privileges to do so. 9569: 9570: =item valid_file() : 9571: 9572: Validates that the requested bubble data file exists in the course. 9573: 9574: =item scantron_download_scantron_data() : 9575: 9576: Shows a list of the three internal files (original, corrected, 9577: skipped) for a specific bubble sheet data file that exists in the 9578: course. 9579: 9580: =item scantron_validate_ID() : 9581: 9582: Validates all scanlines in the selected file to not have any 9583: invalid or underspecified student/employee IDs 9584: 9585: =item navmap_errormsg() : 9586: 9587: Returns HTML mark-up inside a <div></div> with a link to re-initialize the course. 9588: Should be called whenever the request to instantiate a navmap object fails. 9589: 9590: =back 9591: 9592: =cut