loncom/homework/grades.pm - view - 1.596.2.12.2.60.2.5

File: [LON-CAPA] / loncom / homework / grades.pm
Revision 1.596.2.12.2.60.2.5: download - view: text, annotated - select for diffs
Thu Sep 7 17:38:56 2023 UTC (8 months, 1 week ago) by raeburn
Branches: version_2_11_4_msu
Diff to branchpoint 1.596.2.12.2.60: preferred, unified

- For 2.11.4 (modified)
  Include changes in 1.793

1: # The LearningOnline Network with CAPA 2: # The LON-CAPA Grading handler 3: # 4: # $Id: grades.pm,v 1.596.2.12.2.60.2.5 2023/09/07 17:38:56 raeburn 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::bridgetask(); 48: use Apache::lontexconvert(); 49: use String::Similarity; 50: use HTML::Parser(); 51: use File::MMagic; 52: use LONCAPA; 53: 54: use POSIX qw(floor); 55: 56: 57: 58: my %perm=(); 59: my %old_essays=(); 60: 61: # These variables are used to recover from ssi errors 62: 63: my $ssi_retries = 5; 64: my $ssi_error; 65: my $ssi_error_resource; 66: my $ssi_error_message; 67: 68: 69: sub ssi_with_retries { 70: my ($resource, $retries, %form) = @_; 71: my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form); 72: if ($response->is_error) { 73: $ssi_error = 1; 74: $ssi_error_resource = $resource; 75: $ssi_error_message = $response->code . " " . $response->message; 76: } 77: 78: return $content; 79: 80: } 81: # 82: # Prodcuces an ssi retry failure error message to the user: 83: # 84: 85: sub ssi_print_error { 86: my ($r) = @_; 87: my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk'); 88: $r->print(' 89: <br /> 90: <h2>'.&mt('An unrecoverable network error occurred:').'</h2> 91: <p> 92: '.&mt('Unable to retrieve a resource from a server:').'<br /> 93: '.&mt('Resource:').' '.$ssi_error_resource.'<br /> 94: '.&mt('Error:').' '.$ssi_error_message.' 95: </p> 96: <p>'. 97: &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 />'. 98: &mt('If the error persists, please contact the [_1] for assistance.',$helpurl). 99: '</p>'); 100: return; 101: } 102: 103: # 104: # --- Retrieve the parts from the metadata file.--- 105: # Returns an array of everything that the resources stores away 106: # 107: 108: sub getpartlist { 109: my ($symb,$errorref) = @_; 110: 111: my $navmap = Apache::lonnavmaps::navmap->new(); 112: unless (ref($navmap)) { 113: if (ref($errorref)) { 114: $$errorref = 'navmap'; 115: return; 116: } 117: } 118: my $res = $navmap->getBySymb($symb); 119: my $partlist = $res->parts(); 120: my $url = $res->src(); 121: my $toolsymb; 122: if ($url =~ /ext\.tool$/) { 123: $toolsymb = $symb; 124: } 125: my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys',$toolsymb)); 126: 127: my @stores; 128: foreach my $part (@{ $partlist }) { 129: foreach my $key (@metakeys) { 130: if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } 131: } 132: } 133: return @stores; 134: } 135: 136: #--- Format fullname, username:domain if different for display 137: #--- Use anywhere where the student names are listed 138: sub nameUserString { 139: my ($type,$fullname,$uname,$udom) = @_; 140: if ($type eq 'header') { 141: return '<b> '.&mt('Fullname').' </b><span class="LC_internal_info">('.&mt('Username').')</span>'; 142: } else { 143: return ' '.$fullname.'<span class="LC_internal_info"> ('.$uname. 144: ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')</span>'; 145: } 146: } 147: 148: #--- Get the partlist and the response type for a given problem. --- 149: #--- Indicate if a response type is coded handgraded or not. --- 150: #--- Count responseIDs, essayresponse items, and dropbox items --- 151: #--- Sets response_error pointer to "1" if navmaps object broken --- 152: sub response_type { 153: my ($symb,$response_error) = @_; 154: 155: my $navmap = Apache::lonnavmaps::navmap->new(); 156: unless (ref($navmap)) { 157: if (ref($response_error)) { 158: $$response_error = 1; 159: } 160: return; 161: } 162: my $res = $navmap->getBySymb($symb); 163: unless (ref($res)) { 164: $$response_error = 1; 165: return; 166: } 167: my $partlist = $res->parts(); 168: my ($numresp,$numessay,$numdropbox) = (0,0,0); 169: my %vPart = 170: map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); 171: my (%response_types,%handgrade); 172: foreach my $part (@{ $partlist }) { 173: next if (%vPart && !exists($vPart{$part})); 174: 175: my @types = $res->responseType($part); 176: my @ids = $res->responseIds($part); 177: for (my $i=0; $i < scalar(@ids); $i++) { 178: $numresp ++; 179: $response_types{$part}{$ids[$i]} = $types[$i]; 180: if ($types[$i] eq 'essay') { 181: $numessay ++; 182: if (&Apache::lonnet::EXT("resource.$part".'_'.$ids[$i].".uploadedfiletypes",$symb)) { 183: $numdropbox ++; 184: } 185: } 186: $handgrade{$part.'_'.$ids[$i]} = 187: &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. 188: '.handgrade',$symb); 189: } 190: } 191: return ($partlist,\%handgrade,\%response_types,$numresp,$numessay,$numdropbox); 192: } 193: 194: sub flatten_responseType { 195: my ($responseType) = @_; 196: my @part_response_id = 197: map { 198: my $part = $_; 199: map { 200: [$part,$_] 201: } sort(keys(%{ $responseType->{$part} })); 202: } sort(keys(%$responseType)); 203: return @part_response_id; 204: } 205: 206: sub get_display_part { 207: my ($partID,$symb)=@_; 208: my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); 209: if (defined($display) and $display ne '') { 210: $display.= ' (<span class="LC_internal_info">' 211: .&mt('Part ID: [_1]',$partID).'</span>)'; 212: } else { 213: $display=$partID; 214: } 215: return $display; 216: } 217: 218: #--- Show parts and response type 219: sub showResourceInfo { 220: my ($symb,$partlist,$responseType,$formname,$checkboxes,$uploads) = @_; 221: unless ((ref($partlist) eq 'ARRAY') && (ref($responseType) eq 'HASH')) { 222: return '<br clear="all">'; 223: } 224: my $coltitle = &mt('Problem Part Shown'); 225: if ($checkboxes) { 226: $coltitle = &mt('Problem Part'); 227: } else { 228: my $checkedparts = 0; 229: foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { 230: if (grep(/^\Q$partid\E$/,@{$partlist})) { 231: $checkedparts ++; 232: } 233: } 234: if ($checkedparts == scalar(@{$partlist})) { 235: return '<br clear="all">'; 236: } 237: if ($uploads) { 238: $coltitle = &mt('Problem Part Selected'); 239: } 240: } 241: my $result = '<div class="LC_left_float" style="display:inline-block;">'; 242: if ($checkboxes) { 243: my $legend = &mt('Parts to display'); 244: if ($uploads) { 245: $legend = &mt('Part(s) with dropbox'); 246: } 247: $result .= '<fieldset style="display:inline-block;"><legend>'.$legend.'</legend>'. 248: '<span class="LC_nobreak">'. 249: '<label><input type="radio" name="chooseparts" value="0" onclick="toggleParts('."'$formname'".');" checked="checked" />'. 250: &mt('All parts').'</label>'.(' 'x2). 251: '<label><input type="radio" name="chooseparts" value="1" onclick="toggleParts('."'$formname'".');" />'. 252: &mt('Selected parts').'</label></span>'. 253: '<div id="LC_partselector" style="display:none">'; 254: } 255: $result .= &Apache::loncommon::start_data_table() 256: .&Apache::loncommon::start_data_table_header_row(); 257: if ($checkboxes) { 258: $result .= '<th>'.&mt('Display?').'</th>'; 259: } 260: $result .= '<th>'.$coltitle.'</th>' 261: .'<th>'.&mt('Res. ID').'</th>' 262: .'<th>'.&mt('Type').'</th>' 263: .&Apache::loncommon::end_data_table_header_row(); 264: my %partsseen; 265: foreach my $partID (sort(keys(%$responseType))) { 266: foreach my $resID (sort(keys(%{ $responseType->{$partID} }))) { 267: my $responsetype = $responseType->{$partID}->{$resID}; 268: if ($uploads) { 269: next unless ($responsetype eq 'essay'); 270: next unless (&Apache::lonnet::EXT("resource.$partID".'_'."$resID.uploadedfiletypes",$symb)); 271: } 272: my $display_part=&get_display_part($partID,$symb); 273: if (exists($partsseen{$partID})) { 274: $result.=&Apache::loncommon::continue_data_table_row(); 275: } else { 276: $partsseen{$partID}=scalar(keys(%{$responseType->{$partID}})); 277: $result.=&Apache::loncommon::start_data_table_row(). 278: '<td rowspan="'.$partsseen{$partID}.'" style="vertical-align:middle">'; 279: if ($checkboxes) { 280: $result.='<input type="checkbox" name="vPart" checked="checked" value="'.$partID.'" /></td>'. 281: '<td rowspan="'.$partsseen{$partID}.'" style="vertical-align:middle">'.$display_part.'</td>'; 282: } else { 283: $result.=$display_part.'</td>'; 284: } 285: } 286: $result.='<td>'.'<span class="LC_internal_info">'.$resID.'</span></td>' 287: .'<td>'.&mt($responsetype).'</td>' 288: .&Apache::loncommon::end_data_table_row(); 289: } 290: } 291: $result.=&Apache::loncommon::end_data_table(); 292: if ($checkboxes) { 293: $result .= '</div></fieldset>'; 294: } 295: $result .= '</div><div style="padding:0;clear:both;margin:0;border:0"></div>'; 296: if (!keys(%partsseen)) { 297: $result = ''; 298: if ($uploads) { 299: return '<div style="padding:0;clear:both;margin:0;border:0"></div>'. 300: '<p class="LC_info">'. 301: &mt('No dropbox items or essayresponse items with uploadedfiletypes set.'). 302: '</p>'; 303: } else { 304: return '<br clear="all" />'; 305: } 306: } 307: return $result; 308: } 309: 310: sub part_selector_js { 311: my $js = <<"END"; 312: function toggleParts(formname) { 313: if (document.getElementById('LC_partselector')) { 314: var index = ''; 315: if (document.forms.length) { 316: for (var i=0; i<document.forms.length; i++) { 317: if (document.forms[i].name == formname) { 318: index = i; 319: break; 320: } 321: } 322: } 323: if ((index != '') && (document.forms[index].elements['chooseparts'].length > 1)) { 324: for (var i=0; i<document.forms[index].elements['chooseparts'].length; i++) { 325: if (document.forms[index].elements['chooseparts'][i].checked) { 326: var val = document.forms[index].elements['chooseparts'][i].value; 327: if (document.forms[index].elements['chooseparts'][i].value == 1) { 328: document.getElementById('LC_partselector').style.display = 'block'; 329: } else { 330: document.getElementById('LC_partselector').style.display = 'none'; 331: } 332: } 333: } 334: } 335: } 336: } 337: END 338: return &Apache::lonhtmlcommon::scripttag($js); 339: } 340: 341: sub reset_caches { 342: &reset_analyze_cache(); 343: &reset_perm(); 344: &reset_old_essays(); 345: } 346: 347: { 348: my %analyze_cache; 349: my %analyze_cache_formkeys; 350: 351: sub reset_analyze_cache { 352: undef(%analyze_cache); 353: undef(%analyze_cache_formkeys); 354: } 355: 356: sub get_analyze { 357: my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed,$bubbles_per_row)=@_; 358: my $key = "$symb\0$uname\0$udom"; 359: if ($type eq 'randomizetry') { 360: if ($trial ne '') { 361: $key .= "\0".$trial; 362: } 363: } 364: if (exists($analyze_cache{$key})) { 365: my $getupdate = 0; 366: if (ref($add_to_hash) eq 'HASH') { 367: foreach my $item (keys(%{$add_to_hash})) { 368: if (ref($analyze_cache_formkeys{$key}) eq 'HASH') { 369: if (!exists($analyze_cache_formkeys{$key}{$item})) { 370: $getupdate = 1; 371: last; 372: } 373: } else { 374: $getupdate = 1; 375: } 376: } 377: } 378: if (!$getupdate) { 379: return $analyze_cache{$key}; 380: } 381: } 382: 383: my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); 384: $url=&Apache::lonnet::clutter($url); 385: my %form = ('grade_target' => 'analyze', 386: 'grade_domain' => $udom, 387: 'grade_symb' => $symb, 388: 'grade_courseid' => $env{'request.course.id'}, 389: 'grade_username' => $uname, 390: 'grade_noincrement' => $no_increment); 391: if ($bubbles_per_row ne '') { 392: $form{'bubbles_per_row'} = $bubbles_per_row; 393: } 394: if ($type eq 'randomizetry') { 395: $form{'grade_questiontype'} = $type; 396: if ($rndseed ne '') { 397: $form{'grade_rndseed'} = $rndseed; 398: } 399: } 400: if (ref($add_to_hash)) { 401: %form = (%form,%{$add_to_hash}); 402: } 403: my $subresult=&ssi_with_retries($url, $ssi_retries,%form); 404: (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); 405: my %analyze=&Apache::lonnet::str2hash($subresult); 406: if (ref($add_to_hash) eq 'HASH') { 407: $analyze_cache_formkeys{$key} = $add_to_hash; 408: } else { 409: $analyze_cache_formkeys{$key} = {}; 410: } 411: return $analyze_cache{$key} = \%analyze; 412: } 413: 414: sub get_order { 415: my ($partid,$respid,$symb,$uname,$udom,$no_increment,$type,$trial,$rndseed)=@_; 416: my $analyze = &get_analyze($symb,$uname,$udom,$no_increment,undef,$type,$trial,$rndseed); 417: return $analyze->{"$partid.$respid.shown"}; 418: } 419: 420: sub get_radiobutton_correct_foil { 421: my ($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed)=@_; 422: my $analyze = &get_analyze($symb,$uname,$udom,undef,undef,$type,$trial,$rndseed); 423: my $foils = &get_order($partid,$respid,$symb,$uname,$udom,undef,$type,$trial,$rndseed); 424: if (ref($foils) eq 'ARRAY') { 425: foreach my $foil (@{$foils}) { 426: if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { 427: return $foil; 428: } 429: } 430: } 431: } 432: 433: sub scantron_partids_tograde { 434: my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row,$scancode) = @_; 435: my (%analysis,@parts); 436: if (ref($resource)) { 437: my $symb = $resource->symb(); 438: my $add_to_form; 439: if ($check_for_randomlist) { 440: $add_to_form = { 'check_parts_withrandomlist' => 1,}; 441: } 442: if ($scancode) { 443: if (ref($add_to_form) eq 'HASH') { 444: $add_to_form->{'code_for_randomlist'} = $scancode; 445: } else { 446: $add_to_form = { 'code_for_randomlist' => $scancode,}; 447: } 448: } 449: my $analyze = 450: &get_analyze($symb,$uname,$udom,undef,$add_to_form, 451: undef,undef,undef,$bubbles_per_row); 452: if (ref($analyze) eq 'HASH') { 453: %analysis = %{$analyze}; 454: } 455: if (ref($analysis{'parts'}) eq 'ARRAY') { 456: foreach my $part (@{$analysis{'parts'}}) { 457: my ($id,$respid) = split(/\./,$part); 458: if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { 459: push(@parts,$part); 460: } 461: } 462: } 463: } 464: return (\%analysis,\@parts); 465: } 466: 467: } 468: 469: #--- Clean response type for display 470: #--- Currently filters option/rank/radiobutton/match/essay/Task 471: # response types only. 472: sub cleanRecord { 473: my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, 474: $uname,$udom,$type,$trial,$rndseed) = @_; 475: my $grayFont = '<span class="LC_internal_info">'; 476: if ($response =~ /^(option|rank)$/) { 477: my %answer=&Apache::lonnet::str2hash($answer); 478: my @answer = %answer; 479: %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; 480: my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); 481: my ($toprow,$bottomrow); 482: foreach my $foil (@$order) { 483: if ($grading{$foil} == 1) { 484: $toprow.='<td><b>'.$answer{$foil}.' </b></td>'; 485: } else { 486: $toprow.='<td><i>'.$answer{$foil}.' </i></td>'; 487: } 488: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 489: } 490: return '<blockquote><table border="1">'. 491: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 492: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 493: $bottomrow.'</tr></table></blockquote>'; 494: } elsif ($response eq 'match') { 495: my %answer=&Apache::lonnet::str2hash($answer); 496: my @answer = %answer; 497: %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; 498: my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); 499: my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); 500: my ($toprow,$middlerow,$bottomrow); 501: foreach my $foil (@$order) { 502: my $item=shift(@items); 503: if ($grading{$foil} == 1) { 504: $toprow.='<td><b>'.$item.' </b></td>'; 505: $middlerow.='<td><b>'.$grayFont.$answer{$foil}.' </span></b></td>'; 506: } else { 507: $toprow.='<td><i>'.$item.' </i></td>'; 508: $middlerow.='<td><i>'.$grayFont.$answer{$foil}.' </span></i></td>'; 509: } 510: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 511: } 512: return '<blockquote><table border="1">'. 513: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 514: '<tr valign="top"><td>'.$grayFont.&mt('Item ID').'</span></td>'. 515: $middlerow.'</tr>'. 516: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 517: $bottomrow.'</tr></table></blockquote>'; 518: } elsif ($response eq 'radiobutton') { 519: my %answer=&Apache::lonnet::str2hash($answer); 520: my @answer = %answer; 521: %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; 522: my ($toprow,$bottomrow); 523: my $correct = 524: &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed); 525: foreach my $foil (@$order) { 526: if (exists($answer{$foil})) { 527: if ($foil eq $correct) { 528: $toprow.='<td><b>'.&mt('true').'</b></td>'; 529: } else { 530: $toprow.='<td><i>'.&mt('true').'</i></td>'; 531: } 532: } else { 533: $toprow.='<td>'.&mt('false').'</td>'; 534: } 535: $bottomrow.='<td>'.$grayFont.$foil.'</span> </td>'; 536: } 537: return '<blockquote><table border="1">'. 538: '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'. 539: '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'. 540: $bottomrow.'</tr></table></blockquote>'; 541: } elsif ($response eq 'essay') { 542: if (! exists ($env{'form.'.$symb})) { 543: my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', 544: $env{'course.'.$env{'request.course.id'}.'.domain'}, 545: $env{'course.'.$env{'request.course.id'}.'.num'}); 546: 547: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 548: $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; 549: $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; 550: $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; 551: $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; 552: $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. 553: } 554: $answer = &Apache::lontexconvert::msgtexconverted($answer); 555: return '<br /><br /><blockquote><tt>'.&keywords_highlight($answer).'</tt></blockquote>'; 556: } elsif ( $response eq 'organic') { 557: my $result=&mt('Smile representation: [_1]', 558: '"<tt>'.&HTML::Entities::encode($answer, '"<>&').'</tt>"'); 559: my $jme=$record->{$version."resource.$partid.$respid.molecule"}; 560: $result.=&Apache::chemresponse::jme_img($jme,$answer,400); 561: return $result; 562: } elsif ( $response eq 'Task') { 563: if ( $answer eq 'SUBMITTED') { 564: my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; 565: my $result = &Apache::bridgetask::file_list($files,$uname,$udom); 566: return $result; 567: } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { 568: my @matches = grep(/^\Q$version\E.*?\.instance$/, 569: keys(%{$record})); 570: return join('<br />',($version,@matches)); 571: 572: 573: } else { 574: my $result = 575: '<p>' 576: .&mt('Overall result: [_1]', 577: $record->{$version."resource.$respid.$partid.status"}) 578: .'</p>'; 579: 580: $result .= '<ul>'; 581: my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/, 582: keys(%{$record})); 583: foreach my $grade (sort(@grade)) { 584: my ($dim) = ($grade =~/[.]([^.]+)[.]status$/); 585: $result.= '<li>'.&mt("Dimension: [_1], status [_2] ", 586: $dim, $record->{$grade}). 587: '</li>'; 588: } 589: $result.='</ul>'; 590: return $result; 591: } 592: } elsif ( $response =~ m/(?:numerical|formula|custom)/) { 593: # Respect multiple input fields, see Bug #5409 594: $answer = 595: &Apache::loncommon::format_previous_attempt_value('submission', 596: $answer); 597: return $answer; 598: } 599: return &HTML::Entities::encode($answer, '"<>&'); 600: } 601: 602: #-- A couple of common js functions 603: sub commonJSfunctions { 604: my $request = shift; 605: $request->print(&Apache::lonhtmlcommon::scripttag(<<COMMONJSFUNCTIONS)); 606: function radioSelection(radioButton) { 607: var selection=null; 608: if (radioButton.length > 1) { 609: for (var i=0; i<radioButton.length; i++) { 610: if (radioButton[i].checked) { 611: return radioButton[i].value; 612: } 613: } 614: } else { 615: if (radioButton.checked) return radioButton.value; 616: } 617: return selection; 618: } 619: 620: function pullDownSelection(selectOne) { 621: var selection=""; 622: if (selectOne.length > 1) { 623: for (var i=0; i<selectOne.length; i++) { 624: if (selectOne[i].selected) { 625: return selectOne[i].value; 626: } 627: } 628: } else { 629: // only one value it must be the selected one 630: return selectOne.value; 631: } 632: } 633: COMMONJSFUNCTIONS 634: } 635: 636: #--- Dumps the class list with usernames,list of sections, 637: #--- section, ids and fullnames for each user. 638: sub getclasslist { 639: my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus) = @_; 640: my @getsec; 641: my @getgroup; 642: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 643: if (!ref($getsec)) { 644: if ($getsec ne '' && $getsec ne 'all') { 645: @getsec=($getsec); 646: } 647: } else { 648: @getsec=@{$getsec}; 649: } 650: if (grep(/^all$/,@getsec)) { undef(@getsec); } 651: if (!ref($getgroup)) { 652: if ($getgroup ne '' && $getgroup ne 'all') { 653: @getgroup=($getgroup); 654: } 655: } else { 656: @getgroup=@{$getgroup}; 657: } 658: if (grep(/^all$/,@getgroup)) { undef(@getgroup); } 659: 660: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist(); 661: # Bail out if we were unable to get the classlist 662: return if (! defined($classlist)); 663: &Apache::loncoursedata::get_group_memberships($classlist,$keylist); 664: # 665: my %sections; 666: my %fullnames; 667: my ($cdom,$cnum,$partlist); 668: if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { 669: $cdom = $env{"course.$env{'request.course.id'}.domain"}; 670: $cnum = $env{"course.$env{'request.course.id'}.num"}; 671: my $res_error; 672: ($partlist) = &response_type($symb,\$res_error); 673: } 674: foreach my $student (keys(%$classlist)) { 675: my $end = 676: $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; 677: my $start = 678: $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; 679: my $id = 680: $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; 681: my $section = 682: $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; 683: my $fullname = 684: $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; 685: my $status = 686: $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; 687: my $group = 688: $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; 689: # filter students according to status selected 690: if ($filterbyaccstatus && (!($stu_status =~ /Any/))) { 691: if (!($stu_status =~ $status)) { 692: delete($classlist->{$student}); 693: next; 694: } 695: } 696: # filter students according to groups selected 697: my @stu_groups = split(/,/,$group); 698: if (@getgroup) { 699: my $exclude = 1; 700: foreach my $grp (@getgroup) { 701: foreach my $stu_group (@stu_groups) { 702: if ($stu_group eq $grp) { 703: $exclude = 0; 704: } 705: } 706: if (($grp eq 'none') && !$group) { 707: $exclude = 0; 708: } 709: } 710: if ($exclude) { 711: delete($classlist->{$student}); 712: next; 713: } 714: } 715: if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { 716: my $udom = 717: $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()]; 718: my $uname = 719: $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()]; 720: if (($symb ne '') && ($udom ne '') && ($uname ne '')) { 721: if ($submitonly eq 'queued') { 722: my %queue_status = 723: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 724: $udom,$uname); 725: if (!defined($queue_status{'gradingqueue'})) { 726: delete($classlist->{$student}); 727: next; 728: } 729: } else { 730: my (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); 731: my $submitted = 0; 732: my $graded = 0; 733: my $incorrect = 0; 734: foreach (keys(%status)) { 735: $submitted = 1 if ($status{$_} ne 'nothing'); 736: $graded = 1 if ($status{$_} =~ /^ungraded/); 737: $incorrect = 1 if ($status{$_} =~ /^incorrect/); 738: 739: my ($foo,$partid,$foo1) = split(/\./,$_); 740: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 741: $submitted = 0; 742: } 743: } 744: if (!$submitted && ($submitonly eq 'yes' || 745: $submitonly eq 'incorrect' || 746: $submitonly eq 'graded')) { 747: delete($classlist->{$student}); 748: next; 749: } elsif (!$graded && ($submitonly eq 'graded')) { 750: delete($classlist->{$student}); 751: next; 752: } elsif (!$incorrect && $submitonly eq 'incorrect') { 753: delete($classlist->{$student}); 754: next; 755: } 756: } 757: } 758: } 759: $section = ($section ne '' ? $section : 'none'); 760: if (&canview($section)) { 761: if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { 762: $sections{$section}++; 763: if ($classlist->{$student}) { 764: $fullnames{$student}=$fullname; 765: } 766: } else { 767: delete($classlist->{$student}); 768: } 769: } else { 770: delete($classlist->{$student}); 771: } 772: } 773: my @sections = sort(keys(%sections)); 774: return ($classlist,\@sections,\%fullnames); 775: } 776: 777: sub canmodify { 778: my ($sec)=@_; 779: if ($perm{'mgr'}) { 780: if (!defined($perm{'mgr_section'})) { 781: # can modify whole class 782: return 1; 783: } else { 784: if ($sec eq $perm{'mgr_section'}) { 785: #can modify the requested section 786: return 1; 787: } else { 788: # can't modify the requested section 789: return 0; 790: } 791: } 792: } 793: #can't modify 794: return 0; 795: } 796: 797: sub canview { 798: my ($sec)=@_; 799: if ($perm{'vgr'}) { 800: if (!defined($perm{'vgr_section'})) { 801: # can view whole class 802: return 1; 803: } else { 804: if ($sec eq $perm{'vgr_section'}) { 805: #can view the requested section 806: return 1; 807: } else { 808: # can't view the requested section 809: return 0; 810: } 811: } 812: } 813: #can't view 814: return 0; 815: } 816: 817: #--- Retrieve the grade status of a student for all the parts 818: sub student_gradeStatus { 819: my ($symb,$udom,$uname,$partlist) = @_; 820: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 821: my %partstatus = (); 822: foreach (@$partlist) { 823: my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); 824: $status = 'nothing' if ($status eq ''); 825: $partstatus{$_} = $status; 826: my $subkey = "resource.$_.submitted_by"; 827: $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); 828: } 829: return %partstatus; 830: } 831: 832: # hidden form and javascript that calls the form 833: # Use by verifyscript and viewgrades 834: # Shows a student's view of problem and submission 835: sub jscriptNform { 836: my ($symb) = @_; 837: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 838: my $jscript= &Apache::lonhtmlcommon::scripttag( 839: ' function viewOneStudent(user,domain) {'."\n". 840: ' document.onestudent.student.value = user;'."\n". 841: ' document.onestudent.userdom.value = domain;'."\n". 842: ' document.onestudent.submit();'."\n". 843: ' }'."\n". 844: "\n"); 845: $jscript.= '<form action="/adm/grades" method="post" name="onestudent">'."\n". 846: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 847: '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 848: '<input type="hidden" name="command" value="submission" />'."\n". 849: '<input type="hidden" name="student" value="" />'."\n". 850: '<input type="hidden" name="userdom" value="" />'."\n". 851: '</form>'."\n"; 852: return $jscript; 853: } 854: 855: 856: 857: # Given the score (as a number [0-1] and the weight) what is the final 858: # point value? This function will round to the nearest tenth, third, 859: # or quarter if one of those is within the tolerance of .00001. 860: sub compute_points { 861: my ($score, $weight) = @_; 862: 863: my $tolerance = .00001; 864: my $points = $score * $weight; 865: 866: # Check for nearness to 1/x. 867: my $check_for_nearness = sub { 868: my ($factor) = @_; 869: my $num = ($points * $factor) + $tolerance; 870: my $floored_num = floor($num); 871: if ($num - $floored_num < 2 * $tolerance * $factor) { 872: return $floored_num / $factor; 873: } 874: return $points; 875: }; 876: 877: $points = $check_for_nearness->(10); 878: $points = $check_for_nearness->(3); 879: $points = $check_for_nearness->(4); 880: 881: return $points; 882: } 883: 884: #------------------ End of general use routines -------------------- 885: 886: # 887: # Find most similar essay 888: # 889: 890: sub most_similar { 891: my ($uname,$udom,$symb,$uessay)=@_; 892: 893: unless ($symb) { return ''; } 894: 895: unless (ref($old_essays{$symb}) eq 'HASH') { return ''; } 896: 897: # ignore spaces and punctuation 898: 899: $uessay=~s/\W+/ /gs; 900: 901: # ignore empty submissions (occuring when only files are sent) 902: 903: unless ($uessay=~/\w+/s) { return ''; } 904: 905: # these will be returned. Do not care if not at least 50 percent similar 906: my $limit=0.6; 907: my $sname=''; 908: my $sdom=''; 909: my $scrsid=''; 910: my $sessay=''; 911: # go through all essays ... 912: foreach my $tkey (keys(%{$old_essays{$symb}})) { 913: my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); 914: # ... except the same student 915: next if (($tname eq $uname) && ($tdom eq $udom)); 916: my $tessay=$old_essays{$symb}{$tkey}; 917: $tessay=~s/\W+/ /gs; 918: # String similarity gives up if not even limit 919: my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); 920: # Found one 921: if ($tsimilar>$limit) { 922: $limit=$tsimilar; 923: $sname=$tname; 924: $sdom=$tdom; 925: $scrsid=$tcrsid; 926: $sessay=$old_essays{$symb}{$tkey}; 927: } 928: } 929: if ($limit>0.6) { 930: return ($sname,$sdom,$scrsid,$sessay,$limit); 931: } else { 932: return ('','','','',0); 933: } 934: } 935: 936: #------------------------------------------------------------------- 937: 938: #------------------------------------ Receipt Verification Routines 939: # 940: 941: sub initialverifyreceipt { 942: my ($request,$symb) = @_; 943: &commonJSfunctions($request); 944: return '<form name="gradingMenu" action=""><input type="submit" value="'.&mt('Verify Receipt Number.').'" />'. 945: &Apache::lonnet::recprefix($env{'request.course.id'}). 946: '-<input type="text" name="receipt" size="4" />'. 947: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 948: '<input type="hidden" name="command" value="verify" />'. 949: "</form>\n"; 950: } 951: 952: #--- Check whether a receipt number is valid.--- 953: sub verifyreceipt { 954: my ($request,$symb) = @_; 955: 956: my $courseid = $env{'request.course.id'}; 957: my $receipt = &Apache::lonnet::recprefix($courseid).'-'. 958: $env{'form.receipt'}; 959: $receipt =~ s/[^\-\d]//g; 960: 961: my $title = 962: '<h3><span class="LC_info">'. 963: &mt('Verifying Receipt Number [_1]',$receipt). 964: '</span></h3>'."\n"; 965: 966: my ($string,$contents,$matches) = ('','',0); 967: my (undef,undef,$fullname) = &getclasslist('all','0'); 968: 969: my $receiptparts=0; 970: if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || 971: $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } 972: my $parts=['0']; 973: if ($receiptparts) { 974: my $res_error; 975: ($parts)=&response_type($symb,\$res_error); 976: if ($res_error) { 977: return &navmap_errormsg(); 978: } 979: } 980: 981: my $header = 982: &Apache::loncommon::start_data_table(). 983: &Apache::loncommon::start_data_table_header_row(). 984: '<th> '.&mt('Fullname').' </th>'."\n". 985: '<th> '.&mt('Username').' </th>'."\n". 986: '<th> '.&mt('Domain').' </th>'; 987: if ($receiptparts) { 988: $header.='<th> '.&mt('Problem Part').' </th>'; 989: } 990: $header.= 991: &Apache::loncommon::end_data_table_header_row(); 992: 993: foreach (sort 994: { 995: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 996: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 997: } 998: return $a cmp $b; 999: } (keys(%$fullname))) { 1000: my ($uname,$udom)=split(/\:/); 1001: foreach my $part (@$parts) { 1002: if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { 1003: $contents.= 1004: &Apache::loncommon::start_data_table_row(). 1005: '<td> '."\n". 1006: '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. 1007: '\');" target="_self">'.$$fullname{$_}.'</a> </td>'."\n". 1008: '<td> '.$uname.' </td>'. 1009: '<td> '.$udom.' </td>'; 1010: if ($receiptparts) { 1011: $contents.='<td> '.$part.' </td>'; 1012: } 1013: $contents.= 1014: &Apache::loncommon::end_data_table_row()."\n"; 1015: 1016: $matches++; 1017: } 1018: } 1019: } 1020: if ($matches == 0) { 1021: $string = $title 1022: .'<p class="LC_warning">' 1023: .&mt('No match found for the above receipt number.') 1024: .'</p>'; 1025: } else { 1026: $string = &jscriptNform($symb).$title. 1027: '<p>'. 1028: &mt('The above receipt number matches the following [quant,_1,student].',$matches). 1029: '</p>'. 1030: $header. 1031: $contents. 1032: &Apache::loncommon::end_data_table()."\n"; 1033: } 1034: return $string; 1035: } 1036: 1037: #--- This is called by a number of programs. 1038: #--- Called from the Grading Menu - View/Grade an individual student 1039: #--- Also called directly when one clicks on the subm button 1040: # on the problem page. 1041: sub listStudents { 1042: my ($request,$symb,$submitonly,$divforres) = @_; 1043: 1044: my $is_tool = ($symb =~ /ext\.tool$/); 1045: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 1046: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 1047: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 1048: my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; 1049: unless ($submitonly) { 1050: $submitonly = $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; 1051: } 1052: 1053: my $result=''; 1054: my $res_error; 1055: my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error); 1056: 1057: my $table; 1058: if (ref($partlist) eq 'ARRAY') { 1059: if (scalar(@$partlist) > 1 ) { 1060: $table = &showResourceInfo($symb,$partlist,$responseType,'gradesub',1); 1061: } elsif ($divforres) { 1062: $table = '<div style="padding:0;clear:both;margin:0;border:0"></div>'; 1063: } else { 1064: $table = '<br clear="all" />'; 1065: } 1066: } 1067: 1068: my %js_lt = &Apache::lonlocal::texthash ( 1069: 'multiple' => 'Please select a student or group of students before clicking on the Next button.', 1070: 'single' => 'Please select the student before clicking on the Next button.', 1071: ); 1072: &js_escape(\%js_lt); 1073: $request->print(&Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT)); 1074: function checkSelect(checkBox) { 1075: var ctr=0; 1076: var sense=""; 1077: if (checkBox.length > 1) { 1078: for (var i=0; i<checkBox.length; i++) { 1079: if (checkBox[i].checked) { 1080: ctr++; 1081: } 1082: } 1083: sense = '$js_lt{'multiple'}'; 1084: } else { 1085: if (checkBox.checked) { 1086: ctr = 1; 1087: } 1088: sense = '$js_lt{'single'}'; 1089: } 1090: if (ctr == 0) { 1091: alert(sense); 1092: return false; 1093: } 1094: document.gradesub.submit(); 1095: } 1096: 1097: function reLoadList(formname) { 1098: if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;} 1099: formname.command.value = 'submission'; 1100: formname.submit(); 1101: } 1102: LISTJAVASCRIPT 1103: 1104: &commonJSfunctions($request); 1105: $request->print($result); 1106: 1107: my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'. 1108: "\n".$table; 1109: 1110: $gradeTable .= &Apache::lonhtmlcommon::start_pick_box(); 1111: unless ($is_tool) { 1112: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) 1113: .'<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n" 1114: .'<label><input type="radio" name="vProb" value="yes" /> '.&mt('one student').' </label>'."\n" 1115: .'<label><input type="radio" name="vProb" value="all" /> '.&mt('all students').' </label><br />'."\n" 1116: .&Apache::lonhtmlcommon::row_closure(); 1117: $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer')) 1118: .'<label><input type="radio" name="vAns" value="no" /> '.&mt('no').' </label>'."\n" 1119: .'<label><input type="radio" name="vAns" value="yes" /> '.&mt('one student').' </label>'."\n" 1120: .'<label><input type="radio" name="vAns" value="all" checked="checked" /> '.&mt('all students').' </label><br />'."\n" 1121: .&Apache::lonhtmlcommon::row_closure(); 1122: } 1123: 1124: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 1125: my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status; 1126: $env{'form.Status'} = $saveStatus; 1127: my %optiontext; 1128: if ($is_tool) { 1129: %optiontext = &Apache::lonlocal::texthash ( 1130: lastonly => 'last transaction', 1131: last => 'last transaction with details', 1132: datesub => 'all transactions', 1133: all => 'all transactions with details', 1134: ); 1135: } else { 1136: %optiontext = &Apache::lonlocal::texthash ( 1137: lastonly => 'last submission', 1138: last => 'last submission with details', 1139: datesub => 'all submissions', 1140: all => 'all submissions with details', 1141: ); 1142: } 1143: my $submission_options = 1144: '<span class="LC_nobreak">'. 1145: '<label><input type="radio" name="lastSub" value="lastonly" /> '. 1146: $optiontext{'lastonly'}.' </label></span>'."\n". 1147: '<span class="LC_nobreak">'. 1148: '<label><input type="radio" name="lastSub" value="last" /> '. 1149: $optiontext{'last'}.' </label></span>'."\n". 1150: '<span class="LC_nobreak">'. 1151: '<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '. 1152: $optiontext{'datesub'}.'</label></span>'."\n". 1153: '<span class="LC_nobreak">'. 1154: '<label><input type="radio" name="lastSub" value="all" /> '. 1155: $optiontext{'all'}.'</label></span>'; 1156: my $viewtitle; 1157: if ($is_tool) { 1158: $viewtitle = &mt('View Transactions'); 1159: } else { 1160: $viewtitle = &mt('View Submissions'); 1161: } 1162: my ($compmsg,$nocompmsg); 1163: $nocompmsg = ' checked="checked"'; 1164: if ($numessay) { 1165: $compmsg = $nocompmsg; 1166: $nocompmsg = ''; 1167: } 1168: $gradeTable .= &Apache::lonhtmlcommon::row_title($viewtitle) 1169: .$submission_options; 1170: # Check if any gradable 1171: my $showmore; 1172: if ($perm{'mgr'}) { 1173: my @sections; 1174: if ($env{'request.course.sec'} ne '') { 1175: @sections = ($env{'request.course.sec'}); 1176: } elsif ($env{'form.section'} eq '') { 1177: @sections = ('all'); 1178: } else { 1179: @sections = &Apache::loncommon::get_env_multiple('form.section'); 1180: } 1181: if (grep(/^all$/,@sections)) { 1182: $showmore = 1; 1183: } else { 1184: foreach my $sec (@sections) { 1185: if (&canmodify($sec)) { 1186: $showmore = 1; 1187: last; 1188: } 1189: } 1190: } 1191: } 1192: 1193: if ($showmore) { 1194: $gradeTable .= 1195: &Apache::lonhtmlcommon::row_closure() 1196: .&Apache::lonhtmlcommon::row_title(&mt('Send Messages')) 1197: .'<span class="LC_nobreak">' 1198: .'<label><input type="radio" name="compmsg" value="0"'.$nocompmsg.' />' 1199: .&mt('No').(' 'x2).'</label>' 1200: .'<label><input type="radio" name="compmsg" value="1"'.$compmsg.' />' 1201: .&mt('Yes').(' 'x2).'</label>' 1202: .&Apache::lonhtmlcommon::row_closure(); 1203: 1204: $gradeTable .= 1205: &Apache::lonhtmlcommon::row_title(&mt('Grading Increments')) 1206: .'<select name="increment">' 1207: .'<option value="1">'.&mt('Whole Points').'</option>' 1208: .'<option value=".5">'.&mt('Half Points').'</option>' 1209: .'<option value=".25">'.&mt('Quarter Points').'</option>' 1210: .'<option value=".1">'.&mt('Tenths of a Point').'</option>' 1211: .'</select>'; 1212: } 1213: $gradeTable .= 1214: &build_section_inputs(). 1215: '<input type="hidden" name="submitonly" value="'.$submitonly.'" />'."\n". 1216: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 1217: '<input type="hidden" name="saveStatusOld" value="'.$saveStatus.'" />'."\n"; 1218: if (exists($env{'form.Status'})) { 1219: $gradeTable .= '<input type="hidden" name="Status" value="'.$env{'form.Status'}.'" />'."\n"; 1220: } else { 1221: $gradeTable .= &Apache::lonhtmlcommon::row_closure() 1222: .&Apache::lonhtmlcommon::row_title(&mt('Student Status')) 1223: .&Apache::lonhtmlcommon::StatusOptions( 1224: $saveStatus,undef,1,'javascript:reLoadList(this.form);'); 1225: } 1226: if ($numessay) { 1227: $gradeTable .= &Apache::lonhtmlcommon::row_closure() 1228: .&Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism')) 1229: .'<input type="checkbox" name="checkPlag" checked="checked" />'; 1230: } 1231: $gradeTable .= &Apache::lonhtmlcommon::row_closure(1) 1232: .&Apache::lonhtmlcommon::end_pick_box(); 1233: my $regrademsg; 1234: if ($is_tool) { 1235: $regrademsg =&mt("To view/grade/regrade, click on the check box(es) next to the student's name(s). Then click on the Next button."); 1236: } else { 1237: $regrademsg = &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."); 1238: } 1239: $gradeTable .= '<p>' 1240: .$regrademsg."\n" 1241: .'<input type="hidden" name="command" value="processGroup" />' 1242: .'</p>'; 1243: 1244: # checkall buttons 1245: $gradeTable.=&check_script('gradesub', 'stuinfo'); 1246: $gradeTable.='<input type="button" '."\n". 1247: 'onclick="javascript:checkSelect(this.form.stuinfo);" '."\n". 1248: 'value="'.&mt('Next').' →" /> <br />'."\n"; 1249: $gradeTable.=&check_buttons(); 1250: my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup); 1251: $gradeTable.= &Apache::loncommon::start_data_table(). 1252: &Apache::loncommon::start_data_table_header_row(); 1253: my $loop = 0; 1254: while ($loop < 2) { 1255: $gradeTable.='<th>'.&mt('No.').'</th><th>'.&mt('Select').'</th>'. 1256: '<th>'.&nameUserString('header').' '.&mt('Section/Group').'</th>'; 1257: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 1258: foreach my $part (sort(@$partlist)) { 1259: my $display_part= 1260: &get_display_part((split(/_/,$part))[0],$symb); 1261: $gradeTable.= 1262: '<th>'.&mt('Part: [_1] Status',$display_part).'</th>'; 1263: } 1264: } elsif ($submitonly eq 'queued') { 1265: $gradeTable.='<th>'.&mt('Queue Status').' </th>'; 1266: } 1267: $loop++; 1268: # $gradeTable.='<td></td>' if ($loop%2 ==1); 1269: } 1270: $gradeTable.=&Apache::loncommon::end_data_table_header_row()."\n"; 1271: 1272: my $ctr = 0; 1273: foreach my $student (sort 1274: { 1275: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 1276: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 1277: } 1278: return $a cmp $b; 1279: } 1280: (keys(%$fullname))) { 1281: my ($uname,$udom) = split(/:/,$student); 1282: 1283: my %status = (); 1284: 1285: if ($submitonly eq 'queued') { 1286: my %queue_status = 1287: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 1288: $udom,$uname); 1289: next if (!defined($queue_status{'gradingqueue'})); 1290: $status{'gradingqueue'} = $queue_status{'gradingqueue'}; 1291: } 1292: 1293: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 1294: (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); 1295: my $submitted = 0; 1296: my $graded = 0; 1297: my $incorrect = 0; 1298: foreach (keys(%status)) { 1299: $submitted = 1 if ($status{$_} ne 'nothing'); 1300: $graded = 1 if ($status{$_} =~ /^ungraded/); 1301: $incorrect = 1 if ($status{$_} =~ /^incorrect/); 1302: 1303: my ($foo,$partid,$foo1) = split(/\./,$_); 1304: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 1305: $submitted = 0; 1306: my ($part)=split(/\./,$partid); 1307: $gradeTable.='<input type="hidden" name="'. 1308: $student.':'.$part.':submitted_by" value="'. 1309: $status{'resource.'.$partid.'.submitted_by'}.'" />'; 1310: } 1311: } 1312: 1313: next if (!$submitted && ($submitonly eq 'yes' || 1314: $submitonly eq 'incorrect' || 1315: $submitonly eq 'graded')); 1316: next if (!$graded && ($submitonly eq 'graded')); 1317: next if (!$incorrect && $submitonly eq 'incorrect'); 1318: } 1319: 1320: $ctr++; 1321: my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; 1322: my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; 1323: if ( $perm{'vgr'} eq 'F' ) { 1324: if ($ctr%2 ==1) { 1325: $gradeTable.= &Apache::loncommon::start_data_table_row(); 1326: } 1327: $gradeTable.='<td align="right">'.$ctr.' </td>'. 1328: '<td align="center"><label><input type="checkbox" name="stuinfo" value="'. 1329: $student.':'.$$fullname{$student}.':::SECTION'.$section. 1330: ') " />  </label></td>'."\n".'<td>'. 1331: &nameUserString(undef,$$fullname{$student},$uname,$udom). 1332: ' '.$section.($group ne '' ?'/'.$group:'').'</td>'."\n"; 1333: 1334: if ($submitonly ne 'all') { 1335: foreach (sort(keys(%status))) { 1336: next if ($_ =~ /^resource.*?submitted_by$/); 1337: $gradeTable.='<td align="center"> '.&mt($status{$_}).' </td>'."\n"; 1338: } 1339: } 1340: # $gradeTable.='<td></td>' if ($ctr%2 ==1); 1341: if ($ctr%2 ==0) { 1342: $gradeTable.=&Apache::loncommon::end_data_table_row()."\n"; 1343: } 1344: } 1345: } 1346: if ($ctr%2 ==1) { 1347: $gradeTable.='<td> </td><td> </td><td> </td>'; 1348: if (($submitonly ne 'queued') && ($submitonly ne 'all')) { 1349: foreach (@$partlist) { 1350: $gradeTable.='<td> </td>'; 1351: } 1352: } elsif ($submitonly eq 'queued') { 1353: $gradeTable.='<td> </td>'; 1354: } 1355: $gradeTable.=&Apache::loncommon::end_data_table_row(); 1356: } 1357: 1358: $gradeTable.=&Apache::loncommon::end_data_table()."\n". 1359: '<input type="button" '. 1360: 'onclick="javascript:checkSelect(this.form.stuinfo);" '. 1361: 'value="'.&mt('Next').' →" /></form>'."\n"; 1362: if ($ctr == 0) { 1363: my $num_students=(scalar(keys(%$fullname))); 1364: if ($num_students eq 0) { 1365: $gradeTable='<br /> <span class="LC_warning">'.&mt('There are no students currently enrolled.').'</span>'; 1366: } else { 1367: my $submissions='submissions'; 1368: if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } 1369: if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } 1370: if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } 1371: $gradeTable='<br /> <span class="LC_warning">'. 1372: &mt('No '.$submissions.' found for this resource for any students. ([quant,_1,student] checked for '.$submissions.')', 1373: $num_students). 1374: '</span><br />'; 1375: } 1376: } elsif ($ctr == 1) { 1377: $gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/; 1378: } 1379: $request->print($gradeTable); 1380: return ''; 1381: } 1382: 1383: #---- Called from the listStudents routine 1384: 1385: sub check_script { 1386: my ($form,$type) = @_; 1387: my $chkallscript = &Apache::lonhtmlcommon::scripttag(' 1388: function checkall() { 1389: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1390: ele = document.forms.'.$form.'.elements[i]; 1391: if (ele.name == "'.$type.'") { 1392: document.forms.'.$form.'.elements[i].checked=true; 1393: } 1394: } 1395: } 1396: 1397: function checksec() { 1398: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1399: ele = document.forms.'.$form.'.elements[i]; 1400: string = document.forms.'.$form.'.chksec.value; 1401: if 1402: (ele.value.indexOf(":::SECTION"+string)>0) { 1403: document.forms.'.$form.'.elements[i].checked=true; 1404: } 1405: } 1406: } 1407: 1408: 1409: function uncheckall() { 1410: for (i=0; i<document.forms.'.$form.'.elements.length; i++) { 1411: ele = document.forms.'.$form.'.elements[i]; 1412: if (ele.name == "'.$type.'") { 1413: document.forms.'.$form.'.elements[i].checked=false; 1414: } 1415: } 1416: } 1417: 1418: '."\n"); 1419: return $chkallscript; 1420: } 1421: 1422: sub check_buttons { 1423: my $buttons.='<input type="button" onclick="checkall()" value="'.&mt('Check All').'" />'; 1424: $buttons.='<input type="button" onclick="uncheckall()" value="'.&mt('Uncheck All').'" /> '; 1425: $buttons.='<input type="button" onclick="checksec()" value="'.&mt('Check Section/Group').'" />'; 1426: $buttons.='<input type="text" size="5" name="chksec" /> '; 1427: return $buttons; 1428: } 1429: 1430: # Displays the submissions for one student or a group of students 1431: sub processGroup { 1432: my ($request,$symb) = @_; 1433: my $ctr = 0; 1434: my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); 1435: my $total = scalar(@stuchecked)-1; 1436: 1437: foreach my $student (@stuchecked) { 1438: my ($uname,$udom,$fullname) = split(/:/,$student); 1439: $env{'form.student'} = $uname; 1440: $env{'form.userdom'} = $udom; 1441: $env{'form.fullname'} = $fullname; 1442: &submission($request,$ctr,$total,$symb); 1443: $ctr++; 1444: } 1445: return ''; 1446: } 1447: 1448: #------------------------------------------------------------------------------------ 1449: # 1450: #-------------------------- Next few routines handles grading by student, essentially 1451: # handles essay response type problem/part 1452: # 1453: #--- Javascript to handle the submission page functionality --- 1454: sub sub_page_js { 1455: my $request = shift; 1456: my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); 1457: &js_escape(\$alertmsg); 1458: $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT)); 1459: function updateRadio(formname,id,weight) { 1460: var gradeBox = formname["GD_BOX"+id]; 1461: var radioButton = formname["RADVAL"+id]; 1462: var oldpts = formname["oldpts"+id].value; 1463: var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts; 1464: gradeBox.value = pts; 1465: var resetbox = false; 1466: if (isNaN(pts) || pts < 0) { 1467: alert("$alertmsg"+pts); 1468: for (var i=0; i<radioButton.length; i++) { 1469: if (radioButton[i].checked) { 1470: gradeBox.value = i; 1471: resetbox = true; 1472: } 1473: } 1474: if (!resetbox) { 1475: formtextbox.value = ""; 1476: } 1477: return; 1478: } 1479: 1480: if (pts > weight) { 1481: var resp = confirm("You entered a value ("+pts+ 1482: ") greater than the weight for the part. Accept?"); 1483: if (resp == false) { 1484: gradeBox.value = oldpts; 1485: return; 1486: } 1487: } 1488: 1489: for (var i=0; i<radioButton.length; i++) { 1490: radioButton[i].checked=false; 1491: if (pts == i && pts != "") { 1492: radioButton[i].checked=true; 1493: } 1494: } 1495: updateSelect(formname,id); 1496: formname["stores"+id].value = "0"; 1497: } 1498: 1499: function writeBox(formname,id,pts) { 1500: var gradeBox = formname["GD_BOX"+id]; 1501: if (checkSolved(formname,id) == 'update') { 1502: gradeBox.value = pts; 1503: } else { 1504: var oldpts = formname["oldpts"+id].value; 1505: gradeBox.value = oldpts; 1506: var radioButton = formname["RADVAL"+id]; 1507: for (var i=0; i<radioButton.length; i++) { 1508: radioButton[i].checked=false; 1509: if (i == oldpts) { 1510: radioButton[i].checked=true; 1511: } 1512: } 1513: } 1514: formname["stores"+id].value = "0"; 1515: updateSelect(formname,id); 1516: return; 1517: } 1518: 1519: function clearRadBox(formname,id) { 1520: if (checkSolved(formname,id) == 'noupdate') { 1521: updateSelect(formname,id); 1522: return; 1523: } 1524: gradeSelect = formname["GD_SEL"+id]; 1525: for (var i=0; i<gradeSelect.length; i++) { 1526: if (gradeSelect[i].selected) { 1527: var selectx=i; 1528: } 1529: } 1530: var stores = formname["stores"+id]; 1531: if (selectx == stores.value) { return }; 1532: var gradeBox = formname["GD_BOX"+id]; 1533: gradeBox.value = ""; 1534: var radioButton = formname["RADVAL"+id]; 1535: for (var i=0; i<radioButton.length; i++) { 1536: radioButton[i].checked=false; 1537: } 1538: stores.value = selectx; 1539: } 1540: 1541: function checkSolved(formname,id) { 1542: if (formname["solved"+id].value == "correct_by_student" && formname.overRideScore.value == 'no') { 1543: var reply = confirm("This problem has been graded correct by the computer. Do you want to change the score?"); 1544: if (!reply) {return "noupdate";} 1545: formname.overRideScore.value = 'yes'; 1546: } 1547: return "update"; 1548: } 1549: 1550: function updateSelect(formname,id) { 1551: formname["GD_SEL"+id][0].selected = true; 1552: return; 1553: } 1554: 1555: //=========== Check that a point is assigned for all the parts ============ 1556: function checksubmit(formname,val,total,parttot) { 1557: formname.gradeOpt.value = val; 1558: if (val == "Save & Next") { 1559: for (i=0;i<=total;i++) { 1560: for (j=0;j<parttot;j++) { 1561: var partid = formname["partid"+i+"_"+j].value; 1562: if (formname["GD_SEL"+i+"_"+partid][0].selected) { 1563: var points = formname["GD_BOX"+i+"_"+partid].value; 1564: if (points == "") { 1565: var name = formname["name"+i].value; 1566: var studentID = (name != '' ? name : formname["unamedom"+i].value); 1567: var resp = confirm("You did not assign a score for "+studentID+ 1568: ", part "+partid+". Continue?"); 1569: if (resp == false) { 1570: formname["GD_BOX"+i+"_"+partid].focus(); 1571: return false; 1572: } 1573: } 1574: } 1575: } 1576: } 1577: } 1578: formname.submit(); 1579: } 1580: 1581: //======= Check that a score is assigned for all the problems (page/sequence grading only) ========= 1582: function checkSubmitPage(formname,total) { 1583: noscore = new Array(100); 1584: var ptr = 0; 1585: for (i=1;i<total;i++) { 1586: var partid = formname["q_"+i].value; 1587: if (formname["GD_SEL"+i+"_"+partid][0].selected) { 1588: var points = formname["GD_BOX"+i+"_"+partid].value; 1589: var status = formname["solved"+i+"_"+partid].value; 1590: if (points == "" && status != "correct_by_student") { 1591: noscore[ptr] = i; 1592: ptr++; 1593: } 1594: } 1595: } 1596: if (ptr != 0) { 1597: var sense = ptr == 1 ? ": " : "s: "; 1598: var prolist = ""; 1599: if (ptr == 1) { 1600: prolist = noscore[0]; 1601: } else { 1602: var i = 0; 1603: while (i < ptr-1) { 1604: prolist += noscore[i]+", "; 1605: i++; 1606: } 1607: prolist += "and "+noscore[i]; 1608: } 1609: var resp = confirm("You did not assign any score for the following problem"+sense+prolist+". Continue?"); 1610: if (resp == false) { 1611: return false; 1612: } 1613: } 1614: 1615: formname.submit(); 1616: } 1617: SUBJAVASCRIPT 1618: } 1619: 1620: #--- javascript for grading message center 1621: sub sub_grademessage_js { 1622: my $request = shift; 1623: my $iconpath = $request->dir_config('lonIconsURL'); 1624: &commonJSfunctions($request); 1625: 1626: my $inner_js_msg_central= (<<INNERJS); 1627: <script type="text/javascript"> 1628: function checkInput() { 1629: opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value); 1630: var nmsg = opener.document.SCORE.savemsgN.value; 1631: var usrctr = document.msgcenter.usrctr.value; 1632: var newval = opener.document.SCORE["newmsg"+usrctr]; 1633: newval.value = opener.checkEntities(document.msgcenter.newmsg.value); 1634: 1635: var msgchk = ""; 1636: if (document.msgcenter.subchk.checked) { 1637: msgchk = "msgsub,"; 1638: } 1639: var includemsg = 0; 1640: for (var i=1; i<=nmsg; i++) { 1641: var opnmsg = opener.document.SCORE["savemsg"+i]; 1642: var frmmsg = document.msgcenter["msg"+i]; 1643: opnmsg.value = opener.checkEntities(frmmsg.value); 1644: var showflg = opener.document.SCORE["shownOnce"+i]; 1645: showflg.value = "1"; 1646: var chkbox = document.msgcenter["msgn"+i]; 1647: if (chkbox.checked) { 1648: msgchk += "savemsg"+i+","; 1649: includemsg = 1; 1650: } 1651: } 1652: if (document.msgcenter.newmsgchk.checked) { 1653: msgchk += "newmsg"+usrctr; 1654: includemsg = 1; 1655: } 1656: imgformname = opener.document.SCORE["mailicon"+usrctr]; 1657: imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif"); 1658: var includemsg = opener.document.SCORE["includemsg"+usrctr]; 1659: includemsg.value = msgchk; 1660: 1661: self.close() 1662: 1663: } 1664: </script> 1665: INNERJS 1666: 1667: my $start_page_msg_central = 1668: &Apache::loncommon::start_page('Message Central',$inner_js_msg_central, 1669: {'js_ready' => 1, 1670: 'only_body' => 1, 1671: 'bgcolor' =>'#FFFFFF',}); 1672: my $end_page_msg_central = 1673: &Apache::loncommon::end_page({'js_ready' => 1}); 1674: 1675: my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); 1676: $docopen=~s/^document\.//; 1677: 1678: my %html_js_lt = &Apache::lonlocal::texthash( 1679: comp => 'Compose Message for: ', 1680: incl => 'Include', 1681: type => 'Type', 1682: subj => 'Subject', 1683: mesa => 'Message', 1684: new => 'New', 1685: save => 'Save', 1686: canc => 'Cancel', 1687: ); 1688: &html_escape(\%html_js_lt); 1689: &js_escape(\%html_js_lt); 1690: $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT)); 1691: 1692: //===================== Script to view submitted by ================== 1693: function viewSubmitter(submitter) { 1694: document.SCORE.refresh.value = "on"; 1695: document.SCORE.NCT.value = "1"; 1696: document.SCORE.unamedom0.value = submitter; 1697: document.SCORE.submit(); 1698: return; 1699: } 1700: 1701: //====================== Script for composing message ============== 1702: // preload images 1703: img1 = new Image(); 1704: img1.src = "$iconpath/mailbkgrd.gif"; 1705: img2 = new Image(); 1706: img2.src = "$iconpath/mailto.gif"; 1707: 1708: function msgCenter(msgform,usrctr,fullname) { 1709: var Nmsg = msgform.savemsgN.value; 1710: savedMsgHeader(Nmsg,usrctr,fullname); 1711: var subject = msgform.msgsub.value; 1712: var msgchk = document.SCORE["includemsg"+usrctr].value; 1713: re = /msgsub/; 1714: var shwsel = ""; 1715: if (re.test(msgchk)) { shwsel = "checked" } 1716: subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject); 1717: displaySubject(checkEntities(subject),shwsel); 1718: for (var i=1; i<=Nmsg; i++) { 1719: var testmsg = "savemsg"+i+","; 1720: re = new RegExp(testmsg,"g"); 1721: shwsel = ""; 1722: if (re.test(msgchk)) { shwsel = "checked" } 1723: var message = document.SCORE["savemsg"+i].value; 1724: message = (document.SCORE["shownOnce"+i].value == 0 ? checkEntities(message) : message); 1725: displaySavedMsg(i,message,shwsel); //I do not get it. w/o checkEntities on saved messages, 1726: //any < is already converted to <, etc. However, only once!! 1727: } 1728: newmsg = document.SCORE["newmsg"+usrctr].value; 1729: shwsel = ""; 1730: re = /newmsg/; 1731: if (re.test(msgchk)) { shwsel = "checked" } 1732: newMsg(newmsg,shwsel); 1733: msgTail(); 1734: return; 1735: } 1736: 1737: function checkEntities(strx) { 1738: if (strx.length == 0) return strx; 1739: var orgStr = ["&", "<", ">", '"']; 1740: var newStr = ["&", "<", ">", """]; 1741: var counter = 0; 1742: while (counter < 4) { 1743: strx = strReplace(strx,orgStr[counter],newStr[counter]); 1744: counter++; 1745: } 1746: return strx; 1747: } 1748: 1749: function strReplace(strx, orgStr, newStr) { 1750: return strx.split(orgStr).join(newStr); 1751: } 1752: 1753: function savedMsgHeader(Nmsg,usrctr,fullname) { 1754: var height = 70*Nmsg+250; 1755: if (height > 600) { 1756: height = 600; 1757: } 1758: var xpos = (screen.width-600)/2; 1759: xpos = (xpos < 0) ? '0' : xpos; 1760: var ypos = (screen.height-height)/2-30; 1761: ypos = (ypos < 0) ? '0' : ypos; 1762: 1763: pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars=yes,screenx='+xpos+',screeny='+ypos+',width=700,height='+height); 1764: pWin.focus(); 1765: pDoc = pWin.document; 1766: pDoc.$docopen; 1767: pDoc.write('$start_page_msg_central'); 1768: 1769: pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">"); 1770: pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">"); 1771: pDoc.write("<h1> $html_js_lt{'comp'}\"+fullname+\"<\\/h1>"); 1772: 1773: pDoc.write('<table style="border:1px solid black;"><tr>'); 1774: pDoc.write("<td><b>$html_js_lt{'incl'}<\\/b><\\/td><td><b>$html_js_lt{'type'}<\\/b><\\/td><td><b>$html_js_lt{'mesa'}<\\/td><\\/tr>"); 1775: } 1776: function displaySubject(msg,shwsel) { 1777: pDoc = pWin.document; 1778: pDoc.write("<tr>"); 1779: pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1780: pDoc.write("<td>$html_js_lt{'subj'}<\\/td>"); 1781: pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"40\\" maxlength=\\"80\\"><\\/td><\\/tr>"); 1782: } 1783: 1784: function displaySavedMsg(ctr,msg,shwsel) { 1785: pDoc = pWin.document; 1786: pDoc.write("<tr>"); 1787: pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1788: pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>"); 1789: pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>"); 1790: } 1791: 1792: function newMsg(newmsg,shwsel) { 1793: pDoc = pWin.document; 1794: pDoc.write("<tr>"); 1795: pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); 1796: pDoc.write("<td align=\\"center\\">$html_js_lt{'new'}<\\/td>"); 1797: pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>"); 1798: } 1799: 1800: function msgTail() { 1801: pDoc = pWin.document; 1802: pDoc.write("<\\/td><\\/tr><\\/table> "); 1803: pDoc.write("<input type=\\"button\\" value=\\"$html_js_lt{'save'}\\" onclick=\\"javascript:checkInput()\\">  "); 1804: pDoc.write("<input type=\\"button\\" value=\\"$html_js_lt{'canc'}\\" onclick=\\"self.close()\\"><br /><br />"); 1805: pDoc.write("<\\/form>"); 1806: pDoc.write('$end_page_msg_central'); 1807: pDoc.close(); 1808: } 1809: 1810: SUBJAVASCRIPT 1811: } 1812: 1813: #--- javascript for essay type problem -- 1814: sub sub_page_kw_js { 1815: my $request = shift; 1816: 1817: unless ($env{'form.compmsg'}) { 1818: &commonJSfunctions($request); 1819: } 1820: 1821: my $inner_js_highlight_central= (<<INNERJS); 1822: <script type="text/javascript"> 1823: function updateChoice(flag) { 1824: opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr); 1825: opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize); 1826: opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle); 1827: opener.document.SCORE.refresh.value = "on"; 1828: if (opener.document.SCORE.keywords.value!=""){ 1829: opener.document.SCORE.submit(); 1830: } 1831: self.close() 1832: } 1833: </script> 1834: INNERJS 1835: 1836: my $start_page_highlight_central = 1837: &Apache::loncommon::start_page('Highlight Central', 1838: $inner_js_highlight_central, 1839: {'js_ready' => 1, 1840: 'only_body' => 1, 1841: 'bgcolor' =>'#FFFFFF',}); 1842: my $end_page_highlight_central = 1843: &Apache::loncommon::end_page({'js_ready' => 1}); 1844: 1845: my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); 1846: $docopen=~s/^document\.//; 1847: 1848: my %js_lt = &Apache::lonlocal::texthash( 1849: keyw => 'Keywords list, separated by a space. Add/delete to list if desired.', 1850: plse => 'Please select a word or group of words from document and then click this link.', 1851: adds => 'Add selection to keyword list? Edit if desired.', 1852: col1 => 'red', 1853: col2 => 'green', 1854: col3 => 'blue', 1855: siz1 => 'normal', 1856: siz2 => '+1', 1857: siz3 => '+2', 1858: sty1 => 'normal', 1859: sty2 => 'italic', 1860: sty3 => 'bold', 1861: ); 1862: my %html_js_lt = &Apache::lonlocal::texthash( 1863: save => 'Save', 1864: canc => 'Cancel', 1865: kehi => 'Keyword Highlight Options', 1866: txtc => 'Text Color', 1867: font => 'Font Size', 1868: fnst => 'Font Style', 1869: ); 1870: &js_escape(\%js_lt); 1871: &html_escape(\%html_js_lt); 1872: &js_escape(\%html_js_lt); 1873: $request->print(&Apache::lonhtmlcommon::scripttag(<<SUBJAVASCRIPT)); 1874: 1875: //===================== Show list of keywords ==================== 1876: function keywords(formname) { 1877: var nret = prompt("$js_lt{'keyw'}",formname.keywords.value); 1878: if (nret==null) return; 1879: formname.keywords.value = nret; 1880: 1881: if (formname.keywords.value != "") { 1882: formname.refresh.value = "on"; 1883: formname.submit(); 1884: } 1885: return; 1886: } 1887: 1888: //===================== Script to add keyword(s) ================== 1889: function getSel() { 1890: if (document.getSelection) txt = document.getSelection(); 1891: else if (document.selection) txt = document.selection.createRange().text; 1892: else return; 1893: if (typeof(txt) != 'string') { 1894: txt = String(txt); 1895: } 1896: var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," "); 1897: if (cleantxt=="") { 1898: alert("$js_lt{'plse'}"); 1899: return; 1900: } 1901: var nret = prompt("$js_lt{'adds'}",cleantxt); 1902: if (nret==null) return; 1903: document.SCORE.keywords.value = document.SCORE.keywords.value+" "+nret; 1904: if (document.SCORE.keywords.value != "") { 1905: document.SCORE.refresh.value = "on"; 1906: document.SCORE.submit(); 1907: } 1908: return; 1909: } 1910: 1911: //====================== Script for keyword highlight options ============== 1912: function kwhighlight() { 1913: var kwclr = document.SCORE.kwclr.value; 1914: var kwsize = document.SCORE.kwsize.value; 1915: var kwstyle = document.SCORE.kwstyle.value; 1916: var redsel = ""; 1917: var grnsel = ""; 1918: var blusel = ""; 1919: var txtcol1 = "$js_lt{'col1'}"; 1920: var txtcol2 = "$js_lt{'col2'}"; 1921: var txtcol3 = "$js_lt{'col3'}"; 1922: var txtsiz1 = "$js_lt{'siz1'}"; 1923: var txtsiz2 = "$js_lt{'siz2'}"; 1924: var txtsiz3 = "$js_lt{'siz3'}"; 1925: var txtsty1 = "$js_lt{'sty1'}"; 1926: var txtsty2 = "$js_lt{'sty2'}"; 1927: var txtsty3 = "$js_lt{'sty3'}"; 1928: if (kwclr=="red") {var redsel="checked='checked'"}; 1929: if (kwclr=="green") {var grnsel="checked='checked'"}; 1930: if (kwclr=="blue") {var blusel="checked='checked'"}; 1931: var sznsel = ""; 1932: var sz1sel = ""; 1933: var sz2sel = ""; 1934: if (kwsize=="0") {var sznsel="checked='checked'"}; 1935: if (kwsize=="+1") {var sz1sel="checked='checked'"}; 1936: if (kwsize=="+2") {var sz2sel="checked='checked'"}; 1937: var synsel = ""; 1938: var syisel = ""; 1939: var sybsel = ""; 1940: if (kwstyle=="") {var synsel="checked='checked'"}; 1941: if (kwstyle=="<i>") {var syisel="checked='checked'"}; 1942: if (kwstyle=="<b>") {var sybsel="checked='checked'"}; 1943: highlightCentral(); 1944: highlightbody('red',txtcol1,redsel,'0',txtsiz1,sznsel,'',txtsty1,synsel); 1945: highlightbody('green',txtcol2,grnsel,'+1',txtsiz2,sz1sel,'<i>',txtsty2,syisel); 1946: highlightbody('blue',txtcol3,blusel,'+2',txtsiz3,sz2sel,'<b>',txtsty3,sybsel); 1947: highlightend(); 1948: return; 1949: } 1950: 1951: function highlightCentral() { 1952: // if (window.hwdWin) window.hwdWin.close(); 1953: var xpos = (screen.width-400)/2; 1954: xpos = (xpos < 0) ? '0' : xpos; 1955: var ypos = (screen.height-330)/2-30; 1956: ypos = (ypos < 0) ? '0' : ypos; 1957: 1958: hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); 1959: hwdWin.focus(); 1960: var hDoc = hwdWin.document; 1961: hDoc.$docopen; 1962: hDoc.write('$start_page_highlight_central'); 1963: hDoc.write("<form action=\\"inactive\\" name=\\"hlCenter\\">"); 1964: hDoc.write("<h1>$html_js_lt{'kehi'}<\\/h1>"); 1965: 1966: hDoc.write('<table border="0" width="100%"><tr style="background-color:#A1D676">'); 1967: hDoc.write("<th>$html_js_lt{'txtc'}<\\/th><th>$html_js_lt{'font'}<\\/th><th>$html_js_lt{'fnst'}<\\/th><\\/tr>"); 1968: } 1969: 1970: function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) { 1971: var hDoc = hwdWin.document; 1972: hDoc.write("<tr>"); 1973: hDoc.write("<td align=\\"left\\">"); 1974: hDoc.write("<input name=\\"kwdclr\\" type=\\"radio\\" value=\\""+clrval+"\\" "+clrsel+" \\/> "+clrtxt+"<\\/td>"); 1975: hDoc.write("<td align=\\"left\\">"); 1976: hDoc.write("<input name=\\"kwdsize\\" type=\\"radio\\" value=\\""+szval+"\\" "+szsel+" \\/> "+sztxt+"<\\/td>"); 1977: hDoc.write("<td align=\\"left\\">"); 1978: hDoc.write("<input name=\\"kwdstyle\\" type=\\"radio\\" value=\\""+syval+"\\" "+sysel+" \\/> "+sytxt+"<\\/td>"); 1979: hDoc.write("<\\/tr>"); 1980: } 1981: 1982: function highlightend() { 1983: var hDoc = hwdWin.document; 1984: hDoc.write("<\\/table><br \\/>"); 1985: hDoc.write("<input type=\\"button\\" value=\\"$html_js_lt{'save'}\\" onclick=\\"javascript:updateChoice(1)\\" \\/>  "); 1986: hDoc.write("<input type=\\"button\\" value=\\"$html_js_lt{'canc'}\\" onclick=\\"self.close()\\" \\/><br /><br />"); 1987: hDoc.write("<\\/form>"); 1988: hDoc.write('$end_page_highlight_central'); 1989: hDoc.close(); 1990: } 1991: 1992: SUBJAVASCRIPT 1993: } 1994: 1995: sub get_increment { 1996: my $increment = $env{'form.increment'}; 1997: if ($increment != 1 && $increment != .5 && $increment != .25 && 1998: $increment != .1) { 1999: $increment = 1; 2000: } 2001: return $increment; 2002: } 2003: 2004: sub gradeBox_start { 2005: return ( 2006: &Apache::loncommon::start_data_table() 2007: .&Apache::loncommon::start_data_table_header_row() 2008: .'<th>'.&mt('Part').'</th>' 2009: .'<th>'.&mt('Points').'</th>' 2010: .'<th> </th>' 2011: .'<th>'.&mt('Assign Grade').'</th>' 2012: .'<th>'.&mt('Weight').'</th>' 2013: .'<th>'.&mt('Grade Status').'</th>' 2014: .&Apache::loncommon::end_data_table_header_row() 2015: ); 2016: } 2017: 2018: sub gradeBox_end { 2019: return ( 2020: &Apache::loncommon::end_data_table() 2021: ); 2022: } 2023: #--- displays the grading box, used in essay type problem and grading by page/sequence 2024: sub gradeBox { 2025: my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; 2026: my $checkIcon = '<img alt="'.&mt('Check Mark'). 2027: '" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />'; 2028: my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); 2029: my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)') 2030: : '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>'; 2031: $wgt = ($wgt > 0 ? $wgt : '1'); 2032: my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? 2033: '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); 2034: my $data_WGT='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n"; 2035: my $display_part= &get_display_part($partid,$symb); 2036: my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, 2037: [$partid]); 2038: my $aggtries = $$record{'resource.'.$partid.'.tries'}; 2039: if ($last_resets{$partid}) { 2040: $aggtries = &get_num_tries($record,$last_resets{$partid},$partid); 2041: } 2042: my $result=&Apache::loncommon::start_data_table_row(); 2043: my $ctr = 0; 2044: my $thisweight = 0; 2045: my $increment = &get_increment(); 2046: 2047: my $radio.='<table border="0"><tr>'."\n"; # display radio buttons in a nice table 10 across 2048: while ($thisweight<=$wgt) { 2049: $radio.= '<td><span class="LC_nobreak"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '. 2050: 'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','. 2051: $thisweight.')" value="'.$thisweight.'" '. 2052: ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n"; 2053: $radio.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); 2054: $thisweight += $increment; 2055: $ctr++; 2056: } 2057: $radio.='</tr></table>'; 2058: 2059: my $line.='<input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'. 2060: ($score ne ''? ' value = "'.$score.'"':'').' size="4" '. 2061: 'onchange="javascript:updateRadio(this.form,\''.$counter.'_'.$partid.'\','. 2062: $wgt.')" /></td>'."\n"; 2063: $line.='<td>/'.$wgt.' '.$wgtmsg. 2064: ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : ''). 2065: ' </td>'."\n"; 2066: $line.='<td><select name="GD_SEL'.$counter.'_'.$partid.'" '. 2067: 'onchange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n"; 2068: if ($$record{'resource.'.$partid.'.solved'} eq 'excused') { 2069: $line.='<option></option>'. 2070: '<option value="excused" selected="selected">'.&mt('excused').'</option>'; 2071: } else { 2072: $line.='<option selected="selected"></option>'. 2073: '<option value="excused" >'.&mt('excused').'</option>'; 2074: } 2075: $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n"; 2076: 2077: 2078: $result .= 2079: '<td>'.$data_WGT.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'; 2080: $result.=&Apache::loncommon::end_data_table_row(); 2081: $result.=&Apache::loncommon::start_data_table_row().'<td colspan="6">'; 2082: $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n". 2083: '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n". 2084: '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'. 2085: $$record{'resource.'.$partid.'.solved'}.'" />'."\n". 2086: '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'. 2087: $$record{'resource.'.$partid.'.tries'}.'" />'."\n". 2088: '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'. 2089: $aggtries.'" />'."\n"; 2090: my $res_error; 2091: $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record,\$res_error); 2092: $result.='</td>'.&Apache::loncommon::end_data_table_row(); 2093: if ($res_error) { 2094: return &navmap_errormsg(); 2095: } 2096: return $result; 2097: } 2098: 2099: sub handback_box { 2100: my ($symb,$uname,$udom,$counter,$partid,$record,$res_error_pointer) = @_; 2101: my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,$res_error_pointer); 2102: return unless ($numessay); 2103: my (@respids); 2104: my @part_response_id = &flatten_responseType($responseType); 2105: foreach my $part_response_id (@part_response_id) { 2106: my ($part,$resp) = @{ $part_response_id }; 2107: if ($part eq $partid) { 2108: push(@respids,$resp); 2109: } 2110: } 2111: my $result; 2112: foreach my $respid (@respids) { 2113: my $prefix = $counter.'_'.$partid.'_'.$respid.'_'; 2114: my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record); 2115: next if (!@$files); 2116: my $file_counter = 0; 2117: foreach my $file (@$files) { 2118: if ($file =~ /\/portfolio\//) { 2119: $file_counter++; 2120: my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|); 2121: my ($name,$version,$ext) = &file_name_version_ext($file_disp); 2122: $file_disp = "$name.$ext"; 2123: $file = $file_path.$file_disp; 2124: $result.=&mt('Return commented version of [_1] to student.', 2125: '<span class="LC_filename">'.$file_disp.'</span>'); 2126: $result.='<input type="file" name="'.$prefix.'returndoc'.$file_counter.'" />'."\n"; 2127: $result.='<input type="hidden" name="'.$prefix.'origdoc'.$file_counter.'" value="'.$file.'" /><br />'."\n"; 2128: } 2129: } 2130: if ($file_counter) { 2131: $result .= '<input type="hidden" name="'.$prefix.'countreturndoc" value="'.$file_counter.'" />'."\n". 2132: '<span class="LC_info">'. 2133: '('.&mt('File(s) will be uploaded when you click on Save & Next below.',$file_counter).')</span><br /><br />'; 2134: } 2135: } 2136: return $result; 2137: } 2138: 2139: sub show_problem { 2140: my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_; 2141: my $rendered; 2142: my %form = ((ref($form) eq 'HASH')? %{$form} : ()); 2143: &Apache::lonxml::remember_problem_counter(); 2144: if ($mode eq 'both' or $mode eq 'text') { 2145: $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, 2146: $env{'request.course.id'}, 2147: undef,\%form); 2148: } 2149: if ($removeform) { 2150: $rendered=~s|<form(.*?)>||g; 2151: $rendered=~s|</form>||g; 2152: $rendered=~s|(<input[^>]*name\s*=\s*"?)(\w+)("?)|$1would_have_been_$2$3|g; 2153: } 2154: my $companswer; 2155: if ($mode eq 'both' or $mode eq 'answer') { 2156: &Apache::lonxml::restore_problem_counter(); 2157: $companswer= 2158: &Apache::loncommon::get_student_answers($symb,$uname,$udom, 2159: $env{'request.course.id'}, 2160: %form); 2161: } 2162: if ($removeform) { 2163: $companswer=~s|<form(.*?)>||g; 2164: $companswer=~s|</form>||g; 2165: $companswer=~s|name="submit"|name="would_have_been_submit"|g; 2166: } 2167: my $renderheading = &mt('View of the problem'); 2168: my $answerheading = &mt('Correct answer'); 2169: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { 2170: my $stu_fullname = $env{'form.fullname'}; 2171: if ($stu_fullname eq '') { 2172: $stu_fullname = &Apache::loncommon::plainname($uname,$udom,'lastname'); 2173: } 2174: my $forwhom = &nameUserString(undef,$stu_fullname,$uname,$udom); 2175: if ($forwhom ne '') { 2176: $renderheading = &mt('View of the problem for[_1]',$forwhom); 2177: $answerheading = &mt('Correct answer for[_1]',$forwhom); 2178: } 2179: } 2180: $rendered= 2181: '<div class="LC_Box">' 2182: .'<h3 class="LC_hcell">'.$renderheading.'</h3>' 2183: .$rendered 2184: .'</div>'; 2185: $companswer= 2186: '<div class="LC_Box">' 2187: .'<h3 class="LC_hcell">'.$answerheading.'</h3>' 2188: .$companswer 2189: .'</div>'; 2190: my $result; 2191: if ($mode eq 'both') { 2192: $result=$rendered.$companswer; 2193: } elsif ($mode eq 'text') { 2194: $result=$rendered; 2195: } elsif ($mode eq 'answer') { 2196: $result=$companswer; 2197: } 2198: return $result; 2199: } 2200: 2201: sub files_exist { 2202: my ($r, $symb) = @_; 2203: my @students = &Apache::loncommon::get_env_multiple('form.stuinfo'); 2204: foreach my $student (@students) { 2205: my ($uname,$udom,$fullname) = split(/:/,$student); 2206: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, 2207: $udom,$uname); 2208: my ($string)= &get_last_submission(\%record); 2209: foreach my $submission (@$string) { 2210: my ($partid,$respid) = 2211: ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); 2212: my $files=&get_submitted_files($udom,$uname,$partid,$respid, 2213: \%record); 2214: return 1 if (@$files); 2215: } 2216: } 2217: return 0; 2218: } 2219: 2220: sub download_all_link { 2221: my ($r,$symb) = @_; 2222: unless (&files_exist($r, $symb)) { 2223: $r->print(&mt('There are currently no submitted documents.')); 2224: return; 2225: } 2226: my $all_students = 2227: join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo')); 2228: 2229: my $parts = 2230: join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); 2231: 2232: my $identifier = &Apache::loncommon::get_cgi_id(); 2233: &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, 2234: 'cgi.'.$identifier.'.symb' => $symb, 2235: 'cgi.'.$identifier.'.parts' => $parts,}); 2236: $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'. 2237: &mt('Download All Submitted Documents').'</a>'); 2238: return; 2239: } 2240: 2241: sub submit_download_link { 2242: my ($request,$symb) = @_; 2243: if (!$symb) { return ''; } 2244: my $res_error; 2245: my ($partlist,$handgrade,$responseType,$numresp,$numessay,$numdropbox) = 2246: &response_type($symb,\$res_error); 2247: if ($res_error) { 2248: $request->print(&mt('An error occurred retrieving response types')); 2249: return; 2250: } 2251: unless ($numessay) { 2252: $request->print(&mt('No essayresponse items found')); 2253: return; 2254: } 2255: my @chosenparts = &Apache::loncommon::get_env_multiple('form.vPart'); 2256: if (@chosenparts) { 2257: $request->print(&showResourceInfo($symb,$partlist,$responseType, 2258: undef,undef,1)); 2259: } 2260: if ($numessay) { 2261: my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; 2262: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 2263: my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; 2264: (undef,undef,my $fullname) = &getclasslist($getsec,1,$getgroup,$symb,$submitonly,1); 2265: if (ref($fullname) eq 'HASH') { 2266: my @students = map { $_.':'.$fullname->{$_} } (keys(%{$fullname})); 2267: if (@students) { 2268: @{$env{'form.stuinfo'}} = @students; 2269: if ($numdropbox) { 2270: &download_all_link($request,$symb); 2271: } else { 2272: $request->print(&mt('No essayrespose items with dropbox found')); 2273: } 2274: # FIXME Need a mechanism to download essays, i.e., if $numessay > $numdropbox 2275: # Needs to omit user's identity if resource instance is for an anonymous survey. 2276: } else { 2277: $request->print(&mt('No students match the criteria you selected')); 2278: } 2279: } else { 2280: $request->print(&mt('Could not retrieve student information')); 2281: } 2282: } else { 2283: $request->print(&mt('No essayresponse items found')); 2284: } 2285: return; 2286: } 2287: 2288: sub build_section_inputs { 2289: my $section_inputs; 2290: if ($env{'form.section'} eq '') { 2291: $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n"; 2292: } else { 2293: my @sections = &Apache::loncommon::get_env_multiple('form.section'); 2294: foreach my $section (@sections) { 2295: $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n"; 2296: } 2297: } 2298: return $section_inputs; 2299: } 2300: 2301: # --------------------------- show submissions of a student, option to grade 2302: sub submission { 2303: my ($request,$counter,$total,$symb,$divforres,$calledby) = @_; 2304: my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); 2305: $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student? 2306: my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); 2307: $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq ''; 2308: 2309: if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } 2310: my $probtitle=&Apache::lonnet::gettitle($symb); 2311: my $is_tool = ($symb =~ /ext\.tool$/); 2312: my ($essayurl,%coursedesc_by_cid); 2313: 2314: if (!&canview($usec)) { 2315: $request->print( 2316: '<span class="LC_warning">'. 2317: &mt('Unable to view requested student.'). 2318: ' '.&mt('([_1] in section [_2] in course id [_3])', 2319: $uname.':'.$udom,$usec,$env{'request.course.id'}). 2320: '</span>'); 2321: return; 2322: } 2323: 2324: my $res_error; 2325: my ($partlist,$handgrade,$responseType,$numresp,$numessay) = 2326: &response_type($symb,\$res_error); 2327: if ($res_error) { 2328: $request->print(&navmap_errormsg()); 2329: return; 2330: } 2331: 2332: if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; } 2333: unless ($is_tool) { 2334: if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; } 2335: if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; } 2336: } 2337: if (($numessay) && ($calledby eq 'submission') && (!exists($env{'form.compmsg'}))) { 2338: $env{'form.compmsg'} = 1; 2339: } 2340: my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); 2341: my $checkIcon = '<img alt="'.&mt('Check Mark'). 2342: '" src="'.$request->dir_config('lonIconsURL'). 2343: '/check.gif" height="16" border="0" />'; 2344: 2345: # header info 2346: if ($counter == 0) { 2347: my @chosenparts = &Apache::loncommon::get_env_multiple('form.vPart'); 2348: if (@chosenparts) { 2349: $request->print(&showResourceInfo($symb,$partlist,$responseType,'gradesub')); 2350: } elsif ($divforres) { 2351: $request->print('<div style="padding:0;clear:both;margin:0;border:0"></div>'); 2352: } else { 2353: $request->print('<br clear="all" />'); 2354: } 2355: &sub_page_js($request); 2356: &sub_grademessage_js($request) if ($env{'form.compmsg'}); 2357: &sub_page_kw_js($request) if ($numessay); 2358: 2359: # option to display problem, only once else it cause problems 2360: # with the form later since the problem has a form. 2361: if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') { 2362: my $mode; 2363: if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') { 2364: $mode='both'; 2365: } elsif ($env{'form.vProb'} eq 'yes') { 2366: $mode='text'; 2367: } elsif ($env{'form.vAns'} eq 'yes') { 2368: $mode='answer'; 2369: } 2370: &Apache::lonxml::clear_problem_counter(); 2371: $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); 2372: } 2373: 2374: my %keyhash = (); 2375: if (($env{'form.kwclr'} eq '' && $numessay) || ($env{'form.compmsg'})) { 2376: %keyhash = &Apache::lonnet::dump('nohist_handgrade', 2377: $env{'course.'.$env{'request.course.id'}.'.domain'}, 2378: $env{'course.'.$env{'request.course.id'}.'.num'}); 2379: } 2380: # kwclr is the only variable that is guaranteed not to be blank 2381: # if this subroutine has been called once. 2382: if ($env{'form.kwclr'} eq '' && $numessay) { 2383: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 2384: $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; 2385: $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; 2386: $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; 2387: $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; 2388: } 2389: if ($env{'form.compmsg'}) { 2390: $env{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? 2391: $keyhash{$symb.'_subject'} : $probtitle; 2392: $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; 2393: } 2394: 2395: my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'}; 2396: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 2397: $request->print('<form action="/adm/grades" method="post" name="SCORE" enctype="multipart/form-data">'."\n". 2398: '<input type="hidden" name="command" value="handgrade" />'."\n". 2399: '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 2400: '<input type="hidden" name="overRideScore" value="'.$overRideScore.'" />'."\n". 2401: '<input type="hidden" name="refresh" value="off" />'."\n". 2402: '<input type="hidden" name="studentNo" value="" />'."\n". 2403: '<input type="hidden" name="gradeOpt" value="" />'."\n". 2404: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 2405: '<input type="hidden" name="vProb" value="'.$env{'form.vProb'}.'" />'."\n". 2406: '<input type="hidden" name="vAns" value="'.$env{'form.vAns'}.'" />'."\n". 2407: '<input type="hidden" name="lastSub" value="'.$env{'form.lastSub'}.'" />'."\n". 2408: '<input type="hidden" name="compmsg" value="'.$env{'form.compmsg'}.'" />'."\n". 2409: &build_section_inputs(). 2410: '<input type="hidden" name="submitonly" value="'.$env{'form.submitonly'}.'" />'."\n". 2411: '<input type="hidden" name="NCT"'. 2412: ' value="'.($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : $total+1).'" />'."\n"); 2413: if ($env{'form.compmsg'}) { 2414: $request->print('<input type="hidden" name="msgsub" value="'.$env{'form.msgsub'}.'" />'."\n". 2415: '<input type="hidden" name="shownSub" value="0" />'."\n". 2416: '<input type="hidden" name="savemsgN" value="'.$env{'form.savemsgN'}.'" />'."\n"); 2417: } 2418: if ($numessay) { 2419: $request->print('<input type="hidden" name="keywords" value="'.$env{'form.keywords'}.'" />'."\n". 2420: '<input type="hidden" name="kwclr" value="'.$env{'form.kwclr'}.'" />'."\n". 2421: '<input type="hidden" name="kwsize" value="'.$env{'form.kwsize'}.'" />'."\n". 2422: '<input type="hidden" name="kwstyle" value="'.$env{'form.kwstyle'}.'" />'."\n"); 2423: } 2424: 2425: my ($cts,$prnmsg) = (1,''); 2426: while ($cts <= $env{'form.savemsgN'}) { 2427: $prnmsg.='<input type="hidden" name="savemsg'.$cts.'" value="'. 2428: (!exists($keyhash{$symb.'_savemsg'.$cts}) ? 2429: &Apache::lonfeedback::clear_out_html($env{'form.savemsg'.$cts}) : 2430: &Apache::lonfeedback::clear_out_html($keyhash{$symb.'_savemsg'.$cts})). 2431: '" />'."\n". 2432: '<input type="hidden" name="shownOnce'.$cts.'" value="0" />'."\n"; 2433: $cts++; 2434: } 2435: $request->print($prnmsg); 2436: 2437: if ($numessay) { 2438: 2439: my %lt = &Apache::lonlocal::texthash( 2440: keyh => 'Keyword Highlighting for Essays', 2441: keyw => 'Keyword Options', 2442: list => 'List', 2443: past => 'Paste Selection to List', 2444: high => 'Highlight Attribute', 2445: ); 2446: # 2447: # Print out the keyword options line 2448: # 2449: $request->print( 2450: '<div class="LC_columnSection">' 2451: .'<fieldset><legend>'.$lt{'keyh'}.'</legend>' 2452: .&Apache::lonhtmlcommon::funclist_from_array( 2453: ['<a href="javascript:keywords(document.SCORE);" target="_self">'.$lt{'list'}.'</a>', 2454: '<a href="#" onmousedown="javascript:getSel(); return false" 2455: class="page">'.$lt{'past'}.'</a>', 2456: '<a href="javascript:kwhighlight();" target="_self">'.$lt{'high'}.'</a>'], 2457: {legend => $lt{'keyw'}}) 2458: .'</fieldset></div>' 2459: ); 2460: 2461: # 2462: # Load the other essays for similarity check 2463: # 2464: (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); 2465: if ($essayurl eq 'lib/templates/simpleproblem.problem') { 2466: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2467: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2468: if ($cdom ne '' && $cnum ne '') { 2469: my ($map,$id,$res) = &Apache::lonnet::decode_symb($symb); 2470: if ($map =~ m{^\Quploaded/$cdom/$cnum/\E(default(?:|_\d+)\.(?:sequence|page))$}) { 2471: my $apath = $1.'_'.$id; 2472: $apath=~s/\W/\_/gs; 2473: &init_old_essays($symb,$apath,$cdom,$cnum); 2474: } 2475: } 2476: } else { 2477: my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); 2478: $apath=&escape($apath); 2479: $apath=~s/\W/\_/gs; 2480: &init_old_essays($symb,$apath,$adom,$aname); 2481: } 2482: } 2483: } 2484: 2485: # This is where output for one specific student would start 2486: my $add_class = ($counter%2) ? ' LC_grade_show_user_odd_row' : ''; 2487: $request->print( 2488: "\n\n" 2489: .'<div class="LC_grade_show_user'.$add_class.'">' 2490: .'<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).'</h2>' 2491: ."\n" 2492: ); 2493: 2494: # Show additional functions if allowed 2495: if ($perm{'vgr'}) { 2496: $request->print( 2497: &Apache::loncommon::track_student_link( 2498: 'View recent activity', 2499: $uname,$udom,'check') 2500: .' ' 2501: ); 2502: } 2503: if ($perm{'opa'}) { 2504: $request->print( 2505: &Apache::loncommon::pprmlink( 2506: &mt('Set/Change parameters'), 2507: $uname,$udom,$symb,'check')); 2508: } 2509: 2510: # Show Problem 2511: if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') { 2512: my $mode; 2513: if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') { 2514: $mode='both'; 2515: } elsif ($env{'form.vProb'} eq 'all' ) { 2516: $mode='text'; 2517: } elsif ($env{'form.vAns'} eq 'all') { 2518: $mode='answer'; 2519: } 2520: &Apache::lonxml::clear_problem_counter(); 2521: $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode,{'request.prefix' => 'ctr'.$counter})); 2522: } 2523: 2524: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 2525: 2526: # Display student info 2527: $request->print(($counter == 0 ? '' : '<br />')); 2528: 2529: my $boxtitle = &mt('Submissions'); 2530: if ($is_tool) { 2531: $boxtitle = &mt('Transactions') 2532: } 2533: my $result='<div class="LC_Box">' 2534: .'<h3 class="LC_hcell">'.$boxtitle.'</h3>'; 2535: $result.='<input type="hidden" name="name'.$counter. 2536: '" value="'.$env{'form.fullname'}.'" />'."\n"; 2537: if (($numresp > $numessay) && !$is_tool) { 2538: $result.='<p class="LC_info">' 2539: .&mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon) 2540: ."</p>\n"; 2541: } 2542: 2543: # If any part of the problem is an essayresponse, then check for collaborators 2544: my $fullname; 2545: my $col_fullnames = []; 2546: if ($numessay) { 2547: (my $sub_result,$fullname,$col_fullnames)= 2548: &check_collaborators($symb,$uname,$udom,\%record,$handgrade, 2549: $counter); 2550: $result.=$sub_result; 2551: } 2552: $request->print($result."\n"); 2553: 2554: # print student answer/submission 2555: # Options are (1) Last submission only 2556: # (2) Last submission (with detailed information for that submission) 2557: # (3) All transactions (by date) 2558: # (4) The whole record (with detailed information for all transactions) 2559: 2560: my ($lastsubonly,$partinfo) = 2561: &show_last_submission($uname,$udom,$symb,$essayurl,$responseType,$env{'form.lastSub'}, 2562: $is_tool,$fullname,\%record,\%coursedesc_by_cid); 2563: $request->print($partinfo); 2564: $request->print($lastsubonly); 2565: 2566: if ($env{'form.lastSub'} eq 'datesub') { 2567: my ($parts,$handgrade,$responseType) = &response_type($symb,\$res_error); 2568: $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); 2569: } 2570: if ($env{'form.lastSub'} =~ /^(last|all)$/) { 2571: my $identifier = (&canmodify($usec)? $counter : ''); 2572: $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, 2573: $env{'request.course.id'}, 2574: $last,'.submission', 2575: 'Apache::grades::keywords_highlight', 2576: $usec,$identifier)); 2577: } 2578: $request->print('<input type="hidden" name="unamedom'.$counter.'" value="'.$uname.':' 2579: .$udom.'" />'."\n"); 2580: # return if view submission with no grading option 2581: if (!&canmodify($usec)) { 2582: $request->print('<p><span class="LC_warning">'.&mt('No grading privileges').'</span></p></div>'); 2583: return; 2584: } else { 2585: $request->print('</div>'."\n"); 2586: } 2587: 2588: # grading message center 2589: 2590: if ($env{'form.compmsg'}) { 2591: my $result='<div class="LC_Box">'. 2592: '<h3 class="LC_hcell">'.&mt('Send Message').'</h3>'. 2593: '<div class="LC_grade_message_center_body">'; 2594: my ($lastname,$givenn) = split(/,/,$env{'form.fullname'}); 2595: my $msgfor = $givenn.' '.$lastname; 2596: if (scalar(@$col_fullnames) > 0) { 2597: my $lastone = pop(@$col_fullnames); 2598: $msgfor .= ', '.(join ', ',@$col_fullnames).' and '.$lastone.'.'; 2599: } 2600: $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript 2601: $result.='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n". 2602: '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n". 2603: ' <a href="javascript:msgCenter(document.SCORE,'.$counter. 2604: ',\''.$msgfor.'\');" target="_self">'. 2605: &mt('Compose message to student'.(scalar(@$col_fullnames) >= 1 ? 's' : '')).'</a><label> ('. 2606: &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'. 2607: ' <img src="'.$request->dir_config('lonIconsURL'). 2608: '/mailbkgrd.gif" width="14" height="10" alt="" name="mailicon'.$counter.'" />'."\n". 2609: '<br /> ('. 2610: &mt('Message will be sent when you click on Save & Next below.').")\n". 2611: '</div></div>'; 2612: $request->print($result); 2613: } 2614: 2615: my %seen = (); 2616: my @partlist; 2617: my @gradePartRespid; 2618: my @part_response_id; 2619: if ($is_tool) { 2620: @part_response_id = ([0,'']); 2621: } else { 2622: @part_response_id = &flatten_responseType($responseType); 2623: } 2624: $request->print( 2625: '<div class="LC_Box">' 2626: .'<h3 class="LC_hcell">'.&mt('Assign Grades').'</h3>' 2627: ); 2628: $request->print(&gradeBox_start()); 2629: foreach my $part_response_id (@part_response_id) { 2630: my ($partid,$respid) = @{ $part_response_id }; 2631: my $part_resp = join('_',@{ $part_response_id }); 2632: next if ($seen{$partid} > 0); 2633: $seen{$partid}++; 2634: push(@partlist,$partid); 2635: push(@gradePartRespid,$partid.'.'.$respid); 2636: $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); 2637: } 2638: $request->print(&gradeBox_end()); # </div> 2639: $request->print('</div>'); 2640: 2641: $request->print('<div class="LC_grade_info_links">'); 2642: $request->print('</div>'); 2643: 2644: $result='<input type="hidden" name="partlist'.$counter. 2645: '" value="'.(join ":",@partlist).'" />'."\n"; 2646: $result.='<input type="hidden" name="gradePartRespid'. 2647: '" value="'.(join ":",@gradePartRespid).'" />'."\n" if ($counter == 0); 2648: my $ctr = 0; 2649: while ($ctr < scalar(@partlist)) { 2650: $result.='<input type="hidden" name="partid'.$counter.'_'.$ctr.'" value="'. 2651: $partlist[$ctr].'" />'."\n"; 2652: $ctr++; 2653: } 2654: $request->print($result.''."\n"); 2655: 2656: # Done with printing info for one student 2657: 2658: $request->print('</div>');#LC_grade_show_user 2659: 2660: 2661: # print end of form 2662: if ($counter == $total) { 2663: my $endform='<br /><hr /><table border="0"><tr><td>'."\n"; 2664: $endform.='<input type="button" value="'.&mt('Save & Next').'" '. 2665: 'onclick="javascript:checksubmit(this.form,\'Save & Next\','. 2666: $total.','.scalar(@partlist).');" target="_self" />  '."\n"; 2667: my $ntstu ='<select name="NTSTU">'. 2668: '<option>1</option><option>2</option>'. 2669: '<option>3</option><option>5</option>'. 2670: '<option>7</option><option>10</option></select>'."\n"; 2671: my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1'); 2672: $ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</; 2673: $endform.=&mt('[_1]student(s)',$ntstu); 2674: $endform.='  <input type="button" value="'.&mt('Previous').'" '. 2675: 'onclick="javascript:checksubmit(this.form,\'Previous\');" target="_self" />  '."\n". 2676: '<input type="button" value="'.&mt('Next').'" '. 2677: 'onclick="javascript:checksubmit(this.form,\'Next\');" target="_self" />  '; 2678: $endform.='<span class="LC_warning">'. 2679: &mt('(Next and Previous (student) do not save the scores.)'). 2680: '</span>'."\n" ; 2681: $endform.="<input type='hidden' value='".&get_increment(). 2682: "' name='increment' />"; 2683: $endform.='</td></tr></table></form>'; 2684: $request->print($endform); 2685: } 2686: return ''; 2687: } 2688: 2689: sub show_last_submission { 2690: my ($uname,$udom,$symb,$essayurl,$responseType,$viewtype,$is_tool,$fullname, 2691: $record,$coursedesc_by_cid) = @_; 2692: my ($string,$timestamp,$lastgradetime,$lastsubmittime) = 2693: &get_last_submission($record,$is_tool); 2694: 2695: my ($lastsubonly,$partinfo); 2696: if ($timestamp eq '') { 2697: $lastsubonly.='<div class="LC_grade_submissions_body">'.$string->[0].'</div>'; 2698: } elsif ($is_tool) { 2699: $lastsubonly = 2700: '<div class="LC_grade_submissions_body">' 2701: .'<b>'.&mt('Date Grade Passed Back:').'</b> '.$timestamp."</div>\n"; 2702: } else { 2703: my ($shownsubmdate,$showngradedate); 2704: if ($lastsubmittime && $lastgradetime) { 2705: $shownsubmdate = &Apache::lonlocal::locallocaltime($lastsubmittime); 2706: if ($lastgradetime > $lastsubmittime) { 2707: $showngradedate = &Apache::lonlocal::locallocaltime($lastgradetime); 2708: } 2709: } else { 2710: $shownsubmdate = $timestamp; 2711: } 2712: $lastsubonly = 2713: '<div class="LC_grade_submissions_body">' 2714: .'<b>'.&mt('Date Submitted:').'</b> '.$shownsubmdate."\n"; 2715: if ($showngradedate) { 2716: $lastsubonly .= '<br /><b>'.&mt('Date Graded:').'</b> '.$showngradedate."\n"; 2717: } 2718: 2719: my %seenparts; 2720: my @part_response_id = &flatten_responseType($responseType); 2721: foreach my $part (@part_response_id) { 2722: my ($partid,$respid) = @{ $part }; 2723: my $display_part=&get_display_part($partid,$symb); 2724: if ($env{"form.$uname:$udom:$partid:submitted_by"}) { 2725: if (exists($seenparts{$partid})) { next; } 2726: $seenparts{$partid}=1; 2727: $partinfo .= 2728: '<b>'.&mt('Part: [_1]',$display_part).'</b>'. 2729: ' <b>'.&mt('Collaborative submission by: [_1]', 2730: '<a href="javascript:viewSubmitter(\''. 2731: $env{"form.$uname:$udom:$partid:submitted_by"}. 2732: '\');" target="_self">'. 2733: $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a>'). 2734: '<br />'; 2735: next; 2736: } 2737: my $responsetype = $responseType->{$partid}->{$respid}; 2738: if (!exists($record->{"resource.$partid.$respid.submission"})) { 2739: $lastsubonly.="\n".'<div class="LC_grade_submission_part">'. 2740: '<b>'.&mt('Part: [_1]',$display_part).'</b>'. 2741: ' <span class="LC_internal_info">'. 2742: '('.&mt('Response ID: [_1]',$respid).')'. 2743: '</span>   '. 2744: '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br /><br /></div>'; 2745: next; 2746: } 2747: foreach my $submission (@$string) { 2748: my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); 2749: if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; } 2750: my ($ressub,$hide,$draft,$subval) = split(/:/,$submission,4); 2751: # Similarity check 2752: my $similar=''; 2753: my ($type,$trial,$rndseed); 2754: if ($hide eq 'rand') { 2755: $type = 'randomizetry'; 2756: $trial = $record->{"resource.$partid.tries"}; 2757: $rndseed = $record->{"resource.$partid.rndseed"}; 2758: } 2759: if ($env{'form.checkPlag'}) { 2760: my ($oname,$odom,$ocrsid,$oessay,$osim)= 2761: &most_similar($uname,$udom,$symb,$subval); 2762: if ($osim) { 2763: $osim=int($osim*100.0); 2764: if ($hide eq 'anon') { 2765: $similar='<hr /><span class="LC_warning">'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'<br />'. 2766: &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />'; 2767: } else { 2768: $similar='<hr />'; 2769: if ($essayurl eq 'lib/templates/simpleproblem.problem') { 2770: $similar .= '<h3><span class="LC_warning">'. 2771: &mt('Essay is [_1]% similar to an essay by [_2]', 2772: $osim, 2773: &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')'). 2774: '</span></h3>'; 2775: } else { 2776: my %old_course_desc; 2777: if ($ocrsid ne '') { 2778: if (ref($coursedesc_by_cid->{$ocrsid}) eq 'HASH') { 2779: %old_course_desc = %{$coursedesc_by_cid->{$ocrsid}}; 2780: } else { 2781: my $args; 2782: if ($ocrsid ne $env{'request.course.id'}) { 2783: $args = {'one_time' => 1}; 2784: } 2785: %old_course_desc = 2786: &Apache::lonnet::coursedescription($ocrsid,$args); 2787: $coursedesc_by_cid->{$ocrsid} = \%old_course_desc; 2788: } 2789: $similar .= 2790: '<h3><span class="LC_warning">'. 2791: &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])', 2792: $osim, 2793: &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')', 2794: $old_course_desc{'description'}, 2795: $old_course_desc{'num'}, 2796: $old_course_desc{'domain'}). 2797: '</span></h3>'; 2798: } else { 2799: $similar .= 2800: '<h3><span class="LC_warning">'. 2801: &mt('Essay is [_1]% similar to an essay by [_2] in an unknown course', 2802: $osim, 2803: &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')'). 2804: '</span></h3>'; 2805: } 2806: } 2807: $similar .= '<blockquote><i>'. 2808: &keywords_highlight($oessay). 2809: '</i></blockquote><hr />'; 2810: } 2811: } 2812: } 2813: my $order=&get_order($partid,$respid,$symb,$uname,$udom, 2814: undef,$type,$trial,$rndseed); 2815: if (($viewtype eq 'lastonly') || 2816: ($viewtype eq 'datesub') || 2817: ($viewtype =~ /^(last|all)$/)) { 2818: my $display_part=&get_display_part($partid,$symb); 2819: $lastsubonly.='<div class="LC_grade_submission_part">'. 2820: '<b>'.&mt('Part: [_1]',$display_part).'</b>'. 2821: ' <span class="LC_internal_info">'. 2822: '('.&mt('Response ID: [_1]',$respid).')'. 2823: '</span>   '; 2824: my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record); 2825: if (@$files) { 2826: if ($hide eq 'anon') { 2827: $lastsubonly.='<br />'.&mt('[quant,_1,file] uploaded to this anonymous survey',scalar(@{$files})); 2828: } else { 2829: $lastsubonly.='<br /><br />'.'<b>'.&mt('Submitted Files:').'</b>' 2830: .'<br /><span class="LC_warning">'; 2831: if(@$files == 1) { 2832: $lastsubonly .= &mt('Like all files provided by users, this file may contain viruses!'); 2833: } else { 2834: $lastsubonly .= &mt('Like all files provided by users, these files may contain viruses!'); 2835: } 2836: $lastsubonly .= '</span>'; 2837: foreach my $file (@$files) { 2838: &Apache::lonnet::allowuploaded('/adm/grades',$file); 2839: $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" alt="" /> '.$file.'</a>'; 2840: } 2841: } 2842: $lastsubonly.='<br />'; 2843: } 2844: if ($hide eq 'anon') { 2845: $lastsubonly.='<br /><b>'.&mt('Anonymous Survey').'</b>'; 2846: } else { 2847: $lastsubonly.='<br /><b>'.&mt('Submitted Answer:').' </b>'; 2848: if ($draft) { 2849: $lastsubonly.= ' <span class="LC_warning">'.&mt('Draft Copy').'</span>'; 2850: } 2851: $subval = 2852: &cleanRecord($subval,$responsetype,$symb,$partid, 2853: $respid,$record,$order,undef,$uname,$udom,$type,$trial,$rndseed); 2854: if ($responsetype eq 'essay') { 2855: $subval =~ s{\n}{<br />}g; 2856: } 2857: $lastsubonly.=$subval."\n"; 2858: } 2859: if ($similar) {$lastsubonly.="<br /><br />$similar\n";} 2860: $lastsubonly.='</div>'; 2861: } 2862: } 2863: } 2864: $lastsubonly.='</div>'."\n"; # End: LC_grade_submissions_body 2865: } 2866: return ($lastsubonly,$partinfo); 2867: } 2868: 2869: sub check_collaborators { 2870: my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_; 2871: my ($result,@col_fullnames); 2872: my ($classlist,undef,$fullname) = &getclasslist('all','0'); 2873: foreach my $part (keys(%$handgrade)) { 2874: my $ncol = &Apache::lonnet::EXT('resource.'.$part. 2875: '.maxcollaborators', 2876: $symb,$udom,$uname); 2877: next if ($ncol <= 0); 2878: $part =~ s/\_/\./g; 2879: next if ($record->{'resource.'.$part.'.collaborators'} eq ''); 2880: my (@good_collaborators, @bad_collaborators); 2881: foreach my $possible_collaborator 2882: (split(/[,;\s]+/,$record->{'resource.'.$part.'.collaborators'})) { 2883: $possible_collaborator =~ s/[\$\^]//g; 2884: next if ($possible_collaborator eq ''); 2885: my ($co_name,$co_dom) = split(/:/,$possible_collaborator); 2886: $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i); 2887: next if ($co_name eq $uname && $co_dom eq $udom); 2888: # Doing this grep allows 'fuzzy' specification 2889: my @matches = grep(/^\Q$co_name\E:\Q$co_dom\E$/i, 2890: keys(%$classlist)); 2891: if (! scalar(@matches)) { 2892: push(@bad_collaborators, $possible_collaborator); 2893: } else { 2894: push(@good_collaborators, @matches); 2895: } 2896: } 2897: if (scalar(@good_collaborators) != 0) { 2898: $result.='<br />'.&mt('Collaborators:').'<ol>'; 2899: foreach my $name (@good_collaborators) { 2900: my ($lastname,$givenn) = split(/,/,$$fullname{$name}); 2901: push(@col_fullnames, $givenn.' '.$lastname); 2902: $result.='<li>'.$fullname->{$name}.'</li>'; 2903: } 2904: $result.='</ol><br />'."\n"; 2905: my ($part)=split(/\./,$part); 2906: $result.='<input type="hidden" name="collaborator'.$counter. 2907: '" value="'.$part.':'.(join ':',@good_collaborators).'" />'. 2908: "\n"; 2909: } 2910: if (scalar(@bad_collaborators) > 0) { 2911: $result.='<div class="LC_warning">'; 2912: $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators)); 2913: $result .= '</div>'; 2914: } 2915: if (scalar(@bad_collaborators > $ncol)) { 2916: $result .= '<div class="LC_warning">'; 2917: $result .= &mt('This student has submitted too many '. 2918: 'collaborators. Maximum is [_1].',$ncol); 2919: $result .= '</div>'; 2920: } 2921: } 2922: return ($result,$fullname,\@col_fullnames); 2923: } 2924: 2925: #--- Retrieve the last submission for all the parts 2926: sub get_last_submission { 2927: my ($returnhash,$is_tool)=@_; 2928: my (@string,$timestamp,$lastgradetime,$lastsubmittime); 2929: if ($$returnhash{'version'}) { 2930: my %lasthash=(); 2931: my %prevsolved=(); 2932: my %solved=(); 2933: my $version; 2934: for ($version=1;$version<=$$returnhash{'version'};$version++) { 2935: my %handgraded = (); 2936: foreach my $key (sort(split(/\:/, 2937: $$returnhash{$version.':keys'}))) { 2938: $lasthash{$key}=$$returnhash{$version.':'.$key}; 2939: if ($key =~ /\.([^.]+)\.regrader$/) { 2940: $handgraded{$1} = 1; 2941: } elsif ($key =~ /\.portfiles$/) { 2942: if (($$returnhash{$version.':'.$key} ne '') && 2943: ($$returnhash{$version.':'.$key} !~ /\.\d+\.\w+$/)) { 2944: $lastsubmittime = $$returnhash{$version.':timestamp'}; 2945: } 2946: } elsif ($key =~ /\.submission$/) { 2947: if ($$returnhash{$version.':'.$key} ne '') { 2948: $lastsubmittime = $$returnhash{$version.':timestamp'}; 2949: } 2950: } elsif ($key =~ /\.([^.]+)\.solved$/) { 2951: $prevsolved{$1} = $solved{$1}; 2952: $solved{$1} = $lasthash{$key}; 2953: } 2954: } 2955: foreach my $partid (keys(%handgraded)) { 2956: if (($prevsolved{$partid} eq 'ungraded_attempted') && 2957: (($solved{$partid} eq 'incorrect_by_override') || 2958: ($solved{$partid} eq 'correct_by_override'))) { 2959: $lastgradetime = $$returnhash{$version.':timestamp'}; 2960: } 2961: if ($solved{$partid} ne '') { 2962: $prevsolved{$partid} = $solved{$partid}; 2963: } 2964: } 2965: $timestamp = 2966: &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'}); 2967: } 2968: my (%typeparts,%randombytry); 2969: my $showsurv = 2970: &Apache::lonnet::allowed('vas',$env{'request.course.id'}); 2971: foreach my $key (sort(keys(%lasthash))) { 2972: if ($key =~ /\.type$/) { 2973: if (($lasthash{$key} eq 'anonsurvey') || 2974: ($lasthash{$key} eq 'anonsurveycred') || 2975: ($lasthash{$key} eq 'randomizetry')) { 2976: my ($ign,@parts) = split(/\./,$key); 2977: pop(@parts); 2978: my $id = join('.',@parts); 2979: if ($lasthash{$key} eq 'randomizetry') { 2980: $randombytry{$ign.'.'.$id} = $lasthash{$key}; 2981: } else { 2982: unless ($showsurv) { 2983: $typeparts{$ign.'.'.$id} = $lasthash{$key}; 2984: } 2985: } 2986: delete($lasthash{$key}); 2987: } 2988: } 2989: } 2990: my @hidden = keys(%typeparts); 2991: my @randomize = keys(%randombytry); 2992: foreach my $key (keys(%lasthash)) { 2993: next if ($key !~ /\.submission$/); 2994: my $hide; 2995: if (@hidden) { 2996: foreach my $id (@hidden) { 2997: if ($key =~ /^\Q$id\E/) { 2998: $hide = 'anon'; 2999: last; 3000: } 3001: } 3002: } 3003: unless ($hide) { 3004: if (@randomize) { 3005: foreach my $id (@randomize) { 3006: if ($key =~ /^\Q$id\E/) { 3007: $hide = 'rand'; 3008: last; 3009: } 3010: } 3011: } 3012: } 3013: my ($partid,$foo) = split(/submission$/,$key); 3014: my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? 1 : 0; 3015: push(@string, join(':', $key, $hide, $draft, ( 3016: ref($lasthash{$key}) eq 'ARRAY' ? 3017: join(',', @{$lasthash{$key}}) : $lasthash{$key}) )); 3018: } 3019: } 3020: if (!@string) { 3021: my $msg; 3022: if ($is_tool) { 3023: $msg = &mt('No grade passed back.'); 3024: } else { 3025: $msg = &mt('Nothing submitted - no attempts.'); 3026: } 3027: $string[0] = 3028: '<span class="LC_warning">'.$msg.'</span>'; 3029: } 3030: return (\@string,$timestamp,$lastgradetime,$lastsubmittime); 3031: } 3032: 3033: #--- High light keywords, with style choosen by user. 3034: sub keywords_highlight { 3035: my $string = shift; 3036: my $size = $env{'form.kwsize'} eq '0' ? '' : 'size='.$env{'form.kwsize'}; 3037: my $styleon = $env{'form.kwstyle'} eq '' ? '' : $env{'form.kwstyle'}; 3038: (my $styleoff = $styleon) =~ s/\</\<\//; 3039: my @keylist = split(/[,\s+]/,$env{'form.keywords'}); 3040: foreach my $keyword (@keylist) { 3041: $string =~ s/\b\Q$keyword\E(\b|\.)/<font color\=$env{'form.kwclr'} $size\>$styleon$keyword$styleoff<\/font>/gi; 3042: } 3043: return $string; 3044: } 3045: 3046: # For Tasks provide a mechanism to display previous version for one specific student 3047: 3048: sub show_previous_task_version { 3049: my ($request,$symb) = @_; 3050: if ($symb eq '') { 3051: $request->print( 3052: '<span class="LC_error">'. 3053: &mt('Unable to handle ambiguous references.'). 3054: '</span>'); 3055: return ''; 3056: } 3057: my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); 3058: my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); 3059: if (!&canview($usec)) { 3060: $request->print('<span class="LC_warning">'. 3061: &mt('Unable to view previous version for requested student.'). 3062: ' '.&mt('([_1] in section [_2] in course id [_3])', 3063: $uname.':'.$udom,$usec,$env{'request.course.id'}). 3064: '</span>'); 3065: return; 3066: } 3067: my $mode = 'both'; 3068: my $isTask = ($symb =~/\.task$/); 3069: if ($isTask) { 3070: if ($env{'form.previousversion'} =~ /^\d+$/) { 3071: if ($env{'form.fullname'} eq '') { 3072: $env{'form.fullname'} = 3073: &Apache::loncommon::plainname($uname,$udom,'lastname'); 3074: } 3075: my $probtitle=&Apache::lonnet::gettitle($symb); 3076: $request->print("\n\n". 3077: '<div class="LC_grade_show_user">'. 3078: '<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom). 3079: '</h2>'."\n"); 3080: &Apache::lonxml::clear_problem_counter(); 3081: $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode, 3082: {'previousversion' => $env{'form.previousversion'} })); 3083: $request->print("\n</div>"); 3084: } 3085: } 3086: return; 3087: } 3088: 3089: sub choose_task_version_form { 3090: my ($symb,$uname,$udom,$nomenu) = @_; 3091: my $isTask = ($symb =~/\.task$/); 3092: my ($current,$version,$result,$js,$displayed,$rowtitle); 3093: if ($isTask) { 3094: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, 3095: $udom,$uname); 3096: if (($record{'resource.0.version'} eq '') || 3097: ($record{'resource.0.version'} < 2)) { 3098: return ($record{'resource.0.version'}, 3099: $record{'resource.0.version'},$result,$js); 3100: } else { 3101: $current = $record{'resource.0.version'}; 3102: } 3103: if ($env{'form.previousversion'}) { 3104: $displayed = $env{'form.previousversion'}; 3105: $rowtitle = &mt('Choose another version:') 3106: } else { 3107: $displayed = $current; 3108: $rowtitle = &mt('Show earlier version:'); 3109: } 3110: $result = '<div class="LC_left_float">'; 3111: my $list; 3112: my $numversions = 0; 3113: for (my $i=1; $i<=$record{'resource.0.version'}; $i++) { 3114: if ($i == $current) { 3115: if (!$env{'form.previousversion'} || $nomenu) { 3116: next; 3117: } else { 3118: $list .= '<option value="'.$i.'">'.&mt('Current').'</option>'."\n"; 3119: $numversions ++; 3120: } 3121: } elsif (defined($record{'resource.'.$i.'.0.status'})) { 3122: unless ($i == $env{'form.previousversion'}) { 3123: $numversions ++; 3124: } 3125: $list .= '<option value="'.$i.'">'.$i.'</option>'."\n"; 3126: } 3127: } 3128: if ($numversions) { 3129: $symb = &HTML::Entities::encode($symb,'<>"&'); 3130: $result .= 3131: '<form name="getprev" method="post" action=""'. 3132: ' onsubmit="return previousVersion('."'$uname','$udom','$symb','$displayed'".');">'. 3133: &Apache::loncommon::start_data_table(). 3134: &Apache::loncommon::start_data_table_row(). 3135: '<th align="left">'.$rowtitle.'</th>'. 3136: '<td><select name="version">'. 3137: '<option>'.&mt('Select').'</option>'. 3138: $list. 3139: '</select></td>'. 3140: &Apache::loncommon::end_data_table_row(); 3141: unless ($nomenu) { 3142: $result .= &Apache::loncommon::start_data_table_row(). 3143: '<th align="left">'.&mt('Open in new window').'</th>'. 3144: '<td><span class="LC_nobreak">'. 3145: '<label><input type="radio" name="prevwin" value="1" />'. 3146: &mt('Yes').'</label>'. 3147: '<label><input type="radio" name="prevwin" value="0" checked="checked" />'.&mt('No').'</label>'. 3148: '</span></td>'. 3149: &Apache::loncommon::end_data_table_row(); 3150: } 3151: $result .= 3152: &Apache::loncommon::start_data_table_row(). 3153: '<th align="left"> </th>'. 3154: '<td>'. 3155: '<input type="submit" name="prevsub" value="'.&mt('Display').'" />'. 3156: '</td>'. 3157: &Apache::loncommon::end_data_table_row(). 3158: &Apache::loncommon::end_data_table(). 3159: '</form>'; 3160: $js = &previous_display_javascript($nomenu,$current); 3161: } elsif ($displayed && $nomenu) { 3162: $result .= '<a href="javascript:window.close()">'.&mt('Close window').'</a>'; 3163: } else { 3164: $result .= &mt('No previous versions to show for this student'); 3165: } 3166: $result .= '</div>'; 3167: } 3168: return ($current,$displayed,$result,$js); 3169: } 3170: 3171: sub previous_display_javascript { 3172: my ($nomenu,$current) = @_; 3173: my $js = <<"JSONE"; 3174: <script type="text/javascript"> 3175: // <![CDATA[ 3176: function previousVersion(uname,udom,symb) { 3177: var current = '$current'; 3178: var version = document.getprev.version.options[document.getprev.version.selectedIndex].value; 3179: var prevstr = new RegExp("^\\\\d+\$"); 3180: if (!prevstr.test(version)) { 3181: return false; 3182: } 3183: var url = ''; 3184: if (version == current) { 3185: url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=submission'; 3186: } else { 3187: url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=versionsub&previousversion='+version; 3188: } 3189: JSONE 3190: if ($nomenu) { 3191: $js .= <<"JSTWO"; 3192: document.location.href = url; 3193: JSTWO 3194: } else { 3195: $js .= <<"JSTHREE"; 3196: var newwin = 0; 3197: for (var i=0; i<document.getprev.prevwin.length; i++) { 3198: if (document.getprev.prevwin[i].checked == true) { 3199: newwin = document.getprev.prevwin[i].value; 3200: } 3201: } 3202: if (newwin == 1) { 3203: var options = 'height=600,width=800,resizable=yes,scrollbars=yes,location=no,menubar=no,toolbar=no'; 3204: url = url+'&inhibitmenu=yes'; 3205: if (typeof(previousWin) == 'undefined' || previousWin.closed) { 3206: previousWin = window.open(url,'',options,1); 3207: } else { 3208: previousWin.location.href = url; 3209: } 3210: previousWin.focus(); 3211: return false; 3212: } else { 3213: document.location.href = url; 3214: return false; 3215: } 3216: JSTHREE 3217: } 3218: $js .= <<"ENDJS"; 3219: return false; 3220: } 3221: // ]]> 3222: </script> 3223: ENDJS 3224: 3225: } 3226: 3227: #--- Called from submission routine 3228: sub processHandGrade { 3229: my ($request,$symb) = @_; 3230: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 3231: my $button = $env{'form.gradeOpt'}; 3232: my $ngrade = $env{'form.NCT'}; 3233: my $ntstu = $env{'form.NTSTU'}; 3234: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 3235: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 3236: my ($res_error,%queueable); 3237: my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error); 3238: if ($res_error) { 3239: $request->print(&navmap_errormsg()); 3240: return; 3241: } else { 3242: foreach my $part (@{$partlist}) { 3243: if (ref($responseType->{$part}) eq 'HASH') { 3244: foreach my $id (keys(%{$responseType->{$part}})) { 3245: if (($responseType->{$part}->{$id} eq 'essay') || 3246: (lc($handgrade->{$part.'_'.$id}) eq 'yes')) { 3247: $queueable{$part} = 1; 3248: last; 3249: } 3250: } 3251: } 3252: } 3253: } 3254: 3255: if ($button eq 'Save & Next') { 3256: my $ctr = 0; 3257: while ($ctr < $ngrade) { 3258: my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr}); 3259: my ($errorflag,$pts,$wgt,$numhidden) = 3260: &saveHandGrade($request,$symb,$uname,$udom,$ctr,undef,undef,\%queueable); 3261: if ($errorflag eq 'no_score') { 3262: $ctr++; 3263: next; 3264: } 3265: if ($errorflag eq 'not_allowed') { 3266: $request->print( 3267: '<span class="LC_error">' 3268: .&mt('Not allowed to modify grades for [_1]',"$uname:$udom") 3269: .'</span>'); 3270: $ctr++; 3271: next; 3272: } 3273: if ($numhidden) { 3274: $request->print( 3275: '<span class="LC_info">' 3276: .&mt('For [_1]: [quant,_2,transaction] hidden',"$uname:$udom",$numhidden) 3277: .'</span><br />'); 3278: } 3279: my $includemsg = $env{'form.includemsg'.$ctr}; 3280: my ($subject,$message,$msgstatus) = ('','',''); 3281: my $restitle = &Apache::lonnet::gettitle($symb); 3282: my ($feedurl,$showsymb) = 3283: &get_feedurl_and_symb($symb,$uname,$udom); 3284: my $messagetail; 3285: if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { 3286: $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); 3287: unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } 3288: $subject.=' ['.$restitle.']'; 3289: my (@msgnum) = split(/,/,$includemsg); 3290: foreach (@msgnum) { 3291: $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); 3292: } 3293: $message =&Apache::lonfeedback::clear_out_html($message); 3294: if ($env{'form.withgrades'.$ctr}) { 3295: $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; 3296: $messagetail = " for <a href=\"". 3297: $feedurl."?symb=$showsymb\">$restitle</a>"; 3298: } 3299: $msgstatus = 3300: &Apache::lonmsg::user_normal_msg($uname,$udom,$subject, 3301: $message.$messagetail, 3302: undef,$feedurl,undef, 3303: undef,undef,$showsymb, 3304: $restitle); 3305: $request->print('<br />'.&mt('Sending message to [_1]',$uname.':'.$udom).': '. 3306: $msgstatus.'<br />'); 3307: } 3308: if ($env{'form.collaborator'.$ctr}) { 3309: my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); 3310: foreach my $collabstr (@collabstrs) { 3311: my ($part,@collaborators) = split(/:/,$collabstr); 3312: foreach my $collaborator (@collaborators) { 3313: my ($errorflag,$pts,$wgt) = 3314: &saveHandGrade($request,$symb,$collaborator,$udom,$ctr, 3315: $env{'form.unamedom'.$ctr},$part,\%queueable); 3316: if ($errorflag eq 'not_allowed') { 3317: $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>"); 3318: next; 3319: } elsif ($message ne '') { 3320: my ($baseurl,$showsymb) = 3321: &get_feedurl_and_symb($symb,$collaborator, 3322: $udom); 3323: if ($env{'form.withgrades'.$ctr}) { 3324: $messagetail = " for <a href=\"". 3325: $baseurl."?symb=$showsymb\">$restitle</a>"; 3326: } 3327: $msgstatus = 3328: &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); 3329: } 3330: } 3331: } 3332: } 3333: $ctr++; 3334: } 3335: } 3336: 3337: my %keyhash = (); 3338: if ($numessay) { 3339: # Keywords sorted in alphabatical order 3340: my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; 3341: $env{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; 3342: $env{'form.keywords'} =~ s/^\s+|\s+$//g; 3343: my (@keywords) = sort(split(/\s+/,$env{'form.keywords'})); 3344: $env{'form.keywords'} = join(' ',@keywords); 3345: $keyhash{$symb.'_keywords'} = $env{'form.keywords'}; 3346: $keyhash{$symb.'_subject'} = $env{'form.msgsub'}; 3347: $keyhash{$loginuser.'_kwclr'} = $env{'form.kwclr'}; 3348: $keyhash{$loginuser.'_kwsize'} = $env{'form.kwsize'}; 3349: $keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'}; 3350: } 3351: 3352: if ($env{'form.compmsg'}) { 3353: # message center - Order of message gets changed. Blank line is eliminated. 3354: # New messages are saved in env for the next student. 3355: # All messages are saved in nohist_handgrade.db 3356: my ($ctr,$idx) = (1,1); 3357: while ($ctr <= $env{'form.savemsgN'}) { 3358: if ($env{'form.savemsg'.$ctr} ne '') { 3359: $keyhash{$symb.'_savemsg'.$idx} = $env{'form.savemsg'.$ctr}; 3360: $idx++; 3361: } 3362: $ctr++; 3363: } 3364: $ctr = 0; 3365: while ($ctr < $ngrade) { 3366: if ($env{'form.newmsg'.$ctr} ne '') { 3367: $keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr}; 3368: $env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr}; 3369: $idx++; 3370: } 3371: $ctr++; 3372: } 3373: $env{'form.savemsgN'} = --$idx; 3374: $keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'}; 3375: } 3376: if (($numessay) || ($env{'form.compmsg'})) { 3377: my $putresult = &Apache::lonnet::put 3378: ('nohist_handgrade',\%keyhash,$cdom,$cnum); 3379: } 3380: 3381: # Called by Save & Refresh from Highlight Attribute Window 3382: my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); 3383: if ($env{'form.refresh'} eq 'on') { 3384: my ($ctr,$total) = (0,0); 3385: while ($ctr < $ngrade) { 3386: $total++ if $env{'form.unamedom'.$ctr} ne ''; 3387: $ctr++; 3388: } 3389: $env{'form.NTSTU'}=$ngrade; 3390: $ctr = 0; 3391: while ($ctr < $total) { 3392: my $processUser = $env{'form.unamedom'.$ctr}; 3393: ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); 3394: $env{'form.fullname'} = $$fullname{$processUser}; 3395: &submission($request,$ctr,$total-1,$symb); 3396: $ctr++; 3397: } 3398: return ''; 3399: } 3400: 3401: # Get the next/previous one or group of students 3402: my $firststu = $env{'form.unamedom0'}; 3403: my $laststu = $env{'form.unamedom'.($ngrade-1)}; 3404: my $ctr = 2; 3405: while ($laststu eq '') { 3406: $laststu = $env{'form.unamedom'.($ngrade-$ctr)}; 3407: $ctr++; 3408: $laststu = $firststu if ($ctr > $ngrade); 3409: } 3410: 3411: my (@parsedlist,@nextlist); 3412: my ($nextflg) = 0; 3413: foreach my $item (sort 3414: { 3415: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 3416: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 3417: } 3418: return $a cmp $b; 3419: } (keys(%$fullname))) { 3420: if ($nextflg == 1 && $button =~ /Next$/) { 3421: push(@parsedlist,$item); 3422: } 3423: $nextflg = 1 if ($item eq $laststu); 3424: if ($button eq 'Previous') { 3425: last if ($item eq $firststu); 3426: push(@parsedlist,$item); 3427: } 3428: } 3429: $ctr = 0; 3430: @parsedlist = reverse @parsedlist if ($button eq 'Previous'); 3431: foreach my $student (@parsedlist) { 3432: my $submitonly=$env{'form.submitonly'}; 3433: my ($uname,$udom) = split(/:/,$student); 3434: 3435: if ($submitonly eq 'queued') { 3436: my %queue_status = 3437: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 3438: $udom,$uname); 3439: next if (!defined($queue_status{'gradingqueue'})); 3440: } 3441: 3442: if ($submitonly =~ /^(yes|graded|incorrect)$/) { 3443: # my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); 3444: my %status=&student_gradeStatus($symb,$udom,$uname,$partlist); 3445: my $submitted = 0; 3446: my $ungraded = 0; 3447: my $incorrect = 0; 3448: foreach my $item (keys(%status)) { 3449: $submitted = 1 if ($status{$item} ne 'nothing'); 3450: $ungraded = 1 if ($status{$item} =~ /^ungraded/); 3451: $incorrect = 1 if ($status{$item} =~ /^incorrect/); 3452: my ($foo,$partid,$foo1) = split(/\./,$item); 3453: if ($status{'resource.'.$partid.'.submitted_by'} ne '') { 3454: $submitted = 0; 3455: } 3456: } 3457: next if (!$submitted && ($submitonly eq 'yes' || 3458: $submitonly eq 'incorrect' || 3459: $submitonly eq 'graded')); 3460: next if (!$ungraded && ($submitonly eq 'graded')); 3461: next if (!$incorrect && $submitonly eq 'incorrect'); 3462: } 3463: push(@nextlist,$student) if ($ctr < $ntstu); 3464: last if ($ctr == $ntstu); 3465: $ctr++; 3466: } 3467: 3468: $ctr = 0; 3469: my $total = scalar(@nextlist)-1; 3470: 3471: foreach (sort(@nextlist)) { 3472: my ($uname,$udom,$submitter) = split(/:/); 3473: $env{'form.student'} = $uname; 3474: $env{'form.userdom'} = $udom; 3475: $env{'form.fullname'} = $$fullname{$_}; 3476: &submission($request,$ctr,$total,$symb); 3477: $ctr++; 3478: } 3479: if ($total < 0) { 3480: my $the_end.='<p>'.&mt('[_1]Message:[_2] No more students for this section or class.','<b>','</b>').'</p>'."\n"; 3481: $request->print($the_end); 3482: } 3483: return ''; 3484: } 3485: 3486: #---- Save the score and award for each student, if changed 3487: sub saveHandGrade { 3488: my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part,$queueable) = @_; 3489: my @version_parts; 3490: my $usec = &Apache::lonnet::getsection($domain,$stuname, 3491: $env{'request.course.id'}); 3492: if (!&canmodify($usec)) { return('not_allowed'); } 3493: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); 3494: my @parts_graded; 3495: my %newrecord = (); 3496: my ($pts,$wgt,$totchg) = ('','',0); 3497: my %aggregate = (); 3498: my $aggregateflag = 0; 3499: if ($env{'form.HIDE'.$newflg}) { 3500: my ($version,$parts) = split(/:/,$env{'form.HIDE'.$newflg},2); 3501: my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1); 3502: $totchg += $numchgs; 3503: } 3504: my @parts = split(/:/,$env{'form.partlist'.$newflg}); 3505: foreach my $new_part (@parts) { 3506: #collaborator ($submi may vary for different parts 3507: if ($submitter && $new_part ne $part) { next; } 3508: my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; 3509: if ($dropMenu eq 'excused') { 3510: if ($record{'resource.'.$new_part.'.solved'} ne 'excused') { 3511: $newrecord{'resource.'.$new_part.'.solved'} = 'excused'; 3512: if (exists($record{'resource.'.$new_part.'.awarded'})) { 3513: $newrecord{'resource.'.$new_part.'.awarded'} = ''; 3514: } 3515: $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; 3516: } 3517: } elsif ($dropMenu eq 'reset status' 3518: && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts 3519: foreach my $key (keys(%record)) { 3520: if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } 3521: } 3522: $newrecord{'resource.'.$new_part.'.regrader'}= 3523: "$env{'user.name'}:$env{'user.domain'}"; 3524: my $totaltries = $record{'resource.'.$part.'.tries'}; 3525: 3526: my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, 3527: [$new_part]); 3528: my $aggtries =$totaltries; 3529: if ($last_resets{$new_part}) { 3530: $aggtries = &get_num_tries(\%record,$last_resets{$new_part}, 3531: $new_part); 3532: } 3533: 3534: my $solvedstatus = $record{'resource.'.$new_part.'.solved'}; 3535: if ($aggtries > 0) { 3536: &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); 3537: $aggregateflag = 1; 3538: } 3539: } elsif ($dropMenu eq '') { 3540: $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 3541: $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 3542: $env{'form.RADVAL'.$newflg.'_'.$new_part}); 3543: if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$new_part} eq '') { 3544: next; 3545: } 3546: $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : 3547: $env{'form.WGT'.$newflg.'_'.$new_part}; 3548: my $partial= $pts/$wgt; 3549: if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { 3550: #do not update score for part if not changed. 3551: &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); 3552: next; 3553: } else { 3554: push(@parts_graded,$new_part); 3555: } 3556: if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { 3557: $newrecord{'resource.'.$new_part.'.awarded'} = $partial; 3558: } 3559: my $reckey = 'resource.'.$new_part.'.solved'; 3560: if ($partial == 0) { 3561: if ($record{$reckey} ne 'incorrect_by_override') { 3562: $newrecord{$reckey} = 'incorrect_by_override'; 3563: } 3564: } else { 3565: if ($record{$reckey} ne 'correct_by_override') { 3566: $newrecord{$reckey} = 'correct_by_override'; 3567: } 3568: } 3569: if ($submitter && 3570: ($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) { 3571: $newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter; 3572: } 3573: $newrecord{'resource.'.$new_part.'.regrader'}= 3574: "$env{'user.name'}:$env{'user.domain'}"; 3575: } 3576: # unless problem has been graded, set flag to version the submitted files 3577: unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || 3578: $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' || 3579: $dropMenu eq 'reset status') 3580: { 3581: push(@version_parts,$new_part); 3582: } 3583: } 3584: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 3585: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 3586: 3587: if (%newrecord) { 3588: if (@version_parts) { 3589: my @changed_keys = &version_portfiles(\%record, \@parts_graded, 3590: $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts); 3591: @newrecord{@changed_keys} = @record{@changed_keys}; 3592: foreach my $new_part (@version_parts) { 3593: &handback_files($request,$symb,$stuname,$domain,$newflg, 3594: $new_part,\%newrecord); 3595: } 3596: } 3597: &Apache::lonnet::cstore(\%newrecord,$symb, 3598: $env{'request.course.id'},$domain,$stuname); 3599: &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb, 3600: $cdom,$cnum,$domain,$stuname,$queueable); 3601: } 3602: if ($aggregateflag) { 3603: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 3604: $cdom,$cnum); 3605: } 3606: return ('',$pts,$wgt,$totchg); 3607: } 3608: 3609: sub makehidden { 3610: my ($version,$parts,$record,$symb,$domain,$stuname,$tolog) = @_; 3611: return unless (ref($record) eq 'HASH'); 3612: my %modified; 3613: my $numchanged = 0; 3614: if (exists($record->{$version.':keys'})) { 3615: my $partsregexp = $parts; 3616: $partsregexp =~ s/,/|/g; 3617: foreach my $key (split(/\:/,$record->{$version.':keys'})) { 3618: if ($key =~ /^resource\.(?:$partsregexp)\.([^\.]+)$/) { 3619: my $item = $1; 3620: unless (($item eq 'solved') || ($item =~ /^award(|msg|ed)$/)) { 3621: $modified{$key} = $record->{$version.':'.$key}; 3622: } 3623: } elsif ($key =~ m{^(resource\.(?:$partsregexp)\.[^\.]+\.)(.+)$}) { 3624: $modified{$1.'hidden'.$2} = $record->{$version.':'.$key}; 3625: } elsif ($key =~ /^(ip|timestamp|host)$/) { 3626: $modified{$key} = $record->{$version.':'.$key}; 3627: } 3628: } 3629: if (keys(%modified)) { 3630: if (&Apache::lonnet::putstore($env{'request.course.id'},$symb,$version,\%modified, 3631: $domain,$stuname,$tolog) eq 'ok') { 3632: $numchanged ++; 3633: } 3634: } 3635: } 3636: return $numchanged; 3637: } 3638: 3639: sub check_and_remove_from_queue { 3640: my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname,$queueable) = @_; 3641: my @ungraded_parts; 3642: foreach my $part (@{$parts}) { 3643: if ( $record->{ 'resource.'.$part.'.awarded'} eq '' 3644: && $record->{ 'resource.'.$part.'.solved' } ne 'excused' 3645: && $newrecord->{'resource.'.$part.'.awarded'} eq '' 3646: && $newrecord->{'resource.'.$part.'.solved' } ne 'excused' 3647: ) { 3648: if ($queueable->{$part}) { 3649: push(@ungraded_parts, $part); 3650: } 3651: } 3652: } 3653: if ( !@ungraded_parts ) { 3654: &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom, 3655: $cnum,$domain,$stuname); 3656: } 3657: } 3658: 3659: sub handback_files { 3660: my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; 3661: my $portfolio_root = '/userfiles/portfolio'; 3662: my $res_error; 3663: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 3664: if ($res_error) { 3665: $request->print('<br />'.&navmap_errormsg().'<br />'); 3666: return; 3667: } 3668: my @handedback; 3669: my $file_msg; 3670: my @part_response_id = &flatten_responseType($responseType); 3671: foreach my $part_response_id (@part_response_id) { 3672: my ($part_id,$resp_id) = @{ $part_response_id }; 3673: my $part_resp = join('_',@{ $part_response_id }); 3674: if (($env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'} =~ /^\d+$/) & ($new_part eq $part_id)) { 3675: for (my $counter=1; $counter<=$env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'}; $counter++) { 3676: # if multiple files are uploaded names will be 'returndoc2','returndoc3' 3677: if ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter}) { 3678: my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter.'.filename'}; 3679: my ($directory,$answer_file) = 3680: ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter} =~ /^(.*?)([^\/]*)$/); 3681: my ($answer_name,$answer_ver,$answer_ext) = 3682: &file_name_version_ext($answer_file); 3683: my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); 3684: my $getpropath = 1; 3685: my ($dir_list,$listerror) = 3686: &Apache::lonnet::dirlist($portfolio_root.$portfolio_path, 3687: $domain,$stuname,$getpropath); 3688: my $version = &get_next_version($answer_name,$answer_ext,$dir_list); 3689: # fix filename 3690: my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); 3691: my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, 3692: $newflg.'_'.$part_resp.'_returndoc'.$counter, 3693: $save_file_name); 3694: if ($result !~ m|^/uploaded/|) { 3695: $request->print('<br /><span class="LC_error">'. 3696: &mt('An error occurred ([_1]) while trying to upload [_2].', 3697: $result,$newflg.'_'.$part_resp.'_returndoc'.$counter). 3698: '</span>'); 3699: } else { 3700: # mark the file as read only 3701: push(@handedback,$save_file_name); 3702: if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) { 3703: $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; 3704: } 3705: $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; 3706: $file_msg.='<span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span> <br />"; 3707: 3708: } 3709: $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>')); 3710: } 3711: } 3712: } 3713: } 3714: if (@handedback > 0) { 3715: $request->print('<br />'); 3716: my @what = ($symb,$env{'request.course.id'},'handback'); 3717: &Apache::lonnet::mark_as_readonly($domain,$stuname,\@handedback,\@what); 3718: my $user_lh = &Apache::loncommon::user_lang($stuname,$domain,$env{'request.course.id'}); 3719: my ($subject,$message); 3720: if (scalar(@handedback) == 1) { 3721: $subject = &mt_user($user_lh,'File Handed Back by Instructor'); 3722: $message = &mt_user($user_lh,'A file has been returned that was originally submitted in response to: '); 3723: } else { 3724: $subject = &mt_user($user_lh,'Files Handed Back by Instructor'); 3725: $message = &mt_user($user_lh,'Files have been returned that were originally submitted in response to: '); 3726: } 3727: $message .= "<p><strong>".&Apache::lonnet::gettitle($symb)." </strong></p>"; 3728: $message .= &mt_user($user_lh,'The returned file(s) are named: [_1]',"<br />$file_msg <br />"). 3729: &mt_user($user_lh,'The file(s) can be found in your [_1]portfolio[_2].','<a href="/adm/portfolio">','</a>'); 3730: my ($feedurl,$showsymb) = 3731: &get_feedurl_and_symb($symb,$domain,$stuname); 3732: my $restitle = &Apache::lonnet::gettitle($symb); 3733: $subject .= ' '.&mt_user($user_lh,'(File Returned)').' ['.$restitle.']'; 3734: my $msgstatus = 3735: &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject, 3736: $message,undef,$feedurl,undef,undef,undef,$showsymb, 3737: $restitle); 3738: if ($msgstatus) { 3739: $request->print(&mt('Notification message status: [_1]','<span class="LC_info">'.$msgstatus.'</span>').'<br />'); 3740: } 3741: } 3742: return; 3743: } 3744: 3745: sub get_feedurl_and_symb { 3746: my ($symb,$uname,$udom) = @_; 3747: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 3748: $url = &Apache::lonnet::clutter($url); 3749: my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', 3750: $symb,$udom,$uname); 3751: if ($encrypturl =~ /^yes$/i) { 3752: &Apache::lonenc::encrypted(\$url,1); 3753: &Apache::lonenc::encrypted(\$symb,1); 3754: } 3755: return ($url,$symb); 3756: } 3757: 3758: sub get_submitted_files { 3759: my ($udom,$uname,$partid,$respid,$record) = @_; 3760: my @files; 3761: if ($$record{"resource.$partid.$respid.portfiles"}) { 3762: my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; 3763: foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) { 3764: push(@files,$file_url.$file); 3765: } 3766: } 3767: if ($$record{"resource.$partid.$respid.uploadedurl"}) { 3768: push(@files,$$record{"resource.$partid.$respid.uploadedurl"}); 3769: } 3770: return (\@files); 3771: } 3772: 3773: # ----------- Provides number of tries since last reset. 3774: sub get_num_tries { 3775: my ($record,$last_reset,$part) = @_; 3776: my $timestamp = ''; 3777: my $num_tries = 0; 3778: if ($$record{'version'}) { 3779: for (my $version=$$record{'version'};$version>=1;$version--) { 3780: if (exists($$record{$version.':resource.'.$part.'.solved'})) { 3781: $timestamp = $$record{$version.':timestamp'}; 3782: if ($timestamp > $last_reset) { 3783: $num_tries ++; 3784: } else { 3785: last; 3786: } 3787: } 3788: } 3789: } 3790: return $num_tries; 3791: } 3792: 3793: # ----------- Determine decrements required in aggregate totals 3794: sub decrement_aggs { 3795: my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_; 3796: my %decrement = ( 3797: attempts => 0, 3798: users => 0, 3799: correct => 0 3800: ); 3801: $decrement{'attempts'} = $aggtries; 3802: if ($solvedstatus =~ /^correct/) { 3803: $decrement{'correct'} = 1; 3804: } 3805: if ($aggtries == $totaltries) { 3806: $decrement{'users'} = 1; 3807: } 3808: foreach my $type (keys(%decrement)) { 3809: $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type}; 3810: } 3811: return; 3812: } 3813: 3814: # ----------- Determine timestamps for last reset of aggregate totals for parts 3815: sub get_last_resets { 3816: my ($symb,$courseid,$partids) =@_; 3817: my %last_resets; 3818: my $cdom = $env{'course.'.$courseid.'.domain'}; 3819: my $cname = $env{'course.'.$courseid.'.num'}; 3820: my @keys; 3821: foreach my $part (@{$partids}) { 3822: push(@keys,"$symb\0$part\0resettime"); 3823: } 3824: my %results=&Apache::lonnet::get('nohist_resourcetracker',\@keys, 3825: $cdom,$cname); 3826: foreach my $part (@{$partids}) { 3827: $last_resets{$part}=$results{"$symb\0$part\0resettime"}; 3828: } 3829: return %last_resets; 3830: } 3831: 3832: # ----------- Handles creating versions for portfolio files as answers 3833: sub version_portfiles { 3834: my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_; 3835: my $version_parts = join('|',@$v_flag); 3836: my @returned_keys; 3837: my $parts = join('|', @$parts_graded); 3838: my $portfolio_root = '/userfiles/portfolio'; 3839: foreach my $key (keys(%$record)) { 3840: my $new_portfiles; 3841: if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { 3842: my @versioned_portfiles; 3843: my @portfiles = split(/\s*,\s*/,$$record{$key}); 3844: foreach my $file (@portfiles) { 3845: &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file); 3846: my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); 3847: my ($answer_name,$answer_ver,$answer_ext) = 3848: &file_name_version_ext($answer_file); 3849: my $getpropath = 1; 3850: my ($dir_list,$listerror) = 3851: &Apache::lonnet::dirlist($portfolio_root.$directory,$domain, 3852: $stu_name,$getpropath); 3853: my $version = &get_next_version($answer_name,$answer_ext,$dir_list); 3854: my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); 3855: if ($new_answer ne 'problem getting file') { 3856: push(@versioned_portfiles, $directory.$new_answer); 3857: &Apache::lonnet::mark_as_readonly($domain,$stu_name, 3858: [$directory.$new_answer], 3859: [$symb,$env{'request.course.id'},'graded']); 3860: } 3861: } 3862: $$record{$key} = join(',',@versioned_portfiles); 3863: push(@returned_keys,$key); 3864: } 3865: } 3866: return (@returned_keys); 3867: } 3868: 3869: sub get_next_version { 3870: my ($answer_name, $answer_ext, $dir_list) = @_; 3871: my $version; 3872: if (ref($dir_list) eq 'ARRAY') { 3873: foreach my $row (@{$dir_list}) { 3874: my ($file) = split(/\&/,$row,2); 3875: my ($file_name,$file_version,$file_ext) = 3876: &file_name_version_ext($file); 3877: if (($file_name eq $answer_name) && 3878: ($file_ext eq $answer_ext)) { 3879: # gets here if filename and extension match, 3880: # regardless of version 3881: if ($file_version ne '') { 3882: # a versioned file is found so save it for later 3883: if ($file_version > $version) { 3884: $version = $file_version; 3885: } 3886: } 3887: } 3888: } 3889: } 3890: $version ++; 3891: return($version); 3892: } 3893: 3894: sub version_selected_portfile { 3895: my ($domain,$stu_name,$directory,$file_name,$version) = @_; 3896: my ($answer_name,$answer_ver,$answer_ext) = 3897: &file_name_version_ext($file_name); 3898: my $new_answer; 3899: $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name"); 3900: if($env{'form.copy'} eq '-1') { 3901: $new_answer = 'problem getting file'; 3902: } else { 3903: $new_answer = $answer_name.'.'.$version.'.'.$answer_ext; 3904: my $copy_result = &Apache::lonnet::finishuserfileupload( 3905: $stu_name,$domain,'copy', 3906: '/portfolio'.$directory.$new_answer); 3907: } 3908: return ($new_answer); 3909: } 3910: 3911: sub file_name_version_ext { 3912: my ($file)=@_; 3913: my @file_parts = split(/\./, $file); 3914: my ($name,$version,$ext); 3915: if (@file_parts > 1) { 3916: $ext=pop(@file_parts); 3917: if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) { 3918: $version=pop(@file_parts); 3919: } 3920: $name=join('.',@file_parts); 3921: } else { 3922: $name=join('.',@file_parts); 3923: } 3924: return($name,$version,$ext); 3925: } 3926: 3927: #-------------------------------------------------------------------------------------- 3928: # 3929: #-------------------------- Next few routines handles grading by section or whole class 3930: # 3931: #--- Javascript to handle grading by section or whole class 3932: sub viewgrades_js { 3933: my ($request) = shift; 3934: 3935: my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); 3936: &js_escape(\$alertmsg); 3937: $request->print(&Apache::lonhtmlcommon::scripttag(<<VIEWJAVASCRIPT)); 3938: function writePoint(partid,weight,point) { 3939: var radioButton = document.classgrade["RADVAL_"+partid]; 3940: var textbox = document.classgrade["TEXTVAL_"+partid]; 3941: if (point == "textval") { 3942: point = document.classgrade["TEXTVAL_"+partid].value; 3943: if (isNaN(point) || parseFloat(point) < 0) { 3944: alert("$alertmsg"+parseFloat(point)); 3945: var resetbox = false; 3946: for (var i=0; i<radioButton.length; i++) { 3947: if (radioButton[i].checked) { 3948: textbox.value = i; 3949: resetbox = true; 3950: } 3951: } 3952: if (!resetbox) { 3953: textbox.value = ""; 3954: } 3955: return; 3956: } 3957: if (parseFloat(point) > parseFloat(weight)) { 3958: var resp = confirm("You entered a value ("+parseFloat(point)+ 3959: ") greater than the weight for the part. Accept?"); 3960: if (resp == false) { 3961: textbox.value = ""; 3962: return; 3963: } 3964: } 3965: for (var i=0; i<radioButton.length; i++) { 3966: radioButton[i].checked=false; 3967: if (parseFloat(point) == i) { 3968: radioButton[i].checked=true; 3969: } 3970: } 3971: 3972: } else { 3973: textbox.value = parseFloat(point); 3974: } 3975: for (i=0;i<document.classgrade.total.value;i++) { 3976: var user = document.classgrade["ctr"+i].value; 3977: user = user.replace(new RegExp(':', 'g'),"_"); 3978: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 3979: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 3980: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 3981: if (saveval != "correct") { 3982: scorename.value = point; 3983: if (selname[0].selected != true) { 3984: selname[0].selected = true; 3985: } 3986: } 3987: } 3988: document.classgrade["SELVAL_"+partid][0].selected = true; 3989: } 3990: 3991: function writeRadText(partid,weight) { 3992: var selval = document.classgrade["SELVAL_"+partid]; 3993: var radioButton = document.classgrade["RADVAL_"+partid]; 3994: var override = document.classgrade["FORCE_"+partid].checked; 3995: var textbox = document.classgrade["TEXTVAL_"+partid]; 3996: if (selval[1].selected || selval[2].selected) { 3997: for (var i=0; i<radioButton.length; i++) { 3998: radioButton[i].checked=false; 3999: 4000: } 4001: textbox.value = ""; 4002: 4003: for (i=0;i<document.classgrade.total.value;i++) { 4004: var user = document.classgrade["ctr"+i].value; 4005: user = user.replace(new RegExp(':', 'g'),"_"); 4006: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 4007: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 4008: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 4009: if ((saveval != "correct") || override) { 4010: scorename.value = ""; 4011: if (selval[1].selected) { 4012: selname[1].selected = true; 4013: } else { 4014: selname[2].selected = true; 4015: if (Number(document.classgrade["GD_"+user+"_"+partid+"_tries"].value)) 4016: {document.classgrade["GD_"+user+"_"+partid+"_tries"].value = '0';} 4017: } 4018: } 4019: } 4020: } else { 4021: for (i=0;i<document.classgrade.total.value;i++) { 4022: var user = document.classgrade["ctr"+i].value; 4023: user = user.replace(new RegExp(':', 'g'),"_"); 4024: var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 4025: var saveval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 4026: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 4027: if ((saveval != "correct") || override) { 4028: scorename.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value; 4029: selname[0].selected = true; 4030: } 4031: } 4032: } 4033: } 4034: 4035: function changeSelect(partid,user) { 4036: var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"]; 4037: var textbox = document.classgrade["GD_"+user+'_'+partid+"_awarded"]; 4038: var point = textbox.value; 4039: var weight = document.classgrade["weight_"+partid].value; 4040: 4041: if (isNaN(point) || parseFloat(point) < 0) { 4042: alert("$alertmsg"+parseFloat(point)); 4043: textbox.value = ""; 4044: return; 4045: } 4046: if (parseFloat(point) > parseFloat(weight)) { 4047: var resp = confirm("You entered a value ("+parseFloat(point)+ 4048: ") greater than the weight of the part. Accept?"); 4049: if (resp == false) { 4050: textbox.value = ""; 4051: return; 4052: } 4053: } 4054: selval[0].selected = true; 4055: } 4056: 4057: function changeOneScore(partid,user) { 4058: var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"]; 4059: if (selval[1].selected || selval[2].selected) { 4060: document.classgrade["GD_"+user+'_'+partid+"_awarded"].value = ""; 4061: if (selval[2].selected) { 4062: document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0"; 4063: } 4064: } 4065: } 4066: 4067: function resetEntry(numpart) { 4068: for (ctpart=0;ctpart<numpart;ctpart++) { 4069: var partid = document.classgrade["partid_"+ctpart].value; 4070: var radioButton = document.classgrade["RADVAL_"+partid]; 4071: var textbox = document.classgrade["TEXTVAL_"+partid]; 4072: var selval = document.classgrade["SELVAL_"+partid]; 4073: for (var i=0; i<radioButton.length; i++) { 4074: radioButton[i].checked=false; 4075: 4076: } 4077: textbox.value = ""; 4078: selval[0].selected = true; 4079: 4080: for (i=0;i<document.classgrade.total.value;i++) { 4081: var user = document.classgrade["ctr"+i].value; 4082: user = user.replace(new RegExp(':', 'g'),"_"); 4083: var resetscore = document.classgrade["GD_"+user+"_"+partid+"_awarded"]; 4084: resetscore.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value; 4085: var resettries = document.classgrade["GD_"+user+"_"+partid+"_tries"]; 4086: resettries.value = document.classgrade["GD_"+user+"_"+partid+"_tries_s"].value; 4087: var saveselval = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value; 4088: var selname = document.classgrade["GD_"+user+"_"+partid+"_solved"]; 4089: if (saveselval == "excused") { 4090: if (selname[1].selected == false) { selname[1].selected = true;} 4091: } else { 4092: if (selname[0].selected == false) {selname[0].selected = true}; 4093: } 4094: } 4095: } 4096: } 4097: 4098: VIEWJAVASCRIPT 4099: } 4100: 4101: #--- show scores for a section or whole class w/ option to change/update a score 4102: sub viewgrades { 4103: my ($request,$symb) = @_; 4104: my ($is_tool,$toolsymb); 4105: if ($symb =~ /ext\.tool$/) { 4106: $is_tool = 1; 4107: $toolsymb = $symb; 4108: } 4109: &viewgrades_js($request); 4110: 4111: #need to make sure we have the correct data for later EXT calls, 4112: #thus invalidate the cache 4113: &Apache::lonnet::devalidatecourseresdata( 4114: $env{'course.'.$env{'request.course.id'}.'.num'}, 4115: $env{'course.'.$env{'request.course.id'}.'.domain'}); 4116: &Apache::lonnet::clear_EXT_cache_status(); 4117: 4118: my $result='<h3><span class="LC_info">'.&mt('Manual Grading').'</span></h3>'; 4119: 4120: #view individual student submission form - called using Javascript viewOneStudent 4121: $result.=&jscriptNform($symb); 4122: 4123: #beginning of class grading form 4124: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 4125: $result.= '<form action="/adm/grades" method="post" name="classgrade">'."\n". 4126: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 4127: '<input type="hidden" name="command" value="editgrades" />'."\n". 4128: &build_section_inputs(). 4129: '<input type="hidden" name="Status" value="'.$env{'stu_status'}.'" />'."\n". 4130: 4131: #retrieve selected groups 4132: my (@groups,$group_display); 4133: @groups = &Apache::loncommon::get_env_multiple('form.group'); 4134: if (grep(/^all$/,@groups)) { 4135: @groups = ('all'); 4136: } elsif (grep(/^none$/,@groups)) { 4137: @groups = ('none'); 4138: } elsif (@groups > 0) { 4139: $group_display = join(', ',@groups); 4140: } 4141: 4142: my ($common_header,$specific_header,@sections,$section_display); 4143: if ($env{'request.course.sec'} ne '') { 4144: @sections = ($env{'request.course.sec'}); 4145: } else { 4146: @sections = &Apache::loncommon::get_env_multiple('form.section'); 4147: } 4148: 4149: # Check if Save button should be usable 4150: my $disabled = ' disabled="disabled"'; 4151: if ($perm{'mgr'}) { 4152: if (grep(/^all$/,@sections)) { 4153: undef($disabled); 4154: } else { 4155: foreach my $sec (@sections) { 4156: if (&canmodify($sec)) { 4157: undef($disabled); 4158: last; 4159: } 4160: } 4161: } 4162: } 4163: if (grep(/^all$/,@sections)) { 4164: @sections = ('all'); 4165: if ($group_display) { 4166: $common_header = &mt('Assign Common Grade to Students in Group(s) [_1]',$group_display); 4167: $specific_header = &mt('Assign Grade to Specific Students in Group(s) [_1]',$group_display); 4168: } elsif (grep(/^none$/,@groups)) { 4169: $common_header = &mt('Assign Common Grade to Students not assigned to any groups'); 4170: $specific_header = &mt('Assign Grade to Specific Students not assigned to any groups'); 4171: } else { 4172: $common_header = &mt('Assign Common Grade to Class'); 4173: $specific_header = &mt('Assign Grade to Specific Students in Class'); 4174: } 4175: } elsif (grep(/^none$/,@sections)) { 4176: @sections = ('none'); 4177: if ($group_display) { 4178: $common_header = &mt('Assign Common Grade to Students in no Section and in Group(s) [_1]',$group_display); 4179: $specific_header = &mt('Assign Grade to Specific Students in no Section and in Group(s)',$group_display); 4180: } elsif (grep(/^none$/,@groups)) { 4181: $common_header = &mt('Assign Common Grade to Students in no Section and in no Group'); 4182: $specific_header = &mt('Assign Grade to Specific Students in no Section and in no Group'); 4183: } else { 4184: $common_header = &mt('Assign Common Grade to Students in no Section'); 4185: $specific_header = &mt('Assign Grade to Specific Students in no Section'); 4186: } 4187: } else { 4188: $section_display = join (", ",@sections); 4189: if ($group_display) { 4190: $common_header = &mt('Assign Common Grade to Students in Section(s) [_1], and in Group(s) [_2]', 4191: $section_display,$group_display); 4192: $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1], and in Group(s) [_2]', 4193: $section_display,$group_display); 4194: } elsif (grep(/^none$/,@groups)) { 4195: $common_header = &mt('Assign Common Grade to Students in Section(s) [_1] and no Group',$section_display); 4196: $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1] and no Group',$section_display); 4197: } else { 4198: $common_header = &mt('Assign Common Grade to Students in Section(s) [_1]',$section_display); 4199: $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1]',$section_display); 4200: } 4201: } 4202: my %submit_types = &substatus_options(); 4203: my $submission_status = $submit_types{$env{'form.submitonly'}}; 4204: 4205: if ($env{'form.submitonly'} eq 'all') { 4206: $result.= '<h3>'.$common_header.'</h3>'; 4207: } else { 4208: my $text; 4209: if ($is_tool) { 4210: $text = &mt('(transaction status: "[_1]")',$submission_status); 4211: } else { 4212: $text = &mt('(submission status: "[_1]")',$submission_status); 4213: } 4214: $result.= '<h3>'.$common_header.' '.$text.'</h3>'; 4215: } 4216: $result .= &Apache::loncommon::start_data_table(); 4217: #radio buttons/text box for assigning points for a section or class. 4218: #handles different parts of a problem 4219: my $res_error; 4220: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 4221: if ($res_error) { 4222: return &navmap_errormsg(); 4223: } 4224: my %weight = (); 4225: my $ctsparts = 0; 4226: my %seen = (); 4227: my @part_response_id; 4228: if ($is_tool) { 4229: @part_response_id = ([0,'']); 4230: } else { 4231: @part_response_id = &flatten_responseType($responseType); 4232: } 4233: foreach my $part_response_id (@part_response_id) { 4234: my ($partid,$respid) = @{ $part_response_id }; 4235: my $part_resp = join('_',@{ $part_response_id }); 4236: next if $seen{$partid}; 4237: $seen{$partid}++; 4238: my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); 4239: $weight{$partid} = $wgt eq '' ? '1' : $wgt; 4240: 4241: my $display_part=&get_display_part($partid,$symb); 4242: my $radio.='<table border="0"><tr>'; 4243: my $ctr = 0; 4244: while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across 4245: $radio.= '<td><label><input type="radio" name="RADVAL_'.$partid.'" '. 4246: 'onclick="javascript:writePoint(\''.$partid.'\','.$weight{$partid}. 4247: ','.$ctr.')" />'.$ctr."</label></td>\n"; 4248: $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : ''); 4249: $ctr++; 4250: } 4251: $radio.='</tr></table>'; 4252: my $line = '<input type="text" name="TEXTVAL_'. 4253: $partid.'" size="4" '.'onchange="javascript:writePoint(\''. 4254: $partid.'\','.$weight{$partid}.',\'textval\')" /> /'. 4255: $weight{$partid}.' '.&mt('(problem weight)').'</td>'."\n"; 4256: $line.= '<td><b>'.&mt('Grade Status').':</b>'. 4257: '<select name="SELVAL_'.$partid.'" '. 4258: 'onchange="javascript:writeRadText(\''.$partid.'\','. 4259: $weight{$partid}.')"> '. 4260: '<option selected="selected"> </option>'. 4261: '<option value="excused">'.&mt('excused').'</option>'. 4262: '<option value="reset status">'.&mt('reset status').'</option>'. 4263: '</select></td>'. 4264: '<td><label><input type="checkbox" name="FORCE_'.$partid.'" />'.&mt('Override "Correct"').'</label>'; 4265: $line.='<input type="hidden" name="partid_'. 4266: $ctsparts.'" value="'.$partid.'" />'."\n"; 4267: $line.='<input type="hidden" name="weight_'. 4268: $partid.'" value="'.$weight{$partid}.'" />'."\n"; 4269: 4270: $result.= 4271: &Apache::loncommon::start_data_table_row()."\n". 4272: '<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>'. 4273: &Apache::loncommon::end_data_table_row()."\n"; 4274: $ctsparts++; 4275: } 4276: $result.=&Apache::loncommon::end_data_table()."\n". 4277: '<input type="hidden" name="totalparts" value="'.$ctsparts.'" />'; 4278: $result.='<input type="button" value="'.&mt('Revert to Default').'" '. 4279: 'onclick="javascript:resetEntry('.$ctsparts.');" />'; 4280: 4281: #table listing all the students in a section/class 4282: #header of table 4283: if ($env{'form.submitonly'} eq 'all') { 4284: $result.= '<h3>'.$specific_header.'</h3>'; 4285: } else { 4286: my $text; 4287: if ($is_tool) { 4288: $text = &mt('(transaction status: "[_1]")',$submission_status); 4289: } else { 4290: $text = &mt('(submission status: "[_1]")',$submission_status); 4291: } 4292: $result.= '<h3>'.$specific_header.' '.$text.'</h3>'; 4293: } 4294: $result.= &Apache::loncommon::start_data_table(). 4295: &Apache::loncommon::start_data_table_header_row(). 4296: '<th>'.&mt('No.').'</th>'. 4297: '<th>'.&nameUserString('header')."</th>\n"; 4298: my $partserror; 4299: my (@parts) = sort(&getpartlist($symb,\$partserror)); 4300: if ($partserror) { 4301: return &navmap_errormsg(); 4302: } 4303: my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); 4304: my @partids = (); 4305: foreach my $part (@parts) { 4306: my $display=&Apache::lonnet::metadata($url,$part.'.display',$toolsymb); 4307: my $narrowtext = &mt('Tries'); 4308: $display =~ s|^Number of Attempts|$narrowtext <br />|; # makes the column narrower 4309: if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name',$toolsymb); } 4310: my ($partid) = &split_part_type($part); 4311: push(@partids,$partid); 4312: # 4313: # FIXME: Looks like $display looks at English text 4314: # 4315: my $display_part=&get_display_part($partid,$symb); 4316: if ($display =~ /^Partial Credit Factor/) { 4317: $result.='<th>'. 4318: &mt('Score Part: [_1][_2](weight = [_3])', 4319: $display_part,'<br />',$weight{$partid}).'</th>'."\n"; 4320: next; 4321: 4322: } else { 4323: if ($display =~ /Problem Status/) { 4324: my $grade_status_mt = &mt('Grade Status'); 4325: $display =~ s{Problem Status}{$grade_status_mt<br />}; 4326: } 4327: my $part_mt = &mt('Part:'); 4328: $display =~s{\[Part: \Q$partid\E\]}{$part_mt $display_part}; 4329: } 4330: 4331: $result.='<th>'.$display.'</th>'."\n"; 4332: } 4333: $result.=&Apache::loncommon::end_data_table_header_row(); 4334: 4335: my %last_resets = 4336: &get_last_resets($symb,$env{'request.course.id'},\@partids); 4337: 4338: #get info for each student 4339: #list all the students - with points and grade status 4340: my (undef,undef,$fullname) = &getclasslist(\@sections,'1',\@groups); 4341: my $ctr = 0; 4342: foreach (sort 4343: { 4344: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 4345: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 4346: } 4347: return $a cmp $b; 4348: } (keys(%$fullname))) { 4349: $result.=&viewstudentgrade($symb,$env{'request.course.id'}, 4350: $_,$$fullname{$_},\@parts,\%weight,\$ctr,\%last_resets,$is_tool); 4351: } 4352: $result.=&Apache::loncommon::end_data_table(); 4353: $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n"; 4354: $result.='<input type="button" value="'.&mt('Save').'"'.$disabled.' '. 4355: 'onclick="javascript:submit();" target="_self" /></form>'."\n"; 4356: if ($ctr == 0) { 4357: my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status')); 4358: $result='<h3><span class="LC_info">'.&mt('Manual Grading').'</span></h3>'. 4359: '<span class="LC_warning">'; 4360: if ($env{'form.submitonly'} eq 'all') { 4361: if (grep(/^all$/,@sections)) { 4362: if (grep(/^all$/,@groups)) { 4363: $result .= &mt('There are no students with enrollment status [_1] to modify or grade.', 4364: $stu_status); 4365: } elsif (grep(/^none$/,@groups)) { 4366: $result .= &mt('There are no students with no group assigned and with enrollment status [_1] to modify or grade.', 4367: $stu_status); 4368: } else { 4369: $result .= &mt('There are no students in group(s) [_1] with enrollment status [_2] to modify or grade.', 4370: $group_display,$stu_status); 4371: } 4372: } elsif (grep(/^none$/,@sections)) { 4373: if (grep(/^all$/,@groups)) { 4374: $result .= &mt('There are no students in no section with enrollment status [_1] to modify or grade.', 4375: $stu_status); 4376: } elsif (grep(/^none$/,@groups)) { 4377: $result .= &mt('There are no students in no section and no group with enrollment status [_1] to modify or grade.', 4378: $stu_status); 4379: } else { 4380: $result .= &mt('There are no students in no section in group(s) [_1] with enrollment status [_2] to modify or grade.', 4381: $group_display,$stu_status); 4382: } 4383: } else { 4384: if (grep(/^all$/,@groups)) { 4385: $result .= &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.', 4386: $section_display,$stu_status); 4387: } elsif (grep(/^none$/,@groups)) { 4388: $result .= &mt('There are no students in section(s) [_1] and no group with enrollment status [_2] to modify or grade.', 4389: $section_display,$stu_status); 4390: } else { 4391: $result .= &mt('There are no students in section(s) [_1] and group(s) [_2] with enrollment status [_3] to modify or grade.', 4392: $section_display,$group_display,$stu_status); 4393: } 4394: } 4395: } else { 4396: if (grep(/^all$/,@sections)) { 4397: if (grep(/^all$/,@groups)) { 4398: $result .= &mt('There are no students with enrollment status [_1] and submission status "[_2]" to modify or grade.', 4399: $stu_status,$submission_status); 4400: } elsif (grep(/^none$/,@groups)) { 4401: $result .= &mt('There are no students with no group assigned with enrollment status [_1] and submission status "[_2]" to modify or grade.', 4402: $stu_status,$submission_status); 4403: } else { 4404: $result .= &mt('There are no students in group(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', 4405: $group_display,$stu_status,$submission_status); 4406: } 4407: } elsif (grep(/^none$/,@sections)) { 4408: if (grep(/^all$/,@groups)) { 4409: $result .= &mt('There are no students in no section with enrollment status [_1] and submission status "[_2]" to modify or grade.', 4410: $stu_status,$submission_status); 4411: } elsif (grep(/^none$/,@groups)) { 4412: $result .= &mt('There are no students in no section and no group with enrollment status [_1] and submission status "[_2]" to modify or grade.', 4413: $stu_status,$submission_status); 4414: } else { 4415: $result .= &mt('There are no students in no section in group(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', 4416: $group_display,$stu_status,$submission_status); 4417: } 4418: } else { 4419: if (grep(/^all$/,@groups)) { 4420: $result .= &mt('There are no students in section(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', 4421: $section_display,$stu_status,$submission_status); 4422: } elsif (grep(/^none$/,@groups)) { 4423: $result .= &mt('There are no students in section(s) [_1] and no group with enrollment status [_2] and submission status "[_3]" to modify or grade.', 4424: $section_display,$stu_status,$submission_status); 4425: } else { 4426: $result .= &mt('There are no students in section(s) [_1] and group(s) [_2] with enrollment status [_3] and submission status "[_4]" to modify or grade.', 4427: $section_display,$group_display,$stu_status,$submission_status); 4428: } 4429: } 4430: } 4431: $result .= '</span><br />'; 4432: } 4433: return $result; 4434: } 4435: 4436: #--- call by previous routine to display each student who satisfies submission filter. 4437: sub viewstudentgrade { 4438: my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets,$is_tool) = @_; 4439: my ($uname,$udom) = split(/:/,$student); 4440: my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); 4441: my $submitonly = $env{'form.submitonly'}; 4442: unless (($submitonly eq 'all') || ($submitonly eq 'queued')) { 4443: my %partstatus = (); 4444: if (ref($parts) eq 'ARRAY') { 4445: foreach my $apart (@{$parts}) { 4446: my ($part,$type) = &split_part_type($apart); 4447: my ($status,undef) = split(/_/,$record{"resource.$part.solved"},2); 4448: $status = 'nothing' if ($status eq ''); 4449: $partstatus{$part} = $status; 4450: my $subkey = "resource.$part.submitted_by"; 4451: $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); 4452: } 4453: my $submitted = 0; 4454: my $graded = 0; 4455: my $incorrect = 0; 4456: foreach my $key (keys(%partstatus)) { 4457: $submitted = 1 if ($partstatus{$key} ne 'nothing'); 4458: $graded = 1 if ($partstatus{$key} =~ /^ungraded/); 4459: $incorrect = 1 if ($partstatus{$key} =~ /^incorrect/); 4460: 4461: my $partid = (split(/\./,$key))[1]; 4462: if ($partstatus{'resource.'.$partid.'.'.$key.'.submitted_by'} ne '') { 4463: $submitted = 0; 4464: } 4465: } 4466: return if (!$submitted && ($submitonly eq 'yes' || 4467: $submitonly eq 'incorrect' || 4468: $submitonly eq 'graded')); 4469: return if (!$graded && ($submitonly eq 'graded')); 4470: return if (!$incorrect && $submitonly eq 'incorrect'); 4471: } 4472: } 4473: if ($submitonly eq 'queued') { 4474: my ($cdom,$cnum) = split(/_/,$courseid); 4475: my %queue_status = 4476: &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, 4477: $udom,$uname); 4478: return if (!defined($queue_status{'gradingqueue'})); 4479: } 4480: $$ctr++; 4481: my %aggregates = (); 4482: my $result=&Apache::loncommon::start_data_table_row().'<td align="right">'. 4483: '<input type="hidden" name="ctr'.($$ctr-1).'" value="'.$student.'" />'. 4484: "\n".$$ctr.' </td><td> '. 4485: '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. 4486: '\');" target="_self">'.$fullname.'</a> '. 4487: '<span class="LC_internal_info">('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')</span></td>'."\n"; 4488: $student=~s/:/_/; # colon doen't work in javascript for names 4489: foreach my $apart (@$parts) { 4490: my ($part,$type) = &split_part_type($apart); 4491: my $score=$record{"resource.$part.$type"}; 4492: $result.='<td align="center">'; 4493: my ($aggtries,$totaltries); 4494: unless (exists($aggregates{$part})) { 4495: $totaltries = $record{'resource.'.$part.'.tries'}; 4496: $aggtries = $totaltries; 4497: if ($$last_resets{$part}) { 4498: $aggtries = &get_num_tries(\%record,$$last_resets{$part}, 4499: $part); 4500: } 4501: $result.='<input type="hidden" name="'. 4502: 'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n"; 4503: $result.='<input type="hidden" name="'. 4504: 'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n"; 4505: $aggregates{$part} = 1; 4506: } 4507: if ($type eq 'awarded') { 4508: my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part}); 4509: $result.='<input type="hidden" name="'. 4510: 'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n"; 4511: $result.='<input type="text" name="'. 4512: 'GD_'.$student.'_'.$part.'_awarded" '. 4513: 'onchange="javascript:changeSelect(\''.$part.'\',\''.$student. 4514: '\')" value="'.$pts.'" size="4" /></td>'."\n"; 4515: } elsif ($type eq 'solved') { 4516: my ($status,$foo)=split(/_/,$score,2); 4517: $status = 'nothing' if ($status eq ''); 4518: $result.='<input type="hidden" name="'.'GD_'.$student.'_'. 4519: $part.'_solved_s" value="'.$status.'" />'."\n"; 4520: $result.=' <select name="'. 4521: 'GD_'.$student.'_'.$part.'_solved" '. 4522: 'onchange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n"; 4523: $result.= (($status eq 'excused') ? '<option> </option><option selected="selected" value="excused">'.&mt('excused').'</option>' 4524: : '<option selected="selected"> </option><option value="excused">'.&mt('excused').'</option>')."\n"; 4525: $result.='<option value="reset status">'.&mt('reset status').'</option>'; 4526: $result.="</select> </td>\n"; 4527: } else { 4528: $result.='<input type="hidden" name="'. 4529: 'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'. 4530: "\n"; 4531: $result.='<input type="text" name="'. 4532: 'GD_'.$student.'_'.$part.'_'.$type.'" '. 4533: 'value="'.$score.'" size="4" /></td>'."\n"; 4534: } 4535: } 4536: $result.=&Apache::loncommon::end_data_table_row(); 4537: return $result; 4538: } 4539: 4540: #--- change scores for all the students in a section/class 4541: # record does not get update if unchanged 4542: sub editgrades { 4543: my ($request,$symb) = @_; 4544: my $toolsymb; 4545: if ($symb =~ /ext\.tool$/) { 4546: $toolsymb = $symb; 4547: } 4548: 4549: my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); 4550: my $title='<h2>'.&mt('Current Grade Status').'</h2>'; 4551: $title.='<h4><b>'.&mt('Section:').'</b> '.$section_display.'</h4>'."\n"; 4552: 4553: my $result= &Apache::loncommon::start_data_table(). 4554: &Apache::loncommon::start_data_table_header_row(). 4555: '<th rowspan="2" valign="middle">'.&mt('No.').'</th>'. 4556: '<th rowspan="2" valign="middle">'.&nameUserString('header')."</th>\n"; 4557: my %scoreptr = ( 4558: 'correct' =>'correct_by_override', 4559: 'incorrect'=>'incorrect_by_override', 4560: 'excused' =>'excused', 4561: 'ungraded' =>'ungraded_attempted', 4562: 'credited' =>'credit_attempted', 4563: 'nothing' => '', 4564: ); 4565: my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0'); 4566: 4567: my (@partid); 4568: my %weight = (); 4569: my %columns = (); 4570: my ($i,$ctr,$count,$rec_update) = (0,0,0,0); 4571: 4572: my $partserror; 4573: my (@parts) = sort(&getpartlist($symb,\$partserror)); 4574: if ($partserror) { 4575: return &navmap_errormsg(); 4576: } 4577: my $header; 4578: while ($ctr < $env{'form.totalparts'}) { 4579: my $partid = $env{'form.partid_'.$ctr}; 4580: push(@partid,$partid); 4581: $weight{$partid} = $env{'form.weight_'.$partid}; 4582: $ctr++; 4583: } 4584: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 4585: my $totcolspan = 0; 4586: foreach my $partid (@partid) { 4587: $header .= '<th align="center">'.&mt('Old Score').'</th>'. 4588: '<th align="center">'.&mt('New Score').'</th>'; 4589: $columns{$partid}=2; 4590: foreach my $stores (@parts) { 4591: my ($part,$type) = &split_part_type($stores); 4592: if ($part !~ m/^\Q$partid\E/) { next;} 4593: if ($type eq 'awarded' || $type eq 'solved') { next; } 4594: my $display=&Apache::lonnet::metadata($url,$stores.'.display',$toolsymb); 4595: $display =~ s/\[Part: \Q$part\E\]//; 4596: my $narrowtext = &mt('Tries'); 4597: $display =~ s/Number of Attempts/$narrowtext/; 4598: $header .= '<th align="center">'.&mt('Old').' '.$display.'</th>'. 4599: '<th align="center">'.&mt('New').' '.$display.'</th>'; 4600: $columns{$partid}+=2; 4601: } 4602: $totcolspan += $columns{$partid}; 4603: } 4604: foreach my $partid (@partid) { 4605: my $display_part=&get_display_part($partid,$symb); 4606: $result .= '<th colspan="'.$columns{$partid}.'" align="center">'. 4607: &mt('Part: [_1] (Weight = [_2])',$display_part,$weight{$partid}). 4608: '</th>'; 4609: 4610: } 4611: $result .= &Apache::loncommon::end_data_table_header_row(). 4612: &Apache::loncommon::start_data_table_header_row(). 4613: $header. 4614: &Apache::loncommon::end_data_table_header_row(); 4615: my @noupdate; 4616: my ($updateCtr,$noupdateCtr) = (1,1); 4617: my ($got_types,%queueable); 4618: for ($i=0; $i<$env{'form.total'}; $i++) { 4619: my $user = $env{'form.ctr'.$i}; 4620: my ($uname,$udom)=split(/:/,$user); 4621: my %newrecord; 4622: my $updateflag = 0; 4623: my $usec=$classlist->{"$uname:$udom"}[5]; 4624: my $canmodify = &canmodify($usec); 4625: my $line = '<td'.($canmodify?'':' colspan="2"').'>'. 4626: &nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>'; 4627: if (!$canmodify) { 4628: push(@noupdate, 4629: $line."<td colspan=\"$totcolspan\"><span class=\"LC_warning\">". 4630: &mt('Not allowed to modify student')."</span></td>"); 4631: next; 4632: } 4633: my %aggregate = (); 4634: my $aggregateflag = 0; 4635: $user=~s/:/_/; # colon doen't work in javascript for names 4636: foreach (@partid) { 4637: my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'}; 4638: my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1); 4639: my $old_part = $old_aw eq '' ? '' : $old_part_pcr; 4640: my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; 4641: my $awarded = $env{'form.GD_'.$user.'_'.$_.'_awarded'}; 4642: my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1); 4643: my $partial = $awarded eq '' ? '' : $pcr; 4644: my $score; 4645: if ($partial eq '') { 4646: $score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}}; 4647: } elsif ($partial > 0) { 4648: $score = 'correct_by_override'; 4649: } elsif ($partial == 0) { 4650: $score = 'incorrect_by_override'; 4651: } 4652: my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'}; 4653: $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused')); 4654: 4655: $newrecord{'resource.'.$_.'.regrader'}= 4656: "$env{'user.name'}:$env{'user.domain'}"; 4657: if ($dropMenu eq 'reset status' && 4658: $old_score ne '') { # ignore if no previous attempts => nothing to reset 4659: $newrecord{'resource.'.$_.'.tries'} = ''; 4660: $newrecord{'resource.'.$_.'.solved'} = ''; 4661: $newrecord{'resource.'.$_.'.award'} = ''; 4662: $newrecord{'resource.'.$_.'.awarded'} = ''; 4663: $updateflag = 1; 4664: if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) { 4665: my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'}; 4666: my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'}; 4667: my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'}; 4668: &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus); 4669: $aggregateflag = 1; 4670: } 4671: } elsif (!($old_part eq $partial && $old_score eq $score)) { 4672: $updateflag = 1; 4673: $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; 4674: $newrecord{'resource.'.$_.'.solved'} = $score; 4675: $rec_update++; 4676: } 4677: 4678: $line .= '<td align="center">'.$old_aw.' </td>'. 4679: '<td align="center">'.$awarded. 4680: ($score eq 'excused' ? $score : '').' </td>'; 4681: 4682: 4683: my $partid=$_; 4684: foreach my $stores (@parts) { 4685: my ($part,$type) = &split_part_type($stores); 4686: if ($part !~ m/^\Q$partid\E/) { next;} 4687: if ($type eq 'awarded' || $type eq 'solved') { next; } 4688: my $old_aw = $env{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'}; 4689: my $awarded = $env{'form.GD_'.$user.'_'.$part.'_'.$type}; 4690: if ($awarded ne '' && $awarded ne $old_aw) { 4691: $newrecord{'resource.'.$part.'.'.$type}= $awarded; 4692: $newrecord{'resource.'.$part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; 4693: $updateflag=1; 4694: } 4695: $line .= '<td align="center">'.$old_aw.' </td>'. 4696: '<td align="center">'.$awarded.' </td>'; 4697: } 4698: } 4699: $line.="\n"; 4700: 4701: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 4702: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 4703: 4704: if ($updateflag) { 4705: $count++; 4706: &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'}, 4707: $udom,$uname); 4708: 4709: if (&Apache::bridgetask::in_queue('gradingqueue',$symb,$cdom, 4710: $cnum,$udom,$uname)) { 4711: # need to figure out if should be in queue. 4712: my %record = 4713: &Apache::lonnet::restore($symb,$env{'request.course.id'}, 4714: $udom,$uname); 4715: my $all_graded = 1; 4716: my $none_graded = 1; 4717: unless ($got_types) { 4718: my $error; 4719: my ($plist,$handgrd,$resptype) = &response_type($symb,\$error); 4720: unless ($error) { 4721: foreach my $part (@parts) { 4722: if (ref($resptype->{$part}) eq 'HASH') { 4723: foreach my $id (keys(%{$resptype->{$part}})) { 4724: if (($resptype->{$part}->{$id} eq 'essay') || 4725: (lc($handgrd->{$part.'_'.$id}) eq 'yes')) { 4726: $queueable{$part} = 1; 4727: last; 4728: } 4729: } 4730: } 4731: } 4732: } 4733: $got_types = 1; 4734: } 4735: foreach my $part (@parts) { 4736: if ($queueable{$part}) { 4737: if ( $record{'resource.'.$part.'.awarded'} eq '' ) { 4738: $all_graded = 0; 4739: } else { 4740: $none_graded = 0; 4741: } 4742: } 4743: } 4744: 4745: if ($all_graded || $none_graded) { 4746: &Apache::bridgetask::remove_from_queue('gradingqueue', 4747: $symb,$cdom,$cnum, 4748: $udom,$uname); 4749: } 4750: } 4751: 4752: $result.=&Apache::loncommon::start_data_table_row(). 4753: '<td align="right"> '.$updateCtr.' </td>'.$line. 4754: &Apache::loncommon::end_data_table_row(); 4755: $updateCtr++; 4756: } else { 4757: push(@noupdate, 4758: '<td align="right"> '.$noupdateCtr.' </td>'.$line); 4759: $noupdateCtr++; 4760: } 4761: if ($aggregateflag) { 4762: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 4763: $cdom,$cnum); 4764: } 4765: } 4766: if (@noupdate) { 4767: my $numcols=$totcolspan+2; 4768: $result .= &Apache::loncommon::start_data_table_row('LC_empty_row'). 4769: '<td align="center" colspan="'.$numcols.'">'. 4770: &mt('No Changes Occurred For the Students Below'). 4771: '</td>'. 4772: &Apache::loncommon::end_data_table_row(); 4773: foreach my $line (@noupdate) { 4774: $result.= 4775: &Apache::loncommon::start_data_table_row(). 4776: $line. 4777: &Apache::loncommon::end_data_table_row(); 4778: } 4779: } 4780: $result .= &Apache::loncommon::end_data_table(); 4781: my $msg = '<p><b>'. 4782: &mt('Number of records updated = [_1] for [quant,_2,student].', 4783: $rec_update,$count).'</b><br />'. 4784: '<b>'.&mt('Total number of students = [_1]',$env{'form.total'}). 4785: '</b></p>'; 4786: return $title.$msg.$result; 4787: } 4788: 4789: sub split_part_type { 4790: my ($partstr) = @_; 4791: my ($temp,@allparts)=split(/_/,$partstr); 4792: my $type=pop(@allparts); 4793: my $part=join('_',@allparts); 4794: return ($part,$type); 4795: } 4796: 4797: #------------- end of section for handling grading by section/class --------- 4798: # 4799: #---------------------------------------------------------------------------- 4800: 4801: 4802: #---------------------------------------------------------------------------- 4803: # 4804: #-------------------------- Next few routines handles grading by csv upload 4805: # 4806: #--- Javascript to handle csv upload 4807: sub csvupload_javascript_reverse_associate { 4808: my $error1=&mt('You need to specify the username or the student/employee ID'); 4809: my $error2=&mt('You need to specify at least one grading field'); 4810: &js_escape(\$error1); 4811: &js_escape(\$error2); 4812: return(<<ENDPICK); 4813: function verify(vf) { 4814: var foundsomething=0; 4815: var founduname=0; 4816: var foundID=0; 4817: for (i=0;i<=vf.nfields.value;i++) { 4818: tw=eval('vf.f'+i+'.selectedIndex'); 4819: if (i==0 && tw!=0) { foundID=1; } 4820: if (i==1 && tw!=0) { founduname=1; } 4821: if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; } 4822: } 4823: if (founduname==0 && foundID==0) { 4824: alert('$error1'); 4825: return; 4826: } 4827: if (foundsomething==0) { 4828: alert('$error2'); 4829: return; 4830: } 4831: vf.submit(); 4832: } 4833: function flip(vf,tf) { 4834: var nw=eval('vf.f'+tf+'.selectedIndex'); 4835: var i; 4836: for (i=0;i<=vf.nfields.value;i++) { 4837: //can not pick the same destination field for both name and domain 4838: if (((i ==0)||(i ==1)) && 4839: ((tf==0)||(tf==1)) && 4840: (i!=tf) && 4841: (eval('vf.f'+i+'.selectedIndex')==nw)) { 4842: eval('vf.f'+i+'.selectedIndex=0;') 4843: } 4844: } 4845: } 4846: ENDPICK 4847: } 4848: 4849: sub csvupload_javascript_forward_associate { 4850: my $error1=&mt('You need to specify the username or the student/employee ID'); 4851: my $error2=&mt('You need to specify at least one grading field'); 4852: &js_escape(\$error1); 4853: &js_escape(\$error2); 4854: return(<<ENDPICK); 4855: function verify(vf) { 4856: var foundsomething=0; 4857: var founduname=0; 4858: var foundID=0; 4859: for (i=0;i<=vf.nfields.value;i++) { 4860: tw=eval('vf.f'+i+'.selectedIndex'); 4861: if (tw==1) { foundID=1; } 4862: if (tw==2) { founduname=1; } 4863: if (tw>3) { foundsomething=1; } 4864: } 4865: if (founduname==0 && foundID==0) { 4866: alert('$error1'); 4867: return; 4868: } 4869: if (foundsomething==0) { 4870: alert('$error2'); 4871: return; 4872: } 4873: vf.submit(); 4874: } 4875: function flip(vf,tf) { 4876: var nw=eval('vf.f'+tf+'.selectedIndex'); 4877: var i; 4878: //can not pick the same destination field twice 4879: for (i=0;i<=vf.nfields.value;i++) { 4880: if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) { 4881: eval('vf.f'+i+'.selectedIndex=0;') 4882: } 4883: } 4884: } 4885: ENDPICK 4886: } 4887: 4888: sub csvuploadmap_header { 4889: my ($request,$symb,$datatoken,$distotal)= @_; 4890: my $javascript; 4891: if ($env{'form.upfile_associate'} eq 'reverse') { 4892: $javascript=&csvupload_javascript_reverse_associate(); 4893: } else { 4894: $javascript=&csvupload_javascript_forward_associate(); 4895: } 4896: 4897: my $checked=(($env{'form.noFirstLine'})?' checked="checked"':''); 4898: my $ignore=&mt('Ignore First Line'); 4899: $symb = &Apache::lonenc::check_encrypt($symb); 4900: $request->print('<form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">'. 4901: &mt('Total number of records found in file: [_1]',$distotal).'<hr />'. 4902: &mt('Associate entries from the uploaded file with as many fields as you can.')); 4903: my $reverse=&mt("Reverse Association"); 4904: $request->print(<<ENDPICK); 4905: <br /> 4906: <input type="button" value="$reverse" onclick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" /> 4907: <label><input type="checkbox" name="noFirstLine" $checked />$ignore</label> 4908: <input type="hidden" name="associate" value="" /> 4909: <input type="hidden" name="phase" value="three" /> 4910: <input type="hidden" name="datatoken" value="$datatoken" /> 4911: <input type="hidden" name="fileupload" value="$env{'form.fileupload'}" /> 4912: <input type="hidden" name="upfiletype" value="$env{'form.upfiletype'}" /> 4913: <input type="hidden" name="upfile_associate" 4914: value="$env{'form.upfile_associate'}" /> 4915: <input type="hidden" name="symb" value="$symb" /> 4916: <input type="hidden" name="command" value="csvuploadoptions" /> 4917: <hr /> 4918: ENDPICK 4919: $request->print(&Apache::lonhtmlcommon::scripttag($javascript)); 4920: return ''; 4921: 4922: } 4923: 4924: sub csvupload_fields { 4925: my ($symb,$errorref) = @_; 4926: my $toolsymb; 4927: if ($symb =~ /ext\.tool$/) { 4928: $toolsymb = $symb; 4929: } 4930: my (@parts) = &getpartlist($symb,$errorref); 4931: if (ref($errorref)) { 4932: if ($$errorref) { 4933: return; 4934: } 4935: } 4936: 4937: my @fields=(['ID','Student/Employee ID'], 4938: ['username','Student Username'], 4939: ['domain','Student Domain']); 4940: my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); 4941: foreach my $part (sort(@parts)) { 4942: my @datum; 4943: my $display=&Apache::lonnet::metadata($url,$part.'.display',$toolsymb); 4944: my $name=$part; 4945: if (!$display) { $display = $name; } 4946: @datum=($name,$display); 4947: if ($name=~/^stores_(.*)_awarded/) { 4948: push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]); 4949: } 4950: push(@fields,\@datum); 4951: } 4952: return (@fields); 4953: } 4954: 4955: sub csvuploadmap_footer { 4956: my ($request,$i,$keyfields) =@_; 4957: my $buttontext = &mt('Assign Grades'); 4958: $request->print(<<ENDPICK); 4959: </table> 4960: <input type="hidden" name="nfields" value="$i" /> 4961: <input type="hidden" name="keyfields" value="$keyfields" /> 4962: <input type="button" onclick="javascript:verify(this.form)" value="$buttontext" /><br /> 4963: </form> 4964: ENDPICK 4965: } 4966: 4967: sub checkforfile_js { 4968: my $alertmsg = &mt('Please use the browse button to select a file from your local directory.'); 4969: &js_escape(\$alertmsg); 4970: my $result = &Apache::lonhtmlcommon::scripttag(<<CSVFORMJS); 4971: function checkUpload(formname) { 4972: if (formname.upfile.value == "") { 4973: alert("$alertmsg"); 4974: return false; 4975: } 4976: formname.submit(); 4977: } 4978: CSVFORMJS 4979: return $result; 4980: } 4981: 4982: sub upcsvScores_form { 4983: my ($request,$symb) = @_; 4984: if (!$symb) {return '';} 4985: my $result=&checkforfile_js(); 4986: $result.=&Apache::loncommon::start_data_table(). 4987: &Apache::loncommon::start_data_table_header_row(). 4988: '<th>'.&mt('Specify a file containing the class scores for current resource.').'</th>'. 4989: &Apache::loncommon::end_data_table_header_row(). 4990: &Apache::loncommon::start_data_table_row().'<td>'; 4991: my $upload=&mt("Upload Scores"); 4992: my $upfile_select=&Apache::loncommon::upfile_select_html(); 4993: my $ignore=&mt('Ignore First Line'); 4994: $symb = &Apache::lonenc::check_encrypt($symb); 4995: $result.=<<ENDUPFORM; 4996: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 4997: <input type="hidden" name="symb" value="$symb" /> 4998: <input type="hidden" name="command" value="csvuploadmap" /> 4999: $upfile_select 5000: <br /><input type="button" onclick="javascript:checkUpload(this.form);" value="$upload" /> 5001: <label><input type="checkbox" name="noFirstLine" />$ignore</label> 5002: </form> 5003: ENDUPFORM 5004: $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV", 5005: &mt("How do I create a CSV file from a spreadsheet")). 5006: '</td>'. 5007: &Apache::loncommon::end_data_table_row(). 5008: &Apache::loncommon::end_data_table(); 5009: return $result; 5010: } 5011: 5012: 5013: sub csvuploadmap { 5014: my ($request,$symb) = @_; 5015: if (!$symb) {return '';} 5016: 5017: my $datatoken; 5018: if (!$env{'form.datatoken'}) { 5019: $datatoken=&Apache::loncommon::upfile_store($request); 5020: } else { 5021: $datatoken=&Apache::loncommon::valid_datatoken($env{'form.datatoken'}); 5022: if ($datatoken ne '') { 5023: &Apache::loncommon::load_tmp_file($request,$datatoken); 5024: } 5025: } 5026: my @records=&Apache::loncommon::upfile_record_sep(); 5027: if ($env{'form.noFirstLine'}) { shift(@records); } 5028: &csvuploadmap_header($request,$symb,$datatoken,$#records+1); 5029: my ($i,$keyfields); 5030: if (@records) { 5031: my $fieldserror; 5032: my @fields=&csvupload_fields($symb,\$fieldserror); 5033: if ($fieldserror) { 5034: $request->print(&navmap_errormsg()); 5035: return; 5036: } 5037: if ($env{'form.upfile_associate'} eq 'reverse') { 5038: &Apache::loncommon::csv_print_samples($request,\@records); 5039: $i=&Apache::loncommon::csv_print_select_table($request,\@records, 5040: \@fields); 5041: foreach (@fields) { $keyfields.=$_->[0].','; } 5042: chop($keyfields); 5043: } else { 5044: unshift(@fields,['none','']); 5045: $i=&Apache::loncommon::csv_samples_select_table($request,\@records, 5046: \@fields); 5047: foreach my $rec (@records) { 5048: my %temp = &Apache::loncommon::record_sep($rec); 5049: if (%temp) { 5050: $keyfields=join(',',sort(keys(%temp))); 5051: last; 5052: } 5053: } 5054: } 5055: } 5056: &csvuploadmap_footer($request,$i,$keyfields); 5057: 5058: return ''; 5059: } 5060: 5061: sub csvuploadoptions { 5062: my ($request,$symb)= @_; 5063: my $overwrite=&mt('Overwrite any existing score'); 5064: my $checked=(($env{'form.noFirstLine'})?'1':'0'); 5065: my $ignore=&mt('Ignore First Line'); 5066: $request->print(<<ENDPICK); 5067: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 5068: <input type="hidden" name="command" value="csvuploadassign" /> 5069: <p> 5070: <label> 5071: <input type="checkbox" name="overwite_scores" checked="checked" /> 5072: $overwrite 5073: </label> 5074: </p> 5075: ENDPICK 5076: my %fields=&get_fields(); 5077: if (!defined($fields{'domain'})) { 5078: my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); 5079: $request->print("\n<p>".&mt('Users are in domain: [_1]',$domform)."</p>\n"); 5080: } 5081: foreach my $key (sort(keys(%env))) { 5082: if ($key !~ /^form\.(.*)$/) { next; } 5083: my $cleankey=$1; 5084: if ($cleankey eq 'command') { next; } 5085: $request->print('<input type="hidden" name="'.$cleankey. 5086: '" value="'.$env{$key}.'" />'."\n"); 5087: } 5088: # FIXME do a check for any duplicated user ids... 5089: # FIXME do a check for any invalid user ids?... 5090: $request->print('<input type="submit" value="'.&mt('Assign Grades').'" /><br /> 5091: <hr /></form>'."\n"); 5092: return ''; 5093: } 5094: 5095: sub get_fields { 5096: my %fields; 5097: my @keyfields = split(/\,/,$env{'form.keyfields'}); 5098: for (my $i=0; $i<=$env{'form.nfields'}; $i++) { 5099: if ($env{'form.upfile_associate'} eq 'reverse') { 5100: if ($env{'form.f'.$i} ne 'none') { 5101: $fields{$keyfields[$i]}=$env{'form.f'.$i}; 5102: } 5103: } else { 5104: if ($env{'form.f'.$i} ne 'none') { 5105: $fields{$env{'form.f'.$i}}=$keyfields[$i]; 5106: } 5107: } 5108: } 5109: return %fields; 5110: } 5111: 5112: sub csvuploadassign { 5113: my ($request,$symb) = @_; 5114: if (!$symb) {return '';} 5115: my $error_msg = ''; 5116: my $datatoken = &Apache::loncommon::valid_datatoken($env{'form.datatoken'}); 5117: if ($datatoken ne '') { 5118: &Apache::loncommon::load_tmp_file($request,$datatoken); 5119: } 5120: my @gradedata = &Apache::loncommon::upfile_record_sep(); 5121: if ($env{'form.noFirstLine'}) { shift(@gradedata); } 5122: my %fields=&get_fields(); 5123: my $courseid=$env{'request.course.id'}; 5124: my ($classlist) = &getclasslist('all',0); 5125: my @notallowed; 5126: my @skipped; 5127: my @warnings; 5128: my $countdone=0; 5129: foreach my $grade (@gradedata) { 5130: my %entries=&Apache::loncommon::record_sep($grade); 5131: my $domain; 5132: if ($entries{$fields{'domain'}}) { 5133: $domain=$entries{$fields{'domain'}}; 5134: } else { 5135: $domain=$env{'form.default_domain'}; 5136: } 5137: $domain=~s/\s//g; 5138: my $username=$entries{$fields{'username'}}; 5139: $username=~s/\s//g; 5140: if (!$username) { 5141: my $id=$entries{$fields{'ID'}}; 5142: $id=~s/\s//g; 5143: my %ids=&Apache::lonnet::idget($domain,$id); 5144: $username=$ids{$id}; 5145: } 5146: if (!exists($$classlist{"$username:$domain"})) { 5147: my $id=$entries{$fields{'ID'}}; 5148: $id=~s/\s//g; 5149: if ($id) { 5150: push(@skipped,"$id:$domain"); 5151: } else { 5152: push(@skipped,"$username:$domain"); 5153: } 5154: next; 5155: } 5156: my $usec=$classlist->{"$username:$domain"}[5]; 5157: if (!&canmodify($usec)) { 5158: push(@notallowed,"$username:$domain"); 5159: next; 5160: } 5161: my %points; 5162: my %grades; 5163: foreach my $dest (keys(%fields)) { 5164: if ($dest eq 'ID' || $dest eq 'username' || 5165: $dest eq 'domain') { next; } 5166: if ($entries{$fields{$dest}} =~ /^\s*$/) { next; } 5167: if ($dest=~/stores_(.*)_points/) { 5168: my $part=$1; 5169: my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', 5170: $symb,$domain,$username); 5171: if ($wgt) { 5172: $entries{$fields{$dest}}=~s/\s//g; 5173: my $pcr=$entries{$fields{$dest}} / $wgt; 5174: my $award=($pcr == 0) ? 'incorrect_by_override' 5175: : 'correct_by_override'; 5176: if ($pcr>1) { 5177: push(@warnings,&mt("[_1]: point value larger than weight","$username:$domain")); 5178: } 5179: $grades{"resource.$part.awarded"}=$pcr; 5180: $grades{"resource.$part.solved"}=$award; 5181: $points{$part}=1; 5182: } else { 5183: $error_msg = "<br />" . 5184: &mt("Some point values were assigned" 5185: ." for problems with a weight " 5186: ."of zero. These values were " 5187: ."ignored."); 5188: } 5189: } else { 5190: if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } 5191: if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } 5192: my $store_key=$dest; 5193: $store_key=~s/^stores/resource/; 5194: $store_key=~s/_/\./g; 5195: $grades{$store_key}=$entries{$fields{$dest}}; 5196: } 5197: } 5198: if (! %grades) { 5199: push(@skipped,&mt("[_1]: no data to save","$username:$domain")); 5200: } else { 5201: $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; 5202: my $result=&Apache::lonnet::cstore(\%grades,$symb, 5203: $env{'request.course.id'}, 5204: $domain,$username); 5205: if ($result eq 'ok') { 5206: # Successfully stored 5207: $request->print('.'); 5208: # Remove from grading queue 5209: &Apache::bridgetask::remove_from_queue('gradingqueue',$symb, 5210: $env{'course.'.$env{'request.course.id'}.'.domain'}, 5211: $env{'course.'.$env{'request.course.id'}.'.num'}, 5212: $domain,$username); 5213: } else { 5214: $request->print("<p><span class=\"LC_error\">". 5215: &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", 5216: "$username:$domain",$result)."</span></p>"); 5217: } 5218: $request->rflush(); 5219: $countdone++; 5220: } 5221: } 5222: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0)); 5223: if (@warnings) { 5224: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('Warnings generated for the following saved scores:'),1).'<br />'); 5225: $request->print(join(', ',@warnings)); 5226: } 5227: if (@skipped) { 5228: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('No scores stored for the following username(s):'),1).'<br />'); 5229: $request->print(join(', ',@skipped)); 5230: } 5231: if (@notallowed) { 5232: $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('Modification of scores not allowed for the following username(s):'),1).'<br />'); 5233: $request->print(join(', ',@notallowed)); 5234: } 5235: $request->print("<br />\n"); 5236: return $error_msg; 5237: } 5238: #------------- end of section for handling csv file upload --------- 5239: # 5240: #------------------------------------------------------------------- 5241: # 5242: #-------------- Next few routines handle grading by page/sequence 5243: # 5244: #--- Select a page/sequence and a student to grade 5245: sub pickStudentPage { 5246: my ($request,$symb) = @_; 5247: 5248: my $alertmsg = &mt('Please select the student you wish to grade.'); 5249: &js_escape(\$alertmsg); 5250: $request->print(&Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT)); 5251: 5252: function checkPickOne(formname) { 5253: if (radioSelection(formname.student) == null) { 5254: alert("$alertmsg"); 5255: return; 5256: } 5257: ptr = pullDownSelection(formname.selectpage); 5258: formname.page.value = formname["page"+ptr].value; 5259: formname.title.value = formname["title"+ptr].value; 5260: formname.submit(); 5261: } 5262: 5263: LISTJAVASCRIPT 5264: &commonJSfunctions($request); 5265: 5266: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 5267: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 5268: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 5269: my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; 5270: 5271: my $result='<h3><span class="LC_info"> '. 5272: &mt('Manual Grading by Page or Sequence').'</span></h3>'; 5273: 5274: $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n"; 5275: my $map_error; 5276: my ($titles,$symbx) = &getSymbMap($map_error); 5277: if ($map_error) { 5278: $request->print(&navmap_errormsg()); 5279: return; 5280: } 5281: my ($curpage) =&Apache::lonnet::decode_symb($symb); 5282: # my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 5283: # my $type=($curpage =~ /\.(page|sequence)/); 5284: 5285: # Collection of hidden fields 5286: my $ctr=0; 5287: foreach (@$titles) { 5288: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 5289: $result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n"; 5290: $result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n"; 5291: $ctr++; 5292: } 5293: $result.='<input type="hidden" name="page" />'."\n". 5294: '<input type="hidden" name="title" />'."\n"; 5295: 5296: $result.=&build_section_inputs(); 5297: my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); 5298: $result.='<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". 5299: '<input type="hidden" name="command" value="displayPage" />'."\n". 5300: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 5301: 5302: # Show grading options 5303: $result.=&Apache::lonhtmlcommon::start_pick_box(); 5304: my $select = '<select name="selectpage">'."\n"; 5305: $ctr=0; 5306: foreach (@$titles) { 5307: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 5308: $select.='<option value="'.$ctr.'"'. 5309: ($$symbx{$_} =~ /$curpage$/ ? ' selected="selected"' : ''). 5310: '>'.$showtitle.'</option>'."\n"; 5311: $ctr++; 5312: } 5313: $select.= '</select>'; 5314: 5315: $result.= 5316: &Apache::lonhtmlcommon::row_title(&mt('Problems from')) 5317: .$select 5318: .&Apache::lonhtmlcommon::row_closure(); 5319: 5320: $result.= 5321: &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) 5322: .'<label><input type="radio" name="vProb" value="no"' 5323: .' checked="checked" /> '.&mt('no').' </label>'."\n" 5324: .'<label><input type="radio" name="vProb" value="yes" />' 5325: .&mt('yes').'</label>'."\n" 5326: .&Apache::lonhtmlcommon::row_closure(); 5327: 5328: $result.= 5329: &Apache::lonhtmlcommon::row_title(&mt('View Submissions')) 5330: .'<label><input type="radio" name="lastSub" value="none" /> ' 5331: .&mt('none').' </label>'."\n" 5332: .'<label><input type="radio" name="lastSub" value="datesub"' 5333: .' checked="checked" /> '.&mt('all submissions').'</label>'."\n" 5334: .'<label><input type="radio" name="lastSub" value="all" /> ' 5335: .&mt('all submissions with details').' </label>' 5336: .&Apache::lonhtmlcommon::row_closure(); 5337: 5338: $result.= 5339: &Apache::lonhtmlcommon::row_title(&mt('Use CODE')) 5340: .'<input type="text" name="CODE" value="" />' 5341: .&Apache::lonhtmlcommon::row_closure(1) 5342: .&Apache::lonhtmlcommon::end_pick_box(); 5343: 5344: # Show list of students to select for grading 5345: $result.='<br /><input type="button" '. 5346: 'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /><br />'."\n"; 5347: 5348: $request->print($result); 5349: 5350: my $studentTable.=' <b>'.&mt('Select a student you wish to grade and then click on the Next button.').'</b><br />'. 5351: &Apache::loncommon::start_data_table(). 5352: &Apache::loncommon::start_data_table_header_row(). 5353: '<th align="right"> '.&mt('No.').'</th>'. 5354: '<th>'.&nameUserString('header').'</th>'. 5355: '<th align="right"> '.&mt('No.').'</th>'. 5356: '<th>'.&nameUserString('header').'</th>'. 5357: &Apache::loncommon::end_data_table_header_row(); 5358: 5359: my (undef,undef,$fullname) = &getclasslist($getsec,'1',$getgroup); 5360: my $ptr = 1; 5361: foreach my $student (sort 5362: { 5363: if (lc($$fullname{$a}) ne lc($$fullname{$b})) { 5364: return (lc($$fullname{$a}) cmp lc($$fullname{$b})); 5365: } 5366: return $a cmp $b; 5367: } (keys(%$fullname))) { 5368: my ($uname,$udom) = split(/:/,$student); 5369: $studentTable.=($ptr%2==1 ? &Apache::loncommon::start_data_table_row() 5370: : '</td>'); 5371: $studentTable.='<td align="right">'.$ptr.' </td>'; 5372: $studentTable.='<td> <label><input type="radio" name="student" value="'.$student.'" /> ' 5373: .&nameUserString(undef,$$fullname{$student},$uname,$udom)."</label>\n"; 5374: $studentTable.= 5375: ($ptr%2 == 0 ? '</td>'.&Apache::loncommon::end_data_table_row() 5376: : ''); 5377: $ptr++; 5378: } 5379: if ($ptr%2 == 0) { 5380: $studentTable.='</td><td> </td><td> </td>'. 5381: &Apache::loncommon::end_data_table_row(); 5382: } 5383: $studentTable.=&Apache::loncommon::end_data_table()."\n"; 5384: $studentTable.='<input type="button" '. 5385: 'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /></form>'."\n"; 5386: 5387: $request->print($studentTable); 5388: 5389: return ''; 5390: } 5391: 5392: sub getSymbMap { 5393: my ($map_error) = @_; 5394: my $navmap = Apache::lonnavmaps::navmap->new(); 5395: unless (ref($navmap)) { 5396: if (ref($map_error)) { 5397: $$map_error = 'navmap'; 5398: } 5399: return; 5400: } 5401: my %symbx = (); 5402: my @titles = (); 5403: my $minder = 0; 5404: 5405: # Gather every sequence that has problems. 5406: my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 5407: 1,0,1); 5408: for my $sequence ($navmap->getById('0.0'), @sequences) { 5409: if ($navmap->hasResource($sequence, sub { shift->is_gradable(); }, 0) ) { 5410: my $title = $minder.'.'. 5411: &HTML::Entities::encode($sequence->compTitle(),'"\'&'); 5412: push(@titles, $title); # minder in case two titles are identical 5413: $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); 5414: $minder++; 5415: } 5416: } 5417: return \@titles,\%symbx; 5418: } 5419: 5420: # 5421: #--- Displays a page/sequence w/wo problems, w/wo submissions 5422: sub displayPage { 5423: my ($request,$symb) = @_; 5424: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 5425: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 5426: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 5427: my $pageTitle = $env{'form.page'}; 5428: my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); 5429: my ($uname,$udom) = split(/:/,$env{'form.student'}); 5430: my $usec=$classlist->{$env{'form.student'}}[5]; 5431: 5432: #need to make sure we have the correct data for later EXT calls, 5433: #thus invalidate the cache 5434: &Apache::lonnet::devalidatecourseresdata( 5435: $env{'course.'.$env{'request.course.id'}.'.num'}, 5436: $env{'course.'.$env{'request.course.id'}.'.domain'}); 5437: &Apache::lonnet::clear_EXT_cache_status(); 5438: 5439: if (!&canview($usec)) { 5440: $request->print( 5441: '<span class="LC_warning">'. 5442: &mt('Unable to view requested student. ([_1])', 5443: $env{'form.student'}). 5444: '</span>'); 5445: return; 5446: } 5447: my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; 5448: $result.='<h3> '.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)). 5449: '</h3>'."\n"; 5450: $env{'form.CODE'} = uc($env{'form.CODE'}); 5451: if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) { 5452: $result.='<h3> '.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n"; 5453: } else { 5454: delete($env{'form.CODE'}); 5455: } 5456: &sub_page_js($request); 5457: $request->print($result); 5458: 5459: my $navmap = Apache::lonnavmaps::navmap->new(); 5460: unless (ref($navmap)) { 5461: $request->print(&navmap_errormsg()); 5462: return; 5463: } 5464: my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'}); 5465: my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps 5466: if (!$map) { 5467: $request->print('<span class="LC_warning">'.&mt('Unable to view requested sequence. ([_1])',$resUrl).'</span>'); 5468: return; 5469: } 5470: my $iterator = $navmap->getIterator($map->map_start(), 5471: $map->map_finish()); 5472: 5473: my $studentTable='<form action="/adm/grades" method="post" name="gradePage">'."\n". 5474: '<input type="hidden" name="command" value="gradeByPage" />'."\n". 5475: '<input type="hidden" name="fullname" value="'.$$fullname{$env{'form.student'}}.'" />'."\n". 5476: '<input type="hidden" name="student" value="'.$env{'form.student'}.'" />'."\n". 5477: '<input type="hidden" name="page" value="'.$pageTitle.'" />'."\n". 5478: '<input type="hidden" name="title" value="'.$env{'form.title'}.'" />'."\n". 5479: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". 5480: '<input type="hidden" name="overRideScore" value="no" />'."\n"; 5481: 5482: if (defined($env{'form.CODE'})) { 5483: $studentTable.= 5484: '<input type="hidden" name="CODE" value="'.$env{'form.CODE'}.'" />'."\n"; 5485: } 5486: my $checkIcon = '<img alt="'.&mt('Check Mark'). 5487: '" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />'; 5488: 5489: $studentTable.=' <span class="LC_info">'. 5490: &mt('Problems graded correct by the computer are marked with a [_1] symbol.',$checkIcon). 5491: '</span>'."\n". 5492: &Apache::loncommon::start_data_table(). 5493: &Apache::loncommon::start_data_table_header_row(). 5494: '<th>'.&mt('Prob.').'</th>'. 5495: '<th> '.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').'</th>'. 5496: &Apache::loncommon::end_data_table_header_row(); 5497: 5498: &Apache::lonxml::clear_problem_counter(); 5499: my ($depth,$question,$prob) = (1,1,1); 5500: $iterator->next(); # skip the first BEGIN_MAP 5501: my $curRes = $iterator->next(); # for "current resource" 5502: while ($depth > 0) { 5503: if($curRes == $iterator->BEGIN_MAP) { $depth++; } 5504: if($curRes == $iterator->END_MAP) { $depth--; } 5505: 5506: if (ref($curRes) && $curRes->is_gradable()) { 5507: my $parts = $curRes->parts(); 5508: my $title = $curRes->compTitle(); 5509: my $symbx = $curRes->symb(); 5510: my $is_tool = ($symbx =~ /ext\.tool$/); 5511: $studentTable.= 5512: &Apache::loncommon::start_data_table_row(). 5513: '<td align="center" valign="top" >'.$prob. 5514: (scalar(@{$parts}) == 1 ? '' 5515: : '<br />('.&mt('[_1]parts', 5516: scalar(@{$parts}).' ').')' 5517: ). 5518: '</td>'; 5519: $studentTable.='<td valign="top">'; 5520: my %form = ('CODE' => $env{'form.CODE'},); 5521: if ($is_tool) { 5522: $studentTable.=' <b>'.$title.'</b><br />'; 5523: } else { 5524: if ($env{'form.vProb'} eq 'yes' ) { 5525: $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, 5526: undef,'both',\%form); 5527: } else { 5528: my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form); 5529: $companswer =~ s|<form(.*?)>||g; 5530: $companswer =~ s|</form>||g; 5531: # while ($companswer =~ /(<a href\=\"javascript:newWindow.*?Script Vars<\/a>)/s) { #<a href="javascript:newWindow</a> 5532: # $companswer =~ s/$1/ /ms; 5533: # $request->print('match='.$1."<br />\n"); 5534: # } 5535: # $companswer =~ s|<table border=\"1\">|<table border=\"0\">|g; 5536: $studentTable.=' <b>'.$title.'</b> <br /> <b>'.&mt('Correct answer').':</b><br />'.$companswer; 5537: } 5538: } 5539: 5540: my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); 5541: 5542: if ($env{'form.lastSub'} eq 'datesub') { 5543: if ($record{'version'} eq '') { 5544: my $msg = &mt('No recorded submission for this problem.'); 5545: if ($is_tool) { 5546: $msg = &mt('No recorded transactions for this external tool'); 5547: } 5548: $studentTable.='<br /> <span class="LC_warning">'.$msg.'</span><br />'; 5549: } else { 5550: my %responseType = (); 5551: foreach my $partid (@{$parts}) { 5552: my @responseIds =$curRes->responseIds($partid); 5553: my @responseType =$curRes->responseType($partid); 5554: my %responseIds; 5555: for (my $i=0;$i<=$#responseIds;$i++) { 5556: $responseIds{$responseIds[$i]}=$responseType[$i]; 5557: } 5558: $responseType{$partid} = \%responseIds; 5559: } 5560: $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom); 5561: 5562: } 5563: } elsif ($env{'form.lastSub'} eq 'all') { 5564: my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); 5565: my $identifier = (&canmodify($usec)? $prob : ''); 5566: $studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom, 5567: $env{'request.course.id'}, 5568: '','.submission',undef, 5569: $usec,$identifier); 5570: 5571: } 5572: if (&canmodify($usec)) { 5573: $studentTable.=&gradeBox_start(); 5574: foreach my $partid (@{$parts}) { 5575: $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record); 5576: $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n"; 5577: $question++; 5578: } 5579: $studentTable.=&gradeBox_end(); 5580: $prob++; 5581: } 5582: $studentTable.='</td></tr>'; 5583: 5584: } 5585: $curRes = $iterator->next(); 5586: } 5587: my $disabled; 5588: unless (&canmodify($usec)) { 5589: $disabled = ' disabled="disabled"'; 5590: } 5591: 5592: $studentTable.= 5593: '</table>'."\n". 5594: '<input type="button" value="'.&mt('Save').'"'.$disabled.' '. 5595: 'onclick="javascript:checkSubmitPage(this.form,'.$question.');" />'. 5596: '</form>'."\n"; 5597: $request->print($studentTable); 5598: 5599: return ''; 5600: } 5601: 5602: sub displaySubByDates { 5603: my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; 5604: my $isCODE=0; 5605: my $isTask = ($symb =~/\.task$/); 5606: my $is_tool = ($symb =~/\.tool$/); 5607: if (exists($record->{'resource.CODE'})) { $isCODE=1; } 5608: my $studentTable=&Apache::loncommon::start_data_table(). 5609: &Apache::loncommon::start_data_table_header_row(). 5610: '<th>'.&mt('Date/Time').'</th>'. 5611: ($isCODE?'<th>'.&mt('CODE').'</th>':''). 5612: ($isTask?'<th>'.&mt('Version').'</th>':''). 5613: '<th>'.($is_tool?&mt('Grade'):&mt('Submission')).'</th>'. 5614: '<th>'.&mt('Status').'</th>'. 5615: &Apache::loncommon::end_data_table_header_row(); 5616: my ($version); 5617: my %mark; 5618: my %orders; 5619: $mark{'correct_by_student'} = $checkIcon; 5620: if (!exists($$record{'1:timestamp'})) { 5621: if ($is_tool) { 5622: return '<br /> <span class="LC_warning">'.&mt('No grade passed back.').'</span><br />'; 5623: } else { 5624: return '<br /> <span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br />'; 5625: } 5626: } 5627: 5628: my $interaction; 5629: my $no_increment = 1; 5630: my (%lastrndseed,%lasttype); 5631: for ($version=1;$version<=$$record{'version'};$version++) { 5632: my $timestamp = 5633: &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'}); 5634: if (exists($$record{$version.':resource.0.version'})) { 5635: $interaction = $$record{$version.':resource.0.version'}; 5636: } 5637: if ($isTask && $env{'form.previousversion'}) { 5638: next unless ($interaction == $env{'form.previousversion'}); 5639: } 5640: my $where = ($isTask ? "$version:resource.$interaction" 5641: : "$version:resource"); 5642: $studentTable.=&Apache::loncommon::start_data_table_row(). 5643: '<td>'.$timestamp.'</td>'; 5644: if ($isCODE) { 5645: $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>'; 5646: } 5647: if ($isTask) { 5648: $studentTable.='<td>'.$interaction.'</td>'; 5649: } 5650: my @versionKeys = split(/\:/,$$record{$version.':keys'}); 5651: my @displaySub = (); 5652: foreach my $partid (@{$parts}) { 5653: my ($hidden,$type); 5654: $type = $$record{$version.':resource.'.$partid.'.type'}; 5655: if (($type eq 'anonsurvey') || ($type eq 'anonsurveycred')) { 5656: $hidden = 1; 5657: } 5658: my @matchKey; 5659: if ($isTask) { 5660: @matchKey = sort(grep(/^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)); 5661: } elsif ($is_tool) { 5662: @matchKey = sort(grep(/^resource\.\Q$partid\E\.awarded$/,@versionKeys)); 5663: } else { 5664: @matchKey = sort(grep(/^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); 5665: } 5666: # next if ($$record{"$version:resource.$partid.solved"} eq ''); 5667: my $display_part=&get_display_part($partid,$symb); 5668: foreach my $matchKey (@matchKey) { 5669: if (exists($$record{$version.':'.$matchKey}) && 5670: $$record{$version.':'.$matchKey} ne '') { 5671: if ($is_tool) { 5672: $displaySub[0].=$$record{"$version:resource.$partid.awarded"}; 5673: } else { 5674: my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) 5675: : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); 5676: $displaySub[0].='<span class="LC_nobreak">'; 5677: $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>' 5678: .' <span class="LC_internal_info">' 5679: .'('.&mt('Response ID: [_1]',$responseId).')' 5680: .'</span>' 5681: .' <b>'; 5682: if ($hidden) { 5683: $displaySub[0].= &mt('Anonymous Survey').'</b>'; 5684: } else { 5685: my ($trial,$rndseed,$newvariation); 5686: if ($type eq 'randomizetry') { 5687: $trial = $$record{"$where.$partid.tries"}; 5688: $rndseed = $$record{"$where.$partid.rndseed"}; 5689: } 5690: if ($$record{"$where.$partid.tries"} eq '') { 5691: $displaySub[0].=&mt('Trial not counted'); 5692: } else { 5693: $displaySub[0].=&mt('Trial: [_1]', 5694: $$record{"$where.$partid.tries"}); 5695: if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) { 5696: if (($rndseed ne $lastrndseed{$partid}) && 5697: (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) { 5698: $newvariation = ' ('.&mt('New variation this try').')'; 5699: } 5700: } 5701: $lastrndseed{$partid} = $rndseed; 5702: $lasttype{$partid} = $type; 5703: } 5704: my $responseType=($isTask ? 'Task' 5705: : $responseType->{$partid}->{$responseId}); 5706: if (!exists($orders{$partid})) { $orders{$partid}={}; } 5707: if ((!exists($orders{$partid}->{$responseId})) || ($trial)) { 5708: $orders{$partid}->{$responseId}= 5709: &get_order($partid,$responseId,$symb,$uname,$udom, 5710: $no_increment,$type,$trial,$rndseed); 5711: } 5712: $displaySub[0].='</b>'.$newvariation.'</span>'; # /nobreak 5713: $displaySub[0].='  '. 5714: &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'<br />'; 5715: } 5716: } 5717: } 5718: } 5719: if (exists($$record{"$where.$partid.checkedin"})) { 5720: $displaySub[1].=&mt('Checked in by [_1] into slot [_2]', 5721: $$record{"$where.$partid.checkedin"}, 5722: $$record{"$where.$partid.checkedin.slot"}). 5723: '<br />'; 5724: } 5725: if (exists $$record{"$where.$partid.award"}) { 5726: $displaySub[1].='<b>'.&mt('Part:').'</b> '.$display_part.'  '. 5727: lc($$record{"$where.$partid.award"}).' '. 5728: $mark{$$record{"$where.$partid.solved"}}. 5729: '<br />'; 5730: } elsif (($is_tool) && (exists($$record{"$version:resource.$partid.solved"}))) { 5731: if ($$record{"$version:resource.$partid.solved"} =~ /^(in|)correct_by_passback$/) { 5732: $displaySub[1].=&mt('Grade passed back by external tool'); 5733: } 5734: } 5735: if (exists $$record{"$where.$partid.regrader"}) { 5736: $displaySub[2].=$$record{"$where.$partid.regrader"}; 5737: unless ($is_tool) { 5738: $displaySub[2].=' (<b>'.&mt('Part').':</b> '.$display_part.')'; 5739: } 5740: } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { 5741: $displaySub[2].= 5742: $$record{"$version:resource.$partid.regrader"}; 5743: unless ($is_tool) { 5744: $displaySub[2].=' (<b>'.&mt('Part').':</b> '.$display_part.')'; 5745: } 5746: } 5747: } 5748: # needed because old essay regrader has not parts info 5749: if (exists $$record{"$version:resource.regrader"}) { 5750: $displaySub[2].=$$record{"$version:resource.regrader"}; 5751: } 5752: $studentTable.='<td>'.$displaySub[0].' </td><td>'.$displaySub[1]; 5753: if ($displaySub[2]) { 5754: $studentTable.=&mt('Manually graded by [_1]',$displaySub[2]); 5755: } 5756: $studentTable.=' </td>'. 5757: &Apache::loncommon::end_data_table_row(); 5758: } 5759: $studentTable.=&Apache::loncommon::end_data_table(); 5760: return $studentTable; 5761: } 5762: 5763: sub updateGradeByPage { 5764: my ($request,$symb) = @_; 5765: 5766: my $cdom = $env{"course.$env{'request.course.id'}.domain"}; 5767: my $cnum = $env{"course.$env{'request.course.id'}.num"}; 5768: my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; 5769: my $pageTitle = $env{'form.page'}; 5770: my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); 5771: my ($uname,$udom) = split(/:/,$env{'form.student'}); 5772: my $usec=$classlist->{$env{'form.student'}}[5]; 5773: if (!&canmodify($usec)) { 5774: $request->print('<span class="LC_warning">'.&mt('Unable to modify requested student ([_1])',$env{'form.student'}).'</span>'); 5775: return; 5776: } 5777: my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; 5778: $result.='<h3> '.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom). 5779: '</h3>'."\n"; 5780: 5781: $request->print($result); 5782: 5783: 5784: my $navmap = Apache::lonnavmaps::navmap->new(); 5785: unless (ref($navmap)) { 5786: $request->print(&navmap_errormsg()); 5787: return; 5788: } 5789: my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'}); 5790: my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps 5791: if (!$map) { 5792: $request->print('<span class="LC_warning">'.&mt('Unable to grade requested sequence ([_1]).',$resUrl).'</span>'); 5793: return; 5794: } 5795: my $iterator = $navmap->getIterator($map->map_start(), 5796: $map->map_finish()); 5797: 5798: my $studentTable= 5799: &Apache::loncommon::start_data_table(). 5800: &Apache::loncommon::start_data_table_header_row(). 5801: '<th align="center"> '.&mt('Prob.').' </th>'. 5802: '<th> '.&mt('Title').' </th>'. 5803: '<th> '.&mt('Previous Score').' </th>'. 5804: '<th> '.&mt('New Score').' </th>'. 5805: &Apache::loncommon::end_data_table_header_row(); 5806: 5807: $iterator->next(); # skip the first BEGIN_MAP 5808: my $curRes = $iterator->next(); # for "current resource" 5809: my ($depth,$question,$prob,$changeflag,$hideflag)= (1,1,1,0,0); 5810: while ($depth > 0) { 5811: if($curRes == $iterator->BEGIN_MAP) { $depth++; } 5812: if($curRes == $iterator->END_MAP) { $depth--; } 5813: 5814: if (ref($curRes) && $curRes->is_problem()) { 5815: my $parts = $curRes->parts(); 5816: my $title = $curRes->compTitle(); 5817: my $symbx = $curRes->symb(); 5818: $studentTable.= 5819: &Apache::loncommon::start_data_table_row(). 5820: '<td align="center" valign="top" >'.$prob. 5821: (scalar(@{$parts}) == 1 ? '' 5822: : '<br />('.&mt('[quant,_1,part]',scalar(@{$parts})) 5823: .')').'</td>'; 5824: $studentTable.='<td valign="top"> <b>'.$title.'</b> </td>'; 5825: 5826: my %newrecord=(); 5827: my @displayPts=(); 5828: my %aggregate = (); 5829: my $aggregateflag = 0; 5830: my %queueable; 5831: if ($env{'form.HIDE'.$prob}) { 5832: my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); 5833: my ($version,$parts) = split(/:/,$env{'form.HIDE'.$prob},2); 5834: my $numchgs = &makehidden($version,$parts,\%record,$symbx,$udom,$uname,1); 5835: $hideflag += $numchgs; 5836: } 5837: foreach my $partid (@{$parts}) { 5838: my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid}; 5839: my $oldpts = $env{'form.oldpts'.$question.'_'.$partid}; 5840: my @types = $curRes->responseType($partid); 5841: if (grep(/^essay$/,@types)) { 5842: $queueable{$partid} = 1; 5843: } else { 5844: my @ids = $curRes->responseIds($partid); 5845: for (my $i=0; $i < scalar(@ids); $i++) { 5846: my $hndgrd = &Apache::lonnet::EXT('resource.'.$partid.'_'.$ids[$i]. 5847: '.handgrade',$symb); 5848: if (lc($hndgrd) eq 'yes') { 5849: $queueable{$partid} = 1; 5850: last; 5851: } 5852: } 5853: } 5854: my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? 5855: $env{'form.WGT'.$question.'_'.$partid} : 1; 5856: my $partial = $newpts/$wgt; 5857: my $score; 5858: if ($partial > 0) { 5859: $score = 'correct_by_override'; 5860: } elsif ($newpts ne '') { #empty is taken as 0 5861: $score = 'incorrect_by_override'; 5862: } 5863: my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid}; 5864: if ($dropMenu eq 'excused') { 5865: $partial = ''; 5866: $score = 'excused'; 5867: } elsif ($dropMenu eq 'reset status' 5868: && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists 5869: $newrecord{'resource.'.$partid.'.tries'} = 0; 5870: $newrecord{'resource.'.$partid.'.solved'} = ''; 5871: $newrecord{'resource.'.$partid.'.award'} = ''; 5872: $newrecord{'resource.'.$partid.'.awarded'} = 0; 5873: $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"; 5874: $changeflag++; 5875: $newpts = ''; 5876: 5877: my $aggtries = $env{'form.aggtries'.$question.'_'.$partid}; 5878: my $totaltries = $env{'form.totaltries'.$question.'_'.$partid}; 5879: my $solvedstatus = $env{'form.solved'.$question.'_'.$partid}; 5880: if ($aggtries > 0) { 5881: &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus); 5882: $aggregateflag = 1; 5883: } 5884: } 5885: my $display_part=&get_display_part($partid,$curRes->symb()); 5886: my $oldstatus = $env{'form.solved'.$question.'_'.$partid}; 5887: $displayPts[0].=' <b>'.&mt('Part').':</b> '.$display_part.' = '. 5888: (($oldstatus eq 'excused') ? 'excused' : $oldpts). 5889: ' <br />'; 5890: $displayPts[1].=' <b>'.&mt('Part').':</b> '.$display_part.' = '. 5891: (($score eq 'excused') ? 'excused' : $newpts). 5892: ' <br />'; 5893: $question++; 5894: next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); 5895: 5896: $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; 5897: $newrecord{'resource.'.$partid.'.solved'} = $score if $score ne ''; 5898: $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}" 5899: if (scalar(keys(%newrecord)) > 0); 5900: 5901: $changeflag++; 5902: } 5903: if (scalar(keys(%newrecord)) > 0) { 5904: my %record = 5905: &Apache::lonnet::restore($symbx,$env{'request.course.id'}, 5906: $udom,$uname); 5907: 5908: if (&Apache::lonnet::validCODE($env{'form.CODE'})) { 5909: $newrecord{'resource.CODE'} = $env{'form.CODE'}; 5910: } elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) { 5911: $newrecord{'resource.CODE'} = ''; 5912: } 5913: &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, 5914: $udom,$uname); 5915: %record = &Apache::lonnet::restore($symbx, 5916: $env{'request.course.id'}, 5917: $udom,$uname); 5918: &check_and_remove_from_queue($parts,\%record,undef,$symbx, 5919: $cdom,$cnum,$udom,$uname,\%queueable); 5920: } 5921: 5922: if ($aggregateflag) { 5923: &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, 5924: $env{'course.'.$env{'request.course.id'}.'.domain'}, 5925: $env{'course.'.$env{'request.course.id'}.'.num'}); 5926: } 5927: 5928: $studentTable.='<td valign="top">'.$displayPts[0].'</td>'. 5929: '<td valign="top">'.$displayPts[1].'</td>'. 5930: &Apache::loncommon::end_data_table_row(); 5931: 5932: $prob++; 5933: } 5934: $curRes = $iterator->next(); 5935: } 5936: 5937: $studentTable.=&Apache::loncommon::end_data_table(); 5938: my $grademsg=($changeflag == 0 ? &mt('No score was changed or updated.') : 5939: &mt('The scores were changed for [quant,_1,problem].', 5940: $changeflag).'<br />'); 5941: my $hidemsg=($hideflag == 0 ? '' : 5942: &mt('Submissions were marked "hidden" for [quant,_1,transaction].', 5943: $hideflag).'<br />'); 5944: $request->print($hidemsg.$grademsg.$studentTable); 5945: 5946: return ''; 5947: } 5948: 5949: #-------- end of section for handling grading by page/sequence --------- 5950: # 5951: #------------------------------------------------------------------- 5952: 5953: #-------------------- Bubblesheet (Scantron) Grading ------------------- 5954: # 5955: #------ start of section for handling grading by page/sequence --------- 5956: 5957: =pod 5958: 5959: =head1 Bubble sheet grading routines 5960: 5961: For this documentation: 5962: 5963: 'scanline' refers to the full line of characters 5964: from the file that we are parsing that represents one entire sheet 5965: 5966: 'bubble line' refers to the data 5967: representing the line of bubbles that are on the physical bubblesheet 5968: 5969: 5970: The overall process is that a scanned in bubblesheet data is uploaded 5971: into a course. When a user wants to grade, they select a 5972: sequence/folder of resources, a file of bubblesheet info, and pick 5973: one of the predefined configurations for what each scanline looks 5974: like. 5975: 5976: Next each scanline is checked for any errors of either 'missing 5977: bubbles' (it's an error because it may have been mis-scanned 5978: because too light bubbling), 'double bubble' (each bubble line should 5979: have no more than one letter picked), invalid or duplicated CODE, 5980: invalid student/employee ID 5981: 5982: If the CODE option is used that determines the randomization of the 5983: homework problems, either way the student/employee ID is looked up into a 5984: username:domain. 5985: 5986: During the validation phase the instructor can choose to skip scanlines. 5987: 5988: After the validation phase, there are now 3 bubblesheet files 5989: 5990: scantron_original_filename (unmodified original file) 5991: scantron_corrected_filename (file where the corrected information has replaced the original information) 5992: scantron_skipped_filename (contains the exact text of scanlines that where skipped) 5993: 5994: Also there is a separate hash nohist_scantrondata that contains extra 5995: correction information that isn't representable in the bubblesheet 5996: file (see &scantron_getfile() for more information) 5997: 5998: After all scanlines are either valid, marked as valid or skipped, then 5999: foreach line foreach problem in the picked sequence, an ssi request is 6000: made that simulates a user submitting their selected letter(s) against 6001: the homework problem. 6002: 6003: =over 4 6004: 6005: 6006: 6007: =item defaultFormData 6008: 6009: Returns html hidden inputs used to hold context/default values. 6010: 6011: Arguments: 6012: $symb - $symb of the current resource 6013: 6014: =cut 6015: 6016: sub defaultFormData { 6017: my ($symb)=@_; 6018: return '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'; 6019: } 6020: 6021: 6022: =pod 6023: 6024: =item getSequenceDropDown 6025: 6026: Return html dropdown of possible sequences to grade 6027: 6028: Arguments: 6029: $symb - $symb of the current resource 6030: $map_error - ref to scalar which will container error if 6031: $navmap object is unavailable in &getSymbMap(). 6032: 6033: =cut 6034: 6035: sub getSequenceDropDown { 6036: my ($symb,$map_error)=@_; 6037: my $result='<select name="selectpage">'."\n"; 6038: my ($titles,$symbx) = &getSymbMap($map_error); 6039: if (ref($map_error)) { 6040: return if ($$map_error); 6041: } 6042: my ($curpage)=&Apache::lonnet::decode_symb($symb); 6043: my $ctr=0; 6044: foreach (@$titles) { 6045: my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); 6046: $result.='<option value="'.$$symbx{$_}.'" '. 6047: ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : ''). 6048: '>'.$showtitle.'</option>'."\n"; 6049: $ctr++; 6050: } 6051: $result.= '</select>'; 6052: return $result; 6053: } 6054: 6055: my %bubble_lines_per_response; # no. bubble lines for each response. 6056: # key is zero-based index - 0, 1, 2 ... 6057: 6058: my %first_bubble_line; # First bubble line no. for each bubble. 6059: 6060: my %subdivided_bubble_lines; # no. bubble lines for optionresponse, 6061: # matchresponse or rankresponse, where 6062: # an individual response can have multiple 6063: # lines 6064: 6065: my %responsetype_per_response; # responsetype for each response 6066: 6067: my %masterseq_id_responsenum; # src_id (e.g., 12.3_0.11 etc.) for each 6068: # numbered response. Needed when randomorder 6069: # or randompick are in use. Key is ID, value 6070: # is response number. 6071: 6072: # Save and restore the bubble lines array to the form env. 6073: 6074: 6075: sub save_bubble_lines { 6076: foreach my $line (keys(%bubble_lines_per_response)) { 6077: $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; 6078: $env{"form.scantron.first_bubble_line.$line"} = 6079: $first_bubble_line{$line}; 6080: $env{"form.scantron.sub_bubblelines.$line"} = 6081: $subdivided_bubble_lines{$line}; 6082: $env{"form.scantron.responsetype.$line"} = 6083: $responsetype_per_response{$line}; 6084: } 6085: foreach my $resid (keys(%masterseq_id_responsenum)) { 6086: my $line = $masterseq_id_responsenum{$resid}; 6087: $env{"form.scantron.residpart.$line"} = $resid; 6088: } 6089: } 6090: 6091: 6092: sub restore_bubble_lines { 6093: my $line = 0; 6094: %bubble_lines_per_response = (); 6095: %masterseq_id_responsenum = (); 6096: while ($env{"form.scantron.bubblelines.$line"}) { 6097: my $value = $env{"form.scantron.bubblelines.$line"}; 6098: $bubble_lines_per_response{$line} = $value; 6099: $first_bubble_line{$line} = 6100: $env{"form.scantron.first_bubble_line.$line"}; 6101: $subdivided_bubble_lines{$line} = 6102: $env{"form.scantron.sub_bubblelines.$line"}; 6103: $responsetype_per_response{$line} = 6104: $env{"form.scantron.responsetype.$line"}; 6105: my $id = $env{"form.scantron.residpart.$line"}; 6106: $masterseq_id_responsenum{$id} = $line; 6107: $line++; 6108: } 6109: } 6110: 6111: =pod 6112: 6113: =item scantron_filenames 6114: 6115: Returns a list of the scantron files in the current course 6116: 6117: =cut 6118: 6119: sub scantron_filenames { 6120: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 6121: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 6122: my $getpropath = 1; 6123: my ($dirlist,$listerror) = &Apache::lonnet::dirlist('userfiles',$cdom, 6124: $cname,$getpropath); 6125: my @possiblenames; 6126: if (ref($dirlist) eq 'ARRAY') { 6127: foreach my $filename (sort(@{$dirlist})) { 6128: ($filename)=split(/&/,$filename); 6129: if ($filename!~/^scantron_orig_/) { next ; } 6130: $filename=~s/^scantron_orig_//; 6131: push(@possiblenames,$filename); 6132: } 6133: } 6134: return @possiblenames; 6135: } 6136: 6137: =pod 6138: 6139: =item scantron_uploads 6140: 6141: Returns html drop-down list of scantron files in current course. 6142: 6143: Arguments: 6144: $file2grade - filename to set as selected in the dropdown 6145: 6146: =cut 6147: 6148: sub scantron_uploads { 6149: my ($file2grade) = @_; 6150: my $result= '<select name="scantron_selectfile">'; 6151: $result.="<option></option>"; 6152: foreach my $filename (sort(&scantron_filenames())) { 6153: $result.="<option".($filename eq $file2grade ? ' selected="selected"':'').">$filename</option>\n"; 6154: } 6155: $result.="</select>"; 6156: return $result; 6157: } 6158: 6159: =pod 6160: 6161: =item scantron_scantab 6162: 6163: Returns html drop down of the scantron formats in the scantronformat.tab 6164: file. 6165: 6166: =cut 6167: 6168: sub scantron_scantab { 6169: my $result='<select name="scantron_format">'."\n"; 6170: $result.='<option></option>'."\n"; 6171: my @lines = &Apache::lonnet::get_scantronformat_file(); 6172: if (@lines > 0) { 6173: foreach my $line (@lines) { 6174: next if (($line =~ /^\#/) || ($line eq '')); 6175: my ($name,$descrip)=split(/:/,$line); 6176: $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n"; 6177: } 6178: } 6179: $result.='</select>'."\n"; 6180: return $result; 6181: } 6182: 6183: =pod 6184: 6185: =item scantron_CODElist 6186: 6187: Returns html drop down of the saved CODE lists from current course, 6188: generated from earlier printings. 6189: 6190: =cut 6191: 6192: sub scantron_CODElist { 6193: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 6194: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 6195: my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum); 6196: my $namechoice='<option></option>'; 6197: foreach my $name (sort {uc($a) cmp uc($b)} @names) { 6198: if ($name =~ /^error: 2 /) { next; } 6199: if ($name =~ /^type\0/) { next; } 6200: $namechoice.='<option value="'.$name.'">'.$name.'</option>'; 6201: } 6202: $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>'; 6203: return $namechoice; 6204: } 6205: 6206: =pod 6207: 6208: =item scantron_CODEunique 6209: 6210: Returns the html for "Each CODE to be used once" radio. 6211: 6212: =cut 6213: 6214: sub scantron_CODEunique { 6215: my $result='<span class="LC_nobreak"> 6216: <label><input type="radio" name="scantron_CODEunique" 6217: value="yes" checked="checked" />'.&mt('Yes').' </label> 6218: </span> 6219: <span class="LC_nobreak"> 6220: <label><input type="radio" name="scantron_CODEunique" 6221: value="no" />'.&mt('No').' </label> 6222: </span>'; 6223: return $result; 6224: } 6225: 6226: =pod 6227: 6228: =item scantron_selectphase 6229: 6230: Generates the initial screen to start the bubblesheet process. 6231: Allows for - starting a grading run. 6232: - downloading existing scan data (original, corrected 6233: or skipped info) 6234: 6235: - uploading new scan data 6236: 6237: Arguments: 6238: $r - The Apache request object 6239: $file2grade - name of the file that contain the scanned data to score 6240: 6241: =cut 6242: 6243: sub scantron_selectphase { 6244: my ($r,$file2grade,$symb) = @_; 6245: if (!$symb) {return '';} 6246: my $map_error; 6247: my $sequence_selector=&getSequenceDropDown($symb,\$map_error); 6248: if ($map_error) { 6249: $r->print('<br />'.&navmap_errormsg().'<br />'); 6250: return; 6251: } 6252: my $default_form_data=&defaultFormData($symb); 6253: my $file_selector=&scantron_uploads($file2grade); 6254: my $format_selector=&scantron_scantab(); 6255: my $CODE_selector=&scantron_CODElist(); 6256: my $CODE_unique=&scantron_CODEunique(); 6257: my $result; 6258: 6259: $ssi_error = 0; 6260: 6261: if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || 6262: &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { 6263: 6264: # Chunk of form to prompt for a scantron file upload. 6265: 6266: $r->print(' 6267: <br />'); 6268: my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; 6269: my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'}; 6270: my $alertmsg = &mt('Please use the browse button to select a file from your local directory.'); 6271: &js_escape(\$alertmsg); 6272: my ($formatoptions,$formattitle,$formatjs) = &scantron_upload_dataformat($cdom); 6273: $r->print(&Apache::lonhtmlcommon::scripttag(' 6274: function checkUpload(formname) { 6275: if (formname.upfile.value == "") { 6276: alert("'.$alertmsg.'"); 6277: return false; 6278: } 6279: formname.submit(); 6280: }'."\n".$formatjs)); 6281: $r->print(' 6282: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post"> 6283: '.$default_form_data.' 6284: <input name="courseid" type="hidden" value="'.$cnum.'" /> 6285: <input name="domainid" type="hidden" value="'.$cdom.'" /> 6286: <input name="command" value="scantronupload_save" type="hidden" /> 6287: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 6288: '.&Apache::loncommon::start_data_table_header_row().' 6289: <th> 6290:  '.&mt('Specify a bubblesheet data file to upload.').' 6291: </th> 6292: '.&Apache::loncommon::end_data_table_header_row().' 6293: '.&Apache::loncommon::start_data_table_row().' 6294: <td> 6295: '.&mt('File to upload: [_1]','<input type="file" name="upfile" size="50" />').'<br />'."\n"); 6296: if ($formatoptions) { 6297: $r->print('</td> 6298: '.&Apache::loncommon::end_data_table_row().' 6299: '.&Apache::loncommon::start_data_table_row().' 6300: <td>'.$formattitle.(' 'x2).$formatoptions.' 6301: </td> 6302: '.&Apache::loncommon::end_data_table_row().' 6303: '.&Apache::loncommon::start_data_table_row().' 6304: <td>' 6305: ); 6306: } else { 6307: $r->print(' <br />'); 6308: } 6309: $r->print('<input type="button" onclick="javascript:checkUpload(this.form);" value="'.&mt('Upload Bubblesheet Data').'" /> 6310: </td> 6311: '.&Apache::loncommon::end_data_table_row().' 6312: '.&Apache::loncommon::end_data_table().' 6313: </form>' 6314: ); 6315: 6316: } 6317: 6318: # Chunk of form to prompt for a file to grade and how: 6319: 6320: $result.= ' 6321: <br /> 6322: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process"> 6323: <input type="hidden" name="command" value="scantron_warning" /> 6324: '.$default_form_data.' 6325: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 6326: '.&Apache::loncommon::start_data_table_header_row().' 6327: <th colspan="2"> 6328:  '.&mt('Specify file and which Folder/Sequence to grade').' 6329: </th> 6330: '.&Apache::loncommon::end_data_table_header_row().' 6331: '.&Apache::loncommon::start_data_table_row().' 6332: <td> '.&mt('Sequence to grade:').' </td><td> '.$sequence_selector.' </td> 6333: '.&Apache::loncommon::end_data_table_row().' 6334: '.&Apache::loncommon::start_data_table_row().' 6335: <td> '.&mt('Filename of bubblesheet data file:').' </td><td> '.$file_selector.' </td> 6336: '.&Apache::loncommon::end_data_table_row().' 6337: '.&Apache::loncommon::start_data_table_row().' 6338: <td> '.&mt('Format of bubblesheet data file:').' </td><td> '.$format_selector.' </td> 6339: '.&Apache::loncommon::end_data_table_row().' 6340: '.&Apache::loncommon::start_data_table_row().' 6341: <td> '.&mt('Saved CODEs to validate against:').' </td><td> '.$CODE_selector.' </td> 6342: '.&Apache::loncommon::end_data_table_row().' 6343: '.&Apache::loncommon::start_data_table_row().' 6344: <td> '.&mt('Each CODE is only to be used once:').'</td><td> '.$CODE_unique.' </td> 6345: '.&Apache::loncommon::end_data_table_row().' 6346: '.&Apache::loncommon::start_data_table_row().' 6347: <td> '.&mt('Options:').' </td> 6348: <td> 6349: <label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> '.&mt('Do only previously skipped records').'</label> <br /> 6350: <label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> '.&mt('Remove all existing corrections').'</label> <br /> 6351: <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources when grading').'</label> 6352: </td> 6353: '.&Apache::loncommon::end_data_table_row().' 6354: '.&Apache::loncommon::start_data_table_row().' 6355: <td colspan="2"> 6356: <input type="submit" value="'.&mt('Grading: Validate Bubblesheet Records').'" /> 6357: </td> 6358: '.&Apache::loncommon::end_data_table_row().' 6359: '.&Apache::loncommon::end_data_table().' 6360: </form> 6361: '; 6362: 6363: $r->print($result); 6364: 6365: # Chunk of the form that prompts to view a scoring office file, 6366: # corrected file, skipped records in a file. 6367: 6368: $r->print(' 6369: <br /> 6370: <form action="/adm/grades" name="scantron_download"> 6371: '.$default_form_data.' 6372: <input type="hidden" name="command" value="scantron_download" /> 6373: '.&Apache::loncommon::start_data_table('LC_scantron_action').' 6374: '.&Apache::loncommon::start_data_table_header_row().' 6375: <th> 6376:  '.&mt('Download a scoring office file').' 6377: </th> 6378: '.&Apache::loncommon::end_data_table_header_row().' 6379: '.&Apache::loncommon::start_data_table_row().' 6380: <td> '.&mt('Filename of scoring office file: [_1]',$file_selector).' 6381: <br /> 6382: <input type="submit" value="'.&mt('Download: Show List of Associated Files').'" /> 6383: '.&Apache::loncommon::end_data_table_row().' 6384: '.&Apache::loncommon::end_data_table().' 6385: </form> 6386: <br /> 6387: '); 6388: 6389: &Apache::lonpickcode::code_list($r,2); 6390: 6391: $r->print('<br /><form method="post" name="checkscantron" action="">'. 6392: $default_form_data."\n". 6393: &Apache::loncommon::start_data_table('LC_scantron_action')."\n". 6394: &Apache::loncommon::start_data_table_header_row()."\n". 6395: '<th colspan="2"> 6396:  '.&mt('Review bubblesheet data and submissions for a previously graded folder/sequence')."\n". 6397: '</th>'."\n". 6398: &Apache::loncommon::end_data_table_header_row()."\n". 6399: &Apache::loncommon::start_data_table_row()."\n". 6400: '<td> '.&mt('Graded folder/sequence:').' </td>'."\n". 6401: '<td> '.$sequence_selector.' </td>'. 6402: &Apache::loncommon::end_data_table_row()."\n". 6403: &Apache::loncommon::start_data_table_row()."\n". 6404: '<td> '.&mt('Filename of scoring office file:').' </td>'."\n". 6405: '<td> '.$file_selector.' </td>'."\n". 6406: &Apache::loncommon::end_data_table_row()."\n". 6407: &Apache::loncommon::start_data_table_row()."\n". 6408: '<td> '.&mt('Format of data file:').' </td>'."\n". 6409: '<td> '.$format_selector.' </td>'."\n". 6410: &Apache::loncommon::end_data_table_row()."\n". 6411: &Apache::loncommon::start_data_table_row()."\n". 6412: '<td> '.&mt('Options').' </td>'."\n". 6413: '<td> <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources').'</label></td>'. 6414: &Apache::loncommon::end_data_table_row()."\n". 6415: &Apache::loncommon::start_data_table_row()."\n". 6416: '<td colspan="2">'."\n". 6417: '<input type="hidden" name="command" value="checksubmissions" />'."\n". 6418: '<input type="submit" value="'.&mt('Review Bubblesheet Data and Submission Records').'" />'."\n". 6419: '</td>'."\n". 6420: &Apache::loncommon::end_data_table_row()."\n". 6421: &Apache::loncommon::end_data_table()."\n". 6422: '</form><br />'); 6423: return; 6424: } 6425: 6426: =pod 6427: 6428: =item username_to_idmap 6429: 6430: creates a hash keyed by student/employee ID with values of the corresponding 6431: student username:domain. 6432: 6433: Arguments: 6434: 6435: $classlist - reference to the class list hash. This is a hash 6436: keyed by student name:domain whose elements are references 6437: to arrays containing various chunks of information 6438: about the student. (See loncoursedata for more info). 6439: 6440: Returns 6441: %idmap - the constructed hash 6442: 6443: =cut 6444: 6445: sub username_to_idmap { 6446: my ($classlist)= @_; 6447: my %idmap; 6448: foreach my $student (keys(%$classlist)) { 6449: my $id = $classlist->{$student}->[&Apache::loncoursedata::CL_ID]; 6450: unless ($id eq '') { 6451: if (!exists($idmap{$id})) { 6452: $idmap{$id} = $student; 6453: } else { 6454: my $status = $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS]; 6455: if ($status eq 'Active') { 6456: $idmap{$id} = $student; 6457: } 6458: } 6459: } 6460: } 6461: return %idmap; 6462: } 6463: 6464: =pod 6465: 6466: =item scantron_fixup_scanline 6467: 6468: Process a requested correction to a scanline. 6469: 6470: Arguments: 6471: $scantron_config - hash from &Apache::lonnet::get_scantron_config() 6472: $scan_data - hash of correction information 6473: (see &scantron_getfile()) 6474: $line - existing scanline 6475: $whichline - line number of the passed in scanline 6476: $field - type of change to process 6477: (either 6478: 'ID' -> correct the student/employee ID 6479: 'CODE' -> correct the CODE 6480: 'answer' -> fixup the submitted answers) 6481: 6482: $args - hash of additional info, 6483: - 'ID' 6484: 'newid' -> studentID to use in replacement 6485: of existing one 6486: - 'CODE' 6487: 'CODE_ignore_dup' - set to true if duplicates 6488: should be ignored. 6489: 'CODE' - is new code or 'use_unfound' 6490: if the existing unfound code should 6491: be used as is 6492: - 'answer' 6493: 'response' - new answer or 'none' if blank 6494: 'question' - the bubble line to change 6495: 'questionnum' - the question identifier, 6496: may include subquestion. 6497: 6498: Returns: 6499: $line - the modified scanline 6500: 6501: Side effects: 6502: $scan_data - may be updated 6503: 6504: =cut 6505: 6506: 6507: sub scantron_fixup_scanline { 6508: my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; 6509: if ($field eq 'ID') { 6510: if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { 6511: return ($line,1,'New value too large'); 6512: } 6513: if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { 6514: $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', 6515: $args->{'newid'}); 6516: } 6517: substr($line,$$scantron_config{'IDstart'}-1, 6518: $$scantron_config{'IDlength'})=$args->{'newid'}; 6519: if ($args->{'newid'}=~/^\s*$/) { 6520: &scan_data($scan_data,"$whichline.user", 6521: $args->{'username'}.':'.$args->{'domain'}); 6522: } 6523: } elsif ($field eq 'CODE') { 6524: if ($args->{'CODE_ignore_dup'}) { 6525: &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); 6526: } 6527: &scan_data($scan_data,"$whichline.useCODE",'1'); 6528: if ($args->{'CODE'} ne 'use_unfound') { 6529: if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { 6530: return ($line,1,'New CODE value too large'); 6531: } 6532: if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) { 6533: $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'}); 6534: } 6535: substr($line,$$scantron_config{'CODEstart'}-1, 6536: $$scantron_config{'CODElength'})=$args->{'CODE'}; 6537: } 6538: } elsif ($field eq 'answer') { 6539: my $length=$scantron_config->{'Qlength'}; 6540: my $off=$scantron_config->{'Qoff'}; 6541: my $on=$scantron_config->{'Qon'}; 6542: my $answer=${off}x$length; 6543: if ($args->{'response'} eq 'none') { 6544: &scan_data($scan_data, 6545: "$whichline.no_bubble.".$args->{'questionnum'},'1'); 6546: } else { 6547: if ($on eq 'letter') { 6548: my @alphabet=('A'..'Z'); 6549: $answer=$alphabet[$args->{'response'}]; 6550: } elsif ($on eq 'number') { 6551: $answer=$args->{'response'}+1; 6552: if ($answer == 10) { $answer = '0'; } 6553: } else { 6554: substr($answer,$args->{'response'},1)=$on; 6555: } 6556: &scan_data($scan_data, 6557: "$whichline.no_bubble.".$args->{'questionnum'},undef,'1'); 6558: } 6559: my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; 6560: substr($line,$where-1,$length)=$answer; 6561: } 6562: return $line; 6563: } 6564: 6565: =pod 6566: 6567: =item scan_data 6568: 6569: Edit or look up an item in the scan_data hash. 6570: 6571: Arguments: 6572: $scan_data - The hash (see scantron_getfile) 6573: $key - shorthand of the key to edit (actual key is 6574: scantronfilename_key). 6575: $data - New value of the hash entry. 6576: $delete - If true, the entry is removed from the hash. 6577: 6578: Returns: 6579: The new value of the hash table field (undefined if deleted). 6580: 6581: =cut 6582: 6583: 6584: sub scan_data { 6585: my ($scan_data,$key,$value,$delete)=@_; 6586: my $filename=$env{'form.scantron_selectfile'}; 6587: if (defined($value)) { 6588: $scan_data->{$filename.'_'.$key} = $value; 6589: } 6590: if ($delete) { delete($scan_data->{$filename.'_'.$key}); } 6591: return $scan_data->{$filename.'_'.$key}; 6592: } 6593: 6594: # ----- These first few routines are general use routines.---- 6595: 6596: # Return the number of occurences of a pattern in a string. 6597: 6598: sub occurence_count { 6599: my ($string, $pattern) = @_; 6600: 6601: my @matches = ($string =~ /$pattern/g); 6602: 6603: return scalar(@matches); 6604: } 6605: 6606: 6607: # Take a string known to have digits and convert all the 6608: # digits into letters in the range J,A..I. 6609: 6610: sub digits_to_letters { 6611: my ($input) = @_; 6612: 6613: my @alphabet = ('J', 'A'..'I'); 6614: 6615: my @input = split(//, $input); 6616: my $output =''; 6617: for (my $i = 0; $i < scalar(@input); $i++) { 6618: if ($input[$i] =~ /\d/) { 6619: $output .= $alphabet[$input[$i]]; 6620: } else { 6621: $output .= $input[$i]; 6622: } 6623: } 6624: return $output; 6625: } 6626: 6627: =pod 6628: 6629: =item scantron_parse_scanline 6630: 6631: Decodes a scanline from the selected scantron file 6632: 6633: Arguments: 6634: line - The text of the scantron file line to process 6635: whichline - Line number 6636: scantron_config - Hash describing the format of the scantron lines. 6637: scan_data - Hash of extra information about the scanline 6638: (see scantron_getfile for more information) 6639: just_header - True if should not process question answers but only 6640: the stuff to the left of the answers. 6641: randomorder - True if randomorder in use 6642: randompick - True if randompick in use 6643: sequence - Exam folder URL 6644: master_seq - Ref to array containing symbs in exam folder 6645: symb_to_resource - Ref to hash of symbs for resources in exam folder 6646: (corresponding values are resource objects) 6647: partids_by_symb - Ref to hash of symb -> array ref of partIDs 6648: orderedforcode - Ref to hash of arrays. keys are CODEs and values 6649: are refs to an array of resource objects, ordered 6650: according to order used for CODE, when randomorder 6651: and or randompick are in use. 6652: respnumlookup - Ref to hash mapping question numbers in bubble lines 6653: for current line to question number used for same question 6654: in "Master Sequence" (as seen by Course Coordinator). 6655: startline - Ref to hash where key is question number (0 is first) 6656: and value is number of first bubble line for current 6657: student or code-based randompick and/or randomorder. 6658: totalref - Ref of scalar used to score total number of bubble 6659: lines needed for responses in a scan line (used when 6660: randompick in use. 6661: 6662: Returns: 6663: Hash containing the result of parsing the scanline 6664: 6665: Keys are all proceeded by the string 'scantron.' 6666: 6667: CODE - the CODE in use for this scanline 6668: useCODE - 1 if the CODE is invalid but it usage has been forced 6669: by the operator 6670: CODE_ignore_dup - 1 if the CODE is a duplicated use when unique 6671: CODEs were selected, but the usage has been 6672: forced by the operator 6673: ID - student/employee ID 6674: PaperID - if used, the ID number printed on the sheet when the 6675: paper was scanned 6676: FirstName - first name from the sheet 6677: LastName - last name from the sheet 6678: 6679: if just_header was not true these key may also exist 6680: 6681: missingerror - a list of bubble ranges that are considered to be answers 6682: to a single question that don't have any bubbles filled in. 6683: Of the form questionnumber:firstbubblenumber:count. 6684: doubleerror - a list of bubble ranges that are considered to be answers 6685: to a single question that have more than one bubble filled in. 6686: Of the form questionnumber::firstbubblenumber:count 6687: 6688: In the above, count is the number of bubble responses in the 6689: input line needed to represent the possible answers to the question. 6690: e.g. a radioresponse with 15 choices in an answer sheet with 10 choices 6691: per line would have count = 2. 6692: 6693: maxquest - the number of the last bubble line that was parsed 6694: 6695: (<number> starts at 1) 6696: <number>.answer - zero or more letters representing the selected 6697: letters from the scanline for the bubble line 6698: <number>. 6699: if blank there was either no bubble or there where 6700: multiple bubbles, (consult the keys missingerror and 6701: doubleerror if this is an error condition) 6702: 6703: =cut 6704: 6705: sub scantron_parse_scanline { 6706: my ($line,$whichline,$scantron_config,$scan_data,$just_header,$idmap, 6707: $randomorder,$randompick,$sequence,$master_seq,$symb_to_resource, 6708: $partids_by_symb,$orderedforcode,$respnumlookup,$startline,$totalref)=@_; 6709: 6710: my %record; 6711: my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # stuff before answers 6712: if (!($$scantron_config{'CODElocation'} eq 0 || 6713: $$scantron_config{'CODElocation'} eq 'none')) { 6714: if ($$scantron_config{'CODElocation'} < 0 || 6715: $$scantron_config{'CODElocation'} eq 'letter' || 6716: $$scantron_config{'CODElocation'} eq 'number') { 6717: $record{'scantron.CODE'}=substr($data, 6718: $$scantron_config{'CODEstart'}-1, 6719: $$scantron_config{'CODElength'}); 6720: if (&scan_data($scan_data,"$whichline.useCODE")) { 6721: $record{'scantron.useCODE'}=1; 6722: } 6723: if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) { 6724: $record{'scantron.CODE_ignore_dup'}=1; 6725: } 6726: } else { 6727: #FIXME interpret first N questions 6728: } 6729: } 6730: $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, 6731: $$scantron_config{'IDlength'}); 6732: $record{'scantron.PaperID'}= 6733: substr($data,$$scantron_config{'PaperID'}-1, 6734: $$scantron_config{'PaperIDlength'}); 6735: $record{'scantron.FirstName'}= 6736: substr($data,$$scantron_config{'FirstName'}-1, 6737: $$scantron_config{'FirstNamelength'}); 6738: $record{'scantron.LastName'}= 6739: substr($data,$$scantron_config{'LastName'}-1, 6740: $$scantron_config{'LastNamelength'}); 6741: if ($just_header) { return \%record; } 6742: 6743: my @alphabet=('A'..'Z'); 6744: my $questnum=0; 6745: my $ansnum =1; # Multiple 'answer lines'/question. 6746: 6747: my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'}; 6748: if ($randompick || $randomorder) { 6749: my $total = &get_respnum_lookups($sequence,$scan_data,$idmap,$line,\%record, 6750: $master_seq,$symb_to_resource, 6751: $partids_by_symb,$orderedforcode, 6752: $respnumlookup,$startline); 6753: if ($total) { 6754: $lastpos = $total*$$scantron_config{'Qlength'}; 6755: } 6756: if (ref($totalref)) { 6757: $$totalref = $total; 6758: } 6759: } 6760: my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos); # Answers 6761: chomp($questions); # Get rid of any trailing \n. 6762: $questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads). 6763: while (length($questions)) { 6764: my $answers_needed; 6765: if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { 6766: $answers_needed = $bubble_lines_per_response{$respnumlookup->{$questnum}}; 6767: } else { 6768: $answers_needed = $bubble_lines_per_response{$questnum}; 6769: } 6770: my $answer_length = ($$scantron_config{'Qlength'} * $answers_needed) 6771: || 1; 6772: $questnum++; 6773: my $quest_id = $questnum; 6774: my $currentquest = substr($questions,0,$answer_length); 6775: $questions = substr($questions,$answer_length); 6776: if (length($currentquest) < $answer_length) { next; } 6777: 6778: my $subdivided; 6779: if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { 6780: $subdivided = $subdivided_bubble_lines{$respnumlookup->{$questnum-1}}; 6781: } else { 6782: $subdivided = $subdivided_bubble_lines{$questnum-1}; 6783: } 6784: if ($subdivided =~ /,/) { 6785: my $subquestnum = 1; 6786: my $subquestions = $currentquest; 6787: my @subanswers_needed = split(/,/,$subdivided); 6788: foreach my $subans (@subanswers_needed) { 6789: my $subans_length = 6790: ($$scantron_config{'Qlength'} * $subans) || 1; 6791: my $currsubquest = substr($subquestions,0,$subans_length); 6792: $subquestions = substr($subquestions,$subans_length); 6793: $quest_id = "$questnum.$subquestnum"; 6794: if (($$scantron_config{'Qon'} eq 'letter') || 6795: ($$scantron_config{'Qon'} eq 'number')) { 6796: $ansnum = &scantron_validator_lettnum($ansnum, 6797: $questnum,$quest_id,$subans,$currsubquest,$whichline, 6798: \@alphabet,\%record,$scantron_config,$scan_data, 6799: $randomorder,$randompick,$respnumlookup); 6800: } else { 6801: $ansnum = &scantron_validator_positional($ansnum, 6802: $questnum,$quest_id,$subans,$currsubquest,$whichline, 6803: \@alphabet,\%record,$scantron_config,$scan_data, 6804: $randomorder,$randompick,$respnumlookup); 6805: } 6806: $subquestnum ++; 6807: } 6808: } else { 6809: if (($$scantron_config{'Qon'} eq 'letter') || 6810: ($$scantron_config{'Qon'} eq 'number')) { 6811: $ansnum = &scantron_validator_lettnum($ansnum,$questnum, 6812: $quest_id,$answers_needed,$currentquest,$whichline, 6813: \@alphabet,\%record,$scantron_config,$scan_data, 6814: $randomorder,$randompick,$respnumlookup); 6815: } else { 6816: $ansnum = &scantron_validator_positional($ansnum,$questnum, 6817: $quest_id,$answers_needed,$currentquest,$whichline, 6818: \@alphabet,\%record,$scantron_config,$scan_data, 6819: $randomorder,$randompick,$respnumlookup); 6820: } 6821: } 6822: } 6823: $record{'scantron.maxquest'}=$questnum; 6824: return \%record; 6825: } 6826: 6827: sub get_master_seq { 6828: my ($resources,$master_seq,$symb_to_resource,$need_symb_in_map,$symb_for_examcode) = @_; 6829: return unless ((ref($resources) eq 'ARRAY') && (ref($master_seq) eq 'ARRAY') && 6830: (ref($symb_to_resource) eq 'HASH')); 6831: if ($need_symb_in_map) { 6832: return unless (ref($symb_for_examcode) eq 'HASH'); 6833: } 6834: my $resource_error; 6835: foreach my $resource (@{$resources}) { 6836: my $ressymb; 6837: if (ref($resource)) { 6838: $ressymb = $resource->symb(); 6839: push(@{$master_seq},$ressymb); 6840: $symb_to_resource->{$ressymb} = $resource; 6841: if ($need_symb_in_map) { 6842: unless ($resource->is_map()) { 6843: my $map=(&Apache::lonnet::decode_symb($ressymb))[0]; 6844: unless (exists($symb_for_examcode->{$map})) { 6845: $symb_for_examcode->{$map} = $ressymb; 6846: } 6847: } 6848: } 6849: } else { 6850: $resource_error = 1; 6851: last; 6852: } 6853: } 6854: return $resource_error; 6855: } 6856: 6857: sub get_respnum_lookups { 6858: my ($sequence,$scan_data,$idmap,$line,$record,$master_seq,$symb_to_resource, 6859: $partids_by_symb,$orderedforcode,$respnumlookup,$startline) = @_; 6860: return unless ((ref($record) eq 'HASH') && (ref($master_seq) eq 'ARRAY') && 6861: (ref($symb_to_resource) eq 'HASH') && (ref($partids_by_symb) eq 'HASH') && 6862: (ref($orderedforcode) eq 'HASH') && (ref($respnumlookup) eq 'HASH') && 6863: (ref($startline) eq 'HASH')); 6864: my ($user,$scancode); 6865: if ((exists($record->{'scantron.CODE'})) && 6866: (&Apache::lonnet::validCODE($record->{'scantron.CODE'}))) { 6867: $scancode = $record->{'scantron.CODE'}; 6868: } else { 6869: $user = &scantron_find_student($record,$scan_data,$idmap,$line); 6870: } 6871: my @mapresources = 6872: &users_order($user,$scancode,$sequence,$master_seq,$symb_to_resource, 6873: $orderedforcode); 6874: my $total = 0; 6875: my $count = 0; 6876: foreach my $resource (@mapresources) { 6877: my $id = $resource->id(); 6878: my $symb = $resource->symb(); 6879: if (ref($partids_by_symb->{$symb}) eq 'ARRAY') { 6880: foreach my $partid (@{$partids_by_symb->{$symb}}) { 6881: my $respnum = $masterseq_id_responsenum{$id.'_'.$partid}; 6882: if ($respnum ne '') { 6883: $respnumlookup->{$count} = $respnum; 6884: $startline->{$count} = $total; 6885: $total += $bubble_lines_per_response{$respnum}; 6886: $count ++; 6887: } 6888: } 6889: } 6890: } 6891: return $total; 6892: } 6893: 6894: sub scantron_validator_lettnum { 6895: my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline, 6896: $alphabet,$record,$scantron_config,$scan_data,$randomorder, 6897: $randompick,$respnumlookup) = @_; 6898: 6899: # Qon 'letter' implies for each slot in currquest we have: 6900: # ? or * for doubles, a letter in A-Z for a bubble, and 6901: # about anything else (esp. a value of Qoff) for missing 6902: # bubbles. 6903: # 6904: # Qon 'number' implies each slot gives a digit that indexes the 6905: # bubbles filled, or Qoff, or a non-number for unbubbled lines, 6906: # and * or ? for double bubbles on a single line. 6907: # 6908: 6909: my $matchon; 6910: if ($$scantron_config{'Qon'} eq 'letter') { 6911: $matchon = '[A-Z]'; 6912: } elsif ($$scantron_config{'Qon'} eq 'number') { 6913: $matchon = '\d'; 6914: } 6915: my $occurrences = 0; 6916: my $responsenum = $questnum-1; 6917: if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { 6918: $responsenum = $respnumlookup->{$questnum-1} 6919: } 6920: if (($responsetype_per_response{$responsenum} eq 'essayresponse') || 6921: ($responsetype_per_response{$responsenum} eq 'formularesponse') || 6922: ($responsetype_per_response{$responsenum} eq 'stringresponse') || 6923: ($responsetype_per_response{$responsenum} eq 'imageresponse') || 6924: ($responsetype_per_response{$responsenum} eq 'reactionresponse') || 6925: ($responsetype_per_response{$responsenum} eq 'organicresponse')) { 6926: my @singlelines = split('',$currquest); 6927: foreach my $entry (@singlelines) { 6928: $occurrences = &occurence_count($entry,$matchon); 6929: if ($occurrences > 1) { 6930: last; 6931: } 6932: } 6933: } else { 6934: $occurrences = &occurence_count($currquest,$matchon); 6935: } 6936: if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) { 6937: push(@{$record->{'scantron.doubleerror'}},$quest_id); 6938: for (my $ans=0; $ans<$answers_needed; $ans++) { 6939: my $bubble = substr($currquest,$ans,1); 6940: if ($bubble =~ /$matchon/ ) { 6941: if ($$scantron_config{'Qon'} eq 'number') { 6942: if ($bubble == 0) { 6943: $bubble = 10; 6944: } 6945: $record->{"scantron.$ansnum.answer"} = 6946: $alphabet->[$bubble-1]; 6947: } else { 6948: $record->{"scantron.$ansnum.answer"} = $bubble; 6949: } 6950: } else { 6951: $record->{"scantron.$ansnum.answer"}=''; 6952: } 6953: $ansnum++; 6954: } 6955: } elsif (!defined($currquest) 6956: || (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest)) 6957: || (&occurence_count($currquest,$matchon) == 0)) { 6958: for (my $ans=0; $ans<$answers_needed; $ans++ ) { 6959: $record->{"scantron.$ansnum.answer"}=''; 6960: $ansnum++; 6961: } 6962: if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { 6963: push(@{$record->{'scantron.missingerror'}},$quest_id); 6964: } 6965: } else { 6966: if ($$scantron_config{'Qon'} eq 'number') { 6967: $currquest = &digits_to_letters($currquest); 6968: } 6969: for (my $ans=0; $ans<$answers_needed; $ans++) { 6970: my $bubble = substr($currquest,$ans,1); 6971: $record->{"scantron.$ansnum.answer"} = $bubble; 6972: $ansnum++; 6973: } 6974: } 6975: return $ansnum; 6976: } 6977: 6978: sub scantron_validator_positional { 6979: my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest, 6980: $whichline,$alphabet,$record,$scantron_config,$scan_data, 6981: $randomorder,$randompick,$respnumlookup) = @_; 6982: 6983: # Otherwise there's a positional notation; 6984: # each bubble line requires Qlength items, and there are filled in 6985: # bubbles for each case where there 'Qon' characters. 6986: # 6987: 6988: my @array=split($$scantron_config{'Qon'},$currquest,-1); 6989: 6990: # If the split only gives us one element.. the full length of the 6991: # answer string, no bubbles are filled in: 6992: 6993: if ($answers_needed eq '') { 6994: return; 6995: } 6996: 6997: if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { 6998: for (my $ans=0; $ans<$answers_needed; $ans++ ) { 6999: $record->{"scantron.$ansnum.answer"}=''; 7000: $ansnum++; 7001: } 7002: if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { 7003: push(@{$record->{"scantron.missingerror"}},$quest_id); 7004: } 7005: } elsif (scalar(@array) == 2) { 7006: my $location = length($array[0]); 7007: my $line_num = int($location / $$scantron_config{'Qlength'}); 7008: my $bubble = $alphabet->[$location % $$scantron_config{'Qlength'}]; 7009: for (my $ans=0; $ans<$answers_needed; $ans++) { 7010: if ($ans eq $line_num) { 7011: $record->{"scantron.$ansnum.answer"} = $bubble; 7012: } else { 7013: $record->{"scantron.$ansnum.answer"} = ' '; 7014: } 7015: $ansnum++; 7016: } 7017: } else { 7018: # If there's more than one instance of a bubble character 7019: # That's a double bubble; with positional notation we can 7020: # record all the bubbles filled in as well as the 7021: # fact this response consists of multiple bubbles. 7022: # 7023: my $responsenum = $questnum-1; 7024: if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { 7025: $responsenum = $respnumlookup->{$questnum-1} 7026: } 7027: if (($responsetype_per_response{$responsenum} eq 'essayresponse') || 7028: ($responsetype_per_response{$responsenum} eq 'formularesponse') || 7029: ($responsetype_per_response{$responsenum} eq 'stringresponse') || 7030: ($responsetype_per_response{$responsenum} eq 'imageresponse') || 7031: ($responsetype_per_response{$responsenum} eq 'reactionresponse') || 7032: ($responsetype_per_response{$responsenum} eq 'organicresponse')) { 7033: my $doubleerror = 0; 7034: while (($currquest >= $$scantron_config{'Qlength'}) && 7035: (!$doubleerror)) { 7036: my $currline = substr($currquest,0,$$scantron_config{'Qlength'}); 7037: $currquest = substr($currquest,$$scantron_config{'Qlength'}); 7038: my @currarray = split($$scantron_config{'Qon'},$currline,-1); 7039: if (length(@currarray) > 2) { 7040: $doubleerror = 1; 7041: } 7042: } 7043: if ($doubleerror) { 7044: push(@{$record->{'scantron.doubleerror'}},$quest_id); 7045: } 7046: } else { 7047: push(@{$record->{'scantron.doubleerror'}},$quest_id); 7048: } 7049: my $item = $ansnum; 7050: for (my $ans=0; $ans<$answers_needed; $ans++) { 7051: $record->{"scantron.$item.answer"} = ''; 7052: $item ++; 7053: } 7054: 7055: my @ans=@array; 7056: my $i=0; 7057: my $increment = 0; 7058: while ($#ans) { 7059: $i+=length($ans[0]) + $increment; 7060: my $line = int($i/$$scantron_config{'Qlength'} + $ansnum); 7061: my $bubble = $i%$$scantron_config{'Qlength'}; 7062: $record->{"scantron.$line.answer"}.=$alphabet->[$bubble]; 7063: shift(@ans); 7064: $increment = 1; 7065: } 7066: $ansnum += $answers_needed; 7067: } 7068: return $ansnum; 7069: } 7070: 7071: =pod 7072: 7073: =item scantron_add_delay 7074: 7075: Adds an error message that occurred during the grading phase to a 7076: queue of messages to be shown after grading pass is complete 7077: 7078: Arguments: 7079: $delayqueue - arrary ref of hash ref of error messages 7080: $scanline - the scanline that caused the error 7081: $errormesage - the error message 7082: $errorcode - a numeric code for the error 7083: 7084: Side Effects: 7085: updates the $delayqueue to have a new hash ref of the error 7086: 7087: =cut 7088: 7089: sub scantron_add_delay { 7090: my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; 7091: push(@$delayqueue, 7092: {'line' => $scanline, 'emsg' => $errormessage, 7093: 'ecode' => $errorcode } 7094: ); 7095: } 7096: 7097: =pod 7098: 7099: =item scantron_find_student 7100: 7101: Finds the username for the current scanline 7102: 7103: Arguments: 7104: $scantron_record - hash result from scantron_parse_scanline 7105: $scan_data - hash of correction information 7106: (see &scantron_getfile() form more information) 7107: $idmap - hash from &username_to_idmap() 7108: $line - number of current scanline 7109: 7110: Returns: 7111: Either 'username:domain' or undef if unknown 7112: 7113: =cut 7114: 7115: sub scantron_find_student { 7116: my ($scantron_record,$scan_data,$idmap,$line)=@_; 7117: my $scanID=$$scantron_record{'scantron.ID'}; 7118: if ($scanID =~ /^\s*$/) { 7119: return &scan_data($scan_data,"$line.user"); 7120: } 7121: foreach my $id (keys(%$idmap)) { 7122: if (lc($id) eq lc($scanID)) { 7123: return $$idmap{$id}; 7124: } 7125: } 7126: return undef; 7127: } 7128: 7129: =pod 7130: 7131: =item scantron_filter 7132: 7133: Filter sub for lonnavmaps, filters out hidden resources if ignore 7134: hidden resources was selected 7135: 7136: =cut 7137: 7138: sub scantron_filter { 7139: my ($curres)=@_; 7140: 7141: if (ref($curres) && $curres->is_problem()) { 7142: # if the user has asked to not have either hidden 7143: # or 'randomout' controlled resources to be graded 7144: # don't include them 7145: if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' 7146: && $curres->randomout) { 7147: return 0; 7148: } 7149: return 1; 7150: } 7151: return 0; 7152: } 7153: 7154: =pod 7155: 7156: =item scantron_process_corrections 7157: 7158: Gets correction information out of submitted form data and corrects 7159: the scanline 7160: 7161: =cut 7162: 7163: sub scantron_process_corrections { 7164: my ($r) = @_; 7165: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 7166: my ($scanlines,$scan_data)=&scantron_getfile(); 7167: my $classlist=&Apache::loncoursedata::get_classlist(); 7168: my $which=$env{'form.scantron_line'}; 7169: my $line=&scantron_get_line($scanlines,$scan_data,$which); 7170: my ($skip,$err,$errmsg); 7171: if ($env{'form.scantron_skip_record'}) { 7172: $skip=1; 7173: } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { 7174: my $newstudent=$env{'form.scantron_username'}.':'. 7175: $env{'form.scantron_domain'}; 7176: my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; 7177: ($line,$err,$errmsg)= 7178: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 7179: 'ID',{'newid'=>$newid, 7180: 'username'=>$env{'form.scantron_username'}, 7181: 'domain'=>$env{'form.scantron_domain'}}); 7182: } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { 7183: my $resolution=$env{'form.scantron_CODE_resolution'}; 7184: my $newCODE; 7185: my %args; 7186: if ($resolution eq 'use_unfound') { 7187: $newCODE='use_unfound'; 7188: } elsif ($resolution eq 'use_found') { 7189: $newCODE=$env{'form.scantron_CODE_selectedvalue'}; 7190: } elsif ($resolution eq 'use_typed') { 7191: $newCODE=$env{'form.scantron_CODE_newvalue'}; 7192: } elsif ($resolution =~ /^use_closest_(\d+)/) { 7193: $newCODE=$env{"form.scantron_CODE_closest_$1"}; 7194: } 7195: if ($env{'form.scantron_corrections'} eq 'duplicateCODE') { 7196: $args{'CODE_ignore_dup'}=1; 7197: } 7198: $args{'CODE'}=$newCODE; 7199: ($line,$err,$errmsg)= 7200: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 7201: 'CODE',\%args); 7202: } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { 7203: foreach my $question (split(',',$env{'form.scantron_questions'})) { 7204: ($line,$err,$errmsg)= 7205: &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, 7206: $which,'answer', 7207: { 'question'=>$question, 7208: 'response'=>$env{"form.scantron_correct_Q_$question"}, 7209: 'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}}); 7210: if ($err) { last; } 7211: } 7212: } 7213: if ($err) { 7214: $r->print( 7215: '<p class="LC_error">' 7216: .&mt('Unable to accept last correction, an error occurred: [_1]', 7217: $errmsg) 7218: .'</p>'); 7219: } else { 7220: &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); 7221: &scantron_putfile($scanlines,$scan_data); 7222: } 7223: } 7224: 7225: =pod 7226: 7227: =item reset_skipping_status 7228: 7229: Forgets the current set of remember skipped scanlines (and thus 7230: reverts back to considering all lines in the 7231: scantron_skipped_<filename> file) 7232: 7233: =cut 7234: 7235: sub reset_skipping_status { 7236: my ($scanlines,$scan_data)=&scantron_getfile(); 7237: &scan_data($scan_data,'remember_skipping',undef,1); 7238: &scantron_putfile(undef,$scan_data); 7239: } 7240: 7241: =pod 7242: 7243: =item start_skipping 7244: 7245: Marks a scanline to be skipped. 7246: 7247: =cut 7248: 7249: sub start_skipping { 7250: my ($scan_data,$i)=@_; 7251: my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); 7252: if ($env{'form.scantron_options_redo'} =~ /^redo_/) { 7253: $remembered{$i}=2; 7254: } else { 7255: $remembered{$i}=1; 7256: } 7257: &scan_data($scan_data,'remember_skipping',join(':',%remembered)); 7258: } 7259: 7260: =pod 7261: 7262: =item should_be_skipped 7263: 7264: Checks whether a scanline should be skipped. 7265: 7266: =cut 7267: 7268: sub should_be_skipped { 7269: my ($scanlines,$scan_data,$i)=@_; 7270: if ($env{'form.scantron_options_redo'} !~ /^redo_/) { 7271: # not redoing old skips 7272: if ($scanlines->{'skipped'}[$i]) { return 1; } 7273: return 0; 7274: } 7275: my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); 7276: 7277: if (exists($remembered{$i}) && $remembered{$i} != 2 ) { 7278: return 0; 7279: } 7280: return 1; 7281: } 7282: 7283: =pod 7284: 7285: =item remember_current_skipped 7286: 7287: Discovers what scanlines are in the scantron_skipped_<filename> 7288: file and remembers them into scan_data for later use. 7289: 7290: =cut 7291: 7292: sub remember_current_skipped { 7293: my ($scanlines,$scan_data)=&scantron_getfile(); 7294: my %to_remember; 7295: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7296: if ($scanlines->{'skipped'}[$i]) { 7297: $to_remember{$i}=1; 7298: } 7299: } 7300: 7301: &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); 7302: &scantron_putfile(undef,$scan_data); 7303: } 7304: 7305: =pod 7306: 7307: =item check_for_error 7308: 7309: Checks if there was an error when attempting to remove a specific 7310: scantron_.. bubblesheet data file. Prints out an error if 7311: something went wrong. 7312: 7313: =cut 7314: 7315: sub check_for_error { 7316: my ($r,$result)=@_; 7317: if ($result ne 'ok' && $result ne 'not_found' ) { 7318: $r->print(&mt("An error occurred ([_1]) when trying to remove the existing corrections.",$result)); 7319: } 7320: } 7321: 7322: =pod 7323: 7324: =item scantron_warning_screen 7325: 7326: Interstitial screen to make sure the operator has selected the 7327: correct options before we start the validation phase. 7328: 7329: =cut 7330: 7331: sub scantron_warning_screen { 7332: my ($button_text,$symb)=@_; 7333: my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); 7334: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 7335: my $CODElist; 7336: if ($scantron_config{'CODElocation'} && 7337: $scantron_config{'CODEstart'} && 7338: $scantron_config{'CODElength'}) { 7339: $CODElist=$env{'form.scantron_CODElist'}; 7340: if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">'.&mt('None').'</span>'; } 7341: $CODElist= 7342: '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'. 7343: $env{'form.scantron_CODElist'}.'</tt></td></tr>'; 7344: } 7345: my $lastbubblepoints; 7346: if ($env{'form.scantron_lastbubblepoints'} ne '') { 7347: $lastbubblepoints = 7348: '<tr><td><b>'.&mt('Hand-graded items: points from last bubble in row').'</b></td><td><tt>'. 7349: $env{'form.scantron_lastbubblepoints'}.'</tt></td></tr>'; 7350: } 7351: return (' 7352: <p> 7353: <span class="LC_warning"> 7354: '.&mt("Please double check the information below before clicking on '[_1]'",&mt($button_text)).'</span> 7355: </p> 7356: <table> 7357: <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr> 7358: <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr> 7359: '.$CODElist.$lastbubblepoints.' 7360: </table> 7361: <p> '.&mt("If this information is correct, please click on '[_1]'.",&mt($button_text)).'<br /> 7362: '.&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> 7363: 7364: <br /> 7365: '); 7366: } 7367: 7368: =pod 7369: 7370: =item scantron_do_warning 7371: 7372: Check if the operator has picked something for all required 7373: fields. Error out if something is missing. 7374: 7375: =cut 7376: 7377: sub scantron_do_warning { 7378: my ($r,$symb)=@_; 7379: if (!$symb) {return '';} 7380: my $default_form_data=&defaultFormData($symb); 7381: $r->print(&scantron_form_start().$default_form_data); 7382: if ( $env{'form.selectpage'} eq '' || 7383: $env{'form.scantron_selectfile'} eq '' || 7384: $env{'form.scantron_format'} eq '' ) { 7385: $r->print("<p>".&mt('You have forgotten to specify some information. Please go Back and try again.')."</p>"); 7386: if ( $env{'form.selectpage'} eq '') { 7387: $r->print('<p><span class="LC_error">'.&mt('You have not selected a Sequence to grade').'</span></p>'); 7388: } 7389: if ( $env{'form.scantron_selectfile'} eq '') { 7390: $r->print('<p><span class="LC_error">'.&mt("You have not selected a file that contains the student's response data.").'</span></p>'); 7391: } 7392: if ( $env{'form.scantron_format'} eq '') { 7393: $r->print('<p><span class="LC_error">'.&mt("You have not selected the format of the student's response data.").'</span></p>'); 7394: } 7395: } else { 7396: my $warning=&scantron_warning_screen('Grading: Validate Records',$symb); 7397: my $bubbledbyhand=&hand_bubble_option(); 7398: $r->print(' 7399: '.$warning.$bubbledbyhand.' 7400: <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" /> 7401: <input type="hidden" name="command" value="scantron_validate" /> 7402: '); 7403: } 7404: $r->print("</form><br />"); 7405: return ''; 7406: } 7407: 7408: =pod 7409: 7410: =item scantron_form_start 7411: 7412: html hidden input for remembering all selected grading options 7413: 7414: =cut 7415: 7416: sub scantron_form_start { 7417: my ($max_bubble)=@_; 7418: my $result= <<SCANTRONFORM; 7419: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> 7420: <input type="hidden" name="selectpage" value="$env{'form.selectpage'}" /> 7421: <input type="hidden" name="scantron_format" value="$env{'form.scantron_format'}" /> 7422: <input type="hidden" name="scantron_selectfile" value="$env{'form.scantron_selectfile'}" /> 7423: <input type="hidden" name="scantron_maxbubble" value="$max_bubble" /> 7424: <input type="hidden" name="scantron_CODElist" value="$env{'form.scantron_CODElist'}" /> 7425: <input type="hidden" name="scantron_CODEunique" value="$env{'form.scantron_CODEunique'}" /> 7426: <input type="hidden" name="scantron_options_redo" value="$env{'form.scantron_options_redo'}" /> 7427: <input type="hidden" name="scantron_options_ignore" value="$env{'form.scantron_options_ignore'}" /> 7428: <input type="hidden" name="scantron_options_hidden" value="$env{'form.scantron_options_hidden'}" /> 7429: SCANTRONFORM 7430: 7431: my $line = 0; 7432: while (defined($env{"form.scantron.bubblelines.$line"})) { 7433: my $chunk = 7434: '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n"; 7435: $chunk .= 7436: '<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n"; 7437: $chunk .= 7438: '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n"; 7439: $chunk .= 7440: '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n"; 7441: $chunk .= 7442: '<input type="hidden" name="scantron.residpart.'.$line.'" value="'.$env{"form.scantron.residpart.$line"}.'" />'."\n"; 7443: $result .= $chunk; 7444: $line++; 7445: } 7446: return $result; 7447: } 7448: 7449: =pod 7450: 7451: =item scantron_validate_file 7452: 7453: Dispatch routine for doing validation of a bubblesheet data file. 7454: 7455: Also processes any necessary information resets that need to 7456: occur before validation begins (ignore previous corrections, 7457: restarting the skipped records processing) 7458: 7459: =cut 7460: 7461: sub scantron_validate_file { 7462: my ($r,$symb) = @_; 7463: if (!$symb) {return '';} 7464: my $default_form_data=&defaultFormData($symb); 7465: 7466: # do the detection of only doing skipped records first before we delete 7467: # them when doing the corrections reset 7468: if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') { 7469: &reset_skipping_status(); 7470: } 7471: if ($env{'form.scantron_options_redo'} eq 'redo_skipped') { 7472: &remember_current_skipped(); 7473: $env{'form.scantron_options_redo'}='redo_skipped_ready'; 7474: } 7475: 7476: if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') { 7477: &check_for_error($r,&scantron_remove_file('corrected')); 7478: &check_for_error($r,&scantron_remove_file('skipped')); 7479: &check_for_error($r,&scantron_remove_scan_data()); 7480: $env{'form.scantron_options_ignore'}='done'; 7481: } 7482: 7483: if ($env{'form.scantron_corrections'}) { 7484: &scantron_process_corrections($r); 7485: } 7486: $r->print('<p>'.&mt('Gathering necessary information.').'</p>');$r->rflush(); 7487: #get the student pick code ready 7488: $r->print(&Apache::loncommon::studentbrowser_javascript()); 7489: my $nav_error; 7490: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 7491: my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); 7492: if ($nav_error) { 7493: $r->print(&navmap_errormsg()); 7494: return ''; 7495: } 7496: my $result=&scantron_form_start($max_bubble).$default_form_data; 7497: if ($env{'form.scantron_lastbubblepoints'} ne '') { 7498: $result .= '<input type="hidden" name="scantron_lastbubblepoints" value="'.$env{'form.scantron_lastbubblepoints'}.'" />'; 7499: } 7500: $r->print($result); 7501: 7502: my @validate_phases=( 'sequence', 7503: 'ID', 7504: 'CODE', 7505: 'doublebubble', 7506: 'missingbubbles'); 7507: if (!$env{'form.validatepass'}) { 7508: $env{'form.validatepass'} = 0; 7509: } 7510: my $currentphase=$env{'form.validatepass'}; 7511: 7512: 7513: my $stop=0; 7514: while (!$stop && $currentphase < scalar(@validate_phases)) { 7515: $r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />'); 7516: $r->rflush(); 7517: 7518: my $which="scantron_validate_".$validate_phases[$currentphase]; 7519: { 7520: no strict 'refs'; 7521: ($stop,$currentphase)=&$which($r,$currentphase); 7522: } 7523: } 7524: if (!$stop) { 7525: my $warning=&scantron_warning_screen('Start Grading',$symb); 7526: $r->print(&mt('Validation process complete.').'<br />'. 7527: $warning. 7528: &mt('Perform verification for each student after storage of submissions?'). 7529: ' <span class="LC_nobreak"><label>'. 7530: '<input type="radio" name="verifyrecord" value="1" />'.&mt('Yes').'</label>'. 7531: (' 'x3).'<label>'. 7532: '<input type="radio" name="verifyrecord" value="0" checked="checked" />'.&mt('No'). 7533: '</label></span><br />'. 7534: &mt('Grading will take longer if you use verification.').'<br />'. 7535: &mt('Otherwise, Grade/Manage/Review Bubblesheets [_1] Review bubblesheet data can be used once grading is complete.','»').'<br /><br />'. 7536: '<input type="submit" name="submit" value="'.&mt('Start Grading').'" />'. 7537: '<input type="hidden" name="command" value="scantron_process" />'."\n"); 7538: } else { 7539: $r->print('<input type="hidden" name="command" value="scantron_validate" />'); 7540: $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />"); 7541: } 7542: if ($stop) { 7543: if ($validate_phases[$currentphase] eq 'sequence') { 7544: $r->print('<input type="submit" name="submit" value="'.&mt('Ignore').' → " />'); 7545: $r->print(' '.&mt('this error').' <br />'); 7546: 7547: $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>'); 7548: } else { 7549: if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') { 7550: $r->print('<input type="button" name="submitbutton" value="'.&mt('Continue').' →" onclick="javascript:verify_bubble_radio(this.form)" />'); 7551: } else { 7552: $r->print('<input type="submit" name="submit" value="'.&mt('Continue').' →" />'); 7553: } 7554: $r->print(' '.&mt('using corrected info').' <br />'); 7555: $r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />"); 7556: $r->print(" ".&mt("this scanline saving it for later.")); 7557: } 7558: } 7559: $r->print(" </form><br />"); 7560: return ''; 7561: } 7562: 7563: 7564: =pod 7565: 7566: =item scantron_remove_file 7567: 7568: Removes the requested bubblesheet data file, makes sure that 7569: scantron_original_<filename> is never removed 7570: 7571: 7572: =cut 7573: 7574: sub scantron_remove_file { 7575: my ($which)=@_; 7576: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 7577: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 7578: my $file='scantron_'; 7579: if ($which eq 'corrected' || $which eq 'skipped') { 7580: $file.=$which.'_'; 7581: } else { 7582: return 'refused'; 7583: } 7584: $file.=$env{'form.scantron_selectfile'}; 7585: return &Apache::lonnet::removeuserfile($cname,$cdom,$file); 7586: } 7587: 7588: 7589: =pod 7590: 7591: =item scantron_remove_scan_data 7592: 7593: Removes all scan_data correction for the requested bubblesheet 7594: data file. (In the case that both the are doing skipped records we need 7595: to remember the old skipped lines for the time being so that element 7596: persists for a while.) 7597: 7598: =cut 7599: 7600: sub scantron_remove_scan_data { 7601: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 7602: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 7603: my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname); 7604: my @todelete; 7605: my $filename=$env{'form.scantron_selectfile'}; 7606: foreach my $key (@keys) { 7607: if ($key=~/^\Q$filename\E_/) { 7608: if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' && 7609: $key=~/remember_skipping/) { 7610: next; 7611: } 7612: push(@todelete,$key); 7613: } 7614: } 7615: my $result; 7616: if (@todelete) { 7617: $result = &Apache::lonnet::del('nohist_scantrondata', 7618: \@todelete,$cdom,$cname); 7619: } else { 7620: $result = 'ok'; 7621: } 7622: return $result; 7623: } 7624: 7625: 7626: =pod 7627: 7628: =item scantron_getfile 7629: 7630: Fetches the requested bubblesheet data file (all 3 versions), and 7631: the scan_data hash 7632: 7633: Arguments: 7634: None 7635: 7636: Returns: 7637: 2 hash references 7638: 7639: - first one has 7640: orig - 7641: corrected - 7642: skipped - each of which points to an array ref of the specified 7643: file broken up into individual lines 7644: count - number of scanlines 7645: 7646: - second is the scan_data hash possible keys are 7647: ($number refers to scanline numbered $number and thus the key affects 7648: only that scanline 7649: $bubline refers to the specific bubble line element and the aspects 7650: refers to that specific bubble line element) 7651: 7652: $number.user - username:domain to use 7653: $number.CODE_ignore_dup 7654: - ignore the duplicate CODE error 7655: $number.useCODE 7656: - use the CODE in the scanline as is 7657: $number.no_bubble.$bubline 7658: - it is valid that there is no bubbled in bubble 7659: at $number $bubline 7660: remember_skipping 7661: - a frozen hash containing keys of $number and values 7662: of either 7663: 1 - we are on a 'do skipped records pass' and plan 7664: on processing this line 7665: 2 - we are on a 'do skipped records pass' and this 7666: scanline has been marked to skip yet again 7667: 7668: =cut 7669: 7670: sub scantron_getfile { 7671: #FIXME really would prefer a scantron directory 7672: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 7673: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 7674: my $lines; 7675: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 7676: 'scantron_orig_'.$env{'form.scantron_selectfile'}); 7677: my %scanlines; 7678: $scanlines{'orig'}=[(split("\n",$lines,-1))]; 7679: my $temp=$scanlines{'orig'}; 7680: $scanlines{'count'}=$#$temp; 7681: 7682: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 7683: 'scantron_corrected_'.$env{'form.scantron_selectfile'}); 7684: if ($lines eq '-1') { 7685: $scanlines{'corrected'}=[]; 7686: } else { 7687: $scanlines{'corrected'}=[(split("\n",$lines,-1))]; 7688: } 7689: $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 7690: 'scantron_skipped_'.$env{'form.scantron_selectfile'}); 7691: if ($lines eq '-1') { 7692: $scanlines{'skipped'}=[]; 7693: } else { 7694: $scanlines{'skipped'}=[(split("\n",$lines,-1))]; 7695: } 7696: my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname); 7697: if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } 7698: my %scan_data = @tmp; 7699: return (\%scanlines,\%scan_data); 7700: } 7701: 7702: =pod 7703: 7704: =item lonnet_putfile 7705: 7706: Wrapper routine to call &Apache::lonnet::finishuserfileupload 7707: 7708: Arguments: 7709: $contents - data to store 7710: $filename - filename to store $contents into 7711: 7712: Returns: 7713: result value from &Apache::lonnet::finishuserfileupload 7714: 7715: =cut 7716: 7717: sub lonnet_putfile { 7718: my ($contents,$filename)=@_; 7719: my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; 7720: my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 7721: $env{'form.sillywaytopassafilearound'}=$contents; 7722: &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename); 7723: 7724: } 7725: 7726: =pod 7727: 7728: =item scantron_putfile 7729: 7730: Stores the current version of the bubblesheet data files, and the 7731: scan_data hash. (Does not modify the original version only the 7732: corrected and skipped versions. 7733: 7734: Arguments: 7735: $scanlines - hash ref that looks like the first return value from 7736: &scantron_getfile() 7737: $scan_data - hash ref that looks like the second return value from 7738: &scantron_getfile() 7739: 7740: =cut 7741: 7742: sub scantron_putfile { 7743: my ($scanlines,$scan_data) = @_; 7744: #FIXME really would prefer a scantron directory 7745: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 7746: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 7747: if ($scanlines) { 7748: my $prefix='scantron_'; 7749: # no need to update orig, shouldn't change 7750: # &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'. 7751: # $env{'form.scantron_selectfile'}); 7752: &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}), 7753: $prefix.'corrected_'. 7754: $env{'form.scantron_selectfile'}); 7755: &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), 7756: $prefix.'skipped_'. 7757: $env{'form.scantron_selectfile'}); 7758: } 7759: &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); 7760: } 7761: 7762: =pod 7763: 7764: =item scantron_get_line 7765: 7766: Returns the correct version of the scanline 7767: 7768: Arguments: 7769: $scanlines - hash ref that looks like the first return value from 7770: &scantron_getfile() 7771: $scan_data - hash ref that looks like the second return value from 7772: &scantron_getfile() 7773: $i - number of the requested line (starts at 0) 7774: 7775: Returns: 7776: A scanline, (either the original or the corrected one if it 7777: exists), or undef if the requested scanline should be 7778: skipped. (Either because it's an skipped scanline, or it's an 7779: unskipped scanline and we are not doing a 'do skipped scanlines' 7780: pass. 7781: 7782: =cut 7783: 7784: sub scantron_get_line { 7785: my ($scanlines,$scan_data,$i)=@_; 7786: if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } 7787: #if ($scanlines->{'skipped'}[$i]) { return undef; } 7788: if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} 7789: return $scanlines->{'orig'}[$i]; 7790: } 7791: 7792: =pod 7793: 7794: =item scantron_todo_count 7795: 7796: Counts the number of scanlines that need processing. 7797: 7798: Arguments: 7799: $scanlines - hash ref that looks like the first return value from 7800: &scantron_getfile() 7801: $scan_data - hash ref that looks like the second return value from 7802: &scantron_getfile() 7803: 7804: Returns: 7805: $count - number of scanlines to process 7806: 7807: =cut 7808: 7809: sub get_todo_count { 7810: my ($scanlines,$scan_data)=@_; 7811: my $count=0; 7812: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7813: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7814: if ($line=~/^[\s\cz]*$/) { next; } 7815: $count++; 7816: } 7817: return $count; 7818: } 7819: 7820: =pod 7821: 7822: =item scantron_put_line 7823: 7824: Updates the 'corrected' or 'skipped' versions of the bubblesheet 7825: data file. 7826: 7827: Arguments: 7828: $scanlines - hash ref that looks like the first return value from 7829: &scantron_getfile() 7830: $scan_data - hash ref that looks like the second return value from 7831: &scantron_getfile() 7832: $i - line number to update 7833: $newline - contents of the updated scanline 7834: $skip - if true make the line for skipping and update the 7835: 'skipped' file 7836: 7837: =cut 7838: 7839: sub scantron_put_line { 7840: my ($scanlines,$scan_data,$i,$newline,$skip)=@_; 7841: if ($skip) { 7842: $scanlines->{'skipped'}[$i]=$newline; 7843: &start_skipping($scan_data,$i); 7844: return; 7845: } 7846: $scanlines->{'corrected'}[$i]=$newline; 7847: } 7848: 7849: =pod 7850: 7851: =item scantron_clear_skip 7852: 7853: Remove a line from the 'skipped' file 7854: 7855: Arguments: 7856: $scanlines - hash ref that looks like the first return value from 7857: &scantron_getfile() 7858: $scan_data - hash ref that looks like the second return value from 7859: &scantron_getfile() 7860: $i - line number to update 7861: 7862: =cut 7863: 7864: sub scantron_clear_skip { 7865: my ($scanlines,$scan_data,$i)=@_; 7866: if (exists($scanlines->{'skipped'}[$i])) { 7867: undef($scanlines->{'skipped'}[$i]); 7868: return 1; 7869: } 7870: return 0; 7871: } 7872: 7873: =pod 7874: 7875: =item scantron_filter_not_exam 7876: 7877: Filter routine used by &Apache::lonnavmaps::retrieveResources(), to 7878: filter out resources that are not marked as 'exam' mode 7879: 7880: =cut 7881: 7882: sub scantron_filter_not_exam { 7883: my ($curres)=@_; 7884: 7885: if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) { 7886: # if the user has asked to not have either hidden 7887: # or 'randomout' controlled resources to be graded 7888: # don't include them 7889: if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' 7890: && $curres->randomout) { 7891: return 0; 7892: } 7893: return 1; 7894: } 7895: return 0; 7896: } 7897: 7898: =pod 7899: 7900: =item scantron_validate_sequence 7901: 7902: Validates the selected sequence, checking for resource that are 7903: not set to exam mode. 7904: 7905: =cut 7906: 7907: sub scantron_validate_sequence { 7908: my ($r,$currentphase) = @_; 7909: 7910: my $navmap=Apache::lonnavmaps::navmap->new(); 7911: unless (ref($navmap)) { 7912: $r->print(&navmap_errormsg()); 7913: return (1,$currentphase); 7914: } 7915: my (undef,undef,$sequence)= 7916: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 7917: 7918: my $map=$navmap->getResourceByUrl($sequence); 7919: 7920: $r->print('<input type="hidden" name="validate_sequence_exam" 7921: value="ignore" />'); 7922: if ($env{'form.validate_sequence_exam'} ne 'ignore') { 7923: my @resources= 7924: $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); 7925: if (@resources) { 7926: $r->print('<p class="LC_warning">' 7927: .&mt('Some resources in the sequence currently are not set to' 7928: .' exam mode. Grading these resources currently may not' 7929: .' work correctly.') 7930: .'</p>' 7931: ); 7932: return (1,$currentphase); 7933: } 7934: } 7935: 7936: return (0,$currentphase+1); 7937: } 7938: 7939: 7940: 7941: sub scantron_validate_ID { 7942: my ($r,$currentphase) = @_; 7943: 7944: #get student info 7945: my $classlist=&Apache::loncoursedata::get_classlist(); 7946: my %idmap=&username_to_idmap($classlist); 7947: 7948: #get scantron line setup 7949: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 7950: my ($scanlines,$scan_data)=&scantron_getfile(); 7951: 7952: my $nav_error; 7953: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble_lines.. array. 7954: if ($nav_error) { 7955: $r->print(&navmap_errormsg()); 7956: return(1,$currentphase); 7957: } 7958: 7959: my %found=('ids'=>{},'usernames'=>{}); 7960: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 7961: my $line=&scantron_get_line($scanlines,$scan_data,$i); 7962: if ($line=~/^[\s\cz]*$/) { next; } 7963: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 7964: $scan_data); 7965: my $id=$$scan_record{'scantron.ID'}; 7966: my $found; 7967: foreach my $checkid (keys(%idmap)) { 7968: if (lc($checkid) eq lc($id)) { $found=$checkid;last; } 7969: } 7970: if ($found) { 7971: my $username=$idmap{$found}; 7972: if ($found{'ids'}{$found}) { 7973: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 7974: $line,'duplicateID',$found); 7975: return(1,$currentphase); 7976: } elsif ($found{'usernames'}{$username}) { 7977: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 7978: $line,'duplicateID',$username); 7979: return(1,$currentphase); 7980: } 7981: #FIXME store away line we previously saw the ID on to use above 7982: $found{'ids'}{$found}++; 7983: $found{'usernames'}{$username}++; 7984: } else { 7985: if ($id =~ /^\s*$/) { 7986: my $username=&scan_data($scan_data,"$i.user"); 7987: if (defined($username) && $found{'usernames'}{$username}) { 7988: &scantron_get_correction($r,$i,$scan_record, 7989: \%scantron_config, 7990: $line,'duplicateID',$username); 7991: return(1,$currentphase); 7992: } elsif (!defined($username)) { 7993: &scantron_get_correction($r,$i,$scan_record, 7994: \%scantron_config, 7995: $line,'incorrectID'); 7996: return(1,$currentphase); 7997: } 7998: $found{'usernames'}{$username}++; 7999: } else { 8000: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 8001: $line,'incorrectID'); 8002: return(1,$currentphase); 8003: } 8004: } 8005: } 8006: 8007: return (0,$currentphase+1); 8008: } 8009: 8010: 8011: sub scantron_get_correction { 8012: my ($r,$i,$scan_record,$scan_config,$line,$error,$arg, 8013: $randomorder,$randompick,$respnumlookup,$startline)=@_; 8014: #FIXME in the case of a duplicated ID the previous line, probably need 8015: #to show both the current line and the previous one and allow skipping 8016: #the previous one or the current one 8017: 8018: if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { 8019: $r->print( 8020: '<p class="LC_warning">' 8021: .&mt('An error was detected ([_1]) for PaperID [_2]', 8022: "<b>$error</b>", 8023: '<tt>'.$$scan_record{'scantron.PaperID'}.'</tt>') 8024: ."</p> \n"); 8025: } else { 8026: $r->print( 8027: '<p class="LC_warning">' 8028: .&mt('An error was detected ([_1]) in scanline [_2] [_3]', 8029: "<b>$error</b>", $i, "<pre>$line</pre>") 8030: ."</p> \n"); 8031: } 8032: my $message = 8033: '<p>' 8034: .&mt('The ID on the form is [_1]', 8035: "<tt>$$scan_record{'scantron.ID'}</tt>") 8036: .'<br />' 8037: .&mt('The name on the paper is [_1], [_2]', 8038: $$scan_record{'scantron.LastName'}, 8039: $$scan_record{'scantron.FirstName'}) 8040: .'</p>'; 8041: 8042: $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); 8043: $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n"); 8044: # Array populated for doublebubble or 8045: my @lines_to_correct; # missingbubble errors to build javascript 8046: # to validate radio button checking 8047: 8048: if ($error =~ /ID$/) { 8049: if ($error eq 'incorrectID') { 8050: $r->print('<p class="LC_warning">'.&mt("The encoded ID is not in the classlist"). 8051: "</p>\n"); 8052: } elsif ($error eq 'duplicateID') { 8053: $r->print('<p class="LC_warning">'.&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n"); 8054: } 8055: $r->print($message); 8056: $r->print("<p>".&mt("How should I handle this?")." <br /> \n"); 8057: $r->print("\n<ul><li> "); 8058: #FIXME it would be nice if this sent back the user ID and 8059: #could do partial userID matches 8060: $r->print(&Apache::loncommon::selectstudent_link('scantronupload', 8061: 'scantron_username','scantron_domain')); 8062: $r->print(": <input type='text' name='scantron_username' value='' />"); 8063: $r->print("\n:\n". 8064: &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain')); 8065: 8066: $r->print('</li>'); 8067: } elsif ($error =~ /CODE$/) { 8068: if ($error eq 'incorrectCODE') { 8069: $r->print('<p class="LC_warning">'.&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n"); 8070: } elsif ($error eq 'duplicateCODE') { 8071: $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"); 8072: } 8073: $r->print("<p>".&mt('The CODE on the form is [_1]', 8074: "<tt>'$$scan_record{'scantron.CODE'}'</tt>") 8075: ."</p>\n"); 8076: $r->print($message); 8077: $r->print("<p>".&mt("How should I handle this?")."</p>\n"); 8078: $r->print("\n<br /> "); 8079: my $i=0; 8080: if ($error eq 'incorrectCODE' 8081: && $$scan_record{'scantron.CODE'}=~/\S/ ) { 8082: my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); 8083: if ($closest > 0) { 8084: foreach my $testcode (@{$closest}) { 8085: my $checked=''; 8086: if (!$i) { $checked=' checked="checked"'; } 8087: $r->print(" 8088: <label> 8089: <input type='radio' name='scantron_CODE_resolution' value='use_closest_$i'$checked /> 8090: ".&mt("Use the similar CODE [_1] instead.", 8091: "<b><tt>".$testcode."</tt></b>")." 8092: </label> 8093: <input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />"); 8094: $r->print("\n<br />"); 8095: $i++; 8096: } 8097: } 8098: } 8099: if ($$scan_record{'scantron.CODE'}=~/\S/ ) { 8100: my $checked; if (!$i) { $checked=' checked="checked"'; } 8101: $r->print(" 8102: <label> 8103: <input type='radio' name='scantron_CODE_resolution' value='use_unfound'$checked /> 8104: ".&mt("Use the CODE [_1] that was on the paper, ignoring the error.", 8105: "<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")." 8106: </label>"); 8107: $r->print("\n<br />"); 8108: } 8109: 8110: $r->print(&Apache::lonhtmlcommon::scripttag(<<ENDSCRIPT)); 8111: function change_radio(field) { 8112: var slct=document.scantronupload.scantron_CODE_resolution; 8113: var i; 8114: for (i=0;i<slct.length;i++) { 8115: if (slct[i].value==field) { slct[i].checked=true; } 8116: } 8117: } 8118: ENDSCRIPT 8119: my $href="/adm/pickcode?". 8120: "form=".&escape("scantronupload"). 8121: "&scantron_format=".&escape($env{'form.scantron_format'}). 8122: "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). 8123: "&curCODE=".&escape($$scan_record{'scantron.CODE'}). 8124: "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); 8125: if ($env{'form.scantron_CODElist'} =~ /\S/) { 8126: $r->print(" 8127: <label> 8128: <input type='radio' name='scantron_CODE_resolution' value='use_found' /> 8129: ".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.", 8130: "<a target='_blank' href='$href'>","</a>")." 8131: </label> 8132: ".&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\')" />')); 8133: $r->print("\n<br />"); 8134: } 8135: $r->print(" 8136: <label> 8137: <input type='radio' name='scantron_CODE_resolution' value='use_typed' /> 8138: ".&mt("Use [_1] as the CODE.", 8139: "</label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" />")); 8140: $r->print("\n<br /><br />"); 8141: } elsif ($error eq 'doublebubble') { 8142: $r->print('<p class="LC_warning">'.&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n"); 8143: 8144: # The form field scantron_questions is acutally a list of line numbers. 8145: # represented by this form so: 8146: 8147: my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, 8148: $respnumlookup,$startline); 8149: 8150: $r->print('<input type="hidden" name="scantron_questions" value="'. 8151: $line_list.'" />'); 8152: $r->print($message); 8153: $r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>"); 8154: foreach my $question (@{$arg}) { 8155: my @linenums = &prompt_for_corrections($r,$question,$scan_config, 8156: $scan_record, $error, 8157: $randomorder,$randompick, 8158: $respnumlookup,$startline); 8159: push(@lines_to_correct,@linenums); 8160: } 8161: $r->print(&verify_bubbles_checked(@lines_to_correct)); 8162: } elsif ($error eq 'missingbubble') { 8163: $r->print('<p class="LC_warning">'.&mt("There have been [_1]no[_2] bubbles scanned for some question(s)",'<b>','</b>')."</p>\n"); 8164: $r->print($message); 8165: $r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>"); 8166: $r->print(&mt("Some questions have no scanned bubbles.")."\n"); 8167: 8168: # The form field scantron_questions is actually a list of line numbers not 8169: # a list of question numbers. Therefore: 8170: # 8171: 8172: my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, 8173: $respnumlookup,$startline); 8174: 8175: $r->print('<input type="hidden" name="scantron_questions" value="'. 8176: $line_list.'" />'); 8177: foreach my $question (@{$arg}) { 8178: my @linenums = &prompt_for_corrections($r,$question,$scan_config, 8179: $scan_record, $error, 8180: $randomorder,$randompick, 8181: $respnumlookup,$startline); 8182: push(@lines_to_correct,@linenums); 8183: } 8184: $r->print(&verify_bubbles_checked(@lines_to_correct)); 8185: } else { 8186: $r->print("\n<ul>"); 8187: } 8188: $r->print("\n</li></ul>"); 8189: } 8190: 8191: sub verify_bubbles_checked { 8192: my (@ansnums) = @_; 8193: my $ansnumstr = join('","',@ansnums); 8194: my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines."); 8195: &js_escape(\$warning); 8196: my $output = &Apache::lonhtmlcommon::scripttag(<<ENDSCRIPT); 8197: function verify_bubble_radio(form) { 8198: var ansnumArray = new Array ("$ansnumstr"); 8199: var need_bubble_count = 0; 8200: for (var i=0; i<ansnumArray.length; i++) { 8201: if (form.elements["scantron_correct_Q_"+ansnumArray[i]].length > 1) { 8202: var bubble_picked = 0; 8203: for (var j=0; j<form.elements["scantron_correct_Q_"+ansnumArray[i]].length; j++) { 8204: if (form.elements["scantron_correct_Q_"+ansnumArray[i]][j].checked == true) { 8205: bubble_picked = 1; 8206: } 8207: } 8208: if (bubble_picked == 0) { 8209: need_bubble_count ++; 8210: } 8211: } 8212: } 8213: if (need_bubble_count) { 8214: alert("$warning"); 8215: return; 8216: } 8217: form.submit(); 8218: } 8219: ENDSCRIPT 8220: return $output; 8221: } 8222: 8223: =pod 8224: 8225: =item questions_to_line_list 8226: 8227: Converts a list of questions into a string of comma separated 8228: line numbers in the answer sheet used by the questions. This is 8229: used to fill in the scantron_questions form field. 8230: 8231: Arguments: 8232: questions - Reference to an array of questions. 8233: randomorder - True if randomorder in use. 8234: randompick - True if randompick in use. 8235: respnumlookup - Reference to HASH mapping question numbers in bubble lines 8236: for current line to question number used for same question 8237: in "Master Seqence" (as seen by Course Coordinator). 8238: startline - Reference to hash where key is question number (0 is first) 8239: and key is number of first bubble line for current student 8240: or code-based randompick and/or randomorder. 8241: 8242: =cut 8243: 8244: 8245: sub questions_to_line_list { 8246: my ($questions,$randomorder,$randompick,$respnumlookup,$startline) = @_; 8247: my @lines; 8248: 8249: foreach my $item (@{$questions}) { 8250: my $question = $item; 8251: my ($first,$count,$last); 8252: if ($item =~ /^(\d+)\.(\d+)$/) { 8253: $question = $1; 8254: my $subquestion = $2; 8255: my $responsenum = $question-1; 8256: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { 8257: $responsenum = $respnumlookup->{$question-1}; 8258: if (ref($startline) eq 'HASH') { 8259: $first = $startline->{$question-1} + 1; 8260: } 8261: } else { 8262: $first = $first_bubble_line{$responsenum} + 1; 8263: } 8264: my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); 8265: my $subcount = 1; 8266: while ($subcount<$subquestion) { 8267: $first += $subans[$subcount-1]; 8268: $subcount ++; 8269: } 8270: $count = $subans[$subquestion-1]; 8271: } else { 8272: my $responsenum = $question-1; 8273: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { 8274: $responsenum = $respnumlookup->{$question-1}; 8275: if (ref($startline) eq 'HASH') { 8276: $first = $startline->{$question-1} + 1; 8277: } 8278: } else { 8279: $first = $first_bubble_line{$responsenum} + 1; 8280: } 8281: $count = $bubble_lines_per_response{$responsenum}; 8282: } 8283: $last = $first+$count-1; 8284: push(@lines, ($first..$last)); 8285: } 8286: return join(',', @lines); 8287: } 8288: 8289: =pod 8290: 8291: =item prompt_for_corrections 8292: 8293: Prompts for a potentially multiline correction to the 8294: user's bubbling (factors out common code from scantron_get_correction 8295: for multi and missing bubble cases). 8296: 8297: Arguments: 8298: $r - Apache request object. 8299: $question - The question number to prompt for. 8300: $scan_config - The scantron file configuration hash. 8301: $scan_record - Reference to the hash that has the the parsed scanlines. 8302: $error - Type of error 8303: $randomorder - True if randomorder in use. 8304: $randompick - True if randompick in use. 8305: $respnumlookup - Reference to HASH mapping question numbers in bubble lines 8306: for current line to question number used for same question 8307: in "Master Seqence" (as seen by Course Coordinator). 8308: $startline - Reference to hash where key is question number (0 is first) 8309: and value is number of first bubble line for current student 8310: or code-based randompick and/or randomorder. 8311: 8312: Implicit inputs: 8313: %bubble_lines_per_response - Starting line numbers for each question. 8314: Numbered from 0 (but question numbers are from 8315: 1. 8316: %first_bubble_line - Starting bubble line for each question. 8317: %subdivided_bubble_lines - optionresponse, matchresponse and rankresponse 8318: type problems render as separate sub-questions, 8319: in exam mode. This hash contains a 8320: comma-separated list of the lines per 8321: sub-question. 8322: %responsetype_per_response - essayresponse, formularesponse, 8323: stringresponse, imageresponse, reactionresponse, 8324: and organicresponse type problem parts can have 8325: multiple lines per response if the weight 8326: assigned exceeds 10. In this case, only 8327: one bubble per line is permitted, but more 8328: than one line might contain bubbles, e.g. 8329: bubbling of: line 1 - J, line 2 - J, 8330: line 3 - B would assign 22 points. 8331: 8332: =cut 8333: 8334: sub prompt_for_corrections { 8335: my ($r, $question, $scan_config, $scan_record, $error, $randomorder, 8336: $randompick, $respnumlookup, $startline) = @_; 8337: my ($current_line,$lines); 8338: my @linenums; 8339: my $questionnum = $question; 8340: my ($first,$responsenum); 8341: if ($question =~ /^(\d+)\.(\d+)$/) { 8342: $question = $1; 8343: my $subquestion = $2; 8344: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { 8345: $responsenum = $respnumlookup->{$question-1}; 8346: if (ref($startline) eq 'HASH') { 8347: $first = $startline->{$question-1}; 8348: } 8349: } else { 8350: $responsenum = $question-1; 8351: $first = $first_bubble_line{$responsenum}; 8352: } 8353: $current_line = $first + 1 ; 8354: my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); 8355: my $subcount = 1; 8356: while ($subcount<$subquestion) { 8357: $current_line += $subans[$subcount-1]; 8358: $subcount ++; 8359: } 8360: $lines = $subans[$subquestion-1]; 8361: } else { 8362: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { 8363: $responsenum = $respnumlookup->{$question-1}; 8364: if (ref($startline) eq 'HASH') { 8365: $first = $startline->{$question-1}; 8366: } 8367: } else { 8368: $responsenum = $question-1; 8369: $first = $first_bubble_line{$responsenum}; 8370: } 8371: $current_line = $first + 1; 8372: $lines = $bubble_lines_per_response{$responsenum}; 8373: } 8374: if ($lines > 1) { 8375: $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />'); 8376: if (($responsetype_per_response{$responsenum} eq 'essayresponse') || 8377: ($responsetype_per_response{$responsenum} eq 'formularesponse') || 8378: ($responsetype_per_response{$responsenum} eq 'stringresponse') || 8379: ($responsetype_per_response{$responsenum} eq 'imageresponse') || 8380: ($responsetype_per_response{$responsenum} eq 'reactionresponse') || 8381: ($responsetype_per_response{$responsenum} eq 'organicresponse')) { 8382: $r->print(&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).'<br /><br />'.&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.').'<br />'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'<br />'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'<br /><br />'); 8383: } else { 8384: $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />"); 8385: } 8386: } 8387: for (my $i =0; $i < $lines; $i++) { 8388: my $selected = $$scan_record{"scantron.$current_line.answer"}; 8389: &scantron_bubble_selector($r,$scan_config,$current_line, 8390: $questionnum,$error,split('', $selected)); 8391: push(@linenums,$current_line); 8392: $current_line++; 8393: } 8394: if ($lines > 1) { 8395: $r->print("<hr /><br />"); 8396: } 8397: return @linenums; 8398: } 8399: 8400: =pod 8401: 8402: =item scantron_bubble_selector 8403: 8404: Generates the html radiobuttons to correct a single bubble line 8405: possibly showing the existing the selected bubbles if known 8406: 8407: Arguments: 8408: $r - Apache request object 8409: $scan_config - hash from &Apache::lonnet::get_scantron_config() 8410: $line - Number of the line being displayed. 8411: $questionnum - Question number (may include subquestion) 8412: $error - Type of error. 8413: @selected - Array of bubbles picked on this line. 8414: 8415: =cut 8416: 8417: sub scantron_bubble_selector { 8418: my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_; 8419: my $max=$$scan_config{'Qlength'}; 8420: 8421: my $scmode=$$scan_config{'Qon'}; 8422: if ($scmode eq 'number' || $scmode eq 'letter') { 8423: if (($$scan_config{'BubblesPerRow'} =~ /^\d+$/) && 8424: ($$scan_config{'BubblesPerRow'} > 0)) { 8425: $max=$$scan_config{'BubblesPerRow'}; 8426: if (($scmode eq 'number') && ($max > 10)) { 8427: $max = 10; 8428: } elsif (($scmode eq 'letter') && $max > 26) { 8429: $max = 26; 8430: } 8431: } else { 8432: $max = 10; 8433: } 8434: } 8435: 8436: my @alphabet=('A'..'Z'); 8437: $r->print(&Apache::loncommon::start_data_table(). 8438: &Apache::loncommon::start_data_table_row()); 8439: $r->print('<td rowspan="2" class="LC_leftcol_header">'.$line.'</td>'); 8440: for (my $i=0;$i<$max+1;$i++) { 8441: $r->print("\n".'<td align="center">'); 8442: if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } 8443: else { $r->print(' '); } 8444: $r->print('</td>'); 8445: } 8446: $r->print(&Apache::loncommon::end_data_table_row(). 8447: &Apache::loncommon::start_data_table_row()); 8448: for (my $i=0;$i<$max;$i++) { 8449: $r->print("\n". 8450: '<td><label><input type="radio" name="scantron_correct_Q_'. 8451: $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>"); 8452: } 8453: my $nobub_checked = ' '; 8454: if ($error eq 'missingbubble') { 8455: $nobub_checked = ' checked = "checked" '; 8456: } 8457: $r->print("\n".'<td><label><input type="radio" name="scantron_correct_Q_'. 8458: $line.'" value="none"'.$nobub_checked.'/>'.&mt('No bubble'). 8459: '</label>'."\n".'<input type="hidden" name="scantron_questionnum_Q_'. 8460: $line.'" value="'.$questionnum.'" /></td>'); 8461: $r->print(&Apache::loncommon::end_data_table_row(). 8462: &Apache::loncommon::end_data_table()); 8463: } 8464: 8465: =pod 8466: 8467: =item num_matches 8468: 8469: Counts the number of characters that are the same between the two arguments. 8470: 8471: Arguments: 8472: $orig - CODE from the scanline 8473: $code - CODE to match against 8474: 8475: Returns: 8476: $count - integer count of the number of same characters between the 8477: two arguments 8478: 8479: =cut 8480: 8481: sub num_matches { 8482: my ($orig,$code) = @_; 8483: my @code=split(//,$code); 8484: my @orig=split(//,$orig); 8485: my $same=0; 8486: for (my $i=0;$i<scalar(@code);$i++) { 8487: if ($code[$i] eq $orig[$i]) { $same++; } 8488: } 8489: return $same; 8490: } 8491: 8492: =pod 8493: 8494: =item scantron_get_closely_matching_CODEs 8495: 8496: Cycles through all CODEs and finds the set that has the greatest 8497: number of same characters as the provided CODE 8498: 8499: Arguments: 8500: $allcodes - hash ref returned by &get_codes() 8501: $CODE - CODE from the current scanline 8502: 8503: Returns: 8504: 2 element list 8505: - first elements is number of how closely matching the best fit is 8506: (5 means best set has 5 matching characters) 8507: - second element is an arrary ref containing the set of valid CODEs 8508: that best fit the passed in CODE 8509: 8510: =cut 8511: 8512: sub scantron_get_closely_matching_CODEs { 8513: my ($allcodes,$CODE)=@_; 8514: my @CODEs; 8515: foreach my $testcode (sort(keys(%{$allcodes}))) { 8516: push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode); 8517: } 8518: 8519: return ($#CODEs,$CODEs[-1]); 8520: } 8521: 8522: =pod 8523: 8524: =item get_codes 8525: 8526: Builds a hash which has keys of all of the valid CODEs from the selected 8527: set of remembered CODEs. 8528: 8529: Arguments: 8530: $old_name - name of the set of remembered CODEs 8531: $cdom - domain of the course 8532: $cnum - internal course name 8533: 8534: Returns: 8535: %allcodes - keys are the valid CODEs, values are all 1 8536: 8537: =cut 8538: 8539: sub get_codes { 8540: my ($old_name, $cdom, $cnum) = @_; 8541: if (!$old_name) { 8542: $old_name=$env{'form.scantron_CODElist'}; 8543: } 8544: if (!$cdom) { 8545: $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'}; 8546: } 8547: if (!$cnum) { 8548: $cnum =$env{'course.'.$env{'request.course.id'}.'.num'}; 8549: } 8550: my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"], 8551: $cdom,$cnum); 8552: my %allcodes; 8553: if ($result{"type\0$old_name"} eq 'number') { 8554: %allcodes=map {($_,1)} split(',',$result{$old_name}); 8555: } else { 8556: %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); 8557: } 8558: return %allcodes; 8559: } 8560: 8561: =pod 8562: 8563: =item scantron_validate_CODE 8564: 8565: Validates all scanlines in the selected file to not have any 8566: invalid or underspecified CODEs and that none of the codes are 8567: duplicated if this was requested. 8568: 8569: =cut 8570: 8571: sub scantron_validate_CODE { 8572: my ($r,$currentphase) = @_; 8573: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 8574: if ($scantron_config{'CODElocation'} && 8575: $scantron_config{'CODEstart'} && 8576: $scantron_config{'CODElength'}) { 8577: if (!defined($env{'form.scantron_CODElist'})) { 8578: &FIXME_blow_up() 8579: } 8580: } else { 8581: return (0,$currentphase+1); 8582: } 8583: 8584: my %usedCODEs; 8585: 8586: my %allcodes=&get_codes(); 8587: 8588: my $nav_error; 8589: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the lines per response array. 8590: if ($nav_error) { 8591: $r->print(&navmap_errormsg()); 8592: return(1,$currentphase); 8593: } 8594: 8595: my ($scanlines,$scan_data)=&scantron_getfile(); 8596: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 8597: my $line=&scantron_get_line($scanlines,$scan_data,$i); 8598: if ($line=~/^[\s\cz]*$/) { next; } 8599: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 8600: $scan_data); 8601: my $CODE=$$scan_record{'scantron.CODE'}; 8602: my $error=0; 8603: if (!&Apache::lonnet::validCODE($CODE)) { 8604: &scantron_get_correction($r,$i,$scan_record, 8605: \%scantron_config, 8606: $line,'incorrectCODE',\%allcodes); 8607: return(1,$currentphase); 8608: } 8609: if (%allcodes && !exists($allcodes{$CODE}) 8610: && !$$scan_record{'scantron.useCODE'}) { 8611: &scantron_get_correction($r,$i,$scan_record, 8612: \%scantron_config, 8613: $line,'incorrectCODE',\%allcodes); 8614: return(1,$currentphase); 8615: } 8616: if (exists($usedCODEs{$CODE}) 8617: && $env{'form.scantron_CODEunique'} eq 'yes' 8618: && !$$scan_record{'scantron.CODE_ignore_dup'}) { 8619: &scantron_get_correction($r,$i,$scan_record, 8620: \%scantron_config, 8621: $line,'duplicateCODE',$usedCODEs{$CODE}); 8622: return(1,$currentphase); 8623: } 8624: push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); 8625: } 8626: return (0,$currentphase+1); 8627: } 8628: 8629: =pod 8630: 8631: =item scantron_validate_doublebubble 8632: 8633: Validates all scanlines in the selected file to not have any 8634: bubble lines with multiple bubbles marked. 8635: 8636: =cut 8637: 8638: sub scantron_validate_doublebubble { 8639: my ($r,$currentphase) = @_; 8640: #get student info 8641: my $classlist=&Apache::loncoursedata::get_classlist(); 8642: my %idmap=&username_to_idmap($classlist); 8643: my (undef,undef,$sequence)= 8644: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 8645: 8646: #get scantron line setup 8647: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 8648: my ($scanlines,$scan_data)=&scantron_getfile(); 8649: 8650: my $navmap = Apache::lonnavmaps::navmap->new(); 8651: unless (ref($navmap)) { 8652: $r->print(&navmap_errormsg()); 8653: return(1,$currentphase); 8654: } 8655: my $map=$navmap->getResourceByUrl($sequence); 8656: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8657: my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, 8658: %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline); 8659: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 8660: 8661: my $nav_error; 8662: if (ref($map)) { 8663: $randomorder = $map->randomorder(); 8664: $randompick = $map->randompick(); 8665: unless ($randomorder || $randompick) { 8666: foreach my $res ($navmap->retrieveResources($map,sub { $_[0]->is_map() },1,0,1)) { 8667: if ($res->randomorder()) { 8668: $randomorder = 1; 8669: } 8670: if ($res->randompick()) { 8671: $randompick = 1; 8672: } 8673: last if ($randomorder || $randompick); 8674: } 8675: } 8676: if ($randomorder || $randompick) { 8677: $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); 8678: if ($nav_error) { 8679: $r->print(&navmap_errormsg()); 8680: return(1,$currentphase); 8681: } 8682: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 8683: \%grader_randomlists_by_symb,$bubbles_per_row); 8684: } 8685: } else { 8686: $r->print(&navmap_errormsg()); 8687: return(1,$currentphase); 8688: } 8689: 8690: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array. 8691: if ($nav_error) { 8692: $r->print(&navmap_errormsg()); 8693: return(1,$currentphase); 8694: } 8695: 8696: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 8697: my $line=&scantron_get_line($scanlines,$scan_data,$i); 8698: if ($line=~/^[\s\cz]*$/) { next; } 8699: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 8700: $scan_data,undef,\%idmap,$randomorder, 8701: $randompick,$sequence,\@master_seq, 8702: \%symb_to_resource,\%grader_partids_by_symb, 8703: \%orderedforcode,\%respnumlookup,\%startline); 8704: if (!defined($$scan_record{'scantron.doubleerror'})) { next; } 8705: &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, 8706: 'doublebubble', 8707: $$scan_record{'scantron.doubleerror'}, 8708: $randomorder,$randompick,\%respnumlookup,\%startline); 8709: return (1,$currentphase); 8710: } 8711: return (0,$currentphase+1); 8712: } 8713: 8714: 8715: sub scantron_get_maxbubble { 8716: my ($nav_error,$scantron_config) = @_; 8717: if (defined($env{'form.scantron_maxbubble'}) && 8718: $env{'form.scantron_maxbubble'}) { 8719: &restore_bubble_lines(); 8720: return $env{'form.scantron_maxbubble'}; 8721: } 8722: 8723: my (undef, undef, $sequence) = 8724: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 8725: 8726: my $navmap=Apache::lonnavmaps::navmap->new(); 8727: unless (ref($navmap)) { 8728: if (ref($nav_error)) { 8729: $$nav_error = 1; 8730: } 8731: return; 8732: } 8733: my $map=$navmap->getResourceByUrl($sequence); 8734: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8735: my $bubbles_per_row = &bubblesheet_bubbles_per_row($scantron_config); 8736: 8737: &Apache::lonxml::clear_problem_counter(); 8738: 8739: my $uname = $env{'user.name'}; 8740: my $udom = $env{'user.domain'}; 8741: my $cid = $env{'request.course.id'}; 8742: my $total_lines = 0; 8743: %bubble_lines_per_response = (); 8744: %first_bubble_line = (); 8745: %subdivided_bubble_lines = (); 8746: %responsetype_per_response = (); 8747: %masterseq_id_responsenum = (); 8748: 8749: my $response_number = 0; 8750: my $bubble_line = 0; 8751: foreach my $resource (@resources) { 8752: my $resid = $resource->id(); 8753: my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname, 8754: $udom,undef,$bubbles_per_row); 8755: if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) { 8756: foreach my $part_id (@{$parts}) { 8757: my $lines; 8758: 8759: # TODO - make this a persistent hash not an array. 8760: 8761: # optionresponse, matchresponse and rankresponse type items 8762: # render as separate sub-questions in exam mode. 8763: if (($analysis->{$part_id.'.type'} eq 'optionresponse') || 8764: ($analysis->{$part_id.'.type'} eq 'matchresponse') || 8765: ($analysis->{$part_id.'.type'} eq 'rankresponse')) { 8766: my ($numbub,$numshown); 8767: if ($analysis->{$part_id.'.type'} eq 'optionresponse') { 8768: if (ref($analysis->{$part_id.'.options'}) eq 'ARRAY') { 8769: $numbub = scalar(@{$analysis->{$part_id.'.options'}}); 8770: } 8771: } elsif ($analysis->{$part_id.'.type'} eq 'matchresponse') { 8772: if (ref($analysis->{$part_id.'.items'}) eq 'ARRAY') { 8773: $numbub = scalar(@{$analysis->{$part_id.'.items'}}); 8774: } 8775: } elsif ($analysis->{$part_id.'.type'} eq 'rankresponse') { 8776: if (ref($analysis->{$part_id.'.foils'}) eq 'ARRAY') { 8777: $numbub = scalar(@{$analysis->{$part_id.'.foils'}}); 8778: } 8779: } 8780: if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') { 8781: $numshown = scalar(@{$analysis->{$part_id.'.shown'}}); 8782: } 8783: my $bubbles_per_row = 8784: &bubblesheet_bubbles_per_row($scantron_config); 8785: my $inner_bubble_lines = int($numbub/$bubbles_per_row); 8786: if (($numbub % $bubbles_per_row) != 0) { 8787: $inner_bubble_lines++; 8788: } 8789: for (my $i=0; $i<$numshown; $i++) { 8790: $subdivided_bubble_lines{$response_number} .= 8791: $inner_bubble_lines.','; 8792: } 8793: $subdivided_bubble_lines{$response_number} =~ s/,$//; 8794: $lines = $numshown * $inner_bubble_lines; 8795: } else { 8796: $lines = $analysis->{"$part_id.bubble_lines"}; 8797: } 8798: 8799: $first_bubble_line{$response_number} = $bubble_line; 8800: $bubble_lines_per_response{$response_number} = $lines; 8801: $responsetype_per_response{$response_number} = 8802: $analysis->{$part_id.'.type'}; 8803: $masterseq_id_responsenum{$resid.'_'.$part_id} = $response_number; 8804: $response_number++; 8805: 8806: $bubble_line += $lines; 8807: $total_lines += $lines; 8808: } 8809: } 8810: } 8811: &Apache::lonnet::delenv('scantron.'); 8812: 8813: &save_bubble_lines(); 8814: $env{'form.scantron_maxbubble'} = 8815: $total_lines; 8816: return $env{'form.scantron_maxbubble'}; 8817: } 8818: 8819: sub bubblesheet_bubbles_per_row { 8820: my ($scantron_config) = @_; 8821: my $bubbles_per_row; 8822: if (ref($scantron_config) eq 'HASH') { 8823: $bubbles_per_row = $scantron_config->{'BubblesPerRow'}; 8824: } 8825: if ((!$bubbles_per_row) || ($bubbles_per_row < 1)) { 8826: $bubbles_per_row = 10; 8827: } 8828: return $bubbles_per_row; 8829: } 8830: 8831: sub scantron_validate_missingbubbles { 8832: my ($r,$currentphase) = @_; 8833: #get student info 8834: my $classlist=&Apache::loncoursedata::get_classlist(); 8835: my %idmap=&username_to_idmap($classlist); 8836: my (undef,undef,$sequence)= 8837: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 8838: 8839: #get scantron line setup 8840: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 8841: my ($scanlines,$scan_data)=&scantron_getfile(); 8842: 8843: my $navmap = Apache::lonnavmaps::navmap->new(); 8844: unless (ref($navmap)) { 8845: $r->print(&navmap_errormsg()); 8846: return(1,$currentphase); 8847: } 8848: 8849: my $map=$navmap->getResourceByUrl($sequence); 8850: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8851: my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, 8852: %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline); 8853: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 8854: 8855: my $nav_error; 8856: if (ref($map)) { 8857: $randomorder = $map->randomorder(); 8858: $randompick = $map->randompick(); 8859: unless ($randomorder || $randompick) { 8860: foreach my $res ($navmap->retrieveResources($map,sub { $_[0]->is_map() },1,0,1)) { 8861: if ($res->randomorder()) { 8862: $randomorder = 1; 8863: } 8864: if ($res->randompick()) { 8865: $randompick = 1; 8866: } 8867: last if ($randomorder || $randompick); 8868: } 8869: } 8870: if ($randomorder || $randompick) { 8871: $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); 8872: if ($nav_error) { 8873: $r->print(&navmap_errormsg()); 8874: return(1,$currentphase); 8875: } 8876: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 8877: \%grader_randomlists_by_symb,$bubbles_per_row); 8878: } 8879: } else { 8880: $r->print(&navmap_errormsg()); 8881: return(1,$currentphase); 8882: } 8883: 8884: 8885: my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); 8886: if ($nav_error) { 8887: $r->print(&navmap_errormsg()); 8888: return(1,$currentphase); 8889: } 8890: 8891: if (!$max_bubble) { $max_bubble=2**31; } 8892: for (my $i=0;$i<=$scanlines->{'count'};$i++) { 8893: my $line=&scantron_get_line($scanlines,$scan_data,$i); 8894: if ($line=~/^[\s\cz]*$/) { next; } 8895: my $scan_record = 8896: &scantron_parse_scanline($line,$i,\%scantron_config,$scan_data,undef,\%idmap, 8897: $randomorder,$randompick,$sequence,\@master_seq, 8898: \%symb_to_resource,\%grader_partids_by_symb, 8899: \%orderedforcode,\%respnumlookup,\%startline); 8900: if (!defined($$scan_record{'scantron.missingerror'})) { next; } 8901: my @to_correct; 8902: 8903: # Probably here's where the error is... 8904: 8905: foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { 8906: my $lastbubble; 8907: if ($missing =~ /^(\d+)\.(\d+)$/) { 8908: my $question = $1; 8909: my $subquestion = $2; 8910: my ($first,$responsenum); 8911: if ($randomorder || $randompick) { 8912: $responsenum = $respnumlookup{$question-1}; 8913: $first = $startline{$question-1}; 8914: } else { 8915: $responsenum = $question-1; 8916: $first = $first_bubble_line{$responsenum}; 8917: } 8918: if (!defined($first)) { next; } 8919: my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); 8920: my $subcount = 1; 8921: while ($subcount<$subquestion) { 8922: $first += $subans[$subcount-1]; 8923: $subcount ++; 8924: } 8925: my $count = $subans[$subquestion-1]; 8926: $lastbubble = $first + $count; 8927: } else { 8928: my ($first,$responsenum); 8929: if ($randomorder || $randompick) { 8930: $responsenum = $respnumlookup{$missing-1}; 8931: $first = $startline{$missing-1}; 8932: } else { 8933: $responsenum = $missing-1; 8934: $first = $first_bubble_line{$responsenum}; 8935: } 8936: if (!defined($first)) { next; } 8937: $lastbubble = $first + $bubble_lines_per_response{$responsenum}; 8938: } 8939: if ($lastbubble > $max_bubble) { next; } 8940: push(@to_correct,$missing); 8941: } 8942: if (@to_correct) { 8943: &scantron_get_correction($r,$i,$scan_record,\%scantron_config, 8944: $line,'missingbubble',\@to_correct, 8945: $randomorder,$randompick,\%respnumlookup, 8946: \%startline); 8947: return (1,$currentphase); 8948: } 8949: 8950: } 8951: return (0,$currentphase+1); 8952: } 8953: 8954: sub hand_bubble_option { 8955: my (undef, undef, $sequence) = 8956: &Apache::lonnet::decode_symb($env{'form.selectpage'}); 8957: return if ($sequence eq ''); 8958: my $navmap = Apache::lonnavmaps::navmap->new(); 8959: unless (ref($navmap)) { 8960: return; 8961: } 8962: my $needs_hand_bubbles; 8963: my $map=$navmap->getResourceByUrl($sequence); 8964: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 8965: foreach my $res (@resources) { 8966: if (ref($res)) { 8967: if ($res->is_problem()) { 8968: my $partlist = $res->parts(); 8969: foreach my $part (@{ $partlist }) { 8970: my @types = $res->responseType($part); 8971: if (grep(/^(chem|essay|image|formula|math|string|functionplot)$/,@types)) { 8972: $needs_hand_bubbles = 1; 8973: last; 8974: } 8975: } 8976: } 8977: } 8978: } 8979: if ($needs_hand_bubbles) { 8980: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 8981: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 8982: return &mt('The sequence to be graded contains response types which are handgraded.').'<p>'. 8983: &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 />'). 8984: '<label><input type="radio" name="scantron_lastbubblepoints" value="'.$bubbles_per_row.'" checked="checked" />'.&mt('[quant,_1,point]',$bubbles_per_row).'</label> '.&mt('or').' '. 8985: '<label><input type="radio" name="scantron_lastbubblepoints" value="0" />'.&mt('0 points').'</label></p>'; 8986: } 8987: return; 8988: } 8989: 8990: sub scantron_process_students { 8991: my ($r,$symb) = @_; 8992: 8993: my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); 8994: if (!$symb) { 8995: return ''; 8996: } 8997: my $default_form_data=&defaultFormData($symb); 8998: 8999: my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 9000: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 9001: my ($scanlines,$scan_data)=&scantron_getfile(); 9002: my $classlist=&Apache::loncoursedata::get_classlist(); 9003: my %idmap=&username_to_idmap($classlist); 9004: my $navmap=Apache::lonnavmaps::navmap->new(); 9005: unless (ref($navmap)) { 9006: $r->print(&navmap_errormsg()); 9007: return ''; 9008: } 9009: my $map=$navmap->getResourceByUrl($sequence); 9010: my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, 9011: %grader_randomlists_by_symb,%symb_for_examcode); 9012: if (ref($map)) { 9013: $randomorder = $map->randomorder(); 9014: $randompick = $map->randompick(); 9015: unless ($randomorder || $randompick) { 9016: foreach my $res ($navmap->retrieveResources($map,sub { $_[0]->is_map() },1,0,1)) { 9017: if ($res->randomorder()) { 9018: $randomorder = 1; 9019: } 9020: if ($res->randompick()) { 9021: $randompick = 1; 9022: } 9023: last if ($randomorder || $randompick); 9024: } 9025: } 9026: } else { 9027: $r->print(&navmap_errormsg()); 9028: return ''; 9029: } 9030: my $nav_error; 9031: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 9032: if ($randomorder || $randompick) { 9033: $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource,1,\%symb_for_examcode); 9034: if ($nav_error) { 9035: $r->print(&navmap_errormsg()); 9036: return ''; 9037: } 9038: } 9039: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 9040: \%grader_randomlists_by_symb,$bubbles_per_row); 9041: 9042: my ($uname,$udom); 9043: my $result= <<SCANTRONFORM; 9044: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload"> 9045: <input type="hidden" name="command" value="scantron_configphase" /> 9046: $default_form_data 9047: SCANTRONFORM 9048: $r->print($result); 9049: 9050: my @delayqueue; 9051: my (%completedstudents,%scandata); 9052: 9053: my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam')); 9054: my $count=&get_todo_count($scanlines,$scan_data); 9055: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); 9056: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,'Processing first student'); 9057: $r->print('<br />'); 9058: my $start=&Time::HiRes::time(); 9059: my $i=-1; 9060: my $started; 9061: 9062: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. 9063: if ($nav_error) { 9064: $r->print(&navmap_errormsg()); 9065: return ''; 9066: } 9067: 9068: # If an ssi failed in scantron_get_maxbubble, put an error message out to 9069: # the user and return. 9070: 9071: if ($ssi_error) { 9072: $r->print("</form>"); 9073: &ssi_print_error($r); 9074: &Apache::lonnet::remove_lock($lock); 9075: return ''; # Dunno why the other returns return '' rather than just returning. 9076: } 9077: 9078: my %lettdig = &Apache::lonnet::letter_to_digits(); 9079: my $numletts = scalar(keys(%lettdig)); 9080: my %orderedforcode; 9081: 9082: while ($i<$scanlines->{'count'}) { 9083: ($uname,$udom)=('',''); 9084: $i++; 9085: my $line=&scantron_get_line($scanlines,$scan_data,$i); 9086: if ($line=~/^[\s\cz]*$/) { next; } 9087: if ($started) { 9088: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student'); 9089: } 9090: $started=1; 9091: my %respnumlookup = (); 9092: my %startline = (); 9093: my $total; 9094: my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, 9095: $scan_data,undef,\%idmap,$randomorder, 9096: $randompick,$sequence,\@master_seq, 9097: \%symb_to_resource,\%grader_partids_by_symb, 9098: \%orderedforcode,\%respnumlookup,\%startline, 9099: \$total); 9100: unless ($uname=&scantron_find_student($scan_record,$scan_data, 9101: \%idmap,$i)) { 9102: &scantron_add_delay(\@delayqueue,$line, 9103: 'Unable to find a student that matches',1); 9104: next; 9105: } 9106: if (exists $completedstudents{$uname}) { 9107: &scantron_add_delay(\@delayqueue,$line, 9108: 'Student '.$uname.' has multiple sheets',2); 9109: next; 9110: } 9111: my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; 9112: my $user = $uname.':'.$usec; 9113: ($uname,$udom)=split(/:/,$uname); 9114: 9115: my $scancode; 9116: if ((exists($scan_record->{'scantron.CODE'})) && 9117: (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { 9118: $scancode = $scan_record->{'scantron.CODE'}; 9119: } else { 9120: $scancode = ''; 9121: } 9122: 9123: my @mapresources = @resources; 9124: if ($randomorder || $randompick) { 9125: @mapresources = 9126: &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource, 9127: \%orderedforcode); 9128: } 9129: my (%partids_by_symb,$res_error); 9130: foreach my $resource (@mapresources) { 9131: my $ressymb; 9132: if (ref($resource)) { 9133: $ressymb = $resource->symb(); 9134: } else { 9135: $res_error = 1; 9136: last; 9137: } 9138: if ((exists($grader_randomlists_by_symb{$ressymb})) || 9139: (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { 9140: my $currcode; 9141: if (exists($grader_randomlists_by_symb{$ressymb})) { 9142: $currcode = $scancode; 9143: } 9144: my ($analysis,$parts) = 9145: &scantron_partids_tograde($resource,$env{'request.course.id'}, 9146: $uname,$udom,undef,$bubbles_per_row, 9147: $currcode); 9148: $partids_by_symb{$ressymb} = $parts; 9149: } else { 9150: $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb}; 9151: } 9152: } 9153: 9154: if ($res_error) { 9155: &scantron_add_delay(\@delayqueue,$line, 9156: 'An error occurred while grading student '.$uname,2); 9157: next; 9158: } 9159: 9160: &Apache::lonxml::clear_problem_counter(); 9161: &Apache::lonnet::appenv($scan_record); 9162: 9163: if (&scantron_clear_skip($scanlines,$scan_data,$i)) { 9164: &scantron_putfile($scanlines,$scan_data); 9165: } 9166: 9167: if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, 9168: \@mapresources,\%partids_by_symb, 9169: $bubbles_per_row,$randomorder,$randompick, 9170: \%respnumlookup,\%startline) 9171: eq 'ssi_error') { 9172: $ssi_error = 0; # So end of handler error message does not trigger. 9173: $r->print("</form>"); 9174: &ssi_print_error($r); 9175: &Apache::lonnet::remove_lock($lock); 9176: return ''; # Why return ''? Beats me. 9177: } 9178: 9179: if (($scancode) && ($randomorder || $randompick)) { 9180: foreach my $key (keys(%symb_for_examcode)) { 9181: my $symb_in_map = $symb_for_examcode{$key}; 9182: if ($symb_in_map ne '') { 9183: my $parmresult = 9184: &Apache::lonparmset::storeparm_by_symb($symb_in_map, 9185: '0_examcode',2,$scancode, 9186: 'string_examcode',$uname, 9187: $udom); 9188: } 9189: } 9190: } 9191: $completedstudents{$uname}={'line'=>$line}; 9192: if ($env{'form.verifyrecord'}) { 9193: my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; 9194: if ($randompick) { 9195: if ($total) { 9196: $lastpos = $total*$scantron_config{'Qlength'}; 9197: } 9198: } 9199: 9200: my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos); 9201: chomp($studentdata); 9202: $studentdata =~ s/\r$//; 9203: my $studentrecord = ''; 9204: my $counter = -1; 9205: foreach my $resource (@mapresources) { 9206: my $ressymb = $resource->symb(); 9207: ($counter,my $recording) = 9208: &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, 9209: $counter,$studentdata,$partids_by_symb{$ressymb}, 9210: \%scantron_config,\%lettdig,$numletts,$randomorder, 9211: $randompick,\%respnumlookup,\%startline); 9212: $studentrecord .= $recording; 9213: } 9214: if ($studentrecord ne $studentdata) { 9215: &Apache::lonxml::clear_problem_counter(); 9216: if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, 9217: \@mapresources,\%partids_by_symb, 9218: $bubbles_per_row,$randomorder,$randompick, 9219: \%respnumlookup,\%startline) 9220: eq 'ssi_error') { 9221: $ssi_error = 0; # So end of handler error message does not trigger. 9222: $r->print("</form>"); 9223: &ssi_print_error($r); 9224: &Apache::lonnet::remove_lock($lock); 9225: delete($completedstudents{$uname}); 9226: return ''; 9227: } 9228: $counter = -1; 9229: $studentrecord = ''; 9230: foreach my $resource (@mapresources) { 9231: my $ressymb = $resource->symb(); 9232: ($counter,my $recording) = 9233: &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, 9234: $counter,$studentdata,$partids_by_symb{$ressymb}, 9235: \%scantron_config,\%lettdig,$numletts, 9236: $randomorder,$randompick,\%respnumlookup, 9237: \%startline); 9238: $studentrecord .= $recording; 9239: } 9240: if ($studentrecord ne $studentdata) { 9241: $r->print('<p><span class="LC_warning">'); 9242: if ($scancode eq '') { 9243: $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2].', 9244: $uname.':'.$udom,$scan_record->{'scantron.ID'})); 9245: } else { 9246: $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2] and CODE: [_3].', 9247: $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode)); 9248: } 9249: $r->print('</span><br />'.&Apache::loncommon::start_data_table()."\n". 9250: &Apache::loncommon::start_data_table_header_row()."\n". 9251: '<th>'.&mt('Source').'</th><th>'.&mt('Bubbled responses').'</th>'. 9252: &Apache::loncommon::end_data_table_header_row()."\n". 9253: &Apache::loncommon::start_data_table_row(). 9254: '<td>'.&mt('Bubblesheet').'</td>'. 9255: '<td><span class="LC_nobreak" style="white-space: pre;"><tt>'.$studentdata.'</tt></span></td>'. 9256: &Apache::loncommon::end_data_table_row(). 9257: &Apache::loncommon::start_data_table_row(). 9258: '<td>'.&mt('Stored submissions').'</td>'. 9259: '<td><span class="LC_nobreak" style="white-space: pre;"><tt>'.$studentrecord.'</tt></span></td>'."\n". 9260: &Apache::loncommon::end_data_table_row(). 9261: &Apache::loncommon::end_data_table().'</p>'); 9262: } else { 9263: $r->print('<br /><span class="LC_warning">'. 9264: &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 />'. 9265: &mt("As a consequence, this user's submission history records two tries."). 9266: '</span><br />'); 9267: } 9268: } 9269: } 9270: if (&Apache::loncommon::connection_aborted($r)) { last; } 9271: } continue { 9272: &Apache::lonxml::clear_problem_counter(); 9273: &Apache::lonnet::delenv('scantron.'); 9274: } 9275: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 9276: &Apache::lonnet::remove_lock($lock); 9277: # my $lasttime = &Time::HiRes::time()-$start; 9278: # $r->print("<p>took $lasttime</p>"); 9279: 9280: $r->print("</form>"); 9281: return ''; 9282: } 9283: 9284: sub graders_resources_pass { 9285: my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb, 9286: $bubbles_per_row) = @_; 9287: if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && 9288: (ref($grader_randomlists_by_symb) eq 'HASH')) { 9289: foreach my $resource (@{$resources}) { 9290: my $ressymb = $resource->symb(); 9291: my ($analysis,$parts) = 9292: &scantron_partids_tograde($resource,$env{'request.course.id'}, 9293: $env{'user.name'},$env{'user.domain'}, 9294: 1,$bubbles_per_row); 9295: $grader_partids_by_symb->{$ressymb} = $parts; 9296: if (ref($analysis) eq 'HASH') { 9297: if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { 9298: $grader_randomlists_by_symb->{$ressymb} = 9299: $analysis->{'parts_withrandomlist'}; 9300: } 9301: } 9302: } 9303: } 9304: return; 9305: } 9306: 9307: =pod 9308: 9309: =item users_order 9310: 9311: Returns array of resources in current map, ordered based on either CODE, 9312: if this is a CODEd exam, or based on student's identity if this is a 9313: "NAMEd" exam. 9314: 9315: Should be used when randomorder and/or randompick applied when the 9316: corresponding exam was printed, prior to students completing bubblesheets 9317: for the version of the exam the student received. 9318: 9319: =cut 9320: 9321: sub users_order { 9322: my ($user,$scancode,$mapurl,$master_seq,$symb_to_resource,$orderedforcode) = @_; 9323: my @mapresources; 9324: unless ((ref($master_seq) eq 'ARRAY') && (ref($symb_to_resource) eq 'HASH')) { 9325: return @mapresources; 9326: } 9327: if ($scancode) { 9328: if ((ref($orderedforcode) eq 'HASH') && (ref($orderedforcode->{$scancode}) eq 'ARRAY')) { 9329: @mapresources = @{$orderedforcode->{$scancode}}; 9330: } else { 9331: $env{'form.CODE'} = $scancode; 9332: my $actual_seq = 9333: &Apache::lonprintout::master_seq_to_person_seq($mapurl, 9334: $master_seq, 9335: $user,$scancode,1); 9336: if (ref($actual_seq) eq 'ARRAY') { 9337: @mapresources = map { $symb_to_resource->{$_}; } @{$actual_seq}; 9338: if (ref($orderedforcode) eq 'HASH') { 9339: if (@mapresources > 0) { 9340: $orderedforcode->{$scancode} = \@mapresources; 9341: } 9342: } 9343: } 9344: delete($env{'form.CODE'}); 9345: } 9346: } else { 9347: my $actual_seq = 9348: &Apache::lonprintout::master_seq_to_person_seq($mapurl, 9349: $master_seq, 9350: $user,undef,1); 9351: if (ref($actual_seq) eq 'ARRAY') { 9352: @mapresources = 9353: map { $symb_to_resource->{$_}; } @{$actual_seq}; 9354: } 9355: } 9356: return @mapresources; 9357: } 9358: 9359: sub grade_student_bubbles { 9360: my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row, 9361: $randomorder,$randompick,$respnumlookup,$startline) = @_; 9362: my $uselookup = 0; 9363: if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH') && 9364: (ref($startline) eq 'HASH')) { 9365: $uselookup = 1; 9366: } 9367: 9368: if (ref($resources) eq 'ARRAY') { 9369: my $count = 0; 9370: foreach my $resource (@{$resources}) { 9371: my $ressymb = $resource->symb(); 9372: my %form = ('submitted' => 'scantron', 9373: 'grade_target' => 'grade', 9374: 'grade_username' => $uname, 9375: 'grade_domain' => $udom, 9376: 'grade_courseid' => $env{'request.course.id'}, 9377: 'grade_symb' => $ressymb, 9378: 'CODE' => $scancode 9379: ); 9380: if ($bubbles_per_row ne '') { 9381: $form{'bubbles_per_row'} = $bubbles_per_row; 9382: } 9383: if ($env{'form.scantron_lastbubblepoints'} ne '') { 9384: $form{'scantron_lastbubblepoints'} = $env{'form.scantron_lastbubblepoints'}; 9385: } 9386: if (ref($parts) eq 'HASH') { 9387: if (ref($parts->{$ressymb}) eq 'ARRAY') { 9388: foreach my $part (@{$parts->{$ressymb}}) { 9389: if ($uselookup) { 9390: $form{'scantron_questnum_start.'.$part} = $startline->{$count} + 1; 9391: } else { 9392: $form{'scantron_questnum_start.'.$part} = 9393: 1+$env{'form.scantron.first_bubble_line.'.$count}; 9394: } 9395: $count++; 9396: } 9397: } 9398: } 9399: my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form); 9400: return 'ssi_error' if ($ssi_error); 9401: last if (&Apache::loncommon::connection_aborted($r)); 9402: } 9403: } 9404: return; 9405: } 9406: 9407: sub scantron_upload_scantron_data { 9408: my ($r,$symb) = @_; 9409: my $dom = $env{'request.role.domain'}; 9410: my ($formatoptions,$formattitle,$formatjs) = &scantron_upload_dataformat($dom); 9411: my $domdesc = &Apache::lonnet::domain($dom,'description'); 9412: $r->print(&Apache::loncommon::coursebrowser_javascript($dom)); 9413: my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', 9414: 'domainid', 9415: 'coursename',$dom); 9416: my $syllabuslink = '<a href="javascript:ToSyllabus();">'.&mt('Syllabus').'</a>'. 9417: ('&nbsp'x2).&mt('(shows course personnel)'); 9418: my $default_form_data=&defaultFormData($symb); 9419: my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.'); 9420: &js_escape(\$nofile_alert); 9421: 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."); 9422: &js_escape(\$nocourseid_alert); 9423: $r->print(&Apache::lonhtmlcommon::scripttag(' 9424: function checkUpload(formname) { 9425: if (formname.upfile.value == "") { 9426: alert("'.$nofile_alert.'"); 9427: return false; 9428: } 9429: if (formname.courseid.value == "") { 9430: alert("'.$nocourseid_alert.'"); 9431: return false; 9432: } 9433: formname.submit(); 9434: } 9435: 9436: function ToSyllabus() { 9437: var cdom = '."'$dom'".'; 9438: var cnum = document.rules.courseid.value; 9439: if (cdom == "" || cdom == null) { 9440: return; 9441: } 9442: if (cnum == "" || cnum == null) { 9443: return; 9444: } 9445: syllwin=window.open("/public/"+cdom+"/"+cnum+"/syllabus","LONCAPASyllabus", 9446: "height=350,width=350,scrollbars=yes,menubar=no"); 9447: return; 9448: } 9449: 9450: '.$formatjs.' 9451: ')); 9452: $r->print(' 9453: <h3>'.&mt('Send bubblesheet data to a course').'</h3> 9454: 9455: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post"> 9456: '.$default_form_data. 9457: &Apache::lonhtmlcommon::start_pick_box(). 9458: &Apache::lonhtmlcommon::row_title(&mt('Course ID')). 9459: '<input name="courseid" type="text" size="30" />'.$select_link. 9460: &Apache::lonhtmlcommon::row_closure(). 9461: &Apache::lonhtmlcommon::row_title(&mt('Course Name')). 9462: '<input name="coursename" type="text" size="30" />'.$syllabuslink. 9463: &Apache::lonhtmlcommon::row_closure(). 9464: &Apache::lonhtmlcommon::row_title(&mt('Domain')). 9465: '<input name="domainid" type="hidden" />'.$domdesc. 9466: &Apache::lonhtmlcommon::row_closure()); 9467: if ($formatoptions) { 9468: $r->print(&Apache::lonhtmlcommon::row_title($formattitle).$formatoptions. 9469: &Apache::lonhtmlcommon::row_closure()); 9470: } 9471: $r->print( 9472: &Apache::lonhtmlcommon::row_title(&mt('File to upload')). 9473: '<input type="file" name="upfile" size="50" />'. 9474: &Apache::lonhtmlcommon::row_closure(1). 9475: &Apache::lonhtmlcommon::end_pick_box().'<br /> 9476: 9477: <input name="command" value="scantronupload_save" type="hidden" /> 9478: <input type="button" onclick="javascript:checkUpload(this.form);" value="'.&mt('Upload Bubblesheet Data').'" /> 9479: </form> 9480: '); 9481: return ''; 9482: } 9483: 9484: sub scantron_upload_dataformat { 9485: my ($dom) = @_; 9486: my ($formatoptions,$formattitle,$formatjs); 9487: $formatjs = <<'END'; 9488: function toggleScantab(form) { 9489: return; 9490: } 9491: END 9492: my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$dom); 9493: if (ref($domconfig{'scantron'}) eq 'HASH') { 9494: if (ref($domconfig{'scantron'}{'config'}) eq 'HASH') { 9495: if (keys(%{$domconfig{'scantron'}{'config'}}) > 1) { 9496: if (($domconfig{'scantron'}{'config'}{'dat'}) && 9497: (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH')) { 9498: if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { 9499: if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}})) { 9500: my ($onclick,$formatextra,$singleline); 9501: my @lines = &Apache::lonnet::get_scantronformat_file(); 9502: my $count = 0; 9503: foreach my $line (@lines) { 9504: next if (($line =~ /^\#/) || ($line eq '')); 9505: $singleline = $line; 9506: $count ++; 9507: } 9508: if ($count > 1) { 9509: $formatextra = '<div style="display:none" id="bubbletype">'. 9510: '<span class="LC_nobreak">'. 9511: &mt('Bubblesheet type').': '. 9512: &scantron_scantab().'</span></div>'; 9513: $onclick = ' onclick="toggleScantab(this.form);"'; 9514: $formatjs = <<"END"; 9515: function toggleScantab(form) { 9516: var divid = 'bubbletype'; 9517: if (document.getElementById(divid)) { 9518: var radioname = 'fileformat'; 9519: var num = form.elements[radioname].length; 9520: if (num) { 9521: for (var i=0; i<num; i++) { 9522: if (form.elements[radioname][i].checked) { 9523: var chosen = form.elements[radioname][i].value; 9524: if (chosen == 'dat') { 9525: document.getElementById(divid).style.display = 'none'; 9526: } else if (chosen == 'csv') { 9527: document.getElementById(divid).style.display = 'block'; 9528: } 9529: } 9530: } 9531: } 9532: } 9533: return; 9534: } 9535: 9536: END 9537: } elsif ($count == 1) { 9538: my $formatname = (split(/:/,$singleline,2))[0]; 9539: $formatextra = '<input type="hidden" name="scantron_format" value="'.$formatname.'" />'; 9540: } 9541: $formattitle = &mt('File format'); 9542: $formatoptions = '<label><input name="fileformat" type="radio" value="dat" checked="checked"'.$onclick.' />'. 9543: &mt('Plain Text (no delimiters)'). 9544: '</label>'.(' 'x2). 9545: '<label><input name="fileformat" type="radio" value="csv"'.$onclick.' />'. 9546: &mt('Comma separated values').'</label>'.$formatextra; 9547: } 9548: } 9549: } 9550: } elsif (keys(%{$domconfig{'scantron'}{'config'}}) == 1) { 9551: if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { 9552: if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}})) { 9553: $formattitle = &mt('Bubblesheet type'); 9554: $formatoptions = &scantron_scantab(); 9555: } 9556: } 9557: } 9558: } 9559: } 9560: return ($formatoptions,$formattitle,$formatjs); 9561: } 9562: 9563: sub scantron_upload_scantron_data_save { 9564: my ($r,$symb) = @_; 9565: my $doanotherupload= 9566: '<br /><form action="/adm/grades" method="post">'."\n". 9567: '<input type="hidden" name="command" value="scantronupload" />'."\n". 9568: '<input type="submit" name="submit" value="'.&mt('Do Another Upload').'" />'."\n". 9569: '</form>'."\n"; 9570: if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && 9571: !&Apache::lonnet::allowed('usc', 9572: $env{'form.domainid'}.'_'.$env{'form.courseid'})) { 9573: $r->print(&mt("You are not allowed to upload bubblesheet data to the requested course.")."<br />"); 9574: unless ($symb) { 9575: $r->print($doanotherupload); 9576: } 9577: return ''; 9578: } 9579: my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); 9580: my $uploadedfile; 9581: $r->print('<p>'.&mt("Uploading file to [_1]",$coursedata{'description'}).'</p>'); 9582: if (length($env{'form.upfile'}) < 2) { 9583: $r->print( 9584: &Apache::lonhtmlcommon::confirm_success( 9585: &mt('The file: [_1] you attempted to upload contained no information. Please check that you entered the correct filename.', 9586: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'),1)); 9587: } else { 9588: my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$env{'form.domainid'}); 9589: my $parser; 9590: if (ref($domconfig{'scantron'}) eq 'HASH') { 9591: if (ref($domconfig{'scantron'}{'config'}) eq 'HASH') { 9592: my $is_csv; 9593: my @possibles = keys(%{$domconfig{'scantron'}{'config'}}); 9594: if (@possibles > 1) { 9595: if ($env{'form.fileformat'} eq 'csv') { 9596: if (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH') { 9597: if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { 9598: if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}}) > 1) { 9599: $is_csv = 1; 9600: } 9601: } 9602: } 9603: } 9604: } elsif (@possibles == 1) { 9605: if (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH') { 9606: if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { 9607: if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}}) > 1) { 9608: $is_csv = 1; 9609: } 9610: } 9611: } 9612: } 9613: if ($is_csv) { 9614: $parser = $domconfig{'scantron'}{'config'}{'csv'}; 9615: } 9616: } 9617: } 9618: my $result = 9619: &Apache::lonnet::userfileupload('upfile','scantron','scantron',$parser,'','', 9620: $env{'form.courseid'},$env{'form.domainid'}); 9621: if ($result =~ m{^/uploaded/}) { 9622: $r->print( 9623: &Apache::lonhtmlcommon::confirm_success(&mt('Upload successful')).'<br />'. 9624: &mt('Uploaded [_1] bytes of data into location: [_2]', 9625: (length($env{'form.upfile'})-1), 9626: '<span class="LC_filename">'.$result.'</span>')); 9627: ($uploadedfile) = ($result =~ m{/([^/]+)$}); 9628: $r->print(&validate_uploaded_scantron_file($env{'form.domainid'}, 9629: $env{'form.courseid'},$uploadedfile)); 9630: } else { 9631: $r->print( 9632: &Apache::lonhtmlcommon::confirm_success(&mt('Upload failed'),1).'<br />'. 9633: &mt('An error ([_1]) occurred when attempting to upload the file: [_2]', 9634: $result, 9635: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>')); 9636: } 9637: } 9638: if ($symb) { 9639: $r->print(&scantron_selectphase($r,$uploadedfile,$symb)); 9640: } else { 9641: $r->print($doanotherupload); 9642: } 9643: return ''; 9644: } 9645: 9646: sub validate_uploaded_scantron_file { 9647: my ($cdom,$cname,$fname) = @_; 9648: my $scanlines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.$fname); 9649: my @lines; 9650: if ($scanlines ne '-1') { 9651: @lines=split("\n",$scanlines,-1); 9652: } 9653: my $output; 9654: if (@lines) { 9655: my (%counts,$max_match_format); 9656: my ($found_match_count,$max_match_count,$max_match_pct) = (0,0,0); 9657: my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cname); 9658: my %idmap = &username_to_idmap($classlist); 9659: foreach my $key (keys(%idmap)) { 9660: my $lckey = lc($key); 9661: $idmap{$lckey} = $idmap{$key}; 9662: } 9663: my %unique_formats; 9664: my @formatlines = &Apache::lonnet::get_scantronformat_file(); 9665: foreach my $line (@formatlines) { 9666: next if (($line =~ /^\#/) || ($line eq '')); 9667: my @config = split(/:/,$line); 9668: my $idstart = $config[5]; 9669: my $idlength = $config[6]; 9670: if (($idstart ne '') && ($idlength > 0)) { 9671: if (ref($unique_formats{$idstart.':'.$idlength}) eq 'ARRAY') { 9672: push(@{$unique_formats{$idstart.':'.$idlength}},$config[0].':'.$config[1]); 9673: } else { 9674: $unique_formats{$idstart.':'.$idlength} = [$config[0].':'.$config[1]]; 9675: } 9676: } 9677: } 9678: foreach my $key (keys(%unique_formats)) { 9679: my ($idstart,$idlength) = split(':',$key); 9680: %{$counts{$key}} = ( 9681: 'found' => 0, 9682: 'total' => 0, 9683: ); 9684: foreach my $line (@lines) { 9685: next if ($line =~ /^#/); 9686: next if ($line =~ /^[\s\cz]*$/); 9687: my $id = substr($line,$idstart-1,$idlength); 9688: $id = lc($id); 9689: if (exists($idmap{$id})) { 9690: $counts{$key}{'found'} ++; 9691: } 9692: $counts{$key}{'total'} ++; 9693: } 9694: if ($counts{$key}{'total'}) { 9695: my $percent_match = (100*$counts{$key}{'found'})/($counts{$key}{'total'}); 9696: if (($max_match_format eq '') || ($percent_match > $max_match_pct)) { 9697: $max_match_pct = $percent_match; 9698: $max_match_format = $key; 9699: $found_match_count = $counts{$key}{'found'}; 9700: $max_match_count = $counts{$key}{'total'}; 9701: } 9702: } 9703: } 9704: if (ref($unique_formats{$max_match_format}) eq 'ARRAY') { 9705: my $format_descs; 9706: my $numwithformat = @{$unique_formats{$max_match_format}}; 9707: for (my $i=0; $i<$numwithformat; $i++) { 9708: my ($name,$desc) = split(':',$unique_formats{$max_match_format}[$i]); 9709: if ($i<$numwithformat-2) { 9710: $format_descs .= '"<i>'.$desc.'</i>", '; 9711: } elsif ($i==$numwithformat-2) { 9712: $format_descs .= '"<i>'.$desc.'</i>" '.&mt('and').' '; 9713: } elsif ($i==$numwithformat-1) { 9714: $format_descs .= '"<i>'.$desc.'</i>"'; 9715: } 9716: } 9717: my $showpct = sprintf("%.0f",$max_match_pct).'%'; 9718: $output .= '<br />'; 9719: if ($found_match_count == $max_match_count) { 9720: # 100% matching entries 9721: $output .= &Apache::lonhtmlcommon::confirm_success( 9722: &mt('Comparison of student IDs: [_1] matching ([quant,_2,entry,entries])', 9723: '<b>'.$showpct.'</b>',$found_match_count)).'<br />'. 9724: &mt('Comparison of student IDs in the uploaded file with'. 9725: ' the course roster found matches for [_1] of the [_2] entries'. 9726: ' in the file (for the format defined for [_3]).', 9727: '<b>'.$showpct.'</b>','<b>'.$max_match_count.'</b>',$format_descs); 9728: } else { 9729: # Not all entries matching? -> Show warning and additional info 9730: $output .= 9731: &Apache::lonhtmlcommon::confirm_success( 9732: &mt('Comparison of student IDs: [_1] matching ([_2]/[quant,_3,entry,entries])', 9733: '<b>'.$showpct.'</b>',$found_match_count,$max_match_count).'<br />'. 9734: &mt('Not all entries could be matched!'),1).'<br />'. 9735: &mt('Comparison of student IDs in the uploaded file with'. 9736: ' the course roster found matches for [_1] of the [_2] entries'. 9737: ' in the file (for the format defined for [_3]).', 9738: '<b>'.$showpct.'</b>','<b>'.$max_match_count.'</b>',$format_descs). 9739: '<p class="LC_info">'. 9740: &mt('A low percentage of matches results from one of the following:'). 9741: '</p><ul>'. 9742: '<li>'.&mt('The file was uploaded to the wrong course.').'</li>'. 9743: '<li>'.&mt('The data is not in the format expected for the domain: [_1]', 9744: '<i>'.$cdom.'</i>').'</li>'. 9745: '<li>'.&mt('Students did not bubble their IDs, or mis-bubbled them').'</li>'. 9746: '<li>'.&mt('The course roster is not up to date.').'</li>'. 9747: '</ul>'; 9748: } 9749: } 9750: } else { 9751: $output = '<p class="LC_warning">'.&mt('Uploaded file contained no data').'</p>'; 9752: } 9753: return $output; 9754: } 9755: 9756: sub valid_file { 9757: my ($requested_file)=@_; 9758: foreach my $filename (sort(&scantron_filenames())) { 9759: if ($requested_file eq $filename) { return 1; } 9760: } 9761: return 0; 9762: } 9763: 9764: sub scantron_download_scantron_data { 9765: my ($r,$symb) = @_; 9766: my $default_form_data=&defaultFormData($symb); 9767: my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; 9768: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 9769: my $file=$env{'form.scantron_selectfile'}; 9770: if (! &valid_file($file)) { 9771: $r->print(' 9772: <p> 9773: '.&mt('The requested filename was invalid.').' 9774: </p> 9775: '); 9776: return; 9777: } 9778: my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; 9779: my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file; 9780: my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file; 9781: &Apache::lonnet::allowuploaded('/adm/grades',$orig); 9782: &Apache::lonnet::allowuploaded('/adm/grades',$corrected); 9783: &Apache::lonnet::allowuploaded('/adm/grades',$skipped); 9784: $r->print(' 9785: <p> 9786: '.&mt('[_1]Original[_2] file as uploaded by the bubblesheet scanning office.', 9787: '<a href="'.$orig.'">','</a>').' 9788: </p> 9789: <p> 9790: '.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.', 9791: '<a href="'.$corrected.'">','</a>').' 9792: </p> 9793: <p> 9794: '.&mt('[_1]Skipped[_2], a file of records that were skipped.', 9795: '<a href="'.$skipped.'">','</a>').' 9796: </p> 9797: '); 9798: return ''; 9799: } 9800: 9801: sub checkscantron_results { 9802: my ($r,$symb) = @_; 9803: if (!$symb) {return '';} 9804: my $cid = $env{'request.course.id'}; 9805: my %lettdig = &Apache::lonnet::letter_to_digits(); 9806: my $numletts = scalar(keys(%lettdig)); 9807: my $cnum = $env{'course.'.$cid.'.num'}; 9808: my $cdom = $env{'course.'.$cid.'.domain'}; 9809: my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); 9810: my %record; 9811: my %scantron_config = 9812: &Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); 9813: my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); 9814: my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile(); 9815: my $classlist=&Apache::loncoursedata::get_classlist(); 9816: my %idmap=&Apache::grades::username_to_idmap($classlist); 9817: my $navmap=Apache::lonnavmaps::navmap->new(); 9818: unless (ref($navmap)) { 9819: $r->print(&navmap_errormsg()); 9820: return ''; 9821: } 9822: my $map=$navmap->getResourceByUrl($sequence); 9823: my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, 9824: %grader_randomlists_by_symb,%orderedforcode); 9825: if (ref($map)) { 9826: $randomorder=$map->randomorder(); 9827: $randompick=$map->randompick(); 9828: unless ($randomorder || $randompick) { 9829: foreach my $res ($navmap->retrieveResources($map,sub { $_[0]->is_map() },1,0,1)) { 9830: if ($res->randomorder()) { 9831: $randomorder = 1; 9832: } 9833: if ($res->randompick()) { 9834: $randompick = 1; 9835: } 9836: last if ($randomorder || $randompick); 9837: } 9838: } 9839: } 9840: my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); 9841: my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); 9842: if ($nav_error) { 9843: $r->print(&navmap_errormsg()); 9844: return ''; 9845: } 9846: &graders_resources_pass(\@resources,\%grader_partids_by_symb, 9847: \%grader_randomlists_by_symb,$bubbles_per_row); 9848: my ($uname,$udom); 9849: my (%scandata,%lastname,%bylast); 9850: $r->print(' 9851: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n"); 9852: 9853: my @delayqueue; 9854: my %completedstudents; 9855: 9856: my $count=&get_todo_count($scanlines,$scan_data); 9857: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); 9858: my ($username,$domain,$started); 9859: &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. 9860: if ($nav_error) { 9861: $r->print(&navmap_errormsg()); 9862: return ''; 9863: } 9864: 9865: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 9866: 'Processing first student'); 9867: my $start=&Time::HiRes::time(); 9868: my $i=-1; 9869: 9870: while ($i<$scanlines->{'count'}) { 9871: ($username,$domain,$uname)=('','',''); 9872: $i++; 9873: my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i); 9874: if ($line=~/^[\s\cz]*$/) { next; } 9875: if ($started) { 9876: &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, 9877: 'last student'); 9878: } 9879: $started=1; 9880: my $scan_record= 9881: &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config, 9882: $scan_data); 9883: unless ($uname=&scantron_find_student($scan_record,$scan_data, 9884: \%idmap,$i)) { 9885: &Apache::grades::scantron_add_delay(\@delayqueue,$line, 9886: 'Unable to find a student that matches',1); 9887: next; 9888: } 9889: if (exists $completedstudents{$uname}) { 9890: &Apache::grades::scantron_add_delay(\@delayqueue,$line, 9891: 'Student '.$uname.' has multiple sheets',2); 9892: next; 9893: } 9894: my $pid = $scan_record->{'scantron.ID'}; 9895: $lastname{$pid} = $scan_record->{'scantron.LastName'}; 9896: push(@{$bylast{$lastname{$pid}}},$pid); 9897: my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; 9898: my $user = $uname.':'.$usec; 9899: ($username,$domain)=split(/:/,$uname); 9900: 9901: my $scancode; 9902: if ((exists($scan_record->{'scantron.CODE'})) && 9903: (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { 9904: $scancode = $scan_record->{'scantron.CODE'}; 9905: } else { 9906: $scancode = ''; 9907: } 9908: 9909: my @mapresources = @resources; 9910: my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; 9911: my %respnumlookup=(); 9912: my %startline=(); 9913: if ($randomorder || $randompick) { 9914: @mapresources = 9915: &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource, 9916: \%orderedforcode); 9917: my $total = &get_respnum_lookups($sequence,$scan_data,\%idmap,$line, 9918: $scan_record,\@master_seq,\%symb_to_resource, 9919: \%grader_partids_by_symb,\%orderedforcode, 9920: \%respnumlookup,\%startline); 9921: if ($randompick && $total) { 9922: $lastpos = $total*$scantron_config{'Qlength'}; 9923: } 9924: } 9925: $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos); 9926: chomp($scandata{$pid}); 9927: $scandata{$pid} =~ s/\r$//; 9928: 9929: my $counter = -1; 9930: foreach my $resource (@mapresources) { 9931: my $parts; 9932: my $ressymb = $resource->symb(); 9933: if ((exists($grader_randomlists_by_symb{$ressymb})) || 9934: (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { 9935: my $currcode; 9936: if (exists($grader_randomlists_by_symb{$ressymb})) { 9937: $currcode = $scancode; 9938: } 9939: (my $analysis,$parts) = 9940: &scantron_partids_tograde($resource,$env{'request.course.id'}, 9941: $username,$domain,undef, 9942: $bubbles_per_row,$currcode); 9943: } else { 9944: $parts = $grader_partids_by_symb{$ressymb}; 9945: } 9946: ($counter,my $recording) = 9947: &verify_scantron_grading($resource,$domain,$username,$cid,$counter, 9948: $scandata{$pid},$parts, 9949: \%scantron_config,\%lettdig,$numletts, 9950: $randomorder,$randompick, 9951: \%respnumlookup,\%startline); 9952: $record{$pid} .= $recording; 9953: } 9954: } 9955: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); 9956: $r->print('<br />'); 9957: my ($okstudents,$badstudents,$numstudents,$passed,$failed); 9958: $passed = 0; 9959: $failed = 0; 9960: $numstudents = 0; 9961: foreach my $last (sort(keys(%bylast))) { 9962: if (ref($bylast{$last}) eq 'ARRAY') { 9963: foreach my $pid (sort(@{$bylast{$last}})) { 9964: my $showscandata = $scandata{$pid}; 9965: my $showrecord = $record{$pid}; 9966: $showscandata =~ s/\s/ /g; 9967: $showrecord =~ s/\s/ /g; 9968: if ($scandata{$pid} eq $record{$pid}) { 9969: my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row'; 9970: $okstudents .= '<tr class="'.$css_class.'">'. 9971: '<td>'.&mt('Bubblesheet').'</td><td>'.$showscandata.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n". 9972: '</tr>'."\n". 9973: '<tr class="'.$css_class.'">'."\n". 9974: '<td>'.&mt('Submissions').'</td><td>'.$showrecord.'</td></tr>'."\n"; 9975: $passed ++; 9976: } else { 9977: my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row'; 9978: $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". 9979: '</tr>'."\n". 9980: '<tr class="'.$css_class.'">'."\n". 9981: '<td>'.&mt('Submissions').'</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n". 9982: '</tr>'."\n"; 9983: $failed ++; 9984: } 9985: $numstudents ++; 9986: } 9987: } 9988: } 9989: $r->print('<p>'. 9990: &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).', 9991: '<b>', 9992: $numstudents, 9993: '</b>', 9994: $env{'form.scantron_maxbubble'}). 9995: '</p>' 9996: ); 9997: $r->print('<p>' 9998: .&mt('Exact matches for [_1][quant,_2,student][_3].','<b>',$passed,'</b>') 9999: .'<br />' 10000: .&mt('Discrepancies detected for [_1][quant,_2,student][_3].','<b>',$failed,'</b>') 10001: .'</p>'); 10002: if ($passed) { 10003: $r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />'); 10004: $r->print(&Apache::loncommon::start_data_table()."\n". 10005: &Apache::loncommon::start_data_table_header_row()."\n". 10006: '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'. 10007: &Apache::loncommon::end_data_table_header_row()."\n". 10008: $okstudents."\n". 10009: &Apache::loncommon::end_data_table().'<br />'); 10010: } 10011: if ($failed) { 10012: $r->print(&mt('Students with differences between bubblesheet data and submissions are as follows:').'<br /><br />'); 10013: $r->print(&Apache::loncommon::start_data_table()."\n". 10014: &Apache::loncommon::start_data_table_header_row()."\n". 10015: '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'. 10016: &Apache::loncommon::end_data_table_header_row()."\n". 10017: $badstudents."\n". 10018: &Apache::loncommon::end_data_table()).'<br />'. 10019: &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.'); 10020: } 10021: $r->print('</form><br />'); 10022: return; 10023: } 10024: 10025: sub verify_scantron_grading { 10026: my ($resource,$domain,$username,$cid,$counter,$scandata,$partids, 10027: $scantron_config,$lettdig,$numletts,$randomorder,$randompick, 10028: $respnumlookup,$startline) = @_; 10029: my ($record,%expected,%startpos); 10030: return ($counter,$record) if (!ref($resource)); 10031: return ($counter,$record) if (!$resource->is_problem()); 10032: my $symb = $resource->symb(); 10033: return ($counter,$record) if (ref($partids) ne 'ARRAY'); 10034: foreach my $part_id (@{$partids}) { 10035: $counter ++; 10036: $expected{$part_id} = 0; 10037: my $respnum = $counter; 10038: if ($randomorder || $randompick) { 10039: $respnum = $respnumlookup->{$counter}; 10040: $startpos{$part_id} = $startline->{$counter} + 1; 10041: } else { 10042: $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"}; 10043: } 10044: if ($env{"form.scantron.sub_bubblelines.$respnum"}) { 10045: my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$respnum"}); 10046: foreach my $item (@sub_lines) { 10047: $expected{$part_id} += $item; 10048: } 10049: } else { 10050: $expected{$part_id} = $env{"form.scantron.bubblelines.$respnum"}; 10051: } 10052: } 10053: if ($symb) { 10054: my %recorded; 10055: my (%returnhash) = &Apache::lonnet::restore($symb,$cid,$domain,$username); 10056: if ($returnhash{'version'}) { 10057: my %lasthash=(); 10058: my $version; 10059: for ($version=1;$version<=$returnhash{'version'};$version++) { 10060: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) { 10061: $lasthash{$key}=$returnhash{$version.':'.$key}; 10062: } 10063: } 10064: foreach my $key (keys(%lasthash)) { 10065: if ($key =~ /\.scantron$/) { 10066: my $value = &unescape($lasthash{$key}); 10067: my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/); 10068: if ($value eq '') { 10069: for (my $i=0; $i<$expected{$part_id}; $i++) { 10070: for (my $j=0; $j<$scantron_config->{'length'}; $j++) { 10071: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 10072: } 10073: } 10074: } else { 10075: my @tocheck; 10076: my @items = split(//,$value); 10077: if (($scantron_config->{'Qon'} eq 'letter') || 10078: ($scantron_config->{'Qon'} eq 'number')) { 10079: if (@items < $expected{$part_id}) { 10080: my $fragment = substr($scandata,$startpos{$part_id},$expected{$part_id}); 10081: my @singles = split(//,$fragment); 10082: foreach my $pos (@singles) { 10083: if ($pos eq ' ') { 10084: push(@tocheck,$pos); 10085: } else { 10086: my $next = shift(@items); 10087: push(@tocheck,$next); 10088: } 10089: } 10090: } else { 10091: @tocheck = @items; 10092: } 10093: foreach my $letter (@tocheck) { 10094: if ($scantron_config->{'Qon'} eq 'letter') { 10095: if ($letter !~ /^[A-J]$/) { 10096: $letter = $scantron_config->{'Qoff'}; 10097: } 10098: $recorded{$part_id} .= $letter; 10099: } elsif ($scantron_config->{'Qon'} eq 'number') { 10100: my $digit; 10101: if ($letter !~ /^[A-J]$/) { 10102: $digit = $scantron_config->{'Qoff'}; 10103: } else { 10104: $digit = $lettdig->{$letter}; 10105: } 10106: $recorded{$part_id} .= $digit; 10107: } 10108: } 10109: } else { 10110: @tocheck = @items; 10111: for (my $i=0; $i<$expected{$part_id}; $i++) { 10112: my $curr_sub = shift(@tocheck); 10113: my $digit; 10114: if ($curr_sub =~ /^[A-J]$/) { 10115: $digit = $lettdig->{$curr_sub}-1; 10116: } 10117: if ($curr_sub eq 'J') { 10118: $digit += scalar($numletts); 10119: } 10120: for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) { 10121: if ($j == $digit) { 10122: $recorded{$part_id} .= $scantron_config->{'Qon'}; 10123: } else { 10124: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 10125: } 10126: } 10127: } 10128: } 10129: } 10130: } 10131: } 10132: } 10133: foreach my $part_id (@{$partids}) { 10134: if ($recorded{$part_id} eq '') { 10135: for (my $i=0; $i<$expected{$part_id}; $i++) { 10136: for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) { 10137: $recorded{$part_id} .= $scantron_config->{'Qoff'}; 10138: } 10139: } 10140: } 10141: $record .= $recorded{$part_id}; 10142: } 10143: } 10144: return ($counter,$record); 10145: } 10146: 10147: #-------- end of section for handling grading scantron forms ------- 10148: # 10149: #------------------------------------------------------------------- 10150: 10151: #-------------------------- Menu interface ------------------------- 10152: # 10153: #--- Href with symb and command --- 10154: 10155: sub href_symb_cmd { 10156: my ($symb,$cmd)=@_; 10157: return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&command='.$cmd; 10158: } 10159: 10160: sub grading_menu { 10161: my ($request,$symb) = @_; 10162: if (!$symb) {return '';} 10163: 10164: my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb), 10165: 'command'=>'individual'); 10166: 10167: my $url1a = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 10168: 10169: $fields{'command'}='ungraded'; 10170: my $url1b=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 10171: 10172: $fields{'command'}='table'; 10173: my $url1c=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 10174: 10175: $fields{'command'}='all_for_one'; 10176: my $url1d=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 10177: 10178: $fields{'command'}='downloadfilesselect'; 10179: my $url1e=&Apache::lonhtmlcommon::build_url('grades/',\%fields); 10180: 10181: $fields{'command'} = 'csvform'; 10182: my $url2 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 10183: 10184: $fields{'command'} = 'processclicker'; 10185: my $url3 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 10186: 10187: $fields{'command'} = 'scantron_selectphase'; 10188: my $url4 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 10189: 10190: $fields{'command'} = 'initialverifyreceipt'; 10191: my $url5 = &Apache::lonhtmlcommon::build_url('grades/',\%fields); 10192: 10193: my %permissions; 10194: if ($perm{'mgr'}) { 10195: $permissions{'either'} = 'F'; 10196: $permissions{'mgr'} = 'F'; 10197: } 10198: if ($perm{'vgr'}) { 10199: $permissions{'either'} = 'F'; 10200: $permissions{'vgr'} = 'F'; 10201: } 10202: 10203: my @menu = ({ categorytitle=>'Hand Grading', 10204: items =>[ 10205: { linktext => 'Select individual students to grade', 10206: url => $url1a, 10207: permission => $permissions{'either'}, 10208: icon => 'grade_students.png', 10209: linktitle => 'Grade current resource for a selection of students.' 10210: }, 10211: { linktext => 'Grade ungraded submissions', 10212: url => $url1b, 10213: permission => $permissions{'either'}, 10214: icon => 'ungrade_sub.png', 10215: linktitle => 'Grade all submissions that have not been graded yet.' 10216: }, 10217: 10218: { linktext => 'Grading table', 10219: url => $url1c, 10220: permission => $permissions{'either'}, 10221: icon => 'grading_table.png', 10222: linktitle => 'Grade current resource for all students.' 10223: }, 10224: { linktext => 'Grade page/folder for one student', 10225: url => $url1d, 10226: permission => $permissions{'either'}, 10227: icon => 'grade_PageFolder.png', 10228: linktitle => 'Grade all resources in current page/sequence/folder for one student.' 10229: }, 10230: { linktext => 'Download submitted files', 10231: url => $url1e, 10232: permission => $permissions{'either'}, 10233: icon => 'download_sub.png', 10234: linktitle => 'Download all files submitted by students.' 10235: }]}, 10236: { categorytitle=>'Automated Grading', 10237: items =>[ 10238: 10239: { linktext => 'Upload Scores', 10240: url => $url2, 10241: permission => $permissions{'mgr'}, 10242: icon => 'uploadscores.png', 10243: linktitle => 'Specify a file containing the class scores for current resource.' 10244: }, 10245: { linktext => 'Process Clicker', 10246: url => $url3, 10247: permission => $permissions{'mgr'}, 10248: icon => 'addClickerInfoFile.png', 10249: linktitle => 'Specify a file containing the clicker information for this resource.' 10250: }, 10251: { linktext => 'Grade/Manage/Review Bubblesheets', 10252: url => $url4, 10253: permission => $permissions{'mgr'}, 10254: icon => 'bubblesheet.png', 10255: linktitle => 'Grade bubblesheet exams, upload/download bubblesheet data files, and review previously graded bubblesheet exams.' 10256: }, 10257: { linktext => 'Verify Receipt Number', 10258: url => $url5, 10259: permission => $permissions{'either'}, 10260: icon => 'receipt_number.png', 10261: linktitle => 'Verify a system-generated receipt number for correct problem solution.' 10262: } 10263: 10264: ] 10265: }); 10266: 10267: # Create the menu 10268: my $Str; 10269: $Str .= '<form method="post" action="" name="gradingMenu">'; 10270: $Str .= '<input type="hidden" name="command" value="" />'. 10271: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 10272: 10273: $Str .= &Apache::lonhtmlcommon::generate_menu(@menu); 10274: return $Str; 10275: } 10276: 10277: sub ungraded { 10278: my ($request)=@_; 10279: &submit_options($request); 10280: } 10281: 10282: sub submit_options_sequence { 10283: my ($request,$symb) = @_; 10284: if (!$symb) {return '';} 10285: &commonJSfunctions($request); 10286: my $result; 10287: 10288: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 10289: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 10290: $result.=&selectfield(0). 10291: '<input type="hidden" name="command" value="pickStudentPage" /> 10292: <div> 10293: <input type="submit" value="'.&mt('Next').' →" /> 10294: </div> 10295: </div> 10296: </form>'; 10297: return $result; 10298: } 10299: 10300: sub submit_options_table { 10301: my ($request,$symb) = @_; 10302: if (!$symb) {return '';} 10303: &commonJSfunctions($request); 10304: my $is_tool = ($symb =~ /ext\.tool$/); 10305: my $result; 10306: 10307: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 10308: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 10309: 10310: $result.=&selectfield(1,$is_tool). 10311: '<input type="hidden" name="command" value="viewgrades" /> 10312: <div> 10313: <input type="submit" value="'.&mt('Next').' →" /> 10314: </div> 10315: </div> 10316: </form>'; 10317: return $result; 10318: } 10319: 10320: sub submit_options_download { 10321: my ($request,$symb) = @_; 10322: if (!$symb) {return '';} 10323: 10324: my $res_error; 10325: my ($partlist,$handgrade,$responseType,$numresp,$numessay,$numdropbox) = 10326: &response_type($symb,\$res_error); 10327: if ($res_error) { 10328: $request->print(&mt('An error occurred retrieving response types')); 10329: return; 10330: } 10331: unless ($numessay) { 10332: $request->print(&mt('No essayresponse items found')); 10333: return; 10334: } 10335: my $table; 10336: if (ref($partlist) eq 'ARRAY') { 10337: if (scalar(@$partlist) > 1 ) { 10338: $table = &showResourceInfo($symb,$partlist,$responseType,'gradingMenu',1,1); 10339: } 10340: } 10341: 10342: my $is_tool = ($symb =~ /ext\.tool$/); 10343: &commonJSfunctions($request); 10344: 10345: my $result='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 10346: $table."\n". 10347: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 10348: $result.=' 10349: <h2> 10350: '.&mt('Select Students for whom to Download Submitted Files').' 10351: </h2>'.&selectfield(1,$is_tool).' 10352: <input type="hidden" name="command" value="downloadfileslink" /> 10353: <input type="submit" value="'.&mt('Next').' →" /> 10354: </div> 10355: </div> 10356: 10357: 10358: </form>'; 10359: return $result; 10360: } 10361: 10362: #--- Displays the submissions first page ------- 10363: sub submit_options { 10364: my ($request,$symb) = @_; 10365: if (!$symb) {return '';} 10366: 10367: my $is_tool = ($symb =~ /ext\.tool$/); 10368: &commonJSfunctions($request); 10369: my $result; 10370: 10371: $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n". 10372: '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; 10373: $result.=&selectfield(1,$is_tool).' 10374: <input type="hidden" name="command" value="submission" /> 10375: <input type="submit" value="'.&mt('Next').' →" /> 10376: </div> 10377: </div> 10378: </form>'; 10379: return $result; 10380: } 10381: 10382: sub selectfield { 10383: my ($full,$is_tool)=@_; 10384: my %options; 10385: if ($is_tool) { 10386: %options = 10387: (&transtatus_options, 10388: 'select_form_order' => ['yes','incorrect','all']); 10389: } else { 10390: %options = 10391: (&substatus_options, 10392: 'select_form_order' => ['yes','queued','graded','incorrect','all']); 10393: } 10394: 10395: # 10396: # PrepareClasslist() needs to be called to avoid getting a sections list 10397: # for a different course from the @Sections global in lonstatistics.pm, 10398: # populated by an earlier request. 10399: # 10400: &Apache::lonstatistics::PrepareClasslist(); 10401: 10402: my $result='<div class="LC_columnSection"> 10403: 10404: <fieldset> 10405: <legend> 10406: '.&mt('Sections').' 10407: </legend> 10408: '.&Apache::lonstatistics::SectionSelect('section','multiple',5).' 10409: </fieldset> 10410: 10411: <fieldset> 10412: <legend> 10413: '.&mt('Groups').' 10414: </legend> 10415: '.&Apache::lonstatistics::GroupSelect('group','multiple',5).' 10416: </fieldset> 10417: 10418: <fieldset> 10419: <legend> 10420: '.&mt('Access Status').' 10421: </legend> 10422: '.&Apache::lonhtmlcommon::StatusOptions(undef,undef,5,undef,'mult').' 10423: </fieldset>'; 10424: if ($full) { 10425: my $heading = &mt('Submission Status'); 10426: if ($is_tool) { 10427: $heading = &mt('Transaction Status'); 10428: } 10429: $result.=' 10430: <fieldset> 10431: <legend> 10432: '.$heading.' 10433: </legend>'. 10434: &Apache::loncommon::select_form('all','submitonly',\%options). 10435: '</fieldset>'; 10436: } 10437: $result.='</div><br />'; 10438: return $result; 10439: } 10440: 10441: sub substatus_options { 10442: return &Apache::lonlocal::texthash( 10443: 'yes' => 'with submissions', 10444: 'queued' => 'in grading queue', 10445: 'graded' => 'with ungraded submissions', 10446: 'incorrect' => 'with incorrect submissions', 10447: 'all' => 'with any status', 10448: ); 10449: } 10450: 10451: sub transtatus_options { 10452: return &Apache::lonlocal::texthash( 10453: 'yes' => 'with score transactions', 10454: 'incorrect' => 'with less than full credit', 10455: 'all' => 'with any status', 10456: ); 10457: } 10458: 10459: sub reset_perm { 10460: undef(%perm); 10461: } 10462: 10463: sub init_perm { 10464: &reset_perm(); 10465: foreach my $test_perm ('vgr','mgr','opa') { 10466: 10467: my $scope = $env{'request.course.id'}; 10468: if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) { 10469: 10470: $scope .= '/'.$env{'request.course.sec'}; 10471: if ( $perm{$test_perm}= 10472: &Apache::lonnet::allowed($test_perm,$scope)) { 10473: $perm{$test_perm.'_section'}=$env{'request.course.sec'}; 10474: } else { 10475: delete($perm{$test_perm}); 10476: } 10477: } 10478: } 10479: } 10480: 10481: sub init_old_essays { 10482: my ($symb,$apath,$adom,$aname) = @_; 10483: if ($symb ne '') { 10484: my %essays = &Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); 10485: if (keys(%essays) > 0) { 10486: $old_essays{$symb} = \%essays; 10487: } 10488: } 10489: return; 10490: } 10491: 10492: sub reset_old_essays { 10493: undef(%old_essays); 10494: } 10495: 10496: sub gather_clicker_ids { 10497: my %clicker_ids; 10498: 10499: my $classlist = &Apache::loncoursedata::get_classlist(); 10500: 10501: # Set up a couple variables. 10502: my $username_idx = &Apache::loncoursedata::CL_SNAME(); 10503: my $domain_idx = &Apache::loncoursedata::CL_SDOM(); 10504: my $status_idx = &Apache::loncoursedata::CL_STATUS(); 10505: 10506: foreach my $student (keys(%$classlist)) { 10507: if ($classlist->{$student}->[$status_idx] ne 'Active') { next; } 10508: my $username = $classlist->{$student}->[$username_idx]; 10509: my $domain = $classlist->{$student}->[$domain_idx]; 10510: my $clickers = 10511: (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; 10512: foreach my $id (split(/\,/,$clickers)) { 10513: $id=~s/^[\#0]+//; 10514: $id=~s/[\-\:]//g; 10515: if (exists($clicker_ids{$id})) { 10516: $clicker_ids{$id}.=','.$username.':'.$domain; 10517: } else { 10518: $clicker_ids{$id}=$username.':'.$domain; 10519: } 10520: } 10521: } 10522: return %clicker_ids; 10523: } 10524: 10525: sub gather_adv_clicker_ids { 10526: my %clicker_ids; 10527: my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; 10528: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 10529: my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum); 10530: foreach my $element (sort(keys(%coursepersonnel))) { 10531: foreach my $person (split(/\,/,$coursepersonnel{$element})) { 10532: my ($puname,$pudom)=split(/\:/,$person); 10533: my $clickers = 10534: (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; 10535: foreach my $id (split(/\,/,$clickers)) { 10536: $id=~s/^[\#0]+//; 10537: $id=~s/[\-\:]//g; 10538: if (exists($clicker_ids{$id})) { 10539: $clicker_ids{$id}.=','.$puname.':'.$pudom; 10540: } else { 10541: $clicker_ids{$id}=$puname.':'.$pudom; 10542: } 10543: } 10544: } 10545: } 10546: return %clicker_ids; 10547: } 10548: 10549: sub clicker_grading_parameters { 10550: return ('gradingmechanism' => 'scalar', 10551: 'upfiletype' => 'scalar', 10552: 'specificid' => 'scalar', 10553: 'pcorrect' => 'scalar', 10554: 'pincorrect' => 'scalar'); 10555: } 10556: 10557: sub process_clicker { 10558: my ($r,$symb)=@_; 10559: if (!$symb) {return '';} 10560: my $result=&checkforfile_js(); 10561: $result.=&Apache::loncommon::start_data_table(). 10562: &Apache::loncommon::start_data_table_header_row(). 10563: '<th>'.&mt('Specify a file containing clicker information and set grading options.').'</th>'. 10564: &Apache::loncommon::end_data_table_header_row(). 10565: &Apache::loncommon::start_data_table_row()."<td>\n"; 10566: # Attempt to restore parameters from last session, set defaults if not present 10567: my %Saveable_Parameters=&clicker_grading_parameters(); 10568: &Apache::loncommon::restore_course_settings('grades_clicker', 10569: \%Saveable_Parameters); 10570: if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; } 10571: if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; } 10572: if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; } 10573: if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; } 10574: 10575: my %checked; 10576: foreach my $gradingmechanism ('attendance','personnel','specific','given') { 10577: if ($env{'form.gradingmechanism'} eq $gradingmechanism) { 10578: $checked{$gradingmechanism}=' checked="checked"'; 10579: } 10580: } 10581: 10582: my $upload=&mt("Evaluate File"); 10583: my $type=&mt("Type"); 10584: my $attendance=&mt("Award points just for participation"); 10585: my $personnel=&mt("Correctness determined from response by course personnel"); 10586: my $specific=&mt("Correctness determined from response with clicker ID(s)"); 10587: my $given=&mt("Correctness determined from given list of answers").' '. 10588: '<font size="-2"><tt>('.&mt("Provide comma-separated list. Use '*' for any answer correct, '-' for skip").')</tt></font>'; 10589: my $pcorrect=&mt("Percentage points for correct solution"); 10590: my $pincorrect=&mt("Percentage points for incorrect solution"); 10591: my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', 10592: {'iclicker' => 'i>clicker', 10593: 'interwrite' => 'interwrite PRS', 10594: 'turning' => 'Turning Technologies'}); 10595: $symb = &Apache::lonenc::check_encrypt($symb); 10596: $result.= &Apache::lonhtmlcommon::scripttag(<<ENDUPFORM); 10597: function sanitycheck() { 10598: // Accept only integer percentages 10599: document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value); 10600: document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value); 10601: // Find out grading choice 10602: for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) { 10603: if (document.forms.gradesupload.gradingmechanism[i].checked) { 10604: gradingchoice=document.forms.gradesupload.gradingmechanism[i].value; 10605: } 10606: } 10607: // By default, new choice equals user selection 10608: newgradingchoice=gradingchoice; 10609: // Not good to give more points for false answers than correct ones 10610: if (Math.round(document.forms.gradesupload.pcorrect.value)<Math.round(document.forms.gradesupload.pincorrect.value)) { 10611: document.forms.gradesupload.pcorrect.value=document.forms.gradesupload.pincorrect.value; 10612: } 10613: // If new choice is attendance only, and old choice was correctness-based, restore defaults 10614: if ((gradingchoice=='attendance') && (document.forms.gradesupload.waschecked.value!='attendance')) { 10615: document.forms.gradesupload.pcorrect.value=100; 10616: document.forms.gradesupload.pincorrect.value=100; 10617: } 10618: // If the values are different, cannot be attendance only 10619: if ((Math.round(document.forms.gradesupload.pcorrect.value)!=Math.round(document.forms.gradesupload.pincorrect.value)) && 10620: (gradingchoice=='attendance')) { 10621: newgradingchoice='personnel'; 10622: } 10623: // Change grading choice to new one 10624: for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) { 10625: if (document.forms.gradesupload.gradingmechanism[i].value==newgradingchoice) { 10626: document.forms.gradesupload.gradingmechanism[i].checked=true; 10627: } else { 10628: document.forms.gradesupload.gradingmechanism[i].checked=false; 10629: } 10630: } 10631: // Remember the old state 10632: document.forms.gradesupload.waschecked.value=newgradingchoice; 10633: } 10634: ENDUPFORM 10635: $result.= <<ENDUPFORM; 10636: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload"> 10637: <input type="hidden" name="symb" value="$symb" /> 10638: <input type="hidden" name="command" value="processclickerfile" /> 10639: <input type="file" name="upfile" size="50" /> 10640: <br /><label>$type: $selectform</label> 10641: ENDUPFORM 10642: $result.='</td>'.&Apache::loncommon::end_data_table_row(). 10643: &Apache::loncommon::start_data_table_row().'<td>'.(<<ENDGRADINGFORM); 10644: <label><input type="radio" name="gradingmechanism" value="attendance"$checked{'attendance'} onclick="sanitycheck()" />$attendance </label> 10645: <br /><label><input type="radio" name="gradingmechanism" value="personnel"$checked{'personnel'} onclick="sanitycheck()" />$personnel</label> 10646: <br /><label><input type="radio" name="gradingmechanism" value="specific"$checked{'specific'} onclick="sanitycheck()" />$specific </label> 10647: <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" /> 10648: <br /><label><input type="radio" name="gradingmechanism" value="given"$checked{'given'} onclick="sanitycheck()" />$given </label> 10649: <br />    10650: <input type="text" name="givenanswer" size="50" /> 10651: <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" /> 10652: ENDGRADINGFORM 10653: $result.='</td>'.&Apache::loncommon::end_data_table_row(). 10654: &Apache::loncommon::start_data_table_row().'<td>'.(<<ENDPERCFORM); 10655: <label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onchange="sanitycheck()" /></label> 10656: <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onchange="sanitycheck()" /></label> 10657: <br /><input type="button" onclick="javascript:checkUpload(this.form);" value="$upload" /> 10658: </form> 10659: ENDPERCFORM 10660: $result.='</td>'. 10661: &Apache::loncommon::end_data_table_row(). 10662: &Apache::loncommon::end_data_table(); 10663: return $result; 10664: } 10665: 10666: sub process_clicker_file { 10667: my ($r,$symb) = @_; 10668: if (!$symb) {return '';} 10669: 10670: my %Saveable_Parameters=&clicker_grading_parameters(); 10671: &Apache::loncommon::store_course_settings('grades_clicker', 10672: \%Saveable_Parameters); 10673: my $result=''; 10674: if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { 10675: $result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>'; 10676: return $result; 10677: } 10678: if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\S/)) { 10679: $result.='<span class="LC_error">'.&mt('You need to specify the correct answer').'</span>'; 10680: return $result; 10681: } 10682: my $foundgiven=0; 10683: if ($env{'form.gradingmechanism'} eq 'given') { 10684: $env{'form.givenanswer'}=~s/^\s*//gs; 10685: $env{'form.givenanswer'}=~s/\s*$//gs; 10686: $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-\+]+/\,/g; 10687: $env{'form.givenanswer'}=uc($env{'form.givenanswer'}); 10688: my @answers=split(/\,/,$env{'form.givenanswer'}); 10689: $foundgiven=$#answers+1; 10690: } 10691: my %clicker_ids=&gather_clicker_ids(); 10692: my %correct_ids; 10693: if ($env{'form.gradingmechanism'} eq 'personnel') { 10694: %correct_ids=&gather_adv_clicker_ids(); 10695: } 10696: if ($env{'form.gradingmechanism'} eq 'specific') { 10697: foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; 10698: $correct_id=~tr/a-z/A-Z/; 10699: $correct_id=~s/\s//gs; 10700: $correct_id=~s/^[\#0]+//; 10701: $correct_id=~s/[\-\:]//g; 10702: if ($correct_id) { 10703: $correct_ids{$correct_id}='specified'; 10704: } 10705: } 10706: } 10707: if ($env{'form.gradingmechanism'} eq 'attendance') { 10708: $result.=&mt('Score based on attendance only'); 10709: } elsif ($env{'form.gradingmechanism'} eq 'given') { 10710: $result.=&mt('Score based on [_1] ([_2] answers)','<tt>'.$env{'form.givenanswer'}.'</tt>',$foundgiven); 10711: } else { 10712: my $number=0; 10713: $result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>'; 10714: foreach my $id (sort(keys(%correct_ids))) { 10715: $result.='<br /><tt>'.$id.'</tt> - '; 10716: if ($correct_ids{$id} eq 'specified') { 10717: $result.=&mt('specified'); 10718: } else { 10719: my ($uname,$udom)=split(/\:/,$correct_ids{$id}); 10720: $result.=&Apache::loncommon::plainname($uname,$udom); 10721: } 10722: $number++; 10723: } 10724: $result.="</p>\n"; 10725: if ($number==0) { 10726: $result .= 10727: &Apache::lonhtmlcommon::confirm_success( 10728: &mt('No IDs found to determine correct answer'),1); 10729: return $result; 10730: } 10731: } 10732: if (length($env{'form.upfile'}) < 2) { 10733: $result .= 10734: &Apache::lonhtmlcommon::confirm_success( 10735: &mt('The file: [_1] you attempted to upload contained no information. Please check that you entered the correct filename.', 10736: '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'),1); 10737: return $result; 10738: } 10739: my $mimetype; 10740: if ($env{'form.upfiletype'} eq 'iclicker') { 10741: my $mm = new File::MMagic; 10742: $mimetype = $mm->checktype_contents($env{'form.upfile'}); 10743: unless (($mimetype eq 'text/plain') || ($mimetype eq 'text/html')) { 10744: $result.= '<p>'. 10745: &Apache::lonhtmlcommon::confirm_success( 10746: &mt('File format is neither csv (iclicker 6) nor xml (iclicker 7)'),1).'</p>'; 10747: return $result; 10748: } 10749: } elsif (($env{'form.upfiletype'} ne 'interwrite') && ($env{'form.upfiletype'} ne 'turning')) { 10750: $result .= '<p>'. 10751: &Apache::lonhtmlcommon::confirm_success( 10752: &mt('Invalid clicker type: choose one of: i>clicker, Interwrite PRS, or Turning Technologies.'),1).'</p>'; 10753: return $result; 10754: } 10755: 10756: # Were able to get all the info needed, now analyze the file 10757: 10758: $result.=&Apache::loncommon::studentbrowser_javascript(); 10759: $symb = &Apache::lonenc::check_encrypt($symb); 10760: $result.=&Apache::loncommon::start_data_table(). 10761: &Apache::loncommon::start_data_table_header_row(). 10762: '<th>'.&mt('Evaluate clicker file').'</th>'. 10763: &Apache::loncommon::end_data_table_header_row(). 10764: &Apache::loncommon::start_data_table_row().(<<ENDHEADER); 10765: <td> 10766: <form method="post" action="/adm/grades" name="clickeranalysis"> 10767: <input type="hidden" name="symb" value="$symb" /> 10768: <input type="hidden" name="command" value="assignclickergrades" /> 10769: <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" /> 10770: <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" /> 10771: <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" /> 10772: ENDHEADER 10773: if ($env{'form.gradingmechanism'} eq 'given') { 10774: $result.='<input type="hidden" name="correct:given" value="'.$env{'form.givenanswer'}.'" />'; 10775: } 10776: my %responses; 10777: my @questiontitles; 10778: my $errormsg=''; 10779: my $number=0; 10780: if ($env{'form.upfiletype'} eq 'iclicker') { 10781: if ($mimetype eq 'text/plain') { 10782: ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); 10783: } elsif ($mimetype eq 'text/html') { 10784: ($errormsg,$number)=&iclickerxml_eval(\@questiontitles,\%responses); 10785: } 10786: } elsif ($env{'form.upfiletype'} eq 'interwrite') { 10787: ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); 10788: } elsif ($env{'form.upfiletype'} eq 'turning') { 10789: ($errormsg,$number)=&turning_eval(\@questiontitles,\%responses); 10790: } 10791: $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'. 10792: '<input type="hidden" name="number" value="'.$number.'" />'. 10793: &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', 10794: $env{'form.pcorrect'},$env{'form.pincorrect'}). 10795: '<br />'; 10796: if (($env{'form.gradingmechanism'} eq 'given') && ($number!=$foundgiven)) { 10797: $result.='<span class="LC_error">'.&mt('Number of given answers does not agree with number of questions in file.').'</span>'; 10798: return $result; 10799: } 10800: # Remember Question Titles 10801: # FIXME: Possibly need delimiter other than ":" 10802: for (my $i=0;$i<$number;$i++) { 10803: $result.='<input type="hidden" name="question:'.$i.'" value="'. 10804: &HTML::Entities::encode($questiontitles[$i],'"&<>').'" />'; 10805: } 10806: my $correct_count=0; 10807: my $student_count=0; 10808: my $unknown_count=0; 10809: # Match answers with usernames 10810: # FIXME: Possibly need delimiter other than ":" 10811: foreach my $id (keys(%responses)) { 10812: if ($correct_ids{$id}) { 10813: $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />'; 10814: $correct_count++; 10815: } elsif ($clicker_ids{$id}) { 10816: if ($clicker_ids{$id}=~/\,/) { 10817: # More than one user with the same clicker! 10818: $result.="</td>".&Apache::loncommon::end_data_table_row(). 10819: &Apache::loncommon::start_data_table_row()."<td>". 10820: &mt('Clicker registered more than once').": <tt>".$id."</tt><br />"; 10821: $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'. 10822: "<select name='multi".$id."'>"; 10823: foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) { 10824: $result.="<option value='".$reguser."'>".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.')</option>'; 10825: } 10826: $result.='</select>'; 10827: $unknown_count++; 10828: } else { 10829: # Good: found one and only one user with the right clicker 10830: $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />'; 10831: $student_count++; 10832: } 10833: } else { 10834: $result.="</td>".&Apache::loncommon::end_data_table_row(). 10835: &Apache::loncommon::start_data_table_row()."<td>". 10836: &mt('Unregistered Clicker')." <tt>".$id."</tt><br />"; 10837: $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'. 10838: "\n".&mt("Username").": <input type='text' name='uname".$id."' /> ". 10839: "\n".&mt("Domain").": ". 10840: &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '. 10841: &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id,'',$id); 10842: $unknown_count++; 10843: } 10844: } 10845: $result.='<hr />'. 10846: &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); 10847: if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) { 10848: if ($correct_count==0) { 10849: $errormsg.="Found no correct answers for grading!"; 10850: } elsif ($correct_count>1) { 10851: $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>'; 10852: } 10853: } 10854: if ($number<1) { 10855: $errormsg.="Found no questions."; 10856: } 10857: if ($errormsg) { 10858: $result.='<br /><span class="LC_error">'.&mt($errormsg).'</span>'; 10859: } else { 10860: $result.='<br /><input type="submit" name="finalize" value="'.&mt('Finalize Grading').'" />'; 10861: } 10862: $result.='</form></td>'. 10863: &Apache::loncommon::end_data_table_row(). 10864: &Apache::loncommon::end_data_table(); 10865: return $result; 10866: } 10867: 10868: sub iclicker_eval { 10869: my ($questiontitles,$responses)=@_; 10870: my $number=0; 10871: my $errormsg=''; 10872: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 10873: my %components=&Apache::loncommon::record_sep($line); 10874: my @entries=map {$components{$_}} (sort(keys(%components))); 10875: if ($entries[0] eq 'Question') { 10876: for (my $i=3;$i<$#entries;$i+=6) { 10877: $$questiontitles[$number]=$entries[$i]; 10878: $number++; 10879: } 10880: } 10881: if ($entries[0]=~/^\#/) { 10882: my $id=$entries[0]; 10883: my @idresponses; 10884: $id=~s/^[\#0]+//; 10885: for (my $i=0;$i<$number;$i++) { 10886: my $idx=3+$i*6; 10887: $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+]+//g; 10888: push(@idresponses,$entries[$idx]); 10889: } 10890: $$responses{$id}=join(',',@idresponses); 10891: } 10892: } 10893: return ($errormsg,$number); 10894: } 10895: 10896: sub iclickerxml_eval { 10897: my ($questiontitles,$responses)=@_; 10898: my $number=0; 10899: my $errormsg=''; 10900: my @state; 10901: my %respbyid; 10902: my $p = HTML::Parser->new 10903: ( 10904: xml_mode => 1, 10905: start_h => 10906: [sub { 10907: my ($tagname,$attr) = @_; 10908: push(@state,$tagname); 10909: if ("@state" eq "ssn p") { 10910: my $title = $attr->{qn}; 10911: $title =~ s/(^\s+|\s+$)//g; 10912: $questiontitles->[$number]=$title; 10913: } elsif ("@state" eq "ssn p v") { 10914: my $id = $attr->{id}; 10915: my $entry = $attr->{ans}; 10916: $id=~s/^[\#0]+//; 10917: $entry =~s/[^a-zA-Z0-9\.\*\-\+]+//g; 10918: $respbyid{$id}[$number] = $entry; 10919: } 10920: }, "tagname, attr"], 10921: end_h => 10922: [sub { 10923: my ($tagname) = @_; 10924: if ("@state" eq "ssn p") { 10925: $number++; 10926: } 10927: pop(@state); 10928: }, "tagname"], 10929: ); 10930: 10931: $p->parse($env{'form.upfile'}); 10932: $p->eof; 10933: foreach my $id (keys(%respbyid)) { 10934: $responses->{$id}=join(',',@{$respbyid{$id}}); 10935: } 10936: return ($errormsg,$number); 10937: } 10938: 10939: sub interwrite_eval { 10940: my ($questiontitles,$responses)=@_; 10941: my $number=0; 10942: my $errormsg=''; 10943: my $skipline=1; 10944: my $questionnumber=0; 10945: my %idresponses=(); 10946: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 10947: my %components=&Apache::loncommon::record_sep($line); 10948: my @entries=map {$components{$_}} (sort(keys(%components))); 10949: if ($entries[1] eq 'Time') { $skipline=0; next; } 10950: if ($entries[1] eq 'Response') { $skipline=1; } 10951: next if $skipline; 10952: if ($entries[0]!=$questionnumber) { 10953: $questionnumber=$entries[0]; 10954: $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); 10955: $number++; 10956: } 10957: my $id=$entries[4]; 10958: $id=~s/^[\#0]+//; 10959: $id=~s/^v\d*\://i; 10960: $id=~s/[\-\:]//g; 10961: $idresponses{$id}[$number]=$entries[6]; 10962: } 10963: foreach my $id (keys(%idresponses)) { 10964: $$responses{$id}=join(',',@{$idresponses{$id}}); 10965: $$responses{$id}=~s/^\s*\,//; 10966: } 10967: return ($errormsg,$number); 10968: } 10969: 10970: sub turning_eval { 10971: my ($questiontitles,$responses)=@_; 10972: my $number=0; 10973: my $errormsg=''; 10974: foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { 10975: my %components=&Apache::loncommon::record_sep($line); 10976: my @entries=map {$components{$_}} (sort(keys(%components))); 10977: if ($#entries>$number) { $number=$#entries; } 10978: my $id=$entries[0]; 10979: my @idresponses; 10980: $id=~s/^[\#0]+//; 10981: unless ($id) { next; } 10982: for (my $idx=1;$idx<=$#entries;$idx++) { 10983: $entries[$idx]=~s/\,/\;/g; 10984: $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+\;]+//g; 10985: push(@idresponses,$entries[$idx]); 10986: } 10987: $$responses{$id}=join(',',@idresponses); 10988: } 10989: for (my $i=1; $i<=$number; $i++) { 10990: $$questiontitles[$i]=&mt('Question [_1]',$i); 10991: } 10992: return ($errormsg,$number); 10993: } 10994: 10995: sub assign_clicker_grades { 10996: my ($r,$symb) = @_; 10997: if (!$symb) {return '';} 10998: # See which part we are saving to 10999: my $res_error; 11000: my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); 11001: if ($res_error) { 11002: return &navmap_errormsg(); 11003: } 11004: # FIXME: This should probably look for the first handgradeable part 11005: my $part=$$partlist[0]; 11006: # Start screen output 11007: my $result = &Apache::loncommon::start_data_table(). 11008: &Apache::loncommon::start_data_table_header_row(). 11009: '<th>'.&mt('Assigning grades based on clicker file').'</th>'. 11010: &Apache::loncommon::end_data_table_header_row(). 11011: &Apache::loncommon::start_data_table_row().'<td>'; 11012: # Get correct result 11013: # FIXME: Possibly need delimiter other than ":" 11014: my @correct=(); 11015: my $gradingmechanism=$env{'form.gradingmechanism'}; 11016: my $number=$env{'form.number'}; 11017: if ($gradingmechanism ne 'attendance') { 11018: foreach my $key (keys(%env)) { 11019: if ($key=~/^form\.correct\:/) { 11020: my @input=split(/\,/,$env{$key}); 11021: for (my $i=0;$i<=$#input;$i++) { 11022: if (($correct[$i]) && ($input[$i]) && 11023: ($correct[$i] ne $input[$i])) { 11024: $result.='<br /><span class="LC_warning">'. 11025: &mt('More than one correct result given for question "[_1]": [_2] versus [_3].', 11026: $env{'form.question:'.$i},$correct[$i],$input[$i]).'</span>'; 11027: } elsif (($input[$i]) || ($input[$i] eq '0')) { 11028: $correct[$i]=$input[$i]; 11029: } 11030: } 11031: } 11032: } 11033: for (my $i=0;$i<$number;$i++) { 11034: if ((!$correct[$i]) && ($correct[$i] ne '0')) { 11035: $result.='<br /><span class="LC_error">'. 11036: &mt('No correct result given for question "[_1]"!', 11037: $env{'form.question:'.$i}).'</span>'; 11038: } 11039: } 11040: $result.='<br />'.&mt("Correct answer: [_1]",join(', ',map { ((($_) || ($_ eq '0'))?$_:'-') } @correct)); 11041: } 11042: # Start grading 11043: my $pcorrect=$env{'form.pcorrect'}; 11044: my $pincorrect=$env{'form.pincorrect'}; 11045: my $storecount=0; 11046: my %users=(); 11047: foreach my $key (keys(%env)) { 11048: my $user=''; 11049: if ($key=~/^form\.student\:(.*)$/) { 11050: $user=$1; 11051: } 11052: if ($key=~/^form\.unknown\:(.*)$/) { 11053: my $id=$1; 11054: if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) { 11055: $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id}; 11056: } elsif ($env{'form.multi'.$id}) { 11057: $user=$env{'form.multi'.$id}; 11058: } 11059: } 11060: if ($user) { 11061: if ($users{$user}) { 11062: $result.='<br /><span class="LC_warning">'. 11063: &mt('More than one entry found for [_1]!','<tt>'.$user.'</tt>'). 11064: '</span><br />'; 11065: } 11066: $users{$user}=1; 11067: my @answer=split(/\,/,$env{$key}); 11068: my $sum=0; 11069: my $realnumber=$number; 11070: for (my $i=0;$i<$number;$i++) { 11071: if ($correct[$i] eq '-') { 11072: $realnumber--; 11073: } elsif (($answer[$i]) || ($answer[$i]=~/^[0\.]+$/)) { 11074: if ($gradingmechanism eq 'attendance') { 11075: $sum+=$pcorrect; 11076: } elsif ($correct[$i] eq '*') { 11077: $sum+=$pcorrect; 11078: } else { 11079: # We actually grade if correct or not 11080: my $increment=$pincorrect; 11081: # Special case: numerical answer "0" 11082: if ($correct[$i] eq '0') { 11083: if ($answer[$i]=~/^[0\.]+$/) { 11084: $increment=$pcorrect; 11085: } 11086: # General numerical answer, both evaluate to something non-zero 11087: } elsif ((1.0*$correct[$i]!=0) && (1.0*$answer[$i]!=0)) { 11088: if (1.0*$correct[$i]==1.0*$answer[$i]) { 11089: $increment=$pcorrect; 11090: } 11091: # Must be just alphanumeric 11092: } elsif ($answer[$i] eq $correct[$i]) { 11093: $increment=$pcorrect; 11094: } 11095: $sum+=$increment; 11096: } 11097: } 11098: } 11099: my $ave=$sum/(100*$realnumber); 11100: # Store 11101: my ($username,$domain)=split(/\:/,$user); 11102: my %grades=(); 11103: $grades{"resource.$part.solved"}='correct_by_override'; 11104: $grades{"resource.$part.awarded"}=$ave; 11105: $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; 11106: my $returncode=&Apache::lonnet::cstore(\%grades,$symb, 11107: $env{'request.course.id'}, 11108: $domain,$username); 11109: if ($returncode ne 'ok') { 11110: $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>"; 11111: } else { 11112: $storecount++; 11113: } 11114: } 11115: } 11116: # We are done 11117: $result.='<br />'.&mt('Successfully stored grades for [quant,_1,student].',$storecount). 11118: '</td>'. 11119: &Apache::loncommon::end_data_table_row(). 11120: &Apache::loncommon::end_data_table(); 11121: return $result; 11122: } 11123: 11124: sub navmap_errormsg { 11125: return '<div class="LC_error">'. 11126: &mt('An error occurred retrieving information about resources in the course.').'<br />'. 11127: &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>'). 11128: '</div>'; 11129: } 11130: 11131: sub startpage { 11132: my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$head_extra,$onload,$divforres) = @_; 11133: my %args; 11134: if ($onload) { 11135: my %loaditems = ( 11136: 'onload' => $onload, 11137: ); 11138: $args{'add_entries'} = \%loaditems; 11139: } 11140: if ($nomenu) { 11141: $args{'only_body'} = 1; 11142: $r->print(&Apache::loncommon::start_page("Student's Version",$head_extra,\%args)); 11143: } else { 11144: if ($env{'request.course.id'}) { 11145: unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"}); 11146: } 11147: $args{'bread_crumbs'} = $crumbs; 11148: $r->print(&Apache::loncommon::start_page('Grading',$head_extra,\%args)); 11149: } 11150: unless ($nodisplayflag) { 11151: $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag,$stuvcurrent,$stuvdisp,$divforres)); 11152: } 11153: } 11154: 11155: sub select_problem { 11156: my ($r)=@_; 11157: $r->print('<h3>'.&mt('Select the problem or one of the problems you want to grade').'</h3><form action="/adm/grades">'); 11158: $r->print(&Apache::lonstathelpers::problem_selector('.',undef,1,undef,undef,1)); 11159: $r->print('<input type="hidden" name="command" value="gradingmenu" />'); 11160: $r->print('<input type="submit" value="'.&mt('Next').' →" /></form>'); 11161: } 11162: 11163: #----- display problem, answer, and submissions for a single student (no grading) 11164: 11165: sub view_as_user { 11166: my ($symb,$vuname,$vudom,$hasperm) = @_; 11167: my $plainname = &Apache::loncommon::plainname($vuname,$vudom,'lastname'); 11168: my $displayname = &nameUserString('',$plainname,$vuname,$vudom); 11169: my $output = &Apache::loncommon::get_student_view($symb,$vuname,$vudom, 11170: $env{'request.course.id'}, 11171: undef,{'disable_submit' => 1}). 11172: "\n\n". 11173: '<div class="LC_grade_show_user">'. 11174: '<h2>'.$displayname.'</h2>'. 11175: "\n". 11176: &Apache::loncommon::track_student_link('View recent activity', 11177: $vuname,$vudom,'check').' '. 11178: "\n"; 11179: if (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) || 11180: (($env{'request.course.sec'} ne '') && 11181: &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.$env{'request.course.sec'}))) { 11182: $output .= &Apache::loncommon::pprmlink(&mt('Set/Change parameters'), 11183: $vuname,$vudom,$symb,'check'); 11184: } 11185: $output .= "\n"; 11186: my $companswer = &Apache::loncommon::get_student_answers($symb,$vuname,$vudom, 11187: $env{'request.course.id'}); 11188: $companswer=~s|<form(.*?)>||g; 11189: $companswer=~s|</form>||g; 11190: $companswer=~s|name="submit"|name="would_have_been_submit"|g; 11191: $output .= '<div class="LC_Box">'. 11192: '<h3 class="LC_hcell">'.&mt('Correct answer for[_1]',$displayname).'</h3>'. 11193: $companswer. 11194: '</div>'."\n"; 11195: my $is_tool = ($symb =~ /ext\.tool$/); 11196: my ($essayurl,%coursedesc_by_cid); 11197: (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); 11198: my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$vudom,$vuname); 11199: my $res_error; 11200: my ($partlist,$handgrade,$responseType,$numresp,$numessay) = 11201: &response_type($symb,\$res_error); 11202: my $fullname; 11203: my $collabinfo; 11204: if ($numessay) { 11205: unless ($hasperm) { 11206: &init_perm(); 11207: } 11208: ($collabinfo,$fullname)= 11209: &check_collaborators($symb,$vuname,$vudom,\%record,$handgrade,0); 11210: unless ($hasperm) { 11211: &reset_perm(); 11212: } 11213: } 11214: my $checkIcon = '<img alt="'.&mt('Check Mark'). 11215: '" src="'.$Apache::lonnet::perlvar{'lonIconsURL'}. 11216: '/check.gif" height="16" border="0" />'; 11217: my ($lastsubonly,$partinfo) = 11218: &show_last_submission($vuname,$vudom,$symb,$essayurl,$responseType,'datesub', 11219: '',$fullname,\%record,\%coursedesc_by_cid); 11220: $output .= '<div class="LC_Box">'. 11221: '<h3 class="LC_hcell">'.&mt('Submissions').'</h3>'."\n".$collabinfo."\n"; 11222: if (($numresp > $numessay) & !$is_tool) { 11223: $output .='<p class="LC_info">'. 11224: &mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon). 11225: "</p>\n"; 11226: } 11227: $output .= $partinfo; 11228: $output .= $lastsubonly; 11229: $output .= &displaySubByDates($symb,\%record,$partlist,$responseType,$checkIcon,$vuname,$vudom); 11230: $output .= '</div></div>'."\n"; 11231: return $output; 11232: } 11233: 11234: sub handler { 11235: my $request=$_[0]; 11236: &reset_caches(); 11237: if ($request->header_only) { 11238: &Apache::loncommon::content_type($request,'text/html'); 11239: $request->send_http_header; 11240: return OK; 11241: } 11242: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); 11243: 11244: # see what command we need to execute 11245: 11246: my @commands=&Apache::loncommon::get_env_multiple('form.command'); 11247: my $command=$commands[0]; 11248: 11249: &init_perm(); 11250: if (!$env{'request.course.id'}) { 11251: unless ((&Apache::lonnet::allowed('usc',$env{'request.role.domain'})) && 11252: ($command =~ /^scantronupload/)) { 11253: # Not in a course. 11254: $env{'user.error.msg'}="/adm/grades::vgr:0:0:Cannot display grades page outside course context"; 11255: return HTTP_NOT_ACCEPTABLE; 11256: } 11257: } elsif (!%perm) { 11258: $request->internal_redirect('/adm/quickgrades'); 11259: return OK; 11260: } 11261: &Apache::loncommon::content_type($request,'text/html'); 11262: $request->send_http_header; 11263: 11264: if ($#commands > 0) { 11265: &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); 11266: } 11267: 11268: # see what the symb is 11269: 11270: my $symb=$env{'form.symb'}; 11271: unless ($symb) { 11272: (my $url=$env{'form.url'}) =~ s-^https*://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; 11273: $symb=&Apache::lonnet::symbread($url); 11274: } 11275: &Apache::lonenc::check_decrypt(\$symb); 11276: 11277: $ssi_error = 0; 11278: if (($symb eq '' || $command eq '') && ($env{'request.course.id'})) { 11279: # 11280: # Not called from a resource, but inside a course 11281: # 11282: &startpage($request,undef,[],1,1); 11283: &select_problem($request); 11284: } else { 11285: if ($command eq 'submission' && $perm{'vgr'}) { 11286: my ($stuvcurrent,$stuvdisp,$versionform,$js,$onload); 11287: if (($env{'form.student'} ne '') && ($env{'form.userdom'} ne '')) { 11288: ($stuvcurrent,$stuvdisp,$versionform,$js) = 11289: &choose_task_version_form($symb,$env{'form.student'}, 11290: $env{'form.userdom'}); 11291: } 11292: my $divforres; 11293: if ($env{'form.student'} eq '') { 11294: $js .= &part_selector_js(); 11295: $onload = "toggleParts('gradesub');"; 11296: } else { 11297: $divforres = 1; 11298: } 11299: my $head_extra = $js; 11300: unless ($env{'form.vProb'} eq 'no') { 11301: my $csslinks = &Apache::loncommon::css_links($symb); 11302: if ($csslinks) { 11303: $head_extra .= "\n$csslinks"; 11304: } 11305: } 11306: &startpage($request,$symb,[{href=>"", text=>"Student Submissions"}],undef,undef, 11307: $stuvcurrent,$stuvdisp,undef,$head_extra,$onload,$divforres); 11308: if ($versionform) { 11309: if ($divforres) { 11310: $request->print('<div style="padding:0;clear:both;margin:0;border:0"></div>'); 11311: } 11312: $request->print($versionform); 11313: } 11314: ($env{'form.student'} eq '' ? &listStudents($request,$symb,'',$divforres) : &submission($request,0,0,$symb,$divforres,$command)); 11315: } elsif ($command eq 'versionsub' && $perm{'vgr'}) { 11316: my ($stuvcurrent,$stuvdisp,$versionform,$js) = 11317: &choose_task_version_form($symb,$env{'form.student'}, 11318: $env{'form.userdom'}, 11319: $env{'form.inhibitmenu'}); 11320: my $head_extra = $js; 11321: unless ($env{'form.vProb'} eq 'no') { 11322: my $csslinks = &Apache::loncommon::css_links($symb); 11323: if ($csslinks) { 11324: $head_extra .= "\n$csslinks"; 11325: } 11326: } 11327: &startpage($request,$symb,[{href=>"", text=>"Previous Student Version"}],undef,undef, 11328: $stuvcurrent,$stuvdisp,$env{'form.inhibitmenu'},$head_extra); 11329: if ($versionform) { 11330: $request->print($versionform); 11331: } 11332: $request->print('<br clear="all" />'); 11333: $request->print(&show_previous_task_version($request,$symb)); 11334: } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { 11335: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 11336: {href=>'',text=>'Select student'}],1,1); 11337: &pickStudentPage($request,$symb); 11338: } elsif ($command eq 'displayPage' && $perm{'vgr'}) { 11339: my $csslinks; 11340: unless ($env{'form.vProb'} eq 'no') { 11341: $csslinks = &Apache::loncommon::css_links($symb,'map'); 11342: } 11343: &startpage($request,$symb, 11344: [{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 11345: {href=>'',text=>'Select student'}, 11346: {href=>'',text=>'Grade student'}],1,1,undef,undef,undef,$csslinks); 11347: &displayPage($request,$symb); 11348: } elsif ($command eq 'gradeByPage' && $perm{'mgr'}) { 11349: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, 11350: {href=>'',text=>'Select student'}, 11351: {href=>'',text=>'Grade student'}, 11352: {href=>'',text=>'Store grades'}],1,1); 11353: &updateGradeByPage($request,$symb); 11354: } elsif ($command eq 'processGroup' && $perm{'vgr'}) { 11355: my $csslinks; 11356: unless ($env{'form.vProb'} eq 'no') { 11357: $csslinks = &Apache::loncommon::css_links($symb); 11358: } 11359: &startpage($request,$symb,[{href=>'',text=>'...'}, 11360: {href=>'',text=>'Modify grades'}],undef,undef,undef,undef,undef,$csslinks,undef,1); 11361: &processGroup($request,$symb); 11362: } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) { 11363: &startpage($request,$symb); 11364: $request->print(&grading_menu($request,$symb)); 11365: } elsif ($command eq 'individual' && $perm{'vgr'}) { 11366: &startpage($request,$symb,[{href=>'',text=>'Select individual students to grade'}]); 11367: $request->print(&submit_options($request,$symb)); 11368: } elsif ($command eq 'ungraded' && $perm{'vgr'}) { 11369: my $js = &part_selector_js(); 11370: my $onload = "toggleParts('gradesub');"; 11371: &startpage($request,$symb,[{href=>'',text=>'Grade ungraded submissions'}], 11372: undef,undef,undef,undef,undef,$js,$onload); 11373: $request->print(&listStudents($request,$symb,'graded')); 11374: } elsif ($command eq 'table' && $perm{'vgr'}) { 11375: &startpage($request,$symb,[{href=>"", text=>"Grading table"}]); 11376: $request->print(&submit_options_table($request,$symb)); 11377: } elsif ($command eq 'all_for_one' && $perm{'vgr'}) { 11378: &startpage($request,$symb,[{href=>'',text=>'Grade page/folder for one student'}],1,1); 11379: $request->print(&submit_options_sequence($request,$symb)); 11380: } elsif ($command eq 'viewgrades' && $perm{'vgr'}) { 11381: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"table"), text=>"Grading table"},{href=>'', text=>"Modify grades"}]); 11382: $request->print(&viewgrades($request,$symb)); 11383: } elsif ($command eq 'handgrade' && $perm{'mgr'}) { 11384: &startpage($request,$symb,[{href=>'',text=>'...'}, 11385: {href=>'',text=>'Store grades'}]); 11386: $request->print(&processHandGrade($request,$symb)); 11387: } elsif ($command eq 'editgrades' && $perm{'mgr'}) { 11388: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"table"), text=>"Grading table"}, 11389: {href=>&href_symb_cmd($symb,'viewgrades').'&group=all&section=all&Status=Active', 11390: text=>"Modify grades"}, 11391: {href=>'', text=>"Store grades"}]); 11392: $request->print(&editgrades($request,$symb)); 11393: } elsif ($command eq 'initialverifyreceipt' && $perm{'vgr'}) { 11394: &startpage($request,$symb,[{href=>'',text=>'Verify Receipt Number'}]); 11395: $request->print(&initialverifyreceipt($request,$symb)); 11396: } elsif ($command eq 'verify' && $perm{'vgr'}) { 11397: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,"initialverifyreceipt"),text=>'Verify Receipt Number'}, 11398: {href=>'',text=>'Verification Result'}]); 11399: $request->print(&verifyreceipt($request,$symb)); 11400: } elsif ($command eq 'processclicker' && $perm{'mgr'}) { 11401: &startpage($request,$symb,[{href=>'', text=>'Process clicker'}]); 11402: $request->print(&process_clicker($request,$symb)); 11403: } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { 11404: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'processclicker'), text=>'Process clicker'}, 11405: {href=>'', text=>'Process clicker file'}]); 11406: $request->print(&process_clicker_file($request,$symb)); 11407: } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) { 11408: &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'processclicker'), text=>'Process clicker'}, 11409: {href=>'', text=>'Process clicker file'}, 11410: {href=>'', text=>'Store grades'}]); 11411: $request->print(&assign_clicker_grades($request,$symb)); 11412: } elsif ($command eq 'csvform' && $perm{'mgr'}) { 11413: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 11414: $request->print(&upcsvScores_form($request,$symb)); 11415: } elsif ($command eq 'csvupload' && $perm{'mgr'}) { 11416: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 11417: $request->print(&csvupload($request,$symb)); 11418: } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) { 11419: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 11420: $request->print(&csvuploadmap($request,$symb)); 11421: } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) { 11422: if ($env{'form.associate'} ne 'Reverse Association') { 11423: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 11424: $request->print(&csvuploadoptions($request,$symb)); 11425: } else { 11426: if ( $env{'form.upfile_associate'} ne 'reverse' ) { 11427: $env{'form.upfile_associate'} = 'reverse'; 11428: } else { 11429: $env{'form.upfile_associate'} = 'forward'; 11430: } 11431: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 11432: $request->print(&csvuploadmap($request,$symb)); 11433: } 11434: } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) { 11435: &startpage($request,$symb,[{href=>'', text=>'Upload Scores'}],1,1); 11436: $request->print(&csvuploadassign($request,$symb)); 11437: } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { 11438: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1, 11439: undef,undef,undef,undef,'toggleScantab(document.rules);'); 11440: $request->print(&scantron_selectphase($request,undef,$symb)); 11441: } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) { 11442: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 11443: $request->print(&scantron_do_warning($request,$symb)); 11444: } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { 11445: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 11446: $request->print(&scantron_validate_file($request,$symb)); 11447: } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { 11448: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 11449: $request->print(&scantron_process_students($request,$symb)); 11450: } elsif ($command eq 'scantronupload' && 11451: (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| 11452: &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { 11453: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1, 11454: undef,undef,undef,undef,'toggleScantab(document.rules);'); 11455: $request->print(&scantron_upload_scantron_data($request,$symb)); 11456: } elsif ($command eq 'scantronupload_save' && 11457: (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})|| 11458: &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) { 11459: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 11460: $request->print(&scantron_upload_scantron_data_save($request,$symb)); 11461: } elsif ($command eq 'scantron_download' && 11462: &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { 11463: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 11464: $request->print(&scantron_download_scantron_data($request,$symb)); 11465: } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) { 11466: &startpage($request,$symb,[{href=>'', text=>'Grade/Manage/Review Bubblesheets'}],1,1); 11467: $request->print(&checkscantron_results($request,$symb)); 11468: } elsif ($command eq 'downloadfilesselect' && $perm{'vgr'}) { 11469: my $js = &part_selector_js(); 11470: my $onload = "toggleParts('gradingMenu');"; 11471: &startpage($request,$symb,[{href=>'', text=>'Select which submissions to download'}], 11472: undef,undef,undef,undef,undef,$js,$onload); 11473: $request->print(&submit_options_download($request,$symb)); 11474: } elsif ($command eq 'downloadfileslink' && $perm{'vgr'}) { 11475: &startpage($request,$symb, 11476: [{href=>&href_symb_cmd($symb,'downloadfilesselect'), text=>'Select which submissions to download'}, 11477: {href=>'', text=>'Download submitted files'}], 11478: undef,undef,undef,undef,undef,undef,undef,1); 11479: $request->print('<div style="padding:0;clear:both;margin:0;border:0"></div>'); 11480: &submit_download_link($request,$symb); 11481: } elsif ($command) { 11482: &startpage($request,$symb,[{href=>'', text=>'Access denied'}]); 11483: $request->print('<p class="LC_error">'.&mt('Access Denied ([_1])',$command).'</p>'); 11484: } 11485: } 11486: if ($ssi_error) { 11487: &ssi_print_error($request); 11488: } 11489: $request->print(&Apache::loncommon::end_page()); 11490: &reset_caches(); 11491: return OK; 11492: } 11493: 11494: 1; 11495: 11496: __END__; 11497: 11498: 11499: =head1 NAME 11500: 11501: Apache::grades 11502: 11503: =head1 SYNOPSIS 11504: 11505: Handles the viewing of grades. 11506: 11507: This is part of the LearningOnline Network with CAPA project 11508: described at http://www.lon-capa.org. 11509: 11510: =head1 OVERVIEW 11511: 11512: Do an ssi with retries: 11513: While I'd love to factor out this with the vesrion in lonprintout, 11514: 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 11515: I'm not quite ready to invent (e.g. an ssi_with_retry object). 11516: 11517: At least the logic that drives this has been pulled out into loncommon. 11518: 11519: 11520: 11521: ssi_with_retries - Does the server side include of a resource. 11522: if the ssi call returns an error we'll retry it up to 11523: the number of times requested by the caller. 11524: If we still have a problem, no text is appended to the 11525: output and we set some global variables. 11526: to indicate to the caller an SSI error occurred. 11527: All of this is supposed to deal with the issues described 11528: in LON-CAPA BZ 5631 see: 11529: http://bugs.lon-capa.org/show_bug.cgi?id=5631 11530: by informing the user that this happened. 11531: 11532: Parameters: 11533: resource - The resource to include. This is passed directly, without 11534: interpretation to lonnet::ssi. 11535: form - The form hash parameters that guide the interpretation of the resource 11536: 11537: retries - Number of retries allowed before giving up completely. 11538: Returns: 11539: On success, returns the rendered resource identified by the resource parameter. 11540: Side Effects: 11541: The following global variables can be set: 11542: ssi_error - If an unrecoverable error occurred this becomes true. 11543: It is up to the caller to initialize this to false 11544: if desired. 11545: ssi_error_resource - If an unrecoverable error occurred, this is the value 11546: of the resource that could not be rendered by the ssi 11547: call. 11548: ssi_error_message - The error string fetched from the ssi response 11549: in the event of an error. 11550: 11551: 11552: =head1 HANDLER SUBROUTINE 11553: 11554: ssi_with_retries() 11555: 11556: =head1 SUBROUTINES 11557: 11558: =over 11559: 11560: =item scantron_get_correction() : 11561: 11562: Builds the interface screen to interact with the operator to fix a 11563: specific error condition in a specific scanline 11564: 11565: Arguments: 11566: $r - Apache request object 11567: $i - number of the current scanline 11568: $scan_record - hash ref as returned from &scantron_parse_scanline() 11569: $scan_config - hash ref as returned from &Apache::lonnet::get_scantron_config() 11570: $line - full contents of the current scanline 11571: $error - error condition, valid values are 11572: 'incorrectCODE', 'duplicateCODE', 11573: 'doublebubble', 'missingbubble', 11574: 'duplicateID', 'incorrectID' 11575: $arg - extra information needed 11576: For errors: 11577: - duplicateID - paper number that this studentID was seen before on 11578: - duplicateCODE - array ref of the paper numbers this CODE was 11579: seen on before 11580: - incorrectCODE - current incorrect CODE 11581: - doublebubble - array ref of the bubble lines that have double 11582: bubble errors 11583: - missingbubble - array ref of the bubble lines that have missing 11584: bubble errors 11585: 11586: $randomorder - True if exam folder (or a sub-folder) has randomorder set 11587: $randompick - True if exam folder (or a sub-folder) has randompick set 11588: $respnumlookup - Reference to HASH mapping question numbers in bubble lines 11589: for current line to question number used for same question 11590: in "Master Seqence" (as seen by Course Coordinator). 11591: $startline - Reference to hash where key is question number (0 is first) 11592: and value is number of first bubble line for current student 11593: or code-based randompick and/or randomorder. 11594: 11595: 11596: =item scantron_get_maxbubble() : 11597: 11598: Arguments: 11599: $nav_error - Reference to scalar which is a flag to indicate a 11600: failure to retrieve a navmap object. 11601: if $nav_error is set to 1 by scantron_get_maxbubble(), the 11602: calling routine should trap the error condition and display the warning 11603: found in &navmap_errormsg(). 11604: 11605: $scantron_config - Reference to bubblesheet format configuration hash. 11606: 11607: Returns the maximum number of bubble lines that are expected to 11608: occur. Does this by walking the selected sequence rendering the 11609: resource and then checking &Apache::lonxml::get_problem_counter() 11610: for what the current value of the problem counter is. 11611: 11612: Caches the results to $env{'form.scantron_maxbubble'}, 11613: $env{'form.scantron.bubble_lines.n'}, 11614: $env{'form.scantron.first_bubble_line.n'} and 11615: $env{"form.scantron.sub_bubblelines.n"} 11616: which are the total number of bubble lines, the number of bubble 11617: lines for response n and number of the first bubble line for response n, 11618: and a comma separated list of numbers of bubble lines for sub-questions 11619: (for optionresponse, matchresponse, and rankresponse items), for response n. 11620: 11621: 11622: =item scantron_validate_missingbubbles() : 11623: 11624: Validates all scanlines in the selected file to not have any 11625: answers that don't have bubbles that have not been verified 11626: to be bubble free. 11627: 11628: =item scantron_process_students() : 11629: 11630: Routine that does the actual grading of the bubblesheet information. 11631: 11632: The parsed scanline hash is added to %env 11633: 11634: Then foreach unskipped scanline it does an &Apache::lonnet::ssi() 11635: foreach resource , with the form data of 11636: 11637: 'submitted' =>'scantron' 11638: 'grade_target' =>'grade', 11639: 'grade_username'=> username of student 11640: 'grade_domain' => domain of student 11641: 'grade_courseid'=> of course 11642: 'grade_symb' => symb of resource to grade 11643: 11644: This triggers a grading pass. The problem grading code takes care 11645: of converting the bubbled letter information (now in %env) into a 11646: valid submission. 11647: 11648: =item scantron_upload_scantron_data() : 11649: 11650: Creates the screen for adding a new bubblesheet data file to a course. 11651: 11652: =item scantron_upload_scantron_data_save() : 11653: 11654: Adds a provided bubble information data file to the course if user 11655: has the correct privileges to do so. 11656: 11657: =item valid_file() : 11658: 11659: Validates that the requested bubble data file exists in the course. 11660: 11661: =item scantron_download_scantron_data() : 11662: 11663: Shows a list of the three internal files (original, corrected, 11664: skipped) for a specific bubblesheet data file that exists in the 11665: course. 11666: 11667: =item scantron_validate_ID() : 11668: 11669: Validates all scanlines in the selected file to not have any 11670: invalid or underspecified student/employee IDs 11671: 11672: =item navmap_errormsg() : 11673: 11674: Returns HTML mark-up inside a <div></div> with a link to re-initialize the course. 11675: Should be called whenever the request to instantiate a navmap object fails. 11676: 11677: =back 11678: 11679: =cut