loncom/homework/grades.pm - view

File: [LON-CAPA] / loncom / homework / grades.pm
Revision 1.719: download - view: text, annotated - select for diffs
Wed Feb 5 15:09:30 2014 UTC (10 years, 2 months ago) by bisitz
Branches: MAIN
CVS tags: HEAD

Actually apply desired wording improvement from grades.pm 1.718
("- Inform about scope: essay only")

1: # The LearningOnline Network with CAPA 2: # The LON-CAPA Grading handler 3: # 4: # $Id: grades.pm,v 1.719 2014/02/05 15:09:30 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 Apache::bridgetask(); 49: use String::Similarity; 50: use LONCAPA; 51: 52: use POSIX qw(floor); 53: 54: 55: 56: my %perm=(); 57: my %old_essays=(); 58: 59: # These variables are used to recover from ssi errors 60: 61: my $ssi_retries = 5; 62: my $ssi_error; 63: my $ssi_error_resource; 64: my $ssi_error_message; 65: 66: 67: sub ssi_with_retries { 68: my ($resource, $retries, %form) = @_; 69: my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form); 70: if ($response->is_error) { 71: $ssi_error = 1; 72: $ssi_error_resource = $resource; 73: $ssi_error_message = $response->code . " " . $response->message; 74: } 75: 76: return $content; 77: 78: } 79: # 80: # Prodcuces an ssi retry failure error message to the user: 81: # 82: 83: sub ssi_print_error { 84: my ($r) = @_; 85: my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk'); 86: $r->print(' 87: <br /> 88: <h2>'.&mt('An unrecoverable network error occurred:').'</h2> 89: <p> 90: '.&mt('Unable to retrieve a resource from a server:').'<br /> 91: '.&mt('Resource:').' '.$ssi_error_resource.'<br /> 92: '.&mt('Error:').' '.$ssi_error_message.' 93: </p> 94: <p>'. 95: &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 />'. 96: &mt('If the error persists, please contact the [_1] for assistance.',$helpurl). 97: '</p>'); 98: return; 99: } 100: 101: # 102: # --- Retrieve the parts from the metadata file.--- 103: # Returns an array of everything that the resources stores away 104: # 105: 106: sub getpartlist { 107: my ($symb,$errorref) = @_; 108: 109: my $navmap = Apache::lonnavmaps::navmap->new(); 110: unless (ref($navmap)) { 111: if (ref($errorref)) { 112: $$errorref = 'navmap'; 113: return; 114: } 115: } 116: my $res = $navmap->getBySymb($symb); 117: my $partlist = $res->parts(); 118: my $url = $res->src(); 119: my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys')); 120: 121: my @stores; 122: foreach my $part (@{ $partlist }) { 123: foreach my $key (@metakeys) { 124: if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } 125: } 126: } 127: return @stores; 128: } 129: 130: #--- Format fullname, username:domain if different for display 131: #--- Use anywhere where the student names are listed 132: sub nameUserString { 133: my ($type,$fullname,$uname,$udom) = @_; 134: if ($type eq 'header') { 135: return '<b> '.&mt('Fullname').' </b><span class="LC_internal_info">('.&mt('Username').')</span>'; 136: } else { 137: return ' '.$fullname.'<span class="LC_internal_info"> ('.$uname. 138: ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')</span>'; 139: } 140: } 141: 142: #--- Get the partlist and the response type for a given problem. --- 143: #--- Indicate if a response type is coded handgraded or not. --- 144: #--- Sets response_error pointer to "1" if navmaps object broken --- 145: sub response_type { 146: my ($symb,$response_error) = @_; 147: 148: my $navmap = Apache::lonnavmaps::navmap->new(); 149: unless (ref($navmap)) { 150: if (ref($response_error)) { 151: $$response_error = 1; 152: } 153: return; 154: } 155: my $res = $navmap->getBySymb($symb); 156: unless (ref($res)) { 157: $$response_error = 1; 158: return; 159: } 160: my $partlist = $res->parts(); 161: my %vPart = 162: map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); 163: my (%response_types,%handgrade); 164: foreach my $part (@{ $partlist }) { 165: next if (%vPart && !exists($vPart{$part})); 166: 167: my @types = $res->responseType($part); 168: my @ids = $res->responseIds($part); 169: for (my $i=0; $i < scalar(@ids); $i++) { 170: $response_types{$part}{$ids[$i]} = $types[$i]; 171: $handgrade{$part.'_'.$ids[$i]} = 172: &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. 173: '.handgrade',$symb); 174: } 175: } 176: return ($partlist,\%handgrade,\%response_types); 177: } 178: 179: sub flatten_responseType { 180: my ($responseType) = @_; 181: my @part_response_id = 182: map { 183: my $part = $_; 184: map { 185: [$part,$_] 186: } sort(keys(%{ $responseType->{$part} })); 187: } sort(keys(%$responseType)); 188: return @part_response_id; 189: } 190: 191: sub get_display_part { 192: my ($partID,$symb)=@_; 193: my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); 194: if (defined($display) and $display ne '') { 195: $display.= ' (<span class="LC_internal_info">' 196: .&mt('Part ID: [_1]',$partID).'</span>)'; 197: } else { 198: $display=$partID; 199: } 200: return $display; 201: } 202: 203: sub reset_caches { 204: &reset_analyze_cache(); 205: &reset_perm(); 206: &reset_old_essays(); 207: } 208: 209: { 210: my %analyze_cache; 211: my %analyze_cache_formkeys; 212: 213: sub reset_analyze_cache { 214: undef(%analyze_cache); 215: undef(%analyze_cache_formkeys); 216: } 217: 218: sub get_analyze { 219: my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed,$bubbles_per_row)=@_; 220: my $key = "$symb\0$uname\0$udom"; 221: if ($type eq 'randomizetry') { 222: if ($trial ne '') { 223: $key .= "\0".$trial; 224: } 225: } 226: if (exists($analyze_cache{$key})) { 227: my $getupdate = 0; 228: if (ref($add_to_hash) eq 'HASH') { 229: foreach my $item (keys(%{$add_to_hash})) { 230: if (ref($analyze_cache_formkeys{$key}) eq 'HASH') { 231: if (!exists($analyze_cache_formkeys{$key}{$item})) { 232: $getupdate = 1; 233: last; 234: } 235: } else { 236: $getupdate = 1; 237: } 238: } 239: } 240: if (!$getupdate) { 241: return $analyze_cache{$key}; 242: } 243: } 244: 245: my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); 246: $url=&Apache::lonnet::clutter($url); 247: my %form = ('grade_target' => 'analyze', 248: 'grade_domain' => $udom, 249: 'grade_symb' => $symb, 250: 'grade_courseid' => $env{'request.course.id'}, 251: 'grade_username' => $uname, 252: 'grade_noincrement' => $no_increment); 253: if ($bubbles_per_row ne '') { 254: $form{'bubbles_per_row'} = $bubbles_per_row; 255: } 256: if ($type eq 'randomizetry') { 257: $form{'grade_questiontype'} = $type; 258: if ($rndseed ne '') { 259: $form{'grade_rndseed'} = $rndseed; 260: } 261: } 262: if (ref($add_to_hash)) { 263: %form = (%form,%{$add_to_hash}); 264: } 265: my $subresult=&ssi_with_retries($url, $ssi_retries,%form); 266: (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); 267: my %analyze=&Apache::lonnet::str2hash($subresult); 268: if (ref($add_to_hash) eq 'HASH') { 269: $analyze_cache_formkeys{$key} = $add_to_hash; 270: } else { 271: $analyze_cache_formkeys{$key} = {}; 272: } 273: return $analyze_cache{$key} = \%analyze; 274: } 275: 276: sub get_order { 277: my ($partid,$respid,$symb,$uname,$udom,$no_increment,$type,$trial,$rndseed)=@_; 278: my $analyze = &get_analyze($symb,$uname,$udom,$no_increment,undef,$type,$trial,$rndseed); 279: return $analyze->{"$partid.$respid.shown"}; 280: } 281: 282: sub get_radiobutton_correct_foil { 283: my ($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed)=@_; 284: my $analyze = &get_analyze($symb,$uname,$udom,undef,undef,$type,$trial,$rndseed); 285: my $foils = &get_order($partid,$respid,$symb,$uname,$udom,undef,$type,$trial,$rndseed); 286: if (ref($foils) eq 'ARRAY') { 287: foreach my $foil (@{$foils}) { 288: if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { 289: return $foil; 290: } 291: } 292: } 293: } 294: 295: sub scantron_partids_tograde { 296: my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row) = @_; 297: my (%analysis,@parts); 298: if (ref($resource)) { 299: my $symb = $resource->symb(); 300: my $add_to_form; 301: if ($check_for_randomlist) { 302: $add_to_form = { 'check_parts_withrandomlist' => 1,}; 303: } 304: my $analyze = 305: &get_analyze($symb,$uname,$udom,undef,$add_to_form, 306: undef,undef,undef,$bubbles_per_row); 307: if (ref($analyze) eq 'HASH') { 308: %analysis = %{$analyze}; 309: } 310: if (ref($analysis{'parts'}) eq 'ARRAY') { 311: foreach my $part (@{$analysis{'parts'}}) { 312: my ($id,$respid) = split(/\./,$part); 313: if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { 314: push(@parts,$part); 315: } 316: } 317: } 318: } 319: return (\%analysis,\@parts); 320: } 321: 322: } 323: 324: #--- Clean response type for display 325: #--- Currently filters option/rank/radiobutton/match/essay/Task 326: # response types only. 327: sub cleanRecord { 328: my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, 329: $uname,$udom,$type,$trial,$rndseed) = @_; 330: my $grayFont = '<span class="LC_internal_info">'; 331: if ($response =~ /^(option|rank)$/) { 332: my %answer=&Apache::lonnet::str2hash($answer); 333: my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); 334: my ($toprow,$bottomrow); 335: foreach my $foil (@$order) { 336: if ($grading{$foil} == 1) { 337: $toprow.='<td><b>'.$answer{$foil}.' </b></td>'; 338: } else { 339: $toprow.='<td><i>'.$answer{$foil}.' </i></td>'; 340: } 341: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 342: } 343: return '<blockquote><table border="1">'. 344: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 345: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 346: $bottomrow.'</tr></table></blockquote>'; 347: } elsif ($response eq 'match') { 348: my %answer=&Apache::lonnet::str2hash($answer); 349: my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); 350: my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); 351: my ($toprow,$middlerow,$bottomrow); 352: foreach my $foil (@$order) { 353: my $item=shift(@items); 354: if ($grading{$foil} == 1) { 355: $toprow.='<td><b>'.$item.' </b></td>'; 356: $middlerow.='<td><b>'.$grayFont.$answer{$foil}.' </span></b></td>'; 357: } else { 358: $toprow.='<td><i>'.$item.' </i></td>'; 359: $middlerow.='<td><i>'.$grayFont.$answer{$foil}.' </span></i></td>'; 360: } 361: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 362: } 363: return '<blockquote><table border="1">'. 364: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 365: '<tr valign="top"><td>'.$grayFont.&mt('Item ID').'</span></td>'. 366: $middlerow.'</tr>'. 367: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 368: $bottomrow.'</tr></table></blockquote>'; 369: } elsif ($response eq 'radiobutton') { 370: my %answer=&Apache::lonnet::str2hash($answer); 371: my ($toprow,$bottomrow); 372: my $correct = 373: &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed); 374: foreach my $foil (@$order) { 375: if (exists($answer{$foil})) { 376: if ($foil eq $correct) { 377: $toprow.='<td><b>'.&mt('true').'</b></td>'; 378: } else { 379: $toprow.='<td><i>'.&mt('true').'</i></td>'; 380: } 381: } else { 382: $toprow.='<td>'.&mt('false').'</td>'; 383: } 384: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 385: } 386: return '<blockquote><table border="1">'. 387: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 388: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 389: $bottomrow.'</tr></table></blockquote>'; 390: } elsif ($response eq 'essay') { 391: if (! exists ($env{'form.'.$symb})) { 392: my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', 393: $env{'course.'.$env{'request.course.id'}.'.domain'}, 394: $env{'course.'.$env{'request.course.id'}.'.num'}); 395: 396: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 397: $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; 398: $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; 399: $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; 400: $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; 401: $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. 402: } 403: $answer =~ s-\n-<br />-g; 404: return '<br /><br /><blockquote><tt>'.&keywords_highlight($answer).'</tt></blockquote>'; 405: } elsif ( $response eq 'organic') { 406: my $result='Smile representation: "<tt>'.$answer.'</tt>"'; 407: my $jme=$record->{$version."resource.$partid.$respid.molecule"}; 408: $result.=&Apache::chemresponse::jme_img($jme,$answer,400); 409: return $result; 410: } elsif ( $response eq 'Task') { 411: if ( $answer eq 'SUBMITTED') { 412: my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; 413: my $result = &Apache::bridgetask::file_list($files,$uname,$udom); 414: return $result; 415: } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { 416: my @matches = grep(/^\Q$version\E.*?\.instance$/, 417: keys(%{$record})); 418: return join('<br />',($version,@matches)); 419: 420: 421: } else { 422: my $result = 423: '<p>' 424: .&mt('Overall result: [_1]', 425: $record->{$version."resource.$respid.$partid.status"}) 426: .'</p>'; 427: 428: $result .= '<ul>'; 429: my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/, 430: keys(%{$record})); 431: foreach my $grade (sort(@grade)) { 432: my ($dim) = ($grade =~/[.]([^.]+)[.]status$/); 433: $result.= '<li>'.&mt("Dimension: [_1], status [_2] ", 434: $dim, $record->{$grade}). 435: '</li>'; 436: } 437: $result.='</ul>'; 438: return $result; 439: } 440: } elsif ( $response =~ m/(?:numerical|formula|custom)/) { 441: # Respect multiple input fields, see Bug #5409 442: $answer = 443: &Apache::loncommon::format_previous_attempt_value('submission', 444: $answer); 445: } 446: return $answer; 447: } 448: 449: #-- A couple of common js functions 450: sub commonJSfunctions { 451: my $request = shift; 452: $request->print(&Apache::lonhtmlcommon::scripttag(<<COMMONJSFUNCTIONS)); 453: function radioSelection(radioButton) { 454: var selection=null; 455: if (radioButton.length > 1) { 456: for (var i=0; i<radioButton.length; i++) { 457: if (radioButton[i].checked) { 458: return radioButton[i].value; 459: } 460: } 461: } else { 462: if (radioButton.checked) return radioButton.value; 463: } 464: return selection; 465: } 466: 467: function pullDownSelection(selectOne) { 468: var selection=""; 469: if (selectOne.length > 1) { 470: for (var i=0; i<selectOne.length; i++) { 471: if (selectOne[i].selected) { 472: return selectOne[i].value; 473: } 474: } 475: } else { 476: // only one value it must be the selected one 477: return selectOne.value; 478: } 479: } 480: COMMONJSFUNCTIONS 481: } 482: 483: #--- Dumps the class list with usernames,list of sections, 484: #--- section, ids and fullnames for each user. 485: sub getclasslist { 486: my ($getsec,$filterlist,$getgroup) = @_; 487: my @getsec; 488: my @getgroup; 489: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 490: if (!ref($getsec)) { 491: if ($getsec ne '' && $getsec ne 'all') { 492: @getsec=($getsec); 493: } 494: } else { 495: @getsec=@{$getsec}; 496: } 497: if (grep(/^all$/,@getsec)) { undef(@getsec); } 498: if (!ref($getgroup)) { 499: if ($getgroup ne '' && $getgroup ne 'all') { 500: @getgroup=($getgroup); 501: } 502: } else { 503: @getgroup=@{$getgroup}; 504: } 505: if (grep(/^all$/,@getgroup)) { undef(@getgroup); } 506: 507: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist(); 508: # Bail out if we were unable to get the classlist 509: return if (! defined($classlist)); 510: &Apache::loncoursedata::get_group_memberships($classlist,$keylist); 511: # 512: my %sections; 513: my %fullnames; 514: foreach my $student (keys(%$classlist)) { 515: my $end = 516: $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; 517: my $start = 518: $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; 519: my $id = 520: $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; 521: my $section = 522: $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; 523: my $fullname = 524: $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; 525: my $status = 526: $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; 527: my $group = 528: $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; 529: # filter students according to status selected 530: if ($filterlist && (!($stu_status =~ /Any/))) { 531: if (!($stu_status =~ $status)) { 532: delete($classlist->{$student}); 533: next; 534: } 535: } 536: # filter students according to groups selected 537: my @stu_groups = split(/,/,$group); 538: if (@getgroup) { 539: my $exclude = 1; 540: foreach my $grp (@getgroup) { 541: foreach my $stu_group (@stu_groups) { 542: if ($stu_group eq $grp) { 543: $exclude = 0; 544: } 545: } 546: if (($grp eq 'none') && !$group) { 547: $exclude = 0; 548: } 549: } 550: if ($exclude) { 551: delete($classlist->{$student}); 552: } 553: } 554: $section = ($section ne '' ? $section : 'none'); 555: if (&canview($section)) { 556: if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { 557: $sections{$section}++; 558: if ($classlist->{$student}) { 559: $fullnames{$student}=$fullname; 560: } 561: } else { 562: delete($classlist->{$student}); 563: } 564: } else { 565: delete($classlist->{$student}); 566: } 567: } 568: my %seen = (); 569: my @sections = sort(keys(%sections)); 570: return ($classlist,\@sections,\%fullnames); 571: } 572: 573: sub canmodify { 574: my ($sec)=@_; 575: if ($perm{'mgr'}) { 576: if (!defined($perm{'mgr_section'})) { 577: # can modify whole class 578: return 1; 579: } else { 580: if ($sec eq $perm{'mgr_section'}) { 581: #can modify the requested section 582: return 1; 583: } else { 584: # can't modify the request section 585: return 0; 586: } 587: } 588: } 589: #can't modify 590: return 0; 591: } 592: 593: sub canview { 594: my ($sec)=@_; 595: if ($perm{'vgr'}) { 596: if (!defined($perm{'vgr_section'})) { 597: # can modify whole class 598: return 1; 599: } else { 600: if ($sec eq $perm{'vgr_section'}) { 601: #can modify the requested section 602: return 1; 603: } else { 604: # can't modify the request section 605: return 0; 606: } 607: } 608: } 609: #can't modify 610: return 0; 611: } 612: 613: #--- Retrieve the grade status of a student for all the parts 614: sub student_gradeStatus { 615: my ($symb,$udom,$uname,$partlist) = @_; 616: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 617: my %partstatus = (); 618: foreach (@$partlist) { 619: my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); 620: $status = 'nothing' if ($status eq ''); 621: $partstatus{$_} = $status; 622: my $subkey = "resource.$_.submitted_by"; 623: $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); 624: } 625: return %partstatus; 626: } 627: 628: # hidden form and javascript that calls the form 629: # Use by verifyscript and viewgrades 630: # Shows a student's view of problem and submission 631: sub jscriptNform { 632: my ($symb) = @_; 633: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 634: my $jscript= &Apache::lonhtmlcommon::scripttag( 635: ' function viewOneStudent(user,domain) {'."\n". 636: ' document.onestudent.student.value = user;'."\n". 637: ' document.onestudent.userdom.value = domain;'."\n". 638: ' document.onestudent.submit();'."\n". 639: ' }'."\n". 640: "\n"); 641: $jscript.= '<form action="/adm/grades" method="post" name="onestudent">'."\n". 642: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 643: '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 644: '<input type="hidden" name="command" value="submission" />'."\n". 645: '<input type="hidden" name="student" value="" />'."\n". 646: '<input type="hidden" name="userdom" value="" />'."\n". 647: '</form>'."\n"; 648: return $jscript; 649: } 650: 651: 652: 653: # Given the score (as a number [0-1] and the weight) what is the final 654: # point value? This function will round to the nearest tenth, third, 655: # or quarter if one of those is within the tolerance of .00001. 656: sub compute_points { 657: my ($score, $weight) = @_; 658: 659: my $tolerance = .00001; 660: my $points = $score * $weight; 661: 662: # Check for nearness to 1/x. 663: my $check_for_nearness = sub { 664: my ($factor) = @_; 665: my $num = ($points * $factor) + $tolerance; 666: my $floored_num = floor($num); 667: if ($num - $floored_num < 2 * $tolerance * $factor) { 668: return $floored_num / $factor; 669: } 670: return $points; 671: }; 672: 673: $points = $check_for_nearness->(10); 674: $points = $check_for_nearness->(3); 675: $points = $check_for_nearness->(4); 676: 677: return $points; 678: } 679: 680: #------------------ End of general use routines -------------------- 681: 682: # 683: # Find most similar essay 684: # 685: 686: sub most_similar { 687: my ($uname,$udom,$symb,$uessay)=@_; 688: 689: unless ($symb) { return ''; } 690: 691: unless (ref($old_essays{$symb}) eq 'HASH') { return ''; } 692: 693: # ignore spaces and punctuation 694: 695: $uessay=~s/\W+/ /gs; 696: 697: # ignore empty submissions (occuring when only files are sent) 698: 699: unless ($uessay=~/\w+/s) { return ''; } 700: 701: # these will be returned. Do not care if not at least 50 percent similar 702: my $limit=0.6; 703: my $sname=''; 704: my $sdom=''; 705: my $scrsid=''; 706: my $sessay=''; 707: # go through all essays ... 708: foreach my $tkey (keys(%{$old_essays{$symb}})) { 709: my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); 710: # ... except the same student 711: next if (($tname eq $uname) && ($tdom eq $udom)); 712: my $tessay=$old_essays{$symb}{$tkey}; 713: $tessay=~s/\W+/ /gs; 714: # String similarity gives up if not even limit 715: my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); 716: # Found one 717: if ($tsimilar>$limit) { 718: $limit=$tsimilar; 719: $sname=$tname; 720: $sdom=$tdom; 721: $scrsid=$tcrsid; 722: $sessay=$old_essays{$symb}{$tkey}; 723: } 724: } 725: if ($limit>0.6) { 726: return ($sname,$sdom,$scrsid,$sessay,$limit); 727: } else { 728: return ('','','','',0); 729: } 730: } 731: 732: #------------------------------------------------------------------- 733: 734: #------------------------------------ Receipt Verification Routines 735: # 736: 737: sub initialverifyreceipt { 738: my ($request,$symb) = @_; 739: &commonJSfunctions($request); 740: return '<form name="gradingMenu" action=""><input type="submit" value="'.&mt('Verify Receipt Number.').'" />'. 741: &Apache::lonnet::recprefix($env{'request.course.id'}). 742: '-<input type="text" name="receipt" size="4" />'. 743: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 744: '<input type="hidden" name="command" value="verify" />'. 745: "</form>\n"; 746: } 747: 748: #--- Check whether a receipt number is valid.--- 749: sub verifyreceipt { 750: my ($request,$symb) = @_; 751: 752: my $courseid = $env{'request.course.id'}; 753: my $receipt = &Apache::lonnet::recprefix($courseid).'-'. 754: $env{'form.receipt'}; 755: $receipt =~ s/[^\-\d]//g; 756: 757: my $title.= 758: '<h3><span class="LC_info">'. 759: &mt('Verifying Receipt Number [_1]',$receipt). 760: '</span></h3>'."\n"; 761: 762: my ($string,$contents,$matches) = ('','',0); 763: my (undef,undef,$fullname) = &getclasslist('all','0'); 764: 765: my $receiptparts=0; 766: if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || 767: $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } 768: my $parts=['0']; 769: if ($receiptparts) { 770: my $res_error; 771: ($parts)=&response_type($symb,\$res_error); 772: if ($res_error) { 773: return &navmap_errormsg(); 774: } 775: } 776: 777: my $header = 778: &Apache::loncommon::start_data_table(). 779: &Apache::loncommon::start_data_table_header_row(). 780: '<th> '.&mt('Fullname').' </th>'."\n". 781: '<th> '.&mt('Username').' </th>'."\n". 782: '<th> '.&mt('Domain').' </th>'; 783: if ($receiptparts) { 784: $header.='<th> '.&mt('Problem Part').' </th>'; 785: } 786: $header.= 787: &Apache::loncommon::end_data_table_header_row(); 788: 789: foreach (sort 790: { 791: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 792: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 793: } 794: return $a cmp $b; 795: } (keys(%$fullname))) { 796: my ($uname,$udom)=split(/\:/); 797: foreach my $part (@$parts) { 798: if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { 799: $contents.= 800: &Apache::loncommon::start_data_table_row(). 801: '<td> '."\n". 802: '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. 803: '\');" target="_self">'.$$fullname{$_}.'</a> </td>'."\n". 804: '<td> '.$uname.' </td>'. 805: '<td> '.$udom.' </td>'; 806: if ($receiptparts) { 807: $contents.='<td> '.$part.' </td>'; 808: } 809: $contents.= 810: &Apache::loncommon::end_data_table_row()."\n"; 811: 812: $matches++; 813: } 814: } 815: } 816: if ($matches == 0) { 817: $string = $title 818: .'<p class="LC_warning">' 819: .&mt('No match found for the above receipt number.') 820: .'</p>'; 821: } else { 822: $string = &jscriptNform($symb).$title. 823: '<p>'. 824: &mt('The above receipt number matches the following [quant,_1,student].',$matches). 825: '</p>'. 826: $header. 827: $contents. 828: &Apache::loncommon::end_data_table()."\n"; 829: } 830: return $string; 831: } 832: 833: #--- This is called by a number of programs. 834: #--- Called from the Grading Menu - View/Grade an individual student 835: #--- Also called directly when one clicks on the subm button 836: # on the problem page. 837: sub listStudents { 838: my ($request,$symb,$submitonly) = @_; 839: 840: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 841: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 842: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 843: my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; 844: unless ($submitonly) { 845: $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; 846: } 847: 848: my $result=''; 849: my $res_error; 850: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 851: 852: my %lt = &Apache::lonlocal::texthash ( 853: 'multiple' => 'Please select a student or group of students before clicking on the Next button.', 854: 'single' => 'Please select the student before clicking on the Next button.', 855: ); 856: $request->print(&Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT)); 857: function checkSelect(checkBox) { 858: var ctr=0; 859: var sense=""; 860: if (checkBox.length > 1) { 861: for (var i=0; i<checkBox.length; i++) { 862: if (checkBox[i].checked) { 863: ctr++; 864: } 865: } 866: sense = '$lt{'multiple'}'; 867: } else { 868: if (checkBox.checked) { 869: ctr = 1; 870: } 871: sense = '$lt{'single'}'; 872: } 873: if (ctr == 0) { 874: alert(sense); 875: return false; 876: } 877: document.gradesub.submit(); 878: } 879: 880: function reLoadList(formname) { 881: if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;} 882: formname.command.value = 'submission'; 883: formname.submit(); 884: } 885: LISTJAVASCRIPT 886: 887: &commonJSfunctions($request); 888: $request->print($result); 889: 890: my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'. 891: "\n"; 892: 893: $gradeTable .= &Apache::lonhtmlcommon::start_pick_box(); 894: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) 895: .'<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n" 896: .'<label><input type="radio" name="vProb" value="yes" /> '.&mt('one student').' </label>'."\n" 897: .'<label><input type="radio" name="vProb" value="all" /> '.&mt('all students').' </label><br />'."\n" 898: .&Apache::lonhtmlcommon::row_closure(); 899: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer')) 900: .'<label><input type="radio" name="vAns" value="no" /> '.&mt('no').' </label>'."\n" 901: .'<label><input type="radio" name="vAns" value="yes" /> '.&mt('one student').' </label>'."\n" 902: .'<label><input type="radio" name="vAns" value="all" checked="checked" /> '.&mt('all students').' </label><br />'."\n" 903: .&Apache::lonhtmlcommon::row_closure(); 904: 905: my $submission_options; 906: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 907: my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status; 908: $env{'form.Status'} = $saveStatus; 909: $submission_options.= 910: '<span class="LC_nobreak">'. 911: '<label><input type="radio" name="lastSub" value="lastonly" /> '. 912: &mt('last submission').' </label></span>'."\n". 913: '<span class="LC_nobreak">'. 914: '<label><input type="radio" name="lastSub" value="last" /> '. 915: &mt('last submission with details').' </label></span>'."\n". 916: '<span class="LC_nobreak">'. 917: '<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '. 918: &mt('all submissions').'</label></span>'."\n". 919: '<span class="LC_nobreak">'. 920: '<label><input type="radio" name="lastSub" value="all" /> '. 921: &mt('all submissions with details').'</label></span>'; 922: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Submissions')) 923: .$submission_options 924: .&Apache::lonhtmlcommon::row_closure(); 925: 926: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Grading Increments')) 927: .'<select name="increment">' 928: .'<option value="1">'.&mt('Whole Points').'</option>' 929: .'<option value=".5">'.&mt('Half Points').'</option>' 930: .'<option value=".25">'.&mt('Quarter Points').'</option>' 931: .'<option value=".1">'.&mt('Tenths of a Point').'</option>' 932: .'</select>' 933: .&Apache::lonhtmlcommon::row_closure(); 934: 935: $gradeTable .= 936: &build_section_inputs(). 937: '<input type="hidden" name="submitonly" value="'.$submitonly.'" />'."\n". 938: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 939: '<input type="hidden" name="saveStatusOld" value="'.$saveStatus.'" />'."\n"; 940: 941: if (exists($env{'form.Status'})) { 942: $gradeTable .= '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n"; 943: } else { 944: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Student Status')) 945: .&Apache::lonhtmlcommon::StatusOptions( 946: $saveStatus,undef,1,'javascript:reLoadList(this.form);') 947: .&Apache::lonhtmlcommon::row_closure(); 948: } 949: 950: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism')) 951: .'<input type="checkbox" name="checkPlag" checked="checked" />' 952: .&Apache::lonhtmlcommon::row_closure(1) 953: .&Apache::lonhtmlcommon::end_pick_box(); 954: 955: $gradeTable .= '<p>' 956: .&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" 957: .'<input type="hidden" name="command" value="processGroup" />' 958: .'</p>'; 959: 960: # checkall buttons 961: $gradeTable.=&check_script('gradesub', 'stuinfo'); 962: $gradeTable.='<input type="button" '."\n". 963: 'onclick="javascript:checkSelect(this.form.stuinfo);" '."\n". 964: 'value="'.&mt('Next').' →" /> <br />'."\n"; 965: $gradeTable.=&check_buttons(); 966: my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup); 967: $gradeTable.= &Apache::loncommon::start_data_table(). 968: &Apache::loncommon::start_data_table_header_row(); 969: my $loop = 0; 970: while ($loop < 2) { 971: $gradeTable.='<th>'.&mt('No.').'</th><th>'.&mt('Select').'</th>'. 972: '<th>'.&nameUserString('header').' '.&mt('Section/Group').'</th>'; 973: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 974: foreach my $part (sort(@$partlist)) { 975: my $display_part= 976: &get_display_part((split(/_/,$part))[0],$symb); 977: $gradeTable.= 978: '<th>'.&mt('Part: [_1] Status',$display_part).'</th>'; 979: } 980: } elsif ($submitonly eq 'queued') { 981: $gradeTable.='<th>'.&mt('Queue Status').' </th>'; 982: } 983: $loop++; 984: # $gradeTable.='<td></td>' if ($loop%2 ==1); 985: } 986: $gradeTable.=&Apache::loncommon::end_data_table_header_row()."\n"; 987: 988: my $ctr = 0; 989: foreach my $student (sort 990: { 991: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 992: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 993: } 994: return $a cmp $b; 995: } 996: (keys(%$fullname))) { 997: my ($uname,$udom) = split(/:/,$student); 998: 999: my %status = (); 1000: 1001: if ($submitonly eq 'queued') { 1002: my %queue_status = 1003: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 1004: $udom,$uname); 1005: next if (!defined($queue_status{'gradingqueue'})); 1006: $status{'gradingqueue'} = $queue_status{'gradingqueue'}; 1007: } 1008: 1009: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 1010: (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); 1011: my $submitted = 0; 1012: my $graded = 0; 1013: my $incorrect = 0; 1014: foreach (keys(%status)) { 1015: $submitted = 1 if ($status{$_} ne 'nothing'); 1016: $graded = 1 if ($status{$_} =~ /^ungraded/); 1017: $incorrect = 1 if ($status{$_} =~ /^incorrect/); 1018: 1019: my ($foo,$partid,$foo1) = split(/\./,$_); 1020: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 1021: $submitted = 0; 1022: my ($part)=split(/\./,$partid); 1023: $gradeTable.='<input type="hidden" name="'. 1024: $student.':'.$part.':submitted_by" value="'. 1025: $status{'resource.'.$partid.'.submitted_by'}.'" />'; 1026: } 1027: } 1028: 1029: next if (!$submitted && ($submitonly eq 'yes' || 1030: $submitonly eq 'incorrect' || 1031: $submitonly eq 'graded')); 1032: next if (!$graded && ($submitonly eq 'graded')); 1033: next if (!$incorrect && $submitonly eq 'incorrect'); 1034: } 1035: 1036: $ctr++; 1037: my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; 1038: my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; 1039: if ( $perm{'vgr'} eq 'F' ) { 1040: if ($ctr%2 ==1) { 1041: $gradeTable.= &Apache::loncommon::start_data_table_row(); 1042: } 1043: $gradeTable.='<td align="right">'.$ctr.' </td>'. 1044: '<td align="center"><label><input type="checkbox" name="stuinfo" value="'. 1045: $student.':'.$$fullname{$student}.':::SECTION'.$section. 1046: ') " />  </label></td>'."\n".'<td>'. 1047: &nameUserString(undef,$$fullname{$student},$uname,$udom). 1048: ' '.$section.($group ne '' ?'/'.$group:'').'</td>'."\n"; 1049: 1050: if ($submitonly ne 'all') { 1051: foreach (sort(keys(%status))) { 1052: next if ($_ =~ /^resource.*?submitted_by$/); 1053: $gradeTable.='<td align="center"> '.&mt($status{$_}).' </td>'."\n"; 1054: } 1055: } 1056: # $gradeTable.='<td></td>' if ($ctr%2 ==1); 1057: if ($ctr%2 ==0) { 1058: $gradeTable.=&Apache::loncommon::end_data_table_row()."\n"; 1059: } 1060: } 1061: } 1062: if ($ctr%2 ==1) { 1063: $gradeTable.='<td> </td><td> </td><td> </td>'; 1064: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 1065: foreach (@$partlist) { 1066: $gradeTable.='<td> </td>'; 1067: } 1068: } elsif ($submitonly eq 'queued') { 1069: $gradeTable.='<td> </td>'; 1070: } 1071: $gradeTable.=&Apache::loncommon::end_data_table_row(); 1072: } 1073: 1074: $gradeTable.=&Apache::loncommon::end_data_table()."\n". 1075: '<input type="button" '. 1076: 'onclick="javascript:checkSelect(this.form.stuinfo);" '. 1077: 'value="'.&mt('Next').' →" /></form>'."\n"; 1078: if ($ctr == 0) { 1079: my $num_students=(scalar(keys(%$fullname))); 1080: if ($num_students eq 0) { 1081: $gradeTable='<br /> <span class="LC_warning">'.&mt('There are no students currently enrolled.').'</span>'; 1082: } else { 1083: my $submissions='submissions'; 1084: if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } 1085: if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } 1086: if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } 1087: $gradeTable='<br /> <span class="LC_warning">'. 1088: &mt('No '.$submissions.' found for this resource for any students. ([quant,_1,student] checked for '.$submissions.')', 1089: $num_students). 1090: '</span><br />'; 1091: } 1092: } elsif ($ctr == 1) { 1093: $gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/; 1094: } 1095: $request->print($gradeTable); 1096: return ''; 1097: } 1098: 1099: #---- Called from the listStudents routine 1100: 1101: sub check_script { 1102: my ($form, $type)=@_; 1103: my $chkallscript= &Apache::lonhtmlcommon::scripttag(' 1104: function checkall() { 1105: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1106: ele = document.forms.'.$form.'.elements[i]; 1107: if (ele.name == "'.$type.'") { 1108: document.forms.'.$form.'.elements[i].checked=true; 1109: } 1110: } 1111: } 1112: 1113: function checksec() { 1114: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1115: ele = document.forms.'.$form.'.elements[i]; 1116: string = document.forms.'.$form.'.chksec.value; 1117: if 1118: (ele.value.indexOf(":::SECTION"+string)>0) { 1119: document.forms.'.$form.'.elements[i].checked=true; 1120: } 1121: } 1122: } 1123: 1124: 1125: function uncheckall() { 1126: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1127: ele = document.forms.'.$form.'.elements[i]; 1128: if (ele.name == "'.$type.'") { 1129: document.forms.'.$form.'.elements[i].checked=false; 1130: } 1131: } 1132: } 1133: 1134: '."\n"); 1135: return $chkallscript; 1136: } 1137: 1138: sub check_buttons { 1139: my $buttons.='<input type="button" onclick="checkall()" value="'.&mt('Check All').'" />'; 1140: $buttons.='<input type="button" onclick="uncheckall()" value="'.&mt('Uncheck All').'" /> '; 1141: $buttons.='<input type="button" onclick="checksec()" value="'.&mt('Check Section/Group').'" />'; 1142: $buttons.='<input type="text" size="5" name="chksec" /> '; 1143: return $buttons; 1144: } 1145: 1146: # Displays the submissions for one student or a group of students 1147: sub processGroup { 1148: my ($request,$symb) = @_; 1149: my $ctr = 0; 1150: my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); 1151: my $total = scalar(@stuchecked)-1; 1152: 1153: foreach my $student (@stuchecked) { 1154: my ($uname,$udom,$fullname) = split(/:/,$student); 1155: $env{'form.student'} = $uname; 1156: $env{'form.userdom'} = $udom; 1157: $env{'form.fullname'} = $fullname; 1158: &submission($request,$ctr,$total,$symb); 1159: $ctr++; 1160: } 1161: return ''; 1162: } 1163: 1164: #------------------------------------------------------------------------------------ 1165: # 1166: #-------------------------- Next few routines handles grading by student, essentially 1167: # handles essay response type problem/part 1168: # 1169: #--- Javascript to handle the submission page functionality --- 1170: sub sub_page_js { 1171: my $request = shift; 1172: my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); 1173: $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT)); 1174: function updateRadio(formname,id,weight) { 1175: var gradeBox = formname["GD_BOX"+id]; 1176: var radioButton = formname["RADVAL"+id]; 1177: var oldpts = formname["oldpts"+id].value; 1178: var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts; 1179: gradeBox.value = pts; 1180: var resetbox = false; 1181: if (isNaN(pts) || pts < 0) { 1182: alert("$alertmsg"+pts); 1183: for (var i=0; i<radioButton.length; i++) { 1184: if (radioButton[i].checked) { 1185: gradeBox.value = i; 1186: resetbox = true; 1187: } 1188: } 1189: if (!resetbox) { 1190: formtextbox.value = ""; 1191: } 1192: return; 1193: } 1194: 1195: if (pts > weight) { 1196: var resp = confirm("You entered a value ("+pts+ 1197: ") greater than the weight for the part. Accept?"); 1198: if (resp == false) { 1199: gradeBox.value = oldpts; 1200: return; 1201: } 1202: } 1203: 1204: for (var i=0; i<radioButton.length; i++) { 1205: radioButton[i].checked=false; 1206: if (pts == i && pts != "") { 1207: radioButton[i].checked=true; 1208: } 1209: } 1210: updateSelect(formname,id); 1211: formname["stores"+id].value = "0"; 1212: } 1213: 1214: function writeBox(formname,id,pts) { 1215: var gradeBox = formname["GD_BOX"+id]; 1216: if (checkSolved(formname,id) == 'update') { 1217: gradeBox.value = pts; 1218: } else { 1219: var oldpts = formname["oldpts"+id].value; 1220: gradeBox.value = oldpts; 1221: var radioButton = formname["RADVAL"+id]; 1222: for (var i=0; i<radioButton.length; i++) { 1223: radioButton[i].checked=false; 1224: if (i == oldpts) { 1225: radioButton[i].checked=true; 1226: } 1227: } 1228: } 1229: formname["stores"+id].value = "0"; 1230: updateSelect(formname,id); 1231: return; 1232: } 1233: 1234: function clearRadBox(formname,id) { 1235: if (checkSolved(formname,id) == 'noupdate') { 1236: updateSelect(formname,id); 1237: return; 1238: } 1239: gradeSelect = formname["GD_SEL"+id]; 1240: for (var i=0; i<gradeSelect.length; i++) { 1241: if (gradeSelect[i].selected) { 1242: var selectx=i; 1243: } 1244: } 1245: var stores = formname["stores"+id]; 1246: if (selectx == stores.value) { return }; 1247: var gradeBox = formname["GD_BOX"+id]; 1248: gradeBox.value = ""; 1249: var radioButton = formname["RADVAL"+id]; 1250: for (var i=0; i<radioButton.length; i++) { 1251: radioButton[i].checked=false; 1252: } 1253: stores.value = selectx; 1254: } 1255: 1256: function checkSolved(formname,id) { 1257: if (formname["solved"+id].value == "correct_by_student" && formname.overRideScore.value == 'no') { 1258: var reply = confirm("This problem has been graded correct by the computer. Do you want to change the score?"); 1259: if (!reply) {return "noupdate";} 1260: formname.overRideScore.value = 'yes'; 1261: } 1262: return "update"; 1263: } 1264: 1265: function updateSelect(formname,id) { 1266: formname["GD_SEL"+id][0].selected = true; 1267: return; 1268: } 1269: 1270: //=========== Check that a point is assigned for all the parts ============ 1271: function checksubmit(formname,val,total,parttot) { 1272: formname.gradeOpt.value = val; 1273: if (val == "Save & Next") { 1274: for (i=0;i<=total;i++) { 1275: for (j=0;j<parttot;j++) { 1276: var partid = formname["partid"+i+"_"+j].value; 1277: if (formname["GD_SEL"+i+"_"+partid][0].selected) { 1278: var points = formname["GD_BOX"+i+"_"+partid].value; 1279: if (points == "") { 1280: var name = formname["name"+i].value; 1281: var studentID = (name != '' ? name : formname["unamedom"+i].value); 1282: var resp = confirm("You did not assign a score for "+studentID+ 1283: ", part "+partid+". Continue?"); 1284: if (resp == false) { 1285: formname["GD_BOX"+i+"_"+partid].focus(); 1286: return false; 1287: } 1288: } 1289: } 1290: 1291: } 1292: } 1293: 1294: } 1295: formname.submit(); 1296: } 1297: 1298: //======= Check that a score is assigned for all the problems (page/sequence grading only) ========= 1299: function checkSubmitPage(formname,total) { 1300: noscore = new Array(100); 1301: var ptr = 0; 1302: for (i=1;i<total;i++) { 1303: var partid = formname["q_"+i].value; 1304: if (formname["GD_SEL"+i+"_"+partid][0].selected) { 1305: var points = formname["GD_BOX"+i+"_"+partid].value; 1306: var status = formname["solved"+i+"_"+partid].value; 1307: if (points == "" && status != "correct_by_student") { 1308: noscore[ptr] = i; 1309: ptr++; 1310: } 1311: } 1312: } 1313: if (ptr != 0) { 1314: var sense = ptr == 1 ? ": " : "s: "; 1315: var prolist = ""; 1316: if (ptr == 1) { 1317: prolist = noscore[0]; 1318: } else { 1319: var i = 0; 1320: while (i < ptr-1) { 1321: prolist += noscore[i]+", "; 1322: i++; 1323: } 1324: prolist += "and "+noscore[i]; 1325: } 1326: var resp = confirm("You did not assign any score for the following problem"+sense+prolist+". Continue?"); 1327: if (resp == false) { 1328: return false; 1329: } 1330: } 1331: 1332: formname.submit(); 1333: } 1334: SUBJAVASCRIPT 1335: } 1336: 1337: #--- javascript for essay type problem -- 1338: sub sub_page_kw_js { 1339: my $request = shift; 1340: my $iconpath = $request->dir_config('lonIconsURL'); 1341: &commonJSfunctions($request); 1342: 1343: my $inner_js_msg_central= (<<INNERJS); 1344: <script type="text/javascript"> 1345: function checkInput() { 1346: opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value); 1347: var nmsg = opener.document.SCORE.savemsgN.value; 1348: var usrctr = document.msgcenter.usrctr.value; 1349: var newval = opener.document.SCORE["newmsg"+usrctr]; 1350: newval.value = opener.checkEntities(document.msgcenter.newmsg.value); 1351: 1352: var msgchk = ""; 1353: if (document.msgcenter.subchk.checked) { 1354: msgchk = "msgsub,"; 1355: } 1356: var includemsg = 0; 1357: for (var i=1; i<=nmsg; i++) { 1358: var opnmsg = opener.document.SCORE["savemsg"+i]; 1359: var frmmsg = document.msgcenter["msg"+i]; 1360: opnmsg.value = opener.checkEntities(frmmsg.value); 1361: var showflg = opener.document.SCORE["shownOnce"+i]; 1362: showflg.value = "1"; 1363: var chkbox = document.msgcenter["msgn"+i]; 1364: if (chkbox.checked) { 1365: msgchk += "savemsg"+i+","; 1366: includemsg = 1; 1367: } 1368: } 1369: if (document.msgcenter.newmsgchk.checked) { 1370: msgchk += "newmsg"+usrctr; 1371: includemsg = 1; 1372: } 1373: imgformname = opener.document.SCORE["mailicon"+usrctr]; 1374: imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif"); 1375: var includemsg = opener.document.SCORE["includemsg"+usrctr]; 1376: includemsg.value = msgchk; 1377: 1378: self.close() 1379: 1380: } 1381: </script> 1382: INNERJS 1383: 1384: my $inner_js_highlight_central= (<<INNERJS); 1385: <script type="text/javascript"> 1386: function updateChoice(flag) { 1387: opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr); 1388: opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize); 1389: opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle); 1390: opener.document.SCORE.refresh.value = "on"; 1391: if (opener.document.SCORE.keywords.value!=""){ 1392: opener.document.SCORE.submit(); 1393: } 1394: self.close() 1395: } 1396: </script> 1397: INNERJS 1398: 1399: my $start_page_msg_central = 1400: &Apache::loncommon::start_page('Message Central',$inner_js_msg_central, 1401: {'js_ready' => 1, 1402: 'only_body' => 1, 1403: 'bgcolor' =>'#FFFFFF',}); 1404: my $end_page_msg_central = 1405: &Apache::loncommon::end_page({'js_ready' => 1}); 1406: 1407: 1408: my $start_page_highlight_central = 1409: &Apache::loncommon::start_page('Highlight Central', 1410: $inner_js_highlight_central, 1411: {'js_ready' => 1, 1412: 'only_body' => 1, 1413: 'bgcolor' =>'#FFFFFF',}); 1414: my $end_page_highlight_central = 1415: &Apache::loncommon::end_page({'js_ready' => 1}); 1416: 1417: my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); 1418: $docopen=~s/^document\.//; 1419: my %lt = &Apache::lonlocal::texthash( 1420: keyw => 'Keywords list, separated by a space. Add/delete to list if desired.', 1421: plse => 'Please select a word or group of words from document and then click this link.', 1422: adds => 'Add selection to keyword list? Edit if desired.', 1423: comp => 'Compose Message for: ', 1424: incl => 'Include', 1425: type => 'Type', 1426: subj => 'Subject', 1427: mesa => 'Message', 1428: new => 'New', 1429: save => 'Save', 1430: canc => 'Cancel', 1431: kehi => 'Keyword Highlight Options', 1432: txtc => 'Text Color', 1433: font => 'Font Size', 1434: fnst => 'Font Style', 1435: col1 => 'red', 1436: col2 => 'green', 1437: col3 => 'blue', 1438: siz1 => 'normal', 1439: siz2 => '+1', 1440: siz3 => '+2', 1441: sty1 => 'normal', 1442: sty2 => 'italic', 1443: sty3 => 'bold', 1444: ); 1445: $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT)); 1446: 1447: //===================== Show list of keywords ==================== 1448: function keywords(formname) { 1449: var nret = prompt("$lt{'keyw'}",formname.keywords.value); 1450: if (nret==null) return; 1451: formname.keywords.value = nret; 1452: 1453: if (formname.keywords.value != "") { 1454: formname.refresh.value = "on"; 1455: formname.submit(); 1456: } 1457: return; 1458: } 1459: 1460: //===================== Script to view submitted by ================== 1461: function viewSubmitter(submitter) { 1462: document.SCORE.refresh.value = "on"; 1463: document.SCORE.NCT.value = "1"; 1464: document.SCORE.unamedom0.value = submitter; 1465: document.SCORE.submit(); 1466: return; 1467: } 1468: 1469: //===================== Script to add keyword(s) ================== 1470: function getSel() { 1471: if (document.getSelection) txt = document.getSelection(); 1472: else if (document.selection) txt = document.selection.createRange().text; 1473: else return; 1474: var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," "); 1475: if (cleantxt=="") { 1476: alert("$lt{'plse'}"); 1477: return; 1478: } 1479: var nret = prompt("$lt{'adds'}",cleantxt); 1480: if (nret==null) return; 1481: document.SCORE.keywords.value = document.SCORE.keywords.value+" "+nret; 1482: if (document.SCORE.keywords.value != "") { 1483: document.SCORE.refresh.value = "on"; 1484: document.SCORE.submit(); 1485: } 1486: return; 1487: } 1488: 1489: //====================== Script for composing message ============== 1490: // preload images 1491: img1 = new Image(); 1492: img1.src = "$iconpath/mailbkgrd.gif"; 1493: img2 = new Image(); 1494: img2.src = "$iconpath/mailto.gif"; 1495: 1496: function msgCenter(msgform,usrctr,fullname) { 1497: var Nmsg = msgform.savemsgN.value; 1498: savedMsgHeader(Nmsg,usrctr,fullname); 1499: var subject = msgform.msgsub.value; 1500: var msgchk = document.SCORE["includemsg"+usrctr].value; 1501: re = /msgsub/; 1502: var shwsel = ""; 1503: if (re.test(msgchk)) { shwsel = "checked" } 1504: subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject); 1505: displaySubject(checkEntities(subject),shwsel); 1506: for (var i=1; i<=Nmsg; i++) { 1507: var testmsg = "savemsg"+i+","; 1508: re = new RegExp(testmsg,"g"); 1509: shwsel = ""; 1510: if (re.test(msgchk)) { shwsel = "checked" } 1511: var message = document.SCORE["savemsg"+i].value; 1512: message = (document.SCORE["shownOnce"+i].value == 0 ? checkEntities(message) : message); 1513: displaySavedMsg(i,message,shwsel); //I do not get it. w/o checkEntities on saved messages, 1514: //any < is already converted to <, etc. However, only once!! 1515: } 1516: newmsg = document.SCORE["newmsg"+usrctr].value; 1517: shwsel = ""; 1518: re = /newmsg/; 1519: if (re.test(msgchk)) { shwsel = "checked" } 1520: newMsg(newmsg,shwsel); 1521: msgTail(); 1522: return; 1523: } 1524: 1525: function checkEntities(strx) { 1526: if (strx.length == 0) return strx; 1527: var orgStr = ["&", "<", ">", '"']; 1528: var newStr = ["&", "<", ">", """]; 1529: var counter = 0; 1530: while (counter < 4) { 1531: strx = strReplace(strx,orgStr[counter],newStr[counter]); 1532: counter++; 1533: } 1534: return strx; 1535: } 1536: 1537: function strReplace(strx, orgStr, newStr) { 1538: return strx.split(orgStr).join(newStr); 1539: } 1540: 1541: function savedMsgHeader(Nmsg,usrctr,fullname) { 1542: var height = 70*Nmsg+250; 1543: if (height > 600) { 1544: height = 600; 1545: } 1546: var xpos = (screen.width-600)/2; 1547: xpos = (xpos < 0) ? '0' : xpos; 1548: var ypos = (screen.height-height)/2-30; 1549: ypos = (ypos < 0) ? '0' : ypos; 1550: 1551: pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars=yes,screenx='+xpos+',screeny='+ypos+',width=700,height='+height); 1552: pWin.focus(); 1553: pDoc = pWin.document; 1554: pDoc.$docopen; 1555: pDoc.write('$start_page_msg_central'); 1556: 1557: pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">"); 1558: pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">"); 1559: pDoc.write("<h1> $lt{'comp'}\"+fullname+\"<\\/h1>"); 1560: 1561: pDoc.write('<table style="border:1px solid black;"><tr>'); 1562: pDoc.write("<td><b>$lt{'incl'}<\\/b><\\/td><td><b>$lt{'type'}<\\/b><\\/td><td><b>$lt{'mesa'}<\\/td><\\/tr>"); 1563: } 1564: function displaySubject(msg,shwsel) { 1565: pDoc = pWin.document; 1566: pDoc.write("<tr>"); 1567: pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1568: pDoc.write("<td>$lt{'subj'}<\\/td>"); 1569: pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"40\\" maxlength=\\"80\\"><\\/td><\\/tr>"); 1570: } 1571: 1572: function displaySavedMsg(ctr,msg,shwsel) { 1573: pDoc = pWin.document; 1574: pDoc.write("<tr>"); 1575: pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1576: pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>"); 1577: pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>"); 1578: } 1579: 1580: function newMsg(newmsg,shwsel) { 1581: pDoc = pWin.document; 1582: pDoc.write("<tr>"); 1583: pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1584: pDoc.write("<td align=\\"center\\">$lt{'new'}<\\/td>"); 1585: pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>"); 1586: } 1587: 1588: function msgTail() { 1589: pDoc = pWin.document; 1590: //pDoc.write("<\\/table>"); 1591: pDoc.write("<\\/td><\\/tr><\\/table> "); 1592: pDoc.write("<input type=\\"button\\" value=\\"$lt{'save'}\\" onclick=\\"javascript:checkInput()\\">  "); 1593: pDoc.write("<input type=\\"button\\" value=\\"$lt{'canc'}\\" onclick=\\"self.close()\\"><br /><br />"); 1594: pDoc.write("<\\/form>"); 1595: pDoc.write('$end_page_msg_central'); 1596: pDoc.close(); 1597: } 1598: 1599: //====================== Script for keyword highlight options ============== 1600: function kwhighlight() { 1601: var kwclr = document.SCORE.kwclr.value; 1602: var kwsize = document.SCORE.kwsize.value; 1603: var kwstyle = document.SCORE.kwstyle.value; 1604: var redsel = ""; 1605: var grnsel = ""; 1606: var blusel = ""; 1607: var txtcol1 = "$lt{'col1'}"; 1608: var txtcol2 = "$lt{'col2'}"; 1609: var txtcol3 = "$lt{'col3'}"; 1610: var txtsiz1 = "$lt{'siz1'}"; 1611: var txtsiz2 = "$lt{'siz2'}"; 1612: var txtsiz3 = "$lt{'siz3'}"; 1613: var txtsty1 = "$lt{'sty1'}"; 1614: var txtsty2 = "$lt{'sty2'}"; 1615: var txtsty3 = "$lt{'sty3'}"; 1616: if (kwclr=="red") {var redsel="checked='checked'"}; 1617: if (kwclr=="green") {var grnsel="checked='checked'"}; 1618: if (kwclr=="blue") {var blusel="checked='checked'"}; 1619: var sznsel = ""; 1620: var sz1sel = ""; 1621: var sz2sel = ""; 1622: if (kwsize=="0") {var sznsel="checked='checked'"}; 1623: if (kwsize=="+1") {var sz1sel="checked='checked'"}; 1624: if (kwsize=="+2") {var sz2sel="checked='checked'"}; 1625: var synsel = ""; 1626: var syisel = ""; 1627: var sybsel = ""; 1628: if (kwstyle=="") {var synsel="checked='checked'"}; 1629: if (kwstyle=="<i>") {var syisel="checked='checked'"}; 1630: if (kwstyle=="<b>") {var sybsel="checked='checked'"}; 1631: highlightCentral(); 1632: highlightbody('red',txtcol1,redsel,'0',txtsiz1,sznsel,'',txtsty1,synsel); 1633: highlightbody('green',txtcol2,grnsel,'+1',txtsiz2,sz1sel,'<i>',txtsty2,syisel); 1634: highlightbody('blue',txtcol3,blusel,'+2',txtsiz3,sz2sel,'<b>',txtsty3,sybsel); 1635: highlightend(); 1636: return; 1637: } 1638: 1639: function highlightCentral() { 1640: // if (window.hwdWin) window.hwdWin.close(); 1641: var xpos = (screen.width-400)/2; 1642: xpos = (xpos < 0) ? '0' : xpos; 1643: var ypos = (screen.height-330)/2-30; 1644: ypos = (ypos < 0) ? '0' : ypos; 1645: 1646: hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); 1647: hwdWin.focus(); 1648: var hDoc = hwdWin.document; 1649: hDoc.$docopen; 1650: hDoc.write('$start_page_highlight_central'); 1651: hDoc.write("<form action=\\"inactive\\" name=\\"hlCenter\\">"); 1652: hDoc.write("<h1>$lt{'kehi'}<\\/h1>"); 1653: 1654: hDoc.write('<table border="0" width="100%"><tr style="background-color:#A1D676">'); 1655: hDoc.write("<th>$lt{'txtc'}<\\/th><th>$lt{'font'}<\\/th><th>$lt{'fnst'}<\\/th><\\/tr>"); 1656: } 1657: 1658: function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) { 1659: var hDoc = hwdWin.document; 1660: hDoc.write("<tr>"); 1661: hDoc.write("<td align=\\"left\\">"); 1662: hDoc.write("<input name=\\"kwdclr\\" type=\\"radio\\" value=\\""+clrval+"\\" "+clrsel+" \\/> "+clrtxt+"<\\/td>"); 1663: hDoc.write("<td align=\\"left\\">"); 1664: hDoc.write("<input name=\\"kwdsize\\" type=\\"radio\\" value=\\""+szval+"\\" "+szsel+" \\/> "+sztxt+"<\\/td>"); 1665: hDoc.write("<td align=\\"left\\">"); 1666: hDoc.write("<input name=\\"kwdstyle\\" type=\\"radio\\" value=\\""+syval+"\\" "+sysel+" \\/> "+sytxt+"<\\/td>"); 1667: hDoc.write("<\\/tr>"); 1668: } 1669: 1670: function highlightend() { 1671: var hDoc = hwdWin.document; 1672: hDoc.write("<\\/table><br \\/>"); 1673: hDoc.write("<input type=\\"button\\" value=\\"$lt{'save'}\\" onclick=\\"javascript:updateChoice(1)\\" \\/>  "); 1674: hDoc.write("<input type=\\"button\\" value=\\"$lt{'canc'}\\" onclick=\\"self.close()\\" \\/><br /><br />"); 1675: hDoc.write("<\\/form>"); 1676: hDoc.write('$end_page_highlight_central'); 1677: hDoc.close(); 1678: } 1679: 1680: SUBJAVASCRIPT 1681: } 1682: 1683: sub get_increment { 1684: my $increment = $env{'form.increment'}; 1685: if ($increment != 1 && $increment != .5 && $increment != .25 && 1686: $increment != .1) { 1687: $increment = 1; 1688: } 1689: return $increment; 1690: } 1691: 1692: sub gradeBox_start { 1693: return ( 1694: &Apache::loncommon::start_data_table() 1695: .&Apache::loncommon::start_data_table_header_row() 1696: .'<th>'.&mt('Part').'</th>' 1697: .'<th>'.&mt('Points').'</th>' 1698: .'<th> </th>' 1699: .'<th>'.&mt('Assign Grade').'</th>' 1700: .'<th>'.&mt('Weight').'</th>' 1701: .'<th>'.&mt('Grade Status').'</th>' 1702: .&Apache::loncommon::end_data_table_header_row() 1703: ); 1704: } 1705: 1706: sub gradeBox_end { 1707: return ( 1708: &Apache::loncommon::end_data_table() 1709: ); 1710: } 1711: #--- displays the grading box, used in essay type problem and grading by page/sequence 1712: sub gradeBox { 1713: my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; 1714: my $checkIcon = '<img alt="'.&mt('Check Mark'). 1715: '" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />'; 1716: my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); 1717: my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)') 1718: : '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>'; 1719: $wgt = ($wgt > 0 ? $wgt : '1'); 1720: my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? 1721: '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); 1722: my $data_WGT='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n"; 1723: my $display_part= &get_display_part($partid,$symb); 1724: my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, 1725: [$partid]); 1726: my $aggtries = $$record{'resource.'.$partid.'.tries'}; 1727: if ($last_resets{$partid}) { 1728: $aggtries = &get_num_tries($record,$last_resets{$partid},$partid); 1729: } 1730: my $result=&Apache::loncommon::start_data_table_row(); 1731: my $ctr = 0; 1732: my $thisweight = 0; 1733: my $increment = &get_increment(); 1734: 1735: my $radio.='<table border="0"><tr>'."\n"; # display radio buttons in a nice table 10 across 1736: while ($thisweight<=$wgt) { 1737: $radio.= '<td><span class="LC_nobreak"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '. 1738: 'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','. 1739: $thisweight.')" value="'.$thisweight.'" '. 1740: ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n"; 1741: $radio.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); 1742: $thisweight += $increment; 1743: $ctr++; 1744: } 1745: $radio.='</tr></table>'; 1746: 1747: my $line.='<input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'. 1748: ($score ne ''? ' value = "'.$score.'"':'').' size="4" '. 1749: 'onchange="javascript:updateRadio(this.form,\''.$counter.'_'.$partid.'\','. 1750: $wgt.')" /></td>'."\n"; 1751: $line.='<td>/'.$wgt.' '.$wgtmsg. 1752: ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : ''). 1753: ' </td>'."\n"; 1754: $line.='<td><select name="GD_SEL'.$counter.'_'.$partid.'" '. 1755: 'onchange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n"; 1756: if ($$record{'resource.'.$partid.'.solved'} eq 'excused') { 1757: $line.='<option></option>'. 1758: '<option value="excused" selected="selected">'.&mt('excused').'</option>'; 1759: } else { 1760: $line.='<option selected="selected"></option>'. 1761: '<option value="excused" >'.&mt('excused').'</option>'; 1762: } 1763: $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n"; 1764: 1765: 1766: $result .= 1767: '<td>'.$data_WGT.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'; 1768: $result.=&Apache::loncommon::end_data_table_row(); 1769: $result.=&Apache::loncommon::start_data_table_row().'<td colspan="6">'; 1770: $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n". 1771: '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n". 1772: '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'. 1773: $$record{'resource.'.$partid.'.solved'}.'" />'."\n". 1774: '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'. 1775: $$record{'resource.'.$partid.'.tries'}.'" />'."\n". 1776: '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'. 1777: $aggtries.'" />'."\n"; 1778: my $res_error; 1779: $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record,\$res_error); 1780: $result.='</td>'.&Apache::loncommon::end_data_table_row(); 1781: if ($res_error) { 1782: return &navmap_errormsg(); 1783: } 1784: return $result; 1785: } 1786: 1787: sub handback_box { 1788: my ($symb,$uname,$udom,$counter,$partid,$record,$res_error_pointer) = @_; 1789: my ($partlist,$handgrade,$responseType) = &response_type($symb,$res_error_pointer); 1790: my (@respids); 1791: my @part_response_id = &flatten_responseType($responseType); 1792: foreach my $part_response_id (@part_response_id) { 1793: my ($part,$resp) = @{ $part_response_id }; 1794: if ($part eq $partid) { 1795: push(@respids,$resp); 1796: } 1797: } 1798: my $result; 1799: foreach my $respid (@respids) { 1800: my $prefix = $counter.'_'.$partid.'_'.$respid.'_'; 1801: my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record); 1802: next if (!@$files); 1803: my $file_counter = 0; 1804: foreach my $file (@$files) { 1805: if ($file =~ /\/portfolio\//) { 1806: $file_counter++; 1807: my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|); 1808: my ($name,$version,$ext) = &file_name_version_ext($file_disp); 1809: $file_disp = "$name.$ext"; 1810: $file = $file_path.$file_disp; 1811: $result.=&mt('Return commented version of [_1] to student.', 1812: '<span class="LC_filename">'.$file_disp.'</span>'); 1813: $result.='<input type="file" name="'.$prefix.'returndoc'.$file_counter.'" />'."\n"; 1814: $result.='<input type="hidden" name="'.$prefix.'origdoc'.$file_counter.'" value="'.$file.'" /><br />'."\n"; 1815: } 1816: } 1817: if ($file_counter) { 1818: $result .= '<input type="hidden" name="'.$prefix.'countreturndoc" value="'.$file_counter.'" />'."\n". 1819: '<span class="LC_info">'. 1820: '('.&mt('File(s) will be uploaded when you click on Save & Next below.',$file_counter).')</span><br /><br />'; 1821: } 1822: } 1823: return $result; 1824: } 1825: 1826: sub show_problem { 1827: my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_; 1828: my $rendered; 1829: my %form = ((ref($form) eq 'HASH')? %{$form} : ()); 1830: &Apache::lonxml::remember_problem_counter(); 1831: if ($mode eq 'both' or $mode eq 'text') { 1832: $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, 1833: $env{'request.course.id'}, 1834: undef,\%form); 1835: } 1836: if ($removeform) { 1837: $rendered=~s|<form(.*?)>||g; 1838: $rendered=~s|</form>||g; 1839: $rendered=~s|(<input[^>]*name\s*=\s*"?)(\w+)("?)|$1would_have_been_$2$3|g; 1840: } 1841: my $companswer; 1842: if ($mode eq 'both' or $mode eq 'answer') { 1843: &Apache::lonxml::restore_problem_counter(); 1844: $companswer= 1845: &Apache::loncommon::get_student_answers($symb,$uname,$udom, 1846: $env{'request.course.id'}, 1847: %form); 1848: } 1849: if ($removeform) { 1850: $companswer=~s|<form(.*?)>||g; 1851: $companswer=~s|</form>||g; 1852: $companswer=~s|name="submit"|name="would_have_been_submit"|g; 1853: } 1854: my $renderheading = &mt('View of the problem'); 1855: my $answerheading = &mt('Correct answer'); 1856: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { 1857: my $stu_fullname = $env{'form.fullname'}; 1858: if ($stu_fullname eq '') { 1859: $stu_fullname = &Apache::loncommon::plainname($uname,$udom,'lastname'); 1860: } 1861: my $forwhom = &nameUserString(undef,$stu_fullname,$uname,$udom); 1862: if ($forwhom ne '') { 1863: $renderheading = &mt('View of the problem for[_1]',$forwhom); 1864: $answerheading = &mt('Correct answer for[_1]',$forwhom); 1865: } 1866: } 1867: $rendered= 1868: '<div class="LC_Box">' 1869: .'<h3 class="LC_hcell">'.$renderheading.'</h3>' 1870: .$rendered 1871: .'</div>'; 1872: $companswer= 1873: '<div class="LC_Box">' 1874: .'<h3 class="LC_hcell">'.$answerheading.'</h3>' 1875: .$companswer 1876: .'</div>'; 1877: my $result; 1878: if ($mode eq 'both') { 1879: $result=$rendered.$companswer; 1880: } elsif ($mode eq 'text') { 1881: $result=$rendered; 1882: } elsif ($mode eq 'answer') { 1883: $result=$companswer; 1884: } 1885: return $result; 1886: } 1887: 1888: sub files_exist { 1889: my ($r, $symb) = @_; 1890: my @students = &Apache::loncommon::get_env_multiple('form.stuinfo'); 1891: 1892: foreach my $student (@students) { 1893: my ($uname,$udom,$fullname) = split(/:/,$student); 1894: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, 1895: $udom,$uname); 1896: my ($string,$timestamp)= &get_last_submission(\%record); 1897: foreach my $submission (@$string) { 1898: my ($partid,$respid) = 1899: ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); 1900: my $files=&get_submitted_files($udom,$uname,$partid,$respid, 1901: \%record); 1902: return 1 if (@$files); 1903: } 1904: } 1905: return 0; 1906: } 1907: 1908: sub download_all_link { 1909: my ($r,$symb) = @_; 1910: unless (&files_exist($r, $symb)) { 1911: $r->print(&mt('There are currently no submitted documents.')); 1912: return; 1913: } 1914: 1915: my $all_students = 1916: join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo')); 1917: 1918: my $parts = 1919: join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); 1920: 1921: my $identifier = &Apache::loncommon::get_cgi_id(); 1922: &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, 1923: 'cgi.'.$identifier.'.symb' => $symb, 1924: 'cgi.'.$identifier.'.parts' => $parts,}); 1925: $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'. 1926: &mt('Download All Submitted Documents').'</a>'); 1927: return; 1928: } 1929: 1930: sub submit_download_link { 1931: my ($request,$symb) = @_; 1932: if (!$symb) { return ''; } 1933: #FIXME: Figure out which type of problem this is and provide appropriate download 1934: &download_all_link($request,$symb); 1935: } 1936: 1937: sub build_section_inputs { 1938: my $section_inputs; 1939: if ($env{'form.section'} eq '') { 1940: $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n"; 1941: } else { 1942: my @sections = &Apache::loncommon::get_env_multiple('form.section'); 1943: foreach my $section (@sections) { 1944: $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n"; 1945: } 1946: } 1947: return $section_inputs; 1948: } 1949: 1950: # --------------------------- show submissions of a student, option to grade 1951: sub submission { 1952: my ($request,$counter,$total,$symb) = @_; 1953: my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); 1954: $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student? 1955: my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); 1956: $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq ''; 1957: 1958: my $probtitle=&Apache::lonnet::gettitle($symb); 1959: if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } 1960: 1961: if (!&canview($usec)) { 1962: $request->print( 1963: '<span class="LC_warning">'. 1964: &mt('Unable to view requested student.'). 1965: ' '.&mt('([_1] in section [_2] in course id [_3])', 1966: $uname.':'.$udom,$usec,$env{'request.course.id'}). 1967: '</span>'); 1968: return; 1969: } 1970: 1971: if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; } 1972: if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; } 1973: if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; } 1974: my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); 1975: my $checkIcon = '<img alt="'.&mt('Check Mark'). 1976: '" src="'.$request->dir_config('lonIconsURL'). 1977: '/check.gif" height="16" border="0" />'; 1978: 1979: # header info 1980: if ($counter == 0) { 1981: &sub_page_js($request); 1982: &sub_page_kw_js($request); 1983: 1984: # option to display problem, only once else it cause problems 1985: # with the form later since the problem has a form. 1986: if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') { 1987: my $mode; 1988: if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') { 1989: $mode='both'; 1990: } elsif ($env{'form.vProb'} eq 'yes') { 1991: $mode='text'; 1992: } elsif ($env{'form.vAns'} eq 'yes') { 1993: $mode='answer'; 1994: } 1995: &Apache::lonxml::clear_problem_counter(); 1996: $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); 1997: } 1998: 1999: # kwclr is the only variable that is guaranteed not to be blank 2000: # if this subroutine has been called once. 2001: my %keyhash = (); 2002: # if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') { 2003: if (1) { 2004: %keyhash = &Apache::lonnet::dump('nohist_handgrade', 2005: $env{'course.'.$env{'request.course.id'}.'.domain'}, 2006: $env{'course.'.$env{'request.course.id'}.'.num'}); 2007: 2008: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 2009: $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; 2010: $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; 2011: $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; 2012: $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; 2013: $env{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? 2014: $keyhash{$symb.'_subject'} : $probtitle; 2015: $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; 2016: } 2017: my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'}; 2018: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 2019: $request->print('<form action="/adm/grades" method="post" name="SCORE" enctype="multipart/form-data">'."\n". 2020: '<input type="hidden" name="command" value="handgrade" />'."\n". 2021: '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 2022: '<input type="hidden" name="overRideScore" value="'.$overRideScore.'" />'."\n". 2023: '<input type="hidden" name="refresh" value="off" />'."\n". 2024: '<input type="hidden" name="studentNo" value="" />'."\n". 2025: '<input type="hidden" name="gradeOpt" value="" />'."\n". 2026: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 2027: '<input type="hidden" name="vProb" value="'.$env{'form.vProb'}.'" />'."\n". 2028: '<input type="hidden" name="vAns" value="'.$env{'form.vAns'}.'" />'."\n". 2029: '<input type="hidden" name="lastSub" value="'.$env{'form.lastSub'}.'" />'."\n". 2030: &build_section_inputs(). 2031: '<input type="hidden" name="submitonly" value="'.$env{'form.submitonly'}.'" />'."\n". 2032: '<input type="hidden" name="NCT"'. 2033: ' value="'.($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : $total+1).'" />'."\n"); 2034: # if ($env{'form.handgrade'} eq 'yes') { 2035: if (1) { 2036: $request->print('<input type="hidden" name="keywords" value="'.$env{'form.keywords'}.'" />'."\n". 2037: '<input type="hidden" name="kwclr" value="'.$env{'form.kwclr'}.'" />'."\n". 2038: '<input type="hidden" name="kwsize" value="'.$env{'form.kwsize'}.'" />'."\n". 2039: '<input type="hidden" name="kwstyle" value="'.$env{'form.kwstyle'}.'" />'."\n". 2040: '<input type="hidden" name="msgsub" value="'.$env{'form.msgsub'}.'" />'."\n". 2041: '<input type="hidden" name="shownSub" value="0" />'."\n". 2042: '<input type="hidden" name="savemsgN" value="'.$env{'form.savemsgN'}.'" />'."\n"); 2043: foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { 2044: $request->print('<input type="hidden" name="vPart" value="'.$partid.'" />'."\n"); 2045: } 2046: } 2047: 2048: my ($cts,$prnmsg) = (1,''); 2049: while ($cts <= $env{'form.savemsgN'}) { 2050: $prnmsg.='<input type="hidden" name="savemsg'.$cts.'" value="'. 2051: (!exists($keyhash{$symb.'_savemsg'.$cts}) ? 2052: &Apache::lonfeedback::clear_out_html($env{'form.savemsg'.$cts}) : 2053: &Apache::lonfeedback::clear_out_html($keyhash{$symb.'_savemsg'.$cts})). 2054: '" />'."\n". 2055: '<input type="hidden" name="shownOnce'.$cts.'" value="0" />'."\n"; 2056: $cts++; 2057: } 2058: $request->print($prnmsg); 2059: 2060: # if ($env{'form.handgrade'} eq 'yes') { 2061: if (1) { 2062: 2063: my %lt = &Apache::lonlocal::texthash( 2064: keyh => 'Keyword Highlighting for Essays', 2065: keyw => 'Keyword Options', 2066: list => 'List', 2067: past => 'Paste Selection to List', 2068: high => 'Highlight Attribute', 2069: ); 2070: # 2071: # Print out the keyword options line 2072: # 2073: $request->print( 2074: '<div class="LC_columnSection">' 2075: .'<fieldset><legend>'.$lt{'keyh'}.'</legend>' 2076: .&Apache::lonhtmlcommon::funclist_from_array( 2077: ['<a href="javascript:keywords(document.SCORE);" target="_self">'.$lt{'list'}.'</a>', 2078: '<a href="#" onmousedown="javascript:getSel(); return false" 2079: class="page">'.$lt{'past'}.'</a>', 2080: '<a href="javascript:kwhighlight();" target="_self">'.$lt{'high'}.'</a>'], 2081: {legend => $lt{'keyw'}}) 2082: .'</fieldset></div>' 2083: ); 2084: 2085: # 2086: # Load the other essays for similarity check 2087: # 2088: my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); 2089: my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); 2090: $apath=&escape($apath); 2091: $apath=~s/\W/\_/gs; 2092: &init_old_essays($symb,$apath,$adom,$aname); 2093: } 2094: } 2095: 2096: # This is where output for one specific student would start 2097: my $add_class = ($counter%2) ? ' LC_grade_show_user_odd_row' : ''; 2098: $request->print( 2099: "\n\n" 2100: .'<div class="LC_grade_show_user'.$add_class.'">' 2101: .'<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).'</h2>' 2102: ."\n" 2103: ); 2104: 2105: # Show additional functions if allowed 2106: if ($perm{'vgr'}) { 2107: $request->print( 2108: &Apache::loncommon::track_student_link( 2109: 'View recent activity', 2110: $uname,$udom,'check') 2111: .' ' 2112: ); 2113: } 2114: if ($perm{'opa'}) { 2115: $request->print( 2116: &Apache::loncommon::pprmlink( 2117: &mt('Set/Change parameters'), 2118: $uname,$udom,$symb,'check')); 2119: } 2120: 2121: # Show Problem 2122: if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') { 2123: my $mode; 2124: if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') { 2125: $mode='both'; 2126: } elsif ($env{'form.vProb'} eq 'all' ) { 2127: $mode='text'; 2128: } elsif ($env{'form.vAns'} eq 'all') { 2129: $mode='answer'; 2130: } 2131: &Apache::lonxml::clear_problem_counter(); 2132: $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode,{'request.prefix' => 'ctr'.$counter})); 2133: } 2134: 2135: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 2136: my $res_error; 2137: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 2138: if ($res_error) { 2139: $request->print(&navmap_errormsg()); 2140: return; 2141: } 2142: 2143: # Display student info 2144: $request->print(($counter == 0 ? '' : '<br />')); 2145: 2146: my $result='<div class="LC_Box">' 2147: .'<h3 class="LC_hcell">'.&mt('Submissions').'</h3>'; 2148: $result.='<input type="hidden" name="name'.$counter. 2149: '" value="'.$env{'form.fullname'}.'" />'."\n"; 2150: # if ($env{'form.handgrade'} eq 'no') { 2151: if (1) { 2152: $result.='<p class="LC_info">' 2153: .&mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon) 2154: ."</p>\n"; 2155: } 2156: 2157: # If any part of the problem is an essay-response (handgraded), then check for collaborators 2158: my $fullname; 2159: my $col_fullnames = []; 2160: # if ($env{'form.handgrade'} eq 'yes') { 2161: if (1) { 2162: (my $sub_result,$fullname,$col_fullnames)= 2163: &check_collaborators($symb,$uname,$udom,\%record,$handgrade, 2164: $counter); 2165: $result.=$sub_result; 2166: } 2167: $request->print($result."\n"); 2168: 2169: # print student answer/submission 2170: # Options are (1) Handgraded submission only 2171: # (2) Last submission, includes submission that is not handgraded 2172: # (for multi-response type part) 2173: # (3) Last submission plus the parts info 2174: # (4) The whole record for this student 2175: 2176: my ($string,$timestamp)= &get_last_submission(\%record); 2177: 2178: my $lastsubonly; 2179: 2180: if ($$timestamp eq '') { 2181: $lastsubonly.='<div class="LC_grade_submissions_body">'.$$string[0].'</div>'; 2182: } else { 2183: $lastsubonly = 2184: '<div class="LC_grade_submissions_body">' 2185: .'<b>'.&mt('Date Submitted:').'</b> '.$$timestamp."\n"; 2186: 2187: my %seenparts; 2188: my @part_response_id = &flatten_responseType($responseType); 2189: foreach my $part (@part_response_id) { 2190: next if ($env{'form.lastSub'} eq 'hdgrade' 2191: && $$handgrade{$$part[0].'_'.$$part[1]} ne 'yes'); 2192: 2193: my ($partid,$respid) = @{ $part }; 2194: my $display_part=&get_display_part($partid,$symb); 2195: if ($env{"form.$uname:$udom:$partid:submitted_by"}) { 2196: if (exists($seenparts{$partid})) { next; } 2197: $seenparts{$partid}=1; 2198: $request->print( 2199: '<b>'.&mt('Part: [_1]',$display_part).'</b>'. 2200: ' <b>'.&mt('Collaborative submission by: [_1]', 2201: '<a href="javascript:viewSubmitter(\''. 2202: $env{"form.$uname:$udom:$partid:submitted_by"}. 2203: '\');" target="_self">'. 2204: $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a>'). 2205: '<br />'); 2206: next; 2207: } 2208: my $responsetype = $responseType->{$partid}->{$respid}; 2209: if (!exists($record{"resource.$partid.$respid.submission"})) { 2210: $lastsubonly.="\n".'<div class="LC_grade_submission_part">'. 2211: '<b>'.&mt('Part: [_1]',$display_part).'</b>'. 2212: ' <span class="LC_internal_info">'. 2213: '('.&mt('Response ID: [_1]',$respid).')'. 2214: '</span>   '. 2215: '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br /><br /></div>'; 2216: next; 2217: } 2218: foreach my $submission (@$string) { 2219: my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); 2220: if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; } 2221: my ($ressub,$hide,$subval) = split(/:/,$submission,3); 2222: # Similarity check 2223: my $similar=''; 2224: my ($type,$trial,$rndseed); 2225: if ($hide eq 'rand') { 2226: $type = 'randomizetry'; 2227: $trial = $record{"resource.$partid.tries"}; 2228: $rndseed = $record{"resource.$partid.rndseed"}; 2229: } 2230: if ($env{'form.checkPlag'}) { 2231: my ($oname,$odom,$ocrsid,$oessay,$osim)= 2232: &most_similar($uname,$udom,$symb,$subval); 2233: if ($osim) { 2234: $osim=int($osim*100.0); 2235: my %old_course_desc = 2236: &Apache::lonnet::coursedescription($ocrsid, 2237: {'one_time' => 1}); 2238: 2239: if ($hide eq 'anon') { 2240: $similar='<hr /><span class="LC_warning">'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'<br />'. 2241: &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />'; 2242: } else { 2243: $similar="<hr /><h3><span class=\"LC_warning\">". 2244: &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])', 2245: $osim, 2246: &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')', 2247: $old_course_desc{'description'}, 2248: $old_course_desc{'num'}, 2249: $old_course_desc{'domain'}). 2250: '</span></h3><blockquote><i>'. 2251: &keywords_highlight($oessay). 2252: '</i></blockquote><hr />'; 2253: } 2254: } 2255: } 2256: my $order=&get_order($partid,$respid,$symb,$uname,$udom, 2257: undef,$type,$trial,$rndseed); 2258: if ($env{'form.lastSub'} eq 'lastonly' || $env{'form.lastSub'} eq 'datesub' || $env{'form.lastSub'} =~ /^(last|all)$/ || ($env{'form.lastSub'} eq 'hdgrade' && 2259: $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) { 2260: my $display_part=&get_display_part($partid,$symb); 2261: $lastsubonly.='<div class="LC_grade_submission_part">'. 2262: '<b>'.&mt('Part: [_1]',$display_part).'</b>'. 2263: ' <span class="LC_internal_info">'. 2264: '('.&mt('Response ID: [_1]',$respid).')'. 2265: '</span>   '; 2266: my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record); 2267: 2268: if (@$files) { 2269: if ($hide eq 'anon') { 2270: $lastsubonly.='<br />'.&mt('[quant,_1,file] uploaded to this anonymous survey',scalar(@{$files})); 2271: } else { 2272: $lastsubonly.='<br /><br />'.'<b>'.&mt('Submitted Files:').'</b>' 2273: .'<br /><span class="LC_warning">'; 2274: if(@$files == 1) { 2275: $lastsubonly .= &mt('Like all files provided by users, this file may contain viruses!'); 2276: } else { 2277: $lastsubonly .= &mt('Like all files provided by users, these files may contain viruses!'); 2278: } 2279: $lastsubonly .= '</span>'; 2280: foreach my $file (@$files) { 2281: &Apache::lonnet::allowuploaded('/adm/grades',$file); 2282: $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" alt="" /> '.$file.'</a>'; 2283: } 2284: } 2285: $lastsubonly.='<br />'; 2286: } 2287: if ($hide eq 'anon') { 2288: $lastsubonly.='<br /><b>'.&mt('Anonymous Survey').'</b>'; 2289: } else { 2290: $lastsubonly.='<br /><b>'.&mt('Submitted Answer:').' </b>'. 2291: &cleanRecord($subval,$responsetype,$symb,$partid, 2292: $respid,\%record,$order,undef,$uname,$udom,$type,$trial,$rndseed); 2293: } 2294: if ($similar) {$lastsubonly.="<br /><br />$similar\n";} 2295: $lastsubonly.='</div>'; 2296: } 2297: } 2298: } 2299: $lastsubonly.='</div>'."\n"; # End: LC_grade_submissions_body 2300: } 2301: $request->print($lastsubonly); 2302: if ($env{'form.lastSub'} eq 'datesub') { 2303: my ($parts,$handgrade,$responseType) = &response_type($symb,\$res_error); 2304: $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); 2305: } 2306: if ($env{'form.lastSub'} =~ /^(last|all)$/) { 2307: $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, 2308: $env{'request.course.id'}, 2309: $last,'.submission', 2310: 'Apache::grades::keywords_highlight')); 2311: } 2312: $request->print('<input type="hidden" name="unamedom'.$counter.'" value="'.$uname.':' 2313: .$udom.'" />'."\n"); 2314: # return if view submission with no grading option 2315: if (!&canmodify($usec)) { 2316: $request->print('<p><span class="LC_warning">'.&mt('No grading privileges').'</span></p></div>'); 2317: return; 2318: } else { 2319: $request->print('</div>'."\n"); 2320: } 2321: 2322: # essay grading message center 2323: # if ($env{'form.handgrade'} eq 'yes') { 2324: if (1) { 2325: my $result='<div class="LC_grade_message_center">'; 2326: 2327: $result.='<div class="LC_grade_message_center_header">'. 2328: &mt('Send Message').'</div><div class="LC_grade_message_center_body">'; 2329: my ($lastname,$givenn) = split(/,/,$env{'form.fullname'}); 2330: my $msgfor = $givenn.' '.$lastname; 2331: if (scalar(@$col_fullnames) > 0) { 2332: my $lastone = pop(@$col_fullnames); 2333: $msgfor .= ', '.(join ', ',@$col_fullnames).' and '.$lastone.'.'; 2334: } 2335: $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript 2336: $result.='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n". 2337: '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n"; 2338: $result.=' <a href="javascript:msgCenter(document.SCORE,'.$counter. 2339: ',\''.$msgfor.'\');" target="_self">'. 2340: &mt('Compose message to student'.(scalar(@$col_fullnames) >= 1 ? 's' : '')).'</a><label> ('. 2341: &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'. 2342: ' <img src="'.$request->dir_config('lonIconsURL'). 2343: '/mailbkgrd.gif" width="14" height="10" alt="" name="mailicon'.$counter.'" />'."\n". 2344: '<br /> ('. 2345: &mt('Message will be sent when you click on Save & Next below.').")\n"; 2346: $result.='</div></div>'; 2347: $request->print($result); 2348: } 2349: 2350: my %seen = (); 2351: my @partlist; 2352: my @gradePartRespid; 2353: my @part_response_id = &flatten_responseType($responseType); 2354: $request->print( 2355: '<div class="LC_Box">' 2356: .'<h3 class="LC_hcell">'.&mt('Assign Grades').'</h3>' 2357: ); 2358: $request->print(&gradeBox_start()); 2359: foreach my $part_response_id (@part_response_id) { 2360: my ($partid,$respid) = @{ $part_response_id }; 2361: my $part_resp = join('_',@{ $part_response_id }); 2362: next if ($seen{$partid} > 0); 2363: $seen{$partid}++; 2364: next if ($$handgrade{$part_resp} ne 'yes' 2365: && $env{'form.lastSub'} eq 'hdgrade'); 2366: push(@partlist,$partid); 2367: push(@gradePartRespid,$partid.'.'.$respid); 2368: $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); 2369: } 2370: $request->print(&gradeBox_end()); # </div> 2371: $request->print('</div>'); 2372: 2373: $request->print('<div class="LC_grade_info_links">'); 2374: $request->print('</div>'); 2375: 2376: $result='<input type="hidden" name="partlist'.$counter. 2377: '" value="'.(join ":",@partlist).'" />'."\n"; 2378: $result.='<input type="hidden" name="gradePartRespid'. 2379: '" value="'.(join ":",@gradePartRespid).'" />'."\n" if ($counter == 0); 2380: my $ctr = 0; 2381: while ($ctr < scalar(@partlist)) { 2382: $result.='<input type="hidden" name="partid'.$counter.'_'.$ctr.'" value="'. 2383: $partlist[$ctr].'" />'."\n"; 2384: $ctr++; 2385: } 2386: $request->print($result.''."\n"); 2387: 2388: # Done with printing info for one student 2389: 2390: $request->print('</div>');#LC_grade_show_user 2391: 2392: 2393: # print end of form 2394: if ($counter == $total) { 2395: my $endform='<br /><hr /><table border="0"><tr><td>'."\n"; 2396: $endform.='<input type="button" value="'.&mt('Save & Next').'" '. 2397: 'onclick="javascript:checksubmit(this.form,\'Save & Next\','. 2398: $total.','.scalar(@partlist).');" target="_self" />  '."\n"; 2399: my $ntstu ='<select name="NTSTU">'. 2400: '<option>1</option><option>2</option>'. 2401: '<option>3</option><option>5</option>'. 2402: '<option>7</option><option>10</option></select>'."\n"; 2403: my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1'); 2404: $ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</; 2405: $endform.=&mt('[_1]student(s)',$ntstu); 2406: $endform.='  <input type="button" value="'.&mt('Previous').'" '. 2407: 'onclick="javascript:checksubmit(this.form,\'Previous\');" target="_self" />  '."\n". 2408: '<input type="button" value="'.&mt('Next').'" '. 2409: 'onclick="javascript:checksubmit(this.form,\'Next\');" target="_self" />  '; 2410: $endform.='<span class="LC_warning">'. 2411: &mt('(Next and Previous (student) do not save the scores.)'). 2412: '</span>'."\n" ; 2413: $endform.="<input type='hidden' value='".&get_increment(). 2414: "' name='increment' />"; 2415: $endform.='</td></tr></table></form>'; 2416: $request->print($endform); 2417: } 2418: return ''; 2419: } 2420: 2421: sub check_collaborators { 2422: my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_; 2423: my ($result,@col_fullnames); 2424: my ($classlist,undef,$fullname) = &getclasslist('all','0'); 2425: foreach my $part (keys(%$handgrade)) { 2426: my $ncol = &Apache::lonnet::EXT('resource.'.$part. 2427: '.maxcollaborators', 2428: $symb,$udom,$uname); 2429: next if ($ncol <= 0); 2430: $part =~ s/\_/\./g; 2431: next if ($record->{'resource.'.$part.'.collaborators'} eq ''); 2432: my (@good_collaborators, @bad_collaborators); 2433: foreach my $possible_collaborator 2434: (split(/[,;\s]+/,$record->{'resource.'.$part.'.collaborators'})) { 2435: $possible_collaborator =~ s/[\$\^]//g; 2436: next if ($possible_collaborator eq ''); 2437: my ($co_name,$co_dom) = split(/:/,$possible_collaborator); 2438: $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i); 2439: next if ($co_name eq $uname && $co_dom eq $udom); 2440: # Doing this grep allows 'fuzzy' specification 2441: my @matches = grep(/^\Q$co_name\E:\Q$co_dom\E$/i, 2442: keys(%$classlist)); 2443: if (! scalar(@matches)) { 2444: push(@bad_collaborators, $possible_collaborator); 2445: } else { 2446: push(@good_collaborators, @matches); 2447: } 2448: } 2449: if (scalar(@good_collaborators) != 0) { 2450: $result.='<br />'.&mt('Collaborators:').'<ol>'; 2451: foreach my $name (@good_collaborators) { 2452: my ($lastname,$givenn) = split(/,/,$$fullname{$name}); 2453: push(@col_fullnames, $givenn.' '.$lastname); 2454: $result.='<li>'.$fullname->{$name}.'</li>'; 2455: } 2456: $result.='</ol><br />'."\n"; 2457: my ($part)=split(/\./,$part); 2458: $result.='<input type="hidden" name="collaborator'.$counter. 2459: '" value="'.$part.':'.(join ':',@good_collaborators).'" />'. 2460: "\n"; 2461: } 2462: if (scalar(@bad_collaborators) > 0) { 2463: $result.='<div class="LC_warning">'; 2464: $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators)); 2465: $result .= '</div>'; 2466: } 2467: if (scalar(@bad_collaborators > $ncol)) { 2468: $result .= '<div class="LC_warning">'; 2469: $result .= &mt('This student has submitted too many '. 2470: 'collaborators. Maximum is [_1].',$ncol); 2471: $result .= '</div>'; 2472: } 2473: } 2474: return ($result,$fullname,\@col_fullnames); 2475: } 2476: 2477: #--- Retrieve the last submission for all the parts 2478: sub get_last_submission { 2479: my ($returnhash)=@_; 2480: my (@string,$timestamp,%lasthidden); 2481: if ($$returnhash{'version'}) { 2482: my %lasthash=(); 2483: my ($version); 2484: for ($version=1;$version<=$$returnhash{'version'};$version++) { 2485: foreach my $key (sort(split(/\:/, 2486: $$returnhash{$version.':keys'}))) { 2487: $lasthash{$key}=$$returnhash{$version.':'.$key}; 2488: $timestamp = 2489: &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'}); 2490: } 2491: } 2492: my (%typeparts,%randombytry); 2493: my $showsurv = 2494: &Apache::lonnet::allowed('vas',$env{'request.course.id'}); 2495: foreach my $key (sort(keys(%lasthash))) { 2496: if ($key =~ /\.type$/) { 2497: if (($lasthash{$key} eq 'anonsurvey') || 2498: ($lasthash{$key} eq 'anonsurveycred') || 2499: ($lasthash{$key} eq 'randomizetry')) { 2500: my ($ign,@parts) = split(/\./,$key); 2501: pop(@parts); 2502: my $id = join('.',@parts); 2503: if ($lasthash{$key} eq 'randomizetry') { 2504: $randombytry{$ign.'.'.$id} = $lasthash{$key}; 2505: } else { 2506: unless ($showsurv) { 2507: $typeparts{$ign.'.'.$id} = $lasthash{$key}; 2508: } 2509: } 2510: delete($lasthash{$key}); 2511: } 2512: } 2513: } 2514: my @hidden = keys(%typeparts); 2515: my @randomize = keys(%randombytry); 2516: foreach my $key (keys(%lasthash)) { 2517: next if ($key !~ /\.submission$/); 2518: my $hide; 2519: if (@hidden) { 2520: foreach my $id (@hidden) { 2521: if ($key =~ /^\Q$id\E/) { 2522: $hide = 'anon'; 2523: last; 2524: } 2525: } 2526: } 2527: unless ($hide) { 2528: if (@randomize) { 2529: foreach my $id (@hidden) { 2530: if ($key =~ /^\Q$id\E/) { 2531: $hide = 'rand'; 2532: last; 2533: } 2534: } 2535: } 2536: } 2537: my ($partid,$foo) = split(/submission$/,$key); 2538: my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? 2539: '<span class="LC_warning">'.&mt('Draft Copy').'</span> ' : ''; 2540: #push(@string, join(':', $key, $hide, $draft.$lasthash{$key})); 2541: push(@string, join(':', $key, $hide, $draft.( 2542: ref($lasthash{$key}) eq 'ARRAY' ? 2543: join(',', @{$lasthash{$key}}) : $lasthash{$key}) )); 2544: } 2545: } 2546: if (!@string) { 2547: $string[0] = 2548: '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span>'; 2549: } 2550: return (\@string,\$timestamp); 2551: } 2552: 2553: #--- High light keywords, with style choosen by user. 2554: sub keywords_highlight { 2555: my $string = shift; 2556: my $size = $env{'form.kwsize'} eq '0' ? '' : 'size='.$env{'form.kwsize'}; 2557: my $styleon = $env{'form.kwstyle'} eq '' ? '' : $env{'form.kwstyle'}; 2558: (my $styleoff = $styleon) =~ s/\</\<\//; 2559: my @keylist = split(/[,\s+]/,$env{'form.keywords'}); 2560: foreach my $keyword (@keylist) { 2561: $string =~ s/\b\Q$keyword\E(\b|\.)/<font color\=$env{'form.kwclr'} $size\>$styleon$keyword$styleoff<\/font>/gi; 2562: } 2563: return $string; 2564: } 2565: 2566: # For Tasks provide a mechanism to display previous version for one specific student 2567: 2568: sub show_previous_task_version { 2569: my ($request,$symb) = @_; 2570: if ($symb eq '') { 2571: $request->print( 2572: '<span class="LC_error">'. 2573: &mt('Unable to handle ambiguous references.'). 2574: '</span>'); 2575: return ''; 2576: } 2577: my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); 2578: my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); 2579: if (!&canview($usec)) { 2580: $request->print( 2581: '<span class="LC_warning">'. 2582: &mt('Unable to view previous version for requested student.'). 2583: ' '.&mt('([_1] in section [_2] in course id [_3])', 2584: $uname.':'.$udom,$usec,$env{'request.course.id'}). 2585: '</span>'); 2586: return; 2587: } 2588: my $mode = 'both'; 2589: my $isTask = ($symb =~/\.task$/); 2590: if ($isTask) { 2591: if ($env{'form.previousversion'} =~ /^\d+$/) { 2592: if ($env{'form.fullname'} eq '') { 2593: $env{'form.fullname'} = 2594: &Apache::loncommon::plainname($uname,$udom,'lastname'); 2595: } 2596: my $probtitle=&Apache::lonnet::gettitle($symb); 2597: $request->print("\n\n". 2598: '<div class="LC_grade_show_user">'. 2599: '<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom). 2600: '</h2>'."\n"); 2601: &Apache::lonxml::clear_problem_counter(); 2602: $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode, 2603: {'previousversion' => $env{'form.previousversion'} })); 2604: $request->print("\n</div>"); 2605: } 2606: } 2607: return; 2608: } 2609: 2610: sub choose_task_version_form { 2611: my ($symb,$uname,$udom,$nomenu) = @_; 2612: my $isTask = ($symb =~/\.task$/); 2613: my ($current,$version,$result,$js,$displayed,$rowtitle); 2614: if ($isTask) { 2615: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, 2616: $udom,$uname); 2617: if (($record{'resource.0.version'} eq '') || 2618: ($record{'resource.0.version'} < 2)) { 2619: return ($record{'resource.0.version'}, 2620: $record{'resource.0.version'},$result,$js); 2621: } else { 2622: $current = $record{'resource.0.version'}; 2623: } 2624: if ($env{'form.previousversion'}) { 2625: $displayed = $env{'form.previousversion'}; 2626: $rowtitle = &mt('Choose another version:') 2627: } else { 2628: $displayed = $current; 2629: $rowtitle = &mt('Show earlier version:'); 2630: } 2631: $result = '<div class="LC_left_float">'; 2632: my $list; 2633: my $numversions = 0; 2634: for (my $i=1; $i<=$record{'resource.0.version'}; $i++) { 2635: if ($i == $current) { 2636: if (!$env{'form.previousversion'} || $nomenu) { 2637: next; 2638: } else { 2639: $list .= '<option value="'.$i.'">'.&mt('Current').'</option>'."\n"; 2640: $numversions ++; 2641: } 2642: } elsif (defined($record{'resource.'.$i.'.0.status'})) { 2643: unless ($i == $env{'form.previousversion'}) { 2644: $numversions ++; 2645: } 2646: $list .= '<option value="'.$i.'">'.$i.'</option>'."\n"; 2647: } 2648: } 2649: if ($numversions) { 2650: $symb = &HTML::Entities::encode($symb,'<>"&'); 2651: $result .= 2652: '<form name="getprev" method="post" action=""'. 2653: ' onsubmit="return previousVersion('."'$uname','$udom','$symb','$displayed'".');">'. 2654: &Apache::loncommon::start_data_table(). 2655: &Apache::loncommon::start_data_table_row(). 2656: '<th align="left">'.$rowtitle.'</th>'. 2657: '<td><select name="version">'. 2658: '<option>'.&mt('Select').'</option>'. 2659: $list. 2660: '</select></td>'. 2661: &Apache::loncommon::end_data_table_row(); 2662: unless ($nomenu) { 2663: $result .= &Apache::loncommon::start_data_table_row(). 2664: '<th align="left">'.&mt('Open in new window').'</th>'. 2665: '<td><span class="LC_nobreak">'. 2666: '<label><input type="radio" name="prevwin" value="1" />'. 2667: &mt('Yes').'</label>'. 2668: '<label><input type="radio" name="prevwin" value="0" checked="checked" />'.&mt('No').'</label>'. 2669: '</span></td>'. 2670: &Apache::loncommon::end_data_table_row(); 2671: } 2672: $result .= 2673: &Apache::loncommon::start_data_table_row(). 2674: '<th align="left"> </th>'. 2675: '<td>'. 2676: '<input type="submit" name="prevsub" value="'.&mt('Display').'" />'. 2677: '</td>'. 2678: &Apache::loncommon::end_data_table_row(). 2679: &Apache::loncommon::end_data_table(). 2680: '</form>'; 2681: $js = &previous_display_javascript($nomenu,$current); 2682: } elsif ($displayed && $nomenu) { 2683: $result .= '<a href="javascript:window.close()">'.&mt('Close window').'</a>'; 2684: } else { 2685: $result .= &mt('No previous versions to show for this student'); 2686: } 2687: $result .= '</div>'; 2688: } 2689: return ($current,$displayed,$result,$js); 2690: } 2691: 2692: sub previous_display_javascript { 2693: my ($nomenu,$current) = @_; 2694: my $js = <<"JSONE"; 2695: <script type="text/javascript"> 2696: // <![CDATA[ 2697: function previousVersion(uname,udom,symb) { 2698: var current = '$current'; 2699: var version = document.getprev.version.options[document.getprev.version.selectedIndex].value; 2700: var prevstr = new RegExp("^\\\\d+\$"); 2701: if (!prevstr.test(version)) { 2702: return false; 2703: } 2704: var url = ''; 2705: if (version == current) { 2706: url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=submission'; 2707: } else { 2708: url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=versionsub&previousversion='+version; 2709: } 2710: JSONE 2711: if ($nomenu) { 2712: $js .= <<"JSTWO"; 2713: document.location.href = url; 2714: JSTWO 2715: } else { 2716: $js .= <<"JSTHREE"; 2717: var newwin = 0; 2718: for (var i=0; i<document.getprev.prevwin.length; i++) { 2719: if (document.getprev.prevwin[i].checked == true) { 2720: newwin = document.getprev.prevwin[i].value; 2721: } 2722: } 2723: if (newwin == 1) { 2724: var options = 'height=600,width=800,resizable=yes,scrollbars=yes,location=no,menubar=no,toolbar=no'; 2725: url = url+'&inhibitmenu=yes'; 2726: if (typeof(previousWin) == 'undefined' || previousWin.closed) { 2727: previousWin = window.open(url,'',options,1); 2728: } else { 2729: previousWin.location.href = url; 2730: } 2731: previousWin.focus(); 2732: return false; 2733: } else { 2734: document.location.href = url; 2735: return false; 2736: } 2737: JSTHREE 2738: } 2739: $js .= <<"ENDJS"; 2740: return false; 2741: } 2742: // ]]> 2743: </script> 2744: ENDJS 2745: 2746: } 2747: 2748: #--- Called from submission routine 2749: sub processHandGrade { 2750: my ($request,$symb) = @_; 2751: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 2752: my $button = $env{'form.gradeOpt'}; 2753: my $ngrade = $env{'form.NCT'}; 2754: my $ntstu = $env{'form.NTSTU'}; 2755: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2756: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2757: 2758: if ($button eq 'Save & Next') { 2759: my $ctr = 0; 2760: while ($ctr < $ngrade) { 2761: my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr}); 2762: my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$symb,$uname,$udom,$ctr); 2763: if ($errorflag eq 'no_score') { 2764: $ctr++; 2765: next; 2766: } 2767: if ($errorflag eq 'not_allowed') { 2768: $request->print("<span class=\"LC_warning\">Not allowed to modify grades for $uname:$udom</span>"); 2769: $ctr++; 2770: next; 2771: } 2772: my $includemsg = $env{'form.includemsg'.$ctr}; 2773: my ($subject,$message,$msgstatus) = ('','',''); 2774: my $restitle = &Apache::lonnet::gettitle($symb); 2775: my ($feedurl,$showsymb) = 2776: &get_feedurl_and_symb($symb,$uname,$udom); 2777: my $messagetail; 2778: if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { 2779: $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); 2780: unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } 2781: $subject.=' ['.$restitle.']'; 2782: my (@msgnum) = split(/,/,$includemsg); 2783: foreach (@msgnum) { 2784: $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); 2785: } 2786: $message =&Apache::lonfeedback::clear_out_html($message); 2787: if ($env{'form.withgrades'.$ctr}) { 2788: $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; 2789: $messagetail = " for <a href=\"". 2790: $feedurl."?symb=$showsymb\">$restitle</a>"; 2791: } 2792: $msgstatus = 2793: &Apache::lonmsg::user_normal_msg($uname,$udom,$subject, 2794: $message.$messagetail, 2795: undef,$feedurl,undef, 2796: undef,undef,$showsymb, 2797: $restitle); 2798: $request->print('<br />'.&mt('Sending message to [_1]',$uname.':'.$udom).': '. 2799: $msgstatus.'<br />'); 2800: } 2801: if ($env{'form.collaborator'.$ctr}) { 2802: my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); 2803: foreach my $collabstr (@collabstrs) { 2804: my ($part,@collaborators) = split(/:/,$collabstr); 2805: foreach my $collaborator (@collaborators) { 2806: my ($errorflag,$pts,$wgt) = 2807: &saveHandGrade($request,$symb,$collaborator,$udom,$ctr, 2808: $env{'form.unamedom'.$ctr},$part); 2809: if ($errorflag eq 'not_allowed') { 2810: $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>"); 2811: next; 2812: } elsif ($message ne '') { 2813: my ($baseurl,$showsymb) = 2814: &get_feedurl_and_symb($symb,$collaborator, 2815: $udom); 2816: if ($env{'form.withgrades'.$ctr}) { 2817: $messagetail = " for <a href=\"". 2818: $baseurl."?symb=$showsymb\">$restitle</a>"; 2819: } 2820: $msgstatus = 2821: &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); 2822: } 2823: } 2824: } 2825: } 2826: $ctr++; 2827: } 2828: } 2829: 2830: # if ($env{'form.handgrade'} eq 'yes') { 2831: if (1) { 2832: # Keywords sorted in alphabatical order 2833: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 2834: my %keyhash = (); 2835: $env{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; 2836: $env{'form.keywords'} =~ s/^\s+|\s+$//; 2837: my (@keywords) = sort(split(/\s+/,$env{'form.keywords'})); 2838: $env{'form.keywords'} = join(' ',@keywords); 2839: $keyhash{$symb.'_keywords'} = $env{'form.keywords'}; 2840: $keyhash{$symb.'_subject'} = $env{'form.msgsub'}; 2841: $keyhash{$loginuser.'_kwclr'} = $env{'form.kwclr'}; 2842: $keyhash{$loginuser.'_kwsize'} = $env{'form.kwsize'}; 2843: $keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'}; 2844: 2845: # message center - Order of message gets changed. Blank line is eliminated. 2846: # New messages are saved in env for the next student. 2847: # All messages are saved in nohist_handgrade.db 2848: my ($ctr,$idx) = (1,1); 2849: while ($ctr <= $env{'form.savemsgN'}) { 2850: if ($env{'form.savemsg'.$ctr} ne '') { 2851: $keyhash{$symb.'_savemsg'.$idx} = $env{'form.savemsg'.$ctr}; 2852: $idx++; 2853: } 2854: $ctr++; 2855: } 2856: $ctr = 0; 2857: while ($ctr < $ngrade) { 2858: if ($env{'form.newmsg'.$ctr} ne '') { 2859: $keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr}; 2860: $env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr}; 2861: $idx++; 2862: } 2863: $ctr++; 2864: } 2865: $env{'form.savemsgN'} = --$idx; 2866: $keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'}; 2867: my $putresult = &Apache::lonnet::put 2868: ('nohist_handgrade',\%keyhash,$cdom,$cnum); 2869: } 2870: # Called by Save & Refresh from Highlight Attribute Window 2871: my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); 2872: if ($env{'form.refresh'} eq 'on') { 2873: my ($ctr,$total) = (0,0); 2874: while ($ctr < $ngrade) { 2875: $total++ if $env{'form.unamedom'.$ctr} ne ''; 2876: $ctr++; 2877: } 2878: $env{'form.NTSTU'}=$ngrade; 2879: $ctr = 0; 2880: while ($ctr < $total) { 2881: my $processUser = $env{'form.unamedom'.$ctr}; 2882: ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); 2883: $env{'form.fullname'} = $$fullname{$processUser}; 2884: &submission($request,$ctr,$total-1,$symb); 2885: $ctr++; 2886: } 2887: return ''; 2888: } 2889: 2890: # Get the next/previous one or group of students 2891: my $firststu = $env{'form.unamedom0'}; 2892: my $laststu = $env{'form.unamedom'.($ngrade-1)}; 2893: my $ctr = 2; 2894: while ($laststu eq '') { 2895: $laststu = $env{'form.unamedom'.($ngrade-$ctr)}; 2896: $ctr++; 2897: $laststu = $firststu if ($ctr > $ngrade); 2898: } 2899: 2900: my (@parsedlist,@nextlist); 2901: my ($nextflg) = 0; 2902: foreach my $item (sort 2903: { 2904: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 2905: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 2906: } 2907: return $a cmp $b; 2908: } (keys(%$fullname))) { 2909: # FIXME: this is fishy, looks like the button label 2910: if ($nextflg == 1 && $button =~ /Next$/) { 2911: push(@parsedlist,$item); 2912: } 2913: $nextflg = 1 if ($item eq $laststu); 2914: if ($button eq 'Previous') { 2915: last if ($item eq $firststu); 2916: push(@parsedlist,$item); 2917: } 2918: } 2919: $ctr = 0; 2920: # FIXME: this is fishy, looks like the button label 2921: @parsedlist = reverse @parsedlist if ($button eq 'Previous'); 2922: my $res_error; 2923: my ($partlist) = &response_type($symb,\$res_error); 2924: if ($res_error) { 2925: $request->print(&navmap_errormsg()); 2926: return; 2927: } 2928: foreach my $student (@parsedlist) { 2929: my $submitonly=$env{'form.submitonly'}; 2930: my ($uname,$udom) = split(/:/,$student); 2931: 2932: if ($submitonly eq 'queued') { 2933: my %queue_status = 2934: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 2935: $udom,$uname); 2936: next if (!defined($queue_status{'gradingqueue'})); 2937: } 2938: 2939: if ($submitonly =~ /^(yes|graded|incorrect)$/) { 2940: # my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 2941: my %status=&student_gradeStatus($symb,$udom,$uname,$partlist); 2942: my $submitted = 0; 2943: my $ungraded = 0; 2944: my $incorrect = 0; 2945: foreach my $item (keys(%status)) { 2946: $submitted = 1 if ($status{$item} ne 'nothing'); 2947: $ungraded = 1 if ($status{$item} =~ /^ungraded/); 2948: $incorrect = 1 if ($status{$item} =~ /^incorrect/); 2949: my ($foo,$partid,$foo1) = split(/\./,$item); 2950: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 2951: $submitted = 0; 2952: } 2953: } 2954: next if (!$submitted && ($submitonly eq 'yes' || 2955: $submitonly eq 'incorrect' || 2956: $submitonly eq 'graded')); 2957: next if (!$ungraded && ($submitonly eq 'graded')); 2958: next if (!$incorrect && $submitonly eq 'incorrect'); 2959: } 2960: push(@nextlist,$student) if ($ctr < $ntstu); 2961: last if ($ctr == $ntstu); 2962: $ctr++; 2963: } 2964: 2965: $ctr = 0; 2966: my $total = scalar(@nextlist)-1; 2967: 2968: foreach (sort(@nextlist)) { 2969: my ($uname,$udom,$submitter) = split(/:/); 2970: $env{'form.student'} = $uname; 2971: $env{'form.userdom'} = $udom; 2972: $env{'form.fullname'} = $$fullname{$_}; 2973: &submission($request,$ctr,$total,$symb); 2974: $ctr++; 2975: } 2976: if ($total < 0) { 2977: my $the_end.='<p>'.&mt('[_1]Message:[_2] No more students for this section or class.','<b>','</b>').'</p>'."\n"; 2978: $request->print($the_end); 2979: } 2980: return ''; 2981: } 2982: 2983: #---- Save the score and award for each student, if changed 2984: sub saveHandGrade { 2985: my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; 2986: my @version_parts; 2987: my $usec = &Apache::lonnet::getsection($domain,$stuname, 2988: $env{'request.course.id'}); 2989: if (!&canmodify($usec)) { return('not_allowed'); } 2990: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); 2991: my @parts_graded; 2992: my %newrecord = (); 2993: my ($pts,$wgt) = ('',''); 2994: my %aggregate = (); 2995: my $aggregateflag = 0; 2996: my @parts = split(/:/,$env{'form.partlist'.$newflg}); 2997: foreach my $new_part (@parts) { 2998: #collaborator ($submi may vary for different parts 2999: if ($submitter && $new_part ne $part) { next; } 3000: my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; 3001: if ($dropMenu eq 'excused') { 3002: if ($record{'resource.'.$new_part.'.solved'} ne 'excused') { 3003: $newrecord{'resource.'.$new_part.'.solved'} = 'excused'; 3004: if (exists($record{'resource.'.$new_part.'.awarded'})) { 3005: $newrecord{'resource.'.$new_part.'.awarded'} = ''; 3006: } 3007: $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; 3008: } 3009: } elsif ($dropMenu eq 'reset status' 3010: && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts 3011: foreach my $key (keys(%record)) { 3012: if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } 3013: } 3014: $newrecord{'resource.'.$new_part.'.regrader'}= 3015: "$env{'user.name'}:$env{'user.domain'}"; 3016: my $totaltries = $record{'resource.'.$part.'.tries'}; 3017: 3018: my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, 3019: [$new_part]); 3020: my $aggtries =$totaltries; 3021: if ($last_resets{$new_part}) { 3022: $aggtries = &get_num_tries(\%record,$last_resets{$new_part}, 3023: $new_part); 3024: } 3025: 3026: my $solvedstatus = $record{'resource.'.$new_part.'.solved'}; 3027: if ($aggtries > 0) { 3028: &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); 3029: $aggregateflag = 1; 3030: } 3031: } elsif ($dropMenu eq '') { 3032: $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 3033: $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 3034: $env{'form.RADVAL'.$newflg.'_'.$new_part}); 3035: if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$new_part} eq '') { 3036: next; 3037: } 3038: $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : 3039: $env{'form.WGT'.$newflg.'_'.$new_part}; 3040: my $partial= $pts/$wgt; 3041: if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { 3042: #do not update score for part if not changed. 3043: &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); 3044: next; 3045: } else { 3046: push(@parts_graded,$new_part); 3047: } 3048: if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { 3049: $newrecord{'resource.'.$new_part.'.awarded'} = $partial; 3050: } 3051: my $reckey = 'resource.'.$new_part.'.solved'; 3052: if ($partial == 0) { 3053: if ($record{$reckey} ne 'incorrect_by_override') { 3054: $newrecord{$reckey} = 'incorrect_by_override'; 3055: } 3056: } else { 3057: if ($record{$reckey} ne 'correct_by_override') { 3058: $newrecord{$reckey} = 'correct_by_override'; 3059: } 3060: } 3061: if ($submitter && 3062: ($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) { 3063: $newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter; 3064: } 3065: $newrecord{'resource.'.$new_part.'.regrader'}= 3066: "$env{'user.name'}:$env{'user.domain'}"; 3067: } 3068: # unless problem has been graded, set flag to version the submitted files 3069: unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || 3070: $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' || 3071: $dropMenu eq 'reset status') 3072: { 3073: push(@version_parts,$new_part); 3074: } 3075: } 3076: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 3077: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 3078: 3079: if (%newrecord) { 3080: if (@version_parts) { 3081: my @changed_keys = &version_portfiles(\%record, \@parts_graded, 3082: $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts); 3083: @newrecord{@changed_keys} = @record{@changed_keys}; 3084: foreach my $new_part (@version_parts) { 3085: &handback_files($request,$symb,$stuname,$domain,$newflg, 3086: $new_part,\%newrecord); 3087: } 3088: } 3089: &Apache::lonnet::cstore(\%newrecord,$symb, 3090: $env{'request.course.id'},$domain,$stuname); 3091: &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb, 3092: $cdom,$cnum,$domain,$stuname); 3093: } 3094: if ($aggregateflag) { 3095: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 3096: $cdom,$cnum); 3097: } 3098: return ('',$pts,$wgt); 3099: } 3100: 3101: sub check_and_remove_from_queue { 3102: my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_; 3103: my @ungraded_parts; 3104: foreach my $part (@{$parts}) { 3105: if ( $record->{ 'resource.'.$part.'.awarded'} eq '' 3106: && $record->{ 'resource.'.$part.'.solved' } ne 'excused' 3107: && $newrecord->{'resource.'.$part.'.awarded'} eq '' 3108: && $newrecord->{'resource.'.$part.'.solved' } ne 'excused' 3109: ) { 3110: push(@ungraded_parts, $part); 3111: } 3112: } 3113: if ( !@ungraded_parts ) { 3114: &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom, 3115: $cnum,$domain,$stuname); 3116: } 3117: } 3118: 3119: sub handback_files { 3120: my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; 3121: my $portfolio_root = '/userfiles/portfolio'; 3122: my $res_error; 3123: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 3124: if ($res_error) { 3125: $request->print('<br />'.&navmap_errormsg().'<br />'); 3126: return; 3127: } 3128: my @handedback; 3129: my $file_msg; 3130: my @part_response_id = &flatten_responseType($responseType); 3131: foreach my $part_response_id (@part_response_id) { 3132: my ($part_id,$resp_id) = @{ $part_response_id }; 3133: my $part_resp = join('_',@{ $part_response_id }); 3134: if (($env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'} =~ /^\d+$/) & ($new_part eq $part_id)) { 3135: for (my $counter=1; $counter<=$env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'}; $counter++) { 3136: # if multiple files are uploaded names will be 'returndoc2','returndoc3' 3137: if ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter}) { 3138: my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter.'.filename'}; 3139: my ($directory,$answer_file) = 3140: ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter} =~ /^(.*?)([^\/]*)$/); 3141: my ($answer_name,$answer_ver,$answer_ext) = 3142: &file_name_version_ext($answer_file); 3143: my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); 3144: my $getpropath = 1; 3145: my ($dir_list,$listerror) = 3146: &Apache::lonnet::dirlist($portfolio_root.$portfolio_path, 3147: $domain,$stuname,$getpropath); 3148: my $version = &get_next_version($answer_name,$answer_ext,$dir_list); 3149: # fix filename 3150: my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); 3151: my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, 3152: $newflg.'_'.$part_resp.'_returndoc'.$counter, 3153: $save_file_name); 3154: if ($result !~ m|^/uploaded/|) { 3155: $request->print('<br /><span class="LC_error">'. 3156: &mt('An error occurred ([_1]) while trying to upload [_2].', 3157: $result,$newflg.'_'.$part_resp.'_returndoc'.$counter). 3158: '</span>'); 3159: } else { 3160: # mark the file as read only 3161: push(@handedback,$save_file_name); 3162: if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) { 3163: $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; 3164: } 3165: $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; 3166: $file_msg.= '<span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span> <br />"; 3167: } 3168: $request->print('<br />'.&mt('[_1] will be the uploaded filename [_2]','<span class="LC_info">'.$fname.'</span>','<span class="LC_filename">'.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'</span>')); 3169: } 3170: } 3171: } 3172: } 3173: if (@handedback > 0) { 3174: $request->print('<br />'); 3175: my @what = ($symb,$env{'request.course.id'},'handback'); 3176: &Apache::lonnet::mark_as_readonly($domain,$stuname,\@handedback,\@what); 3177: my $user_lh = &Apache::loncommon::user_lang($stuname,$domain,$env{'request.course.id'}); 3178: my ($subject,$message); 3179: if (scalar(@handedback) == 1) { 3180: $subject = &mt_user($user_lh,'File Handed Back by Instructor'); 3181: $message = &mt_user($user_lh,'A file has been returned that was originally submitted in response to: '); 3182: } else { 3183: $subject = &mt_user($user_lh,'Files Handed Back by Instructor'); 3184: $message = &mt_user($user_lh,'Files have been returned that were originally submitted in response to: '); 3185: } 3186: $message .= "<p><strong>".&Apache::lonnet::gettitle($symb)." </strong></p>"; 3187: $message .= &mt_user($user_lh,'The returned file(s) are named: [_1]',"<br />$file_msg <br />"). 3188: &mt_user($user_lh,'The file(s) can be found in your [_1]portfolio[_2].','<a href="/adm/portfolio">','</a>'); 3189: my ($feedurl,$showsymb) = 3190: &get_feedurl_and_symb($symb,$domain,$stuname); 3191: my $restitle = &Apache::lonnet::gettitle($symb); 3192: $subject .= ' '.&mt_user($user_lh,'(File Returned)').' ['.$restitle.']'; 3193: my $msgstatus = 3194: &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject, 3195: $message,undef,$feedurl,undef,undef,undef,$showsymb, 3196: $restitle); 3197: if ($msgstatus) { 3198: $request->print(&mt('Notification message status: [_1]','<span class="LC_info">'.$msgstatus.'</span>').'<br />'); 3199: } 3200: } 3201: return; 3202: } 3203: 3204: sub get_feedurl_and_symb { 3205: my ($symb,$uname,$udom) = @_; 3206: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 3207: $url = &Apache::lonnet::clutter($url); 3208: my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', 3209: $symb,$udom,$uname); 3210: if ($encrypturl =~ /^yes$/i) { 3211: &Apache::lonenc::encrypted(\$url,1); 3212: &Apache::lonenc::encrypted(\$symb,1); 3213: } 3214: return ($url,$symb); 3215: } 3216: 3217: sub get_submitted_files { 3218: my ($udom,$uname,$partid,$respid,$record) = @_; 3219: my @files; 3220: if ($$record{"resource.$partid.$respid.portfiles"}) { 3221: my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; 3222: foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) { 3223: push(@files,$file_url.$file); 3224: } 3225: } 3226: if ($$record{"resource.$partid.$respid.uploadedurl"}) { 3227: push(@files,$$record{"resource.$partid.$respid.uploadedurl"}); 3228: } 3229: return (\@files); 3230: } 3231: 3232: # ----------- Provides number of tries since last reset. 3233: sub get_num_tries { 3234: my ($record,$last_reset,$part) = @_; 3235: my $timestamp = ''; 3236: my $num_tries = 0; 3237: if ($$record{'version'}) { 3238: for (my $version=$$record{'version'};$version>=1;$version--) { 3239: if (exists($$record{$version.':resource.'.$part.'.solved'})) { 3240: $timestamp = $$record{$version.':timestamp'}; 3241: if ($timestamp > $last_reset) { 3242: $num_tries ++; 3243: } else { 3244: last; 3245: } 3246: } 3247: } 3248: } 3249: return $num_tries; 3250: } 3251: 3252: # ----------- Determine decrements required in aggregate totals 3253: sub decrement_aggs { 3254: my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_; 3255: my %decrement = ( 3256: attempts => 0, 3257: users => 0, 3258: correct => 0 3259: ); 3260: $decrement{'attempts'} = $aggtries; 3261: if ($solvedstatus =~ /^correct/) { 3262: $decrement{'correct'} = 1; 3263: } 3264: if ($aggtries == $totaltries) { 3265: $decrement{'users'} = 1; 3266: } 3267: foreach my $type (keys(%decrement)) { 3268: $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type}; 3269: } 3270: return; 3271: } 3272: 3273: # ----------- Determine timestamps for last reset of aggregate totals for parts 3274: sub get_last_resets { 3275: my ($symb,$courseid,$partids) =@_; 3276: my %last_resets; 3277: my $cdom = $env{'course.'.$courseid.'.domain'}; 3278: my $cname = $env{'course.'.$courseid.'.num'}; 3279: my @keys; 3280: foreach my $part (@{$partids}) { 3281: push(@keys,"$symb\0$part\0resettime"); 3282: } 3283: my %results=&Apache::lonnet::get('nohist_resourcetracker',\@keys, 3284: $cdom,$cname); 3285: foreach my $part (@{$partids}) { 3286: $last_resets{$part}=$results{"$symb\0$part\0resettime"}; 3287: } 3288: return %last_resets; 3289: } 3290: 3291: # ----------- Handles creating versions for portfolio files as answers 3292: sub version_portfiles { 3293: my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_; 3294: my $version_parts = join('|',@$v_flag); 3295: my @returned_keys; 3296: my $parts = join('|', @$parts_graded); 3297: my $portfolio_root = '/userfiles/portfolio'; 3298: foreach my $key (keys(%$record)) { 3299: my $new_portfiles; 3300: if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { 3301: my @versioned_portfiles; 3302: my @portfiles = split(/\s*,\s*/,$$record{$key}); 3303: foreach my $file (@portfiles) { 3304: &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file); 3305: my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); 3306: my ($answer_name,$answer_ver,$answer_ext) = 3307: &file_name_version_ext($answer_file); 3308: my $getpropath = 1; 3309: my ($dir_list,$listerror) = 3310: &Apache::lonnet::dirlist($portfolio_root.$directory,$domain, 3311: $stu_name,$getpropath); 3312: my $version = &get_next_version($answer_name,$answer_ext,$dir_list); 3313: my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); 3314: if ($new_answer ne 'problem getting file') { 3315: push(@versioned_portfiles, $directory.$new_answer); 3316: &Apache::lonnet::mark_as_readonly($domain,$stu_name, 3317: [$directory.$new_answer], 3318: [$symb,$env{'request.course.id'},'graded']); 3319: } 3320: } 3321: $$record{$key} = join(',',@versioned_portfiles); 3322: push(@returned_keys,$key); 3323: } 3324: } 3325: return (@returned_keys); 3326: } 3327: 3328: sub get_next_version { 3329: my ($answer_name, $answer_ext, $dir_list) = @_; 3330: my $version; 3331: if (ref($dir_list) eq 'ARRAY') { 3332: foreach my $row (@{$dir_list}) { 3333: my ($file) = split(/\&/,$row,2); 3334: my ($file_name,$file_version,$file_ext) = 3335: &file_name_version_ext($file); 3336: if (($file_name eq $answer_name) && 3337: ($file_ext eq $answer_ext)) { 3338: # gets here if filename and extension match, 3339: # regardless of version 3340: if ($file_version ne '') { 3341: # a versioned file is found so save it for later 3342: if ($file_version > $version) { 3343: $version = $file_version; 3344: } 3345: } 3346: } 3347: } 3348: } 3349: $version ++; 3350: return($version); 3351: } 3352: 3353: sub version_selected_portfile { 3354: my ($domain,$stu_name,$directory,$file_name,$version) = @_; 3355: my ($answer_name,$answer_ver,$answer_ext) = 3356: &file_name_version_ext($file_name); 3357: my $new_answer; 3358: $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name"); 3359: if($env{'form.copy'} eq '-1') { 3360: $new_answer = 'problem getting file'; 3361: } else { 3362: $new_answer = $answer_name.'.'.$version.'.'.$answer_ext; 3363: my $copy_result = &Apache::lonnet::finishuserfileupload( 3364: $stu_name,$domain,'copy', 3365: '/portfolio'.$directory.$new_answer); 3366: } 3367: return ($new_answer); 3368: } 3369: 3370: sub file_name_version_ext { 3371: my ($file)=@_; 3372: my @file_parts = split(/\./, $file); 3373: my ($name,$version,$ext); 3374: if (@file_parts > 1) { 3375: $ext=pop(@file_parts); 3376: if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) { 3377: $version=pop(@file_parts); 3378: } 3379: $name=join('.',@file_parts); 3380: } else { 3381: $name=join('.',@file_parts); 3382: } 3383: return($name,$version,$ext); 3384: } 3385: 3386: #-------------------------------------------------------------------------------------- 3387: # 3388: #-------------------------- Next few routines handles grading by section or whole class 3389: # 3390: #--- Javascript to handle grading by section or whole class 3391: sub viewgrades_js { 3392: my ($request) = shift; 3393: 3394: my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); 3395: $request->print(&Apache::lonhtmlcommon::scripttag(<<VIEWJAVASCRIPT)); 3396: function writePoint(partid,weight,point) { 3397: var radioButton = document.classgrade["RADVAL_"+partid]; 3398: var textbox = document.classgrade["TEXTVAL_"+partid]; 3399: if (point == "textval") { 3400: point = document.classgrade["TEXTVAL_"+partid].value; 3401: if (isNaN(point) || parseFloat(point) < 0) { 3402: alert("$alertmsg"+parseFloat(point)); 3403: var resetbox = false; 3404: for (var i=0; i<radioButton.length; i++) { 3405: if (radioButton[i].checked) { 3406: textbox.value = i; 3407: resetbox = true; 3408: } 3409: } 3410: if (!resetbox) { 3411: textbox.value = ""; 3412: } 3413: return; 3414: } 3415: if (parseFloat(point) > parseFloat(weight)) { 3416: var resp = confirm("You entered a value ("+parseFloat(point)+ 3417: ") greater than the weight for the part. Accept?"); 3418: if (resp == false) { 3419: textbox.value = ""; 3420: return; 3421: } 3422: } 3423: for (var i=0; i<radioButton.length; i++) { 3424: radioButton[i].checked=false; 3425: if (parseFloat(point) == i) { 3426: radioButton[i].checked=true; 3427: } 3428: } 3429: 3430: } else { 3431: textbox.value = parseFloat(point); 3432: } 3433: for (i=0;i<document.classgrade.total.value;i++) { 3434: var user = document.classgrade["ctr"+i].value; 3435: user = user.replace(new RegExp(':', 'g'),"_"); 3436: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3437: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3438: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3439: if (saveval != "correct") { 3440: scorename.value = point; 3441: if (selname[0].selected != true) { 3442: selname[0].selected = true; 3443: } 3444: } 3445: } 3446: document.classgrade["SELVAL_"+partid][0].selected = true; 3447: } 3448: 3449: function writeRadText(partid,weight) { 3450: var selval = document.classgrade["SELVAL_"+partid]; 3451: var radioButton = document.classgrade["RADVAL_"+partid]; 3452: var override = document.classgrade["FORCE_"+partid].checked; 3453: var textbox = document.classgrade["TEXTVAL_"+partid]; 3454: if (selval[1].selected || selval[2].selected) { 3455: for (var i=0; i<radioButton.length; i++) { 3456: radioButton[i].checked=false; 3457: 3458: } 3459: textbox.value = ""; 3460: 3461: for (i=0;i<document.classgrade.total.value;i++) { 3462: var user = document.classgrade["ctr"+i].value; 3463: user = user.replace(new RegExp(':', 'g'),"_"); 3464: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3465: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3466: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3467: if ((saveval != "correct") || override) { 3468: scorename.value = ""; 3469: if (selval[1].selected) { 3470: selname[1].selected = true; 3471: } else { 3472: selname[2].selected = true; 3473: if (Number(document.classgrade["GD_"+user+"_"+partid+"_tries"].value)) 3474: {document.classgrade["GD_"+user+"_"+partid+"_tries"].value = '0';} 3475: } 3476: } 3477: } 3478: } else { 3479: for (i=0;i<document.classgrade.total.value;i++) { 3480: var user = document.classgrade["ctr"+i].value; 3481: user = user.replace(new RegExp(':', 'g'),"_"); 3482: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3483: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3484: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3485: if ((saveval != "correct") || override) { 3486: scorename.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value; 3487: selname[0].selected = true; 3488: } 3489: } 3490: } 3491: } 3492: 3493: function changeSelect(partid,user) { 3494: var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"]; 3495: var textbox = document.classgrade["GD_"+user+'_'+partid+"_awarded"]; 3496: var point = textbox.value; 3497: var weight = document.classgrade["weight_"+partid].value; 3498: 3499: if (isNaN(point) || parseFloat(point) < 0) { 3500: alert("$alertmsg"+parseFloat(point)); 3501: textbox.value = ""; 3502: return; 3503: } 3504: if (parseFloat(point) > parseFloat(weight)) { 3505: var resp = confirm("You entered a value ("+parseFloat(point)+ 3506: ") greater than the weight of the part. Accept?"); 3507: if (resp == false) { 3508: textbox.value = ""; 3509: return; 3510: } 3511: } 3512: selval[0].selected = true; 3513: } 3514: 3515: function changeOneScore(partid,user) { 3516: var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"]; 3517: if (selval[1].selected || selval[2].selected) { 3518: document.classgrade["GD_"+user+'_'+partid+"_awarded"].value = ""; 3519: if (selval[2].selected) { 3520: document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0"; 3521: } 3522: } 3523: } 3524: 3525: function resetEntry(numpart) { 3526: for (ctpart=0;ctpart<numpart;ctpart++) { 3527: var partid = document.classgrade["partid_"+ctpart].value; 3528: var radioButton = document.classgrade["RADVAL_"+partid]; 3529: var textbox = document.classgrade["TEXTVAL_"+partid]; 3530: var selval = document.classgrade["SELVAL_"+partid]; 3531: for (var i=0; i<radioButton.length; i++) { 3532: radioButton[i].checked=false; 3533: 3534: } 3535: textbox.value = ""; 3536: selval[0].selected = true; 3537: 3538: for (i=0;i<document.classgrade.total.value;i++) { 3539: var user = document.classgrade["ctr"+i].value; 3540: user = user.replace(new RegExp(':', 'g'),"_"); 3541: var resetscore = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3542: resetscore.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value; 3543: var resettries = document.classgrade["GD_"+user+"_"+partid+"_tries"]; 3544: resettries.value = document.classgrade["GD_"+user+"_"+partid+"_tries_s"].value; 3545: var saveselval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3546: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3547: if (saveselval == "excused") { 3548: if (selname[1].selected == false) { selname[1].selected = true;} 3549: } else { 3550: if (selname[0].selected == false) {selname[0].selected = true}; 3551: } 3552: } 3553: } 3554: } 3555: 3556: VIEWJAVASCRIPT 3557: } 3558: 3559: #--- show scores for a section or whole class w/ option to change/update a score 3560: sub viewgrades { 3561: my ($request,$symb) = @_; 3562: &viewgrades_js($request); 3563: 3564: #need to make sure we have the correct data for later EXT calls, 3565: #thus invalidate the cache 3566: &Apache::lonnet::devalidatecourseresdata( 3567: $env{'course.'.$env{'request.course.id'}.'.num'}, 3568: $env{'course.'.$env{'request.course.id'}.'.domain'}); 3569: &Apache::lonnet::clear_EXT_cache_status(); 3570: 3571: my $result='<h3><span class="LC_info">'.&mt('Manual Grading').'</span></h3>'; 3572: 3573: #view individual student submission form - called using Javascript viewOneStudent 3574: $result.=&jscriptNform($symb); 3575: 3576: #beginning of class grading form 3577: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 3578: $result.= '<form action="/adm/grades" method="post" name="classgrade">'."\n". 3579: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 3580: '<input type="hidden" name="command" value="editgrades" />'."\n". 3581: &build_section_inputs(). 3582: '<input type="hidden" name="Status" value="'.$env{'stu_status'}.'" />'."\n". 3583: 3584: my ($common_header,$specific_header); 3585: if ($env{'form.section'} eq 'all') { 3586: $common_header = &mt('Assign Common Grade to Class'); 3587: $specific_header = &mt('Assign Grade to Specific Students in Class'); 3588: } elsif ($env{'form.section'} eq 'none') { 3589: $common_header = &mt('Assign Common Grade to Students in no Section'); 3590: $specific_header = &mt('Assign Grade to Specific Students in no Section'); 3591: } else { 3592: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3593: $common_header = &mt('Assign Common Grade to Students in Section(s) [_1]',$section_display); 3594: $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1]',$section_display); 3595: } 3596: $result.= '<h3>'.$common_header.'</h3>'.&Apache::loncommon::start_data_table(); 3597: #radio buttons/text box for assigning points for a section or class. 3598: #handles different parts of a problem 3599: my $res_error; 3600: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 3601: if ($res_error) { 3602: return &navmap_errormsg(); 3603: } 3604: my %weight = (); 3605: my $ctsparts = 0; 3606: my %seen = (); 3607: my @part_response_id = &flatten_responseType($responseType); 3608: foreach my $part_response_id (@part_response_id) { 3609: my ($partid,$respid) = @{ $part_response_id }; 3610: my $part_resp = join('_',@{ $part_response_id }); 3611: next if $seen{$partid}; 3612: $seen{$partid}++; 3613: my $handgrade=$$handgrade{$part_resp}; 3614: my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); 3615: $weight{$partid} = $wgt eq '' ? '1' : $wgt; 3616: 3617: my $display_part=&get_display_part($partid,$symb); 3618: my $radio.='<table border="0"><tr>'; 3619: my $ctr = 0; 3620: while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across 3621: $radio.= '<td><label><input type="radio" name="RADVAL_'.$partid.'" '. 3622: 'onclick="javascript:writePoint(\''.$partid.'\','.$weight{$partid}. 3623: ','.$ctr.')" />'.$ctr."</label></td>\n"; 3624: $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); 3625: $ctr++; 3626: } 3627: $radio.='</tr></table>'; 3628: my $line = '<input type="text" name="TEXTVAL_'. 3629: $partid.'" size="4" '.'onchange="javascript:writePoint(\''. 3630: $partid.'\','.$weight{$partid}.',\'textval\')" /> /'. 3631: $weight{$partid}.' '.&mt('(problem weight)').'</td>'."\n"; 3632: $line.= '<td><b>'.&mt('Grade Status').':</b>'. 3633: '<select name="SELVAL_'.$partid.'" '. 3634: 'onchange="javascript:writeRadText(\''.$partid.'\','. 3635: $weight{$partid}.')"> '. 3636: '<option selected="selected"> </option>'. 3637: '<option value="excused">'.&mt('excused').'</option>'. 3638: '<option value="reset status">'.&mt('reset status').'</option>'. 3639: '</select></td>'. 3640: '<td><label><input type="checkbox" name="FORCE_'.$partid.'" />'.&mt('Override "Correct"').'</label>'; 3641: $line.='<input type="hidden" name="partid_'. 3642: $ctsparts.'" value="'.$partid.'" />'."\n"; 3643: $line.='<input type="hidden" name="weight_'. 3644: $partid.'" value="'.$weight{$partid}.'" />'."\n"; 3645: 3646: $result.= 3647: &Apache::loncommon::start_data_table_row()."\n". 3648: '<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>'. 3649: &Apache::loncommon::end_data_table_row()."\n"; 3650: $ctsparts++; 3651: } 3652: $result.=&Apache::loncommon::end_data_table()."\n". 3653: '<input type="hidden" name="totalparts" value="'.$ctsparts.'" />'; 3654: $result.='<input type="button" value="'.&mt('Revert to Default').'" '. 3655: 'onclick="javascript:resetEntry('.$ctsparts.');" />'; 3656: 3657: #table listing all the students in a section/class 3658: #header of table 3659: $result.= '<h3>'.$specific_header.'</h3>'. 3660: &Apache::loncommon::start_data_table(). 3661: &Apache::loncommon::start_data_table_header_row(). 3662: '<th>'.&mt('No.').'</th>'. 3663: '<th>'.&nameUserString('header')."</th>\n"; 3664: my $partserror; 3665: my (@parts) = sort(&getpartlist($symb,\$partserror)); 3666: if ($partserror) { 3667: return &navmap_errormsg(); 3668: } 3669: my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); 3670: my @partids = (); 3671: foreach my $part (@parts) { 3672: my $display=&Apache::lonnet::metadata($url,$part.'.display'); 3673: my $narrowtext = &mt('Tries'); 3674: $display =~ s|^Number of Attempts|$narrowtext <br />|; # makes the column narrower 3675: if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } 3676: my ($partid) = &split_part_type($part); 3677: push(@partids,$partid); 3678: # 3679: # FIXME: Looks like $display looks at English text 3680: # 3681: my $display_part=&get_display_part($partid,$symb); 3682: if ($display =~ /^Partial Credit Factor/) { 3683: $result.='<th>'. 3684: &mt('Score Part: [_1][_2](weight = [_3])', 3685: $display_part,'<br />',$weight{$partid}).'</th>'."\n"; 3686: next; 3687: 3688: } else { 3689: if ($display =~ /Problem Status/) { 3690: my $grade_status_mt = &mt('Grade Status'); 3691: $display =~ s{Problem Status}{$grade_status_mt<br />}; 3692: } 3693: my $part_mt = &mt('Part:'); 3694: $display =~s{\[Part: \Q$partid\E\]}{$part_mt $display_part}; 3695: } 3696: 3697: $result.='<th>'.$display.'</th>'."\n"; 3698: } 3699: $result.=&Apache::loncommon::end_data_table_header_row(); 3700: 3701: my %last_resets = 3702: &get_last_resets($symb,$env{'request.course.id'},\@partids); 3703: 3704: #get info for each student 3705: #list all the students - with points and grade status 3706: my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); 3707: my $ctr = 0; 3708: foreach (sort 3709: { 3710: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 3711: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 3712: } 3713: return $a cmp $b; 3714: } (keys(%$fullname))) { 3715: $ctr++; 3716: $result.=&viewstudentgrade($symb,$env{'request.course.id'}, 3717: $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets); 3718: } 3719: $result.=&Apache::loncommon::end_data_table(); 3720: $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n"; 3721: $result.='<input type="button" value="'.&mt('Save').'" '. 3722: 'onclick="javascript:submit();" target="_self" /></form>'."\n"; 3723: if (scalar(%$fullname) eq 0) { 3724: my $colspan=3+scalar(@parts); 3725: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3726: my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status')); 3727: $result='<span class="LC_warning">'. 3728: &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.', 3729: $section_display, $stu_status). 3730: '</span>'; 3731: } 3732: return $result; 3733: } 3734: 3735: #--- call by previous routine to display each student 3736: sub viewstudentgrade { 3737: my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_; 3738: my ($uname,$udom) = split(/:/,$student); 3739: my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); 3740: my %aggregates = (); 3741: my $result=&Apache::loncommon::start_data_table_row().'<td align="right">'. 3742: '<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'. 3743: "\n".$ctr.' </td><td> '. 3744: '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. 3745: '\');" target="_self">'.$fullname.'</a> '. 3746: '<span class="LC_internal_info">('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')</span></td>'."\n"; 3747: $student=~s/:/_/; # colon doen't work in javascript for names 3748: foreach my $apart (@$parts) { 3749: my ($part,$type) = &split_part_type($apart); 3750: my $score=$record{"resource.$part.$type"}; 3751: $result.='<td align="center">'; 3752: my ($aggtries,$totaltries); 3753: unless (exists($aggregates{$part})) { 3754: $totaltries = $record{'resource.'.$part.'.tries'}; 3755: 3756: $aggtries = $totaltries; 3757: if ($$last_resets{$part}) { 3758: $aggtries = &get_num_tries(\%record,$$last_resets{$part}, 3759: $part); 3760: } 3761: $result.='<input type="hidden" name="'. 3762: 'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n"; 3763: $result.='<input type="hidden" name="'. 3764: 'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n"; 3765: $aggregates{$part} = 1; 3766: } 3767: if ($type eq 'awarded') { 3768: my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part}); 3769: $result.='<input type="hidden" name="'. 3770: 'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n"; 3771: $result.='<input type="text" name="'. 3772: 'GD_'.$student.'_'.$part.'_awarded" '. 3773: 'onchange="javascript:changeSelect(\''.$part.'\',\''.$student. 3774: '\')" value="'.$pts.'" size="4" /></td>'."\n"; 3775: } elsif ($type eq 'solved') { 3776: my ($status,$foo)=split(/_/,$score,2); 3777: $status = 'nothing' if ($status eq ''); 3778: $result.='<input type="hidden" name="'.'GD_'.$student.'_'. 3779: $part.'_solved_s" value="'.$status.'" />'."\n"; 3780: $result.=' <select name="'. 3781: 'GD_'.$student.'_'.$part.'_solved" '. 3782: 'onchange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n"; 3783: $result.= (($status eq 'excused') ? '<option> </option><option selected="selected" value="excused">'.&mt('excused').'</option>' 3784: : '<option selected="selected"> </option><option value="excused">'.&mt('excused').'</option>')."\n"; 3785: $result.='<option value="reset status">'.&mt('reset status').'</option>'; 3786: $result.="</select> </td>\n"; 3787: } else { 3788: $result.='<input type="hidden" name="'. 3789: 'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'. 3790: "\n"; 3791: $result.='<input type="text" name="'. 3792: 'GD_'.$student.'_'.$part.'_'.$type.'" '. 3793: 'value="'.$score.'" size="4" /></td>'."\n"; 3794: } 3795: } 3796: $result.=&Apache::loncommon::end_data_table_row(); 3797: return $result; 3798: } 3799: 3800: #--- change scores for all the students in a section/class 3801: # record does not get update if unchanged 3802: sub editgrades { 3803: my ($request,$symb) = @_; 3804: 3805: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 3806: my $title='<h2>'.&mt('Current Grade Status').'</h2>'; 3807: $title.='<h4>'.&mt('<b>Section: </b>[_1]',$section_display).'</h4>'."\n"; 3808: 3809: my $result= &Apache::loncommon::start_data_table(). 3810: &Apache::loncommon::start_data_table_header_row(). 3811: '<th rowspan="2" valign="middle">'.&mt('No.').'</th>'. 3812: '<th rowspan="2" valign="middle">'.&nameUserString('header')."</th>\n"; 3813: my %scoreptr = ( 3814: 'correct' =>'correct_by_override', 3815: 'incorrect'=>'incorrect_by_override', 3816: 'excused' =>'excused', 3817: 'ungraded' =>'ungraded_attempted', 3818: 'credited' =>'credit_attempted', 3819: 'nothing' => '', 3820: ); 3821: my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0'); 3822: 3823: my (@partid); 3824: my %weight = (); 3825: my %columns = (); 3826: my ($i,$ctr,$count,$rec_update) = (0,0,0,0); 3827: 3828: my $partserror; 3829: my (@parts) = sort(&getpartlist($symb,\$partserror)); 3830: if ($partserror) { 3831: return &navmap_errormsg(); 3832: } 3833: my $header; 3834: while ($ctr < $env{'form.totalparts'}) { 3835: my $partid = $env{'form.partid_'.$ctr}; 3836: push(@partid,$partid); 3837: $weight{$partid} = $env{'form.weight_'.$partid}; 3838: $ctr++; 3839: } 3840: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 3841: foreach my $partid (@partid) { 3842: $header .= '<th align="center">'.&mt('Old Score').'</th>'. 3843: '<th align="center">'.&mt('New Score').'</th>'; 3844: $columns{$partid}=2; 3845: foreach my $stores (@parts) { 3846: my ($part,$type) = &split_part_type($stores); 3847: if ($part !~ m/^\Q$partid\E/) { next;} 3848: if ($type eq 'awarded' || $type eq 'solved') { next; } 3849: my $display=&Apache::lonnet::metadata($url,$stores.'.display'); 3850: $display =~ s/\[Part: \Q$part\E\]//; 3851: my $narrowtext = &mt('Tries'); 3852: $display =~ s/Number of Attempts/$narrowtext/; 3853: $header .= '<th align="center">'.&mt('Old').' '.$display.'</th>'. 3854: '<th align="center">'.&mt('New').' '.$display.'</th>'; 3855: $columns{$partid}+=2; 3856: } 3857: } 3858: foreach my $partid (@partid) { 3859: my $display_part=&get_display_part($partid,$symb); 3860: $result .= '<th colspan="'.$columns{$partid}.'" align="center">'. 3861: &mt('Part: [_1] (Weight = [_2])',$display_part,$weight{$partid}). 3862: '</th>'; 3863: 3864: } 3865: $result .= &Apache::loncommon::end_data_table_header_row(). 3866: &Apache::loncommon::start_data_table_header_row(). 3867: $header. 3868: &Apache::loncommon::end_data_table_header_row(); 3869: my @noupdate; 3870: my ($updateCtr,$noupdateCtr) = (1,1); 3871: for ($i=0; $i<$env{'form.total'}; $i++) { 3872: my $line; 3873: my $user = $env{'form.ctr'.$i}; 3874: my ($uname,$udom)=split(/:/,$user); 3875: my %newrecord; 3876: my $updateflag = 0; 3877: $line .= '<td>'.&nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>'; 3878: my $usec=$classlist->{"$uname:$udom"}[5]; 3879: if (!&canmodify($usec)) { 3880: my $numcols=scalar(@partid)*4+2; 3881: push(@noupdate, 3882: $line."<td colspan=\"$numcols\"><span class=\"LC_warning\">". 3883: &mt('Not allowed to modify student')."</span></td></tr>"); 3884: next; 3885: } 3886: my %aggregate = (); 3887: my $aggregateflag = 0; 3888: $user=~s/:/_/; # colon doen't work in javascript for names 3889: foreach (@partid) { 3890: my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'}; 3891: my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1); 3892: my $old_part = $old_aw eq '' ? '' : $old_part_pcr; 3893: my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; 3894: my $awarded = $env{'form.GD_'.$user.'_'.$_.'_awarded'}; 3895: my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1); 3896: my $partial = $awarded eq '' ? '' : $pcr; 3897: my $score; 3898: if ($partial eq '') { 3899: $score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; 3900: } elsif ($partial > 0) { 3901: $score = 'correct_by_override'; 3902: } elsif ($partial == 0) { 3903: $score = 'incorrect_by_override'; 3904: } 3905: my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'}; 3906: $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused')); 3907: 3908: $newrecord{'resource.'.$_.'.regrader'}= 3909: "$env{'user.name'}:$env{'user.domain'}"; 3910: if ($dropMenu eq 'reset status' && 3911: $old_score ne '') { # ignore if no previous attempts => nothing to reset 3912: $newrecord{'resource.'.$_.'.tries'} = ''; 3913: $newrecord{'resource.'.$_.'.solved'} = ''; 3914: $newrecord{'resource.'.$_.'.award'} = ''; 3915: $newrecord{'resource.'.$_.'.awarded'} = ''; 3916: $updateflag = 1; 3917: if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) { 3918: my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'}; 3919: my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'}; 3920: my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'}; 3921: &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus); 3922: $aggregateflag = 1; 3923: } 3924: } elsif (!($old_part eq $partial && $old_score eq $score)) { 3925: $updateflag = 1; 3926: $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; 3927: $newrecord{'resource.'.$_.'.solved'} = $score; 3928: $rec_update++; 3929: } 3930: 3931: $line .= '<td align="center">'.$old_aw.' </td>'. 3932: '<td align="center">'.$awarded. 3933: ($score eq 'excused' ? $score : '').' </td>'; 3934: 3935: 3936: my $partid=$_; 3937: foreach my $stores (@parts) { 3938: my ($part,$type) = &split_part_type($stores); 3939: if ($part !~ m/^\Q$partid\E/) { next;} 3940: if ($type eq 'awarded' || $type eq 'solved') { next; } 3941: my $old_aw = $env{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'}; 3942: my $awarded = $env{'form.GD_'.$user.'_'.$part.'_'.$type}; 3943: if ($awarded ne '' && $awarded ne $old_aw) { 3944: $newrecord{'resource.'.$part.'.'.$type}= $awarded; 3945: $newrecord{'resource.'.$part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; 3946: $updateflag=1; 3947: } 3948: $line .= '<td align="center">'.$old_aw.' </td>'. 3949: '<td align="center">'.$awarded.' </td>'; 3950: } 3951: } 3952: $line.="\n"; 3953: 3954: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 3955: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 3956: 3957: if ($updateflag) { 3958: $count++; 3959: &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'}, 3960: $udom,$uname); 3961: 3962: if (&Apache::bridgetask::in_queue('gradingqueue',$symb,$cdom, 3963: $cnum,$udom,$uname)) { 3964: # need to figure out if should be in queue. 3965: my %record = 3966: &Apache::lonnet::restore($symb,$env{'request.course.id'}, 3967: $udom,$uname); 3968: my $all_graded = 1; 3969: my $none_graded = 1; 3970: foreach my $part (@parts) { 3971: if ( $record{'resource.'.$part.'.awarded'} eq '' ) { 3972: $all_graded = 0; 3973: } else { 3974: $none_graded = 0; 3975: } 3976: } 3977: 3978: if ($all_graded || $none_graded) { 3979: &Apache::bridgetask::remove_from_queue('gradingqueue', 3980: $symb,$cdom,$cnum, 3981: $udom,$uname); 3982: } 3983: } 3984: 3985: $result.=&Apache::loncommon::start_data_table_row(). 3986: '<td align="right"> '.$updateCtr.' </td>'.$line. 3987: &Apache::loncommon::end_data_table_row(); 3988: $updateCtr++; 3989: } else { 3990: push(@noupdate, 3991: '<td align="right"> '.$noupdateCtr.' </td>'.$line); 3992: $noupdateCtr++; 3993: } 3994: if ($aggregateflag) { 3995: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 3996: $cdom,$cnum); 3997: } 3998: } 3999: if (@noupdate) { 4000: # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; 4001: my $numcols=scalar(@partid)*4+2; 4002: $result .= &Apache::loncommon::start_data_table_row('LC_empty_row'). 4003: '<td align="center" colspan="'.$numcols.'">'. 4004: &mt('No Changes Occurred For the Students Below'). 4005: '</td>'. 4006: &Apache::loncommon::end_data_table_row(); 4007: foreach my $line (@noupdate) { 4008: $result.= 4009: &Apache::loncommon::start_data_table_row(). 4010: $line. 4011: &Apache::loncommon::end_data_table_row(); 4012: } 4013: } 4014: $result .= &Apache::loncommon::end_data_table(); 4015: my $msg = '<p><b>'. 4016: &mt('Number of records updated = [_1] for [quant,_2,student].', 4017: $rec_update,$count).'</b><br />'. 4018: '<b>'.&mt('Total number of students = [_1]',$env{'form.total'}). 4019: '</b></p>'; 4020: return $title.$msg.$result; 4021: } 4022: 4023: sub split_part_type { 4024: my ($partstr) = @_; 4025: my ($temp,@allparts)=split(/_/,$partstr); 4026: my $type=pop(@allparts); 4027: my $part=join('_',@allparts); 4028: return ($part,$type); 4029: } 4030: 4031: #------------- end of section for handling grading by section/class --------- 4032: # 4033: #---------------------------------------------------------------------------- 4034: 4035: 4036: #---------------------------------------------------------------------------- 4037: # 4038: #-------------------------- Next few routines handles grading by csv upload 4039: # 4040: #--- Javascript to handle csv upload 4041: sub csvupload_javascript_reverse_associate { 4042: my $error1=&mt('You need to specify the username or the student/employee ID'); 4043: my $error2=&mt('You need to specify at least one grading field'); 4044: return(<<ENDPICK); 4045: function verify(vf) { 4046: var foundsomething=0; 4047: var founduname=0; 4048: var foundID=0; 4049: for (i=0;i<=vf.nfields.value;i++) { 4050: tw=eval('vf.f'+i+'.selectedIndex'); 4051: if (i==0 && tw!=0) { foundID=1; } 4052: if (i==1 && tw!=0) { founduname=1; } 4053: if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; } 4054: } 4055: if (founduname==0 && foundID==0) { 4056: alert('$error1'); 4057: return; 4058: } 4059: if (foundsomething==0) { 4060: alert('$error2'); 4061: return; 4062: } 4063: vf.submit(); 4064: } 4065: function flip(vf,tf) { 4066: var nw=eval('vf.f'+tf+'.selectedIndex'); 4067: var i; 4068: for (i=0;i<=vf.nfields.value;i++) { 4069: //can not pick the same destination field for both name and domain 4070: if (((i ==0)||(i ==1)) && 4071: ((tf==0)||(tf==1)) && 4072: (i!=tf) && 4073: (eval('vf.f'+i+'.selectedIndex')==nw)) { 4074: eval('vf.f'+i+'.selectedIndex=0;') 4075: } 4076: } 4077: } 4078: ENDPICK 4079: } 4080: 4081: sub csvupload_javascript_forward_associate { 4082: my $error1=&mt('You need to specify the username or the student/employee ID'); 4083: my $error2=&mt('You need to specify at least one grading field'); 4084: return(<<ENDPICK); 4085: function verify(vf) { 4086: var foundsomething=0; 4087: var founduname=0; 4088: var foundID=0; 4089: for (i=0;i<=vf.nfields.value;i++) { 4090: tw=eval('vf.f'+i+'.selectedIndex'); 4091: if (tw==1) { foundID=1; } 4092: if (tw==2) { founduname=1; } 4093: if (tw>3) { foundsomething=1; } 4094: } 4095: if (founduname==0 && foundID==0) { 4096: alert('$error1'); 4097: return; 4098: } 4099: if (foundsomething==0) { 4100: alert('$error2'); 4101: return; 4102: } 4103: vf.submit(); 4104: } 4105: function flip(vf,tf) { 4106: var nw=eval('vf.f'+tf+'.selectedIndex'); 4107: var i; 4108: //can not pick the same destination field twice 4109: for (i=0;i<=vf.nfields.value;i++) { 4110: if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) { 4111: eval('vf.f'+i+'.selectedIndex=0;') 4112: } 4113: } 4114: } 4115: ENDPICK 4116: } 4117: 4118: sub csvuploadmap_header { 4119: my ($request,$symb,$datatoken,$distotal)= @_; 4120: my $javascript; 4121: if ($env{'form.upfile_associate'} eq 'reverse') { 4122: $javascript=&csvupload_javascript_reverse_associate(); 4123: } else { 4124: $javascript=&csvupload_javascript_forward_associate(); 4125: } 4126: 4127: $symb = &Apache::lonenc::check_encrypt($symb); 4128: $request->print('<form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">'. 4129: &mt('Total number of records found in file: [_1]',$distotal).'<hr />'. 4130: &mt('Associate entries from the uploaded file with as many fields as you can.')); 4131: my $reverse=&mt("Reverse Association"); 4132: $request->print(<<ENDPICK); 4133: <br /> 4134: <input type="button" value="$reverse" onclick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" /> 4135: <input type="hidden" name="associate" value="" /> 4136: <input type="hidden" name="phase" value="three" /> 4137: <input type="hidden" name="datatoken" value="$datatoken" /> 4138: <input type="hidden" name="fileupload" value="$env{'form.fileupload'}" /> 4139: <input type="hidden" name="upfiletype" value="$env{'form.upfiletype'}" /> 4140: <input type="hidden" name="upfile_associate" 4141: value="$env{'form.upfile_associate'}" /> 4142: <input type="hidden" name="symb" value="$symb" /> 4143: <input type="hidden" name="command" value="csvuploadoptions" /> 4144: <hr /> 4145: ENDPICK 4146: $request->print(&Apache::lonhtmlcommon::scripttag($javascript)); 4147: return ''; 4148: 4149: } 4150: 4151: sub csvupload_fields { 4152: my ($symb,$errorref) = @_; 4153: my (@parts) = &getpartlist($symb,$errorref); 4154: if (ref($errorref)) { 4155: if ($$errorref) { 4156: return; 4157: } 4158: } 4159: 4160: my @fields=(['ID','Student/Employee ID'], 4161: ['username','Student Username'], 4162: ['domain','Student Domain']); 4163: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 4164: foreach my $part (sort(@parts)) { 4165: my @datum; 4166: my $display=&Apache::lonnet::metadata($url,$part.'.display'); 4167: my $name=$part; 4168: if (!$display) { $display = $name; } 4169: @datum=($name,$display); 4170: if ($name=~/^stores_(.*)_awarded/) { 4171: push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]); 4172: } 4173: push(@fields,\@datum); 4174: } 4175: return (@fields); 4176: } 4177: 4178: sub csvuploadmap_footer { 4179: my ($request,$i,$keyfields) =@_; 4180: my $buttontext = &mt('Assign Grades'); 4181: $request->print(<<ENDPICK); 4182: </table> 4183: <input type="hidden" name="nfields" value="$i" /> 4184: <input type="hidden" name="keyfields" value="$keyfields" /> 4185: <input type="button" onclick="javascript:verify(this.form)" value="$buttontext" /><br /> 4186: </form> 4187: ENDPICK 4188: } 4189: 4190: sub checkforfile_js { 4191: my $alertmsg = &mt('Please use the browse button to select a file from your local directory.'); 4192: my $result = &Apache::lonhtmlcommon::scripttag(<<CSVFORMJS); 4193: function checkUpload(formname) { 4194: if (formname.upfile.value == "") { 4195: alert("$alertmsg"); 4196: return false; 4197: } 4198: formname.submit(); 4199: } 4200: CSVFORMJS 4201: return $result; 4202: } 4203: 4204: sub upcsvScores_form { 4205: my ($request,$symb) = @_; 4206: if (!$symb) {return '';} 4207: my $result=&checkforfile_js(); 4208: $result.=&Apache::loncommon::start_data_table(). 4209: &Apache::loncommon::start_data_table_header_row(). 4210: '<th>'.&mt('Specify a file containing the class scores for current resource.').'</th>'. 4211: &Apache::loncommon::end_data_table_header_row(). 4212: &Apache::loncommon::start_data_table_row().'<td>'; 4213: my $upload=&mt("Upload Scores"); 4214: my $upfile_select=&Apache::loncommon::upfile_select_html(); 4215: my $ignore=&mt('Ignore First Line'); 4216: $symb = &Apache::lonenc::check_encrypt($symb); 4217: $result.=<<ENDUPFORM; 4218: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 4219: <input type="hidden" name="symb" value="$symb" /> 4220: <input type="hidden" name="command" value="csvuploadmap" /> 4221: $upfile_select 4222: <br /><input type="button" onclick="javascript:checkUpload(this.form);" value="$upload" /> 4223: </form> 4224: ENDUPFORM 4225: $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV", 4226: &mt("How do I create a CSV file from a spreadsheet")). 4227: '</td>'. 4228: &Apache::loncommon::end_data_table_row(). 4229: &Apache::loncommon::end_data_table(); 4230: return $result; 4231: } 4232: 4233: 4234: sub csvuploadmap { 4235: my ($request,$symb)= @_; 4236: if (!$symb) {return '';} 4237: 4238: my $datatoken; 4239: if (!$env{'form.datatoken'}) { 4240: $datatoken=&Apache::loncommon::upfile_store($request); 4241: } else { 4242: $datatoken=$env{'form.datatoken'}; 4243: &Apache::loncommon::load_tmp_file($request); 4244: } 4245: my @records=&Apache::loncommon::upfile_record_sep(); 4246: &csvuploadmap_header($request,$symb,$datatoken,$#records+1); 4247: my ($i,$keyfields); 4248: if (@records) { 4249: my $fieldserror; 4250: my @fields=&csvupload_fields($symb,\$fieldserror); 4251: if ($fieldserror) { 4252: $request->print(&navmap_errormsg()); 4253: return; 4254: } 4255: if ($env{'form.upfile_associate'} eq 'reverse') { 4256: &Apache::loncommon::csv_print_samples($request,\@records); 4257: $i=&Apache::loncommon::csv_print_select_table($request,\@records, 4258: \@fields); 4259: foreach (@fields) { $keyfields.=$_->[0].','; } 4260: chop($keyfields); 4261: } else { 4262: unshift(@fields,['none','']); 4263: $i=&Apache::loncommon::csv_samples_select_table($request,\@records, 4264: \@fields); 4265: foreach my $rec (@records) { 4266: my %temp = &Apache::loncommon::record_sep($rec); 4267: if (%temp) { 4268: $keyfields=join(',',sort(keys(%temp))); 4269: last; 4270: } 4271: } 4272: } 4273: } 4274: &csvuploadmap_footer($request,$i,$keyfields); 4275: 4276: return ''; 4277: } 4278: 4279: sub csvuploadoptions { 4280: my ($request,$symb)= @_; 4281: my $overwrite=&mt('Overwrite any existing score'); 4282: $request->print(<<ENDPICK); 4283: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 4284: <input type="hidden" name="command" value="csvuploadassign" /> 4285: <p> 4286: <label> 4287: <input type="checkbox" name="overwite_scores" checked="checked" /> 4288: $overwrite 4289: </label> 4290: </p> 4291: ENDPICK 4292: my %fields=&get_fields(); 4293: if (!defined($fields{'domain'})) { 4294: my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); 4295: $request->print("\n<p>".&mt('Users are in domain: [_1]',$domform)."</p>\n"); 4296: } 4297: foreach my $key (sort(keys(%env))) { 4298: if ($key !~ /^form\.(.*)$/) { next; } 4299: my $cleankey=$1; 4300: if ($cleankey eq 'command') { next; } 4301: $request->print('<input type="hidden" name="'.$cleankey. 4302: '" value="'.$env{$key}.'" />'."\n"); 4303: } 4304: # FIXME do a check for any duplicated user ids... 4305: # FIXME do a check for any invalid user ids?... 4306: $request->print('<input type="submit" value="'.&mt('Assign Grades').'" /><br /> 4307: <hr /></form>'."\n"); 4308: return ''; 4309: } 4310: 4311: sub get_fields { 4312: my %fields; 4313: my @keyfields = split(/\,/,$env{'form.keyfields'}); 4314: for (my $i=0; $i<=$env{'form.nfields'}; $i++) { 4315: if ($env{'form.upfile_associate'} eq 'reverse') { 4316: if ($env{'form.f'.$i} ne 'none') { 4317: $fields{$keyfields[$i]}=$env{'form.f'.$i}; 4318: } 4319: } else { 4320: if ($env{'form.f'.$i} ne 'none') { 4321: $fields{$env{'form.f'.$i}}=$keyfields[$i]; 4322: } 4323: } 4324: } 4325: return %fields; 4326: } 4327: 4328: sub csvuploadassign { 4329: my ($request,$symb)= @_; 4330: if (!$symb) {return '';} 4331: my $error_msg = ''; 4332: &Apache::loncommon::load_tmp_file($request); 4333: my @gradedata = &Apache::loncommon::upfile_record_sep(); 4334: my %fields=&get_fields(); 4335: my $courseid=$env{'request.course.id'}; 4336: my ($classlist) = &getclasslist('all',0); 4337: my @notallowed; 4338: my @skipped; 4339: my @warnings; 4340: my $countdone=0; 4341: foreach my $grade (@gradedata) { 4342: my %entries=&Apache::loncommon::record_sep($grade); 4343: my $domain; 4344: if ($entries{$fields{'domain'}}) { 4345: $domain=$entries{$fields{'domain'}}; 4346: } else { 4347: $domain=$env{'form.default_domain'}; 4348: } 4349: $domain=~s/\s//g; 4350: my $username=$entries{$fields{'username'}}; 4351: $username=~s/\s//g; 4352: if (!$username) { 4353: my $id=$entries{$fields{'ID'}}; 4354: $id=~s/\s//g; 4355: my %ids=&Apache::lonnet::idget($domain,$id); 4356: $username=$ids{$id}; 4357: } 4358: if (!exists($$classlist{"$username:$domain"})) { 4359: my $id=$entries{$fields{'ID'}}; 4360: $id=~s/\s//g; 4361: if ($id) { 4362: push(@skipped,"$id:$domain"); 4363: } else { 4364: push(@skipped,"$username:$domain"); 4365: } 4366: next; 4367: } 4368: my $usec=$classlist->{"$username:$domain"}[5]; 4369: if (!&canmodify($usec)) { 4370: push(@notallowed,"$username:$domain"); 4371: next; 4372: } 4373: my %points; 4374: my %grades; 4375: foreach my $dest (keys(%fields)) { 4376: if ($dest eq 'ID' || $dest eq 'username' || 4377: $dest eq 'domain') { next; } 4378: if ($entries{$fields{$dest}} =~ /^\s*$/) { next; } 4379: if ($dest=~/stores_(.*)_points/) { 4380: my $part=$1; 4381: my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', 4382: $symb,$domain,$username); 4383: if ($wgt) { 4384: $entries{$fields{$dest}}=~s/\s//g; 4385: my $pcr=$entries{$fields{$dest}} / $wgt; 4386: my $award=($pcr == 0) ? 'incorrect_by_override' 4387: : 'correct_by_override'; 4388: if ($pcr>1) { 4389: push(@warnings,&mt("[_1]: point value larger than weight","$username:$domain")); 4390: } 4391: $grades{"resource.$part.awarded"}=$pcr; 4392: $grades{"resource.$part.solved"}=$award; 4393: $points{$part}=1; 4394: } else { 4395: $error_msg = "<br />" . 4396: &mt("Some point values were assigned" 4397: ." for problems with a weight " 4398: ."of zero. These values were " 4399: ."ignored."); 4400: } 4401: } else { 4402: if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } 4403: if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } 4404: my $store_key=$dest; 4405: $store_key=~s/^stores/resource/; 4406: $store_key=~s/_/\./g; 4407: $grades{$store_key}=$entries{$fields{$dest}}; 4408: } 4409: } 4410: if (! %grades) { 4411: push(@skipped,&mt("[_1]: no data to save","$username:$domain")); 4412: } else { 4413: $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; 4414: my $result=&Apache::lonnet::cstore(\%grades,$symb, 4415: $env{'request.course.id'}, 4416: $domain,$username); 4417: if ($result eq 'ok') { 4418: # Successfully stored 4419: $request->print('.'); 4420: # Remove from grading queue 4421: &Apache::bridgetask::remove_from_queue('gradingqueue',$symb, 4422: $env{'course.'.$env{'request.course.id'}.'.domain'}, 4423: $env{'course.'.$env{'request.course.id'}.'.num'}, 4424: $domain,$username); 4425: $countdone++; 4426: } else { 4427: $request->print("<p><span class=\"LC_error\">". 4428: &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", 4429: "$username:$domain",$result)."</span></p>"); 4430: } 4431: $request->rflush(); 4432: } 4433: } 4434: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0)); 4435: if (@warnings) { 4436: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('Warnings generated for the following saved scores:'),1).'<br />'); 4437: $request->print(join(', ',@warnings)); 4438: } 4439: if (@skipped) { 4440: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('No scores stored for the following username(s):'),1).'<br />'); 4441: $request->print(join(', ',@skipped)); 4442: } 4443: if (@notallowed) { 4444: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('Modification of scores not allowed for the following username(s):'),1).'<br />'); 4445: $request->print(join(', ',@notallowed)); 4446: } 4447: $request->print("<br />\n"); 4448: return $error_msg; 4449: } 4450: #------------- end of section for handling csv file upload --------- 4451: # 4452: #------------------------------------------------------------------- 4453: # 4454: #-------------- Next few routines handle grading by page/sequence 4455: # 4456: #--- Select a page/sequence and a student to grade 4457: sub pickStudentPage { 4458: my ($request,$symb) = @_; 4459: 4460: my $alertmsg = &mt('Please select the student you wish to grade.'); 4461: $request->print(&Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT)); 4462: 4463: function checkPickOne(formname) { 4464: if (radioSelection(formname.student) == null) { 4465: alert("$alertmsg"); 4466: return; 4467: } 4468: ptr = pullDownSelection(formname.selectpage); 4469: formname.page.value = formname["page"+ptr].value; 4470: formname.title.value = formname["title"+ptr].value; 4471: formname.submit(); 4472: } 4473: 4474: LISTJAVASCRIPT 4475: &commonJSfunctions($request); 4476: 4477: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 4478: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 4479: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 4480: 4481: my $result='<h3><span class="LC_info"> '. 4482: &mt('Manual Grading by Page or Sequence').'</span></h3>'; 4483: 4484: $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n"; 4485: my $map_error; 4486: my ($titles,$symbx) = &getSymbMap($map_error); 4487: if ($map_error) { 4488: $request->print(&navmap_errormsg()); 4489: return; 4490: } 4491: my ($curpage) =&Apache::lonnet::decode_symb($symb); 4492: # my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 4493: # my $type=($curpage =~ /\.(page|sequence)/); 4494: 4495: # Collection of hidden fields 4496: my $ctr=0; 4497: foreach (@$titles) { 4498: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 4499: $result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n"; 4500: $result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n"; 4501: $ctr++; 4502: } 4503: $result.='<input type="hidden" name="page" />'."\n". 4504: '<input type="hidden" name="title" />'."\n"; 4505: 4506: $result.=&build_section_inputs(); 4507: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 4508: $result.='<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 4509: '<input type="hidden" name="command" value="displayPage" />'."\n". 4510: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 4511: 4512: # Show grading options 4513: $result.=&Apache::lonhtmlcommon::start_pick_box(); 4514: my $select = '<select name="selectpage">'."\n"; 4515: $ctr=0; 4516: foreach (@$titles) { 4517: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 4518: $select.='<option value="'.$ctr.'"'. 4519: ($$symbx{$_} =~ /$curpage$/ ? ' selected="selected"' : ''). 4520: '>'.$showtitle.'</option>'."\n"; 4521: $ctr++; 4522: } 4523: $select.= '</select>'; 4524: 4525: $result.= 4526: &Apache::lonhtmlcommon::row_title(&mt('Problems from')) 4527: .$select 4528: .&Apache::lonhtmlcommon::row_closure(); 4529: 4530: $result.= 4531: &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) 4532: .'<label><input type="radio" name="vProb" value="no"' 4533: .' checked="checked" /> '.&mt('no').' </label>'."\n" 4534: .'<label><input type="radio" name="vProb" value="yes" />' 4535: .&mt('yes').'</label>'."\n" 4536: .&Apache::lonhtmlcommon::row_closure(); 4537: 4538: $result.= 4539: &Apache::lonhtmlcommon::row_title(&mt('View Submissions')) 4540: .'<label><input type="radio" name="lastSub" value="none" /> ' 4541: .&mt('none').' </label>'."\n" 4542: .'<label><input type="radio" name="lastSub" value="datesub"' 4543: .' checked="checked" /> '.&mt('all submissions').'</label>'."\n" 4544: .'<label><input type="radio" name="lastSub" value="all" /> ' 4545: .&mt('all submissions with details').' </label>' 4546: .&Apache::lonhtmlcommon::row_closure(); 4547: 4548: $result.= 4549: &Apache::lonhtmlcommon::row_title(&mt('Use CODE')) 4550: .'<input type="text" name="CODE" value="" />' 4551: .&Apache::lonhtmlcommon::row_closure(1) 4552: .&Apache::lonhtmlcommon::end_pick_box(); 4553: 4554: # Show list of students to select for grading 4555: $result.='<br /><input type="button" '. 4556: 'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /><br />'."\n"; 4557: 4558: $request->print($result); 4559: 4560: my $studentTable.=' <b>'.&mt('Select a student you wish to grade and then click on the Next button.').'</b><br />'. 4561: &Apache::loncommon::start_data_table(). 4562: &Apache::loncommon::start_data_table_header_row(). 4563: '<th align="right"> '.&mt('No.').'</th>'. 4564: '<th>'.&nameUserString('header').'</th>'. 4565: '<th align="right"> '.&mt('No.').'</th>'. 4566: '<th>'.&nameUserString('header').'</th>'. 4567: &Apache::loncommon::end_data_table_header_row(); 4568: 4569: my (undef,undef,$fullname) = &getclasslist($getsec,'1'); 4570: my $ptr = 1; 4571: foreach my $student (sort 4572: { 4573: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 4574: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 4575: } 4576: return $a cmp $b; 4577: } (keys(%$fullname))) { 4578: my ($uname,$udom) = split(/:/,$student); 4579: $studentTable.=($ptr%2==1 ? &Apache::loncommon::start_data_table_row() 4580: : '</td>'); 4581: $studentTable.='<td align="right">'.$ptr.' </td>'; 4582: $studentTable.='<td> <label><input type="radio" name="student" value="'.$student.'" /> ' 4583: .&nameUserString(undef,$$fullname{$student},$uname,$udom)."</label>\n"; 4584: $studentTable.= 4585: ($ptr%2 == 0 ? '</td>'.&Apache::loncommon::end_data_table_row() 4586: : ''); 4587: $ptr++; 4588: } 4589: if ($ptr%2 == 0) { 4590: $studentTable.='</td><td> </td><td> </td>'. 4591: &Apache::loncommon::end_data_table_row(); 4592: } 4593: $studentTable.=&Apache::loncommon::end_data_table()."\n"; 4594: $studentTable.='<input type="button" '. 4595: 'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /></form>'."\n"; 4596: 4597: $request->print($studentTable); 4598: 4599: return ''; 4600: } 4601: 4602: sub getSymbMap { 4603: my ($map_error) = @_; 4604: my $navmap = Apache::lonnavmaps::navmap->new(); 4605: unless (ref($navmap)) { 4606: if (ref($map_error)) { 4607: $$map_error = 'navmap'; 4608: } 4609: return; 4610: } 4611: my %symbx = (); 4612: my @titles = (); 4613: my $minder = 0; 4614: 4615: # Gather every sequence that has problems. 4616: my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 4617: 1,0,1); 4618: for my $sequence ($navmap->getById('0.0'), @sequences) { 4619: if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { 4620: my $title = $minder.'.'. 4621: &HTML::Entities::encode($sequence->compTitle(),'"\'&'); 4622: push(@titles, $title); # minder in case two titles are identical 4623: $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); 4624: $minder++; 4625: } 4626: } 4627: return \@titles,\%symbx; 4628: } 4629: 4630: # 4631: #--- Displays a page/sequence w/wo problems, w/wo submissions 4632: sub displayPage { 4633: my ($request,$symb) = @_; 4634: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 4635: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 4636: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 4637: my $pageTitle = $env{'form.page'}; 4638: my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); 4639: my ($uname,$udom) = split(/:/,$env{'form.student'}); 4640: my $usec=$classlist->{$env{'form.student'}}[5]; 4641: 4642: #need to make sure we have the correct data for later EXT calls, 4643: #thus invalidate the cache 4644: &Apache::lonnet::devalidatecourseresdata( 4645: $env{'course.'.$env{'request.course.id'}.'.num'}, 4646: $env{'course.'.$env{'request.course.id'}.'.domain'}); 4647: &Apache::lonnet::clear_EXT_cache_status(); 4648: 4649: if (!&canview($usec)) { 4650: $request->print( 4651: '<span class="LC_warning">'. 4652: &mt('Unable to view requested student. ([_1])', 4653: $env{'form.student'}). 4654: '</span>'); 4655: return; 4656: } 4657: my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; 4658: $result.='<h3> '.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)). 4659: '</h3>'."\n"; 4660: $env{'form.CODE'} = uc($env{'form.CODE'}); 4661: if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) { 4662: $result.='<h3> '.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n"; 4663: } else { 4664: delete($env{'form.CODE'}); 4665: } 4666: &sub_page_js($request); 4667: $request->print($result); 4668: 4669: my $navmap = Apache::lonnavmaps::navmap->new(); 4670: unless (ref($navmap)) { 4671: $request->print(&navmap_errormsg()); 4672: return; 4673: } 4674: my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'}); 4675: my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps 4676: if (!$map) { 4677: $request->print('<span class="LC_warning">'.&mt('Unable to view requested sequence. ([_1])',$resUrl).'</span>'); 4678: return; 4679: } 4680: my $iterator = $navmap->getIterator($map->map_start(), 4681: $map->map_finish()); 4682: 4683: my $studentTable='<form action="/adm/grades" method="post" name="gradePage">'."\n". 4684: '<input type="hidden" name="command" value="gradeByPage" />'."\n". 4685: '<input type="hidden" name="fullname" value="'.$$fullname{$env{'form.student'}}.'" />'."\n". 4686: '<input type="hidden" name="student" value="'.$env{'form.student'}.'" />'."\n". 4687: '<input type="hidden" name="page" value="'.$pageTitle.'" />'."\n". 4688: '<input type="hidden" name="title" value="'.$env{'form.title'}.'" />'."\n". 4689: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 4690: '<input type="hidden" name="overRideScore" value="no" />'."\n"; 4691: 4692: if (defined($env{'form.CODE'})) { 4693: $studentTable.= 4694: '<input type="hidden" name="CODE" value="'.$env{'form.CODE'}.'" />'."\n"; 4695: } 4696: my $checkIcon = '<img alt="'.&mt('Check Mark'). 4697: '" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />'; 4698: 4699: $studentTable.=' <span class="LC_info">'. 4700: &mt('Problems graded correct by the computer are marked with a [_1] symbol.',$checkIcon). 4701: '</span>'."\n". 4702: &Apache::loncommon::start_data_table(). 4703: &Apache::loncommon::start_data_table_header_row(). 4704: '<th>'.&mt('Prob.').'</th>'. 4705: '<th> '.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').'</th>'. 4706: &Apache::loncommon::end_data_table_header_row(); 4707: 4708: &Apache::lonxml::clear_problem_counter(); 4709: my ($depth,$question,$prob) = (1,1,1); 4710: $iterator->next(); # skip the first BEGIN_MAP 4711: my $curRes = $iterator->next(); # for "current resource" 4712: while ($depth > 0) { 4713: if($curRes == $iterator->BEGIN_MAP) { $depth++; } 4714: if($curRes == $iterator->END_MAP) { $depth--; } 4715: 4716: if (ref($curRes) && $curRes->is_problem()) { 4717: my $parts = $curRes->parts(); 4718: my $title = $curRes->compTitle(); 4719: my $symbx = $curRes->symb(); 4720: $studentTable.= 4721: &Apache::loncommon::start_data_table_row(). 4722: '<td align="center" valign="top" >'.$prob. 4723: (scalar(@{$parts}) == 1 ? '' 4724: : '<br />('.&mt('[_1]parts', 4725: scalar(@{$parts}).' ').')' 4726: ). 4727: '</td>'; 4728: $studentTable.='<td valign="top">'; 4729: my %form = ('CODE' => $env{'form.CODE'},); 4730: if ($env{'form.vProb'} eq 'yes' ) { 4731: $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, 4732: undef,'both',\%form); 4733: } else { 4734: my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form); 4735: $companswer =~ s|<form(.*?)>||g; 4736: $companswer =~ s|</form>||g; 4737: # while ($companswer =~ /(<a href\=\"javascript:newWindow.*?Script Vars<\/a>)/s) { #<a href="javascript:newWindow</a> 4738: # $companswer =~ s/$1/ /ms; 4739: # $request->print('match='.$1."<br />\n"); 4740: # } 4741: # $companswer =~ s|<table border=\"1\">|<table border=\"0\">|g; 4742: $studentTable.=' <b>'.$title.'</b> <br /> <b>'.&mt('Correct answer').':</b><br />'.$companswer; 4743: } 4744: 4745: my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); 4746: 4747: if ($env{'form.lastSub'} eq 'datesub') { 4748: if ($record{'version'} eq '') { 4749: $studentTable.='<br /> <span class="LC_warning">'.&mt('No recorded submission for this problem.').'</span><br />'; 4750: } else { 4751: my %responseType = (); 4752: foreach my $partid (@{$parts}) { 4753: my @responseIds =$curRes->responseIds($partid); 4754: my @responseType =$curRes->responseType($partid); 4755: my %responseIds; 4756: for (my $i=0;$i<=$#responseIds;$i++) { 4757: $responseIds{$responseIds[$i]}=$responseType[$i]; 4758: } 4759: $responseType{$partid} = \%responseIds; 4760: } 4761: $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom); 4762: 4763: } 4764: } elsif ($env{'form.lastSub'} eq 'all') { 4765: my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); 4766: $studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom, 4767: $env{'request.course.id'}, 4768: '','.submission'); 4769: 4770: } 4771: if (&canmodify($usec)) { 4772: $studentTable.=&gradeBox_start(); 4773: foreach my $partid (@{$parts}) { 4774: $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record); 4775: $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n"; 4776: $question++; 4777: } 4778: $studentTable.=&gradeBox_end(); 4779: $prob++; 4780: } 4781: $studentTable.='</td></tr>'; 4782: 4783: } 4784: $curRes = $iterator->next(); 4785: } 4786: 4787: $studentTable.= 4788: '</table>'."\n". 4789: '<input type="button" value="'.&mt('Save').'" '. 4790: 'onclick="javascript:checkSubmitPage(this.form,'.$question.');" />'. 4791: '</form>'."\n"; 4792: $request->print($studentTable); 4793: 4794: return ''; 4795: } 4796: 4797: sub displaySubByDates { 4798: my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; 4799: my $isCODE=0; 4800: my $isTask = ($symb =~/\.task$/); 4801: if (exists($record->{'resource.CODE'})) { $isCODE=1; } 4802: my $studentTable=&Apache::loncommon::start_data_table(). 4803: &Apache::loncommon::start_data_table_header_row(). 4804: '<th>'.&mt('Date/Time').'</th>'. 4805: ($isCODE?'<th>'.&mt('CODE').'</th>':''). 4806: ($isTask?'<th>'.&mt('Version').'</th>':''). 4807: '<th>'.&mt('Submission').'</th>'. 4808: '<th>'.&mt('Status').'</th>'. 4809: &Apache::loncommon::end_data_table_header_row(); 4810: my ($version); 4811: my %mark; 4812: my %orders; 4813: $mark{'correct_by_student'} = $checkIcon; 4814: if (!exists($$record{'1:timestamp'})) { 4815: return '<br /> <span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br />'; 4816: } 4817: 4818: my $interaction; 4819: my $no_increment = 1; 4820: my %lastrndseed; 4821: for ($version=1;$version<=$$record{'version'};$version++) { 4822: my $timestamp = 4823: &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'}); 4824: if (exists($$record{$version.':resource.0.version'})) { 4825: $interaction = $$record{$version.':resource.0.version'}; 4826: } 4827: if ($isTask && $env{'form.previousversion'}) { 4828: next unless ($interaction == $env{'form.previousversion'}); 4829: } 4830: my $where = ($isTask ? "$version:resource.$interaction" 4831: : "$version:resource"); 4832: $studentTable.=&Apache::loncommon::start_data_table_row(). 4833: '<td>'.$timestamp.'</td>'; 4834: if ($isCODE) { 4835: $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>'; 4836: } 4837: if ($isTask) { 4838: $studentTable.='<td>'.$interaction.'</td>'; 4839: } 4840: my @versionKeys = split(/\:/,$$record{$version.':keys'}); 4841: my @displaySub = (); 4842: foreach my $partid (@{$parts}) { 4843: my ($hidden,$type); 4844: $type = $$record{$version.':resource.'.$partid.'.type'}; 4845: if (($type eq 'anonsurvey') || ($type eq 'anonsurveycred')) { 4846: $hidden = 1; 4847: } 4848: my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys) 4849: : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); 4850: 4851: # next if ($$record{"$version:resource.$partid.solved"} eq ''); 4852: my $display_part=&get_display_part($partid,$symb); 4853: foreach my $matchKey (@matchKey) { 4854: if (exists($$record{$version.':'.$matchKey}) && 4855: $$record{$version.':'.$matchKey} ne '') { 4856: 4857: my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) 4858: : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); 4859: $displaySub[0].='<span class="LC_nobreak">'; 4860: $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>' 4861: .' <span class="LC_internal_info">' 4862: .'('.&mt('Response ID: [_1]',$responseId).')' 4863: .'</span>' 4864: .' <b>'; 4865: if ($hidden) { 4866: $displaySub[0].= &mt('Anonymous Survey').'</b>'; 4867: } else { 4868: my ($trial,$rndseed,$newvariation); 4869: if ($type eq 'randomizetry') { 4870: $trial = $$record{"$where.$partid.tries"}; 4871: $rndseed = $$record{"$where.$partid.rndseed"}; 4872: } 4873: if ($$record{"$where.$partid.tries"} eq '') { 4874: $displaySub[0].=&mt('Trial not counted'); 4875: } else { 4876: $displaySub[0].=&mt('Trial: [_1]', 4877: $$record{"$where.$partid.tries"}); 4878: if ($rndseed || $lastrndseed{$partid}) { 4879: if ($rndseed ne $lastrndseed{$partid}) { 4880: $newvariation = ' ('.&mt('New variation this try').')'; 4881: } 4882: } 4883: $lastrndseed{$partid} = $rndseed; 4884: } 4885: my $responseType=($isTask ? 'Task' 4886: : $responseType->{$partid}->{$responseId}); 4887: if (!exists($orders{$partid})) { $orders{$partid}={}; } 4888: if ((!exists($orders{$partid}->{$responseId})) || ($trial)) { 4889: $orders{$partid}->{$responseId}= 4890: &get_order($partid,$responseId,$symb,$uname,$udom, 4891: $no_increment,$type,$trial,$rndseed); 4892: } 4893: $displaySub[0].='</b>'.$newvariation.'</span>'; # /nobreak 4894: $displaySub[0].='  '. 4895: &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'<br />'; 4896: } 4897: } 4898: } 4899: if (exists($$record{"$where.$partid.checkedin"})) { 4900: $displaySub[1].=&mt('Checked in by [_1] into slot [_2]', 4901: $$record{"$where.$partid.checkedin"}, 4902: $$record{"$where.$partid.checkedin.slot"}). 4903: '<br />'; 4904: } 4905: if (exists $$record{"$where.$partid.award"}) { 4906: $displaySub[1].='<b>'.&mt('Part:').'</b> '.$display_part.'  '. 4907: lc($$record{"$where.$partid.award"}).' '. 4908: $mark{$$record{"$where.$partid.solved"}}. 4909: '<br />'; 4910: } 4911: if (exists $$record{"$where.$partid.regrader"}) { 4912: $displaySub[2].=$$record{"$where.$partid.regrader"}. 4913: ' (<b>'.&mt('Part').':</b> '.$display_part.')'; 4914: } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { 4915: $displaySub[2].= 4916: $$record{"$version:resource.$partid.regrader"}. 4917: ' (<b>'.&mt('Part').':</b> '.$display_part.')'; 4918: } 4919: } 4920: # needed because old essay regrader has not parts info 4921: if (exists $$record{"$version:resource.regrader"}) { 4922: $displaySub[2].=$$record{"$version:resource.regrader"}; 4923: } 4924: $studentTable.='<td>'.$displaySub[0].' </td><td>'.$displaySub[1]; 4925: if ($displaySub[2]) { 4926: $studentTable.=&mt('Manually graded by [_1]',$displaySub[2]); 4927: } 4928: $studentTable.=' </td>'. 4929: &Apache::loncommon::end_data_table_row(); 4930: } 4931: $studentTable.=&Apache::loncommon::end_data_table(); 4932: return $studentTable; 4933: } 4934: 4935: sub updateGradeByPage { 4936: my ($request,$symb) = @_; 4937: 4938: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 4939: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 4940: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 4941: my $pageTitle = $env{'form.page'}; 4942: my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); 4943: my ($uname,$udom) = split(/:/,$env{'form.student'}); 4944: my $usec=$classlist->{$env{'form.student'}}[5]; 4945: if (!&canmodify($usec)) { 4946: $request->print('<span class="LC_warning">'.&mt('Unable to modify requested student ([_1])',$env{'form.student'}).'</span>'); 4947: return; 4948: } 4949: my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; 4950: $result.='<h3> '.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom). 4951: '</h3>'."\n"; 4952: 4953: $request->print($result); 4954: 4955: 4956: my $navmap = Apache::lonnavmaps::navmap->new(); 4957: unless (ref($navmap)) { 4958: $request->print(&navmap_errormsg()); 4959: return; 4960: } 4961: my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'}); 4962: my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps 4963: if (!$map) { 4964: $request->print('<span class="LC_warning">'.&mt('Unable to grade requested sequence ([_1]).',$resUrl).'</span>'); 4965: return; 4966: } 4967: my $iterator = $navmap->getIterator($map->map_start(), 4968: $map->map_finish()); 4969: 4970: my $studentTable= 4971: &Apache::loncommon::start_data_table(). 4972: &Apache::loncommon::start_data_table_header_row(). 4973: '<th align="center"> '.&mt('Prob.').' </th>'. 4974: '<th> '.&mt('Title').' </th>'. 4975: '<th> '.&mt('Previous Score').' </th>'. 4976: '<th> '.&mt('New Score').' </th>'. 4977: &Apache::loncommon::end_data_table_header_row(); 4978: 4979: $iterator->next(); # skip the first BEGIN_MAP 4980: my $curRes = $iterator->next(); # for "current resource" 4981: my ($depth,$question,$prob,$changeflag)= (1,1,1,0); 4982: while ($depth > 0) { 4983: if($curRes == $iterator->BEGIN_MAP) { $depth++; } 4984: if($curRes == $iterator->END_MAP) { $depth--; } 4985: 4986: if (ref($curRes) && $curRes->is_problem()) { 4987: my $parts = $curRes->parts(); 4988: my $title = $curRes->compTitle(); 4989: my $symbx = $curRes->symb(); 4990: $studentTable.= 4991: &Apache::loncommon::start_data_table_row(). 4992: '<td align="center" valign="top" >'.$prob. 4993: (scalar(@{$parts}) == 1 ? '' 4994: : '<br />('.&mt('[quant,_1,part]',scalar(@{$parts})) 4995: .')').'</td>'; 4996: $studentTable.='<td valign="top"> <b>'.$title.'</b> </td>'; 4997: 4998: my %newrecord=(); 4999: my @displayPts=(); 5000: my %aggregate = (); 5001: my $aggregateflag = 0; 5002: foreach my $partid (@{$parts}) { 5003: my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid}; 5004: my $oldpts = $env{'form.oldpts'.$question.'_'.$partid}; 5005: 5006: my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? 5007: $env{'form.WGT'.$question.'_'.$partid} : 1; 5008: my $partial = $newpts/$wgt; 5009: my $score; 5010: if ($partial > 0) { 5011: $score = 'correct_by_override'; 5012: } elsif ($newpts ne '') { #empty is taken as 0 5013: $score = 'incorrect_by_override'; 5014: } 5015: my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid}; 5016: if ($dropMenu eq 'excused') { 5017: $partial = ''; 5018: $score = 'excused'; 5019: } elsif ($dropMenu eq 'reset status' 5020: && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists 5021: $newrecord{'resource.'.$partid.'.tries'} = 0; 5022: $newrecord{'resource.'.$partid.'.solved'} = ''; 5023: $newrecord{'resource.'.$partid.'.award'} = ''; 5024: $newrecord{'resource.'.$partid.'.awarded'} = 0; 5025: $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"; 5026: $changeflag++; 5027: $newpts = ''; 5028: 5029: my $aggtries = $env{'form.aggtries'.$question.'_'.$partid}; 5030: my $totaltries = $env{'form.totaltries'.$question.'_'.$partid}; 5031: my $solvedstatus = $env{'form.solved'.$question.'_'.$partid}; 5032: if ($aggtries > 0) { 5033: &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus); 5034: $aggregateflag = 1; 5035: } 5036: } 5037: my $display_part=&get_display_part($partid,$curRes->symb()); 5038: my $oldstatus = $env{'form.solved'.$question.'_'.$partid}; 5039: $displayPts[0].=' <b>'.&mt('Part').':</b> '.$display_part.' = '. 5040: (($oldstatus eq 'excused') ? 'excused' : $oldpts). 5041: ' <br />'; 5042: $displayPts[1].=' <b>'.&mt('Part').':</b> '.$display_part.' = '. 5043: (($score eq 'excused') ? 'excused' : $newpts). 5044: ' <br />'; 5045: $question++; 5046: next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); 5047: 5048: $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; 5049: $newrecord{'resource.'.$partid.'.solved'} = $score if $score ne ''; 5050: $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}" 5051: if (scalar(keys(%newrecord)) > 0); 5052: 5053: $changeflag++; 5054: } 5055: if (scalar(keys(%newrecord)) > 0) { 5056: my %record = 5057: &Apache::lonnet::restore($symbx,$env{'request.course.id'}, 5058: $udom,$uname); 5059: 5060: if (&Apache::lonnet::validCODE($env{'form.CODE'})) { 5061: $newrecord{'resource.CODE'} = $env{'form.CODE'}; 5062: } elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) { 5063: $newrecord{'resource.CODE'} = ''; 5064: } 5065: &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, 5066: $udom,$uname); 5067: %record = &Apache::lonnet::restore($symbx, 5068: $env{'request.course.id'}, 5069: $udom,$uname); 5070: &check_and_remove_from_queue($parts,\%record,undef,$symbx, 5071: $cdom,$cnum,$udom,$uname); 5072: } 5073: 5074: if ($aggregateflag) { 5075: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 5076: $env{'course.'.$env{'request.course.id'}.'.domain'}, 5077: $env{'course.'.$env{'request.course.id'}.'.num'}); 5078: } 5079: 5080: $studentTable.='<td valign="top">'.$displayPts[0].'</td>'. 5081: '<td valign="top">'.$displayPts[1].'</td>'. 5082: &Apache::loncommon::end_data_table_row(); 5083: 5084: $prob++; 5085: } 5086: $curRes = $iterator->next(); 5087: } 5088: 5089: $studentTable.=&Apache::loncommon::end_data_table(); 5090: my $grademsg=($changeflag == 0 ? &mt('No score was changed or updated.') : 5091: &mt('The scores were changed for [quant,_1,problem].', 5092: $changeflag)); 5093: $request->print($grademsg.$studentTable); 5094: 5095: return ''; 5096: } 5097: 5098: #-------- end of section for handling grading by page/sequence --------- 5099: # 5100: #------------------------------------------------------------------- 5101: 5102: #-------------------- Bubblesheet (Scantron) Grading ------------------- 5103: # 5104: #------ start of section for handling grading by page/sequence --------- 5105: 5106: =pod 5107: 5108: =head1 Bubble sheet grading routines 5109: 5110: For this documentation: 5111: 5112: 'scanline' refers to the full line of characters 5113: from the file that we are parsing that represents one entire sheet 5114: 5115: 'bubble line' refers to the data 5116: representing the line of bubbles that are on the physical bubblesheet 5117: 5118: 5119: The overall process is that a scanned in bubblesheet data is uploaded 5120: into a course. When a user wants to grade, they select a 5121: sequence/folder of resources, a file of bubblesheet info, and pick 5122: one of the predefined configurations for what each scanline looks 5123: like. 5124: 5125: Next each scanline is checked for any errors of either 'missing 5126: bubbles' (it's an error because it may have been mis-scanned 5127: because too light bubbling), 'double bubble' (each bubble line should 5128: have no more than one letter picked), invalid or duplicated CODE, 5129: invalid student/employee ID 5130: 5131: If the CODE option is used that determines the randomization of the 5132: homework problems, either way the student/employee ID is looked up into a 5133: username:domain. 5134: 5135: During the validation phase the instructor can choose to skip scanlines. 5136: 5137: After the validation phase, there are now 3 bubblesheet files 5138: 5139: scantron_original_filename (unmodified original file) 5140: scantron_corrected_filename (file where the corrected information has replaced the original information) 5141: scantron_skipped_filename (contains the exact text of scanlines that where skipped) 5142: 5143: Also there is a separate hash nohist_scantrondata that contains extra 5144: correction information that isn't representable in the bubblesheet 5145: file (see &scantron_getfile() for more information) 5146: 5147: After all scanlines are either valid, marked as valid or skipped, then 5148: foreach line foreach problem in the picked sequence, an ssi request is 5149: made that simulates a user submitting their selected letter(s) against 5150: the homework problem. 5151: 5152: =over 4 5153: 5154: 5155: 5156: =item defaultFormData 5157: 5158: Returns html hidden inputs used to hold context/default values. 5159: 5160: Arguments: 5161: $symb - $symb of the current resource 5162: 5163: =cut 5164: 5165: sub defaultFormData { 5166: my ($symb)=@_; 5167: return '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'; 5168: } 5169: 5170: 5171: =pod 5172: 5173: =item getSequenceDropDown 5174: 5175: Return html dropdown of possible sequences to grade 5176: 5177: Arguments: 5178: $symb - $symb of the current resource 5179: $map_error - ref to scalar which will container error if 5180: $navmap object is unavailable in &getSymbMap(). 5181: 5182: =cut 5183: 5184: sub getSequenceDropDown { 5185: my ($symb,$map_error)=@_; 5186: my $result='<select name="selectpage">'."\n"; 5187: my ($titles,$symbx) = &getSymbMap($map_error); 5188: if (ref($map_error)) { 5189: return if ($$map_error); 5190: } 5191: my ($curpage)=&Apache::lonnet::decode_symb($symb); 5192: my $ctr=0; 5193: foreach (@$titles) { 5194: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 5195: $result.='<option value="'.$$symbx{$_}.'" '. 5196: ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : ''). 5197: '>'.$showtitle.'</option>'."\n"; 5198: $ctr++; 5199: } 5200: $result.= '</select>'; 5201: return $result; 5202: } 5203: 5204: my %bubble_lines_per_response; # no. bubble lines for each response. 5205: # key is zero-based index - 0, 1, 2 ... 5206: 5207: my %first_bubble_line; # First bubble line no. for each bubble. 5208: 5209: my %subdivided_bubble_lines; # no. bubble lines for optionresponse, 5210: # matchresponse or rankresponse, where 5211: # an individual response can have multiple 5212: # lines 5213: 5214: my %responsetype_per_response; # responsetype for each response 5215: 5216: my %masterseq_id_responsenum; # src_id (e.g., 12.3_0.11 etc.) for each 5217: # numbered response. Needed when randomorder 5218: # or randompick are in use. Key is ID, value 5219: # is response number. 5220: 5221: # Save and restore the bubble lines array to the form env. 5222: 5223: 5224: sub save_bubble_lines { 5225: foreach my $line (keys(%bubble_lines_per_response)) { 5226: $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; 5227: $env{"form.scantron.first_bubble_line.$line"} = 5228: $first_bubble_line{$line}; 5229: $env{"form.scantron.sub_bubblelines.$line"} = 5230: $subdivided_bubble_lines{$line}; 5231: $env{"form.scantron.responsetype.$line"} = 5232: $responsetype_per_response{$line}; 5233: } 5234: foreach my $resid (keys(%masterseq_id_responsenum)) { 5235: my $line = $masterseq_id_responsenum{$resid}; 5236: $env{"form.scantron.residpart.$line"} = $resid; 5237: } 5238: } 5239: 5240: 5241: sub restore_bubble_lines { 5242: my $line = 0; 5243: %bubble_lines_per_response = (); 5244: %masterseq_id_responsenum = (); 5245: while ($env{"form.scantron.bubblelines.$line"}) { 5246: my $value = $env{"form.scantron.bubblelines.$line"}; 5247: $bubble_lines_per_response{$line} = $value; 5248: $first_bubble_line{$line} = 5249: $env{"form.scantron.first_bubble_line.$line"}; 5250: $subdivided_bubble_lines{$line} = 5251: $env{"form.scantron.sub_bubblelines.$line"}; 5252: $responsetype_per_response{$line} = 5253: $env{"form.scantron.responsetype.$line"}; 5254: my $id = $env{"form.scantron.residpart.$line"}; 5255: $masterseq_id_responsenum{$id} = $line; 5256: $line++; 5257: } 5258: } 5259: 5260: =pod 5261: 5262: =item scantron_filenames 5263: 5264: Returns a list of the scantron files in the current course 5265: 5266: =cut 5267: 5268: sub scantron_filenames { 5269: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 5270: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 5271: my $getpropath = 1; 5272: my ($dirlist,$listerror) = &Apache::lonnet::dirlist('userfiles',$cdom, 5273: $cname,$getpropath); 5274: my @possiblenames; 5275: if (ref($dirlist) eq 'ARRAY') { 5276: foreach my $filename (sort(@{$dirlist})) { 5277: ($filename)=split(/&/,$filename); 5278: if ($filename!~/^scantron_orig_/) { next ; } 5279: $filename=~s/^scantron_orig_//; 5280: push(@possiblenames,$filename); 5281: } 5282: } 5283: return @possiblenames; 5284: } 5285: 5286: =pod 5287: 5288: =item scantron_uploads 5289: 5290: Returns html drop-down list of scantron files in current course. 5291: 5292: Arguments: 5293: $file2grade - filename to set as selected in the dropdown 5294: 5295: =cut 5296: 5297: sub scantron_uploads { 5298: my ($file2grade) = @_; 5299: my $result= '<select name="scantron_selectfile">'; 5300: $result.="<option></option>"; 5301: foreach my $filename (sort(&scantron_filenames())) { 5302: $result.="<option".($filename eq $file2grade ? ' selected="selected"':'').">$filename</option>\n"; 5303: } 5304: $result.="</select>"; 5305: return $result; 5306: } 5307: 5308: =pod 5309: 5310: =item scantron_scantab 5311: 5312: Returns html drop down of the scantron formats in the scantronformat.tab 5313: file. 5314: 5315: =cut 5316: 5317: sub scantron_scantab { 5318: my $result='<select name="scantron_format">'."\n"; 5319: $result.='<option></option>'."\n"; 5320: my @lines = &get_scantronformat_file(); 5321: if (@lines > 0) { 5322: foreach my $line (@lines) { 5323: next if (($line =~ /^\#/) || ($line eq '')); 5324: my ($name,$descrip)=split(/:/,$line); 5325: $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n"; 5326: } 5327: } 5328: $result.='</select>'."\n"; 5329: return $result; 5330: } 5331: 5332: =pod 5333: 5334: =item get_scantronformat_file 5335: 5336: Returns an array containing lines from the scantron format file for 5337: the domain of the course. 5338: 5339: If a url for a custom.tab file is listed in domain's configuration.db, 5340: lines are from this file. 5341: 5342: Otherwise, if a default.tab has been published in RES space by the 5343: domainconfig user, lines are from this file. 5344: 5345: Otherwise, fall back to getting lines from the legacy file on the 5346: local server: /home/httpd/lonTabs/default_scantronformat.tab 5347: 5348: =cut 5349: 5350: sub get_scantronformat_file { 5351: my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; 5352: my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom); 5353: my $gottab = 0; 5354: my @lines; 5355: if (ref($domconfig{'scantron'}) eq 'HASH') { 5356: if ($domconfig{'scantron'}{'scantronformat'} ne '') { 5357: my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'}); 5358: if ($formatfile ne '-1') { 5359: @lines = split("\n",$formatfile,-1); 5360: $gottab = 1; 5361: } 5362: } 5363: } 5364: if (!$gottab) { 5365: my $confname = $cdom.'-domainconfig'; 5366: my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab'; 5367: my $formatfile = &Apache::lonnet::getfile($default); 5368: if ($formatfile ne '-1') { 5369: @lines = split("\n",$formatfile,-1); 5370: $gottab = 1; 5371: } 5372: } 5373: if (!$gottab) { 5374: my @domains = &Apache::lonnet::current_machine_domains(); 5375: if (grep(/^\Q$cdom\E$/,@domains)) { 5376: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); 5377: @lines = <$fh>; 5378: close($fh); 5379: } else { 5380: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab'); 5381: @lines = <$fh>; 5382: close($fh); 5383: } 5384: } 5385: return @lines; 5386: } 5387: 5388: =pod 5389: 5390: =item scantron_CODElist 5391: 5392: Returns html drop down of the saved CODE lists from current course, 5393: generated from earlier printings. 5394: 5395: =cut 5396: 5397: sub scantron_CODElist { 5398: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 5399: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 5400: my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum); 5401: my $namechoice='<option></option>'; 5402: foreach my $name (sort {uc($a) cmp uc($b)} @names) { 5403: if ($name =~ /^error: 2 /) { next; } 5404: if ($name =~ /^type\0/) { next; } 5405: $namechoice.='<option value="'.$name.'">'.$name.'</option>'; 5406: } 5407: $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>'; 5408: return $namechoice; 5409: } 5410: 5411: =pod 5412: 5413: =item scantron_CODEunique 5414: 5415: Returns the html for "Each CODE to be used once" radio. 5416: 5417: =cut 5418: 5419: sub scantron_CODEunique { 5420: my $result='<span class="LC_nobreak"> 5421: <label><input type="radio" name="scantron_CODEunique" 5422: value="yes" checked="checked" />'.&mt('Yes').' </label> 5423: </span> 5424: <span class="LC_nobreak"> 5425: <label><input type="radio" name="scantron_CODEunique" 5426: value="no" />'.&mt('No').' </label> 5427: </span>'; 5428: return $result; 5429: } 5430: 5431: =pod 5432: 5433: =item scantron_selectphase 5434: 5435: Generates the initial screen to start the bubblesheet process. 5436: Allows for - starting a grading run. 5437: - downloading existing scan data (original, corrected 5438: or skipped info) 5439: 5440: - uploading new scan data 5441: 5442: Arguments: 5443: $r - The Apache request object 5444: $file2grade - name of the file that contain the scanned data to score 5445: 5446: =cut 5447: 5448: sub scantron_selectphase { 5449: my ($r,$file2grade,$symb) = @_; 5450: if (!$symb) {return '';} 5451: my $map_error; 5452: my $sequence_selector=&getSequenceDropDown($symb,\$map_error); 5453: if ($map_error) { 5454: $r->print('<br />'.&navmap_errormsg().'<br />'); 5455: return; 5456: } 5457: my $default_form_data=&defaultFormData($symb); 5458: my $file_selector=&scantron_uploads($file2grade); 5459: my $format_selector=&scantron_scantab(); 5460: my $CODE_selector=&scantron_CODElist(); 5461: my $CODE_unique=&scantron_CODEunique(); 5462: my $result; 5463: 5464: $ssi_error = 0; 5465: 5466: if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || 5467: &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { 5468: 5469: # Chunk of form to prompt for a scantron file upload. 5470: 5471: $r->print(' 5472: <br /> 5473: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 5474: '.&Apache::loncommon::start_data_table_header_row().' 5475: <th> 5476:  '.&mt('Specify a bubblesheet data file to upload.').' 5477: </th> 5478: '.&Apache::loncommon::end_data_table_header_row().' 5479: '.&Apache::loncommon::start_data_table_row().' 5480: <td> 5481: '); 5482: my $default_form_data=&defaultFormData($symb); 5483: my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; 5484: my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'}; 5485: $r->print(&Apache::lonhtmlcommon::scripttag(' 5486: function checkUpload(formname) { 5487: if (formname.upfile.value == "") { 5488: alert("'.&mt('Please use the browse button to select a file from your local directory.').'"); 5489: return false; 5490: } 5491: formname.submit(); 5492: }')); 5493: $r->print(' 5494: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post"> 5495: '.$default_form_data.' 5496: <input name="courseid" type="hidden" value="'.$cnum.'" /> 5497: <input name="domainid" type="hidden" value="'.$cdom.'" /> 5498: <input name="command" value="scantronupload_save" type="hidden" /> 5499: '.&mt('File to upload: [_1]','<input type="file" name="upfile" size="50" />').' 5500: <br /> 5501: <input type="button" onclick="javascript:checkUpload(this.form);" value="'.&mt('Upload Bubblesheet Data').'" /> 5502: </form> 5503: '); 5504: 5505: $r->print(' 5506: </td> 5507: '.&Apache::loncommon::end_data_table_row().' 5508: '.&Apache::loncommon::end_data_table().' 5509: '); 5510: } 5511: 5512: # Chunk of form to prompt for a file to grade and how: 5513: 5514: $result.= ' 5515: <br /> 5516: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process"> 5517: <input type="hidden" name="command" value="scantron_warning" /> 5518: '.$default_form_data.' 5519: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 5520: '.&Apache::loncommon::start_data_table_header_row().' 5521: <th colspan="2"> 5522:  '.&mt('Specify file and which Folder/Sequence to grade').' 5523: </th> 5524: '.&Apache::loncommon::end_data_table_header_row().' 5525: '.&Apache::loncommon::start_data_table_row().' 5526: <td> '.&mt('Sequence to grade:').' </td><td> '.$sequence_selector.' </td> 5527: '.&Apache::loncommon::end_data_table_row().' 5528: '.&Apache::loncommon::start_data_table_row().' 5529: <td> '.&mt('Filename of bubblesheet data file:').' </td><td> '.$file_selector.' </td> 5530: '.&Apache::loncommon::end_data_table_row().' 5531: '.&Apache::loncommon::start_data_table_row().' 5532: <td> '.&mt('Format of bubblesheet data file:').' </td><td> '.$format_selector.' </td> 5533: '.&Apache::loncommon::end_data_table_row().' 5534: '.&Apache::loncommon::start_data_table_row().' 5535: <td> '.&mt('Saved CODEs to validate against:').' </td><td> '.$CODE_selector.' </td> 5536: '.&Apache::loncommon::end_data_table_row().' 5537: '.&Apache::loncommon::start_data_table_row().' 5538: <td> '.&mt('Each CODE is only to be used once:').'</td><td> '.$CODE_unique.' </td> 5539: '.&Apache::loncommon::end_data_table_row().' 5540: '.&Apache::loncommon::start_data_table_row().' 5541: <td> '.&mt('Options:').' </td> 5542: <td> 5543: <label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> '.&mt('Do only previously skipped records').'</label> <br /> 5544: <label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> '.&mt('Remove all existing corrections').'</label> <br /> 5545: <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources when grading').'</label> 5546: </td> 5547: '.&Apache::loncommon::end_data_table_row().' 5548: '.&Apache::loncommon::start_data_table_row().' 5549: <td colspan="2"> 5550: <input type="submit" value="'.&mt('Grading: Validate Bubblesheet Records').'" /> 5551: </td> 5552: '.&Apache::loncommon::end_data_table_row().' 5553: '.&Apache::loncommon::end_data_table().' 5554: </form> 5555: '; 5556: 5557: $r->print($result); 5558: 5559: 5560: 5561: # Chunk of the form that prompts to view a scoring office file, 5562: # corrected file, skipped records in a file. 5563: 5564: $r->print(' 5565: <br /> 5566: <form action="/adm/grades" name="scantron_download"> 5567: '.$default_form_data.' 5568: <input type="hidden" name="command" value="scantron_download" /> 5569: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 5570: '.&Apache::loncommon::start_data_table_header_row().' 5571: <th> 5572:  '.&mt('Download a scoring office file').' 5573: </th> 5574: '.&Apache::loncommon::end_data_table_header_row().' 5575: '.&Apache::loncommon::start_data_table_row().' 5576: <td> '.&mt('Filename of scoring office file: [_1]',$file_selector).' 5577: <br /> 5578: <input type="submit" value="'.&mt('Download: Show List of Associated Files').'" /> 5579: '.&Apache::loncommon::end_data_table_row().' 5580: '.&Apache::loncommon::end_data_table().' 5581: </form> 5582: <br /> 5583: '); 5584: 5585: &Apache::lonpickcode::code_list($r,2); 5586: 5587: $r->print('<br /><form method="post" name="checkscantron" action="">'. 5588: $default_form_data."\n". 5589: &Apache::loncommon::start_data_table('LC_scantron_action')."\n". 5590: &Apache::loncommon::start_data_table_header_row()."\n". 5591: '<th colspan="2"> 5592:  '.&mt('Review bubblesheet data and submissions for a previously graded folder/sequence')."\n". 5593: '</th>'."\n". 5594: &Apache::loncommon::end_data_table_header_row()."\n". 5595: &Apache::loncommon::start_data_table_row()."\n". 5596: '<td> '.&mt('Graded folder/sequence:').' </td>'."\n". 5597: '<td> '.$sequence_selector.' </td>'. 5598: &Apache::loncommon::end_data_table_row()."\n". 5599: &Apache::loncommon::start_data_table_row()."\n". 5600: '<td> '.&mt('Filename of scoring office file:').' </td>'."\n". 5601: '<td> '.$file_selector.' </td>'."\n". 5602: &Apache::loncommon::end_data_table_row()."\n". 5603: &Apache::loncommon::start_data_table_row()."\n". 5604: '<td> '.&mt('Format of data file:').' </td>'."\n". 5605: '<td> '.$format_selector.' </td>'."\n". 5606: &Apache::loncommon::end_data_table_row()."\n". 5607: &Apache::loncommon::start_data_table_row()."\n". 5608: '<td> '.&mt('Options').' </td>'."\n". 5609: '<td> <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources').'</label></td>'. 5610: &Apache::loncommon::end_data_table_row()."\n". 5611: &Apache::loncommon::start_data_table_row()."\n". 5612: '<td colspan="2">'."\n". 5613: '<input type="hidden" name="command" value="checksubmissions" />'."\n". 5614: '<input type="submit" value="'.&mt('Review Bubblesheet Data and Submission Records').'" />'."\n". 5615: '</td>'."\n". 5616: &Apache::loncommon::end_data_table_row()."\n". 5617: &Apache::loncommon::end_data_table()."\n". 5618: '</form><br />'); 5619: return; 5620: } 5621: 5622: =pod 5623: 5624: =item get_scantron_config 5625: 5626: Parse and return the bubblesheet configuration line selected as a 5627: hash of configuration file fields. 5628: 5629: Arguments: 5630: which - the name of the configuration to parse from the file. 5631: 5632: 5633: Returns: 5634: If the named configuration is not in the file, an empty 5635: hash is returned. 5636: a hash with the fields 5637: name - internal name for the this configuration setup 5638: description - text to display to operator that describes this config 5639: CODElocation - if 0 or the string 'none' 5640: - no CODE exists for this config 5641: if -1 || the string 'letter' 5642: - a CODE exists for this config and is 5643: a string of letters 5644: Unsupported value (but planned for future support) 5645: if a positive integer 5646: - The CODE exists as the first n items from 5647: the question section of the form 5648: if the string 'number' 5649: - The CODE exists for this config and is 5650: a string of numbers 5651: CODEstart - (only matter if a CODE exists) column in the line where 5652: the CODE starts 5653: CODElength - length of the CODE 5654: IDstart - column where the student/employee ID starts 5655: IDlength - length of the student/employee ID info 5656: Qstart - column where the information from the bubbled 5657: 'questions' start 5658: Qlength - number of columns comprising a single bubble line from 5659: the sheet. (usually either 1 or 10) 5660: Qon - either a single character representing the character used 5661: to signal a bubble was chosen in the positional setup, or 5662: the string 'letter' if the letter of the chosen bubble is 5663: in the final, or 'number' if a number representing the 5664: chosen bubble is in the file (1->A 0->J) 5665: Qoff - the character used to represent that a bubble was 5666: left blank 5667: PaperID - if the scanning process generates a unique number for each 5668: sheet scanned the column that this ID number starts in 5669: PaperIDlength - number of columns that comprise the unique ID number 5670: for the sheet of paper 5671: FirstName - column that the first name starts in 5672: FirstNameLength - number of columns that the first name spans 5673: 5674: LastName - column that the last name starts in 5675: LastNameLength - number of columns that the last name spans 5676: BubblesPerRow - number of bubbles available in each row used to 5677: bubble an answer. (If not specified, 10 assumed). 5678: 5679: =cut 5680: 5681: sub get_scantron_config { 5682: my ($which) = @_; 5683: my @lines = &get_scantronformat_file(); 5684: my %config; 5685: #FIXME probably should move to XML it has already gotten a bit much now 5686: foreach my $line (@lines) { 5687: my ($name,$descrip)=split(/:/,$line); 5688: if ($name ne $which ) { next; } 5689: chomp($line); 5690: my @config=split(/:/,$line); 5691: $config{'name'}=$config[0]; 5692: $config{'description'}=$config[1]; 5693: $config{'CODElocation'}=$config[2]; 5694: $config{'CODEstart'}=$config[3]; 5695: $config{'CODElength'}=$config[4]; 5696: $config{'IDstart'}=$config[5]; 5697: $config{'IDlength'}=$config[6]; 5698: $config{'Qstart'}=$config[7]; 5699: $config{'Qlength'}=$config[8]; 5700: $config{'Qoff'}=$config[9]; 5701: $config{'Qon'}=$config[10]; 5702: $config{'PaperID'}=$config[11]; 5703: $config{'PaperIDlength'}=$config[12]; 5704: $config{'FirstName'}=$config[13]; 5705: $config{'FirstNamelength'}=$config[14]; 5706: $config{'LastName'}=$config[15]; 5707: $config{'LastNamelength'}=$config[16]; 5708: $config{'BubblesPerRow'}=$config[17]; 5709: last; 5710: } 5711: return %config; 5712: } 5713: 5714: =pod 5715: 5716: =item username_to_idmap 5717: 5718: creates a hash keyed by student/employee ID with values of the corresponding 5719: student username:domain. 5720: 5721: Arguments: 5722: 5723: $classlist - reference to the class list hash. This is a hash 5724: keyed by student name:domain whose elements are references 5725: to arrays containing various chunks of information 5726: about the student. (See loncoursedata for more info). 5727: 5728: Returns 5729: %idmap - the constructed hash 5730: 5731: =cut 5732: 5733: sub username_to_idmap { 5734: my ($classlist)= @_; 5735: my %idmap; 5736: foreach my $student (keys(%$classlist)) { 5737: $idmap{$classlist->{$student}->[&Apache::loncoursedata::CL_ID]}= 5738: $student; 5739: } 5740: return %idmap; 5741: } 5742: 5743: =pod 5744: 5745: =item scantron_fixup_scanline 5746: 5747: Process a requested correction to a scanline. 5748: 5749: Arguments: 5750: $scantron_config - hash from &get_scantron_config() 5751: $scan_data - hash of correction information 5752: (see &scantron_getfile()) 5753: $line - existing scanline 5754: $whichline - line number of the passed in scanline 5755: $field - type of change to process 5756: (either 5757: 'ID' -> correct the student/employee ID 5758: 'CODE' -> correct the CODE 5759: 'answer' -> fixup the submitted answers) 5760: 5761: $args - hash of additional info, 5762: - 'ID' 5763: 'newid' -> studentID to use in replacement 5764: of existing one 5765: - 'CODE' 5766: 'CODE_ignore_dup' - set to true if duplicates 5767: should be ignored. 5768: 'CODE' - is new code or 'use_unfound' 5769: if the existing unfound code should 5770: be used as is 5771: - 'answer' 5772: 'response' - new answer or 'none' if blank 5773: 'question' - the bubble line to change 5774: 'questionnum' - the question identifier, 5775: may include subquestion. 5776: 5777: Returns: 5778: $line - the modified scanline 5779: 5780: Side effects: 5781: $scan_data - may be updated 5782: 5783: =cut 5784: 5785: 5786: sub scantron_fixup_scanline { 5787: my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; 5788: if ($field eq 'ID') { 5789: if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { 5790: return ($line,1,'New value too large'); 5791: } 5792: if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { 5793: $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', 5794: $args->{'newid'}); 5795: } 5796: substr($line,$$scantron_config{'IDstart'}-1, 5797: $$scantron_config{'IDlength'})=$args->{'newid'}; 5798: if ($args->{'newid'}=~/^\s*$/) { 5799: &scan_data($scan_data,"$whichline.user", 5800: $args->{'username'}.':'.$args->{'domain'}); 5801: } 5802: } elsif ($field eq 'CODE') { 5803: if ($args->{'CODE_ignore_dup'}) { 5804: &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); 5805: } 5806: &scan_data($scan_data,"$whichline.useCODE",'1'); 5807: if ($args->{'CODE'} ne 'use_unfound') { 5808: if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { 5809: return ($line,1,'New CODE value too large'); 5810: } 5811: if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) { 5812: $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'}); 5813: } 5814: substr($line,$$scantron_config{'CODEstart'}-1, 5815: $$scantron_config{'CODElength'})=$args->{'CODE'}; 5816: } 5817: } elsif ($field eq 'answer') { 5818: my $length=$scantron_config->{'Qlength'}; 5819: my $off=$scantron_config->{'Qoff'}; 5820: my $on=$scantron_config->{'Qon'}; 5821: my $answer=${off}x$length; 5822: if ($args->{'response'} eq 'none') { 5823: &scan_data($scan_data, 5824: "$whichline.no_bubble.".$args->{'questionnum'},'1'); 5825: } else { 5826: if ($on eq 'letter') { 5827: my @alphabet=('A'..'Z'); 5828: $answer=$alphabet[$args->{'response'}]; 5829: } elsif ($on eq 'number') { 5830: $answer=$args->{'response'}+1; 5831: if ($answer == 10) { $answer = '0'; } 5832: } else { 5833: substr($answer,$args->{'response'},1)=$on; 5834: } 5835: &scan_data($scan_data, 5836: "$whichline.no_bubble.".$args->{'questionnum'},undef,'1'); 5837: } 5838: my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; 5839: substr($line,$where-1,$length)=$answer; 5840: } 5841: return $line; 5842: } 5843: 5844: =pod 5845: 5846: =item scan_data 5847: 5848: Edit or look up an item in the scan_data hash. 5849: 5850: Arguments: 5851: $scan_data - The hash (see scantron_getfile) 5852: $key - shorthand of the key to edit (actual key is 5853: scantronfilename_key). 5854: $data - New value of the hash entry. 5855: $delete - If true, the entry is removed from the hash. 5856: 5857: Returns: 5858: The new value of the hash table field (undefined if deleted). 5859: 5860: =cut 5861: 5862: 5863: sub scan_data { 5864: my ($scan_data,$key,$value,$delete)=@_; 5865: my $filename=$env{'form.scantron_selectfile'}; 5866: if (defined($value)) { 5867: $scan_data->{$filename.'_'.$key} = $value; 5868: } 5869: if ($delete) { delete($scan_data->{$filename.'_'.$key}); } 5870: return $scan_data->{$filename.'_'.$key}; 5871: } 5872: 5873: # ----- These first few routines are general use routines.---- 5874: 5875: # Return the number of occurences of a pattern in a string. 5876: 5877: sub occurence_count { 5878: my ($string, $pattern) = @_; 5879: 5880: my @matches = ($string =~ /$pattern/g); 5881: 5882: return scalar(@matches); 5883: } 5884: 5885: 5886: # Take a string known to have digits and convert all the 5887: # digits into letters in the range J,A..I. 5888: 5889: sub digits_to_letters { 5890: my ($input) = @_; 5891: 5892: my @alphabet = ('J', 'A'..'I'); 5893: 5894: my @input = split(//, $input); 5895: my $output =''; 5896: for (my $i = 0; $i < scalar(@input); $i++) { 5897: if ($input[$i] =~ /\d/) { 5898: $output .= $alphabet[$input[$i]]; 5899: } else { 5900: $output .= $input[$i]; 5901: } 5902: } 5903: return $output; 5904: } 5905: 5906: =pod 5907: 5908: =item scantron_parse_scanline 5909: 5910: Decodes a scanline from the selected bubblesheet file 5911: 5912: Arguments: 5913: line - The text of the bubblesheet file line to process 5914: whichline - Line number 5915: scantron_config - Hash describing the format of the bubblesheet lines. 5916: scan_data - Hash of extra information about the scanline 5917: (see scantron_getfile for more information) 5918: just_header - True if should not process question answers but only 5919: the stuff to the left of the answers. 5920: randomorder - True if randomorder in use 5921: randompick - True if randompick in use 5922: sequence - Exam folder URL 5923: master_seq - Ref to array containing symbs in exam folder 5924: symb_to_resource - Ref to hash of symbs for resources in exam folder 5925: (corresponding values are resource objects) 5926: partids_by_symb - Ref to hash of symb -> array ref of partIDs 5927: orderedforcode - Ref to hash of arrays. keys are CODEs and values 5928: are refs to an array of resource objects, ordered 5929: according to order used for CODE, when randomorder 5930: and or randompick are in use. 5931: respnumlookup - Ref to hash mapping question numbers in bubble lines 5932: for current line to question number used for same question 5933: in "Master Sequence" (as seen by Course Coordinator). 5934: startline - Ref to hash where key is question number (0 is first) 5935: and value is number of first bubble line for current 5936: student or code-based randompick and/or randomorder. 5937: totalref - Ref of scalar used to score total number of bubble 5938: lines needed for responses in a scan line (used when 5939: randompick in use. 5940: 5941: Returns: 5942: Hash containing the result of parsing the scanline 5943: 5944: Keys are all proceeded by the string 'scantron.' 5945: 5946: CODE - the CODE in use for this scanline 5947: useCODE - 1 if the CODE is invalid but it usage has been forced 5948: by the operator 5949: CODE_ignore_dup - 1 if the CODE is a duplicated use when unique 5950: CODEs were selected, but the usage has been 5951: forced by the operator 5952: ID - student/employee ID 5953: PaperID - if used, the ID number printed on the sheet when the 5954: paper was scanned 5955: FirstName - first name from the sheet 5956: LastName - last name from the sheet 5957: 5958: if just_header was not true these key may also exist 5959: 5960: missingerror - a list of bubble ranges that are considered to be answers 5961: to a single question that don't have any bubbles filled in. 5962: Of the form questionnumber:firstbubblenumber:count. 5963: doubleerror - a list of bubble ranges that are considered to be answers 5964: to a single question that have more than one bubble filled in. 5965: Of the form questionnumber::firstbubblenumber:count 5966: 5967: In the above, count is the number of bubble responses in the 5968: input line needed to represent the possible answers to the question. 5969: e.g. a radioresponse with 15 choices in an answer sheet with 10 choices 5970: per line would have count = 2. 5971: 5972: maxquest - the number of the last bubble line that was parsed 5973: 5974: (<number> starts at 1) 5975: <number>.answer - zero or more letters representing the selected 5976: letters from the scanline for the bubble line 5977: <number>. 5978: if blank there was either no bubble or there where 5979: multiple bubbles, (consult the keys missingerror and 5980: doubleerror if this is an error condition) 5981: 5982: =cut 5983: 5984: sub scantron_parse_scanline { 5985: my ($line,$whichline,$scantron_config,$scan_data,$just_header,$idmap, 5986: $randomorder,$randompick,$sequence,$master_seq,$symb_to_resource, 5987: $partids_by_symb,$orderedforcode,$respnumlookup,$startline,$totalref)=@_; 5988: 5989: my %record; 5990: my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # stuff before answers 5991: if (!($$scantron_config{'CODElocation'} eq 0 || 5992: $$scantron_config{'CODElocation'} eq 'none')) { 5993: if ($$scantron_config{'CODElocation'} < 0 || 5994: $$scantron_config{'CODElocation'} eq 'letter' || 5995: $$scantron_config{'CODElocation'} eq 'number') { 5996: $record{'scantron.CODE'}=substr($data, 5997: $$scantron_config{'CODEstart'}-1, 5998: $$scantron_config{'CODElength'}); 5999: if (&scan_data($scan_data,"$whichline.useCODE")) { 6000: $record{'scantron.useCODE'}=1; 6001: } 6002: if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) { 6003: $record{'scantron.CODE_ignore_dup'}=1; 6004: } 6005: } else { 6006: #FIXME interpret first N questions 6007: } 6008: } 6009: $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, 6010: $$scantron_config{'IDlength'}); 6011: $record{'scantron.PaperID'}= 6012: substr($data,$$scantron_config{'PaperID'}-1, 6013: $$scantron_config{'PaperIDlength'}); 6014: $record{'scantron.FirstName'}= 6015: substr($data,$$scantron_config{'FirstName'}-1, 6016: $$scantron_config{'FirstNamelength'}); 6017: $record{'scantron.LastName'}= 6018: substr($data,$$scantron_config{'LastName'}-1, 6019: $$scantron_config{'LastNamelength'}); 6020: if ($just_header) { return \%record; } 6021: 6022: my @alphabet=('A'..'Z'); 6023: my $questnum=0; 6024: my $ansnum =1; # Multiple 'answer lines'/question. 6025: 6026: my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'}; 6027: if ($randompick || $randomorder) { 6028: my $total = &get_respnum_lookups($sequence,$scan_data,$idmap,$line,\%record, 6029: $master_seq,$symb_to_resource, 6030: $partids_by_symb,$orderedforcode, 6031: $respnumlookup,$startline); 6032: if ($total) { 6033: $lastpos = $total*$$scantron_config{'Qlength'}; 6034: } 6035: if (ref($totalref)) { 6036: $$totalref = $total; 6037: } 6038: } 6039: my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos); # Answers 6040: chomp($questions); # Get rid of any trailing \n. 6041: $questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads). 6042: while (length($questions)) { 6043: my $answers_needed; 6044: if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { 6045: $answers_needed = $bubble_lines_per_response{$respnumlookup->{$questnum}}; 6046: } else { 6047: $answers_needed = $bubble_lines_per_response{$questnum}; 6048: } 6049: my $answer_length = ($$scantron_config{'Qlength'} * $answers_needed) 6050: || 1; 6051: $questnum++; 6052: my $quest_id = $questnum; 6053: my $currentquest = substr($questions,0,$answer_length); 6054: $questions = substr($questions,$answer_length); 6055: if (length($currentquest) < $answer_length) { next; } 6056: 6057: my $subdivided; 6058: if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { 6059: $subdivided = $subdivided_bubble_lines{$respnumlookup->{$questnum-1}}; 6060: } else { 6061: $subdivided = $subdivided_bubble_lines{$questnum-1}; 6062: } 6063: if ($subdivided =~ /,/) { 6064: my $subquestnum = 1; 6065: my $subquestions = $currentquest; 6066: my @subanswers_needed = split(/,/,$subdivided); 6067: foreach my $subans (@subanswers_needed) { 6068: my $subans_length = 6069: ($$scantron_config{'Qlength'} * $subans) || 1; 6070: my $currsubquest = substr($subquestions,0,$subans_length); 6071: $subquestions = substr($subquestions,$subans_length); 6072: $quest_id = "$questnum.$subquestnum"; 6073: if (($$scantron_config{'Qon'} eq 'letter') || 6074: ($$scantron_config{'Qon'} eq 'number')) { 6075: $ansnum = &scantron_validator_lettnum($ansnum, 6076: $questnum,$quest_id,$subans,$currsubquest,$whichline, 6077: \@alphabet,\%record,$scantron_config,$scan_data, 6078: $randomorder,$randompick,$respnumlookup); 6079: } else { 6080: $ansnum = &scantron_validator_positional($ansnum, 6081: $questnum,$quest_id,$subans,$currsubquest,$whichline, 6082: \@alphabet,\%record,$scantron_config,$scan_data, 6083: $randomorder,$randompick,$respnumlookup); 6084: } 6085: $subquestnum ++; 6086: } 6087: } else { 6088: if (($$scantron_config{'Qon'} eq 'letter') || 6089: ($$scantron_config{'Qon'} eq 'number')) { 6090: $ansnum = &scantron_validator_lettnum($ansnum,$questnum, 6091: $quest_id,$answers_needed,$currentquest,$whichline, 6092: \@alphabet,\%record,$scantron_config,$scan_data, 6093: $randomorder,$randompick,$respnumlookup); 6094: } else { 6095: $ansnum = &scantron_validator_positional($ansnum,$questnum, 6096: $quest_id,$answers_needed,$currentquest,$whichline, 6097: \@alphabet,\%record,$scantron_config,$scan_data, 6098: $randomorder,$randompick,$respnumlookup); 6099: } 6100: } 6101: } 6102: $record{'scantron.maxquest'}=$questnum; 6103: return \%record; 6104: } 6105: 6106: sub get_master_seq { 6107: my ($resources,$master_seq,$symb_to_resource) = @_; 6108: return unless ((ref($resources) eq 'ARRAY') && (ref($master_seq) eq 'ARRAY') && 6109: (ref($symb_to_resource) eq 'HASH')); 6110: my $resource_error; 6111: foreach my $resource (@{$resources}) { 6112: my $ressymb; 6113: if (ref($resource)) { 6114: $ressymb = $resource->symb(); 6115: push(@{$master_seq},$ressymb); 6116: $symb_to_resource->{$ressymb} = $resource; 6117: } else { 6118: $resource_error = 1; 6119: last; 6120: } 6121: } 6122: return $resource_error; 6123: } 6124: 6125: sub get_respnum_lookups { 6126: my ($sequence,$scan_data,$idmap,$line,$record,$master_seq,$symb_to_resource, 6127: $partids_by_symb,$orderedforcode,$respnumlookup,$startline) = @_; 6128: return unless ((ref($record) eq 'HASH') && (ref($master_seq) eq 'ARRAY') && 6129: (ref($symb_to_resource) eq 'HASH') && (ref($partids_by_symb) eq 'HASH') && 6130: (ref($orderedforcode) eq 'HASH') && (ref($respnumlookup) eq 'HASH') && 6131: (ref($startline) eq 'HASH')); 6132: my ($user,$scancode); 6133: if ((exists($record->{'scantron.CODE'})) && 6134: (&Apache::lonnet::validCODE($record->{'scantron.CODE'}))) { 6135: $scancode = $record->{'scantron.CODE'}; 6136: } else { 6137: $user = &scantron_find_student($record,$scan_data,$idmap,$line); 6138: } 6139: my @mapresources = 6140: &users_order($user,$scancode,$sequence,$master_seq,$symb_to_resource, 6141: $orderedforcode); 6142: my $total = 0; 6143: my $count = 0; 6144: foreach my $resource (@mapresources) { 6145: my $id = $resource->id(); 6146: my $symb = $resource->symb(); 6147: if (ref($partids_by_symb->{$symb}) eq 'ARRAY') { 6148: foreach my $partid (@{$partids_by_symb->{$symb}}) { 6149: my $respnum = $masterseq_id_responsenum{$id.'_'.$partid}; 6150: if ($respnum ne '') { 6151: $respnumlookup->{$count} = $respnum; 6152: $startline->{$count} = $total; 6153: $total += $bubble_lines_per_response{$respnum}; 6154: $count ++; 6155: } 6156: } 6157: } 6158: } 6159: return $total; 6160: } 6161: 6162: sub scantron_validator_lettnum { 6163: my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline, 6164: $alphabet,$record,$scantron_config,$scan_data,$randomorder, 6165: $randompick,$respnumlookup) = @_; 6166: 6167: # Qon 'letter' implies for each slot in currquest we have: 6168: # ? or * for doubles, a letter in A-Z for a bubble, and 6169: # about anything else (esp. a value of Qoff) for missing 6170: # bubbles. 6171: # 6172: # Qon 'number' implies each slot gives a digit that indexes the 6173: # bubbles filled, or Qoff, or a non-number for unbubbled lines, 6174: # and * or ? for double bubbles on a single line. 6175: # 6176: 6177: my $matchon; 6178: if ($$scantron_config{'Qon'} eq 'letter') { 6179: $matchon = '[A-Z]'; 6180: } elsif ($$scantron_config{'Qon'} eq 'number') { 6181: $matchon = '\d'; 6182: } 6183: my $occurrences = 0; 6184: my $responsenum = $questnum-1; 6185: if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { 6186: $responsenum = $respnumlookup->{$questnum-1} 6187: } 6188: if (($responsetype_per_response{$responsenum} eq 'essayresponse') || 6189: ($responsetype_per_response{$responsenum} eq 'formularesponse') || 6190: ($responsetype_per_response{$responsenum} eq 'stringresponse') || 6191: ($responsetype_per_response{$responsenum} eq 'imageresponse') || 6192: ($responsetype_per_response{$responsenum} eq 'reactionresponse') || 6193: ($responsetype_per_response{$responsenum} eq 'organicresponse')) { 6194: my @singlelines = split('',$currquest); 6195: foreach my $entry (@singlelines) { 6196: $occurrences = &occurence_count($entry,$matchon); 6197: if ($occurrences > 1) { 6198: last; 6199: } 6200: } 6201: } else { 6202: $occurrences = &occurence_count($currquest,$matchon); 6203: } 6204: if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) { 6205: push(@{$record->{'scantron.doubleerror'}},$quest_id); 6206: for (my $ans=0; $ans<$answers_needed; $ans++) { 6207: my $bubble = substr($currquest,$ans,1); 6208: if ($bubble =~ /$matchon/ ) { 6209: if ($$scantron_config{'Qon'} eq 'number') { 6210: if ($bubble == 0) { 6211: $bubble = 10; 6212: } 6213: $record->{"scantron.$ansnum.answer"} = 6214: $alphabet->[$bubble-1]; 6215: } else { 6216: $record->{"scantron.$ansnum.answer"} = $bubble; 6217: } 6218: } else { 6219: $record->{"scantron.$ansnum.answer"}=''; 6220: } 6221: $ansnum++; 6222: } 6223: } elsif (!defined($currquest) 6224: || (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest)) 6225: || (&occurence_count($currquest,$matchon) == 0)) { 6226: for (my $ans=0; $ans<$answers_needed; $ans++ ) { 6227: $record->{"scantron.$ansnum.answer"}=''; 6228: $ansnum++; 6229: } 6230: if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { 6231: push(@{$record->{'scantron.missingerror'}},$quest_id); 6232: } 6233: } else { 6234: if ($$scantron_config{'Qon'} eq 'number') { 6235: $currquest = &digits_to_letters($currquest); 6236: } 6237: for (my $ans=0; $ans<$answers_needed; $ans++) { 6238: my $bubble = substr($currquest,$ans,1); 6239: $record->{"scantron.$ansnum.answer"} = $bubble; 6240: $ansnum++; 6241: } 6242: } 6243: return $ansnum; 6244: } 6245: 6246: sub scantron_validator_positional { 6247: my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest, 6248: $whichline,$alphabet,$record,$scantron_config,$scan_data, 6249: $randomorder,$randompick,$respnumlookup) = @_; 6250: 6251: # Otherwise there's a positional notation; 6252: # each bubble line requires Qlength items, and there are filled in 6253: # bubbles for each case where there 'Qon' characters. 6254: # 6255: 6256: my @array=split($$scantron_config{'Qon'},$currquest,-1); 6257: 6258: # If the split only gives us one element.. the full length of the 6259: # answer string, no bubbles are filled in: 6260: 6261: if ($answers_needed eq '') { 6262: return; 6263: } 6264: 6265: if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { 6266: for (my $ans=0; $ans<$answers_needed; $ans++ ) { 6267: $record->{"scantron.$ansnum.answer"}=''; 6268: $ansnum++; 6269: } 6270: if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { 6271: push(@{$record->{"scantron.missingerror"}},$quest_id); 6272: } 6273: } elsif (scalar(@array) == 2) { 6274: my $location = length($array[0]); 6275: my $line_num = int($location / $$scantron_config{'Qlength'}); 6276: my $bubble = $alphabet->[$location % $$scantron_config{'Qlength'}]; 6277: for (my $ans=0; $ans<$answers_needed; $ans++) { 6278: if ($ans eq $line_num) { 6279: $record->{"scantron.$ansnum.answer"} = $bubble; 6280: } else { 6281: $record->{"scantron.$ansnum.answer"} = ' '; 6282: } 6283: $ansnum++; 6284: } 6285: } else { 6286: # If there's more than one instance of a bubble character 6287: # That's a double bubble; with positional notation we can 6288: # record all the bubbles filled in as well as the 6289: # fact this response consists of multiple bubbles. 6290: # 6291: my $responsenum = $questnum-1; 6292: if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { 6293: $responsenum = $respnumlookup->{$questnum-1} 6294: } 6295: if (($responsetype_per_response{$responsenum} eq 'essayresponse') || 6296: ($responsetype_per_response{$responsenum} eq 'formularesponse') || 6297: ($responsetype_per_response{$responsenum} eq 'stringresponse') || 6298: ($responsetype_per_response{$responsenum} eq 'imageresponse') || 6299: ($responsetype_per_response{$responsenum} eq 'reactionresponse') || 6300: ($responsetype_per_response{$responsenum} eq 'organicresponse')) { 6301: my $doubleerror = 0; 6302: while (($currquest >= $$scantron_config{'Qlength'}) && 6303: (!$doubleerror)) { 6304: my $currline = substr($currquest,0,$$scantron_config{'Qlength'}); 6305: $currquest = substr($currquest,$$scantron_config{'Qlength'}); 6306: my @currarray = split($$scantron_config{'Qon'},$currline,-1); 6307: if (length(@currarray) > 2) { 6308: $doubleerror = 1; 6309: } 6310: } 6311: if ($doubleerror) { 6312: push(@{$record->{'scantron.doubleerror'}},$quest_id); 6313: } 6314: } else { 6315: push(@{$record->{'scantron.doubleerror'}},$quest_id); 6316: } 6317: my $item = $ansnum; 6318: for (my $ans=0; $ans<$answers_needed; $ans++) { 6319: $record->{"scantron.$item.answer"} = ''; 6320: $item ++; 6321: } 6322: 6323: my @ans=@array; 6324: my $i=0; 6325: my $increment = 0; 6326: while ($#ans) { 6327: $i+=length($ans[0]) + $increment; 6328: my $line = int($i/$$scantron_config{'Qlength'} + $ansnum); 6329: my $bubble = $i%$$scantron_config{'Qlength'}; 6330: $record->{"scantron.$line.answer"}.=$alphabet->[$bubble]; 6331: shift(@ans); 6332: $increment = 1; 6333: } 6334: $ansnum += $answers_needed; 6335: } 6336: return $ansnum; 6337: } 6338: 6339: =pod 6340: 6341: =item scantron_add_delay 6342: 6343: Adds an error message that occurred during the grading phase to a 6344: queue of messages to be shown after grading pass is complete 6345: 6346: Arguments: 6347: $delayqueue - arrary ref of hash ref of error messages 6348: $scanline - the scanline that caused the error 6349: $errormesage - the error message 6350: $errorcode - a numeric code for the error 6351: 6352: Side Effects: 6353: updates the $delayqueue to have a new hash ref of the error 6354: 6355: =cut 6356: 6357: sub scantron_add_delay { 6358: my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; 6359: push(@$delayqueue, 6360: {'line' => $scanline, 'emsg' => $errormessage, 6361: 'ecode' => $errorcode } 6362: ); 6363: } 6364: 6365: =pod 6366: 6367: =item scantron_find_student 6368: 6369: Finds the username for the current scanline 6370: 6371: Arguments: 6372: $scantron_record - hash result from scantron_parse_scanline 6373: $scan_data - hash of correction information 6374: (see &scantron_getfile() form more information) 6375: $idmap - hash from &username_to_idmap() 6376: $line - number of current scanline 6377: 6378: Returns: 6379: Either 'username:domain' or undef if unknown 6380: 6381: =cut 6382: 6383: sub scantron_find_student { 6384: my ($scantron_record,$scan_data,$idmap,$line)=@_; 6385: my $scanID=$$scantron_record{'scantron.ID'}; 6386: if ($scanID =~ /^\s*$/) { 6387: return &scan_data($scan_data,"$line.user"); 6388: } 6389: foreach my $id (keys(%$idmap)) { 6390: if (lc($id) eq lc($scanID)) { 6391: return $$idmap{$id}; 6392: } 6393: } 6394: return undef; 6395: } 6396: 6397: =pod 6398: 6399: =item scantron_filter 6400: 6401: Filter sub for lonnavmaps, filters out hidden resources if ignore 6402: hidden resources was selected 6403: 6404: =cut 6405: 6406: sub scantron_filter { 6407: my ($curres)=@_; 6408: 6409: if (ref($curres) && $curres->is_problem()) { 6410: # if the user has asked to not have either hidden 6411: # or 'randomout' controlled resources to be graded 6412: # don't include them 6413: if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' 6414: && $curres->randomout) { 6415: return 0; 6416: } 6417: return 1; 6418: } 6419: return 0; 6420: } 6421: 6422: =pod 6423: 6424: =item scantron_process_corrections 6425: 6426: Gets correction information out of submitted form data and corrects 6427: the scanline 6428: 6429: =cut 6430: 6431: sub scantron_process_corrections { 6432: my ($r) = @_; 6433: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6434: my ($scanlines,$scan_data)=&scantron_getfile(); 6435: my $classlist=&Apache::loncoursedata::get_classlist(); 6436: my $which=$env{'form.scantron_line'}; 6437: my $line=&scantron_get_line($scanlines,$scan_data,$which); 6438: my ($skip,$err,$errmsg); 6439: if ($env{'form.scantron_skip_record'}) { 6440: $skip=1; 6441: } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { 6442: my $newstudent=$env{'form.scantron_username'}.':'. 6443: $env{'form.scantron_domain'}; 6444: my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; 6445: ($line,$err,$errmsg)= 6446: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 6447: 'ID',{'newid'=>$newid, 6448: 'username'=>$env{'form.scantron_username'}, 6449: 'domain'=>$env{'form.scantron_domain'}}); 6450: } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { 6451: my $resolution=$env{'form.scantron_CODE_resolution'}; 6452: my $newCODE; 6453: my %args; 6454: if ($resolution eq 'use_unfound') { 6455: $newCODE='use_unfound'; 6456: } elsif ($resolution eq 'use_found') { 6457: $newCODE=$env{'form.scantron_CODE_selectedvalue'}; 6458: } elsif ($resolution eq 'use_typed') { 6459: $newCODE=$env{'form.scantron_CODE_newvalue'}; 6460: } elsif ($resolution =~ /^use_closest_(\d+)/) { 6461: $newCODE=$env{"form.scantron_CODE_closest_$1"}; 6462: } 6463: if ($env{'form.scantron_corrections'} eq 'duplicateCODE') { 6464: $args{'CODE_ignore_dup'}=1; 6465: } 6466: $args{'CODE'}=$newCODE; 6467: ($line,$err,$errmsg)= 6468: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 6469: 'CODE',\%args); 6470: } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { 6471: foreach my $question (split(',',$env{'form.scantron_questions'})) { 6472: ($line,$err,$errmsg)= 6473: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, 6474: $which,'answer', 6475: { 'question'=>$question, 6476: 'response'=>$env{"form.scantron_correct_Q_$question"}, 6477: 'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}}); 6478: if ($err) { last; } 6479: } 6480: } 6481: if ($err) { 6482: $r->print( 6483: '<p class="LC_error">' 6484: .&mt('Unable to accept last correction, an error occurred: [_1]', 6485: $errmsg) 6486: .'</p>'); 6487: } else { 6488: &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); 6489: &scantron_putfile($scanlines,$scan_data); 6490: } 6491: } 6492: 6493: =pod 6494: 6495: =item reset_skipping_status 6496: 6497: Forgets the current set of remember skipped scanlines (and thus 6498: reverts back to considering all lines in the 6499: scantron_skipped_<filename> file) 6500: 6501: =cut 6502: 6503: sub reset_skipping_status { 6504: my ($scanlines,$scan_data)=&scantron_getfile(); 6505: &scan_data($scan_data,'remember_skipping',undef,1); 6506: &scantron_putfile(undef,$scan_data); 6507: } 6508: 6509: =pod 6510: 6511: =item start_skipping 6512: 6513: Marks a scanline to be skipped. 6514: 6515: =cut 6516: 6517: sub start_skipping { 6518: my ($scan_data,$i)=@_; 6519: my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); 6520: if ($env{'form.scantron_options_redo'} =~ /^redo_/) { 6521: $remembered{$i}=2; 6522: } else { 6523: $remembered{$i}=1; 6524: } 6525: &scan_data($scan_data,'remember_skipping',join(':',%remembered)); 6526: } 6527: 6528: =pod 6529: 6530: =item should_be_skipped 6531: 6532: Checks whether a scanline should be skipped. 6533: 6534: =cut 6535: 6536: sub should_be_skipped { 6537: my ($scanlines,$scan_data,$i)=@_; 6538: if ($env{'form.scantron_options_redo'} !~ /^redo_/) { 6539: # not redoing old skips 6540: if ($scanlines->{'skipped'}[$i]) { return 1; } 6541: return 0; 6542: } 6543: my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); 6544: 6545: if (exists($remembered{$i}) && $remembered{$i} != 2 ) { 6546: return 0; 6547: } 6548: return 1; 6549: } 6550: 6551: =pod 6552: 6553: =item remember_current_skipped 6554: 6555: Discovers what scanlines are in the scantron_skipped_<filename> 6556: file and remembers them into scan_data for later use. 6557: 6558: =cut 6559: 6560: sub remember_current_skipped { 6561: my ($scanlines,$scan_data)=&scantron_getfile(); 6562: my %to_remember; 6563: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 6564: if ($scanlines->{'skipped'}[$i]) { 6565: $to_remember{$i}=1; 6566: } 6567: } 6568: 6569: &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); 6570: &scantron_putfile(undef,$scan_data); 6571: } 6572: 6573: =pod 6574: 6575: =item check_for_error 6576: 6577: Checks if there was an error when attempting to remove a specific 6578: scantron_.. bubblesheet data file. Prints out an error if 6579: something went wrong. 6580: 6581: =cut 6582: 6583: sub check_for_error { 6584: my ($r,$result)=@_; 6585: if ($result ne 'ok' && $result ne 'not_found' ) { 6586: $r->print(&mt("An error occurred ([_1]) when trying to remove the existing corrections.",$result)); 6587: } 6588: } 6589: 6590: =pod 6591: 6592: =item scantron_warning_screen 6593: 6594: Interstitial screen to make sure the operator has selected the 6595: correct options before we start the validation phase. 6596: 6597: =cut 6598: 6599: sub scantron_warning_screen { 6600: my ($button_text,$symb)=@_; 6601: my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); 6602: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6603: my $CODElist; 6604: if ($scantron_config{'CODElocation'} && 6605: $scantron_config{'CODEstart'} && 6606: $scantron_config{'CODElength'}) { 6607: $CODElist=$env{'form.scantron_CODElist'}; 6608: if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">None</span>'; } 6609: $CODElist= 6610: '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'. 6611: $env{'form.scantron_CODElist'}.'</tt></td></tr>'; 6612: } 6613: my $lastbubblepoints; 6614: if ($env{'form.scantron_lastbubblepoints'} ne '') { 6615: $lastbubblepoints = 6616: '<tr><td><b>'.&mt('Hand-graded items: points from last bubble in row').'</b></td><td><tt>'. 6617: $env{'form.scantron_lastbubblepoints'}.'</tt></td></tr>'; 6618: } 6619: return (' 6620: <p> 6621: <span class="LC_warning"> 6622: '.&mt("Please double check the information below before clicking on '[_1]'",&mt($button_text)).'</span> 6623: </p> 6624: <table> 6625: <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr> 6626: <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr> 6627: '.$CODElist.$lastbubblepoints.' 6628: </table> 6629: <p> '.&mt("If this information is correct, please click on '[_1]'.",&mt($button_text)).'<br /> 6630: '.&mt('If something is incorrect, please return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','<a href="/adm/grades?symb='.$symb.'&command=scantron_selectphase" class="LC_info">','</a>').'</p> 6631: 6632: <br /> 6633: '); 6634: } 6635: 6636: =pod 6637: 6638: =item scantron_do_warning 6639: 6640: Check if the operator has picked something for all required 6641: fields. Error out if something is missing. 6642: 6643: =cut 6644: 6645: sub scantron_do_warning { 6646: my ($r,$symb)=@_; 6647: if (!$symb) {return '';} 6648: my $default_form_data=&defaultFormData($symb); 6649: $r->print(&scantron_form_start().$default_form_data); 6650: if ( $env{'form.selectpage'} eq '' || 6651: $env{'form.scantron_selectfile'} eq '' || 6652: $env{'form.scantron_format'} eq '' ) { 6653: $r->print("<p>".&mt('You have forgotten to specify some information. Please go Back and try again.')."</p>"); 6654: if ( $env{'form.selectpage'} eq '') { 6655: $r->print('<p><span class="LC_error">'.&mt('You have not selected a Sequence to grade').'</span></p>'); 6656: } 6657: if ( $env{'form.scantron_selectfile'} eq '') { 6658: $r->print('<p><span class="LC_error">'.&mt("You have not selected a file that contains the student's response data.").'</span></p>'); 6659: } 6660: if ( $env{'form.scantron_format'} eq '') { 6661: $r->print('<p><span class="LC_error">'.&mt("You have not selected the format of the student's response data.").'</span></p>'); 6662: } 6663: } else { 6664: my $warning=&scantron_warning_screen('Grading: Validate Records',$symb); 6665: my $bubbledbyhand=&hand_bubble_option(); 6666: $r->print(' 6667: '.$warning.$bubbledbyhand.' 6668: <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" /> 6669: <input type="hidden" name="command" value="scantron_validate" /> 6670: '); 6671: } 6672: $r->print("</form><br />"); 6673: return ''; 6674: } 6675: 6676: =pod 6677: 6678: =item scantron_form_start 6679: 6680: html hidden input for remembering all selected grading options 6681: 6682: =cut 6683: 6684: sub scantron_form_start { 6685: my ($max_bubble)=@_; 6686: my $result= <<SCANTRONFORM; 6687: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> 6688: <input type="hidden" name="selectpage" value="$env{'form.selectpage'}" /> 6689: <input type="hidden" name="scantron_format" value="$env{'form.scantron_format'}" /> 6690: <input type="hidden" name="scantron_selectfile" value="$env{'form.scantron_selectfile'}" /> 6691: <input type="hidden" name="scantron_maxbubble" value="$max_bubble" /> 6692: <input type="hidden" name="scantron_CODElist" value="$env{'form.scantron_CODElist'}" /> 6693: <input type="hidden" name="scantron_CODEunique" value="$env{'form.scantron_CODEunique'}" /> 6694: <input type="hidden" name="scantron_options_redo" value="$env{'form.scantron_options_redo'}" /> 6695: <input type="hidden" name="scantron_options_ignore" value="$env{'form.scantron_options_ignore'}" /> 6696: <input type="hidden" name="scantron_options_hidden" value="$env{'form.scantron_options_hidden'}" /> 6697: SCANTRONFORM 6698: 6699: my $line = 0; 6700: while (defined($env{"form.scantron.bubblelines.$line"})) { 6701: my $chunk = 6702: '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n"; 6703: $chunk .= 6704: '<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n"; 6705: $chunk .= 6706: '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n"; 6707: $chunk .= 6708: '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n"; 6709: $chunk .= 6710: '<input type="hidden" name="scantron.residpart.'.$line.'" value="'.$env{"form.scantron.residpart.$line"}.'" />'."\n"; 6711: $result .= $chunk; 6712: $line++; 6713: } 6714: return $result; 6715: } 6716: 6717: =pod 6718: 6719: =item scantron_validate_file 6720: 6721: Dispatch routine for doing validation of a bubblesheet data file. 6722: 6723: Also processes any necessary information resets that need to 6724: occur before validation begins (ignore previous corrections, 6725: restarting the skipped records processing) 6726: 6727: =cut 6728: 6729: sub scantron_validate_file { 6730: my ($r,$symb) = @_; 6731: if (!$symb) {return '';} 6732: my $default_form_data=&defaultFormData($symb); 6733: 6734: # do the detection of only doing skipped records first before we delete 6735: # them when doing the corrections reset 6736: if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') { 6737: &reset_skipping_status(); 6738: } 6739: if ($env{'form.scantron_options_redo'} eq 'redo_skipped') { 6740: &remember_current_skipped(); 6741: $env{'form.scantron_options_redo'}='redo_skipped_ready'; 6742: } 6743: 6744: if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') { 6745: &check_for_error($r,&scantron_remove_file('corrected')); 6746: &check_for_error($r,&scantron_remove_file('skipped')); 6747: &check_for_error($r,&scantron_remove_scan_data()); 6748: $env{'form.scantron_options_ignore'}='done'; 6749: } 6750: 6751: if ($env{'form.scantron_corrections'}) { 6752: &scantron_process_corrections($r); 6753: } 6754: $r->print('<p>'.&mt('Gathering necessary information.').'</p>');$r->rflush(); 6755: #get the student pick code ready 6756: $r->print(&Apache::loncommon::studentbrowser_javascript()); 6757: my $nav_error; 6758: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 6759: my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); 6760: if ($nav_error) { 6761: $r->print(&navmap_errormsg()); 6762: return ''; 6763: } 6764: my $result=&scantron_form_start($max_bubble).$default_form_data; 6765: if ($env{'form.scantron_lastbubblepoints'} ne '') { 6766: $result .= '<input type="hidden" name="scantron_lastbubblepoints" value="'.$env{'form.scantron_lastbubblepoints'}.'" />'; 6767: } 6768: $r->print($result); 6769: 6770: my @validate_phases=( 'sequence', 6771: 'ID', 6772: 'CODE', 6773: 'doublebubble', 6774: 'missingbubbles'); 6775: if (!$env{'form.validatepass'}) { 6776: $env{'form.validatepass'} = 0; 6777: } 6778: my $currentphase=$env{'form.validatepass'}; 6779: 6780: 6781: my $stop=0; 6782: while (!$stop && $currentphase < scalar(@validate_phases)) { 6783: $r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />'); 6784: $r->rflush(); 6785: 6786: my $which="scantron_validate_".$validate_phases[$currentphase]; 6787: { 6788: no strict 'refs'; 6789: ($stop,$currentphase)=&$which($r,$currentphase); 6790: } 6791: } 6792: if (!$stop) { 6793: my $warning=&scantron_warning_screen('Start Grading',$symb); 6794: $r->print(&mt('Validation process complete.').'<br />'. 6795: $warning. 6796: &mt('Perform verification for each student after storage of submissions?'). 6797: ' <span class="LC_nobreak"><label>'. 6798: '<input type="radio" name="verifyrecord" value="1" />'.&mt('Yes').'</label>'. 6799: (' 'x3).'<label>'. 6800: '<input type="radio" name="verifyrecord" value="0" checked="checked" />'.&mt('No'). 6801: '</label></span><br />'. 6802: &mt('Grading will take longer if you use verification.').'<br />'. 6803: &mt('Otherwise, Grade/Manage/Review Bubblesheets [_1] Review bubblesheet data can be used once grading is complete.','»').'<br /><br />'. 6804: '<input type="submit" name="submit" value="'.&mt('Start Grading').'" />'. 6805: '<input type="hidden" name="command" value="scantron_process" />'."\n"); 6806: } else { 6807: $r->print('<input type="hidden" name="command" value="scantron_validate" />'); 6808: $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />"); 6809: } 6810: if ($stop) { 6811: if ($validate_phases[$currentphase] eq 'sequence') { 6812: $r->print('<input type="submit" name="submit" value="'.&mt('Ignore').' → " />'); 6813: $r->print(' '.&mt('this error').' <br />'); 6814: 6815: $r->print('<p>'.&mt('Or return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','<a href="/adm/grades?symb='.$symb.'&command=scantron_selectphase" class="LC_info">','</a>').'</p>'); 6816: } else { 6817: if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') { 6818: $r->print('<input type="button" name="submitbutton" value="'.&mt('Continue').' →" onclick="javascript:verify_bubble_radio(this.form)" />'); 6819: } else { 6820: $r->print('<input type="submit" name="submit" value="'.&mt('Continue').' →" />'); 6821: } 6822: $r->print(' '.&mt('using corrected info').' <br />'); 6823: $r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />"); 6824: $r->print(" ".&mt("this scanline saving it for later.")); 6825: } 6826: } 6827: $r->print(" </form><br />"); 6828: return ''; 6829: } 6830: 6831: 6832: =pod 6833: 6834: =item scantron_remove_file 6835: 6836: Removes the requested bubblesheet data file, makes sure that 6837: scantron_original_<filename> is never removed 6838: 6839: 6840: =cut 6841: 6842: sub scantron_remove_file { 6843: my ($which)=@_; 6844: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6845: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6846: my $file='scantron_'; 6847: if ($which eq 'corrected' || $which eq 'skipped') { 6848: $file.=$which.'_'; 6849: } else { 6850: return 'refused'; 6851: } 6852: $file.=$env{'form.scantron_selectfile'}; 6853: return &Apache::lonnet::removeuserfile($cname,$cdom,$file); 6854: } 6855: 6856: 6857: =pod 6858: 6859: =item scantron_remove_scan_data 6860: 6861: Removes all scan_data correction for the requested bubblesheet 6862: data file. (In the case that both the are doing skipped records we need 6863: to remember the old skipped lines for the time being so that element 6864: persists for a while.) 6865: 6866: =cut 6867: 6868: sub scantron_remove_scan_data { 6869: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6870: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6871: my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname); 6872: my @todelete; 6873: my $filename=$env{'form.scantron_selectfile'}; 6874: foreach my $key (@keys) { 6875: if ($key=~/^\Q$filename\E_/) { 6876: if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' && 6877: $key=~/remember_skipping/) { 6878: next; 6879: } 6880: push(@todelete,$key); 6881: } 6882: } 6883: my $result; 6884: if (@todelete) { 6885: $result = &Apache::lonnet::del('nohist_scantrondata', 6886: \@todelete,$cdom,$cname); 6887: } else { 6888: $result = 'ok'; 6889: } 6890: return $result; 6891: } 6892: 6893: 6894: =pod 6895: 6896: =item scantron_getfile 6897: 6898: Fetches the requested bubblesheet data file (all 3 versions), and 6899: the scan_data hash 6900: 6901: Arguments: 6902: None 6903: 6904: Returns: 6905: 2 hash references 6906: 6907: - first one has 6908: orig - 6909: corrected - 6910: skipped - each of which points to an array ref of the specified 6911: file broken up into individual lines 6912: count - number of scanlines 6913: 6914: - second is the scan_data hash possible keys are 6915: ($number refers to scanline numbered $number and thus the key affects 6916: only that scanline 6917: $bubline refers to the specific bubble line element and the aspects 6918: refers to that specific bubble line element) 6919: 6920: $number.user - username:domain to use 6921: $number.CODE_ignore_dup 6922: - ignore the duplicate CODE error 6923: $number.useCODE 6924: - use the CODE in the scanline as is 6925: $number.no_bubble.$bubline 6926: - it is valid that there is no bubbled in bubble 6927: at $number $bubline 6928: remember_skipping 6929: - a frozen hash containing keys of $number and values 6930: of either 6931: 1 - we are on a 'do skipped records pass' and plan 6932: on processing this line 6933: 2 - we are on a 'do skipped records pass' and this 6934: scanline has been marked to skip yet again 6935: 6936: =cut 6937: 6938: sub scantron_getfile { 6939: #FIXME really would prefer a scantron directory 6940: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6941: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6942: my $lines; 6943: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 6944: 'scantron_orig_'.$env{'form.scantron_selectfile'}); 6945: my %scanlines; 6946: $scanlines{'orig'}=[(split("\n",$lines,-1))]; 6947: my $temp=$scanlines{'orig'}; 6948: $scanlines{'count'}=$#$temp; 6949: 6950: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 6951: 'scantron_corrected_'.$env{'form.scantron_selectfile'}); 6952: if ($lines eq '-1') { 6953: $scanlines{'corrected'}=[]; 6954: } else { 6955: $scanlines{'corrected'}=[(split("\n",$lines,-1))]; 6956: } 6957: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 6958: 'scantron_skipped_'.$env{'form.scantron_selectfile'}); 6959: if ($lines eq '-1') { 6960: $scanlines{'skipped'}=[]; 6961: } else { 6962: $scanlines{'skipped'}=[(split("\n",$lines,-1))]; 6963: } 6964: my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname); 6965: if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } 6966: my %scan_data = @tmp; 6967: return (\%scanlines,\%scan_data); 6968: } 6969: 6970: =pod 6971: 6972: =item lonnet_putfile 6973: 6974: Wrapper routine to call &Apache::lonnet::finishuserfileupload 6975: 6976: Arguments: 6977: $contents - data to store 6978: $filename - filename to store $contents into 6979: 6980: Returns: 6981: result value from &Apache::lonnet::finishuserfileupload 6982: 6983: =cut 6984: 6985: sub lonnet_putfile { 6986: my ($contents,$filename)=@_; 6987: my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6988: my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6989: $env{'form.sillywaytopassafilearound'}=$contents; 6990: &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename); 6991: 6992: } 6993: 6994: =pod 6995: 6996: =item scantron_putfile 6997: 6998: Stores the current version of the bubblesheet data files, and the 6999: scan_data hash. (Does not modify the original version only the 7000: corrected and skipped versions. 7001: 7002: Arguments: 7003: $scanlines - hash ref that looks like the first return value from 7004: &scantron_getfile() 7005: $scan_data - hash ref that looks like the second return value from 7006: &scantron_getfile() 7007: 7008: =cut 7009: 7010: sub scantron_putfile { 7011: my ($scanlines,$scan_data) = @_; 7012: #FIXME really would prefer a scantron directory 7013: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 7014: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 7015: if ($scanlines) { 7016: my $prefix='scantron_'; 7017: # no need to update orig, shouldn't change 7018: # &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'. 7019: # $env{'form.scantron_selectfile'}); 7020: &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}), 7021: $prefix.'corrected_'. 7022: $env{'form.scantron_selectfile'}); 7023: &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), 7024: $prefix.'skipped_'. 7025: $env{'form.scantron_selectfile'}); 7026: } 7027: &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); 7028: } 7029: 7030: =pod 7031: 7032: =item scantron_get_line 7033: 7034: Returns the correct version of the scanline 7035: 7036: Arguments: 7037: $scanlines - hash ref that looks like the first return value from 7038: &scantron_getfile() 7039: $scan_data - hash ref that looks like the second return value from 7040: &scantron_getfile() 7041: $i - number of the requested line (starts at 0) 7042: 7043: Returns: 7044: A scanline, (either the original or the corrected one if it 7045: exists), or undef if the requested scanline should be 7046: skipped. (Either because it's an skipped scanline, or it's an 7047: unskipped scanline and we are not doing a 'do skipped scanlines' 7048: pass. 7049: 7050: =cut 7051: 7052: sub scantron_get_line { 7053: my ($scanlines,$scan_data,$i)=@_; 7054: if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } 7055: #if ($scanlines->{'skipped'}[$i]) { return undef; } 7056: if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} 7057: return $scanlines->{'orig'}[$i]; 7058: } 7059: 7060: =pod 7061: 7062: =item scantron_todo_count 7063: 7064: Counts the number of scanlines that need processing. 7065: 7066: Arguments: 7067: $scanlines - hash ref that looks like the first return value from 7068: &scantron_getfile() 7069: $scan_data - hash ref that looks like the second return value from 7070: &scantron_getfile() 7071: 7072: Returns: 7073: $count - number of scanlines to process 7074: 7075: =cut 7076: 7077: sub get_todo_count { 7078: my ($scanlines,$scan_data)=@_; 7079: my $count=0; 7080: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7081: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7082: if ($line=~/^[\s\cz]*$/) { next; } 7083: $count++; 7084: } 7085: return $count; 7086: } 7087: 7088: =pod 7089: 7090: =item scantron_put_line 7091: 7092: Updates the 'corrected' or 'skipped' versions of the bubblesheet 7093: data file. 7094: 7095: Arguments: 7096: $scanlines - hash ref that looks like the first return value from 7097: &scantron_getfile() 7098: $scan_data - hash ref that looks like the second return value from 7099: &scantron_getfile() 7100: $i - line number to update 7101: $newline - contents of the updated scanline 7102: $skip - if true make the line for skipping and update the 7103: 'skipped' file 7104: 7105: =cut 7106: 7107: sub scantron_put_line { 7108: my ($scanlines,$scan_data,$i,$newline,$skip)=@_; 7109: if ($skip) { 7110: $scanlines->{'skipped'}[$i]=$newline; 7111: &start_skipping($scan_data,$i); 7112: return; 7113: } 7114: $scanlines->{'corrected'}[$i]=$newline; 7115: } 7116: 7117: =pod 7118: 7119: =item scantron_clear_skip 7120: 7121: Remove a line from the 'skipped' file 7122: 7123: Arguments: 7124: $scanlines - hash ref that looks like the first return value from 7125: &scantron_getfile() 7126: $scan_data - hash ref that looks like the second return value from 7127: &scantron_getfile() 7128: $i - line number to update 7129: 7130: =cut 7131: 7132: sub scantron_clear_skip { 7133: my ($scanlines,$scan_data,$i)=@_; 7134: if (exists($scanlines->{'skipped'}[$i])) { 7135: undef($scanlines->{'skipped'}[$i]); 7136: return 1; 7137: } 7138: return 0; 7139: } 7140: 7141: =pod 7142: 7143: =item scantron_filter_not_exam 7144: 7145: Filter routine used by &Apache::lonnavmaps::retrieveResources(), to 7146: filter out resources that are not marked as 'exam' mode 7147: 7148: =cut 7149: 7150: sub scantron_filter_not_exam { 7151: my ($curres)=@_; 7152: 7153: if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) { 7154: # if the user has asked to not have either hidden 7155: # or 'randomout' controlled resources to be graded 7156: # don't include them 7157: if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' 7158: && $curres->randomout) { 7159: return 0; 7160: } 7161: return 1; 7162: } 7163: return 0; 7164: } 7165: 7166: =pod 7167: 7168: =item scantron_validate_sequence 7169: 7170: Validates the selected sequence, checking for resource that are 7171: not set to exam mode. 7172: 7173: =cut 7174: 7175: sub scantron_validate_sequence { 7176: my ($r,$currentphase) = @_; 7177: 7178: my $navmap=Apache::lonnavmaps::navmap->new(); 7179: unless (ref($navmap)) { 7180: $r->print(&navmap_errormsg()); 7181: return (1,$currentphase); 7182: } 7183: my (undef,undef,$sequence)= 7184: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 7185: 7186: my $map=$navmap->getResourceByUrl($sequence); 7187: 7188: $r->print('<input type="hidden" name="validate_sequence_exam" 7189: value="ignore" />'); 7190: if ($env{'form.validate_sequence_exam'} ne 'ignore') { 7191: my @resources= 7192: $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); 7193: if (@resources) { 7194: $r->print( 7195: '<p class="LC_warning">' 7196: .&mt('Some resources in the sequence currently are not set to' 7197: .' bubblesheet exam mode. Grading these resources currently may not' 7198: .' work correctly.') 7199: .'</p>' 7200: ); 7201: return (1,$currentphase); 7202: } 7203: } 7204: 7205: return (0,$currentphase+1); 7206: } 7207: 7208: 7209: 7210: sub scantron_validate_ID { 7211: my ($r,$currentphase) = @_; 7212: 7213: #get student info 7214: my $classlist=&Apache::loncoursedata::get_classlist(); 7215: my %idmap=&username_to_idmap($classlist); 7216: 7217: #get scantron line setup 7218: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 7219: my ($scanlines,$scan_data)=&scantron_getfile(); 7220: 7221: my $nav_error; 7222: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble_lines.. array. 7223: if ($nav_error) { 7224: $r->print(&navmap_errormsg()); 7225: return(1,$currentphase); 7226: } 7227: 7228: my %found=('ids'=>{},'usernames'=>{}); 7229: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7230: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7231: if ($line=~/^[\s\cz]*$/) { next; } 7232: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 7233: $scan_data); 7234: my $id=$$scan_record{'scantron.ID'}; 7235: my $found; 7236: foreach my $checkid (keys(%idmap)) { 7237: if (lc($checkid) eq lc($id)) { $found=$checkid;last; } 7238: } 7239: if ($found) { 7240: my $username=$idmap{$found}; 7241: if ($found{'ids'}{$found}) { 7242: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 7243: $line,'duplicateID',$found); 7244: return(1,$currentphase); 7245: } elsif ($found{'usernames'}{$username}) { 7246: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 7247: $line,'duplicateID',$username); 7248: return(1,$currentphase); 7249: } 7250: #FIXME store away line we previously saw the ID on to use above 7251: $found{'ids'}{$found}++; 7252: $found{'usernames'}{$username}++; 7253: } else { 7254: if ($id =~ /^\s*$/) { 7255: my $username=&scan_data($scan_data,"$i.user"); 7256: if (defined($username) && $found{'usernames'}{$username}) { 7257: &scantron_get_correction($r,$i,$scan_record, 7258: \%scantron_config, 7259: $line,'duplicateID',$username); 7260: return(1,$currentphase); 7261: } elsif (!defined($username)) { 7262: &scantron_get_correction($r,$i,$scan_record, 7263: \%scantron_config, 7264: $line,'incorrectID'); 7265: return(1,$currentphase); 7266: } 7267: $found{'usernames'}{$username}++; 7268: } else { 7269: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 7270: $line,'incorrectID'); 7271: return(1,$currentphase); 7272: } 7273: } 7274: } 7275: 7276: return (0,$currentphase+1); 7277: } 7278: 7279: 7280: sub scantron_get_correction { 7281: my ($r,$i,$scan_record,$scan_config,$line,$error,$arg, 7282: $randomorder,$randompick,$respnumlookup,$startline)=@_; 7283: #FIXME in the case of a duplicated ID the previous line, probably need 7284: #to show both the current line and the previous one and allow skipping 7285: #the previous one or the current one 7286: 7287: if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { 7288: $r->print( 7289: '<p class="LC_warning">' 7290: .&mt('An error was detected ([_1]) for PaperID [_2]', 7291: "<b>$error</b>", 7292: '<tt>'.$$scan_record{'scantron.PaperID'}.'</tt>') 7293: ."</p> \n"); 7294: } else { 7295: $r->print( 7296: '<p class="LC_warning">' 7297: .&mt('An error was detected ([_1]) in scanline [_2] [_3]', 7298: "<b>$error</b>", $i, "<pre>$line</pre>") 7299: ."</p> \n"); 7300: } 7301: my $message = 7302: '<p>' 7303: .&mt('The ID on the form is [_1]', 7304: "<tt>$$scan_record{'scantron.ID'}</tt>") 7305: .'<br />' 7306: .&mt('The name on the paper is [_1], [_2]', 7307: $$scan_record{'scantron.LastName'}, 7308: $$scan_record{'scantron.FirstName'}) 7309: .'</p>'; 7310: 7311: $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); 7312: $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n"); 7313: # Array populated for doublebubble or 7314: my @lines_to_correct; # missingbubble errors to build javascript 7315: # to validate radio button checking 7316: 7317: if ($error =~ /ID$/) { 7318: if ($error eq 'incorrectID') { 7319: $r->print('<p class="LC_warning">'.&mt("The encoded ID is not in the classlist"). 7320: "</p>\n"); 7321: } elsif ($error eq 'duplicateID') { 7322: $r->print('<p class="LC_warning">'.&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n"); 7323: } 7324: $r->print($message); 7325: $r->print("<p>".&mt("How should I handle this?")." <br /> \n"); 7326: $r->print("\n<ul><li> "); 7327: #FIXME it would be nice if this sent back the user ID and 7328: #could do partial userID matches 7329: $r->print(&Apache::loncommon::selectstudent_link('scantronupload', 7330: 'scantron_username','scantron_domain')); 7331: $r->print(": <input type='text' name='scantron_username' value='' />"); 7332: $r->print("\n:\n". 7333: &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain')); 7334: 7335: $r->print('</li>'); 7336: } elsif ($error =~ /CODE$/) { 7337: if ($error eq 'incorrectCODE') { 7338: $r->print('<p class="LC_warning">'.&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n"); 7339: } elsif ($error eq 'duplicateCODE') { 7340: $r->print('<p class="LC_warning">'.&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."</p>\n"); 7341: } 7342: $r->print("<p>".&mt('The CODE on the form is [_1]', 7343: "<tt>'$$scan_record{'scantron.CODE'}'</tt>") 7344: ."</p>\n"); 7345: $r->print($message); 7346: $r->print("<p>".&mt("How should I handle this?")."</p>\n"); 7347: $r->print("\n<br /> "); 7348: my $i=0; 7349: if ($error eq 'incorrectCODE' 7350: && $$scan_record{'scantron.CODE'}=~/\S/ ) { 7351: my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); 7352: if ($closest > 0) { 7353: foreach my $testcode (@{$closest}) { 7354: my $checked=''; 7355: if (!$i) { $checked=' checked="checked"'; } 7356: $r->print(" 7357: <label> 7358: <input type='radio' name='scantron_CODE_resolution' value='use_closest_$i'$checked /> 7359: ".&mt("Use the similar CODE [_1] instead.", 7360: "<b><tt>".$testcode."</tt></b>")." 7361: </label> 7362: <input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />"); 7363: $r->print("\n<br />"); 7364: $i++; 7365: } 7366: } 7367: } 7368: if ($$scan_record{'scantron.CODE'}=~/\S/ ) { 7369: my $checked; if (!$i) { $checked=' checked="checked"'; } 7370: $r->print(" 7371: <label> 7372: <input type='radio' name='scantron_CODE_resolution' value='use_unfound'$checked /> 7373: ".&mt("Use the CODE [_1] that was on the paper, ignoring the error.", 7374: "<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")." 7375: </label>"); 7376: $r->print("\n<br />"); 7377: } 7378: 7379: $r->print(&Apache::lonhtmlcommon::scripttag(<<ENDSCRIPT)); 7380: function change_radio(field) { 7381: var slct=document.scantronupload.scantron_CODE_resolution; 7382: var i; 7383: for (i=0;i<slct.length;i++) { 7384: if (slct[i].value==field) { slct[i].checked=true; } 7385: } 7386: } 7387: ENDSCRIPT 7388: my $href="/adm/pickcode?". 7389: "form=".&escape("scantronupload"). 7390: "&scantron_format=".&escape($env{'form.scantron_format'}). 7391: "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). 7392: "&curCODE=".&escape($$scan_record{'scantron.CODE'}). 7393: "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); 7394: if ($env{'form.scantron_CODElist'} =~ /\S/) { 7395: $r->print(" 7396: <label> 7397: <input type='radio' name='scantron_CODE_resolution' value='use_found' /> 7398: ".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.", 7399: "<a target='_blank' href='$href'>","</a>")." 7400: </label> 7401: ".&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\')" />')); 7402: $r->print("\n<br />"); 7403: } 7404: $r->print(" 7405: <label> 7406: <input type='radio' name='scantron_CODE_resolution' value='use_typed' /> 7407: ".&mt("Use [_1] as the CODE.", 7408: "</label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" />")); 7409: $r->print("\n<br /><br />"); 7410: } elsif ($error eq 'doublebubble') { 7411: $r->print('<p class="LC_warning">'.&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n"); 7412: 7413: # The form field scantron_questions is acutally a list of line numbers. 7414: # represented by this form so: 7415: 7416: my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, 7417: $respnumlookup,$startline); 7418: 7419: $r->print('<input type="hidden" name="scantron_questions" value="'. 7420: $line_list.'" />'); 7421: $r->print($message); 7422: $r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>"); 7423: foreach my $question (@{$arg}) { 7424: my @linenums = &prompt_for_corrections($r,$question,$scan_config, 7425: $scan_record, $error, 7426: $randomorder,$randompick, 7427: $respnumlookup,$startline); 7428: push(@lines_to_correct,@linenums); 7429: } 7430: $r->print(&verify_bubbles_checked(@lines_to_correct)); 7431: } elsif ($error eq 'missingbubble') { 7432: $r->print('<p class="LC_warning">'.&mt("There have been [_1]no[_2] bubbles scanned for some question(s)",'<b>','</b>')."</p>\n"); 7433: $r->print($message); 7434: $r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>"); 7435: $r->print(&mt("Some questions have no scanned bubbles.")."\n"); 7436: 7437: # The form field scantron_questions is actually a list of line numbers not 7438: # a list of question numbers. Therefore: 7439: # 7440: 7441: my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, 7442: $respnumlookup,$startline); 7443: 7444: $r->print('<input type="hidden" name="scantron_questions" value="'. 7445: $line_list.'" />'); 7446: foreach my $question (@{$arg}) { 7447: my @linenums = &prompt_for_corrections($r,$question,$scan_config, 7448: $scan_record, $error, 7449: $randomorder,$randompick, 7450: $respnumlookup,$startline); 7451: push(@lines_to_correct,@linenums); 7452: } 7453: $r->print(&verify_bubbles_checked(@lines_to_correct)); 7454: } else { 7455: $r->print("\n<ul>"); 7456: } 7457: $r->print("\n</li></ul>"); 7458: } 7459: 7460: sub verify_bubbles_checked { 7461: my (@ansnums) = @_; 7462: my $ansnumstr = join('","',@ansnums); 7463: my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines."); 7464: my $output = &Apache::lonhtmlcommon::scripttag((<<ENDSCRIPT)); 7465: function verify_bubble_radio(form) { 7466: var ansnumArray = new Array ("$ansnumstr"); 7467: var need_bubble_count = 0; 7468: for (var i=0; i<ansnumArray.length; i++) { 7469: if (form.elements["scantron_correct_Q_"+ansnumArray[i]].length > 1) { 7470: var bubble_picked = 0; 7471: for (var j=0; j<form.elements["scantron_correct_Q_"+ansnumArray[i]].length; j++) { 7472: if (form.elements["scantron_correct_Q_"+ansnumArray[i]][j].checked == true) { 7473: bubble_picked = 1; 7474: } 7475: } 7476: if (bubble_picked == 0) { 7477: need_bubble_count ++; 7478: } 7479: } 7480: } 7481: if (need_bubble_count) { 7482: alert("$warning"); 7483: return; 7484: } 7485: form.submit(); 7486: } 7487: ENDSCRIPT 7488: return $output; 7489: } 7490: 7491: =pod 7492: 7493: =item questions_to_line_list 7494: 7495: Converts a list of questions into a string of comma separated 7496: line numbers in the answer sheet used by the questions. This is 7497: used to fill in the scantron_questions form field. 7498: 7499: Arguments: 7500: questions - Reference to an array of questions. 7501: randomorder - True if randomorder in use. 7502: randompick - True if randompick in use. 7503: respnumlookup - Reference to HASH mapping question numbers in bubble lines 7504: for current line to question number used for same question 7505: in "Master Seqence" (as seen by Course Coordinator). 7506: startline - Reference to hash where key is question number (0 is first) 7507: and key is number of first bubble line for current student 7508: or code-based randompick and/or randomorder. 7509: 7510: =cut 7511: 7512: 7513: sub questions_to_line_list { 7514: my ($questions,$randomorder,$randompick,$respnumlookup,$startline) = @_; 7515: my @lines; 7516: 7517: foreach my $item (@{$questions}) { 7518: my $question = $item; 7519: my ($first,$count,$last); 7520: if ($item =~ /^(\d+)\.(\d+)$/) { 7521: $question = $1; 7522: my $subquestion = $2; 7523: my $responsenum = $question-1; 7524: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { 7525: $responsenum = $respnumlookup->{$question-1}; 7526: if (ref($startline) eq 'HASH') { 7527: $first = $startline->{$question-1} + 1; 7528: } 7529: } else { 7530: $first = $first_bubble_line{$responsenum} + 1; 7531: } 7532: my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); 7533: my $subcount = 1; 7534: while ($subcount<$subquestion) { 7535: $first += $subans[$subcount-1]; 7536: $subcount ++; 7537: } 7538: $count = $subans[$subquestion-1]; 7539: } else { 7540: my $responsenum = $question-1; 7541: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { 7542: $responsenum = $respnumlookup->{$question-1}; 7543: if (ref($startline) eq 'HASH') { 7544: $first = $startline->{$question-1} + 1; 7545: } 7546: } else { 7547: $first = $first_bubble_line{$responsenum} + 1; 7548: } 7549: $count = $bubble_lines_per_response{$responsenum}; 7550: } 7551: $last = $first+$count-1; 7552: push(@lines, ($first..$last)); 7553: } 7554: return join(',', @lines); 7555: } 7556: 7557: =pod 7558: 7559: =item prompt_for_corrections 7560: 7561: Prompts for a potentially multiline correction to the 7562: user's bubbling (factors out common code from scantron_get_correction 7563: for multi and missing bubble cases). 7564: 7565: Arguments: 7566: $r - Apache request object. 7567: $question - The question number to prompt for. 7568: $scan_config - The scantron file configuration hash. 7569: $scan_record - Reference to the hash that has the the parsed scanlines. 7570: $error - Type of error 7571: $randomorder - True if randomorder in use. 7572: $randompick - True if randompick in use. 7573: $respnumlookup - Reference to HASH mapping question numbers in bubble lines 7574: for current line to question number used for same question 7575: in "Master Seqence" (as seen by Course Coordinator). 7576: $startline - Reference to hash where key is question number (0 is first) 7577: and value is number of first bubble line for current student 7578: or code-based randompick and/or randomorder. 7579: 7580: 7581: Implicit inputs: 7582: %bubble_lines_per_response - Starting line numbers for each question. 7583: Numbered from 0 (but question numbers are from 7584: 1. 7585: %first_bubble_line - Starting bubble line for each question. 7586: %subdivided_bubble_lines - optionresponse, matchresponse and rankresponse 7587: type problems render as separate sub-questions, 7588: in exam mode. This hash contains a 7589: comma-separated list of the lines per 7590: sub-question. 7591: %responsetype_per_response - essayresponse, formularesponse, 7592: stringresponse, imageresponse, reactionresponse, 7593: and organicresponse type problem parts can have 7594: multiple lines per response if the weight 7595: assigned exceeds 10. In this case, only 7596: one bubble per line is permitted, but more 7597: than one line might contain bubbles, e.g. 7598: bubbling of: line 1 - J, line 2 - J, 7599: line 3 - B would assign 22 points. 7600: 7601: =cut 7602: 7603: sub prompt_for_corrections { 7604: my ($r, $question, $scan_config, $scan_record, $error, $randomorder, 7605: $randompick, $respnumlookup, $startline) = @_; 7606: my ($current_line,$lines); 7607: my @linenums; 7608: my $questionnum = $question; 7609: my ($first,$responsenum); 7610: if ($question =~ /^(\d+)\.(\d+)$/) { 7611: $question = $1; 7612: my $subquestion = $2; 7613: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { 7614: $responsenum = $respnumlookup->{$question-1}; 7615: if (ref($startline) eq 'HASH') { 7616: $first = $startline->{$question-1}; 7617: } 7618: } else { 7619: $responsenum = $question-1; 7620: $first = $first_bubble_line{$responsenum}; 7621: } 7622: $current_line = $first + 1 ; 7623: my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); 7624: my $subcount = 1; 7625: while ($subcount<$subquestion) { 7626: $current_line += $subans[$subcount-1]; 7627: $subcount ++; 7628: } 7629: $lines = $subans[$subquestion-1]; 7630: } else { 7631: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { 7632: $responsenum = $respnumlookup->{$question-1}; 7633: if (ref($startline) eq 'HASH') { 7634: $first = $startline->{$question-1}; 7635: } 7636: } else { 7637: $responsenum = $question-1; 7638: $first = $first_bubble_line{$responsenum}; 7639: } 7640: $current_line = $first + 1; 7641: $lines = $bubble_lines_per_response{$responsenum}; 7642: } 7643: if ($lines > 1) { 7644: $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />'); 7645: if (($responsetype_per_response{$responsenum} eq 'essayresponse') || 7646: ($responsetype_per_response{$responsenum} eq 'formularesponse') || 7647: ($responsetype_per_response{$responsenum} eq 'stringresponse') || 7648: ($responsetype_per_response{$responsenum} eq 'imageresponse') || 7649: ($responsetype_per_response{$responsenum} eq 'reactionresponse') || 7650: ($responsetype_per_response{$responsenum} eq 'organicresponse')) { 7651: $r->print( 7652: &mt("Although this particular question type requires handgrading, the instructions for this question in the bubblesheet exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines) 7653: .'<br /><br />' 7654: .&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.') 7655: .'<br />' 7656: .&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.') 7657: .'<br />' 7658: .&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.") 7659: .'<br /><br />' 7660: ); 7661: } else { 7662: $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />"); 7663: } 7664: } 7665: for (my $i =0; $i < $lines; $i++) { 7666: my $selected = $$scan_record{"scantron.$current_line.answer"}; 7667: &scantron_bubble_selector($r,$scan_config,$current_line, 7668: $questionnum,$error,split('', $selected)); 7669: push(@linenums,$current_line); 7670: $current_line++; 7671: } 7672: if ($lines > 1) { 7673: $r->print("<hr /><br />"); 7674: } 7675: return @linenums; 7676: } 7677: 7678: =pod 7679: 7680: =item scantron_bubble_selector 7681: 7682: Generates the html radiobuttons to correct a single bubble line 7683: possibly showing the existing the selected bubbles if known 7684: 7685: Arguments: 7686: $r - Apache request object 7687: $scan_config - hash from &get_scantron_config() 7688: $line - Number of the line being displayed. 7689: $questionnum - Question number (may include subquestion) 7690: $error - Type of error. 7691: @selected - Array of bubbles picked on this line. 7692: 7693: =cut 7694: 7695: sub scantron_bubble_selector { 7696: my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_; 7697: my $max=$$scan_config{'Qlength'}; 7698: 7699: my $scmode=$$scan_config{'Qon'}; 7700: if ($scmode eq 'number' || $scmode eq 'letter') { 7701: if (($$scan_config{'BubblesPerRow'} =~ /^\d+$/) && 7702: ($$scan_config{'BubblesPerRow'} > 0)) { 7703: $max=$$scan_config{'BubblesPerRow'}; 7704: if (($scmode eq 'number') && ($max > 10)) { 7705: $max = 10; 7706: } elsif (($scmode eq 'letter') && $max > 26) { 7707: $max = 26; 7708: } 7709: } else { 7710: $max = 10; 7711: } 7712: } 7713: 7714: my @alphabet=('A'..'Z'); 7715: $r->print(&Apache::loncommon::start_data_table(). 7716: &Apache::loncommon::start_data_table_row()); 7717: $r->print('<td rowspan="2" class="LC_leftcol_header">'.$line.'</td>'); 7718: for (my $i=0;$i<$max+1;$i++) { 7719: $r->print("\n".'<td align="center">'); 7720: if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } 7721: else { $r->print(' '); } 7722: $r->print('</td>'); 7723: } 7724: $r->print(&Apache::loncommon::end_data_table_row(). 7725: &Apache::loncommon::start_data_table_row()); 7726: for (my $i=0;$i<$max;$i++) { 7727: $r->print("\n". 7728: '<td><label><input type="radio" name="scantron_correct_Q_'. 7729: $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>"); 7730: } 7731: my $nobub_checked = ' '; 7732: if ($error eq 'missingbubble') { 7733: $nobub_checked = ' checked = "checked" '; 7734: } 7735: $r->print("\n".'<td><label><input type="radio" name="scantron_correct_Q_'. 7736: $line.'" value="none"'.$nobub_checked.'/>'.&mt('No bubble'). 7737: '</label>'."\n".'<input type="hidden" name="scantron_questionnum_Q_'. 7738: $line.'" value="'.$questionnum.'" /></td>'); 7739: $r->print(&Apache::loncommon::end_data_table_row(). 7740: &Apache::loncommon::end_data_table()); 7741: } 7742: 7743: =pod 7744: 7745: =item num_matches 7746: 7747: Counts the number of characters that are the same between the two arguments. 7748: 7749: Arguments: 7750: $orig - CODE from the scanline 7751: $code - CODE to match against 7752: 7753: Returns: 7754: $count - integer count of the number of same characters between the 7755: two arguments 7756: 7757: =cut 7758: 7759: sub num_matches { 7760: my ($orig,$code) = @_; 7761: my @code=split(//,$code); 7762: my @orig=split(//,$orig); 7763: my $same=0; 7764: for (my $i=0;$i<scalar(@code);$i++) { 7765: if ($code[$i] eq $orig[$i]) { $same++; } 7766: } 7767: return $same; 7768: } 7769: 7770: =pod 7771: 7772: =item scantron_get_closely_matching_CODEs 7773: 7774: Cycles through all CODEs and finds the set that has the greatest 7775: number of same characters as the provided CODE 7776: 7777: Arguments: 7778: $allcodes - hash ref returned by &get_codes() 7779: $CODE - CODE from the current scanline 7780: 7781: Returns: 7782: 2 element list 7783: - first elements is number of how closely matching the best fit is 7784: (5 means best set has 5 matching characters) 7785: - second element is an arrary ref containing the set of valid CODEs 7786: that best fit the passed in CODE 7787: 7788: =cut 7789: 7790: sub scantron_get_closely_matching_CODEs { 7791: my ($allcodes,$CODE)=@_; 7792: my @CODEs; 7793: foreach my $testcode (sort(keys(%{$allcodes}))) { 7794: push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode); 7795: } 7796: 7797: return ($#CODEs,$CODEs[-1]); 7798: } 7799: 7800: =pod 7801: 7802: =item get_codes 7803: 7804: Builds a hash which has keys of all of the valid CODEs from the selected 7805: set of remembered CODEs. 7806: 7807: Arguments: 7808: $old_name - name of the set of remembered CODEs 7809: $cdom - domain of the course 7810: $cnum - internal course name 7811: 7812: Returns: 7813: %allcodes - keys are the valid CODEs, values are all 1 7814: 7815: =cut 7816: 7817: sub get_codes { 7818: my ($old_name, $cdom, $cnum) = @_; 7819: if (!$old_name) { 7820: $old_name=$env{'form.scantron_CODElist'}; 7821: } 7822: if (!$cdom) { 7823: $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'}; 7824: } 7825: if (!$cnum) { 7826: $cnum =$env{'course.'.$env{'request.course.id'}.'.num'}; 7827: } 7828: my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"], 7829: $cdom,$cnum); 7830: my %allcodes; 7831: if ($result{"type\0$old_name"} eq 'number') { 7832: %allcodes=map {($_,1)} split(',',$result{$old_name}); 7833: } else { 7834: %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); 7835: } 7836: return %allcodes; 7837: } 7838: 7839: =pod 7840: 7841: =item scantron_validate_CODE 7842: 7843: Validates all scanlines in the selected file to not have any 7844: invalid or underspecified CODEs and that none of the codes are 7845: duplicated if this was requested. 7846: 7847: =cut 7848: 7849: sub scantron_validate_CODE { 7850: my ($r,$currentphase) = @_; 7851: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 7852: if ($scantron_config{'CODElocation'} && 7853: $scantron_config{'CODEstart'} && 7854: $scantron_config{'CODElength'}) { 7855: if (!defined($env{'form.scantron_CODElist'})) { 7856: &FIXME_blow_up() 7857: } 7858: } else { 7859: return (0,$currentphase+1); 7860: } 7861: 7862: my %usedCODEs; 7863: 7864: my %allcodes=&get_codes(); 7865: 7866: my $nav_error; 7867: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the lines per response array. 7868: if ($nav_error) { 7869: $r->print(&navmap_errormsg()); 7870: return(1,$currentphase); 7871: } 7872: 7873: my ($scanlines,$scan_data)=&scantron_getfile(); 7874: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7875: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7876: if ($line=~/^[\s\cz]*$/) { next; } 7877: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 7878: $scan_data); 7879: my $CODE=$$scan_record{'scantron.CODE'}; 7880: my $error=0; 7881: if (!&Apache::lonnet::validCODE($CODE)) { 7882: &scantron_get_correction($r,$i,$scan_record, 7883: \%scantron_config, 7884: $line,'incorrectCODE',\%allcodes); 7885: return(1,$currentphase); 7886: } 7887: if (%allcodes && !exists($allcodes{$CODE}) 7888: && !$$scan_record{'scantron.useCODE'}) { 7889: &scantron_get_correction($r,$i,$scan_record, 7890: \%scantron_config, 7891: $line,'incorrectCODE',\%allcodes); 7892: return(1,$currentphase); 7893: } 7894: if (exists($usedCODEs{$CODE}) 7895: && $env{'form.scantron_CODEunique'} eq 'yes' 7896: && !$$scan_record{'scantron.CODE_ignore_dup'}) { 7897: &scantron_get_correction($r,$i,$scan_record, 7898: \%scantron_config, 7899: $line,'duplicateCODE',$usedCODEs{$CODE}); 7900: return(1,$currentphase); 7901: } 7902: push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); 7903: } 7904: return (0,$currentphase+1); 7905: } 7906: 7907: =pod 7908: 7909: =item scantron_validate_doublebubble 7910: 7911: Validates all scanlines in the selected file to not have any 7912: bubble lines with multiple bubbles marked. 7913: 7914: =cut 7915: 7916: sub scantron_validate_doublebubble { 7917: my ($r,$currentphase) = @_; 7918: #get student info 7919: my $classlist=&Apache::loncoursedata::get_classlist(); 7920: my %idmap=&username_to_idmap($classlist); 7921: my (undef,undef,$sequence)= 7922: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 7923: 7924: #get scantron line setup 7925: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 7926: my ($scanlines,$scan_data)=&scantron_getfile(); 7927: 7928: my $navmap = Apache::lonnavmaps::navmap->new(); 7929: unless (ref($navmap)) { 7930: $r->print(&navmap_errormsg()); 7931: return(1,$currentphase); 7932: } 7933: my $map=$navmap->getResourceByUrl($sequence); 7934: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 7935: my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, 7936: %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline); 7937: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 7938: 7939: my $nav_error; 7940: if (ref($map)) { 7941: $randomorder = $map->randomorder(); 7942: $randompick = $map->randompick(); 7943: if ($randomorder || $randompick) { 7944: $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); 7945: if ($nav_error) { 7946: $r->print(&navmap_errormsg()); 7947: return(1,$currentphase); 7948: } 7949: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 7950: \%grader_randomlists_by_symb,$bubbles_per_row); 7951: } 7952: } else { 7953: $r->print(&navmap_errormsg()); 7954: return(1,$currentphase); 7955: } 7956: 7957: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array. 7958: if ($nav_error) { 7959: $r->print(&navmap_errormsg()); 7960: return(1,$currentphase); 7961: } 7962: 7963: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7964: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7965: if ($line=~/^[\s\cz]*$/) { next; } 7966: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 7967: $scan_data,undef,\%idmap,$randomorder, 7968: $randompick,$sequence,\@master_seq, 7969: \%symb_to_resource,\%grader_partids_by_symb, 7970: \%orderedforcode,\%respnumlookup,\%startline); 7971: if (!defined($$scan_record{'scantron.doubleerror'})) { next; } 7972: &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, 7973: 'doublebubble', 7974: $$scan_record{'scantron.doubleerror'}, 7975: $randomorder,$randompick,\%respnumlookup,\%startline); 7976: return (1,$currentphase); 7977: } 7978: return (0,$currentphase+1); 7979: } 7980: 7981: 7982: sub scantron_get_maxbubble { 7983: my ($nav_error,$scantron_config) = @_; 7984: if (defined($env{'form.scantron_maxbubble'}) && 7985: $env{'form.scantron_maxbubble'}) { 7986: &restore_bubble_lines(); 7987: return $env{'form.scantron_maxbubble'}; 7988: } 7989: 7990: my (undef, undef, $sequence) = 7991: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 7992: 7993: my $navmap=Apache::lonnavmaps::navmap->new(); 7994: unless (ref($navmap)) { 7995: if (ref($nav_error)) { 7996: $$nav_error = 1; 7997: } 7998: return; 7999: } 8000: my $map=$navmap->getResourceByUrl($sequence); 8001: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8002: my $bubbles_per_row = &bubblesheet_bubbles_per_row($scantron_config); 8003: 8004: &Apache::lonxml::clear_problem_counter(); 8005: 8006: my $uname = $env{'user.name'}; 8007: my $udom = $env{'user.domain'}; 8008: my $cid = $env{'request.course.id'}; 8009: my $total_lines = 0; 8010: %bubble_lines_per_response = (); 8011: %first_bubble_line = (); 8012: %subdivided_bubble_lines = (); 8013: %responsetype_per_response = (); 8014: %masterseq_id_responsenum = (); 8015: 8016: my $response_number = 0; 8017: my $bubble_line = 0; 8018: foreach my $resource (@resources) { 8019: my $resid = $resource->id(); 8020: my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname, 8021: $udom,undef,$bubbles_per_row); 8022: if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) { 8023: foreach my $part_id (@{$parts}) { 8024: my $lines; 8025: 8026: # TODO - make this a persistent hash not an array. 8027: 8028: # optionresponse, matchresponse and rankresponse type items 8029: # render as separate sub-questions in exam mode. 8030: if (($analysis->{$part_id.'.type'} eq 'optionresponse') || 8031: ($analysis->{$part_id.'.type'} eq 'matchresponse') || 8032: ($analysis->{$part_id.'.type'} eq 'rankresponse')) { 8033: my ($numbub,$numshown); 8034: if ($analysis->{$part_id.'.type'} eq 'optionresponse') { 8035: if (ref($analysis->{$part_id.'.options'}) eq 'ARRAY') { 8036: $numbub = scalar(@{$analysis->{$part_id.'.options'}}); 8037: } 8038: } elsif ($analysis->{$part_id.'.type'} eq 'matchresponse') { 8039: if (ref($analysis->{$part_id.'.items'}) eq 'ARRAY') { 8040: $numbub = scalar(@{$analysis->{$part_id.'.items'}}); 8041: } 8042: } elsif ($analysis->{$part_id.'.type'} eq 'rankresponse') { 8043: if (ref($analysis->{$part_id.'.foils'}) eq 'ARRAY') { 8044: $numbub = scalar(@{$analysis->{$part_id.'.foils'}}); 8045: } 8046: } 8047: if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') { 8048: $numshown = scalar(@{$analysis->{$part_id.'.shown'}}); 8049: } 8050: my $bubbles_per_row = 8051: &bubblesheet_bubbles_per_row($scantron_config); 8052: my $inner_bubble_lines = int($numbub/$bubbles_per_row); 8053: if (($numbub % $bubbles_per_row) != 0) { 8054: $inner_bubble_lines++; 8055: } 8056: for (my $i=0; $i<$numshown; $i++) { 8057: $subdivided_bubble_lines{$response_number} .= 8058: $inner_bubble_lines.','; 8059: } 8060: $subdivided_bubble_lines{$response_number} =~ s/,$//; 8061: $lines = $numshown * $inner_bubble_lines; 8062: } else { 8063: $lines = $analysis->{"$part_id.bubble_lines"}; 8064: } 8065: 8066: $first_bubble_line{$response_number} = $bubble_line; 8067: $bubble_lines_per_response{$response_number} = $lines; 8068: $responsetype_per_response{$response_number} = 8069: $analysis->{$part_id.'.type'}; 8070: $masterseq_id_responsenum{$resid.'_'.$part_id} = $response_number; 8071: $response_number++; 8072: 8073: $bubble_line += $lines; 8074: $total_lines += $lines; 8075: } 8076: } 8077: } 8078: &Apache::lonnet::delenv('scantron.'); 8079: 8080: &save_bubble_lines(); 8081: $env{'form.scantron_maxbubble'} = 8082: $total_lines; 8083: return $env{'form.scantron_maxbubble'}; 8084: } 8085: 8086: sub bubblesheet_bubbles_per_row { 8087: my ($scantron_config) = @_; 8088: my $bubbles_per_row; 8089: if (ref($scantron_config) eq 'HASH') { 8090: $bubbles_per_row = $scantron_config->{'BubblesPerRow'}; 8091: } 8092: if ((!$bubbles_per_row) || ($bubbles_per_row < 1)) { 8093: $bubbles_per_row = 10; 8094: } 8095: return $bubbles_per_row; 8096: } 8097: 8098: sub scantron_validate_missingbubbles { 8099: my ($r,$currentphase) = @_; 8100: #get student info 8101: my $classlist=&Apache::loncoursedata::get_classlist(); 8102: my %idmap=&username_to_idmap($classlist); 8103: my (undef,undef,$sequence)= 8104: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 8105: 8106: #get scantron line setup 8107: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 8108: my ($scanlines,$scan_data)=&scantron_getfile(); 8109: 8110: my $navmap = Apache::lonnavmaps::navmap->new(); 8111: unless (ref($navmap)) { 8112: $r->print(&navmap_errormsg()); 8113: return(1,$currentphase); 8114: } 8115: 8116: my $map=$navmap->getResourceByUrl($sequence); 8117: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8118: my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, 8119: %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline); 8120: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 8121: 8122: my $nav_error; 8123: if (ref($map)) { 8124: $randomorder = $map->randomorder(); 8125: $randompick = $map->randompick(); 8126: if ($randomorder || $randompick) { 8127: $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); 8128: if ($nav_error) { 8129: $r->print(&navmap_errormsg()); 8130: return(1,$currentphase); 8131: } 8132: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 8133: \%grader_randomlists_by_symb,$bubbles_per_row); 8134: } 8135: } else { 8136: $r->print(&navmap_errormsg()); 8137: return(1,$currentphase); 8138: } 8139: 8140: 8141: my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); 8142: if ($nav_error) { 8143: $r->print(&navmap_errormsg()); 8144: return(1,$currentphase); 8145: } 8146: 8147: if (!$max_bubble) { $max_bubble=2**31; } 8148: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 8149: my $line=&scantron_get_line($scanlines,$scan_data,$i); 8150: if ($line=~/^[\s\cz]*$/) { next; } 8151: my $scan_record = 8152: &scantron_parse_scanline($line,$i,\%scantron_config,$scan_data,undef,\%idmap, 8153: $randomorder,$randompick,$sequence,\@master_seq, 8154: \%symb_to_resource,\%grader_partids_by_symb, 8155: \%orderedforcode,\%respnumlookup,\%startline); 8156: if (!defined($$scan_record{'scantron.missingerror'})) { next; } 8157: my @to_correct; 8158: 8159: # Probably here's where the error is... 8160: 8161: foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { 8162: my $lastbubble; 8163: if ($missing =~ /^(\d+)\.(\d+)$/) { 8164: my $question = $1; 8165: my $subquestion = $2; 8166: my ($first,$responsenum); 8167: if ($randomorder || $randompick) { 8168: $responsenum = $respnumlookup{$question-1}; 8169: $first = $startline{$question-1}; 8170: } else { 8171: $responsenum = $question-1; 8172: $first = $first_bubble_line{$responsenum}; 8173: } 8174: if (!defined($first)) { next; } 8175: my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); 8176: my $subcount = 1; 8177: while ($subcount<$subquestion) { 8178: $first += $subans[$subcount-1]; 8179: $subcount ++; 8180: } 8181: my $count = $subans[$subquestion-1]; 8182: $lastbubble = $first + $count; 8183: } else { 8184: my ($first,$responsenum); 8185: if ($randomorder || $randompick) { 8186: $responsenum = $respnumlookup{$missing-1}; 8187: $first = $startline{$missing-1}; 8188: } else { 8189: $responsenum = $missing-1; 8190: $first = $first_bubble_line{$responsenum}; 8191: } 8192: if (!defined($first)) { next; } 8193: $lastbubble = $first + $bubble_lines_per_response{$responsenum}; 8194: } 8195: if ($lastbubble > $max_bubble) { next; } 8196: push(@to_correct,$missing); 8197: } 8198: if (@to_correct) { 8199: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 8200: $line,'missingbubble',\@to_correct, 8201: $randomorder,$randompick,\%respnumlookup, 8202: \%startline); 8203: return (1,$currentphase); 8204: } 8205: 8206: } 8207: return (0,$currentphase+1); 8208: } 8209: 8210: sub hand_bubble_option { 8211: my (undef, undef, $sequence) = 8212: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 8213: return if ($sequence eq ''); 8214: my $navmap = Apache::lonnavmaps::navmap->new(); 8215: unless (ref($navmap)) { 8216: return; 8217: } 8218: my $needs_hand_bubbles; 8219: my $map=$navmap->getResourceByUrl($sequence); 8220: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8221: foreach my $res (@resources) { 8222: if (ref($res)) { 8223: if ($res->is_problem()) { 8224: my $partlist = $res->parts(); 8225: foreach my $part (@{ $partlist }) { 8226: my @types = $res->responseType($part); 8227: if (grep(/^(chem|essay|image|formula|math|string|functionplot)$/,@types)) { 8228: $needs_hand_bubbles = 1; 8229: last; 8230: } 8231: } 8232: } 8233: } 8234: } 8235: if ($needs_hand_bubbles) { 8236: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 8237: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 8238: return &mt('The sequence to be graded contains response types which are handgraded.').'<p>'. 8239: &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?','<br />'). 8240: '<label><input type="radio" name="scantron_lastbubblepoints" value="'.$bubbles_per_row.'" checked="checked" />'.&mt('[quant,_1,point]',$bubbles_per_row).'</label> '.&mt('or').' '. 8241: '<label><input type="radio" name="scantron_lastbubblepoints" value="0"/>0 points</label></p>'; 8242: } 8243: return; 8244: } 8245: 8246: sub scantron_process_students { 8247: my ($r,$symb) = @_; 8248: 8249: my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); 8250: if (!$symb) { 8251: return ''; 8252: } 8253: my $default_form_data=&defaultFormData($symb); 8254: 8255: my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); 8256: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 8257: my ($scanlines,$scan_data)=&scantron_getfile(); 8258: my $classlist=&Apache::loncoursedata::get_classlist(); 8259: my %idmap=&username_to_idmap($classlist); 8260: my $navmap=Apache::lonnavmaps::navmap->new(); 8261: unless (ref($navmap)) { 8262: $r->print(&navmap_errormsg()); 8263: return ''; 8264: } 8265: my $map=$navmap->getResourceByUrl($sequence); 8266: my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, 8267: %grader_randomlists_by_symb); 8268: if (ref($map)) { 8269: $randomorder = $map->randomorder(); 8270: $randompick = $map->randompick(); 8271: } else { 8272: $r->print(&navmap_errormsg()); 8273: return ''; 8274: } 8275: my $nav_error; 8276: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8277: if ($randomorder || $randompick) { 8278: $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); 8279: if ($nav_error) { 8280: $r->print(&navmap_errormsg()); 8281: return ''; 8282: } 8283: } 8284: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 8285: \%grader_randomlists_by_symb,$bubbles_per_row); 8286: 8287: my ($uname,$udom); 8288: my $result= <<SCANTRONFORM; 8289: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> 8290: <input type="hidden" name="command" value="scantron_configphase" /> 8291: $default_form_data 8292: SCANTRONFORM 8293: $r->print($result); 8294: 8295: my @delayqueue; 8296: my (%completedstudents,%scandata); 8297: 8298: my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam')); 8299: my $count=&get_todo_count($scanlines,$scan_data); 8300: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); 8301: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,'Processing first student'); 8302: $r->print('<br />'); 8303: my $start=&Time::HiRes::time(); 8304: my $i=-1; 8305: my $started; 8306: 8307: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. 8308: if ($nav_error) { 8309: $r->print(&navmap_errormsg()); 8310: return ''; 8311: } 8312: 8313: # If an ssi failed in scantron_get_maxbubble, put an error message out to 8314: # the user and return. 8315: 8316: if ($ssi_error) { 8317: $r->print("</form>"); 8318: &ssi_print_error($r); 8319: &Apache::lonnet::remove_lock($lock); 8320: return ''; # Dunno why the other returns return '' rather than just returning. 8321: } 8322: 8323: my %lettdig = &letter_to_digits(); 8324: my $numletts = scalar(keys(%lettdig)); 8325: my %orderedforcode; 8326: 8327: while ($i<$scanlines->{'count'}) { 8328: ($uname,$udom)=('',''); 8329: $i++; 8330: my $line=&scantron_get_line($scanlines,$scan_data,$i); 8331: if ($line=~/^[\s\cz]*$/) { next; } 8332: if ($started) { 8333: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student'); 8334: } 8335: $started=1; 8336: my %respnumlookup = (); 8337: my %startline = (); 8338: my $total; 8339: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 8340: $scan_data,undef,\%idmap,$randomorder, 8341: $randompick,$sequence,\@master_seq, 8342: \%symb_to_resource,\%grader_partids_by_symb, 8343: \%orderedforcode,\%respnumlookup,\%startline, 8344: \$total); 8345: unless ($uname=&scantron_find_student($scan_record,$scan_data, 8346: \%idmap,$i)) { 8347: &scantron_add_delay(\@delayqueue,$line, 8348: 'Unable to find a student that matches',1); 8349: next; 8350: } 8351: if (exists $completedstudents{$uname}) { 8352: &scantron_add_delay(\@delayqueue,$line, 8353: 'Student '.$uname.' has multiple sheets',2); 8354: next; 8355: } 8356: my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; 8357: my $user = $uname.':'.$usec; 8358: ($uname,$udom)=split(/:/,$uname); 8359: 8360: my $scancode; 8361: if ((exists($scan_record->{'scantron.CODE'})) && 8362: (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { 8363: $scancode = $scan_record->{'scantron.CODE'}; 8364: } else { 8365: $scancode = ''; 8366: } 8367: 8368: my @mapresources = @resources; 8369: if ($randomorder || $randompick) { 8370: @mapresources = 8371: &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource, 8372: \%orderedforcode); 8373: } 8374: my (%partids_by_symb,$res_error); 8375: foreach my $resource (@mapresources) { 8376: my $ressymb; 8377: if (ref($resource)) { 8378: $ressymb = $resource->symb(); 8379: } else { 8380: $res_error = 1; 8381: last; 8382: } 8383: if ((exists($grader_randomlists_by_symb{$ressymb})) || 8384: (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { 8385: my ($analysis,$parts) = 8386: &scantron_partids_tograde($resource,$env{'request.course.id'}, 8387: $uname,$udom,undef,$bubbles_per_row); 8388: $partids_by_symb{$ressymb} = $parts; 8389: } else { 8390: $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb}; 8391: } 8392: } 8393: 8394: if ($res_error) { 8395: &scantron_add_delay(\@delayqueue,$line, 8396: 'An error occurred while grading student '.$uname,2); 8397: next; 8398: } 8399: 8400: &Apache::lonxml::clear_problem_counter(); 8401: &Apache::lonnet::appenv($scan_record); 8402: 8403: if (&scantron_clear_skip($scanlines,$scan_data,$i)) { 8404: &scantron_putfile($scanlines,$scan_data); 8405: } 8406: 8407: if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, 8408: \@mapresources,\%partids_by_symb, 8409: $bubbles_per_row,$randomorder,$randompick, 8410: \%respnumlookup,\%startline) 8411: eq 'ssi_error') { 8412: $ssi_error = 0; # So end of handler error message does not trigger. 8413: $r->print("</form>"); 8414: &ssi_print_error($r); 8415: &Apache::lonnet::remove_lock($lock); 8416: return ''; # Why return ''? Beats me. 8417: } 8418: 8419: if (($scancode) && ($randomorder || $randompick)) { 8420: my $parmresult = 8421: &Apache::lonparmset::storeparm_by_symb($symb, 8422: '0_examcode',2,$scancode, 8423: 'string_examcode',$uname, 8424: $udom); 8425: } 8426: $completedstudents{$uname}={'line'=>$line}; 8427: if ($env{'form.verifyrecord'}) { 8428: my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; 8429: if ($randompick) { 8430: if ($total) { 8431: $lastpos = $total*$scantron_config{'Qlength'}; 8432: } 8433: } 8434: 8435: my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos); 8436: chomp($studentdata); 8437: $studentdata =~ s/\r$//; 8438: my $studentrecord = ''; 8439: my $counter = -1; 8440: foreach my $resource (@mapresources) { 8441: my $ressymb = $resource->symb(); 8442: ($counter,my $recording) = 8443: &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, 8444: $counter,$studentdata,$partids_by_symb{$ressymb}, 8445: \%scantron_config,\%lettdig,$numletts,$randomorder, 8446: $randompick,\%respnumlookup,\%startline); 8447: $studentrecord .= $recording; 8448: } 8449: if ($studentrecord ne $studentdata) { 8450: &Apache::lonxml::clear_problem_counter(); 8451: if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, 8452: \@mapresources,\%partids_by_symb, 8453: $bubbles_per_row,$randomorder,$randompick, 8454: \%respnumlookup,\%startline) 8455: eq 'ssi_error') { 8456: $ssi_error = 0; # So end of handler error message does not trigger. 8457: $r->print("</form>"); 8458: &ssi_print_error($r); 8459: &Apache::lonnet::remove_lock($lock); 8460: delete($completedstudents{$uname}); 8461: return ''; 8462: } 8463: $counter = -1; 8464: $studentrecord = ''; 8465: foreach my $resource (@mapresources) { 8466: my $ressymb = $resource->symb(); 8467: ($counter,my $recording) = 8468: &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, 8469: $counter,$studentdata,$partids_by_symb{$ressymb}, 8470: \%scantron_config,\%lettdig,$numletts, 8471: $randomorder,$randompick,\%respnumlookup, 8472: \%startline); 8473: $studentrecord .= $recording; 8474: } 8475: if ($studentrecord ne $studentdata) { 8476: $r->print('<p><span class="LC_warning">'); 8477: if ($scancode eq '') { 8478: $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2].', 8479: $uname.':'.$udom,$scan_record->{'scantron.ID'})); 8480: } else { 8481: $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2] and CODE: [_3].', 8482: $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode)); 8483: } 8484: $r->print('</span><br />'.&Apache::loncommon::start_data_table()."\n". 8485: &Apache::loncommon::start_data_table_header_row()."\n". 8486: '<th>'.&mt('Source').'</th><th>'.&mt('Bubbled responses').'</th>'. 8487: &Apache::loncommon::end_data_table_header_row()."\n". 8488: &Apache::loncommon::start_data_table_row(). 8489: '<td>'.&mt('Bubblesheet').'</td>'. 8490: '<td><span class="LC_nobreak" style="white-space: pre;"><tt>'.$studentdata.'</tt></span></td>'. 8491: &Apache::loncommon::end_data_table_row(). 8492: &Apache::loncommon::start_data_table_row(). 8493: '<td>'.&mt('Stored submissions').'</td>'. 8494: '<td><span class="LC_nobreak" style="white-space: pre;"><tt>'.$studentrecord.'</tt></span></td>'."\n". 8495: &Apache::loncommon::end_data_table_row(). 8496: &Apache::loncommon::end_data_table().'</p>'); 8497: } else { 8498: $r->print('<br /><span class="LC_warning">'. 8499: &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 />'. 8500: &mt("As a consequence, this user's submission history records two tries."). 8501: '</span><br />'); 8502: } 8503: } 8504: } 8505: if (&Apache::loncommon::connection_aborted($r)) { last; } 8506: } continue { 8507: &Apache::lonxml::clear_problem_counter(); 8508: &Apache::lonnet::delenv('scantron.'); 8509: } 8510: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 8511: &Apache::lonnet::remove_lock($lock); 8512: # my $lasttime = &Time::HiRes::time()-$start; 8513: # $r->print("<p>took $lasttime</p>"); 8514: 8515: $r->print("</form>"); 8516: return ''; 8517: } 8518: 8519: sub graders_resources_pass { 8520: my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb, 8521: $bubbles_per_row) = @_; 8522: if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && 8523: (ref($grader_randomlists_by_symb) eq 'HASH')) { 8524: foreach my $resource (@{$resources}) { 8525: my $ressymb = $resource->symb(); 8526: my ($analysis,$parts) = 8527: &scantron_partids_tograde($resource,$env{'request.course.id'}, 8528: $env{'user.name'},$env{'user.domain'}, 8529: 1,$bubbles_per_row); 8530: $grader_partids_by_symb->{$ressymb} = $parts; 8531: if (ref($analysis) eq 'HASH') { 8532: if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { 8533: $grader_randomlists_by_symb->{$ressymb} = 8534: $analysis->{'parts_withrandomlist'}; 8535: } 8536: } 8537: } 8538: } 8539: return; 8540: } 8541: 8542: =pod 8543: 8544: =item users_order 8545: 8546: Returns array of resources in current map, ordered based on either CODE, 8547: if this is a CODEd exam, or based on student's identity if this is a 8548: "NAMEd" exam. 8549: 8550: Should be used when randomorder and/or randompick applied when the 8551: corresponding exam was printed, prior to students completing bubblesheets 8552: for the version of the exam the student received. 8553: 8554: =cut 8555: 8556: sub users_order { 8557: my ($user,$scancode,$mapurl,$master_seq,$symb_to_resource,$orderedforcode) = @_; 8558: my @mapresources; 8559: unless ((ref($master_seq) eq 'ARRAY') && (ref($symb_to_resource) eq 'HASH')) { 8560: return @mapresources; 8561: } 8562: if ($scancode) { 8563: if ((ref($orderedforcode) eq 'HASH') && (ref($orderedforcode->{$scancode}) eq 'ARRAY')) { 8564: @mapresources = @{$orderedforcode->{$scancode}}; 8565: } else { 8566: $env{'form.CODE'} = $scancode; 8567: my $actual_seq = 8568: &Apache::lonprintout::master_seq_to_person_seq($mapurl, 8569: $master_seq, 8570: $user,$scancode,1); 8571: if (ref($actual_seq) eq 'ARRAY') { 8572: @mapresources = map { $symb_to_resource->{$_}; } @{$actual_seq}; 8573: if (ref($orderedforcode) eq 'HASH') { 8574: if (@mapresources > 0) { 8575: $orderedforcode->{$scancode} = \@mapresources; 8576: } 8577: } 8578: } 8579: delete($env{'form.CODE'}); 8580: } 8581: } else { 8582: my $actual_seq = 8583: &Apache::lonprintout::master_seq_to_person_seq($mapurl, 8584: $master_seq, 8585: $user,undef,1); 8586: if (ref($actual_seq) eq 'ARRAY') { 8587: @mapresources = 8588: map { $symb_to_resource->{$_}; } @{$actual_seq}; 8589: } 8590: } 8591: return @mapresources; 8592: } 8593: 8594: sub grade_student_bubbles { 8595: my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row, 8596: $randomorder,$randompick,$respnumlookup,$startline) = @_; 8597: my $uselookup = 0; 8598: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH') && 8599: (ref($startline) eq 'HASH')) { 8600: $uselookup = 1; 8601: } 8602: 8603: if (ref($resources) eq 'ARRAY') { 8604: my $count = 0; 8605: foreach my $resource (@{$resources}) { 8606: my $ressymb = $resource->symb(); 8607: my %form = ('submitted' => 'scantron', 8608: 'grade_target' => 'grade', 8609: 'grade_username' => $uname, 8610: 'grade_domain' => $udom, 8611: 'grade_courseid' => $env{'request.course.id'}, 8612: 'grade_symb' => $ressymb, 8613: 'CODE' => $scancode 8614: ); 8615: if ($bubbles_per_row ne '') { 8616: $form{'bubbles_per_row'} = $bubbles_per_row; 8617: } 8618: if ($env{'form.scantron_lastbubblepoints'} ne '') { 8619: $form{'scantron_lastbubblepoints'} = $env{'form.scantron_lastbubblepoints'}; 8620: } 8621: if (ref($parts) eq 'HASH') { 8622: if (ref($parts->{$ressymb}) eq 'ARRAY') { 8623: foreach my $part (@{$parts->{$ressymb}}) { 8624: if ($uselookup) { 8625: $form{'scantron_questnum_start.'.$part} = $startline->{$count} + 1; 8626: } else { 8627: $form{'scantron_questnum_start.'.$part} = 8628: 1+$env{'form.scantron.first_bubble_line.'.$count}; 8629: } 8630: $count++; 8631: } 8632: } 8633: } 8634: my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form); 8635: return 'ssi_error' if ($ssi_error); 8636: last if (&Apache::loncommon::connection_aborted($r)); 8637: } 8638: } 8639: return; 8640: } 8641: 8642: sub scantron_upload_scantron_data { 8643: my ($r,$symb)=@_; 8644: my $dom = $env{'request.role.domain'}; 8645: my $domdesc = &Apache::lonnet::domain($dom,'description'); 8646: $r->print(&Apache::loncommon::coursebrowser_javascript($dom)); 8647: my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', 8648: 'domainid', 8649: 'coursename',$dom); 8650: my $syllabuslink = '<a href="javascript:ToSyllabus();">'.&mt('Syllabus').'</a>'. 8651: ('&nbsp'x2).&mt('(shows course personnel)'); 8652: my $default_form_data=&defaultFormData($symb); 8653: my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.'); 8654: 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."); 8655: $r->print(&Apache::lonhtmlcommon::scripttag(' 8656: function checkUpload(formname) { 8657: if (formname.upfile.value == "") { 8658: alert("'.$nofile_alert.'"); 8659: return false; 8660: } 8661: if (formname.courseid.value == "") { 8662: alert("'.$nocourseid_alert.'"); 8663: return false; 8664: } 8665: formname.submit(); 8666: } 8667: 8668: function ToSyllabus() { 8669: var cdom = '."'$dom'".'; 8670: var cnum = document.rules.courseid.value; 8671: if (cdom == "" || cdom == null) { 8672: return; 8673: } 8674: if (cnum == "" || cnum == null) { 8675: return; 8676: } 8677: syllwin=window.open("/public/"+cdom+"/"+cnum+"/syllabus","LONCAPASyllabus", 8678: "height=350,width=350,scrollbars=yes,menubar=no"); 8679: return; 8680: } 8681: 8682: ')); 8683: $r->print(' 8684: <h3>'.&mt('Send bubblesheet data to a course').'</h3> 8685: 8686: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post"> 8687: '.$default_form_data. 8688: &Apache::lonhtmlcommon::start_pick_box(). 8689: &Apache::lonhtmlcommon::row_title(&mt('Course ID')). 8690: '<input name="courseid" type="text" size="30" />'.$select_link. 8691: &Apache::lonhtmlcommon::row_closure(). 8692: &Apache::lonhtmlcommon::row_title(&mt('Course Name')). 8693: '<input name="coursename" type="text" size="30" />'.$syllabuslink. 8694: &Apache::lonhtmlcommon::row_closure(). 8695: &Apache::lonhtmlcommon::row_title(&mt('Domain')). 8696: '<input name="domainid" type="hidden" />'.$domdesc. 8697: &Apache::lonhtmlcommon::row_closure(). 8698: &Apache::lonhtmlcommon::row_title(&mt('File to upload')). 8699: '<input type="file" name="upfile" size="50" />'. 8700: &Apache::lonhtmlcommon::row_closure(1). 8701: &Apache::lonhtmlcommon::end_pick_box().'<br /> 8702: 8703: <input name="command" value="scantronupload_save" type="hidden" /> 8704: <input type="button" onclick="javascript:checkUpload(this.form);" value="'.&mt('Upload Bubblesheet Data').'" /> 8705: </form> 8706: '); 8707: return ''; 8708: } 8709: 8710: 8711: sub scantron_upload_scantron_data_save { 8712: my($r,$symb)=@_; 8713: my $doanotherupload= 8714: '<br /><form action="/adm/grades" method="post">'."\n". 8715: '<input type="hidden" name="command" value="scantronupload" />'."\n". 8716: '<input type="submit" name="submit" value="'.&mt('Do Another Upload').'" />'."\n". 8717: '</form>'."\n"; 8718: if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && 8719: !&Apache::lonnet::allowed('usc', 8720: $env{'form.domainid'}.'_'.$env{'form.courseid'})) { 8721: $r->print(&mt("You are not allowed to upload bubblesheet data to the requested course.")."<br />"); 8722: unless ($symb) { 8723: $r->print($doanotherupload); 8724: } 8725: return ''; 8726: } 8727: my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); 8728: my $uploadedfile; 8729: $r->print('<p>'.&mt('Uploading file to [_1]','"'.$coursedata{'description'}.'"').'</p>'); 8730: if (length($env{'form.upfile'}) < 2) { 8731: $r->print( 8732: &Apache::lonhtmlcommon::confirm_success( 8733: &mt('The file: [_1] you attempted to upload contained no information. Please check that you entered the correct filename.', 8734: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'),1)); 8735: } else { 8736: my $result = 8737: &Apache::lonnet::userfileupload('upfile','','scantron','','','', 8738: $env{'form.courseid'},$env{'form.domainid'}); 8739: if ($result =~ m{^/uploaded/}) { 8740: $r->print( 8741: &Apache::lonhtmlcommon::confirm_success(&mt('Upload successful')).'<br />'. 8742: &mt('Uploaded [_1] bytes of data into location: [_2]', 8743: (length($env{'form.upfile'})-1), 8744: '<span class="LC_filename">'.$result.'</span>')); 8745: ($uploadedfile) = ($result =~ m{/([^/]+)$}); 8746: $r->print(&validate_uploaded_scantron_file($env{'form.domainid'}, 8747: $env{'form.courseid'},$uploadedfile)); 8748: } else { 8749: $r->print( 8750: &Apache::lonhtmlcommon::confirm_success(&mt('Upload failed'),1).'<br />'. 8751: &mt('An error ([_1]) occurred when attempting to upload the file: [_2]', 8752: $result, 8753: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>')); 8754: } 8755: } 8756: if ($symb) { 8757: $r->print(&scantron_selectphase($r,$uploadedfile,$symb)); 8758: } else { 8759: $r->print($doanotherupload); 8760: } 8761: return ''; 8762: } 8763: 8764: sub validate_uploaded_scantron_file { 8765: my ($cdom,$cname,$fname) = @_; 8766: my $scanlines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.$fname); 8767: my @lines; 8768: if ($scanlines ne '-1') { 8769: @lines=split("\n",$scanlines,-1); 8770: } 8771: my $output; 8772: if (@lines) { 8773: my (%counts,$max_match_format); 8774: my ($found_match_count,$max_match_count,$max_match_pct) = (0,0,0); 8775: my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cname); 8776: my %idmap = &username_to_idmap($classlist); 8777: foreach my $key (keys(%idmap)) { 8778: my $lckey = lc($key); 8779: $idmap{$lckey} = $idmap{$key}; 8780: } 8781: my %unique_formats; 8782: my @formatlines = &get_scantronformat_file(); 8783: foreach my $line (@formatlines) { 8784: chomp($line); 8785: my @config = split(/:/,$line); 8786: my $idstart = $config[5]; 8787: my $idlength = $config[6]; 8788: if (($idstart ne '') && ($idlength > 0)) { 8789: if (ref($unique_formats{$idstart.':'.$idlength}) eq 'ARRAY') { 8790: push(@{$unique_formats{$idstart.':'.$idlength}},$config[0].':'.$config[1]); 8791: } else { 8792: $unique_formats{$idstart.':'.$idlength} = [$config[0].':'.$config[1]]; 8793: } 8794: } 8795: } 8796: foreach my $key (keys(%unique_formats)) { 8797: my ($idstart,$idlength) = split(':',$key); 8798: %{$counts{$key}} = ( 8799: 'found' => 0, 8800: 'total' => 0, 8801: ); 8802: foreach my $line (@lines) { 8803: next if ($line =~ /^#/); 8804: next if ($line =~ /^[\s\cz]*$/); 8805: my $id = substr($line,$idstart-1,$idlength); 8806: $id = lc($id); 8807: if (exists($idmap{$id})) { 8808: $counts{$key}{'found'} ++; 8809: } 8810: $counts{$key}{'total'} ++; 8811: } 8812: if ($counts{$key}{'total'}) { 8813: my $percent_match = (100*$counts{$key}{'found'})/($counts{$key}{'total'}); 8814: if (($max_match_format eq '') || ($percent_match > $max_match_pct)) { 8815: $max_match_pct = $percent_match; 8816: $max_match_format = $key; 8817: $found_match_count = $counts{$key}{'found'}; 8818: $max_match_count = $counts{$key}{'total'}; 8819: } 8820: } 8821: } 8822: if (ref($unique_formats{$max_match_format}) eq 'ARRAY') { 8823: my $format_descs; 8824: my $numwithformat = @{$unique_formats{$max_match_format}}; 8825: for (my $i=0; $i<$numwithformat; $i++) { 8826: my ($name,$desc) = split(':',$unique_formats{$max_match_format}[$i]); 8827: if ($i<$numwithformat-2) { 8828: $format_descs .= '"<i>'.$desc.'</i>", '; 8829: } elsif ($i==$numwithformat-2) { 8830: $format_descs .= '"<i>'.$desc.'</i>" '.&mt('and').' '; 8831: } elsif ($i==$numwithformat-1) { 8832: $format_descs .= '"<i>'.$desc.'</i>"'; 8833: } 8834: } 8835: my $showpct = sprintf("%.0f",$max_match_pct).'%'; 8836: $output .= '<br />'; 8837: if ($found_match_count == $max_match_count) { 8838: # 100% matching entries 8839: $output .= &Apache::lonhtmlcommon::confirm_success( 8840: &mt('Comparison of student IDs: [_1] matching ([quant,_2,entry,entries])', 8841: '<b>'.$showpct.'</b>',$found_match_count)).'<br />'. 8842: &mt('Comparison of student IDs in the uploaded file with'. 8843: ' the course roster found matches for [_1] of the [_2] entries'. 8844: ' in the file (for the format defined for [_3]).', 8845: '<b>'.$showpct.'</b>','<b>'.$max_match_count.'</b>',$format_descs); 8846: } else { 8847: # Not all entries matching? -> Show warning and additional info 8848: $output .= 8849: &Apache::lonhtmlcommon::confirm_success( 8850: &mt('Comparison of student IDs: [_1] matching ([_2]/[quant,_3,entry,entries])', 8851: '<b>'.$showpct.'</b>',$found_match_count,$max_match_count).'<br />'. 8852: &mt('Not all entries could be matched!'),1).'<br />'. 8853: &mt('Comparison of student IDs in the uploaded file with'. 8854: ' the course roster found matches for [_1] of the [_2] entries'. 8855: ' in the file (for the format defined for [_3]).', 8856: '<b>'.$showpct.'</b>','<b>'.$max_match_count.'</b>',$format_descs). 8857: '<p class="LC_info">'. 8858: &mt('A low percentage of matches results from one of the following:'). 8859: '</p><ul>'. 8860: '<li>'.&mt('The file was uploaded to the wrong course.').'</li>'. 8861: '<li>'.&mt('The data is not in the format expected for the domain: [_1]', 8862: '<i>'.$cdom.'</i>').'</li>'. 8863: '<li>'.&mt('Students did not bubble their IDs, or mis-bubbled them').'</li>'. 8864: '<li>'.&mt('The course roster is not up to date.').'</li>'. 8865: '</ul>'; 8866: } 8867: } 8868: } else { 8869: $output = '<p class="LC_warning">'.&mt('Uploaded file contained no data').'</p>'; 8870: } 8871: return $output; 8872: } 8873: 8874: sub valid_file { 8875: my ($requested_file)=@_; 8876: foreach my $filename (sort(&scantron_filenames())) { 8877: if ($requested_file eq $filename) { return 1; } 8878: } 8879: return 0; 8880: } 8881: 8882: sub scantron_download_scantron_data { 8883: my ($r,$symb)=@_; 8884: my $default_form_data=&defaultFormData($symb); 8885: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 8886: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 8887: my $file=$env{'form.scantron_selectfile'}; 8888: if (! &valid_file($file)) { 8889: $r->print(' 8890: <p> 8891: '.&mt('The requested filename was invalid.').' 8892: </p> 8893: '); 8894: return; 8895: } 8896: my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; 8897: my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file; 8898: my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file; 8899: &Apache::lonnet::allowuploaded('/adm/grades',$orig); 8900: &Apache::lonnet::allowuploaded('/adm/grades',$corrected); 8901: &Apache::lonnet::allowuploaded('/adm/grades',$skipped); 8902: $r->print(' 8903: <p> 8904: '.&mt('[_1]Original[_2] file as uploaded by the bubblesheet office.', 8905: '<a href="'.$orig.'">','</a>').' 8906: </p> 8907: <p> 8908: '.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.', 8909: '<a href="'.$corrected.'">','</a>').' 8910: </p> 8911: <p> 8912: '.&mt('[_1]Skipped[_2], a file of records that were skipped.', 8913: '<a href="'.$skipped.'">','</a>').' 8914: </p> 8915: '); 8916: return ''; 8917: } 8918: 8919: sub checkscantron_results { 8920: my ($r,$symb) = @_; 8921: if (!$symb) {return '';} 8922: my $cid = $env{'request.course.id'}; 8923: my %lettdig = &letter_to_digits(); 8924: my $numletts = scalar(keys(%lettdig)); 8925: my $cnum = $env{'course.'.$cid.'.num'}; 8926: my $cdom = $env{'course.'.$cid.'.domain'}; 8927: my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); 8928: my %record; 8929: my %scantron_config = 8930: &Apache::grades::get_scantron_config($env{'form.scantron_format'}); 8931: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 8932: my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile(); 8933: my $classlist=&Apache::loncoursedata::get_classlist(); 8934: my %idmap=&Apache::grades::username_to_idmap($classlist); 8935: my $navmap=Apache::lonnavmaps::navmap->new(); 8936: unless (ref($navmap)) { 8937: $r->print(&navmap_errormsg()); 8938: return ''; 8939: } 8940: my $map=$navmap->getResourceByUrl($sequence); 8941: my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, 8942: %grader_randomlists_by_symb,%orderedforcode); 8943: if (ref($map)) { 8944: $randomorder=$map->randomorder(); 8945: $randompick=$map->randompick(); 8946: } 8947: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8948: my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); 8949: if ($nav_error) { 8950: $r->print(&navmap_errormsg()); 8951: return ''; 8952: } 8953: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 8954: \%grader_randomlists_by_symb,$bubbles_per_row); 8955: my ($uname,$udom); 8956: my (%scandata,%lastname,%bylast); 8957: $r->print(' 8958: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n"); 8959: 8960: my @delayqueue; 8961: my %completedstudents; 8962: 8963: my $count=&get_todo_count($scanlines,$scan_data); 8964: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); 8965: my ($username,$domain,$started); 8966: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. 8967: if ($nav_error) { 8968: $r->print(&navmap_errormsg()); 8969: return ''; 8970: } 8971: 8972: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,'Processing first student'); 8973: my $start=&Time::HiRes::time(); 8974: my $i=-1; 8975: 8976: while ($i<$scanlines->{'count'}) { 8977: ($username,$domain,$uname)=('','',''); 8978: $i++; 8979: my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i); 8980: if ($line=~/^[\s\cz]*$/) { next; } 8981: if ($started) { 8982: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student'); 8983: } 8984: $started=1; 8985: my $scan_record= 8986: &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config, 8987: $scan_data); 8988: unless ($uname=&scantron_find_student($scan_record,$scan_data, 8989: \%idmap,$i)) { 8990: &Apache::grades::scantron_add_delay(\@delayqueue,$line, 8991: 'Unable to find a student that matches',1); 8992: next; 8993: } 8994: if (exists $completedstudents{$uname}) { 8995: &Apache::grades::scantron_add_delay(\@delayqueue,$line, 8996: 'Student '.$uname.' has multiple sheets',2); 8997: next; 8998: } 8999: my $pid = $scan_record->{'scantron.ID'}; 9000: $lastname{$pid} = $scan_record->{'scantron.LastName'}; 9001: push(@{$bylast{$lastname{$pid}}},$pid); 9002: my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; 9003: my $user = $uname.':'.$usec; 9004: ($username,$domain)=split(/:/,$uname); 9005: 9006: my $scancode; 9007: if ((exists($scan_record->{'scantron.CODE'})) && 9008: (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { 9009: $scancode = $scan_record->{'scantron.CODE'}; 9010: } else { 9011: $scancode = ''; 9012: } 9013: 9014: my @mapresources = @resources; 9015: my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; 9016: my %respnumlookup=(); 9017: my %startline=(); 9018: if ($randomorder || $randompick) { 9019: @mapresources = 9020: &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource, 9021: \%orderedforcode); 9022: my $total = &get_respnum_lookups($sequence,$scan_data,\%idmap,$line, 9023: $scan_record,\@master_seq,\%symb_to_resource, 9024: \%grader_partids_by_symb,\%orderedforcode, 9025: \%respnumlookup,\%startline); 9026: if ($randompick && $total) { 9027: $lastpos = $total*$scantron_config{'Qlength'}; 9028: } 9029: } 9030: $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos); 9031: chomp($scandata{$pid}); 9032: $scandata{$pid} =~ s/\r$//; 9033: 9034: my $counter = -1; 9035: foreach my $resource (@mapresources) { 9036: my $parts; 9037: my $ressymb = $resource->symb(); 9038: if ((exists($grader_randomlists_by_symb{$ressymb})) || 9039: (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { 9040: (my $analysis,$parts) = 9041: &scantron_partids_tograde($resource,$env{'request.course.id'}, 9042: $username,$domain,undef, 9043: $bubbles_per_row); 9044: } else { 9045: $parts = $grader_partids_by_symb{$ressymb}; 9046: } 9047: ($counter,my $recording) = 9048: &verify_scantron_grading($resource,$domain,$username,$cid,$counter, 9049: $scandata{$pid},$parts, 9050: \%scantron_config,\%lettdig,$numletts, 9051: $randomorder,$randompick, 9052: \%respnumlookup,\%startline); 9053: $record{$pid} .= $recording; 9054: } 9055: } 9056: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 9057: $r->print('<br />'); 9058: my ($okstudents,$badstudents,$numstudents,$passed,$failed); 9059: $passed = 0; 9060: $failed = 0; 9061: $numstudents = 0; 9062: foreach my $last (sort(keys(%bylast))) { 9063: if (ref($bylast{$last}) eq 'ARRAY') { 9064: foreach my $pid (sort(@{$bylast{$last}})) { 9065: my $showscandata = $scandata{$pid}; 9066: my $showrecord = $record{$pid}; 9067: $showscandata =~ s/\s/ /g; 9068: $showrecord =~ s/\s/ /g; 9069: if ($scandata{$pid} eq $record{$pid}) { 9070: my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row'; 9071: $okstudents .= '<tr class="'.$css_class.'">'. 9072: '<td>'.&mt('Bubblesheet').'</td><td>'.$showscandata.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n". 9073: '</tr>'."\n". 9074: '<tr class="'.$css_class.'">'."\n". 9075: '<td>Submissions</td><td>'.$showrecord.'</td></tr>'."\n"; 9076: $passed ++; 9077: } else { 9078: my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row'; 9079: $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". 9080: '</tr>'."\n". 9081: '<tr class="'.$css_class.'">'."\n". 9082: '<td>Submissions</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n". 9083: '</tr>'."\n"; 9084: $failed ++; 9085: } 9086: $numstudents ++; 9087: } 9088: } 9089: } 9090: $r->print( 9091: '<p>' 9092: .&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).', 9093: '<b>', 9094: $numstudents, 9095: '</b>', 9096: $env{'form.scantron_maxbubble'}) 9097: .'</p>' 9098: ); 9099: $r->print('<p>' 9100: .&mt('Exact matches for [_1][quant,_2,student][_3].','<b>',$passed,'</b>') 9101: .'<br />' 9102: .&mt('Discrepancies detected for [_1][quant,_2,student][_3].','<b>',$failed,'</b>') 9103: .'</p>' 9104: ); 9105: if ($passed) { 9106: $r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />'); 9107: $r->print(&Apache::loncommon::start_data_table()."\n". 9108: &Apache::loncommon::start_data_table_header_row()."\n". 9109: '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'. 9110: &Apache::loncommon::end_data_table_header_row()."\n". 9111: $okstudents."\n". 9112: &Apache::loncommon::end_data_table().'<br />'); 9113: } 9114: if ($failed) { 9115: $r->print(&mt('Students with differences between bubblesheet data and submissions are as follows:').'<br /><br />'); 9116: $r->print(&Apache::loncommon::start_data_table()."\n". 9117: &Apache::loncommon::start_data_table_header_row()."\n". 9118: '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'. 9119: &Apache::loncommon::end_data_table_header_row()."\n". 9120: $badstudents."\n". 9121: &Apache::loncommon::end_data_table()).'<br />'. 9122: &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.'); 9123: } 9124: $r->print('</form><br />'); 9125: return; 9126: } 9127: 9128: sub verify_scantron_grading { 9129: my ($resource,$domain,$username,$cid,$counter,$scandata,$partids, 9130: $scantron_config,$lettdig,$numletts,$randomorder,$randompick, 9131: $respnumlookup,$startline) = @_; 9132: my ($record,%expected,%startpos); 9133: return ($counter,$record) if (!ref($resource)); 9134: return ($counter,$record) if (!$resource->is_problem()); 9135: my $symb = $resource->symb(); 9136: return ($counter,$record) if (ref($partids) ne 'ARRAY'); 9137: foreach my $part_id (@{$partids}) { 9138: $counter ++; 9139: $expected{$part_id} = 0; 9140: my $respnum = $counter; 9141: if ($randomorder || $randompick) { 9142: $respnum = $respnumlookup->{$counter}; 9143: $startpos{$part_id} = $startline->{$counter} + 1; 9144: } else { 9145: $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"}; 9146: } 9147: if ($env{"form.scantron.sub_bubblelines.$respnum"}) { 9148: my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$respnum"}); 9149: foreach my $item (@sub_lines) { 9150: $expected{$part_id} += $item; 9151: } 9152: } else { 9153: $expected{$part_id} = $env{"form.scantron.bubblelines.$respnum"}; 9154: } 9155: } 9156: if ($symb) { 9157: my %recorded; 9158: my (%returnhash) = &Apache::lonnet::restore($symb,$cid,$domain,$username); 9159: if ($returnhash{'version'}) { 9160: my %lasthash=(); 9161: my $version; 9162: for ($version=1;$version<=$returnhash{'version'};$version++) { 9163: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) { 9164: $lasthash{$key}=$returnhash{$version.':'.$key}; 9165: } 9166: } 9167: foreach my $key (keys(%lasthash)) { 9168: if ($key =~ /\.scantron$/) { 9169: my $value = &unescape($lasthash{$key}); 9170: my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/); 9171: if ($value eq '') { 9172: for (my $i=0; $i<$expected{$part_id}; $i++) { 9173: for (my $j=0; $j<$scantron_config->{'length'}; $j++) { 9174: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 9175: } 9176: } 9177: } else { 9178: my @tocheck; 9179: my @items = split(//,$value); 9180: if (($scantron_config->{'Qon'} eq 'letter') || 9181: ($scantron_config->{'Qon'} eq 'number')) { 9182: if (@items < $expected{$part_id}) { 9183: my $fragment = substr($scandata,$startpos{$part_id},$expected{$part_id}); 9184: my @singles = split(//,$fragment); 9185: foreach my $pos (@singles) { 9186: if ($pos eq ' ') { 9187: push(@tocheck,$pos); 9188: } else { 9189: my $next = shift(@items); 9190: push(@tocheck,$next); 9191: } 9192: } 9193: } else { 9194: @tocheck = @items; 9195: } 9196: foreach my $letter (@tocheck) { 9197: if ($scantron_config->{'Qon'} eq 'letter') { 9198: if ($letter !~ /^[A-J]$/) { 9199: $letter = $scantron_config->{'Qoff'}; 9200: } 9201: $recorded{$part_id} .= $letter; 9202: } elsif ($scantron_config->{'Qon'} eq 'number') { 9203: my $digit; 9204: if ($letter !~ /^[A-J]$/) { 9205: $digit = $scantron_config->{'Qoff'}; 9206: } else { 9207: $digit = $lettdig->{$letter}; 9208: } 9209: $recorded{$part_id} .= $digit; 9210: } 9211: } 9212: } else { 9213: @tocheck = @items; 9214: for (my $i=0; $i<$expected{$part_id}; $i++) { 9215: my $curr_sub = shift(@tocheck); 9216: my $digit; 9217: if ($curr_sub =~ /^[A-J]$/) { 9218: $digit = $lettdig->{$curr_sub}-1; 9219: } 9220: if ($curr_sub eq 'J') { 9221: $digit += scalar($numletts); 9222: } 9223: for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) { 9224: if ($j == $digit) { 9225: $recorded{$part_id} .= $scantron_config->{'Qon'}; 9226: } else { 9227: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 9228: } 9229: } 9230: } 9231: } 9232: } 9233: } 9234: } 9235: } 9236: foreach my $part_id (@{$partids}) { 9237: if ($recorded{$part_id} eq '') { 9238: for (my $i=0; $i<$expected{$part_id}; $i++) { 9239: for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) { 9240: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 9241: } 9242: } 9243: } 9244: $record .= $recorded{$part_id}; 9245: } 9246: } 9247: return ($counter,$record); 9248: } 9249: 9250: sub letter_to_digits { 9251: my %lettdig = ( 9252: A => 1, 9253: B => 2, 9254: C => 3, 9255: D => 4, 9256: E => 5, 9257: F => 6, 9258: G => 7, 9259: H => 8, 9260: I => 9, 9261: J => 0, 9262: ); 9263: return %lettdig; 9264: } 9265: 9266: 9267: #-------- end of section for handling grading scantron forms ------- 9268: # 9269: #------------------------------------------------------------------- 9270: 9271: #-------------------------- Menu interface ------------------------- 9272: # 9273: #--- Href with symb and command --- 9274: 9275: sub href_symb_cmd { 9276: my ($symb,$cmd)=@_; 9277: return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&command='.$cmd; 9278: } 9279: 9280: sub grading_menu { 9281: my ($request,$symb) = @_; 9282: if (!$symb) {return '';} 9283: 9284: my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb), 9285: 'command'=>'individual'); 9286: 9287: my $url1a = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 9288: 9289: $fields{'command'}='ungraded'; 9290: my $url1b=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 9291: 9292: $fields{'command'}='table'; 9293: my $url1c=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 9294: 9295: $fields{'command'}='all_for_one'; 9296: my $url1d=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 9297: 9298: $fields{'command'}='downloadfilesselect'; 9299: my $url1e=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 9300: 9301: $fields{'command'} = 'csvform'; 9302: my $url2 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 9303: 9304: $fields{'command'} = 'processclicker'; 9305: my $url3 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 9306: 9307: $fields{'command'} = 'scantron_selectphase'; 9308: my $url4 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 9309: 9310: $fields{'command'} = 'initialverifyreceipt'; 9311: my $url5 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 9312: 9313: my @menu = ({ categorytitle=>'Hand Grading', 9314: items =>[ 9315: { linktext => 'Select individual students to grade', 9316: url => $url1a, 9317: permission => 'F', 9318: icon => 'grade_students.png', 9319: linktitle => 'Grade current resource for a selection of students.' 9320: }, 9321: { linktext => 'Grade ungraded submissions.', 9322: url => $url1b, 9323: permission => 'F', 9324: icon => 'ungrade_sub.png', 9325: linktitle => 'Grade all submissions that have not been graded yet.' 9326: }, 9327: 9328: { linktext => 'Grading table', 9329: url => $url1c, 9330: permission => 'F', 9331: icon => 'grading_table.png', 9332: linktitle => 'Grade current resource for all students.' 9333: }, 9334: { linktext => 'Grade page/folder for one student', 9335: url => $url1d, 9336: permission => 'F', 9337: icon => 'grade_PageFolder.png', 9338: linktitle => 'Grade all resources in current page/sequence/folder for one student.' 9339: }, 9340: { linktext => 'Download submissions', 9341: url => $url1e, 9342: permission => 'F', 9343: icon => 'download_sub.png', 9344: linktitle => 'Download all students submissions.' 9345: }]}, 9346: { categorytitle=>'Automated Grading', 9347: items =>[ 9348: 9349: { linktext => 'Upload Scores', 9350: url => $url2, 9351: permission => 'F', 9352: icon => 'uploadscores.png', 9353: linktitle => 'Specify a file containing the class scores for current resource.' 9354: }, 9355: { linktext => 'Process Clicker', 9356: url => $url3, 9357: permission => 'F', 9358: icon => 'addClickerInfoFile.png', 9359: linktitle => 'Specify a file containing the clicker information for this resource.' 9360: }, 9361: { linktext => 'Grade/Manage/Review Bubblesheets', 9362: url => $url4, 9363: permission => 'F', 9364: icon => 'bubblesheet.png', 9365: linktitle => 'Grade bubblesheet exams, upload/download bubblesheet data files, and review previously graded bubblesheet exams.' 9366: }, 9367: { linktext => 'Verify Receipt Number', 9368: url => $url5, 9369: permission => 'F', 9370: icon => 'receipt_number.png', 9371: linktitle => 'Verify a system-generated receipt number for correct problem solution.' 9372: } 9373: 9374: ] 9375: }); 9376: 9377: # Create the menu 9378: my $Str; 9379: $Str .= '<form method="post" action="" name="gradingMenu">'; 9380: $Str .= '<input type="hidden" name="command" value="" />'. 9381: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 9382: 9383: $Str .= &Apache::lonhtmlcommon::generate_menu(@menu); 9384: return $Str; 9385: } 9386: 9387: 9388: sub ungraded { 9389: my ($request)=@_; 9390: &submit_options($request); 9391: } 9392: 9393: sub submit_options_sequence { 9394: my ($request,$symb) = @_; 9395: if (!$symb) {return '';} 9396: &commonJSfunctions($request); 9397: my $result; 9398: 9399: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 9400: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 9401: $result.=&selectfield(0). 9402: '<input type="hidden" name="command" value="pickStudentPage" /> 9403: <div> 9404: <input type="submit" value="'.&mt('Next').' →" /> 9405: </div> 9406: </div> 9407: </form>'; 9408: return $result; 9409: } 9410: 9411: sub submit_options_table { 9412: my ($request,$symb) = @_; 9413: if (!$symb) {return '';} 9414: &commonJSfunctions($request); 9415: my $result; 9416: 9417: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 9418: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 9419: 9420: $result.=&selectfield(0). 9421: '<input type="hidden" name="command" value="viewgrades" /> 9422: <div> 9423: <input type="submit" value="'.&mt('Next').' →" /> 9424: </div> 9425: </div> 9426: </form>'; 9427: return $result; 9428: } 9429: 9430: sub submit_options_download { 9431: my ($request,$symb) = @_; 9432: if (!$symb) {return '';} 9433: 9434: &commonJSfunctions($request); 9435: 9436: my $result='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 9437: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 9438: $result.=' 9439: <h2> 9440: '.&mt('Select Students for Which to Download Submissions').' 9441: </h2>'.&selectfield(1).' 9442: <input type="hidden" name="command" value="downloadfileslink" /> 9443: <input type="submit" value="'.&mt('Next').' →" /> 9444: </div> 9445: </div> 9446: 9447: 9448: </form>'; 9449: return $result; 9450: } 9451: 9452: #--- Displays the submissions first page ------- 9453: sub submit_options { 9454: my ($request,$symb) = @_; 9455: if (!$symb) {return '';} 9456: 9457: &commonJSfunctions($request); 9458: my $result; 9459: 9460: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 9461: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 9462: $result.=&selectfield(1).' 9463: <input type="hidden" name="command" value="submission" /> 9464: <input type="submit" value="'.&mt('Next').' →" /> 9465: </div> 9466: </div> 9467: 9468: 9469: </form>'; 9470: return $result; 9471: } 9472: 9473: sub selectfield { 9474: my ($full)=@_; 9475: my %options = 9476: (&Apache::lonlocal::texthash( 9477: 'yes' => 'with submissions', 9478: 'queued' => 'in grading queue', 9479: 'graded' => 'with ungraded submissions', 9480: 'incorrect' => 'with incorrect submissions', 9481: 'all' => 'with any status'), 9482: 'select_form_order' => ['yes','queued','graded','incorrect','all']); 9483: my $result='<div class="LC_columnSection"> 9484: 9485: <fieldset> 9486: <legend> 9487: '.&mt('Sections').' 9488: </legend> 9489: '.&Apache::lonstatistics::SectionSelect('section','multiple',5).' 9490: </fieldset> 9491: 9492: <fieldset> 9493: <legend> 9494: '.&mt('Groups').' 9495: </legend> 9496: '.&Apache::lonstatistics::GroupSelect('group','multiple',5).' 9497: </fieldset> 9498: 9499: <fieldset> 9500: <legend> 9501: '.&mt('Access Status').' 9502: </legend> 9503: '.&Apache::lonhtmlcommon::StatusOptions(undef,undef,5,undef,'mult').' 9504: </fieldset>'; 9505: if ($full) { 9506: $result.=' 9507: <fieldset> 9508: <legend> 9509: '.&mt('Submission Status').' 9510: </legend>'. 9511: &Apache::loncommon::select_form('all','submitonly',\%options). 9512: '</fieldset>'; 9513: } 9514: $result.='</div><br />'; 9515: return $result; 9516: } 9517: 9518: sub reset_perm { 9519: undef(%perm); 9520: } 9521: 9522: sub init_perm { 9523: &reset_perm(); 9524: foreach my $test_perm ('vgr','mgr','opa') { 9525: 9526: my $scope = $env{'request.course.id'}; 9527: if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) { 9528: 9529: $scope .= '/'.$env{'request.course.sec'}; 9530: if ( $perm{$test_perm}= 9531: &Apache::lonnet::allowed($test_perm,$scope)) { 9532: $perm{$test_perm.'_section'}=$env{'request.course.sec'}; 9533: } else { 9534: delete($perm{$test_perm}); 9535: } 9536: } 9537: } 9538: } 9539: 9540: sub init_old_essays { 9541: my ($symb,$apath,$adom,$aname) = @_; 9542: if ($symb ne '') { 9543: my %essays = &Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); 9544: if (keys(%essays) > 0) { 9545: $old_essays{$symb} = \%essays; 9546: } 9547: } 9548: return; 9549: } 9550: 9551: sub reset_old_essays { 9552: undef(%old_essays); 9553: } 9554: 9555: sub gather_clicker_ids { 9556: my %clicker_ids; 9557: 9558: my $classlist = &Apache::loncoursedata::get_classlist(); 9559: 9560: # Set up a couple variables. 9561: my $username_idx = &Apache::loncoursedata::CL_SNAME(); 9562: my $domain_idx = &Apache::loncoursedata::CL_SDOM(); 9563: my $status_idx = &Apache::loncoursedata::CL_STATUS(); 9564: 9565: foreach my $student (keys(%$classlist)) { 9566: if ($classlist->{$student}->[$status_idx] ne 'Active') { next; } 9567: my $username = $classlist->{$student}->[$username_idx]; 9568: my $domain = $classlist->{$student}->[$domain_idx]; 9569: my $clickers = 9570: (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; 9571: foreach my $id (split(/\,/,$clickers)) { 9572: $id=~s/^[\#0]+//; 9573: $id=~s/[\-\:]//g; 9574: if (exists($clicker_ids{$id})) { 9575: $clicker_ids{$id}.=','.$username.':'.$domain; 9576: } else { 9577: $clicker_ids{$id}=$username.':'.$domain; 9578: } 9579: } 9580: } 9581: return %clicker_ids; 9582: } 9583: 9584: sub gather_adv_clicker_ids { 9585: my %clicker_ids; 9586: my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; 9587: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 9588: my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum); 9589: foreach my $element (sort(keys(%coursepersonnel))) { 9590: foreach my $person (split(/\,/,$coursepersonnel{$element})) { 9591: my ($puname,$pudom)=split(/\:/,$person); 9592: my $clickers = 9593: (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; 9594: foreach my $id (split(/\,/,$clickers)) { 9595: $id=~s/^[\#0]+//; 9596: $id=~s/[\-\:]//g; 9597: if (exists($clicker_ids{$id})) { 9598: $clicker_ids{$id}.=','.$puname.':'.$pudom; 9599: } else { 9600: $clicker_ids{$id}=$puname.':'.$pudom; 9601: } 9602: } 9603: } 9604: } 9605: return %clicker_ids; 9606: } 9607: 9608: sub clicker_grading_parameters { 9609: return ('gradingmechanism' => 'scalar', 9610: 'upfiletype' => 'scalar', 9611: 'specificid' => 'scalar', 9612: 'pcorrect' => 'scalar', 9613: 'pincorrect' => 'scalar'); 9614: } 9615: 9616: sub process_clicker { 9617: my ($r,$symb)=@_; 9618: if (!$symb) {return '';} 9619: my $result=&checkforfile_js(); 9620: $result.=&Apache::loncommon::start_data_table(). 9621: &Apache::loncommon::start_data_table_header_row(). 9622: '<th>'.&mt('Specify a file containing clicker information and set grading options.').'</th>'. 9623: &Apache::loncommon::end_data_table_header_row(). 9624: &Apache::loncommon::start_data_table_row()."<td>\n"; 9625: # Attempt to restore parameters from last session, set defaults if not present 9626: my %Saveable_Parameters=&clicker_grading_parameters(); 9627: &Apache::loncommon::restore_course_settings('grades_clicker', 9628: \%Saveable_Parameters); 9629: if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; } 9630: if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; } 9631: if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; } 9632: if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; } 9633: 9634: my %checked; 9635: foreach my $gradingmechanism ('attendance','personnel','specific','given') { 9636: if ($env{'form.gradingmechanism'} eq $gradingmechanism) { 9637: $checked{$gradingmechanism}=' checked="checked"'; 9638: } 9639: } 9640: 9641: my $upload=&mt("Evaluate File"); 9642: my $type=&mt("Type"); 9643: my $attendance=&mt("Award points just for participation"); 9644: my $personnel=&mt("Correctness determined from response by course personnel"); 9645: my $specific=&mt("Correctness determined from response with clicker ID(s)"); 9646: my $given=&mt("Correctness determined from given list of answers").' '. 9647: '<font size="-2"><tt>('.&mt("Provide comma-separated list. Use '*' for any answer correct, '-' for skip").')</tt></font>'; 9648: my $pcorrect=&mt("Percentage points for correct solution"); 9649: my $pincorrect=&mt("Percentage points for incorrect solution"); 9650: my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', 9651: {'iclicker' => 'i>clicker', 9652: 'interwrite' => 'interwrite PRS', 9653: 'turning' => 'Turning Technologies'}); 9654: $symb = &Apache::lonenc::check_encrypt($symb); 9655: $result.= &Apache::lonhtmlcommon::scripttag(<<ENDUPFORM); 9656: function sanitycheck() { 9657: // Accept only integer percentages 9658: document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value); 9659: document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value); 9660: // Find out grading choice 9661: for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) { 9662: if (document.forms.gradesupload.gradingmechanism[i].checked) { 9663: gradingchoice=document.forms.gradesupload.gradingmechanism[i].value; 9664: } 9665: } 9666: // By default, new choice equals user selection 9667: newgradingchoice=gradingchoice; 9668: // Not good to give more points for false answers than correct ones 9669: if (Math.round(document.forms.gradesupload.pcorrect.value)<Math.round(document.forms.gradesupload.pincorrect.value)) { 9670: document.forms.gradesupload.pcorrect.value=document.forms.gradesupload.pincorrect.value; 9671: } 9672: // If new choice is attendance only, and old choice was correctness-based, restore defaults 9673: if ((gradingchoice=='attendance') && (document.forms.gradesupload.waschecked.value!='attendance')) { 9674: document.forms.gradesupload.pcorrect.value=100; 9675: document.forms.gradesupload.pincorrect.value=100; 9676: } 9677: // If the values are different, cannot be attendance only 9678: if ((Math.round(document.forms.gradesupload.pcorrect.value)!=Math.round(document.forms.gradesupload.pincorrect.value)) && 9679: (gradingchoice=='attendance')) { 9680: newgradingchoice='personnel'; 9681: } 9682: // Change grading choice to new one 9683: for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) { 9684: if (document.forms.gradesupload.gradingmechanism[i].value==newgradingchoice) { 9685: document.forms.gradesupload.gradingmechanism[i].checked=true; 9686: } else { 9687: document.forms.gradesupload.gradingmechanism[i].checked=false; 9688: } 9689: } 9690: // Remember the old state 9691: document.forms.gradesupload.waschecked.value=newgradingchoice; 9692: } 9693: ENDUPFORM 9694: $result.= <<ENDUPFORM; 9695: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 9696: <input type="hidden" name="symb" value="$symb" /> 9697: <input type="hidden" name="command" value="processclickerfile" /> 9698: <input type="file" name="upfile" size="50" /> 9699: <br /><label>$type: $selectform</label> 9700: ENDUPFORM 9701: $result.='</td>'.&Apache::loncommon::end_data_table_row(). 9702: &Apache::loncommon::start_data_table_row().'<td>'.(<<ENDGRADINGFORM); 9703: <label><input type="radio" name="gradingmechanism" value="attendance"$checked{'attendance'} onclick="sanitycheck()" />$attendance </label> 9704: <br /><label><input type="radio" name="gradingmechanism" value="personnel"$checked{'personnel'} onclick="sanitycheck()" />$personnel</label> 9705: <br /><label><input type="radio" name="gradingmechanism" value="specific"$checked{'specific'} onclick="sanitycheck()" />$specific </label> 9706: <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" /> 9707: <br /><label><input type="radio" name="gradingmechanism" value="given"$checked{'given'} onclick="sanitycheck()" />$given </label> 9708: <br />    9709: <input type="text" name="givenanswer" size="50" /> 9710: <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" /> 9711: ENDGRADINGFORM 9712: $result.='</td>'.&Apache::loncommon::end_data_table_row(). 9713: &Apache::loncommon::start_data_table_row().'<td>'.(<<ENDPERCFORM); 9714: <label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onchange="sanitycheck()" /></label> 9715: <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onchange="sanitycheck()" /></label> 9716: <br /><input type="button" onclick="javascript:checkUpload(this.form);" value="$upload" /> 9717: </form>' 9718: ENDPERCFORM 9719: $result.='</td>'. 9720: &Apache::loncommon::end_data_table_row(). 9721: &Apache::loncommon::end_data_table(); 9722: return $result; 9723: } 9724: 9725: sub process_clicker_file { 9726: my ($r,$symb)=@_; 9727: if (!$symb) {return '';} 9728: 9729: my %Saveable_Parameters=&clicker_grading_parameters(); 9730: &Apache::loncommon::store_course_settings('grades_clicker', 9731: \%Saveable_Parameters); 9732: my $result=''; 9733: if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { 9734: $result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>'; 9735: return $result; 9736: } 9737: if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\S/)) { 9738: $result.='<span class="LC_error">'.&mt('You need to specify the correct answer').'</span>'; 9739: return $result; 9740: } 9741: my $foundgiven=0; 9742: if ($env{'form.gradingmechanism'} eq 'given') { 9743: $env{'form.givenanswer'}=~s/^\s*//gs; 9744: $env{'form.givenanswer'}=~s/\s*$//gs; 9745: $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-\+]+/\,/g; 9746: $env{'form.givenanswer'}=uc($env{'form.givenanswer'}); 9747: my @answers=split(/\,/,$env{'form.givenanswer'}); 9748: $foundgiven=$#answers+1; 9749: } 9750: my %clicker_ids=&gather_clicker_ids(); 9751: my %correct_ids; 9752: if ($env{'form.gradingmechanism'} eq 'personnel') { 9753: %correct_ids=&gather_adv_clicker_ids(); 9754: } 9755: if ($env{'form.gradingmechanism'} eq 'specific') { 9756: foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; 9757: $correct_id=~tr/a-z/A-Z/; 9758: $correct_id=~s/\s//gs; 9759: $correct_id=~s/^[\#0]+//; 9760: $correct_id=~s/[\-\:]//g; 9761: if ($correct_id) { 9762: $correct_ids{$correct_id}='specified'; 9763: } 9764: } 9765: } 9766: if ($env{'form.gradingmechanism'} eq 'attendance') { 9767: $result.=&mt('Score based on attendance only'); 9768: } elsif ($env{'form.gradingmechanism'} eq 'given') { 9769: $result.=&mt('Score based on [_1] ([_2] answers)','<tt>'.$env{'form.givenanswer'}.'</tt>',$foundgiven); 9770: } else { 9771: my $number=0; 9772: $result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>'; 9773: foreach my $id (sort(keys(%correct_ids))) { 9774: $result.='<br /><tt>'.$id.'</tt> - '; 9775: if ($correct_ids{$id} eq 'specified') { 9776: $result.=&mt('specified'); 9777: } else { 9778: my ($uname,$udom)=split(/\:/,$correct_ids{$id}); 9779: $result.=&Apache::loncommon::plainname($uname,$udom); 9780: } 9781: $number++; 9782: } 9783: $result.="</p>\n"; 9784: if ($number==0) { 9785: $result .= 9786: &Apache::lonhtmlcommon::confirm_success( 9787: &mt('No IDs found to determine correct answer'),1); 9788: return $result; 9789: } 9790: } 9791: if (length($env{'form.upfile'}) < 2) { 9792: $result .= 9793: &Apache::lonhtmlcommon::confirm_success( 9794: &mt('The file: [_1] you attempted to upload contained no information. Please check that you entered the correct filename.', 9795: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'),1); 9796: return $result; 9797: } 9798: 9799: # Were able to get all the info needed, now analyze the file 9800: 9801: $result.=&Apache::loncommon::studentbrowser_javascript(); 9802: $symb = &Apache::lonenc::check_encrypt($symb); 9803: $result.=&Apache::loncommon::start_data_table(). 9804: &Apache::loncommon::start_data_table_header_row(). 9805: '<th>'.&mt('Evaluate clicker file').'</th>'. 9806: &Apache::loncommon::end_data_table_header_row(). 9807: &Apache::loncommon::start_data_table_row().(<<ENDHEADER); 9808: <td> 9809: <form method="post" action="/adm/grades" name="clickeranalysis"> 9810: <input type="hidden" name="symb" value="$symb" /> 9811: <input type="hidden" name="command" value="assignclickergrades" /> 9812: <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" /> 9813: <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" /> 9814: <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" /> 9815: ENDHEADER 9816: if ($env{'form.gradingmechanism'} eq 'given') { 9817: $result.='<input type="hidden" name="correct:given" value="'.$env{'form.givenanswer'}.'" />'; 9818: } 9819: my %responses; 9820: my @questiontitles; 9821: my $errormsg=''; 9822: my $number=0; 9823: if ($env{'form.upfiletype'} eq 'iclicker') { 9824: ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); 9825: } 9826: if ($env{'form.upfiletype'} eq 'interwrite') { 9827: ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); 9828: } 9829: if ($env{'form.upfiletype'} eq 'turning') { 9830: ($errormsg,$number)=&turning_eval(\@questiontitles,\%responses); 9831: } 9832: $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'. 9833: '<input type="hidden" name="number" value="'.$number.'" />'. 9834: &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', 9835: $env{'form.pcorrect'},$env{'form.pincorrect'}). 9836: '<br />'; 9837: if (($env{'form.gradingmechanism'} eq 'given') && ($number!=$foundgiven)) { 9838: $result.='<span class="LC_error">'.&mt('Number of given answers does not agree with number of questions in file.').'</span>'; 9839: return $result; 9840: } 9841: # Remember Question Titles 9842: # FIXME: Possibly need delimiter other than ":" 9843: for (my $i=0;$i<$number;$i++) { 9844: $result.='<input type="hidden" name="question:'.$i.'" value="'. 9845: &HTML::Entities::encode($questiontitles[$i],'"&<>').'" />'; 9846: } 9847: my $correct_count=0; 9848: my $student_count=0; 9849: my $unknown_count=0; 9850: # Match answers with usernames 9851: # FIXME: Possibly need delimiter other than ":" 9852: foreach my $id (keys(%responses)) { 9853: if ($correct_ids{$id}) { 9854: $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />'; 9855: $correct_count++; 9856: } elsif ($clicker_ids{$id}) { 9857: if ($clicker_ids{$id}=~/\,/) { 9858: # More than one user with the same clicker! 9859: $result.="</td>".&Apache::loncommon::end_data_table_row(). 9860: &Apache::loncommon::start_data_table_row()."<td>". 9861: &mt('Clicker registered more than once').": <tt>".$id."</tt><br />"; 9862: $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'. 9863: "<select name='multi".$id."'>"; 9864: foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) { 9865: $result.="<option value='".$reguser."'>".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.')</option>'; 9866: } 9867: $result.='</select>'; 9868: $unknown_count++; 9869: } else { 9870: # Good: found one and only one user with the right clicker 9871: $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />'; 9872: $student_count++; 9873: } 9874: } else { 9875: $result.="</td>".&Apache::loncommon::end_data_table_row(). 9876: &Apache::loncommon::start_data_table_row()."<td>". 9877: &mt('Unregistered Clicker')." <tt>".$id."</tt><br />"; 9878: $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'. 9879: "\n".&mt("Username").": <input type='text' name='uname".$id."' /> ". 9880: "\n".&mt("Domain").": ". 9881: &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '. 9882: &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id,0,$id); 9883: $unknown_count++; 9884: } 9885: } 9886: $result.='<hr />'. 9887: &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); 9888: if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) { 9889: if ($correct_count==0) { 9890: $errormsg.="Found no correct answers for grading!"; 9891: } elsif ($correct_count>1) { 9892: $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>'; 9893: } 9894: } 9895: if ($number<1) { 9896: $errormsg.="Found no questions."; 9897: } 9898: if ($errormsg) { 9899: $result.='<br /><span class="LC_error">'.&mt($errormsg).'</span>'; 9900: } else { 9901: $result.='<br /><input type="submit" name="finalize" value="'.&mt('Finalize Grading').'" />'; 9902: } 9903: $result.='</form></td>'. 9904: &Apache::loncommon::end_data_table_row(). 9905: &Apache::loncommon::end_data_table(); 9906: return $result; 9907: } 9908: 9909: sub iclicker_eval { 9910: my ($questiontitles,$responses)=@_; 9911: my $number=0; 9912: my $errormsg=''; 9913: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 9914: my %components=&Apache::loncommon::record_sep($line); 9915: my @entries=map {$components{$_}} (sort(keys(%components))); 9916: if ($entries[0] eq 'Question') { 9917: for (my $i=3;$i<$#entries;$i+=6) { 9918: $$questiontitles[$number]=$entries[$i]; 9919: $number++; 9920: } 9921: } 9922: if ($entries[0]=~/^\#/) { 9923: my $id=$entries[0]; 9924: my @idresponses; 9925: $id=~s/^[\#0]+//; 9926: for (my $i=0;$i<$number;$i++) { 9927: my $idx=3+$i*6; 9928: $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+]+//g; 9929: push(@idresponses,$entries[$idx]); 9930: } 9931: $$responses{$id}=join(',',@idresponses); 9932: } 9933: } 9934: return ($errormsg,$number); 9935: } 9936: 9937: sub interwrite_eval { 9938: my ($questiontitles,$responses)=@_; 9939: my $number=0; 9940: my $errormsg=''; 9941: my $skipline=1; 9942: my $questionnumber=0; 9943: my %idresponses=(); 9944: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 9945: my %components=&Apache::loncommon::record_sep($line); 9946: my @entries=map {$components{$_}} (sort(keys(%components))); 9947: if ($entries[1] eq 'Time') { $skipline=0; next; } 9948: if ($entries[1] eq 'Response') { $skipline=1; } 9949: next if $skipline; 9950: if ($entries[0]!=$questionnumber) { 9951: $questionnumber=$entries[0]; 9952: $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); 9953: $number++; 9954: } 9955: my $id=$entries[4]; 9956: $id=~s/^[\#0]+//; 9957: $id=~s/^v\d*\://i; 9958: $id=~s/[\-\:]//g; 9959: $idresponses{$id}[$number]=$entries[6]; 9960: } 9961: foreach my $id (keys(%idresponses)) { 9962: $$responses{$id}=join(',',@{$idresponses{$id}}); 9963: $$responses{$id}=~s/^\s*\,//; 9964: } 9965: return ($errormsg,$number); 9966: } 9967: 9968: sub turning_eval { 9969: my ($questiontitles,$responses)=@_; 9970: my $number=0; 9971: my $errormsg=''; 9972: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 9973: my %components=&Apache::loncommon::record_sep($line); 9974: my @entries=map {$components{$_}} (sort(keys(%components))); 9975: if ($#entries>$number) { $number=$#entries; } 9976: my $id=$entries[0]; 9977: my @idresponses; 9978: $id=~s/^[\#0]+//; 9979: unless ($id) { next; } 9980: for (my $idx=1;$idx<=$#entries;$idx++) { 9981: $entries[$idx]=~s/\,/\;/g; 9982: $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+\;]+//g; 9983: push(@idresponses,$entries[$idx]); 9984: } 9985: $$responses{$id}=join(',',@idresponses); 9986: } 9987: for (my $i=1; $i<=$number; $i++) { 9988: $$questiontitles[$i]=&mt('Question [_1]',$i); 9989: } 9990: return ($errormsg,$number); 9991: } 9992: 9993: 9994: sub assign_clicker_grades { 9995: my ($r,$symb)=@_; 9996: if (!$symb) {return '';} 9997: # See which part we are saving to 9998: my $res_error; 9999: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 10000: if ($res_error) { 10001: return &navmap_errormsg(); 10002: } 10003: # FIXME: This should probably look for the first handgradeable part 10004: my $part=$$partlist[0]; 10005: # Start screen output 10006: my $result=&Apache::loncommon::start_data_table(). 10007: &Apache::loncommon::start_data_table_header_row(). 10008: '<th>'.&mt('Assigning grades based on clicker file').'</th>'. 10009: &Apache::loncommon::end_data_table_header_row(). 10010: &Apache::loncommon::start_data_table_row().'<td>'; 10011: # Get correct result 10012: # FIXME: Possibly need delimiter other than ":" 10013: my @correct=(); 10014: my $gradingmechanism=$env{'form.gradingmechanism'}; 10015: my $number=$env{'form.number'}; 10016: if ($gradingmechanism ne 'attendance') { 10017: foreach my $key (keys(%env)) { 10018: if ($key=~/^form\.correct\:/) { 10019: my @input=split(/\,/,$env{$key}); 10020: for (my $i=0;$i<=$#input;$i++) { 10021: if (($correct[$i]) && ($input[$i]) && 10022: ($correct[$i] ne $input[$i])) { 10023: $result.='<br /><span class="LC_warning">'. 10024: &mt('More than one correct result given for question "[_1]": [_2] versus [_3].', 10025: $env{'form.question:'.$i},$correct[$i],$input[$i]).'</span>'; 10026: } elsif (($input[$i]) || ($input[$i] eq '0')) { 10027: $correct[$i]=$input[$i]; 10028: } 10029: } 10030: } 10031: } 10032: for (my $i=0;$i<$number;$i++) { 10033: if ((!$correct[$i]) && ($correct[$i] ne '0')) { 10034: $result.='<br /><span class="LC_error">'. 10035: &mt('No correct result given for question "[_1]"!', 10036: $env{'form.question:'.$i}).'</span>'; 10037: } 10038: } 10039: $result.='<br />'.&mt("Correct answer: [_1]",join(', ',map { ((($_) || ($_ eq '0'))?$_:'-') } @correct)); 10040: } 10041: # Start grading 10042: my $pcorrect=$env{'form.pcorrect'}; 10043: my $pincorrect=$env{'form.pincorrect'}; 10044: my $storecount=0; 10045: my %users=(); 10046: foreach my $key (keys(%env)) { 10047: my $user=''; 10048: if ($key=~/^form\.student\:(.*)$/) { 10049: $user=$1; 10050: } 10051: if ($key=~/^form\.unknown\:(.*)$/) { 10052: my $id=$1; 10053: if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) { 10054: $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id}; 10055: } elsif ($env{'form.multi'.$id}) { 10056: $user=$env{'form.multi'.$id}; 10057: } 10058: } 10059: if ($user) { 10060: if ($users{$user}) { 10061: $result.='<br /><span class="LC_warning">'. 10062: &mt('More than one entry found for [_1]!','<tt>'.$user.'</tt>'). 10063: '</span><br />'; 10064: } 10065: $users{$user}=1; 10066: my @answer=split(/\,/,$env{$key}); 10067: my $sum=0; 10068: my $realnumber=$number; 10069: for (my $i=0;$i<$number;$i++) { 10070: if ($correct[$i] eq '-') { 10071: $realnumber--; 10072: } elsif (($answer[$i]) || ($answer[$i]=~/^[0\.]+$/)) { 10073: if ($gradingmechanism eq 'attendance') { 10074: $sum+=$pcorrect; 10075: } elsif ($correct[$i] eq '*') { 10076: $sum+=$pcorrect; 10077: } else { 10078: # We actually grade if correct or not 10079: my $increment=$pincorrect; 10080: # Special case: numerical answer "0" 10081: if ($correct[$i] eq '0') { 10082: if ($answer[$i]=~/^[0\.]+$/) { 10083: $increment=$pcorrect; 10084: } 10085: # General numerical answer, both evaluate to something non-zero 10086: } elsif ((1.0*$correct[$i]!=0) && (1.0*$answer[$i]!=0)) { 10087: if (1.0*$correct[$i]==1.0*$answer[$i]) { 10088: $increment=$pcorrect; 10089: } 10090: # Must be just alphanumeric 10091: } elsif ($answer[$i] eq $correct[$i]) { 10092: $increment=$pcorrect; 10093: } 10094: $sum+=$increment; 10095: } 10096: } 10097: } 10098: my $ave=$sum/(100*$realnumber); 10099: # Store 10100: my ($username,$domain)=split(/\:/,$user); 10101: my %grades=(); 10102: $grades{"resource.$part.solved"}='correct_by_override'; 10103: $grades{"resource.$part.awarded"}=$ave; 10104: $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; 10105: my $returncode=&Apache::lonnet::cstore(\%grades,$symb, 10106: $env{'request.course.id'}, 10107: $domain,$username); 10108: if ($returncode ne 'ok') { 10109: $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>"; 10110: } else { 10111: $storecount++; 10112: } 10113: } 10114: } 10115: # We are done 10116: $result.='<br />'.&mt('Successfully stored grades for [quant,_1,student].',$storecount). 10117: '</td>'. 10118: &Apache::loncommon::end_data_table_row(). 10119: &Apache::loncommon::end_data_table(); 10120: return $result; 10121: } 10122: 10123: sub navmap_errormsg { 10124: return '<div class="LC_error">'. 10125: &mt('An error occurred retrieving information about resources in the course.').'<br />'. 10126: &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>'). 10127: '</div>'; 10128: } 10129: 10130: sub startpage { 10131: my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$js) = @_; 10132: if ($nomenu) { 10133: $r->print(&Apache::loncommon::start_page("Student's Version",$js,{'only_body' => '1'})); 10134: } else { 10135: unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"}); 10136: $r->print(&Apache::loncommon::start_page('Grading',$js, 10137: {'bread_crumbs' => $crumbs})); 10138: &Apache::lonquickgrades::startGradeScreen($r,($env{'form.symb'}?'probgrading':'grading')); 10139: } 10140: unless ($nodisplayflag) { 10141: $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag,$stuvcurrent,$stuvdisp)); 10142: } 10143: } 10144: 10145: sub select_problem { 10146: my ($r)=@_; 10147: $r->print('<h3>'.&mt('Select the problem or one of the problems you want to grade').'</h3><form action="/adm/grades">'); 10148: $r->print(&Apache::lonstathelpers::problem_selector('.',undef,1)); 10149: $r->print('<input type="hidden" name="command" value="gradingmenu" />'); 10150: $r->print('<input type="submit" value="'.&mt('Next').' →" /></form>'); 10151: } 10152: 10153: sub handler { 10154: my $request=$_[0]; 10155: &reset_caches(); 10156: if ($request->header_only) { 10157: &Apache::loncommon::content_type($request,'text/html'); 10158: $request->send_http_header; 10159: return OK; 10160: } 10161: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); 10162: 10163: # see what command we need to execute 10164: 10165: my @commands=&Apache::loncommon::get_env_multiple('form.command'); 10166: my $command=$commands[0]; 10167: 10168: &init_perm(); 10169: if (!$env{'request.course.id'}) { 10170: unless ((&Apache::lonnet::allowed('usc',$env{'request.role.domain'})) && 10171: ($command =~ /^scantronupload/)) { 10172: # Not in a course. 10173: $env{'user.error.msg'}="/adm/grades::vgr:0:0:Cannot display grades page outside course context"; 10174: return HTTP_NOT_ACCEPTABLE; 10175: } 10176: } elsif (!%perm) { 10177: $request->internal_redirect('/adm/quickgrades'); 10178: return OK; 10179: } 10180: &Apache::loncommon::content_type($request,'text/html'); 10181: $request->send_http_header; 10182: 10183: if ($#commands > 0) { 10184: &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); 10185: } 10186: 10187: # see what the symb is 10188: 10189: my $symb=$env{'form.symb'}; 10190: unless ($symb) { 10191: (my $url=$env{'form.url'}) =~ s-^https*://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; 10192: $symb=&Apache::lonnet::symbread($url); 10193: } 10194: &Apache::lonenc::check_decrypt(\$symb); 10195: 10196: $ssi_error = 0; 10197: if (($symb eq '' || $command eq '') && ($env{'request.course.id'})) { 10198: # 10199: # Not called from a resource, but inside a course 10200: # 10201: &startpage($request,undef,[],1,1); 10202: &select_problem($request); 10203: } else { 10204: if ($command eq 'submission' && $perm{'vgr'}) { 10205: my ($stuvcurrent,$stuvdisp,$versionform,$js); 10206: if (($env{'form.student'} ne '') && ($env{'form.userdom'} ne '')) { 10207: ($stuvcurrent,$stuvdisp,$versionform,$js) = 10208: &choose_task_version_form($symb,$env{'form.student'}, 10209: $env{'form.userdom'}); 10210: } 10211: &startpage($request,$symb,[{href=>"", text=>"Student Submissions"}],undef,undef,$stuvcurrent,$stuvdisp,undef,$js); 10212: if ($versionform) { 10213: $request->print($versionform); 10214: } 10215: $request->print('<br clear="all" />'); 10216: ($env{'form.student'} eq '' ? &listStudents($request,$symb) : &submission($request,0,0,$symb)); 10217: } elsif ($command eq 'versionsub' && $perm{'vgr'}) { 10218: my ($stuvcurrent,$stuvdisp,$versionform,$js) = 10219: &choose_task_version_form($symb,$env{'form.student'}, 10220: $env{'form.userdom'}, 10221: $env{'form.inhibitmenu'}); 10222: &startpage($request,$symb,[{href=>"", text=>"Previous Student Version"}],undef,undef,$stuvcurrent,$stuvdisp,$env{'form.inhibitmenu'},$js); 10223: if ($versionform) { 10224: $request->print($versionform); 10225: } 10226: $request->print('<br clear="all" />'); 10227: $request->print(&show_previous_task_version($request,$symb)); 10228: } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { 10229: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 10230: {href=>'',text=>'Select student'}],1,1); 10231: &pickStudentPage($request,$symb); 10232: } elsif ($command eq 'displayPage' && $perm{'vgr'}) { 10233: &startpage($request,$symb, 10234: [{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 10235: {href=>'',text=>'Select student'}, 10236: {href=>'',text=>'Grade student'}],1,1); 10237: &displayPage($request,$symb); 10238: } elsif ($command eq 'gradeByPage' && $perm{'mgr'}) { 10239: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 10240: {href=>'',text=>'Select student'}, 10241: {href=>'',text=>'Grade student'}, 10242: {href=>'',text=>'Store grades'}],1,1); 10243: &updateGradeByPage($request,$symb); 10244: } elsif ($command eq 'processGroup' && $perm{'vgr'}) { 10245: &startpage($request,$symb,[{href=>'',text=>'...'}, 10246: {href=>'',text=>'Modify grades'}]); 10247: &processGroup($request,$symb); 10248: } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) { 10249: &startpage($request,$symb); 10250: $request->print(&grading_menu($request,$symb)); 10251: } elsif ($command eq 'individual' && $perm{'vgr'}) { 10252: &startpage($request,$symb,[{href=>'',text=>'Select individual students to grade'}]); 10253: $request->print(&submit_options($request,$symb)); 10254: } elsif ($command eq 'ungraded' && $perm{'vgr'}) { 10255: &startpage($request,$symb,[{href=>'',text=>'Grade ungraded submissions'}]); 10256: $request->print(&listStudents($request,$symb,'graded')); 10257: } elsif ($command eq 'table' && $perm{'vgr'}) { 10258: &startpage($request,$symb,[{href=>"", text=>"Grading table"}]); 10259: $request->print(&submit_options_table($request,$symb)); 10260: } elsif ($command eq 'all_for_one' && $perm{'vgr'}) { 10261: &startpage($request,$symb,[{href=>'',text=>'Grade page/folder for one student'}],1,1); 10262: $request->print(&submit_options_sequence($request,$symb)); 10263: } elsif ($command eq 'viewgrades' && $perm{'vgr'}) { 10264: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"table"), text=>"Grading table"},{href=>'', text=>"Modify grades"}]); 10265: $request->print(&viewgrades($request,$symb)); 10266: } elsif ($command eq 'handgrade' && $perm{'mgr'}) { 10267: &startpage($request,$symb,[{href=>'',text=>'...'}, 10268: {href=>'',text=>'Store grades'}]); 10269: $request->print(&processHandGrade($request,$symb)); 10270: } elsif ($command eq 'editgrades' && $perm{'mgr'}) { 10271: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"table"), text=>"Grading table"}, 10272: {href=>&href_symb_cmd($symb,'viewgrades').'&group=all&section=all&Status=Active', 10273: text=>"Modify grades"}, 10274: {href=>'', text=>"Store grades"}]); 10275: $request->print(&editgrades($request,$symb)); 10276: } elsif ($command eq 'initialverifyreceipt' && $perm{'vgr'}) { 10277: &startpage($request,$symb,[{href=>'',text=>'Verify Receipt Number'}]); 10278: $request->print(&initialverifyreceipt($request,$symb)); 10279: } elsif ($command eq 'verify' && $perm{'vgr'}) { 10280: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"initialverifyreceipt"),text=>'Verify Receipt Number'}, 10281: {href=>'',text=>'Verification Result'}]); 10282: $request->print(&verifyreceipt($request,$symb)); 10283: } elsif ($command eq 'processclicker' && $perm{'mgr'}) { 10284: &startpage($request,$symb,[{href=>'', text=>'Process clicker'}]); 10285: $request->print(&process_clicker($request,$symb)); 10286: } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { 10287: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'processclicker'), text=>'Process clicker'}, 10288: {href=>'', text=>'Process clicker file'}]); 10289: $request->print(&process_clicker_file($request,$symb)); 10290: } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) { 10291: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'processclicker'), text=>'Process clicker'}, 10292: {href=>'', text=>'Process clicker file'}, 10293: {href=>'', text=>'Store grades'}]); 10294: $request->print(&assign_clicker_grades($request,$symb)); 10295: } elsif ($command eq 'csvform' && $perm{'mgr'}) { 10296: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 10297: $request->print(&upcsvScores_form($request,$symb)); 10298: } elsif ($command eq 'csvupload' && $perm{'mgr'}) { 10299: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 10300: $request->print(&csvupload($request,$symb)); 10301: } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) { 10302: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 10303: $request->print(&csvuploadmap($request,$symb)); 10304: } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) { 10305: if ($env{'form.associate'} ne 'Reverse Association') { 10306: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 10307: $request->print(&csvuploadoptions($request,$symb)); 10308: } else { 10309: if ( $env{'form.upfile_associate'} ne 'reverse' ) { 10310: $env{'form.upfile_associate'} = 'reverse'; 10311: } else { 10312: $env{'form.upfile_associate'} = 'forward'; 10313: } 10314: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 10315: $request->print(&csvuploadmap($request,$symb)); 10316: } 10317: } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) { 10318: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 10319: $request->print(&csvuploadassign($request,$symb)); 10320: } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { 10321: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 10322: $request->print(&scantron_selectphase($request,undef,$symb)); 10323: } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) { 10324: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 10325: $request->print(&scantron_do_warning($request,$symb)); 10326: } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { 10327: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 10328: $request->print(&scantron_validate_file($request,$symb)); 10329: } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { 10330: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 10331: $request->print(&scantron_process_students($request,$symb)); 10332: } elsif ($command eq 'scantronupload' && 10333: (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| 10334: &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { 10335: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 10336: $request->print(&scantron_upload_scantron_data($request,$symb)); 10337: } elsif ($command eq 'scantronupload_save' && 10338: (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| 10339: &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { 10340: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 10341: $request->print(&scantron_upload_scantron_data_save($request,$symb)); 10342: } elsif ($command eq 'scantron_download' && 10343: &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { 10344: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 10345: $request->print(&scantron_download_scantron_data($request,$symb)); 10346: } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) { 10347: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 10348: $request->print(&checkscantron_results($request,$symb)); 10349: } elsif ($command eq 'downloadfilesselect' && $perm{'vgr'}) { 10350: &startpage($request,$symb,[{href=>'', text=>'Select which submissions to download'}]); 10351: $request->print(&submit_options_download($request,$symb)); 10352: } elsif ($command eq 'downloadfileslink' && $perm{'vgr'}) { 10353: &startpage($request,$symb, 10354: [{href=>&href_symb_cmd($symb,'downloadfilesselect'), text=>'Select which submissions to download'}, 10355: {href=>'', text=>'Download submissions'}]); 10356: &submit_download_link($request,$symb); 10357: } elsif ($command) { 10358: &startpage($request,$symb,[{href=>'', text=>'Access denied'}]); 10359: $request->print('<p class="LC_error">'.&mt('Access Denied ([_1])',$command).'</p>'); 10360: } 10361: } 10362: if ($ssi_error) { 10363: &ssi_print_error($request); 10364: } 10365: if ($env{'form.inhibitmenu'}) { 10366: $request->print(&Apache::loncommon::end_page()); 10367: } else { 10368: &Apache::lonquickgrades::endGradeScreen($request); 10369: } 10370: &reset_caches(); 10371: return OK; 10372: } 10373: 10374: 1; 10375: 10376: __END__; 10377: 10378: 10379: =head1 NAME 10380: 10381: Apache::grades 10382: 10383: =head1 SYNOPSIS 10384: 10385: Handles the viewing of grades. 10386: 10387: This is part of the LearningOnline Network with CAPA project 10388: described at http://www.lon-capa.org. 10389: 10390: =head1 OVERVIEW 10391: 10392: Do an ssi with retries: 10393: While I'd love to factor out this with the version in lonprintout, 10394: 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 10395: I'm not quite ready to invent (e.g. an ssi_with_retry object). 10396: 10397: At least the logic that drives this has been pulled out into loncommon. 10398: 10399: 10400: 10401: ssi_with_retries - Does the server side include of a resource. 10402: if the ssi call returns an error we'll retry it up to 10403: the number of times requested by the caller. 10404: If we still have a problem, no text is appended to the 10405: output and we set some global variables. 10406: to indicate to the caller an SSI error occurred. 10407: All of this is supposed to deal with the issues described 10408: in LON-CAPA BZ 5631 see: 10409: http://bugs.lon-capa.org/show_bug.cgi?id=5631 10410: by informing the user that this happened. 10411: 10412: Parameters: 10413: resource - The resource to include. This is passed directly, without 10414: interpretation to lonnet::ssi. 10415: form - The form hash parameters that guide the interpretation of the resource 10416: 10417: retries - Number of retries allowed before giving up completely. 10418: Returns: 10419: On success, returns the rendered resource identified by the resource parameter. 10420: Side Effects: 10421: The following global variables can be set: 10422: ssi_error - If an unrecoverable error occurred this becomes true. 10423: It is up to the caller to initialize this to false 10424: if desired. 10425: ssi_error_resource - If an unrecoverable error occurred, this is the value 10426: of the resource that could not be rendered by the ssi 10427: call. 10428: ssi_error_message - The error string fetched from the ssi response 10429: in the event of an error. 10430: 10431: 10432: =head1 HANDLER SUBROUTINE 10433: 10434: ssi_with_retries() 10435: 10436: =head1 SUBROUTINES 10437: 10438: =over 10439: 10440: =head1 Routines to display previous version of a Task for a specific student 10441: 10442: Tasks are graded pass/fail. Students who have yet to pass a particular Task 10443: can receive another opportunity. Access to tasks is slot-based. If a slot 10444: requires a proctor to check-in the student, a new version of the Task will 10445: be created when the student is checked in to the new opportunity. 10446: 10447: If a particular student has tried two or more versions of a particular task, 10448: the submission screen provides a user with vgr privileges (e.g., a Course 10449: Coordinator) the ability to display a previous version worked on by the 10450: student. By default, the current version is displayed. If a previous version 10451: has been selected for display, submission data are only shown that pertain 10452: to that particular version, and the interface to submit grades is not shown. 10453: 10454: =over 4 10455: 10456: =item show_previous_task_version() 10457: 10458: Displays a specified version of a student's Task, as the student sees it. 10459: 10460: Inputs: 2 10461: request - request object 10462: symb - unique symb for current instance of resource 10463: 10464: Output: None. 10465: 10466: Side Effects: calls &show_problem() to print version of Task, with 10467: version contained in form item: $env{'form.previousversion'} 10468: 10469: =item choose_task_version_form() 10470: 10471: Displays a web form used to select which version of a student's view of a 10472: Task should be displayed. Either launches a pop-up window, or replaces 10473: content in existing pop-up, or replaces page in main window. 10474: 10475: Inputs: 4 10476: symb - unique symb for current instance of resource 10477: uname - username of student 10478: udom - domain of student 10479: nomenu - 1 if display is in a pop-up window, and hence no menu 10480: breadcrumbs etc., are displayed 10481: 10482: Output: 4 10483: current - student's current version 10484: displayed - student's version being displayed 10485: result - scalar containing HTML for web form used to switch to 10486: a different version (or a link to close window, if pop-up). 10487: js - javascript for processing selection in versions web form 10488: 10489: Side Effects: None. 10490: 10491: =item previous_display_javascript() 10492: 10493: Inputs: 2 10494: nomenu - 1 if display is in a pop-up window, and hence no menu 10495: breadcrumbs etc., are displayed. 10496: current - student's current version number. 10497: 10498: Output: 1 10499: js - javascript for processing selection in versions web form. 10500: 10501: Side Effects: None. 10502: 10503: =back 10504: 10505: =head1 Routines to process bubblesheet data. 10506: 10507: =over 4 10508: 10509: =item scantron_get_correction() : 10510: 10511: Builds the interface screen to interact with the operator to fix a 10512: specific error condition in a specific scanline 10513: 10514: Arguments: 10515: $r - Apache request object 10516: $i - number of the current scanline 10517: $scan_record - hash ref as returned from &scantron_parse_scanline() 10518: $scan_config - hash ref as returned from &get_scantron_config() 10519: $line - full contents of the current scanline 10520: $error - error condition, valid values are 10521: 'incorrectCODE', 'duplicateCODE', 10522: 'doublebubble', 'missingbubble', 10523: 'duplicateID', 'incorrectID' 10524: $arg - extra information needed 10525: For errors: 10526: - duplicateID - paper number that this studentID was seen before on 10527: - duplicateCODE - array ref of the paper numbers this CODE was 10528: seen on before 10529: - incorrectCODE - current incorrect CODE 10530: - doublebubble - array ref of the bubble lines that have double 10531: bubble errors 10532: - missingbubble - array ref of the bubble lines that have missing 10533: bubble errors 10534: 10535: $randomorder - True if exam folder has randomorder set 10536: $randompick - True if exam folder has randompick set 10537: $respnumlookup - Reference to HASH mapping question numbers in bubble lines 10538: for current line to question number used for same question 10539: in "Master Seqence" (as seen by Course Coordinator). 10540: $startline - Reference to hash where key is question number (0 is first) 10541: and value is number of first bubble line for current student 10542: or code-based randompick and/or randomorder. 10543: 10544: 10545: 10546: =item scantron_get_maxbubble() : 10547: 10548: Arguments: 10549: $nav_error - Reference to scalar which is a flag to indicate a 10550: failure to retrieve a navmap object. 10551: if $nav_error is set to 1 by scantron_get_maxbubble(), the 10552: calling routine should trap the error condition and display the warning 10553: found in &navmap_errormsg(). 10554: 10555: $scantron_config - Reference to bubblesheet format configuration hash. 10556: 10557: Returns the maximum number of bubble lines that are expected to 10558: occur. Does this by walking the selected sequence rendering the 10559: resource and then checking &Apache::lonxml::get_problem_counter() 10560: for what the current value of the problem counter is. 10561: 10562: Caches the results to $env{'form.scantron_maxbubble'}, 10563: $env{'form.scantron.bubble_lines.n'}, 10564: $env{'form.scantron.first_bubble_line.n'} and 10565: $env{"form.scantron.sub_bubblelines.n"} 10566: which are the total number of bubble lines, the number of bubble 10567: lines for response n and number of the first bubble line for response n, 10568: and a comma separated list of numbers of bubble lines for sub-questions 10569: (for optionresponse, matchresponse, and rankresponse items), for response n. 10570: 10571: 10572: =item scantron_validate_missingbubbles() : 10573: 10574: Validates all scanlines in the selected file to not have any 10575: answers that don't have bubbles that have not been verified 10576: to be bubble free. 10577: 10578: =item scantron_process_students() : 10579: 10580: Routine that does the actual grading of the bubblesheet information. 10581: 10582: The parsed scanline hash is added to %env 10583: 10584: Then foreach unskipped scanline it does an &Apache::lonnet::ssi() 10585: foreach resource , with the form data of 10586: 10587: 'submitted' =>'scantron' 10588: 'grade_target' =>'grade', 10589: 'grade_username'=> username of student 10590: 'grade_domain' => domain of student 10591: 'grade_courseid'=> of course 10592: 'grade_symb' => symb of resource to grade 10593: 10594: This triggers a grading pass. The problem grading code takes care 10595: of converting the bubbled letter information (now in %env) into a 10596: valid submission. 10597: 10598: =item scantron_upload_scantron_data() : 10599: 10600: Creates the screen for adding a new bubblesheet data file to a course. 10601: 10602: =item scantron_upload_scantron_data_save() : 10603: 10604: Adds a provided bubble information data file to the course if user 10605: has the correct privileges to do so. 10606: 10607: =item valid_file() : 10608: 10609: Validates that the requested bubble data file exists in the course. 10610: 10611: =item scantron_download_scantron_data() : 10612: 10613: Shows a list of the three internal files (original, corrected, 10614: skipped) for a specific bubblesheet data file that exists in the 10615: course. 10616: 10617: =item scantron_validate_ID() : 10618: 10619: Validates all scanlines in the selected file to not have any 10620: invalid or underspecified student/employee IDs 10621: 10622: =item navmap_errormsg() : 10623: 10624: Returns HTML mark-up inside a <div></div> with a link to re-initialize the course. 10625: Should be called whenever the request to instantiate a navmap object fails. 10626: 10627: =back 10628: 10629: =back 10630: 10631: =cut