Annotation of loncom/homework/grades.pm, revision 1.533

1.17      albertel    1: # The LearningOnline Network with CAPA
1.13      albertel    2: # The LON-CAPA Grading handler
1.17      albertel    3: #
1.533   ! bisitz      4: # $Id: grades.pm,v 1.532 2008/12/05 10:23:50 bisitz Exp $
1.17      albertel    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: #
1.1       albertel   28: 
1.529     jms        29: 
                     30: 
1.1       albertel   31: package Apache::grades;
                     32: use strict;
                     33: use Apache::style;
                     34: use Apache::lonxml;
                     35: use Apache::lonnet;
1.3       albertel   36: use Apache::loncommon;
1.112     ng         37: use Apache::lonhtmlcommon;
1.68      ng         38: use Apache::lonnavmaps;
1.1       albertel   39: use Apache::lonhomework;
1.456     banghart   40: use Apache::lonpickcode;
1.55      matthew    41: use Apache::loncoursedata;
1.362     albertel   42: use Apache::lonmsg();
1.1       albertel   43: use Apache::Constants qw(:common);
1.167     sakharuk   44: use Apache::lonlocal;
1.386     raeburn    45: use Apache::lonenc;
1.170     albertel   46: use String::Similarity;
1.359     www        47: use LONCAPA;
                     48: 
1.315     bowersj2   49: use POSIX qw(floor);
1.87      www        50: 
1.435     foxr       51: 
1.513     foxr       52: 
1.435     foxr       53: my %perm=();
1.447     foxr       54: 
1.513     foxr       55: #  These variables are used to recover from ssi errors
                     56: 
                     57: my $ssi_retries = 5;
                     58: my $ssi_error;
                     59: my $ssi_error_resource;
                     60: my $ssi_error_message;
                     61: 
                     62: 
                     63: sub ssi_with_retries {
                     64:     my ($resource, $retries, %form) = @_;
                     65:     my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form);
                     66:     if ($response->is_error) {
                     67: 	$ssi_error          = 1;
                     68: 	$ssi_error_resource = $resource;
                     69: 	$ssi_error_message  = $response->code . " " . $response->message;
                     70:     }
                     71: 
                     72:     return $content;
                     73: 
                     74: }
                     75: #
                     76: #  Prodcuces an ssi retry failure error message to the user:
                     77: #
                     78: 
                     79: sub ssi_print_error {
                     80:     my ($r) = @_;
1.516     raeburn    81:     my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk');
                     82:     $r->print('
                     83: <br />
                     84: <h2>'.&mt('An unrecoverable network error occurred:').'</h2>
                     85: <p>
                     86: '.&mt('Unable to retrieve a resource from a server:').'<br />
                     87: '.&mt('Resource:').' '.$ssi_error_resource.'<br />
                     88: '.&mt('Error:').' '.$ssi_error_message.'
                     89: </p>
                     90: <p>'.
                     91: &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 />'.
                     92: &mt('If the error persists, please contact the [_1] for assistance.',$helpurl).
                     93: '</p>');
                     94:     return;
1.513     foxr       95: }
                     96: 
1.44      ng         97: #
1.146     albertel   98: # --- Retrieve the parts from the metadata file.---
1.44      ng         99: sub getpartlist {
1.324     albertel  100:     my ($symb) = @_;
1.439     albertel  101: 
                    102:     my $navmap   = Apache::lonnavmaps::navmap->new();
                    103:     my $res      = $navmap->getBySymb($symb);
                    104:     my $partlist = $res->parts();
                    105:     my $url      = $res->src();
                    106:     my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys'));
                    107: 
1.146     albertel  108:     my @stores;
1.439     albertel  109:     foreach my $part (@{ $partlist }) {
1.146     albertel  110: 	foreach my $key (@metakeys) {
                    111: 	    if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
                    112: 	}
                    113:     }
                    114:     return @stores;
1.2       albertel  115: }
                    116: 
1.44      ng        117: # --- Get the symbolic name of a problem and the url
1.324     albertel  118: sub get_symb {
1.173     albertel  119:     my ($request,$silent) = @_;
1.257     albertel  120:     (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                    121:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
1.173     albertel  122:     if ($symb eq '') { 
                    123: 	if (!$silent) {
                    124: 	    $request->print("Unable to handle ambiguous references:$url:.");
                    125: 	    return ();
                    126: 	}
                    127:     }
1.418     albertel  128:     &Apache::lonenc::check_decrypt(\$symb);
1.324     albertel  129:     return ($symb);
1.32      ng        130: }
                    131: 
1.129     ng        132: #--- Format fullname, username:domain if different for display
                    133: #--- Use anywhere where the student names are listed
                    134: sub nameUserString {
                    135:     my ($type,$fullname,$uname,$udom) = @_;
                    136:     if ($type eq 'header') {
1.485     albertel  137: 	return '<b>&nbsp;'.&mt('Fullname').'&nbsp;</b><span class="LC_internal_info">('.&mt('Username').')</span>';
1.129     ng        138:     } else {
1.398     albertel  139: 	return '&nbsp;'.$fullname.'<span class="LC_internal_info">&nbsp;('.$uname.
                    140: 	    ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')</span>';
1.129     ng        141:     }
                    142: }
                    143: 
1.44      ng        144: #--- Get the partlist and the response type for a given problem. ---
                    145: #--- Indicate if a response type is coded handgraded or not. ---
1.39      ng        146: sub response_type {
1.324     albertel  147:     my ($symb) = shift;
1.377     albertel  148: 
                    149:     my $navmap = Apache::lonnavmaps::navmap->new();
                    150:     my $res = $navmap->getBySymb($symb);
                    151:     my $partlist = $res->parts();
1.392     albertel  152:     my %vPart = 
                    153: 	map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart'));
1.377     albertel  154:     my (%response_types,%handgrade);
                    155:     foreach my $part (@{ $partlist }) {
1.392     albertel  156: 	next if (%vPart && !exists($vPart{$part}));
                    157: 
1.377     albertel  158: 	my @types = $res->responseType($part);
                    159: 	my @ids = $res->responseIds($part);
                    160: 	for (my $i=0; $i < scalar(@ids); $i++) {
                    161: 	    $response_types{$part}{$ids[$i]} = $types[$i];
                    162: 	    $handgrade{$part.'_'.$ids[$i]} = 
                    163: 		&Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i].
                    164: 				     '.handgrade',$symb);
1.41      ng        165: 	}
                    166:     }
1.377     albertel  167:     return ($partlist,\%handgrade,\%response_types);
1.39      ng        168: }
                    169: 
1.375     albertel  170: sub flatten_responseType {
                    171:     my ($responseType) = @_;
                    172:     my @part_response_id =
                    173: 	map { 
                    174: 	    my $part = $_;
                    175: 	    map {
                    176: 		[$part,$_]
                    177: 		} sort(keys(%{ $responseType->{$part} }));
                    178: 	} sort(keys(%$responseType));
                    179:     return @part_response_id;
                    180: }
                    181: 
1.207     albertel  182: sub get_display_part {
1.324     albertel  183:     my ($partID,$symb)=@_;
1.207     albertel  184:     my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb);
                    185:     if (defined($display) and $display ne '') {
1.398     albertel  186: 	$display.= " (<span class=\"LC_internal_info\">id $partID</span>)";
1.207     albertel  187:     } else {
                    188: 	$display=$partID;
                    189:     }
                    190:     return $display;
                    191: }
1.269     raeburn   192: 
1.118     ng        193: #--- Show resource title
                    194: #--- and parts and response type
                    195: sub showResourceInfo {
1.324     albertel  196:     my ($symb,$probTitle,$checkboxes) = @_;
1.154     albertel  197:     my $col=3;
                    198:     if ($checkboxes) { $col=4; }
1.398     albertel  199:     my $result = '<h3>'.&mt('Current Resource').': '.$probTitle.'</h3>'."\n";
                    200:     $result .='<table border="0">';
1.324     albertel  201:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.126     ng        202:     my %resptype = ();
1.122     ng        203:     my $hdgrade='no';
1.154     albertel  204:     my %partsseen;
1.524     raeburn   205:     foreach my $partID (sort(keys(%$responseType))) {
                    206: 	foreach my $resID (sort(keys(%{ $responseType->{$partID} }))) {
1.375     albertel  207: 	    my $handgrade=$$handgrade{$partID.'_'.$resID};
                    208: 	    my $responsetype = $responseType->{$partID}->{$resID};
                    209: 	    $hdgrade = $handgrade if ($handgrade eq 'yes');
                    210: 	    $result.='<tr>';
                    211: 	    if ($checkboxes) {
                    212: 		if (exists($partsseen{$partID})) {
                    213: 		    $result.="<td>&nbsp;</td>";
                    214: 		} else {
1.401     albertel  215: 		    $result.="<td><input type='checkbox' name='vPart' value='$partID' checked='checked' /></td>";
1.375     albertel  216: 		}
                    217: 		$partsseen{$partID}=1;
1.154     albertel  218: 	    }
1.375     albertel  219: 	    my $display_part=&get_display_part($partID,$symb);
1.485     albertel  220: 	    $result.='<td>'.&mt('<b>Part: </b>[_1]',$display_part).' <span class="LC_internal_info">'.
1.398     albertel  221: 		$resID.'</span></td>'.
1.485     albertel  222: 		'<td>'.&mt('<b>Type: </b>[_1]',$responsetype).'</td></tr>';
                    223: #	    '<td>'.&mt('<b>Handgrade: </b>[_1]',$handgrade).'</td></tr>';
1.154     albertel  224: 	}
1.118     ng        225:     }
                    226:     $result.='</table>'."\n";
1.147     albertel  227:     return $result,$responseType,$hdgrade,$partlist,$handgrade;
1.118     ng        228: }
                    229: 
1.434     albertel  230: sub reset_caches {
                    231:     &reset_analyze_cache();
                    232:     &reset_perm();
                    233: }
                    234: 
                    235: {
                    236:     my %analyze_cache;
1.148     albertel  237: 
1.434     albertel  238:     sub reset_analyze_cache {
                    239: 	undef(%analyze_cache);
                    240:     }
                    241: 
                    242:     sub get_analyze {
1.525     raeburn   243: 	my ($symb,$uname,$udom,$no_increment)=@_;
1.434     albertel  244: 	my $key = "$symb\0$uname\0$udom";
                    245: 	return $analyze_cache{$key} if (exists($analyze_cache{$key}));
                    246: 
                    247: 	my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
                    248: 	$url=&Apache::lonnet::clutter($url);
1.513     foxr      249: 	my $subresult=&ssi_with_retries($url, $ssi_retries,
1.516     raeburn   250: 					   ('grade_target' => 'analyze',
                    251: 					    'grade_domain' => $udom,
                    252: 					    'grade_symb' => $symb,
                    253: 					    'grade_courseid' => 
                    254: 					    $env{'request.course.id'},
1.525     raeburn   255: 					    'grade_username' => $uname,
                    256:                                             'grade_noincrement' => $no_increment));
1.434     albertel  257: 	(undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
                    258: 	my %analyze=&Apache::lonnet::str2hash($subresult);
                    259: 	return $analyze_cache{$key} = \%analyze;
                    260:     }
                    261: 
                    262:     sub get_order {
1.525     raeburn   263: 	my ($partid,$respid,$symb,$uname,$udom,$no_increment)=@_;
                    264: 	my $analyze = &get_analyze($symb,$uname,$udom,$no_increment);
1.434     albertel  265: 	return $analyze->{"$partid.$respid.shown"};
                    266:     }
                    267: 
                    268:     sub get_radiobutton_correct_foil {
                    269: 	my ($partid,$respid,$symb,$uname,$udom)=@_;
                    270: 	my $analyze = &get_analyze($symb,$uname,$udom);
                    271: 	foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) {
                    272: 	    if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
                    273: 		return $foil;
                    274: 	    }
                    275: 	}
                    276:     }
1.148     albertel  277: }
1.434     albertel  278: 
1.118     ng        279: #--- Clean response type for display
1.335     albertel  280: #--- Currently filters option/rank/radiobutton/match/essay/Task
                    281: #        response types only.
1.118     ng        282: sub cleanRecord {
1.336     albertel  283:     my ($answer,$response,$symb,$partid,$respid,$record,$order,$version,
                    284: 	$uname,$udom) = @_;
1.398     albertel  285:     my $grayFont = '<span class="LC_internal_info">';
1.148     albertel  286:     if ($response =~ /^(option|rank)$/) {
                    287: 	my %answer=&Apache::lonnet::str2hash($answer);
                    288: 	my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
                    289: 	my ($toprow,$bottomrow);
                    290: 	foreach my $foil (@$order) {
                    291: 	    if ($grading{$foil} == 1) {
                    292: 		$toprow.='<td><b>'.$answer{$foil}.'&nbsp;</b></td>';
                    293: 	    } else {
                    294: 		$toprow.='<td><i>'.$answer{$foil}.'&nbsp;</i></td>';
                    295: 	    }
1.398     albertel  296: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.148     albertel  297: 	}
                    298: 	return '<blockquote><table border="1">'.
1.466     albertel  299: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    300: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.148     albertel  301: 	    $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
                    302:     } elsif ($response eq 'match') {
                    303: 	my %answer=&Apache::lonnet::str2hash($answer);
                    304: 	my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
                    305: 	my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"});
                    306: 	my ($toprow,$middlerow,$bottomrow);
                    307: 	foreach my $foil (@$order) {
                    308: 	    my $item=shift(@items);
                    309: 	    if ($grading{$foil} == 1) {
                    310: 		$toprow.='<td><b>'.$item.'&nbsp;</b></td>';
1.398     albertel  311: 		$middlerow.='<td><b>'.$grayFont.$answer{$foil}.'&nbsp;</span></b></td>';
1.148     albertel  312: 	    } else {
                    313: 		$toprow.='<td><i>'.$item.'&nbsp;</i></td>';
1.398     albertel  314: 		$middlerow.='<td><i>'.$grayFont.$answer{$foil}.'&nbsp;</span></i></td>';
1.148     albertel  315: 	    }
1.398     albertel  316: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.118     ng        317: 	}
1.126     ng        318: 	return '<blockquote><table border="1">'.
1.466     albertel  319: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    320: 	    '<tr valign="top"><td>'.$grayFont.&mt('Item ID').'</span></td>'.
1.148     albertel  321: 	    $middlerow.'</tr>'.
1.466     albertel  322: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.148     albertel  323: 	    $bottomrow.'</tr>'.'</table></blockquote>';
                    324:     } elsif ($response eq 'radiobutton') {
                    325: 	my %answer=&Apache::lonnet::str2hash($answer);
                    326: 	my ($toprow,$bottomrow);
1.434     albertel  327: 	my $correct = 
                    328: 	    &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom);
                    329: 	foreach my $foil (@$order) {
1.148     albertel  330: 	    if (exists($answer{$foil})) {
1.434     albertel  331: 		if ($foil eq $correct) {
1.466     albertel  332: 		    $toprow.='<td><b>'.&mt('true').'</b></td>';
1.148     albertel  333: 		} else {
1.466     albertel  334: 		    $toprow.='<td><i>'.&mt('true').'</i></td>';
1.148     albertel  335: 		}
                    336: 	    } else {
1.466     albertel  337: 		$toprow.='<td>'.&mt('false').'</td>';
1.148     albertel  338: 	    }
1.398     albertel  339: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.148     albertel  340: 	}
                    341: 	return '<blockquote><table border="1">'.
1.466     albertel  342: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    343: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.148     albertel  344: 	    $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
                    345:     } elsif ($response eq 'essay') {
1.257     albertel  346: 	if (! exists ($env{'form.'.$symb})) {
1.122     ng        347: 	    my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',
1.257     albertel  348: 						  $env{'course.'.$env{'request.course.id'}.'.domain'},
                    349: 						  $env{'course.'.$env{'request.course.id'}.'.num'});
1.122     ng        350: 
1.257     albertel  351: 	    my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
                    352: 	    $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : '';
                    353: 	    $env{'form.kwclr'}    = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red';
                    354: 	    $env{'form.kwsize'}   = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0';
                    355: 	    $env{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
                    356: 	    $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob.
1.122     ng        357: 	}
1.166     albertel  358: 	$answer =~ s-\n-<br />-g;
                    359: 	return '<br /><br /><blockquote><tt>'.&keywords_highlight($answer).'</tt></blockquote>';
1.268     albertel  360:     } elsif ( $response eq 'organic') {
                    361: 	my $result='Smile representation: "<tt>'.$answer.'</tt>"';
                    362: 	my $jme=$record->{$version."resource.$partid.$respid.molecule"};
                    363: 	$result.=&Apache::chemresponse::jme_img($jme,$answer,400);
                    364: 	return $result;
1.335     albertel  365:     } elsif ( $response eq 'Task') {
                    366: 	if ( $answer eq 'SUBMITTED') {
                    367: 	    my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"};
1.336     albertel  368: 	    my $result = &Apache::bridgetask::file_list($files,$uname,$udom);
1.335     albertel  369: 	    return $result;
                    370: 	} elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) {
                    371: 	    my @matches = grep(/^\Q$version\E.*?\.instance$/,
                    372: 			       keys(%{$record}));
                    373: 	    return join('<br />',($version,@matches));
                    374: 			       
                    375: 			       
                    376: 	} else {
                    377: 	    my $result =
                    378: 		'<p>'
                    379: 		.&mt('Overall result: [_1]',
                    380: 		     $record->{$version."resource.$respid.$partid.status"})
                    381: 		.'</p>';
                    382: 	    
                    383: 	    $result .= '<ul>';
                    384: 	    my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/,
                    385: 			     keys(%{$record}));
                    386: 	    foreach my $grade (sort(@grade)) {
                    387: 		my ($dim) = ($grade =~/[.]([^.]+)[.]status$/);
                    388: 		$result.= '<li>'.&mt("Dimension: [_1], status [_2] ",
                    389: 				     $dim, $record->{$grade}).
                    390: 			  '</li>';
                    391: 	    }
                    392: 	    $result.='</ul>';
                    393: 	    return $result;
                    394: 	}
1.440     albertel  395:     } elsif ( $response =~ m/(?:numerical|formula)/) {
                    396: 	$answer = 
                    397: 	    &Apache::loncommon::format_previous_attempt_value('submission',
                    398: 							      $answer);
1.122     ng        399:     }
1.118     ng        400:     return $answer;
                    401: }
                    402: 
                    403: #-- A couple of common js functions
                    404: sub commonJSfunctions {
                    405:     my $request = shift;
                    406:     $request->print(<<COMMONJSFUNCTIONS);
                    407: <script type="text/javascript" language="javascript">
                    408:     function radioSelection(radioButton) {
                    409: 	var selection=null;
                    410: 	if (radioButton.length > 1) {
                    411: 	    for (var i=0; i<radioButton.length; i++) {
                    412: 		if (radioButton[i].checked) {
                    413: 		    return radioButton[i].value;
                    414: 		}
                    415: 	    }
                    416: 	} else {
                    417: 	    if (radioButton.checked) return radioButton.value;
                    418: 	}
                    419: 	return selection;
                    420:     }
                    421: 
                    422:     function pullDownSelection(selectOne) {
                    423: 	var selection="";
                    424: 	if (selectOne.length > 1) {
                    425: 	    for (var i=0; i<selectOne.length; i++) {
                    426: 		if (selectOne[i].selected) {
                    427: 		    return selectOne[i].value;
                    428: 		}
                    429: 	    }
                    430: 	} else {
1.138     albertel  431:             // only one value it must be the selected one
                    432: 	    return selectOne.value;
1.118     ng        433: 	}
                    434:     }
                    435: </script>
                    436: COMMONJSFUNCTIONS
                    437: }
                    438: 
1.44      ng        439: #--- Dumps the class list with usernames,list of sections,
                    440: #--- section, ids and fullnames for each user.
                    441: sub getclasslist {
1.449     banghart  442:     my ($getsec,$filterlist,$getgroup) = @_;
1.291     albertel  443:     my @getsec;
1.450     banghart  444:     my @getgroup;
1.442     banghart  445:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.291     albertel  446:     if (!ref($getsec)) {
                    447: 	if ($getsec ne '' && $getsec ne 'all') {
                    448: 	    @getsec=($getsec);
                    449: 	}
                    450:     } else {
                    451: 	@getsec=@{$getsec};
                    452:     }
                    453:     if (grep(/^all$/,@getsec)) { undef(@getsec); }
1.450     banghart  454:     if (!ref($getgroup)) {
                    455: 	if ($getgroup ne '' && $getgroup ne 'all') {
                    456: 	    @getgroup=($getgroup);
                    457: 	}
                    458:     } else {
                    459: 	@getgroup=@{$getgroup};
                    460:     }
                    461:     if (grep(/^all$/,@getgroup)) { undef(@getgroup); }
1.291     albertel  462: 
1.449     banghart  463:     my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
1.49      albertel  464:     # Bail out if we were unable to get the classlist
1.56      matthew   465:     return if (! defined($classlist));
1.449     banghart  466:     &Apache::loncoursedata::get_group_memberships($classlist,$keylist);
1.56      matthew   467:     #
                    468:     my %sections;
                    469:     my %fullnames;
1.205     matthew   470:     foreach my $student (keys(%$classlist)) {
                    471:         my $end      = 
                    472:             $classlist->{$student}->[&Apache::loncoursedata::CL_END()];
                    473:         my $start    = 
                    474:             $classlist->{$student}->[&Apache::loncoursedata::CL_START()];
                    475:         my $id       = 
                    476:             $classlist->{$student}->[&Apache::loncoursedata::CL_ID()];
                    477:         my $section  = 
                    478:             $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
                    479:         my $fullname = 
                    480:             $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()];
                    481:         my $status   = 
                    482:             $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()];
1.449     banghart  483:         my $group   = 
                    484:             $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
1.76      ng        485: 	# filter students according to status selected
1.442     banghart  486: 	if ($filterlist && (!($stu_status =~ /Any/))) {
                    487: 	    if (!($stu_status =~ $status)) {
1.450     banghart  488: 		delete($classlist->{$student});
1.76      ng        489: 		next;
                    490: 	    }
                    491: 	}
1.450     banghart  492: 	# filter students according to groups selected
1.453     banghart  493: 	my @stu_groups = split(/,/,$group);
1.450     banghart  494: 	if (@getgroup) {
                    495: 	    my $exclude = 1;
1.454     banghart  496: 	    foreach my $grp (@getgroup) {
                    497: 	        foreach my $stu_group (@stu_groups) {
1.453     banghart  498: 	            if ($stu_group eq $grp) {
                    499: 	                $exclude = 0;
                    500:     	            } 
1.450     banghart  501: 	        }
1.453     banghart  502:     	        if (($grp eq 'none') && !$group) {
                    503:         	        $exclude = 0;
                    504:         	}
1.450     banghart  505: 	    }
                    506: 	    if ($exclude) {
                    507: 	        delete($classlist->{$student});
                    508: 	    }
                    509: 	}
1.205     matthew   510: 	$section = ($section ne '' ? $section : 'none');
1.106     albertel  511: 	if (&canview($section)) {
1.291     albertel  512: 	    if (!@getsec || grep(/^\Q$section\E$/,@getsec)) {
1.103     albertel  513: 		$sections{$section}++;
1.450     banghart  514: 		if ($classlist->{$student}) {
                    515: 		    $fullnames{$student}=$fullname;
                    516: 		}
1.103     albertel  517: 	    } else {
1.205     matthew   518: 		delete($classlist->{$student});
1.103     albertel  519: 	    }
                    520: 	} else {
1.205     matthew   521: 	    delete($classlist->{$student});
1.103     albertel  522: 	}
1.44      ng        523:     }
                    524:     my %seen = ();
1.56      matthew   525:     my @sections = sort(keys(%sections));
                    526:     return ($classlist,\@sections,\%fullnames);
1.44      ng        527: }
                    528: 
1.103     albertel  529: sub canmodify {
                    530:     my ($sec)=@_;
                    531:     if ($perm{'mgr'}) {
                    532: 	if (!defined($perm{'mgr_section'})) {
                    533: 	    # can modify whole class
                    534: 	    return 1;
                    535: 	} else {
                    536: 	    if ($sec eq $perm{'mgr_section'}) {
                    537: 		#can modify the requested section
                    538: 		return 1;
                    539: 	    } else {
                    540: 		# can't modify the request section
                    541: 		return 0;
                    542: 	    }
                    543: 	}
                    544:     }
                    545:     #can't modify
                    546:     return 0;
                    547: }
                    548: 
                    549: sub canview {
                    550:     my ($sec)=@_;
                    551:     if ($perm{'vgr'}) {
                    552: 	if (!defined($perm{'vgr_section'})) {
                    553: 	    # can modify whole class
                    554: 	    return 1;
                    555: 	} else {
                    556: 	    if ($sec eq $perm{'vgr_section'}) {
                    557: 		#can modify the requested section
                    558: 		return 1;
                    559: 	    } else {
                    560: 		# can't modify the request section
                    561: 		return 0;
                    562: 	    }
                    563: 	}
                    564:     }
                    565:     #can't modify
                    566:     return 0;
                    567: }
                    568: 
1.44      ng        569: #--- Retrieve the grade status of a student for all the parts
                    570: sub student_gradeStatus {
1.324     albertel  571:     my ($symb,$udom,$uname,$partlist) = @_;
1.257     albertel  572:     my %record     = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.44      ng        573:     my %partstatus = ();
                    574:     foreach (@$partlist) {
1.128     ng        575: 	my ($status,undef)   = split(/_/,$record{"resource.$_.solved"},2);
1.44      ng        576: 	$status              = 'nothing' if ($status eq '');
                    577: 	$partstatus{$_}      = $status;
                    578: 	my $subkey           = "resource.$_.submitted_by";
                    579: 	$partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne '');
                    580:     }
                    581:     return %partstatus;
                    582: }
                    583: 
1.45      ng        584: # hidden form and javascript that calls the form
                    585: # Use by verifyscript and viewgrades
                    586: # Shows a student's view of problem and submission
                    587: sub jscriptNform {
1.324     albertel  588:     my ($symb) = @_;
1.442     banghart  589:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.45      ng        590:     my $jscript='<script type="text/javascript" language="javascript">'."\n".
                    591: 	'    function viewOneStudent(user,domain) {'."\n".
                    592: 	'	document.onestudent.student.value = user;'."\n".
                    593: 	'	document.onestudent.userdom.value = domain;'."\n".
                    594: 	'	document.onestudent.submit();'."\n".
                    595: 	'    }'."\n".
                    596: 	'</script>'."\n";
                    597:     $jscript.= '<form action="/adm/grades" method="post" name="onestudent">'."\n".
1.418     albertel  598: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel  599: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
                    600: 	'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n".
1.442     banghart  601: 	'<input type="hidden" name="Status"  value="'.$stu_status.'" />'."\n".
1.45      ng        602: 	'<input type="hidden" name="command" value="submission" />'."\n".
                    603: 	'<input type="hidden" name="student" value="" />'."\n".
                    604: 	'<input type="hidden" name="userdom" value="" />'."\n".
                    605: 	'</form>'."\n";
                    606:     return $jscript;
                    607: }
1.39      ng        608: 
1.447     foxr      609: 
                    610: 
1.315     bowersj2  611: # Given the score (as a number [0-1] and the weight) what is the final
                    612: # point value? This function will round to the nearest tenth, third,
                    613: # or quarter if one of those is within the tolerance of .00001.
1.316     albertel  614: sub compute_points {
1.315     bowersj2  615:     my ($score, $weight) = @_;
                    616:     
                    617:     my $tolerance = .00001;
                    618:     my $points = $score * $weight;
                    619: 
                    620:     # Check for nearness to 1/x.
                    621:     my $check_for_nearness = sub {
                    622:         my ($factor) = @_;
                    623:         my $num = ($points * $factor) + $tolerance;
                    624:         my $floored_num = floor($num);
1.316     albertel  625:         if ($num - $floored_num < 2 * $tolerance * $factor) {
1.315     bowersj2  626:             return $floored_num / $factor;
                    627:         }
                    628:         return $points;
                    629:     };
                    630: 
                    631:     $points = $check_for_nearness->(10);
                    632:     $points = $check_for_nearness->(3);
                    633:     $points = $check_for_nearness->(4);
                    634:     
                    635:     return $points;
                    636: }
                    637: 
1.44      ng        638: #------------------ End of general use routines --------------------
1.87      www       639: 
                    640: #
                    641: # Find most similar essay
                    642: #
                    643: 
                    644: sub most_similar {
1.426     albertel  645:     my ($uname,$udom,$uessay,$old_essays)=@_;
1.87      www       646: 
                    647: # ignore spaces and punctuation
                    648: 
                    649:     $uessay=~s/\W+/ /gs;
                    650: 
1.282     www       651: # ignore empty submissions (occuring when only files are sent)
                    652: 
                    653:     unless ($uessay=~/\w+/) { return ''; }
                    654: 
1.87      www       655: # these will be returned. Do not care if not at least 50 percent similar
1.88      www       656:     my $limit=0.6;
1.87      www       657:     my $sname='';
                    658:     my $sdom='';
                    659:     my $scrsid='';
                    660:     my $sessay='';
                    661: # go through all essays ...
1.426     albertel  662:     foreach my $tkey (keys(%$old_essays)) {
                    663: 	my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));
1.87      www       664: # ... except the same student
1.426     albertel  665:         next if (($tname eq $uname) && ($tdom eq $udom));
                    666: 	my $tessay=$old_essays->{$tkey};
                    667: 	$tessay=~s/\W+/ /gs;
1.87      www       668: # String similarity gives up if not even limit
1.426     albertel  669: 	my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
1.87      www       670: # Found one
1.426     albertel  671: 	if ($tsimilar>$limit) {
                    672: 	    $limit=$tsimilar;
                    673: 	    $sname=$tname;
                    674: 	    $sdom=$tdom;
                    675: 	    $scrsid=$tcrsid;
                    676: 	    $sessay=$old_essays->{$tkey};
                    677: 	}
1.87      www       678:     }
1.88      www       679:     if ($limit>0.6) {
1.87      www       680:        return ($sname,$sdom,$scrsid,$sessay,$limit);
                    681:     } else {
                    682:        return ('','','','',0);
                    683:     }
                    684: }
                    685: 
1.44      ng        686: #-------------------------------------------------------------------
                    687: 
                    688: #------------------------------------ Receipt Verification Routines
1.45      ng        689: #
1.44      ng        690: #--- Check whether a receipt number is valid.---
                    691: sub verifyreceipt {
                    692:     my $request  = shift;
                    693: 
1.257     albertel  694:     my $courseid = $env{'request.course.id'};
1.184     www       695:     my $receipt  = &Apache::lonnet::recprefix($courseid).'-'.
1.257     albertel  696: 	$env{'form.receipt'};
1.44      ng        697:     $receipt     =~ s/[^\-\d]//g;
1.378     albertel  698:     my ($symb)   = &get_symb($request);
1.44      ng        699: 
1.487     albertel  700:     my $title.=
                    701: 	'<h3><span class="LC_info">'.
                    702: 	&mt('Verifying Submission Receipt [_1]',$receipt).
                    703: 	'</span></h3>'."\n".
                    704: 	'<h4>'.&mt('<b>Resource: </b>[_1]',$env{'form.probTitle'}).
                    705: 	'</h4>'."\n";
1.44      ng        706: 
                    707:     my ($string,$contents,$matches) = ('','',0);
1.56      matthew   708:     my (undef,undef,$fullname) = &getclasslist('all','0');
1.177     albertel  709:     
                    710:     my $receiptparts=0;
1.390     albertel  711:     if ($env{"course.$courseid.receiptalg"} eq 'receipt2' ||
                    712: 	$env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; }
1.177     albertel  713:     my $parts=['0'];
1.324     albertel  714:     if ($receiptparts) { ($parts)=&response_type($symb); }
1.486     albertel  715:     
                    716:     my $header = 
                    717: 	&Apache::loncommon::start_data_table().
                    718: 	&Apache::loncommon::start_data_table_header_row().
1.487     albertel  719: 	'<th>&nbsp;'.&mt('Fullname').'&nbsp;</th>'."\n".
                    720: 	'<th>&nbsp;'.&mt('Username').'&nbsp;</th>'."\n".
                    721: 	'<th>&nbsp;'.&mt('Domain').'&nbsp;</th>';
1.486     albertel  722:     if ($receiptparts) {
1.487     albertel  723: 	$header.='<th>&nbsp;'.&mt('Problem Part').'&nbsp;</th>';
1.486     albertel  724:     }
                    725:     $header.=
                    726: 	&Apache::loncommon::end_data_table_header_row();
                    727: 
1.294     albertel  728:     foreach (sort 
                    729: 	     {
                    730: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                    731: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                    732: 		 }
                    733: 		 return $a cmp $b;
                    734: 	     } (keys(%$fullname))) {
1.44      ng        735: 	my ($uname,$udom)=split(/\:/);
1.177     albertel  736: 	foreach my $part (@$parts) {
                    737: 	    if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) {
1.486     albertel  738: 		$contents.=
                    739: 		    &Apache::loncommon::start_data_table_row().
                    740: 		    '<td>&nbsp;'."\n".
1.177     albertel  741: 		    '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
1.417     albertel  742: 		    '\');" target="_self">'.$$fullname{$_}.'</a>&nbsp;</td>'."\n".
1.177     albertel  743: 		    '<td>&nbsp;'.$uname.'&nbsp;</td>'.
                    744: 		    '<td>&nbsp;'.$udom.'&nbsp;</td>';
                    745: 		if ($receiptparts) {
                    746: 		    $contents.='<td>&nbsp;'.$part.'&nbsp;</td>';
                    747: 		}
1.486     albertel  748: 		$contents.= 
                    749: 		    &Apache::loncommon::end_data_table_row()."\n";
1.177     albertel  750: 		
                    751: 		$matches++;
                    752: 	    }
1.44      ng        753: 	}
                    754:     }
                    755:     if ($matches == 0) {
1.487     albertel  756: 	$string = $title.&mt('No match found for the above receipt.');
1.44      ng        757:     } else {
1.324     albertel  758: 	$string = &jscriptNform($symb).$title.
1.487     albertel  759: 	    '<p>'.
                    760: 	    &mt('The above receipt matches the following [numerate,_1,student].',$matches).
                    761: 	    '</p>'.
1.486     albertel  762: 	    $header.
                    763: 	    $contents.
                    764: 	    &Apache::loncommon::end_data_table()."\n";
1.44      ng        765:     }
1.324     albertel  766:     return $string.&show_grading_menu_form($symb);
1.44      ng        767: }
                    768: 
                    769: #--- This is called by a number of programs.
                    770: #--- Called from the Grading Menu - View/Grade an individual student
                    771: #--- Also called directly when one clicks on the subm button 
                    772: #    on the problem page.
1.30      ng        773: sub listStudents {
1.41      ng        774:     my ($request) = shift;
1.49      albertel  775: 
1.324     albertel  776:     my ($symb) = &get_symb($request);
1.257     albertel  777:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                    778:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                    779:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
1.449     banghart  780:     my $getgroup  = $env{'form.group'} eq '' ? 'all' : $env{'form.group'};
1.257     albertel  781:     my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};
                    782:     my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View';
                    783:     $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 
                    784: 	&Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
1.49      albertel  785: 
1.485     albertel  786:     my $result='<h3><span class="LC_info">&nbsp;'.
                    787: 	&mt($viewgrade.' Submissions for a Student or a Group of Students')
                    788: 	.'</span></h3>';
1.118     ng        789: 
1.324     albertel  790:     my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes'));
1.49      albertel  791: 
1.485     albertel  792:     my %lt = ( 'multiple' =>
                    793: 	       "Please select a student or group of students before clicking on the Next button.",
                    794: 	       'single'   =>
                    795: 	       "Please select the student before clicking on the Next button.",
                    796: 	       );
                    797:     %lt = &Apache::lonlocal::texthash(%lt);
1.45      ng        798:     $request->print(<<LISTJAVASCRIPT);
                    799: <script type="text/javascript" language="javascript">
1.110     ng        800:     function checkSelect(checkBox) {
                    801: 	var ctr=0;
                    802: 	var sense="";
                    803: 	if (checkBox.length > 1) {
                    804: 	    for (var i=0; i<checkBox.length; i++) {
                    805: 		if (checkBox[i].checked) {
                    806: 		    ctr++;
                    807: 		}
                    808: 	    }
1.485     albertel  809: 	    sense = '$lt{'multiple'}';
1.110     ng        810: 	} else {
                    811: 	    if (checkBox.checked) {
                    812: 		ctr = 1;
                    813: 	    }
1.485     albertel  814: 	    sense = '$lt{'single'}';
1.110     ng        815: 	}
                    816: 	if (ctr == 0) {
1.485     albertel  817: 	    alert(sense);
1.110     ng        818: 	    return false;
                    819: 	}
                    820: 	document.gradesub.submit();
                    821:     }
                    822: 
                    823:     function reLoadList(formname) {
1.112     ng        824: 	if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;}
1.110     ng        825: 	formname.command.value = 'submission';
                    826: 	formname.submit();
                    827:     }
1.45      ng        828: </script>
                    829: LISTJAVASCRIPT
                    830: 
1.118     ng        831:     &commonJSfunctions($request);
1.41      ng        832:     $request->print($result);
1.39      ng        833: 
1.401     albertel  834:     my $checkhdgrade = ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked="checked"' : '';
                    835:     my $checklastsub = $checkhdgrade eq '' ? 'checked="checked"' : '';
1.154     albertel  836:     my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'.
1.485     albertel  837: 	"\n".$table;
                    838: 	
                    839:     $gradeTable .= 
                    840: 	'&nbsp;'.
                    841: 	&mt('<b>View Problem Text: </b>[_1]',
                    842: 	    '<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n".
                    843: 	    '<label><input type="radio" name="vProb" value="yes" /> '.&mt('one student').' </label>'."\n".
                    844: 	    '<label><input type="radio" name="vProb" value="all" /> '.&mt('all students').' </label>').'<br />'."\n";
                    845:     $gradeTable .= 
                    846: 	'&nbsp;'.
                    847: 	&mt('<b>View Answer: </b>[_1]',
                    848: 	    '<label><input type="radio" name="vAns" value="no"  /> '.&mt('no').' </label>'."\n".
                    849: 	    '<label><input type="radio" name="vAns" value="yes" /> '.&mt('one student').' </label>'."\n".
                    850: 	    '<label><input type="radio" name="vAns" value="all" checked="checked" /> '.&mt('all students').' </label>').'<br />'."\n";
                    851: 
                    852:     my $submission_options;
1.257     albertel  853:     if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {
1.485     albertel  854: 	$submission_options.=
                    855: 	    '<label><input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> '.&mt('essay part only').' </label>'."\n";
1.49      albertel  856:     }
1.442     banghart  857:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
                    858:     my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status;
1.257     albertel  859:     $env{'form.Status'} = $saveStatus;
1.485     albertel  860:     $submission_options.=
                    861: 	'<label><input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> '.&mt('last submission only').' </label>'."\n".
                    862: 	'<label><input type="radio" name="lastSub" value="last" /> '.&mt('last submission &amp; parts info').' </label>'."\n".
                    863: 	'<label><input type="radio" name="lastSub" value="datesub" /> '.&mt('by dates and submissions').' </label>'."\n".
                    864: 	'<label><input type="radio" name="lastSub" value="all" /> '.&mt('all details').'</label>';
                    865:     $gradeTable .= 
                    866: 	'&nbsp;'.
                    867: 	&mt('<b>Submissions: </b>[_1]',$submission_options).'<br />'."\n";
                    868: 
                    869:     $gradeTable .= 
                    870:         '&nbsp;'.
                    871: 	&mt('<b>Grading Increments:</b> [_1]',
                    872: 	    '<select name="increment">'.
                    873: 	    '<option value="1">'.&mt('Whole Points').'</option>'.
                    874: 	    '<option value=".5">'.&mt('Half Points').'</option>'.
                    875: 	    '<option value=".25">'.&mt('Quarter Points').'</option>'.
                    876: 	    '<option value=".1">'.&mt('Tenths of a Point').'</option>'.
                    877: 	    '</select>');
                    878:     
                    879:     $gradeTable .= 
1.432     banghart  880:         &build_section_inputs().
1.45      ng        881: 	'<input type="hidden" name="submitonly"  value="'.$submitonly.'" />'."\n".
1.257     albertel  882: 	'<input type="hidden" name="handgrade"   value="'.$env{'form.handgrade'}.'" /><br />'."\n".
                    883: 	'<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" /><br />'."\n".
                    884: 	'<input type="hidden" name="saveState"   value="'.$env{'form.saveState'}.'" />'."\n".
                    885: 	'<input type="hidden" name="probTitle"   value="'.$env{'form.probTitle'}.'" />'."\n".
1.418     albertel  886: 	'<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.110     ng        887: 	'<input type="hidden" name="saveStatusOld" value="'.$saveStatus.'" />'."\n";
                    888: 
1.257     albertel  889:     if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) {
1.442     banghart  890: 	$gradeTable.='<input type="hidden" name="Status"   value="'.$stu_status.'" />'."\n";
1.124     ng        891:     } else {
1.485     albertel  892: 	$gradeTable.=&mt('<b>Student Status:</b> [_1]',
                    893: 			 &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);')).'<br />';
1.124     ng        894:     }
1.112     ng        895: 
1.485     albertel  896:     $gradeTable.=&mt('To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '.
                    897: 	'next to the student\'s name(s). Then click on the Next button.').'<br />'."\n".
1.110     ng        898: 	'<input type="hidden" name="command" value="processGroup" />'."\n";
1.249     albertel  899: 
                    900: # checkall buttons
                    901:     $gradeTable.=&check_script('gradesub', 'stuinfo');
1.110     ng        902:     $gradeTable.='<input type="button" '."\n".
1.45      ng        903: 	'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".
1.485     albertel  904: 	'value="'.&mt('Next-&gt;').'" /> <br />'."\n";
1.249     albertel  905:     $gradeTable.=&check_buttons();
1.485     albertel  906:     $gradeTable.='<label><input type="checkbox" name="checkPlag" checked="checked" />'.&mt('Check For Plagiarism').'</label>';
1.450     banghart  907:     my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup);
1.474     albertel  908:     $gradeTable.= &Apache::loncommon::start_data_table().
                    909: 	&Apache::loncommon::start_data_table_header_row();
1.110     ng        910:     my $loop = 0;
                    911:     while ($loop < 2) {
1.485     albertel  912: 	$gradeTable.='<th>'.&mt('No.').'</th><th>'.&mt('Select').'</th>'.
                    913: 	    '<th>'.&nameUserString('header').'&nbsp;'.&mt('Section/Group').'</th>';
1.301     albertel  914: 	if ($env{'form.showgrading'} eq 'yes' 
                    915: 	    && $submitonly ne 'queued'
                    916: 	    && $submitonly ne 'all') {
1.485     albertel  917: 	    foreach my $part (sort(@$partlist)) {
                    918: 		my $display_part=
                    919: 		    &get_display_part((split(/_/,$part))[0],$symb);
                    920: 		$gradeTable.=
                    921: 		    '<th>'.&mt('Part: [_1] Status',$display_part).'</th>';
1.110     ng        922: 	    }
1.301     albertel  923: 	} elsif ($submitonly eq 'queued') {
1.474     albertel  924: 	    $gradeTable.='<th>'.&mt('Queue Status').'&nbsp;</th>';
1.110     ng        925: 	}
                    926: 	$loop++;
1.126     ng        927: #	$gradeTable.='<td></td>' if ($loop%2 ==1);
1.41      ng        928:     }
1.474     albertel  929:     $gradeTable.=&Apache::loncommon::end_data_table_header_row()."\n";
1.41      ng        930: 
1.45      ng        931:     my $ctr = 0;
1.294     albertel  932:     foreach my $student (sort 
                    933: 			 {
                    934: 			     if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                    935: 				 return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                    936: 			     }
                    937: 			     return $a cmp $b;
                    938: 			 }
                    939: 			 (keys(%$fullname))) {
1.41      ng        940: 	my ($uname,$udom) = split(/:/,$student);
1.301     albertel  941: 
1.110     ng        942: 	my %status = ();
1.301     albertel  943: 
                    944: 	if ($submitonly eq 'queued') {
                    945: 	    my %queue_status = 
                    946: 		&Apache::bridgetask::get_student_status($symb,$cdom,$cnum,
                    947: 							$udom,$uname);
                    948: 	    next if (!defined($queue_status{'gradingqueue'}));
                    949: 	    $status{'gradingqueue'} = $queue_status{'gradingqueue'};
                    950: 	}
                    951: 
                    952: 	if ($env{'form.showgrading'} eq 'yes' 
                    953: 	    && $submitonly ne 'queued'
                    954: 	    && $submitonly ne 'all') {
1.324     albertel  955: 	    (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist);
1.145     albertel  956: 	    my $submitted = 0;
1.164     albertel  957: 	    my $graded = 0;
1.248     albertel  958: 	    my $incorrect = 0;
1.110     ng        959: 	    foreach (keys(%status)) {
1.145     albertel  960: 		$submitted = 1 if ($status{$_} ne 'nothing');
1.248     albertel  961: 		$graded = 1 if ($status{$_} =~ /^ungraded/);
                    962: 		$incorrect = 1 if ($status{$_} =~ /^incorrect/);
                    963: 		
1.110     ng        964: 		my ($foo,$partid,$foo1) = split(/\./,$_);
                    965: 		if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
1.145     albertel  966: 		    $submitted = 0;
1.150     albertel  967: 		    my ($part)=split(/\./,$partid);
1.110     ng        968: 		    $gradeTable.='<input type="hidden" name="'.
1.150     albertel  969: 			$student.':'.$part.':submitted_by" value="'.
1.110     ng        970: 			$status{'resource.'.$partid.'.submitted_by'}.'" />';
                    971: 		}
1.41      ng        972: 	    }
1.248     albertel  973: 	    
1.156     albertel  974: 	    next if (!$submitted && ($submitonly eq 'yes' ||
                    975: 				     $submitonly eq 'incorrect' ||
                    976: 				     $submitonly eq 'graded'));
1.248     albertel  977: 	    next if (!$graded && ($submitonly eq 'graded'));
                    978: 	    next if (!$incorrect && $submitonly eq 'incorrect');
1.41      ng        979: 	}
1.34      ng        980: 
1.45      ng        981: 	$ctr++;
1.249     albertel  982: 	my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
1.452     banghart  983:         my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
1.104     albertel  984: 	if ( $perm{'vgr'} eq 'F' ) {
1.474     albertel  985: 	    if ($ctr%2 ==1) {
                    986: 		$gradeTable.= &Apache::loncommon::start_data_table_row();
                    987: 	    }
1.126     ng        988: 	    $gradeTable.='<td align="right">'.$ctr.'&nbsp;</td>'.
1.249     albertel  989:                '<td align="center"><label><input type=checkbox name="stuinfo" value="'.
                    990:                $student.':'.$$fullname{$student}.':::SECTION'.$section.
                    991: 	       ')&nbsp;" />&nbsp;&nbsp;</label></td>'."\n".'<td>'.
                    992: 	       &nameUserString(undef,$$fullname{$student},$uname,$udom).
1.474     albertel  993: 	       '&nbsp;'.$section.($group ne '' ?'/'.$group:'').'</td>'."\n";
1.110     ng        994: 
1.257     albertel  995: 	    if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
1.524     raeburn   996: 		foreach (sort(keys(%status))) {
1.485     albertel  997: 		    next if ($_ =~ /^resource.*?submitted_by$/);
                    998: 		    $gradeTable.='<td align="center">&nbsp;'.&mt($status{$_}).'&nbsp;</td>'."\n";
1.110     ng        999: 		}
1.41      ng       1000: 	    }
1.126     ng       1001: #	    $gradeTable.='<td></td>' if ($ctr%2 ==1);
1.474     albertel 1002: 	    if ($ctr%2 ==0) {
                   1003: 		$gradeTable.=&Apache::loncommon::end_data_table_row()."\n";
                   1004: 	    }
1.41      ng       1005: 	}
                   1006:     }
1.110     ng       1007:     if ($ctr%2 ==1) {
1.126     ng       1008: 	$gradeTable.='<td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td>';
1.301     albertel 1009: 	    if ($env{'form.showgrading'} eq 'yes' 
                   1010: 		&& $submitonly ne 'queued'
                   1011: 		&& $submitonly ne 'all') {
1.110     ng       1012: 		foreach (@$partlist) {
                   1013: 		    $gradeTable.='<td>&nbsp;</td>';
                   1014: 		}
1.301     albertel 1015: 	    } elsif ($submitonly eq 'queued') {
                   1016: 		$gradeTable.='<td>&nbsp;</td>';
1.110     ng       1017: 	    }
1.474     albertel 1018: 	$gradeTable.=&Apache::loncommon::end_data_table_row();
1.110     ng       1019:     }
                   1020: 
1.474     albertel 1021:     $gradeTable.=&Apache::loncommon::end_data_table()."\n".
1.45      ng       1022: 	'<input type="button" '.
                   1023: 	'onClick="javascript:checkSelect(this.form.stuinfo);" '.
1.485     albertel 1024: 	'value="'.&mt('Next-&gt;').'" /></form>'."\n";
1.45      ng       1025:     if ($ctr == 0) {
1.96      albertel 1026: 	my $num_students=(scalar(keys(%$fullname)));
                   1027: 	if ($num_students eq 0) {
1.485     albertel 1028: 	    $gradeTable='<br />&nbsp;<span class="LC_warning">'.&mt('There are no students currently enrolled.').'</span>';
1.96      albertel 1029: 	} else {
1.171     albertel 1030: 	    my $submissions='submissions';
                   1031: 	    if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; }
                   1032: 	    if ($submitonly eq 'graded'   ) { $submissions = 'ungraded submissions'; }
1.301     albertel 1033: 	    if ($submitonly eq 'queued'   ) { $submissions = 'queued submissions'; }
1.398     albertel 1034: 	    $gradeTable='<br />&nbsp;<span class="LC_warning">'.
1.485     albertel 1035: 		&mt('No '.$submissions.' found for this resource for any students. ([_1] students checked for '.$submissions.')',
                   1036: 		    $num_students).
                   1037: 		'</span><br />';
1.96      albertel 1038: 	}
1.46      ng       1039:     } elsif ($ctr == 1) {
1.474     albertel 1040: 	$gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/;
1.45      ng       1041:     }
1.324     albertel 1042:     $gradeTable.=&show_grading_menu_form($symb);
1.45      ng       1043:     $request->print($gradeTable);
1.44      ng       1044:     return '';
1.10      ng       1045: }
                   1046: 
1.44      ng       1047: #---- Called from the listStudents routine
1.249     albertel 1048: 
                   1049: sub check_script {
                   1050:     my ($form, $type)=@_;
                   1051:     my $chkallscript='<script type="text/javascript">
                   1052:     function checkall() {
                   1053:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1054:             ele = document.forms.'.$form.'.elements[i];
                   1055:             if (ele.name == "'.$type.'") {
                   1056:             document.forms.'.$form.'.elements[i].checked=true;
                   1057:                                        }
                   1058:         }
                   1059:     }
                   1060: 
                   1061:     function checksec() {
                   1062:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1063:             ele = document.forms.'.$form.'.elements[i];
                   1064:            string = document.forms.'.$form.'.chksec.value;
                   1065:            if
                   1066:           (ele.value.indexOf(":::SECTION"+string)>0) {
                   1067:               document.forms.'.$form.'.elements[i].checked=true;
                   1068:             }
                   1069:         }
                   1070:     }
                   1071: 
                   1072: 
                   1073:     function uncheckall() {
                   1074:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1075:             ele = document.forms.'.$form.'.elements[i];
                   1076:             if (ele.name == "'.$type.'") {
                   1077:             document.forms.'.$form.'.elements[i].checked=false;
                   1078:                                        }
                   1079:         }
                   1080:     }
                   1081: 
                   1082: </script>'."\n";
                   1083:     return $chkallscript;
                   1084: }
                   1085: 
                   1086: sub check_buttons {
1.485     albertel 1087:     my $buttons.='<input type="button" onclick="checkall()" value="'.&mt('Check All').'" />';
                   1088:     $buttons.='<input type="button" onclick="uncheckall()" value="'.&mt('Uncheck All').'" />&nbsp;';
                   1089:     $buttons.='<input type="button" onclick="checksec()" value="'.&mt('Check Section/Group').'" />';
1.249     albertel 1090:     $buttons.='<input type="text" size="5" name="chksec" />&nbsp;';
                   1091:     return $buttons;
                   1092: }
                   1093: 
1.44      ng       1094: #     Displays the submissions for one student or a group of students
1.34      ng       1095: sub processGroup {
1.41      ng       1096:     my ($request)  = shift;
                   1097:     my $ctr        = 0;
1.155     albertel 1098:     my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo');
1.41      ng       1099:     my $total      = scalar(@stuchecked)-1;
1.45      ng       1100: 
1.396     banghart 1101:     foreach my $student (@stuchecked) {
                   1102: 	my ($uname,$udom,$fullname) = split(/:/,$student);
1.257     albertel 1103: 	$env{'form.student'}        = $uname;
                   1104: 	$env{'form.userdom'}        = $udom;
                   1105: 	$env{'form.fullname'}       = $fullname;
1.41      ng       1106: 	&submission($request,$ctr,$total);
                   1107: 	$ctr++;
                   1108:     }
                   1109:     return '';
1.35      ng       1110: }
1.34      ng       1111: 
1.44      ng       1112: #------------------------------------------------------------------------------------
                   1113: #
                   1114: #-------------------------- Next few routines handles grading by student, essentially
                   1115: #                           handles essay response type problem/part
                   1116: #
                   1117: #--- Javascript to handle the submission page functionality ---
                   1118: sub sub_page_js {
                   1119:     my $request = shift;
                   1120:     $request->print(<<SUBJAVASCRIPT);
                   1121: <script type="text/javascript" language="javascript">
1.71      ng       1122:     function updateRadio(formname,id,weight) {
1.125     ng       1123: 	var gradeBox = formname["GD_BOX"+id];
                   1124: 	var radioButton = formname["RADVAL"+id];
                   1125: 	var oldpts = formname["oldpts"+id].value;
1.72      ng       1126: 	var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts;
1.71      ng       1127: 	gradeBox.value = pts;
                   1128: 	var resetbox = false;
                   1129: 	if (isNaN(pts) || pts < 0) {
                   1130: 	    alert("A number equal or greater than 0 is expected. Entered value = "+pts);
                   1131: 	    for (var i=0; i<radioButton.length; i++) {
                   1132: 		if (radioButton[i].checked) {
                   1133: 		    gradeBox.value = i;
                   1134: 		    resetbox = true;
                   1135: 		}
                   1136: 	    }
                   1137: 	    if (!resetbox) {
                   1138: 		formtextbox.value = "";
                   1139: 	    }
                   1140: 	    return;
1.44      ng       1141: 	}
1.71      ng       1142: 
                   1143: 	if (pts > weight) {
                   1144: 	    var resp = confirm("You entered a value ("+pts+
                   1145: 			       ") greater than the weight for the part. Accept?");
                   1146: 	    if (resp == false) {
1.125     ng       1147: 		gradeBox.value = oldpts;
1.71      ng       1148: 		return;
                   1149: 	    }
1.44      ng       1150: 	}
1.13      albertel 1151: 
1.71      ng       1152: 	for (var i=0; i<radioButton.length; i++) {
                   1153: 	    radioButton[i].checked=false;
                   1154: 	    if (pts == i && pts != "") {
                   1155: 		radioButton[i].checked=true;
                   1156: 	    }
                   1157: 	}
                   1158: 	updateSelect(formname,id);
1.125     ng       1159: 	formname["stores"+id].value = "0";
1.41      ng       1160:     }
1.5       albertel 1161: 
1.72      ng       1162:     function writeBox(formname,id,pts) {
1.125     ng       1163: 	var gradeBox = formname["GD_BOX"+id];
1.71      ng       1164: 	if (checkSolved(formname,id) == 'update') {
                   1165: 	    gradeBox.value = pts;
                   1166: 	} else {
1.125     ng       1167: 	    var oldpts = formname["oldpts"+id].value;
1.72      ng       1168: 	    gradeBox.value = oldpts;
1.125     ng       1169: 	    var radioButton = formname["RADVAL"+id];
1.71      ng       1170: 	    for (var i=0; i<radioButton.length; i++) {
                   1171: 		radioButton[i].checked=false;
1.72      ng       1172: 		if (i == oldpts) {
1.71      ng       1173: 		    radioButton[i].checked=true;
                   1174: 		}
                   1175: 	    }
1.41      ng       1176: 	}
1.125     ng       1177: 	formname["stores"+id].value = "0";
1.71      ng       1178: 	updateSelect(formname,id);
                   1179: 	return;
1.41      ng       1180:     }
1.44      ng       1181: 
1.71      ng       1182:     function clearRadBox(formname,id) {
                   1183: 	if (checkSolved(formname,id) == 'noupdate') {
                   1184: 	    updateSelect(formname,id);
                   1185: 	    return;
                   1186: 	}
1.125     ng       1187: 	gradeSelect = formname["GD_SEL"+id];
1.71      ng       1188: 	for (var i=0; i<gradeSelect.length; i++) {
                   1189: 	    if (gradeSelect[i].selected) {
                   1190: 		var selectx=i;
                   1191: 	    }
                   1192: 	}
1.125     ng       1193: 	var stores = formname["stores"+id];
1.71      ng       1194: 	if (selectx == stores.value) { return };
1.125     ng       1195: 	var gradeBox = formname["GD_BOX"+id];
1.71      ng       1196: 	gradeBox.value = "";
1.125     ng       1197: 	var radioButton = formname["RADVAL"+id];
1.71      ng       1198: 	for (var i=0; i<radioButton.length; i++) {
                   1199: 	    radioButton[i].checked=false;
                   1200: 	}
                   1201: 	stores.value = selectx;
                   1202:     }
1.5       albertel 1203: 
1.71      ng       1204:     function checkSolved(formname,id) {
1.125     ng       1205: 	if (formname["solved"+id].value == "correct_by_student" && formname.overRideScore.value == 'no') {
1.118     ng       1206: 	    var reply = confirm("This problem has been graded correct by the computer. Do you want to change the score?");
                   1207: 	    if (!reply) {return "noupdate";}
1.120     ng       1208: 	    formname.overRideScore.value = 'yes';
1.41      ng       1209: 	}
1.71      ng       1210: 	return "update";
1.13      albertel 1211:     }
1.71      ng       1212: 
                   1213:     function updateSelect(formname,id) {
1.125     ng       1214: 	formname["GD_SEL"+id][0].selected = true;
1.71      ng       1215: 	return;
1.41      ng       1216:     }
1.33      ng       1217: 
1.121     ng       1218: //=========== Check that a point is assigned for all the parts  ============
1.71      ng       1219:     function checksubmit(formname,val,total,parttot) {
1.121     ng       1220: 	formname.gradeOpt.value = val;
1.71      ng       1221: 	if (val == "Save & Next") {
                   1222: 	    for (i=0;i<=total;i++) {
                   1223: 		for (j=0;j<parttot;j++) {
1.125     ng       1224: 		    var partid = formname["partid"+i+"_"+j].value;
1.127     ng       1225: 		    if (formname["GD_SEL"+i+"_"+partid][0].selected) {
1.125     ng       1226: 			var points = formname["GD_BOX"+i+"_"+partid].value;
1.71      ng       1227: 			if (points == "") {
1.125     ng       1228: 			    var name = formname["name"+i].value;
1.129     ng       1229: 			    var studentID = (name != '' ? name : formname["unamedom"+i].value);
                   1230: 			    var resp = confirm("You did not assign a score for "+studentID+
                   1231: 					       ", part "+partid+". Continue?");
1.71      ng       1232: 			    if (resp == false) {
1.125     ng       1233: 				formname["GD_BOX"+i+"_"+partid].focus();
1.71      ng       1234: 				return false;
                   1235: 			    }
                   1236: 			}
                   1237: 		    }
                   1238: 		    
                   1239: 		}
                   1240: 	    }
                   1241: 	    
                   1242: 	}
1.121     ng       1243: 	if (val == "Grade Student") {
                   1244: 	    formname.showgrading.value = "yes";
                   1245: 	    if (formname.Status.value == "") {
                   1246: 		formname.Status.value = "Active";
                   1247: 	    }
                   1248: 	    formname.studentNo.value = total;
                   1249: 	}
1.120     ng       1250: 	formname.submit();
                   1251:     }
                   1252: 
1.71      ng       1253: //======= Check that a score is assigned for all the problems (page/sequence grading only) =========
                   1254:     function checkSubmitPage(formname,total) {
                   1255: 	noscore = new Array(100);
                   1256: 	var ptr = 0;
                   1257: 	for (i=1;i<total;i++) {
1.125     ng       1258: 	    var partid = formname["q_"+i].value;
1.127     ng       1259: 	    if (formname["GD_SEL"+i+"_"+partid][0].selected) {
1.125     ng       1260: 		var points = formname["GD_BOX"+i+"_"+partid].value;
                   1261: 		var status = formname["solved"+i+"_"+partid].value;
1.71      ng       1262: 		if (points == "" && status != "correct_by_student") {
                   1263: 		    noscore[ptr] = i;
                   1264: 		    ptr++;
                   1265: 		}
                   1266: 	    }
                   1267: 	}
                   1268: 	if (ptr != 0) {
                   1269: 	    var sense = ptr == 1 ? ": " : "s: ";
                   1270: 	    var prolist = "";
                   1271: 	    if (ptr == 1) {
                   1272: 		prolist = noscore[0];
                   1273: 	    } else {
                   1274: 		var i = 0;
                   1275: 		while (i < ptr-1) {
                   1276: 		    prolist += noscore[i]+", ";
                   1277: 		    i++;
                   1278: 		}
                   1279: 		prolist += "and "+noscore[i];
                   1280: 	    }
                   1281: 	    var resp = confirm("You did not assign any score for the following problem"+sense+prolist+". Continue?");
                   1282: 	    if (resp == false) {
                   1283: 		return false;
                   1284: 	    }
                   1285: 	}
1.45      ng       1286: 
1.71      ng       1287: 	formname.submit();
                   1288:     }
                   1289: </script>
                   1290: SUBJAVASCRIPT
                   1291: }
1.45      ng       1292: 
1.71      ng       1293: #--- javascript for essay type problem --
                   1294: sub sub_page_kw_js {
                   1295:     my $request = shift;
1.80      ng       1296:     my $iconpath = $request->dir_config('lonIconsURL');
1.118     ng       1297:     &commonJSfunctions($request);
1.350     albertel 1298: 
1.351     albertel 1299:     my $inner_js_msg_central=<<INNERJS;
1.350     albertel 1300:     <script text="text/javascript">
                   1301:     function checkInput() {
                   1302:       opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value);
                   1303:       var nmsg   = opener.document.SCORE.savemsgN.value;
                   1304:       var usrctr = document.msgcenter.usrctr.value;
                   1305:       var newval = opener.document.SCORE["newmsg"+usrctr];
                   1306:       newval.value = opener.checkEntities(document.msgcenter.newmsg.value);
                   1307: 
                   1308:       var msgchk = "";
                   1309:       if (document.msgcenter.subchk.checked) {
                   1310:          msgchk = "msgsub,";
                   1311:       }
                   1312:       var includemsg = 0;
                   1313:       for (var i=1; i<=nmsg; i++) {
                   1314:           var opnmsg = opener.document.SCORE["savemsg"+i];
                   1315:           var frmmsg = document.msgcenter["msg"+i];
                   1316:           opnmsg.value = opener.checkEntities(frmmsg.value);
                   1317:           var showflg = opener.document.SCORE["shownOnce"+i];
                   1318:           showflg.value = "1";
                   1319:           var chkbox = document.msgcenter["msgn"+i];
                   1320:           if (chkbox.checked) {
                   1321:              msgchk += "savemsg"+i+",";
                   1322:              includemsg = 1;
                   1323:           }
                   1324:       }
                   1325:       if (document.msgcenter.newmsgchk.checked) {
                   1326:          msgchk += "newmsg"+usrctr;
                   1327:          includemsg = 1;
                   1328:       }
                   1329:       imgformname = opener.document.SCORE["mailicon"+usrctr];
                   1330:       imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif");
                   1331:       var includemsg = opener.document.SCORE["includemsg"+usrctr];
                   1332:       includemsg.value = msgchk;
                   1333: 
                   1334:       self.close()
                   1335: 
                   1336:     }
                   1337:     </script>
                   1338: INNERJS
                   1339: 
1.351     albertel 1340:     my $inner_js_highlight_central=<<INNERJS;
                   1341:  <script type="text/javascript">
                   1342:     function updateChoice(flag) {
                   1343:       opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr);
                   1344:       opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize);
                   1345:       opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle);
                   1346:       opener.document.SCORE.refresh.value = "on";
                   1347:       if (opener.document.SCORE.keywords.value!=""){
                   1348:          opener.document.SCORE.submit();
                   1349:       }
                   1350:       self.close()
                   1351:     }
                   1352: </script>
                   1353: INNERJS
                   1354: 
                   1355:     my $start_page_msg_central = 
                   1356:         &Apache::loncommon::start_page('Message Central',$inner_js_msg_central,
                   1357: 				       {'js_ready'  => 1,
                   1358: 					'only_body' => 1,
                   1359: 					'bgcolor'   =>'#FFFFFF',});
                   1360:     my $end_page_msg_central = 
                   1361: 	&Apache::loncommon::end_page({'js_ready' => 1});
                   1362: 
                   1363: 
                   1364:     my $start_page_highlight_central = 
                   1365:         &Apache::loncommon::start_page('Highlight Central',
                   1366: 				       $inner_js_highlight_central,
1.350     albertel 1367: 				       {'js_ready'  => 1,
                   1368: 					'only_body' => 1,
                   1369: 					'bgcolor'   =>'#FFFFFF',});
1.351     albertel 1370:     my $end_page_highlight_central = 
1.350     albertel 1371: 	&Apache::loncommon::end_page({'js_ready' => 1});
                   1372: 
1.219     www      1373:     my $docopen=&Apache::lonhtmlcommon::javascript_docopen();
1.236     albertel 1374:     $docopen=~s/^document\.//;
1.71      ng       1375:     $request->print(<<SUBJAVASCRIPT);
                   1376: <script type="text/javascript" language="javascript">
1.45      ng       1377: 
1.44      ng       1378: //===================== Show list of keywords ====================
1.122     ng       1379:   function keywords(formname) {
                   1380:     var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",formname.keywords.value);
1.44      ng       1381:     if (nret==null) return;
1.122     ng       1382:     formname.keywords.value = nret;
1.44      ng       1383: 
1.122     ng       1384:     if (formname.keywords.value != "") {
1.128     ng       1385: 	formname.refresh.value = "on";
1.122     ng       1386: 	formname.submit();
1.44      ng       1387:     }
                   1388:     return;
                   1389:   }
                   1390: 
                   1391: //===================== Script to view submitted by ==================
                   1392:   function viewSubmitter(submitter) {
                   1393:     document.SCORE.refresh.value = "on";
                   1394:     document.SCORE.NCT.value = "1";
                   1395:     document.SCORE.unamedom0.value = submitter;
                   1396:     document.SCORE.submit();
                   1397:     return;
                   1398:   }
                   1399: 
                   1400: //===================== Script to add keyword(s) ==================
                   1401:   function getSel() {
                   1402:     if (document.getSelection) txt = document.getSelection();
                   1403:     else if (document.selection) txt = document.selection.createRange().text;
                   1404:     else return;
                   1405:     var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," ");
                   1406:     if (cleantxt=="") {
1.46      ng       1407: 	alert("Please select a word or group of words from document and then click this link.");
1.44      ng       1408: 	return;
                   1409:     }
                   1410:     var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt);
                   1411:     if (nret==null) return;
1.127     ng       1412:     document.SCORE.keywords.value = document.SCORE.keywords.value+" "+nret;
1.44      ng       1413:     if (document.SCORE.keywords.value != "") {
1.127     ng       1414: 	document.SCORE.refresh.value = "on";
1.44      ng       1415: 	document.SCORE.submit();
                   1416:     }
                   1417:     return;
                   1418:   }
                   1419: 
                   1420: //====================== Script for composing message ==============
1.80      ng       1421:    // preload images
                   1422:    img1 = new Image();
                   1423:    img1.src = "$iconpath/mailbkgrd.gif";
                   1424:    img2 = new Image();
                   1425:    img2.src = "$iconpath/mailto.gif";
                   1426: 
1.44      ng       1427:   function msgCenter(msgform,usrctr,fullname) {
                   1428:     var Nmsg  = msgform.savemsgN.value;
                   1429:     savedMsgHeader(Nmsg,usrctr,fullname);
                   1430:     var subject = msgform.msgsub.value;
1.127     ng       1431:     var msgchk = document.SCORE["includemsg"+usrctr].value;
1.44      ng       1432:     re = /msgsub/;
                   1433:     var shwsel = "";
                   1434:     if (re.test(msgchk)) { shwsel = "checked" }
1.123     ng       1435:     subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject);
                   1436:     displaySubject(checkEntities(subject),shwsel);
1.44      ng       1437:     for (var i=1; i<=Nmsg; i++) {
1.123     ng       1438: 	var testmsg = "savemsg"+i+",";
                   1439: 	re = new RegExp(testmsg,"g");
1.44      ng       1440: 	shwsel = "";
                   1441: 	if (re.test(msgchk)) { shwsel = "checked" }
1.125     ng       1442: 	var message = document.SCORE["savemsg"+i].value;
1.126     ng       1443: 	message = (document.SCORE["shownOnce"+i].value == 0 ? checkEntities(message) : message);
1.123     ng       1444: 	displaySavedMsg(i,message,shwsel); //I do not get it. w/o checkEntities on saved messages,
                   1445: 	                                   //any &lt; is already converted to <, etc. However, only once!!
1.44      ng       1446:     }
1.125     ng       1447:     newmsg = document.SCORE["newmsg"+usrctr].value;
1.44      ng       1448:     shwsel = "";
                   1449:     re = /newmsg/;
                   1450:     if (re.test(msgchk)) { shwsel = "checked" }
                   1451:     newMsg(newmsg,shwsel);
                   1452:     msgTail(); 
                   1453:     return;
                   1454:   }
                   1455: 
1.123     ng       1456:   function checkEntities(strx) {
                   1457:     if (strx.length == 0) return strx;
                   1458:     var orgStr = ["&", "<", ">", '"']; 
                   1459:     var newStr = ["&amp;", "&lt;", "&gt;", "&quot;"];
                   1460:     var counter = 0;
                   1461:     while (counter < 4) {
                   1462: 	strx = strReplace(strx,orgStr[counter],newStr[counter]);
                   1463: 	counter++;
                   1464:     }
                   1465:     return strx;
                   1466:   }
                   1467: 
                   1468:   function strReplace(strx, orgStr, newStr) {
                   1469:     return strx.split(orgStr).join(newStr);
                   1470:   }
                   1471: 
1.44      ng       1472:   function savedMsgHeader(Nmsg,usrctr,fullname) {
1.76      ng       1473:     var height = 70*Nmsg+250;
1.44      ng       1474:     var scrollbar = "no";
                   1475:     if (height > 600) {
                   1476: 	height = 600;
                   1477: 	scrollbar = "yes";
                   1478:     }
1.118     ng       1479:     var xpos = (screen.width-600)/2;
                   1480:     xpos = (xpos < 0) ? '0' : xpos;
                   1481:     var ypos = (screen.height-height)/2-30;
                   1482:     ypos = (ypos < 0) ? '0' : ypos;
                   1483: 
1.206     albertel 1484:     pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height);
1.76      ng       1485:     pWin.focus();
                   1486:     pDoc = pWin.document;
1.219     www      1487:     pDoc.$docopen;
1.351     albertel 1488:     pDoc.write('$start_page_msg_central');
1.76      ng       1489: 
                   1490:     pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">");
                   1491:     pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">");
1.465     albertel 1492:     pDoc.write("<h3><span class=\\"LC_info\\">&nbsp;Compose Message for \"+fullname+\"<\\/span><\\/h3><br /><br />");
1.76      ng       1493: 
                   1494:     pDoc.write("<table border=0 width=100%><tr><td bgcolor=\\"#777777\\">");
                   1495:     pDoc.write("<table border=0 width=100%><tr bgcolor=\\"#ddffff\\">");
1.465     albertel 1496:     pDoc.write("<td><b>Type<\\/b><\\/td><td><b>Include<\\/b><\\/td><td><b>Message<\\/td><\\/tr>");
1.44      ng       1497: }
                   1498:     function displaySubject(msg,shwsel) {
1.76      ng       1499:     pDoc = pWin.document;
                   1500:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1501:     pDoc.write("<td>Subject<\\/td>");
                   1502:     pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1503:     pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"60\\" maxlength=\\"80\\"><\\/td><\\/tr>");
1.44      ng       1504: }
                   1505: 
1.72      ng       1506:   function displaySavedMsg(ctr,msg,shwsel) {
1.76      ng       1507:     pDoc = pWin.document;
                   1508:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1509:     pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>");
                   1510:     pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1511:     pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>");
1.44      ng       1512: }
                   1513: 
                   1514:   function newMsg(newmsg,shwsel) {
1.76      ng       1515:     pDoc = pWin.document;
                   1516:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1517:     pDoc.write("<td align=\\"center\\">New<\\/td>");
                   1518:     pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1519:     pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>");
1.44      ng       1520: }
                   1521: 
                   1522:   function msgTail() {
1.76      ng       1523:     pDoc = pWin.document;
1.465     albertel 1524:     pDoc.write("<\\/table>");
                   1525:     pDoc.write("<\\/td><\\/tr><\\/table>&nbsp;");
1.76      ng       1526:     pDoc.write("<input type=\\"button\\" value=\\"Save\\" onClick=\\"javascript:checkInput()\\">&nbsp;&nbsp;");
1.326     albertel 1527:     pDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onClick=\\"self.close()\\"><br /><br />");
1.465     albertel 1528:     pDoc.write("<\\/form>");
1.351     albertel 1529:     pDoc.write('$end_page_msg_central');
1.128     ng       1530:     pDoc.close();
1.44      ng       1531: }
                   1532: 
                   1533: //====================== Script for keyword highlight options ==============
                   1534:   function kwhighlight() {
                   1535:     var kwclr    = document.SCORE.kwclr.value;
                   1536:     var kwsize   = document.SCORE.kwsize.value;
                   1537:     var kwstyle  = document.SCORE.kwstyle.value;
                   1538:     var redsel = "";
                   1539:     var grnsel = "";
                   1540:     var blusel = "";
                   1541:     if (kwclr=="red")   {var redsel="checked"};
                   1542:     if (kwclr=="green") {var grnsel="checked"};
                   1543:     if (kwclr=="blue")  {var blusel="checked"};
                   1544:     var sznsel = "";
                   1545:     var sz1sel = "";
                   1546:     var sz2sel = "";
                   1547:     if (kwsize=="0")  {var sznsel="checked"};
                   1548:     if (kwsize=="+1") {var sz1sel="checked"};
                   1549:     if (kwsize=="+2") {var sz2sel="checked"};
                   1550:     var synsel = "";
                   1551:     var syisel = "";
                   1552:     var sybsel = "";
                   1553:     if (kwstyle=="")    {var synsel="checked"};
                   1554:     if (kwstyle=="<i>") {var syisel="checked"};
                   1555:     if (kwstyle=="<b>") {var sybsel="checked"};
                   1556:     highlightCentral();
                   1557:     highlightbody('red','red',redsel,'0','normal',sznsel,'','normal',synsel);
                   1558:     highlightbody('green','green',grnsel,'+1','+1',sz1sel,'<i>','italic',syisel);
                   1559:     highlightbody('blue','blue',blusel,'+2','+2',sz2sel,'<b>','bold',sybsel);
                   1560:     highlightend();
                   1561:     return;
                   1562:   }
                   1563: 
                   1564:   function highlightCentral() {
1.76      ng       1565: //    if (window.hwdWin) window.hwdWin.close();
1.118     ng       1566:     var xpos = (screen.width-400)/2;
                   1567:     xpos = (xpos < 0) ? '0' : xpos;
                   1568:     var ypos = (screen.height-330)/2-30;
                   1569:     ypos = (ypos < 0) ? '0' : ypos;
                   1570: 
1.206     albertel 1571:     hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos);
1.76      ng       1572:     hwdWin.focus();
                   1573:     var hDoc = hwdWin.document;
1.219     www      1574:     hDoc.$docopen;
1.351     albertel 1575:     hDoc.write('$start_page_highlight_central');
1.76      ng       1576:     hDoc.write("<form action=\\"inactive\\" name=\\"hlCenter\\">");
1.465     albertel 1577:     hDoc.write("<h3><span class=\\"LC_info\\">&nbsp;Keyword Highlight Options<\\/span><\\/h3><br /><br />");
1.76      ng       1578: 
                   1579:     hDoc.write("<table border=0 width=100%><tr><td bgcolor=\\"#777777\\">");
                   1580:     hDoc.write("<table border=0 width=100%><tr bgcolor=\\"#ddffff\\">");
1.465     albertel 1581:     hDoc.write("<td><b>Text Color<\\/b><\\/td><td><b>Font Size<\\/b><\\/td><td><b>Font Style<\\/td><\\/tr>");
1.44      ng       1582:   }
                   1583: 
                   1584:   function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) { 
1.76      ng       1585:     var hDoc = hwdWin.document;
                   1586:     hDoc.write("<tr bgcolor=\\"#ffffdd\\">");
                   1587:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1588:     hDoc.write("<input name=\\"kwdclr\\" type=\\"radio\\" value=\\""+clrval+"\\" "+clrsel+">&nbsp;"+clrtxt+"<\\/td>");
1.76      ng       1589:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1590:     hDoc.write("<input name=\\"kwdsize\\" type=\\"radio\\" value=\\""+szval+"\\" "+szsel+">&nbsp;"+sztxt+"<\\/td>");
1.76      ng       1591:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1592:     hDoc.write("<input name=\\"kwdstyle\\" type=\\"radio\\" value=\\""+syval+"\\" "+sysel+">&nbsp;"+sytxt+"<\\/td>");
                   1593:     hDoc.write("<\\/tr>");
1.44      ng       1594:   }
                   1595: 
                   1596:   function highlightend() { 
1.76      ng       1597:     var hDoc = hwdWin.document;
1.465     albertel 1598:     hDoc.write("<\\/table>");
                   1599:     hDoc.write("<\\/td><\\/tr><\\/table>&nbsp;");
1.76      ng       1600:     hDoc.write("<input type=\\"button\\" value=\\"Save\\" onClick=\\"javascript:updateChoice(1)\\">&nbsp;&nbsp;");
1.326     albertel 1601:     hDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onClick=\\"self.close()\\"><br /><br />");
1.465     albertel 1602:     hDoc.write("<\\/form>");
1.351     albertel 1603:     hDoc.write('$end_page_highlight_central');
1.128     ng       1604:     hDoc.close();
1.44      ng       1605:   }
                   1606: 
                   1607: </script>
                   1608: SUBJAVASCRIPT
                   1609: }
                   1610: 
1.349     albertel 1611: sub get_increment {
1.348     bowersj2 1612:     my $increment = $env{'form.increment'};
                   1613:     if ($increment != 1 && $increment != .5 && $increment != .25 &&
                   1614:         $increment != .1) {
                   1615:         $increment = 1;
                   1616:     }
                   1617:     return $increment;
                   1618: }
                   1619: 
1.71      ng       1620: #--- displays the grading box, used in essay type problem and grading by page/sequence
                   1621: sub gradeBox {
1.322     albertel 1622:     my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_;
1.381     albertel 1623:     my $checkIcon = '<img alt="'.&mt('Check Mark').
1.485     albertel 1624: 	'" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />';
1.71      ng       1625:     my $wgt    = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
1.466     albertel 1626:     my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)') 
                   1627:                            : '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>';
1.71      ng       1628:     $wgt       = ($wgt > 0 ? $wgt : '1');
                   1629:     my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
1.320     albertel 1630: 		  '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
1.71      ng       1631:     my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
1.466     albertel 1632:     my $display_part= &get_display_part($partid,$symb);
1.270     albertel 1633:     my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
                   1634: 				       [$partid]);
                   1635:     my $aggtries = $$record{'resource.'.$partid.'.tries'};
1.269     raeburn  1636:     if ($last_resets{$partid}) {
                   1637:         $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
                   1638:     }
1.485     albertel 1639:     $result.='<table border="0"><tr>';
1.71      ng       1640:     my $ctr = 0;
1.348     bowersj2 1641:     my $thisweight = 0;
1.349     albertel 1642:     my $increment = &get_increment();
1.485     albertel 1643: 
                   1644:     my $radio.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across
1.348     bowersj2 1645:     while ($thisweight<=$wgt) {
1.532     bisitz   1646: 	$radio.= '<td><span class="LC_nobreak"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.
1.71      ng       1647: 	    'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.
1.348     bowersj2 1648: 	    $thisweight.')" value="'.$thisweight.'" '.
1.401     albertel 1649: 	    ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n";
1.485     albertel 1650: 	$radio.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');
1.348     bowersj2 1651:         $thisweight += $increment;
1.71      ng       1652: 	$ctr++;
                   1653:     }
1.485     albertel 1654:     $radio.='</tr></table>';
                   1655: 
                   1656:     my $line.='<input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'.
1.71      ng       1657: 	($score ne ''? ' value = "'.$score.'"':'').' size="4" '.
                   1658: 	'onChange="javascript:updateRadio(this.form,\''.$counter.'_'.$partid.'\','.
                   1659: 	$wgt.')" /></td>'."\n";
1.485     albertel 1660:     $line.='<td>/'.$wgt.' '.$wgtmsg.
1.71      ng       1661: 	($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? '&nbsp;'.$checkIcon : '').
                   1662: 	' </td><td>'."\n";
1.485     albertel 1663:     $line.='<select name="GD_SEL'.$counter.'_'.$partid.'" '.
1.71      ng       1664: 	'onChange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n";
                   1665:     if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {
1.485     albertel 1666: 	$line.='<option></option>'.
                   1667: 	    '<option value="excused" selected="selected">'.&mt('excused').'</option>';
1.71      ng       1668:     } else {
1.485     albertel 1669: 	$line.='<option selected="selected"></option>'.
                   1670: 	    '<option value="excused" >'.&mt('excused').'</option>';
1.71      ng       1671:     }
1.485     albertel 1672:     $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n";
                   1673: 
                   1674: 
                   1675:     $result .= 
                   1676: 	&mt('<td><b>Part:</b></td><td>[_1]</td><td><b>Points:</b></td><td>[_2]</td><td>or</td><td>[_3]</td>',$display_part,$radio,$line);
                   1677: 
                   1678:     
                   1679:     $result.='</tr></table>'."\n";
1.71      ng       1680:     $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".
                   1681: 	'<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n".
                   1682: 	'<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'.
1.269     raeburn  1683: 	$$record{'resource.'.$partid.'.solved'}.'" />'."\n".
                   1684:         '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'.
                   1685:         $$record{'resource.'.$partid.'.tries'}.'" />'."\n".
                   1686:         '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'.
                   1687:         $aggtries.'" />'."\n";
1.323     banghart 1688:     $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record);
1.318     banghart 1689:     return $result;
                   1690: }
1.322     albertel 1691: 
                   1692: sub handback_box {
1.323     banghart 1693:     my ($symb,$uname,$udom,$counter,$partid,$record) = @_;
1.324     albertel 1694:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.323     banghart 1695:     my (@respids);
1.375     albertel 1696:      my @part_response_id = &flatten_responseType($responseType);
                   1697:     foreach my $part_response_id (@part_response_id) {
                   1698:     	my ($part,$resp) = @{ $part_response_id };
1.323     banghart 1699:         if ($part eq $partid) {
1.375     albertel 1700:             push(@respids,$resp);
1.323     banghart 1701:         }
                   1702:     }
1.318     banghart 1703:     my $result;
1.323     banghart 1704:     foreach my $respid (@respids) {
1.322     albertel 1705: 	my $prefix = $counter.'_'.$partid.'_'.$respid.'_';
                   1706: 	my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record);
                   1707: 	next if (!@$files);
                   1708: 	my $file_counter = 1;
1.313     banghart 1709: 	foreach my $file (@$files) {
1.368     banghart 1710: 	    if ($file =~ /\/portfolio\//) {
                   1711:     	        my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|);
                   1712:     	        my ($name,$version,$ext) = &file_name_version_ext($file_disp);
                   1713:     	        $file_disp = "$name.$ext";
                   1714:     	        $file = $file_path.$file_disp;
                   1715:     	        $result.=&mt('Return commented version of [_1] to student.',
                   1716:     			 '<span class="LC_filename">'.$file_disp.'</span>');
                   1717:     	        $result.='<input type="file"   name="'.$prefix.'returndoc'.$file_counter.'" />'."\n";
                   1718:     	        $result.='<input type="hidden" name="'.$prefix.'origdoc'.$file_counter.'" value="'.$file.'" /><br />';
1.485     albertel 1719:     	        $result.='('.&mt('File will be uploaded when you click on Save &amp; Next below.').')<br />';
1.368     banghart 1720:     	        $file_counter++;
                   1721: 	    }
1.322     albertel 1722: 	}
1.313     banghart 1723:     }
1.318     banghart 1724:     return $result;    
1.71      ng       1725: }
1.44      ng       1726: 
1.58      albertel 1727: sub show_problem {
1.382     albertel 1728:     my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_;
1.144     albertel 1729:     my $rendered;
1.382     albertel 1730:     my %form = ((ref($form) eq 'HASH')? %{$form} : ());
1.329     albertel 1731:     &Apache::lonxml::remember_problem_counter();
1.144     albertel 1732:     if ($mode eq 'both' or $mode eq 'text') {
                   1733: 	$rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
1.382     albertel 1734: 						       $env{'request.course.id'},
                   1735: 						       undef,\%form);
1.144     albertel 1736:     }
1.58      albertel 1737:     if ($removeform) {
                   1738: 	$rendered=~s|<form(.*?)>||g;
                   1739: 	$rendered=~s|</form>||g;
1.374     albertel 1740: 	$rendered=~s|(<input[^>]*name\s*=\s*"?)(\w+)("?)|$1would_have_been_$2$3|g;
1.58      albertel 1741:     }
1.144     albertel 1742:     my $companswer;
                   1743:     if ($mode eq 'both' or $mode eq 'answer') {
1.329     albertel 1744: 	&Apache::lonxml::restore_problem_counter();
1.382     albertel 1745: 	$companswer=
                   1746: 	    &Apache::loncommon::get_student_answers($symb,$uname,$udom,
                   1747: 						    $env{'request.course.id'},
                   1748: 						    %form);
1.144     albertel 1749:     }
1.58      albertel 1750:     if ($removeform) {
                   1751: 	$companswer=~s|<form(.*?)>||g;
                   1752: 	$companswer=~s|</form>||g;
1.144     albertel 1753: 	$companswer=~s|name="submit"|name="would_have_been_submit"|g;
1.58      albertel 1754:     }
1.468     albertel 1755:     $rendered=
                   1756: 	'<div class="LC_grade_show_problem_header">'.
                   1757: 	&mt('View of the problem').
                   1758: 	'</div><div class="LC_grade_show_problem_problem">'.
                   1759: 	$rendered.
                   1760: 	'</div>';
                   1761:     $companswer=
                   1762: 	'<div class="LC_grade_show_problem_header">'.
                   1763: 	&mt('Correct answer').
                   1764: 	'</div><div class="LC_grade_show_problem_problem">'.
                   1765: 	$companswer.
                   1766: 	'</div>';
                   1767:     my $result;
1.144     albertel 1768:     if ($mode eq 'both') {
1.468     albertel 1769: 	$result=$rendered.$companswer;
1.144     albertel 1770:     } elsif ($mode eq 'text') {
1.468     albertel 1771: 	$result=$rendered;
1.144     albertel 1772:     } elsif ($mode eq 'answer') {
1.468     albertel 1773: 	$result=$companswer;
1.144     albertel 1774:     }
1.468     albertel 1775:     $result='<div class="LC_grade_show_problem">'.$result.'</div>';
1.71      ng       1776:     return $result;
1.58      albertel 1777: }
1.397     albertel 1778: 
1.396     banghart 1779: sub files_exist {
                   1780:     my ($r, $symb) = @_;
                   1781:     my @students = &Apache::loncommon::get_env_multiple('form.stuinfo');
1.397     albertel 1782: 
1.396     banghart 1783:     foreach my $student (@students) {
                   1784:         my ($uname,$udom,$fullname) = split(/:/,$student);
1.397     albertel 1785:         my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
                   1786: 					      $udom,$uname);
1.396     banghart 1787:         my ($string,$timestamp)= &get_last_submission(\%record);
1.397     albertel 1788:         foreach my $submission (@$string) {
                   1789:             my ($partid,$respid) =
                   1790: 		($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
                   1791:             my $files=&get_submitted_files($udom,$uname,$partid,$respid,
                   1792: 					   \%record);
                   1793:             return 1 if (@$files);
1.396     banghart 1794:         }
                   1795:     }
1.397     albertel 1796:     return 0;
1.396     banghart 1797: }
1.397     albertel 1798: 
1.394     banghart 1799: sub download_all_link {
                   1800:     my ($r,$symb) = @_;
1.395     albertel 1801:     my $all_students = 
                   1802: 	join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo'));
                   1803: 
                   1804:     my $parts =
                   1805: 	join("\n",&Apache::loncommon::get_env_multiple('form.vPart'));
                   1806: 
1.394     banghart 1807:     my $identifier = &Apache::loncommon::get_cgi_id();
1.514     raeburn  1808:     &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students,
                   1809:                              'cgi.'.$identifier.'.symb' => $symb,
                   1810:                              'cgi.'.$identifier.'.parts' => $parts,});
1.395     albertel 1811:     $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'.
                   1812: 	      &mt('Download All Submitted Documents').'</a>');
1.394     banghart 1813:     return
                   1814: }
1.395     albertel 1815: 
1.432     banghart 1816: sub build_section_inputs {
                   1817:     my $section_inputs;
                   1818:     if ($env{'form.section'} eq '') {
                   1819:         $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n";
                   1820:     } else {
                   1821:         my @sections = &Apache::loncommon::get_env_multiple('form.section');
1.434     albertel 1822:         foreach my $section (@sections) {
1.432     banghart 1823:             $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n";
                   1824:         }
                   1825:     }
                   1826:     return $section_inputs;
                   1827: }
                   1828: 
1.44      ng       1829: # --------------------------- show submissions of a student, option to grade 
                   1830: sub submission {
                   1831:     my ($request,$counter,$total) = @_;
1.257     albertel 1832:     my ($uname,$udom)     = ($env{'form.student'},$env{'form.userdom'});
                   1833:     $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student?
                   1834:     my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
                   1835:     $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';
1.324     albertel 1836:     my $symb = &get_symb($request); 
                   1837:     if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
1.104     albertel 1838: 
                   1839:     if (!&canview($usec)) {
1.398     albertel 1840: 	$request->print('<span class="LC_warning">Unable to view requested student.('.
                   1841: 			$uname.':'.$udom.' in section '.$usec.' in course id '.
                   1842: 			$env{'request.course.id'}.')</span>');
1.324     albertel 1843: 	$request->print(&show_grading_menu_form($symb));
1.104     albertel 1844: 	return;
                   1845:     }
                   1846: 
1.257     albertel 1847:     if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; }
                   1848:     if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; }
                   1849:     if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; }
                   1850:     my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
1.381     albertel 1851:     my $checkIcon = '<img alt="'.&mt('Check Mark').
                   1852: 	'" src="'.$request->dir_config('lonIconsURL').
1.122     ng       1853: 	'/check.gif" height="16" border="0" />';
1.41      ng       1854: 
1.426     albertel 1855:     my %old_essays;
1.41      ng       1856:     # header info
                   1857:     if ($counter == 0) {
                   1858: 	&sub_page_js($request);
1.257     albertel 1859: 	&sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes');
                   1860: 	$env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 
                   1861: 	    &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
1.397     albertel 1862: 	if ($env{'form.handgrade'} eq 'yes' && &files_exist($request, $symb)) {
1.396     banghart 1863: 	    &download_all_link($request, $symb);
                   1864: 	}
1.485     albertel 1865: 	$request->print('<h3>&nbsp;<span class="LC_info">'.&mt('Submission Record').'</span></h3>'."\n".
                   1866: 			'<h4>&nbsp;'.&mt('<b>Resource: </b> [_1]',$env{'form.probTitle'}).'</h4>'."\n");
1.118     ng       1867: 
1.44      ng       1868: 	# option to display problem, only once else it cause problems 
                   1869:         # with the form later since the problem has a form.
1.257     albertel 1870: 	if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') {
1.144     albertel 1871: 	    my $mode;
1.257     albertel 1872: 	    if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') {
1.144     albertel 1873: 		$mode='both';
1.257     albertel 1874: 	    } elsif ($env{'form.vProb'} eq 'yes') {
1.144     albertel 1875: 		$mode='text';
1.257     albertel 1876: 	    } elsif ($env{'form.vAns'} eq 'yes') {
1.144     albertel 1877: 		$mode='answer';
                   1878: 	    }
1.329     albertel 1879: 	    &Apache::lonxml::clear_problem_counter();
1.144     albertel 1880: 	    $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));
1.41      ng       1881: 	}
1.441     www      1882: 
1.44      ng       1883: 	# kwclr is the only variable that is guaranteed to be non blank 
                   1884:         # if this subroutine has been called once.
1.41      ng       1885: 	my %keyhash = ();
1.257     albertel 1886: 	if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') {
1.41      ng       1887: 	    %keyhash = &Apache::lonnet::dump('nohist_handgrade',
1.257     albertel 1888: 					     $env{'course.'.$env{'request.course.id'}.'.domain'},
                   1889: 					     $env{'course.'.$env{'request.course.id'}.'.num'});
1.41      ng       1890: 
1.257     albertel 1891: 	    my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
                   1892: 	    $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : '';
                   1893: 	    $env{'form.kwclr'}    = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red';
                   1894: 	    $env{'form.kwsize'}   = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0';
                   1895: 	    $env{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
                   1896: 	    $env{'form.msgsub'}   = $keyhash{$symb.'_subject'} ne '' ? 
                   1897: 		$keyhash{$symb.'_subject'} : $env{'form.probTitle'};
                   1898: 	    $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0';
1.41      ng       1899: 	}
1.257     albertel 1900: 	my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'};
1.442     banghart 1901: 	my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.303     banghart 1902: 	$request->print('<form action="/adm/grades" method="post" name="SCORE" enctype="multipart/form-data">'."\n".
1.41      ng       1903: 			'<input type="hidden" name="command"    value="handgrade" />'."\n".
1.257     albertel 1904: 			'<input type="hidden" name="saveState"  value="'.$env{'form.saveState'}.'" />'."\n".
1.442     banghart 1905: 			'<input type="hidden" name="Status"     value="'.$stu_status.'" />'."\n".
1.120     ng       1906: 			'<input type="hidden" name="overRideScore" value="'.$overRideScore.'" />'."\n".
1.257     albertel 1907: 			'<input type="hidden" name="probTitle"  value="'.$env{'form.probTitle'}.'" />'."\n".
1.41      ng       1908: 			'<input type="hidden" name="refresh"    value="off" />'."\n".
1.120     ng       1909: 			'<input type="hidden" name="studentNo"  value="" />'."\n".
                   1910: 			'<input type="hidden" name="gradeOpt"   value="" />'."\n".
1.418     albertel 1911: 			'<input type="hidden" name="symb"       value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 1912: 			'<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" />'."\n".
                   1913: 			'<input type="hidden" name="vProb"      value="'.$env{'form.vProb'}.'" />'."\n".
                   1914: 			'<input type="hidden" name="vAns"       value="'.$env{'form.vAns'}.'" />'."\n".
                   1915: 			'<input type="hidden" name="lastSub"    value="'.$env{'form.lastSub'}.'" />'."\n".
1.432     banghart 1916: 			&build_section_inputs().
1.326     albertel 1917: 			'<input type="hidden" name="submitonly" value="'.$env{'form.submitonly'}.'" />'."\n".
                   1918: 			'<input type="hidden" name="handgrade"  value="'.$env{'form.handgrade'}.'" />'."\n".
1.41      ng       1919: 			'<input type="hidden" name="NCT"'.
1.257     albertel 1920: 			' value="'.($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : $total+1).'" />'."\n");
                   1921: 	if ($env{'form.handgrade'} eq 'yes') {
                   1922: 	    $request->print('<input type="hidden" name="keywords" value="'.$env{'form.keywords'}.'" />'."\n".
                   1923: 			    '<input type="hidden" name="kwclr"    value="'.$env{'form.kwclr'}.'" />'."\n".
                   1924: 			    '<input type="hidden" name="kwsize"   value="'.$env{'form.kwsize'}.'" />'."\n".
                   1925: 			    '<input type="hidden" name="kwstyle"  value="'.$env{'form.kwstyle'}.'" />'."\n".
                   1926: 			    '<input type="hidden" name="msgsub"   value="'.$env{'form.msgsub'}.'" />'."\n".
1.123     ng       1927: 			    '<input type="hidden" name="shownSub" value="0" />'."\n".
1.257     albertel 1928: 			    '<input type="hidden" name="savemsgN" value="'.$env{'form.savemsgN'}.'" />'."\n");
1.154     albertel 1929: 	    foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) {
                   1930: 		$request->print('<input type="hidden" name="vPart" value="'.$partid.'" />'."\n");
                   1931: 	    }
1.123     ng       1932: 	}
1.41      ng       1933: 	
                   1934: 	my ($cts,$prnmsg) = (1,'');
1.257     albertel 1935: 	while ($cts <= $env{'form.savemsgN'}) {
1.41      ng       1936: 	    $prnmsg.='<input type="hidden" name="savemsg'.$cts.'" value="'.
1.123     ng       1937: 		(!exists($keyhash{$symb.'_savemsg'.$cts}) ? 
1.257     albertel 1938: 		 &Apache::lonfeedback::clear_out_html($env{'form.savemsg'.$cts}) :
1.80      ng       1939: 		 &Apache::lonfeedback::clear_out_html($keyhash{$symb.'_savemsg'.$cts})).
1.123     ng       1940: 		'" />'."\n".
                   1941: 		'<input type="hidden" name="shownOnce'.$cts.'" value="0" />'."\n";
1.41      ng       1942: 	    $cts++;
                   1943: 	}
                   1944: 	$request->print($prnmsg);
1.32      ng       1945: 
1.257     albertel 1946: 	if ($env{'form.handgrade'} eq 'yes' && $env{'form.showgrading'} eq 'yes') {
1.88      www      1947: #
                   1948: # Print out the keyword options line
                   1949: #
1.41      ng       1950: 	    $request->print(<<KEYWORDS);
1.38      ng       1951: &nbsp;<b>Keyword Options:</b>&nbsp;
1.417     albertel 1952: <a href="javascript:keywords(document.SCORE);" target="_self">List</a>&nbsp; &nbsp;
1.38      ng       1953: <a href="#" onMouseDown="javascript:getSel(); return false"
                   1954:  CLASS="page">Paste Selection to List</a>&nbsp; &nbsp;
1.417     albertel 1955: <a href="javascript:kwhighlight();" target="_self">Highlight Attribute</a><br /><br />
1.38      ng       1956: KEYWORDS
1.88      www      1957: #
                   1958: # Load the other essays for similarity check
                   1959: #
1.324     albertel 1960:             my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb);
1.384     albertel 1961: 	    my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
1.359     www      1962: 	    $apath=&escape($apath);
1.88      www      1963: 	    $apath=~s/\W/\_/gs;
1.426     albertel 1964: 	    %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);
1.41      ng       1965:         }
                   1966:     }
1.44      ng       1967: 
1.441     www      1968: # This is where output for one specific student would start
1.468     albertel 1969:     my $add_class = ($counter%2) ? 'LC_grade_show_user_odd_row' : '';
1.441     www      1970:     $request->print("\n\n".
1.468     albertel 1971:                     '<div class="LC_grade_show_user '.$add_class.'">'.
                   1972: 		    '<div class="LC_grade_user_name">'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).'</div>'.
                   1973: 		    '<div class="LC_grade_show_user_body">'."\n");
1.441     www      1974: 
1.257     albertel 1975:     if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') {
1.144     albertel 1976: 	my $mode;
1.257     albertel 1977: 	if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') {
1.144     albertel 1978: 	    $mode='both';
1.257     albertel 1979: 	} elsif ($env{'form.vProb'} eq 'all' ) {
1.144     albertel 1980: 	    $mode='text';
1.257     albertel 1981: 	} elsif ($env{'form.vAns'} eq 'all') {
1.144     albertel 1982: 	    $mode='answer';
                   1983: 	}
1.329     albertel 1984: 	&Apache::lonxml::clear_problem_counter();
1.475     albertel 1985: 	$request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode,{'request.prefix' => 'ctr'.$counter}));
1.58      albertel 1986:     }
1.144     albertel 1987: 
1.257     albertel 1988:     my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.324     albertel 1989:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.41      ng       1990: 
1.44      ng       1991:     # Display student info
1.41      ng       1992:     $request->print(($counter == 0 ? '' : '<br />'));
1.468     albertel 1993:     my $result='<div class="LC_grade_submissions">';
                   1994:     
                   1995:     $result.='<div class="LC_grade_submissions_header">';
                   1996:     $result.= &mt('Submissions');
1.45      ng       1997:     $result.='<input type="hidden" name="name'.$counter.
1.257     albertel 1998: 	'" value="'.$env{'form.fullname'}.'" />'."\n";
1.469     albertel 1999:     if ($env{'form.handgrade'} eq 'no') {
                   2000: 	$result.='<span class="LC_grade_check_note">'.
                   2001: 	    &mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon)."</span>\n";
                   2002: 
                   2003:     }
                   2004: 
                   2005: 
1.41      ng       2006: 
1.118     ng       2007:     # If any part of the problem is an essay-response (handgraded), then check for collaborators
1.464     albertel 2008:     my $fullname;
                   2009:     my $col_fullnames = [];
1.257     albertel 2010:     if ($env{'form.handgrade'} eq 'yes') {
1.464     albertel 2011: 	(my $sub_result,$fullname,$col_fullnames)=
                   2012: 	    &check_collaborators($symb,$uname,$udom,\%record,$handgrade,
                   2013: 				 $counter);
                   2014: 	$result.=$sub_result;
1.41      ng       2015:     }
1.44      ng       2016:     $request->print($result."\n");
1.468     albertel 2017:     $request->print('</div>'."\n");
1.44      ng       2018:     # print student answer/submission
                   2019:     # Options are (1) Handgaded submission only
                   2020:     #             (2) Last submission, includes submission that is not handgraded 
                   2021:     #                  (for multi-response type part)
                   2022:     #             (3) Last submission plus the parts info
                   2023:     #             (4) The whole record for this student
1.257     albertel 2024:     if ($env{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) {
1.151     albertel 2025: 	my ($string,$timestamp)= &get_last_submission(\%record);
1.468     albertel 2026: 	
                   2027: 	my $lastsubonly;
                   2028: 
1.151     albertel 2029: 	if ($$timestamp eq '') {
1.468     albertel 2030: 	    $lastsubonly.='<div class="LC_grade_submissions_body">'.$$string[0].'</div>'; 
1.151     albertel 2031: 	} else {
1.468     albertel 2032: 	    $lastsubonly = '<div class="LC_grade_submissions_body"> <b>Date Submitted:</b> '.$$timestamp."\n";
                   2033: 
1.151     albertel 2034: 	    my %seenparts;
1.375     albertel 2035: 	    my @part_response_id = &flatten_responseType($responseType);
                   2036: 	    foreach my $part (@part_response_id) {
1.393     albertel 2037: 		next if ($env{'form.lastSub'} eq 'hdgrade' 
                   2038: 			 && $$handgrade{$$part[0].'_'.$$part[1]} ne 'yes');
                   2039: 
1.375     albertel 2040: 		my ($partid,$respid) = @{ $part };
1.324     albertel 2041: 		my $display_part=&get_display_part($partid,$symb);
1.257     albertel 2042: 		if ($env{"form.$uname:$udom:$partid:submitted_by"}) {
1.151     albertel 2043: 		    if (exists($seenparts{$partid})) { next; }
                   2044: 		    $seenparts{$partid}=1;
1.207     albertel 2045: 		    my $submitby='<b>Part:</b> '.$display_part.
                   2046: 			' <b>Collaborative submission by:</b> '.
1.151     albertel 2047: 			'<a href="javascript:viewSubmitter(\''.
1.257     albertel 2048: 			$env{"form.$uname:$udom:$partid:submitted_by"}.
1.417     albertel 2049: 			'\');" target="_self">'.
1.257     albertel 2050: 			$$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />';
1.151     albertel 2051: 		    $request->print($submitby);
                   2052: 		    next;
                   2053: 		}
                   2054: 		my $responsetype = $responseType->{$partid}->{$respid};
                   2055: 		if (!exists($record{"resource.$partid.$respid.submission"})) {
1.468     albertel 2056: 		    $lastsubonly.="\n".'<div class="LC_grade_submission_part"><b>Part:</b> '.
1.398     albertel 2057: 			$display_part.' <span class="LC_internal_info">( ID '.$respid.
                   2058: 			' )</span>&nbsp; &nbsp;'.
1.468     albertel 2059: 			'<span class="LC_warning">'.&mt('Nothing submitted - no attempts').'</span><br /><br /></div>';
1.151     albertel 2060: 		    next;
                   2061: 		}
1.468     albertel 2062: 		foreach my $submission (@$string) {
                   2063: 		    my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
1.375     albertel 2064: 		    if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; }
1.468     albertel 2065: 		    my ($ressub,$subval) = split(/:/,$submission,2);
1.151     albertel 2066: 		    # Similarity check
                   2067: 		    my $similar='';
1.257     albertel 2068: 		    if($env{'form.checkPlag'}){
1.151     albertel 2069: 			my ($oname,$odom,$ocrsid,$oessay,$osim)=
1.426     albertel 2070: 			    &most_similar($uname,$udom,$subval,\%old_essays);
1.151     albertel 2071: 			if ($osim) {
                   2072: 			    $osim=int($osim*100.0);
1.426     albertel 2073: 			    my %old_course_desc = 
                   2074: 				&Apache::lonnet::coursedescription($ocrsid,
                   2075: 								   {'one_time' => 1});
                   2076: 
                   2077: 			    $similar="<hr /><h3><span class=\"LC_warning\">".
1.427     albertel 2078: 				&mt('Essay is [_1]% similar to an essay by [_2] ([_3]:[_4]) in course [_5] (course id [_6]:[_7])',
1.426     albertel 2079: 				    $osim,
                   2080: 				    &Apache::loncommon::plainname($oname,$odom),
1.427     albertel 2081: 				    $oname,$odom,
1.426     albertel 2082: 				    $old_course_desc{'description'},
1.427     albertel 2083: 				    $old_course_desc{'num'},
1.426     albertel 2084: 				    $old_course_desc{'domain'}).
1.398     albertel 2085: 				'</span></h3><blockquote><i>'.
1.151     albertel 2086: 				&keywords_highlight($oessay).
                   2087: 				'</i></blockquote><hr />';
                   2088: 			}
1.150     albertel 2089: 		    }
1.151     albertel 2090: 		    my $order=&get_order($partid,$respid,$symb,$uname,$udom);
1.257     albertel 2091: 		    if ($env{'form.lastSub'} eq 'lastonly' || 
                   2092: 			($env{'form.lastSub'} eq 'hdgrade' && 
1.377     albertel 2093: 			 $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) {
1.324     albertel 2094: 			my $display_part=&get_display_part($partid,$symb);
1.468     albertel 2095: 			$lastsubonly.='<div class="LC_grade_submission_part"><b>Part:</b> '.
1.403     albertel 2096: 			    $display_part.' <span class="LC_internal_info">( ID '.$respid.
1.398     albertel 2097: 			    ' )</span>&nbsp; &nbsp;';
1.313     banghart 2098: 			my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);
                   2099: 			if (@$files) {
1.468     albertel 2100: 			    $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain virusses').'</span><br />';
1.303     banghart 2101: 			    my $file_counter = 0;
1.313     banghart 2102: 			    foreach my $file (@$files) {
1.468     albertel 2103: 			        $file_counter++;
1.232     albertel 2104: 				&Apache::lonnet::allowuploaded('/adm/grades',$file);
1.335     albertel 2105: 				$lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border=0"> '.$file.'</a>';
1.232     albertel 2106: 			    }
1.236     albertel 2107: 			    $lastsubonly.='<br />';
1.41      ng       2108: 			}
1.468     albertel 2109: 			$lastsubonly.='<b>'.&mt('Submitted Answer:').' </b>'.
1.151     albertel 2110: 			    &cleanRecord($subval,$responsetype,$symb,$partid,
                   2111: 					 $respid,\%record,$order);
                   2112: 			if ($similar) {$lastsubonly.="<br /><br />$similar\n";}
1.468     albertel 2113: 			$lastsubonly.='</div>';
1.41      ng       2114: 		    }
                   2115: 		}
                   2116: 	    }
1.468     albertel 2117: 	    $lastsubonly.='</div>'."\n";
1.151     albertel 2118: 	}
                   2119: 	$request->print($lastsubonly);
1.468     albertel 2120:    } elsif ($env{'form.lastSub'} eq 'datesub') {
1.324     albertel 2121: 	my (undef,$responseType,undef,$parts) = &showResourceInfo($symb);
1.148     albertel 2122: 	$request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom));
1.257     albertel 2123:     } elsif ($env{'form.lastSub'} =~ /^(last|all)$/) {
1.41      ng       2124: 	$request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
1.257     albertel 2125: 								 $env{'request.course.id'},
1.44      ng       2126: 								 $last,'.submission',
                   2127: 								 'Apache::grades::keywords_highlight'));
1.41      ng       2128:     }
1.120     ng       2129: 
1.121     ng       2130:     $request->print('<input type="hidden" name="unamedom'.$counter.'" value="'.$uname.':'
                   2131: 	.$udom.'" />'."\n");
1.44      ng       2132:     # return if view submission with no grading option
1.257     albertel 2133:     if ($env{'form.showgrading'} eq '' || (!&canmodify($usec))) {
1.120     ng       2134: 	my $toGrade.='<input type="button" value="Grade Student" '.
1.121     ng       2135: 	    'onClick="javascript:checksubmit(this.form,\'Grade Student\',\''
1.417     albertel 2136: 	    .$counter.'\');" target="_self" /> &nbsp;'."\n" if (&canmodify($usec));
1.468     albertel 2137: 	$toGrade.='</div>'."\n";
1.257     albertel 2138: 	if (($env{'form.command'} eq 'submission') || 
                   2139: 	    ($env{'form.command'} eq 'processGroup' && $counter == $total)) {
1.324     albertel 2140: 	    $toGrade.='</form>'.&show_grading_menu_form($symb); 
1.169     albertel 2141: 	}
1.180     albertel 2142: 	$request->print($toGrade);
1.41      ng       2143: 	return;
1.180     albertel 2144:     } else {
1.468     albertel 2145: 	$request->print('</div>'."\n");
1.41      ng       2146:     }
1.33      ng       2147: 
1.121     ng       2148:     # essay grading message center
1.257     albertel 2149:     if ($env{'form.handgrade'} eq 'yes') {
1.468     albertel 2150: 	my $result='<div class="LC_grade_message_center">';
                   2151:     
                   2152: 	$result.='<div class="LC_grade_message_center_header">'.
                   2153: 	    &mt('Send Message').'</div><div class="LC_grade_message_center_body">';
1.257     albertel 2154: 	my ($lastname,$givenn) = split(/,/,$env{'form.fullname'});
1.118     ng       2155: 	my $msgfor = $givenn.' '.$lastname;
1.464     albertel 2156: 	if (scalar(@$col_fullnames) > 0) {
                   2157: 	    my $lastone = pop(@$col_fullnames);
                   2158: 	    $msgfor .= ', '.(join ', ',@$col_fullnames).' and '.$lastone.'.';
1.118     ng       2159: 	}
                   2160: 	$msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript
1.468     albertel 2161: 	$result.='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n".
1.121     ng       2162: 	    '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n";
                   2163: 	$result.='&nbsp;<a href="javascript:msgCenter(document.SCORE,'.$counter.
1.417     albertel 2164: 	    ',\''.$msgfor.'\');" target="_self">'.
1.464     albertel 2165: 	    &mt('Compose message to student').(scalar(@$col_fullnames) >= 1 ? 's' : '').'</a><label> ('.
1.350     albertel 2166: 	    &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'.
1.118     ng       2167: 	    '<img src="'.$request->dir_config('lonIconsURL').
                   2168: 	    '/mailbkgrd.gif" width="14" height="10" name="mailicon'.$counter.'" />'."\n".
1.298     www      2169: 	    '<br />&nbsp;('.
1.468     albertel 2170: 	    &mt('Message will be sent when you click on Save &amp; Next below.').")\n";
                   2171: 	$result.='</div></div>';
1.121     ng       2172: 	$request->print($result);
1.118     ng       2173:     }
1.41      ng       2174: 
                   2175:     my %seen = ();
                   2176:     my @partlist;
1.129     ng       2177:     my @gradePartRespid;
1.375     albertel 2178:     my @part_response_id = &flatten_responseType($responseType);
1.468     albertel 2179:     $request->print('<div class="LC_grade_assign">'.
                   2180: 		    
                   2181: 		    '<div class="LC_grade_assign_header">'.
                   2182: 		    &mt('Assign Grades').'</div>'.
                   2183: 		    '<div class="LC_grade_assign_body">');
1.375     albertel 2184:     foreach my $part_response_id (@part_response_id) {
                   2185:     	my ($partid,$respid) = @{ $part_response_id };
                   2186: 	my $part_resp = join('_',@{ $part_response_id });
1.322     albertel 2187: 	next if ($seen{$partid} > 0);
1.41      ng       2188: 	$seen{$partid}++;
1.393     albertel 2189: 	next if ($$handgrade{$part_resp} ne 'yes' 
                   2190: 		 && $env{'form.lastSub'} eq 'hdgrade');
1.524     raeburn  2191: 	push(@partlist,$partid);
                   2192: 	push(@gradePartRespid,$partid.'.'.$respid);
1.322     albertel 2193: 	$request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
1.41      ng       2194:     }
1.468     albertel 2195:     $request->print('</div></div>');
                   2196: 
                   2197:     $request->print('<div class="LC_grade_info_links">');
                   2198:     if ($perm{'vgr'}) {
                   2199: 	$request->print(
                   2200: 	    &Apache::loncommon::track_student_link(&mt('View recent activity'),
                   2201: 						   $uname,$udom,'check'));
                   2202:     }
                   2203:     if ($perm{'opa'}) {
                   2204: 	$request->print(
                   2205: 	    &Apache::loncommon::pprmlink(&mt('Set/Change parameters'),
                   2206: 					 $uname,$udom,$symb,'check'));
                   2207:     }
                   2208:     $request->print('</div>');
                   2209: 
1.45      ng       2210:     $result='<input type="hidden" name="partlist'.$counter.
                   2211: 	'" value="'.(join ":",@partlist).'" />'."\n";
1.129     ng       2212:     $result.='<input type="hidden" name="gradePartRespid'.
                   2213: 	'" value="'.(join ":",@gradePartRespid).'" />'."\n" if ($counter == 0);
1.45      ng       2214:     my $ctr = 0;
                   2215:     while ($ctr < scalar(@partlist)) {
                   2216: 	$result.='<input type="hidden" name="partid'.$counter.'_'.$ctr.'" value="'.
                   2217: 	    $partlist[$ctr].'" />'."\n";
                   2218: 	$ctr++;
                   2219:     }
1.468     albertel 2220:     $request->print($result.''."\n");
1.41      ng       2221: 
1.441     www      2222: # Done with printing info for one student
                   2223: 
1.468     albertel 2224:     $request->print('</div>');#LC_grade_show_user_body
                   2225:     $request->print('</div>');#LC_grade_show_user
1.441     www      2226: 
                   2227: 
1.41      ng       2228:     # print end of form
                   2229:     if ($counter == $total) {
1.297     www      2230: 	my $endform='<table border="0"><tr><td>'."\n";
1.485     albertel 2231: 	$endform.='<input type="button" value="'.&mt('Save &amp; Next').'" '.
1.119     ng       2232: 	    'onClick="javascript:checksubmit(this.form,\'Save & Next\','.
1.417     albertel 2233: 	    $total.','.scalar(@partlist).');" target="_self" /> &nbsp;'."\n";
1.119     ng       2234: 	my $ntstu ='<select name="NTSTU">'.
                   2235: 	    '<option>1</option><option>2</option>'.
                   2236: 	    '<option>3</option><option>5</option>'.
                   2237: 	    '<option>7</option><option>10</option></select>'."\n";
1.257     albertel 2238: 	my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1');
1.401     albertel 2239: 	$ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</;
1.485     albertel 2240: 	$endform.=&mt('[_1]student(s)',$ntstu);
                   2241: 	$endform.='&nbsp;&nbsp;<input type="button" value="'.&mt('Previous').'" '.
1.417     albertel 2242: 	    'onClick="javascript:checksubmit(this.form,\'Previous\');" target="_self" /> &nbsp;'."\n".
1.485     albertel 2243: 	    '<input type="button" value="'.&mt('Next').'" '.
1.417     albertel 2244: 	    'onClick="javascript:checksubmit(this.form,\'Next\');" target="_self" /> &nbsp;';
1.485     albertel 2245: 	$endform.=&mt('(Next and Previous (student) do not save the scores.)')."\n" ;
1.349     albertel 2246:         $endform.="<input type='hidden' value='".&get_increment().
1.348     bowersj2 2247:             "' name='increment' />";
1.485     albertel 2248: 	$endform.='</td></tr></table></form>';
1.324     albertel 2249: 	$endform.=&show_grading_menu_form($symb);
1.41      ng       2250: 	$request->print($endform);
                   2251:     }
                   2252:     return '';
1.38      ng       2253: }
                   2254: 
1.464     albertel 2255: sub check_collaborators {
                   2256:     my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_;
                   2257:     my ($result,@col_fullnames);
                   2258:     my ($classlist,undef,$fullname) = &getclasslist('all','0');
                   2259:     foreach my $part (keys(%$handgrade)) {
                   2260: 	my $ncol = &Apache::lonnet::EXT('resource.'.$part.
                   2261: 					'.maxcollaborators',
                   2262: 					$symb,$udom,$uname);
                   2263: 	next if ($ncol <= 0);
                   2264: 	$part =~ s/\_/\./g;
                   2265: 	next if ($record->{'resource.'.$part.'.collaborators'} eq '');
                   2266: 	my (@good_collaborators, @bad_collaborators);
                   2267: 	foreach my $possible_collaborator
                   2268: 	    (split(/,?\s+/,$record->{'resource.'.$part.'.collaborators'})) { 
                   2269: 	    $possible_collaborator =~ s/[\$\^\(\)]//g;
                   2270: 	    next if ($possible_collaborator eq '');
                   2271: 	    my ($co_name,$co_dom) = split(/\@|:/,$possible_collaborator);
                   2272: 	    $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i);
                   2273: 	    next if ($co_name eq $uname && $co_dom eq $udom);
                   2274: 	    # Doing this grep allows 'fuzzy' specification
                   2275: 	    my @matches = grep(/^\Q$co_name\E:\Q$co_dom\E$/i, 
                   2276: 			       keys(%$classlist));
                   2277: 	    if (! scalar(@matches)) {
                   2278: 		push(@bad_collaborators, $possible_collaborator);
                   2279: 	    } else {
                   2280: 		push(@good_collaborators, @matches);
                   2281: 	    }
                   2282: 	}
                   2283: 	if (scalar(@good_collaborators) != 0) {
1.466     albertel 2284: 	    $result.='<br />'.&mt('Collaborators: ');
1.464     albertel 2285: 	    foreach my $name (@good_collaborators) {
                   2286: 		my ($lastname,$givenn) = split(/,/,$$fullname{$name});
                   2287: 		push(@col_fullnames, $givenn.' '.$lastname);
                   2288: 		$result.=$fullname->{$name}.'&nbsp; &nbsp; &nbsp;';
                   2289: 	    }
                   2290: 	    $result.='<br />'."\n";
1.466     albertel 2291: 	    my ($part)=split(/\./,$part);
1.464     albertel 2292: 	    $result.='<input type="hidden" name="collaborator'.$counter.
                   2293: 		'" value="'.$part.':'.(join ':',@good_collaborators).'" />'.
                   2294: 		"\n";
                   2295: 	}
                   2296: 	if (scalar(@bad_collaborators) > 0) {
1.466     albertel 2297: 	    $result.='<div class="LC_warning">';
1.464     albertel 2298: 	    $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators));
                   2299: 	    $result .= '</div>';
                   2300: 	}         
                   2301: 	if (scalar(@bad_collaborators > $ncol)) {
1.466     albertel 2302: 	    $result .= '<div class="LC_warning">';
1.464     albertel 2303: 	    $result .= &mt('This student has submitted too many '.
                   2304: 		'collaborators.  Maximum is [_1].',$ncol);
                   2305: 	    $result .= '</div>';
                   2306: 	}
                   2307:     }
                   2308:     return ($result,$fullname,\@col_fullnames);
                   2309: }
                   2310: 
1.44      ng       2311: #--- Retrieve the last submission for all the parts
1.38      ng       2312: sub get_last_submission {
1.119     ng       2313:     my ($returnhash)=@_;
1.46      ng       2314:     my (@string,$timestamp);
1.119     ng       2315:     if ($$returnhash{'version'}) {
1.46      ng       2316: 	my %lasthash=();
                   2317: 	my ($version);
1.119     ng       2318: 	for ($version=1;$version<=$$returnhash{'version'};$version++) {
1.397     albertel 2319: 	    foreach my $key (sort(split(/\:/,
                   2320: 					$$returnhash{$version.':keys'}))) {
                   2321: 		$lasthash{$key}=$$returnhash{$version.':'.$key};
                   2322: 		$timestamp = 
                   2323: 		    scalar(localtime($$returnhash{$version.':timestamp'}));
1.46      ng       2324: 	    }
                   2325: 	}
1.397     albertel 2326: 	foreach my $key (keys(%lasthash)) {
                   2327: 	    next if ($key !~ /\.submission$/);
                   2328: 
                   2329: 	    my ($partid,$foo) = split(/submission$/,$key);
                   2330: 	    my $draft  = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?
1.398     albertel 2331: 		'<span class="LC_warning">Draft Copy</span> ' : '';
1.397     albertel 2332: 	    push(@string, join(':', $key, $draft.$lasthash{$key}));
1.41      ng       2333: 	}
                   2334:     }
1.397     albertel 2335:     if (!@string) {
                   2336: 	$string[0] =
1.398     albertel 2337: 	    '<span class="LC_warning">Nothing submitted - no attempts.</span>';
1.397     albertel 2338:     }
                   2339:     return (\@string,\$timestamp);
1.38      ng       2340: }
1.35      ng       2341: 
1.44      ng       2342: #--- High light keywords, with style choosen by user.
1.38      ng       2343: sub keywords_highlight {
1.44      ng       2344:     my $string    = shift;
1.257     albertel 2345:     my $size      = $env{'form.kwsize'} eq '0' ? '' : 'size='.$env{'form.kwsize'};
                   2346:     my $styleon   = $env{'form.kwstyle'} eq ''  ? '' : $env{'form.kwstyle'};
1.41      ng       2347:     (my $styleoff = $styleon) =~ s/\</\<\//;
1.257     albertel 2348:     my @keylist   = split(/[,\s+]/,$env{'form.keywords'});
1.398     albertel 2349:     foreach my $keyword (@keylist) {
                   2350: 	$string =~ s/\b\Q$keyword\E(\b|\.)/<font color\=$env{'form.kwclr'} $size\>$styleon$keyword$styleoff<\/font>/gi;
1.41      ng       2351:     }
                   2352:     return $string;
1.38      ng       2353: }
1.36      ng       2354: 
1.44      ng       2355: #--- Called from submission routine
1.38      ng       2356: sub processHandGrade {
1.41      ng       2357:     my ($request) = shift;
1.324     albertel 2358:     my $symb   = &get_symb($request);
                   2359:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.257     albertel 2360:     my $button = $env{'form.gradeOpt'};
                   2361:     my $ngrade = $env{'form.NCT'};
                   2362:     my $ntstu  = $env{'form.NTSTU'};
1.301     albertel 2363:     my $cdom   = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2364:     my $cnum   = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2365: 
1.44      ng       2366:     if ($button eq 'Save & Next') {
                   2367: 	my $ctr = 0;
                   2368: 	while ($ctr < $ngrade) {
1.257     albertel 2369: 	    my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr});
1.324     albertel 2370: 	    my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$symb,$uname,$udom,$ctr);
1.71      ng       2371: 	    if ($errorflag eq 'no_score') {
                   2372: 		$ctr++;
                   2373: 		next;
                   2374: 	    }
1.104     albertel 2375: 	    if ($errorflag eq 'not_allowed') {
1.398     albertel 2376: 		$request->print("<span class=\"LC_warning\">Not allowed to modify grades for $uname:$udom</span>");
1.104     albertel 2377: 		$ctr++;
                   2378: 		next;
                   2379: 	    }
1.257     albertel 2380: 	    my $includemsg = $env{'form.includemsg'.$ctr};
1.44      ng       2381: 	    my ($subject,$message,$msgstatus) = ('','','');
1.418     albertel 2382: 	    my $restitle = &Apache::lonnet::gettitle($symb);
                   2383:             my ($feedurl,$showsymb) =
                   2384: 		&get_feedurl_and_symb($symb,$uname,$udom);
                   2385: 	    my $messagetail;
1.62      albertel 2386: 	    if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
1.298     www      2387: 		$subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/);
1.295     www      2388: 		unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); }
1.386     raeburn  2389: 		$subject.=' ['.$restitle.']';
1.44      ng       2390: 		my (@msgnum) = split(/,/,$includemsg);
                   2391: 		foreach (@msgnum) {
1.257     albertel 2392: 		    $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne '');
1.44      ng       2393: 		}
1.80      ng       2394: 		$message =&Apache::lonfeedback::clear_out_html($message);
1.298     www      2395: 		if ($env{'form.withgrades'.$ctr}) {
                   2396: 		    $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt;
1.386     raeburn  2397: 		    $messagetail = " for <a href=\"".
1.418     albertel 2398: 		                   $feedurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
1.386     raeburn  2399: 		}
                   2400: 		$msgstatus = 
                   2401:                     &Apache::lonmsg::user_normal_msg($uname,$udom,$subject,
                   2402: 						     $message.$messagetail,
1.418     albertel 2403:                                                      undef,$feedurl,undef,
1.386     raeburn  2404:                                                      undef,undef,$showsymb,
                   2405:                                                      $restitle);
                   2406: 		$request->print('<br />'.&mt('Sending message to [_1]:[_2]',$uname,$udom).': '.
1.296     www      2407: 				$msgstatus);
1.44      ng       2408: 	    }
1.257     albertel 2409: 	    if ($env{'form.collaborator'.$ctr}) {
1.155     albertel 2410: 		my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr");
1.150     albertel 2411: 		foreach my $collabstr (@collabstrs) {
                   2412: 		    my ($part,@collaborators) = split(/:/,$collabstr);
1.310     banghart 2413: 		    foreach my $collaborator (@collaborators) {
1.150     albertel 2414: 			my ($errorflag,$pts,$wgt) = 
1.324     albertel 2415: 			    &saveHandGrade($request,$symb,$collaborator,$udom,$ctr,
1.257     albertel 2416: 					   $env{'form.unamedom'.$ctr},$part);
1.150     albertel 2417: 			if ($errorflag eq 'not_allowed') {
1.362     albertel 2418: 			    $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>");
1.150     albertel 2419: 			    next;
1.418     albertel 2420: 			} elsif ($message ne '') {
                   2421: 			    my ($baseurl,$showsymb) = 
                   2422: 				&get_feedurl_and_symb($symb,$collaborator,
                   2423: 						      $udom);
                   2424: 			    if ($env{'form.withgrades'.$ctr}) {
                   2425: 				$messagetail = " for <a href=\"".
1.386     raeburn  2426:                                     $baseurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
1.150     albertel 2427: 			    }
1.418     albertel 2428: 			    $msgstatus = 
                   2429: 				&Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle);
1.104     albertel 2430: 			}
1.44      ng       2431: 		    }
                   2432: 		}
                   2433: 	    }
                   2434: 	    $ctr++;
                   2435: 	}
                   2436:     }
                   2437: 
1.257     albertel 2438:     if ($env{'form.handgrade'} eq 'yes') {
1.119     ng       2439: 	# Keywords sorted in alphabatical order
1.257     albertel 2440: 	my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
1.119     ng       2441: 	my %keyhash = ();
1.257     albertel 2442: 	$env{'form.keywords'}           =~ s/,\s{0,}|\s+/ /g;
                   2443: 	$env{'form.keywords'}           =~ s/^\s+|\s+$//;
                   2444: 	my (@keywords) = sort(split(/\s+/,$env{'form.keywords'}));
                   2445: 	$env{'form.keywords'} = join(' ',@keywords);
                   2446: 	$keyhash{$symb.'_keywords'}     = $env{'form.keywords'};
                   2447: 	$keyhash{$symb.'_subject'}      = $env{'form.msgsub'};
                   2448: 	$keyhash{$loginuser.'_kwclr'}   = $env{'form.kwclr'};
                   2449: 	$keyhash{$loginuser.'_kwsize'}  = $env{'form.kwsize'};
                   2450: 	$keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'};
1.119     ng       2451: 
                   2452: 	# message center - Order of message gets changed. Blank line is eliminated.
1.257     albertel 2453: 	# New messages are saved in env for the next student.
1.119     ng       2454: 	# All messages are saved in nohist_handgrade.db
                   2455: 	my ($ctr,$idx) = (1,1);
1.257     albertel 2456: 	while ($ctr <= $env{'form.savemsgN'}) {
                   2457: 	    if ($env{'form.savemsg'.$ctr} ne '') {
                   2458: 		$keyhash{$symb.'_savemsg'.$idx} = $env{'form.savemsg'.$ctr};
1.119     ng       2459: 		$idx++;
                   2460: 	    }
                   2461: 	    $ctr++;
1.41      ng       2462: 	}
1.119     ng       2463: 	$ctr = 0;
                   2464: 	while ($ctr < $ngrade) {
1.257     albertel 2465: 	    if ($env{'form.newmsg'.$ctr} ne '') {
                   2466: 		$keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr};
                   2467: 		$env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr};
1.119     ng       2468: 		$idx++;
                   2469: 	    }
                   2470: 	    $ctr++;
1.41      ng       2471: 	}
1.257     albertel 2472: 	$env{'form.savemsgN'} = --$idx;
                   2473: 	$keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'};
1.119     ng       2474: 	my $putresult = &Apache::lonnet::put
1.301     albertel 2475: 	    ('nohist_handgrade',\%keyhash,$cdom,$cnum);
1.41      ng       2476:     }
1.44      ng       2477:     # Called by Save & Refresh from Highlight Attribute Window
1.257     albertel 2478:     my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');
                   2479:     if ($env{'form.refresh'} eq 'on') {
1.86      ng       2480: 	my ($ctr,$total) = (0,0);
                   2481: 	while ($ctr < $ngrade) {
1.257     albertel 2482: 	    $total++ if  $env{'form.unamedom'.$ctr} ne '';
1.86      ng       2483: 	    $ctr++;
                   2484: 	}
1.257     albertel 2485: 	$env{'form.NTSTU'}=$ngrade;
1.86      ng       2486: 	$ctr = 0;
                   2487: 	while ($ctr < $total) {
1.257     albertel 2488: 	    my $processUser = $env{'form.unamedom'.$ctr};
                   2489: 	    ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser);
                   2490: 	    $env{'form.fullname'} = $$fullname{$processUser};
1.86      ng       2491: 	    &submission($request,$ctr,$total-1);
1.41      ng       2492: 	    $ctr++;
                   2493: 	}
                   2494: 	return '';
                   2495:     }
1.36      ng       2496: 
1.121     ng       2497: # Go directly to grade student - from submission or link from chart page
1.120     ng       2498:     if ($button eq 'Grade Student') {
1.324     albertel 2499: 	(undef,undef,$env{'form.handgrade'},undef,undef) = &showResourceInfo($symb);
1.257     albertel 2500: 	my $processUser = $env{'form.unamedom'.$env{'form.studentNo'}};
                   2501: 	($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser);
                   2502: 	$env{'form.fullname'} = $$fullname{$processUser};
1.120     ng       2503: 	&submission($request,0,0);
                   2504: 	return '';
                   2505:     }
                   2506: 
1.44      ng       2507:     # Get the next/previous one or group of students
1.257     albertel 2508:     my $firststu = $env{'form.unamedom0'};
                   2509:     my $laststu = $env{'form.unamedom'.($ngrade-1)};
1.119     ng       2510:     my $ctr = 2;
1.41      ng       2511:     while ($laststu eq '') {
1.257     albertel 2512: 	$laststu  = $env{'form.unamedom'.($ngrade-$ctr)};
1.41      ng       2513: 	$ctr++;
                   2514: 	$laststu = $firststu if ($ctr > $ngrade);
                   2515:     }
1.44      ng       2516: 
1.41      ng       2517:     my (@parsedlist,@nextlist);
                   2518:     my ($nextflg) = 0;
1.524     raeburn  2519:     foreach my $item (sort 
1.294     albertel 2520: 	     {
                   2521: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   2522: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   2523: 		 }
                   2524: 		 return $a cmp $b;
                   2525: 	     } (keys(%$fullname))) {
1.41      ng       2526: 	if ($nextflg == 1 && $button =~ /Next$/) {
1.524     raeburn  2527: 	    push(@parsedlist,$item);
1.41      ng       2528: 	}
1.524     raeburn  2529: 	$nextflg = 1 if ($item eq $laststu);
1.41      ng       2530: 	if ($button eq 'Previous') {
1.524     raeburn  2531: 	    last if ($item eq $firststu);
                   2532: 	    push(@parsedlist,$item);
1.41      ng       2533: 	}
                   2534:     }
                   2535:     $ctr = 0;
                   2536:     @parsedlist = reverse @parsedlist if ($button eq 'Previous');
1.324     albertel 2537:     my ($partlist) = &response_type($symb);
1.41      ng       2538:     foreach my $student (@parsedlist) {
1.257     albertel 2539: 	my $submitonly=$env{'form.submitonly'};
1.41      ng       2540: 	my ($uname,$udom) = split(/:/,$student);
1.301     albertel 2541: 	
                   2542: 	if ($submitonly eq 'queued') {
                   2543: 	    my %queue_status = 
                   2544: 		&Apache::bridgetask::get_student_status($symb,$cdom,$cnum,
                   2545: 							$udom,$uname);
                   2546: 	    next if (!defined($queue_status{'gradingqueue'}));
                   2547: 	}
                   2548: 
1.156     albertel 2549: 	if ($submitonly =~ /^(yes|graded|incorrect)$/) {
1.257     albertel 2550: #	    my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.324     albertel 2551: 	    my %status=&student_gradeStatus($symb,$udom,$uname,$partlist);
1.145     albertel 2552: 	    my $submitted = 0;
1.248     albertel 2553: 	    my $ungraded = 0;
                   2554: 	    my $incorrect = 0;
1.524     raeburn  2555: 	    foreach my $item (keys(%status)) {
                   2556: 		$submitted = 1 if ($status{$item} ne 'nothing');
                   2557: 		$ungraded = 1 if ($status{$item} =~ /^ungraded/);
                   2558: 		$incorrect = 1 if ($status{$item} =~ /^incorrect/);
                   2559: 		my ($foo,$partid,$foo1) = split(/\./,$item);
1.145     albertel 2560: 		if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
                   2561: 		    $submitted = 0;
                   2562: 		}
1.41      ng       2563: 	    }
1.156     albertel 2564: 	    next if (!$submitted && ($submitonly eq 'yes' ||
                   2565: 				     $submitonly eq 'incorrect' ||
                   2566: 				     $submitonly eq 'graded'));
1.248     albertel 2567: 	    next if (!$ungraded && ($submitonly eq 'graded'));
                   2568: 	    next if (!$incorrect && $submitonly eq 'incorrect');
1.41      ng       2569: 	}
1.524     raeburn  2570: 	push(@nextlist,$student) if ($ctr < $ntstu);
1.129     ng       2571: 	last if ($ctr == $ntstu);
1.41      ng       2572: 	$ctr++;
                   2573:     }
1.36      ng       2574: 
1.41      ng       2575:     $ctr = 0;
                   2576:     my $total = scalar(@nextlist)-1;
1.39      ng       2577: 
1.524     raeburn  2578:     foreach (sort(@nextlist)) {
1.41      ng       2579: 	my ($uname,$udom,$submitter) = split(/:/);
1.257     albertel 2580: 	$env{'form.student'}  = $uname;
                   2581: 	$env{'form.userdom'}  = $udom;
                   2582: 	$env{'form.fullname'} = $$fullname{$_};
1.41      ng       2583: 	&submission($request,$ctr,$total);
                   2584: 	$ctr++;
                   2585:     }
                   2586:     if ($total < 0) {
1.485     albertel 2587: 	my $the_end = '<h3><span class="LC_info">'.&mt('LON-CAPA User Message').'</span></h3><br />'."\n";
                   2588: 	$the_end.=&mt('<b>Message: </b> No more students for this section or class.').'<br /><br />'."\n";
                   2589: 	$the_end.=&mt('Click on the button below to return to the grading menu.').'<br /><br />'."\n";
1.324     albertel 2590: 	$the_end.=&show_grading_menu_form($symb);
1.41      ng       2591: 	$request->print($the_end);
                   2592:     }
                   2593:     return '';
1.38      ng       2594: }
1.36      ng       2595: 
1.44      ng       2596: #---- Save the score and award for each student, if changed
1.38      ng       2597: sub saveHandGrade {
1.324     albertel 2598:     my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_;
1.342     banghart 2599:     my @version_parts;
1.104     albertel 2600:     my $usec = &Apache::lonnet::getsection($domain,$stuname,
1.257     albertel 2601: 					   $env{'request.course.id'});
1.104     albertel 2602:     if (!&canmodify($usec)) { return('not_allowed'); }
1.337     banghart 2603:     my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);
1.251     banghart 2604:     my @parts_graded;
1.77      ng       2605:     my %newrecord  = ();
                   2606:     my ($pts,$wgt) = ('','');
1.269     raeburn  2607:     my %aggregate = ();
                   2608:     my $aggregateflag = 0;
1.301     albertel 2609:     my @parts = split(/:/,$env{'form.partlist'.$newflg});
                   2610:     foreach my $new_part (@parts) {
1.337     banghart 2611: 	#collaborator ($submi may vary for different parts
1.259     banghart 2612: 	if ($submitter && $new_part ne $part) { next; }
                   2613: 	my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};
1.125     ng       2614: 	if ($dropMenu eq 'excused') {
1.259     banghart 2615: 	    if ($record{'resource.'.$new_part.'.solved'} ne 'excused') {
                   2616: 		$newrecord{'resource.'.$new_part.'.solved'} = 'excused';
                   2617: 		if (exists($record{'resource.'.$new_part.'.awarded'})) {
                   2618: 		    $newrecord{'resource.'.$new_part.'.awarded'} = '';
1.58      albertel 2619: 		}
1.364     banghart 2620: 	        $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
1.58      albertel 2621: 	    }
1.125     ng       2622: 	} elsif ($dropMenu eq 'reset status'
1.259     banghart 2623: 		 && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts
1.524     raeburn  2624: 	    foreach my $key (keys(%record)) {
1.259     banghart 2625: 		if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; }
1.197     albertel 2626: 	    }
1.259     banghart 2627: 	    $newrecord{'resource.'.$new_part.'.regrader'}=
1.257     albertel 2628: 		"$env{'user.name'}:$env{'user.domain'}";
1.270     albertel 2629:             my $totaltries = $record{'resource.'.$part.'.tries'};
                   2630: 
                   2631:             my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
                   2632: 					       [$new_part]);
                   2633:             my $aggtries =$totaltries;
1.269     raeburn  2634:             if ($last_resets{$new_part}) {
1.270     albertel 2635:                 $aggtries = &get_num_tries(\%record,$last_resets{$new_part},
                   2636: 					   $new_part);
1.269     raeburn  2637:             }
1.270     albertel 2638: 
                   2639:             my $solvedstatus = $record{'resource.'.$new_part.'.solved'};
1.269     raeburn  2640:             if ($aggtries > 0) {
1.327     albertel 2641:                 &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus);
1.269     raeburn  2642:                 $aggregateflag = 1;
                   2643:             }
1.125     ng       2644: 	} elsif ($dropMenu eq '') {
1.259     banghart 2645: 	    $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 
                   2646: 		    $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 
                   2647: 		    $env{'form.RADVAL'.$newflg.'_'.$new_part});
                   2648: 	    if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$new_part} eq '') {
1.153     albertel 2649: 		next;
                   2650: 	    }
1.259     banghart 2651: 	    $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : 
                   2652: 		$env{'form.WGT'.$newflg.'_'.$new_part};
1.41      ng       2653: 	    my $partial= $pts/$wgt;
1.259     banghart 2654: 	    if ($partial eq $record{'resource.'.$new_part.'.awarded'}) {
1.153     albertel 2655: 		#do not update score for part if not changed.
1.346     banghart 2656:                 &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
1.153     albertel 2657: 		next;
1.251     banghart 2658: 	    } else {
1.524     raeburn  2659: 	        push(@parts_graded,$new_part);
1.153     albertel 2660: 	    }
1.259     banghart 2661: 	    if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {
                   2662: 		$newrecord{'resource.'.$new_part.'.awarded'}  = $partial;
1.153     albertel 2663: 	    }
1.259     banghart 2664: 	    my $reckey = 'resource.'.$new_part.'.solved';
1.41      ng       2665: 	    if ($partial == 0) {
1.153     albertel 2666: 		if ($record{$reckey} ne 'incorrect_by_override') {
                   2667: 		    $newrecord{$reckey} = 'incorrect_by_override';
                   2668: 		}
1.41      ng       2669: 	    } else {
1.153     albertel 2670: 		if ($record{$reckey} ne 'correct_by_override') {
                   2671: 		    $newrecord{$reckey} = 'correct_by_override';
                   2672: 		}
                   2673: 	    }	    
                   2674: 	    if ($submitter && 
1.259     banghart 2675: 		($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) {
                   2676: 		$newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter;
1.41      ng       2677: 	    }
1.259     banghart 2678: 	    $newrecord{'resource.'.$new_part.'.regrader'}=
1.257     albertel 2679: 		"$env{'user.name'}:$env{'user.domain'}";
1.41      ng       2680: 	}
1.259     banghart 2681: 	# unless problem has been graded, set flag to version the submitted files
1.305     banghart 2682: 	unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/  || 
                   2683: 	        $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||
                   2684: 	        $dropMenu eq 'reset status')
                   2685: 	   {
1.524     raeburn  2686: 	    push(@version_parts,$new_part);
1.259     banghart 2687: 	}
1.41      ng       2688:     }
1.301     albertel 2689:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2690:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2691: 
1.344     albertel 2692:     if (%newrecord) {
                   2693:         if (@version_parts) {
1.364     banghart 2694:             my @changed_keys = &version_portfiles(\%record, \@parts_graded, 
                   2695:                                 $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts);
1.344     albertel 2696: 	    @newrecord{@changed_keys} = @record{@changed_keys};
1.367     albertel 2697: 	    foreach my $new_part (@version_parts) {
                   2698: 		&handback_files($request,$symb,$stuname,$domain,$newflg,
                   2699: 				$new_part,\%newrecord);
                   2700: 	    }
1.259     banghart 2701:         }
1.44      ng       2702: 	&Apache::lonnet::cstore(\%newrecord,$symb,
1.257     albertel 2703: 				$env{'request.course.id'},$domain,$stuname);
1.380     albertel 2704: 	&check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb,
                   2705: 				     $cdom,$cnum,$domain,$stuname);
1.41      ng       2706:     }
1.269     raeburn  2707:     if ($aggregateflag) {
                   2708:         &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
1.301     albertel 2709: 			      $cdom,$cnum);
1.269     raeburn  2710:     }
1.301     albertel 2711:     return ('',$pts,$wgt);
1.36      ng       2712: }
1.322     albertel 2713: 
1.380     albertel 2714: sub check_and_remove_from_queue {
                   2715:     my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_;
                   2716:     my @ungraded_parts;
                   2717:     foreach my $part (@{$parts}) {
                   2718: 	if (    $record->{   'resource.'.$part.'.awarded'} eq ''
                   2719: 	     && $record->{   'resource.'.$part.'.solved' } ne 'excused'
                   2720: 	     && $newrecord->{'resource.'.$part.'.awarded'} eq ''
                   2721: 	     && $newrecord->{'resource.'.$part.'.solved' } ne 'excused'
                   2722: 		) {
                   2723: 	    push(@ungraded_parts, $part);
                   2724: 	}
                   2725:     }
                   2726:     if ( !@ungraded_parts ) {
                   2727: 	&Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,
                   2728: 					       $cnum,$domain,$stuname);
                   2729:     }
                   2730: }
                   2731: 
1.337     banghart 2732: sub handback_files {
                   2733:     my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
1.517     raeburn  2734:     my $portfolio_root = '/userfiles/portfolio';
1.359     www      2735:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.375     albertel 2736: 
                   2737:     my @part_response_id = &flatten_responseType($responseType);
                   2738:     foreach my $part_response_id (@part_response_id) {
                   2739:     	my ($part_id,$resp_id) = @{ $part_response_id };
                   2740: 	my $part_resp = join('_',@{ $part_response_id });
1.337     banghart 2741:             if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) {
                   2742:                 # if multiple files are uploaded names will be 'returndoc2','returndoc3'
                   2743:                 my $file_counter = 1;
1.367     albertel 2744: 		my $file_msg;
1.337     banghart 2745:                 while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {
                   2746:                     my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};
1.338     banghart 2747:                     my ($directory,$answer_file) = 
                   2748:                         ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/);
                   2749:                     my ($answer_name,$answer_ver,$answer_ext) =
                   2750: 		        &file_name_version_ext($answer_file);
1.355     banghart 2751: 		    my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
1.517     raeburn  2752:                     my $getpropath = 1;
                   2753: 		    my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath);
1.338     banghart 2754: 		    my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
1.355     banghart 2755:                     # fix file name
                   2756:                     my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
                   2757:                     my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,
                   2758:             	                                $newflg.'_'.$part_resp.'_returndoc'.$file_counter,
                   2759:             	                                $save_file_name);
1.337     banghart 2760:                     if ($result !~ m|^/uploaded/|) {
1.401     albertel 2761:                         $request->print('<span class="LC_error">An error occurred ('.$result.
1.398     albertel 2762:                         ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'</span><br />');
1.356     banghart 2763:                     } else {
1.360     banghart 2764:                         # mark the file as read only
                   2765:                         my @files = ($save_file_name);
1.372     albertel 2766:                         my @what = ($symb,$env{'request.course.id'},'handback');
1.360     banghart 2767:                         &Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what);
1.367     albertel 2768: 			if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) {
                   2769: 			    $$newrecord{"resource.$new_part.$resp_id.handback"}.=',';
                   2770: 			}
                   2771:                         $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name;
                   2772: 			$file_msg.= "\n".'<br /><span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span><br />";
                   2773: 
1.337     banghart 2774:                     }
                   2775:                     $request->print("<br />".$fname." will be the uploaded file name");
1.354     albertel 2776:                     $request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter});
1.337     banghart 2777:                     $file_counter++;
                   2778:                 }
1.367     albertel 2779: 		my $subject = "File Handed Back by Instructor ";
                   2780: 		my $message = "A file has been returned that was originally submitted in reponse to: <br />";
                   2781: 		$message .= "<strong>".&Apache::lonnet::gettitle($symb)."</strong><br />";
                   2782: 		$message .= ' The returned file(s) are named: '. $file_msg;
                   2783: 		$message .= " and can be found in your portfolio space.";
1.418     albertel 2784: 		my ($feedurl,$showsymb) = 
                   2785: 		    &get_feedurl_and_symb($symb,$domain,$stuname);
1.386     raeburn  2786:                 my $restitle = &Apache::lonnet::gettitle($symb);
                   2787: 		my $msgstatus = 
                   2788:                    &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject.
                   2789: 			 ' (File Returned) ['.$restitle.']',$message,undef,
1.418     albertel 2790:                          $feedurl,undef,undef,undef,$showsymb,$restitle);
1.337     banghart 2791:             }
                   2792:         }
1.338     banghart 2793:     return;
1.337     banghart 2794: }
                   2795: 
1.418     albertel 2796: sub get_feedurl_and_symb {
                   2797:     my ($symb,$uname,$udom) = @_;
                   2798:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
                   2799:     $url = &Apache::lonnet::clutter($url);
                   2800:     my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl',
                   2801: 					$symb,$udom,$uname);
                   2802:     if ($encrypturl =~ /^yes$/i) {
                   2803: 	&Apache::lonenc::encrypted(\$url,1);
                   2804: 	&Apache::lonenc::encrypted(\$symb,1);
                   2805:     }
                   2806:     return ($url,$symb);
                   2807: }
                   2808: 
1.313     banghart 2809: sub get_submitted_files {
                   2810:     my ($udom,$uname,$partid,$respid,$record) = @_;
                   2811:     my @files;
                   2812:     if ($$record{"resource.$partid.$respid.portfiles"}) {
                   2813:         my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio';
                   2814:         foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) {
                   2815:     	    push(@files,$file_url.$file);
                   2816:         }
                   2817:     }
                   2818:     if ($$record{"resource.$partid.$respid.uploadedurl"}) {
                   2819:         push(@files,$$record{"resource.$partid.$respid.uploadedurl"});
                   2820:     }
                   2821:     return (\@files);
                   2822: }
1.322     albertel 2823: 
1.269     raeburn  2824: # ----------- Provides number of tries since last reset.
                   2825: sub get_num_tries {
                   2826:     my ($record,$last_reset,$part) = @_;
                   2827:     my $timestamp = '';
                   2828:     my $num_tries = 0;
                   2829:     if ($$record{'version'}) {
                   2830:         for (my $version=$$record{'version'};$version>=1;$version--) {
                   2831:             if (exists($$record{$version.':resource.'.$part.'.solved'})) {
                   2832:                 $timestamp = $$record{$version.':timestamp'};
                   2833:                 if ($timestamp > $last_reset) {
                   2834:                     $num_tries ++;
                   2835:                 } else {
                   2836:                     last;
                   2837:                 }
                   2838:             }
                   2839:         }
                   2840:     }
                   2841:     return $num_tries;
                   2842: }
                   2843: 
                   2844: # ----------- Determine decrements required in aggregate totals 
                   2845: sub decrement_aggs {
                   2846:     my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_;
                   2847:     my %decrement = (
                   2848:                         attempts => 0,
                   2849:                         users => 0,
                   2850:                         correct => 0
                   2851:                     );
                   2852:     $decrement{'attempts'} = $aggtries;
                   2853:     if ($solvedstatus =~ /^correct/) {
                   2854:         $decrement{'correct'} = 1;
                   2855:     }
                   2856:     if ($aggtries == $totaltries) {
                   2857:         $decrement{'users'} = 1;
                   2858:     }
1.524     raeburn  2859:     foreach my $type (keys(%decrement)) {
1.269     raeburn  2860:         $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type};
                   2861:     }
                   2862:     return;
                   2863: }
                   2864: 
                   2865: # ----------- Determine timestamps for last reset of aggregate totals for parts  
                   2866: sub get_last_resets {
1.270     albertel 2867:     my ($symb,$courseid,$partids) =@_;
                   2868:     my %last_resets;
1.269     raeburn  2869:     my $cdom = $env{'course.'.$courseid.'.domain'};
                   2870:     my $cname = $env{'course.'.$courseid.'.num'};
1.271     albertel 2871:     my @keys;
                   2872:     foreach my $part (@{$partids}) {
                   2873: 	push(@keys,"$symb\0$part\0resettime");
                   2874:     }
                   2875:     my %results=&Apache::lonnet::get('nohist_resourcetracker',\@keys,
                   2876: 				     $cdom,$cname);
                   2877:     foreach my $part (@{$partids}) {
                   2878: 	$last_resets{$part}=$results{"$symb\0$part\0resettime"};
1.269     raeburn  2879:     }
1.270     albertel 2880:     return %last_resets;
1.269     raeburn  2881: }
                   2882: 
1.251     banghart 2883: # ----------- Handles creating versions for portfolio files as answers
                   2884: sub version_portfiles {
1.343     banghart 2885:     my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_;
1.263     banghart 2886:     my $version_parts = join('|',@$v_flag);
1.343     banghart 2887:     my @returned_keys;
1.255     banghart 2888:     my $parts = join('|', @$parts_graded);
1.517     raeburn  2889:     my $portfolio_root = '/userfiles/portfolio';
1.277     albertel 2890:     foreach my $key (keys(%$record)) {
1.259     banghart 2891:         my $new_portfiles;
1.263     banghart 2892:         if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {
1.342     banghart 2893:             my @versioned_portfiles;
1.367     albertel 2894:             my @portfiles = split(/\s*,\s*/,$$record{$key});
1.252     banghart 2895:             foreach my $file (@portfiles) {
1.306     banghart 2896:                 &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file);
1.304     albertel 2897:                 my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
                   2898: 		my ($answer_name,$answer_ver,$answer_ext) =
                   2899: 		    &file_name_version_ext($answer_file);
1.517     raeburn  2900:                 my $getpropath = 1;    
                   2901:                 my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath);
1.342     banghart 2902:                 my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
1.306     banghart 2903:                 my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
                   2904:                 if ($new_answer ne 'problem getting file') {
1.342     banghart 2905:                     push(@versioned_portfiles, $directory.$new_answer);
1.306     banghart 2906:                     &Apache::lonnet::mark_as_readonly($domain,$stu_name,
1.367     albertel 2907:                         [$directory.$new_answer],
1.306     banghart 2908:                         [$symb,$env{'request.course.id'},'graded']);
1.259     banghart 2909:                 }
1.252     banghart 2910:             }
1.343     banghart 2911:             $$record{$key} = join(',',@versioned_portfiles);
                   2912:             push(@returned_keys,$key);
1.251     banghart 2913:         }
                   2914:     } 
1.343     banghart 2915:     return (@returned_keys);   
1.305     banghart 2916: }
                   2917: 
1.307     banghart 2918: sub get_next_version {
1.341     banghart 2919:     my ($answer_name, $answer_ext, $dir_list) = @_;
1.307     banghart 2920:     my $version;
                   2921:     foreach my $row (@$dir_list) {
                   2922:         my ($file) = split(/\&/,$row,2);
                   2923:         my ($file_name,$file_version,$file_ext) =
                   2924: 	    &file_name_version_ext($file);
                   2925:         if (($file_name eq $answer_name) && 
                   2926: 	    ($file_ext eq $answer_ext)) {
                   2927:                 # gets here if filename and extension match, regardless of version
                   2928:                 if ($file_version ne '') {
                   2929:                 # a versioned file is found  so save it for later
                   2930:                 if ($file_version > $version) {
                   2931: 		    $version = $file_version;
                   2932: 	        }
                   2933:             }
                   2934:         }
                   2935:     } 
                   2936:     $version ++;
                   2937:     return($version);
                   2938: }
                   2939: 
1.305     banghart 2940: sub version_selected_portfile {
1.306     banghart 2941:     my ($domain,$stu_name,$directory,$file_name,$version) = @_;
                   2942:     my ($answer_name,$answer_ver,$answer_ext) =
                   2943:         &file_name_version_ext($file_name);
                   2944:     my $new_answer;
                   2945:     $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name");
                   2946:     if($env{'form.copy'} eq '-1') {
                   2947:         $new_answer = 'problem getting file';
                   2948:     } else {
                   2949:         $new_answer = $answer_name.'.'.$version.'.'.$answer_ext;
                   2950:         my $copy_result = &Apache::lonnet::finishuserfileupload(
                   2951:                             $stu_name,$domain,'copy',
                   2952: 		        '/portfolio'.$directory.$new_answer);
                   2953:     }    
                   2954:     return ($new_answer);
1.251     banghart 2955: }
                   2956: 
1.304     albertel 2957: sub file_name_version_ext {
                   2958:     my ($file)=@_;
                   2959:     my @file_parts = split(/\./, $file);
                   2960:     my ($name,$version,$ext);
                   2961:     if (@file_parts > 1) {
                   2962: 	$ext=pop(@file_parts);
                   2963: 	if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) {
                   2964: 	    $version=pop(@file_parts);
                   2965: 	}
                   2966: 	$name=join('.',@file_parts);
                   2967:     } else {
                   2968: 	$name=join('.',@file_parts);
                   2969:     }
                   2970:     return($name,$version,$ext);
                   2971: }
                   2972: 
1.44      ng       2973: #--------------------------------------------------------------------------------------
                   2974: #
                   2975: #-------------------------- Next few routines handles grading by section or whole class
                   2976: #
                   2977: #--- Javascript to handle grading by section or whole class
1.42      ng       2978: sub viewgrades_js {
                   2979:     my ($request) = shift;
                   2980: 
1.41      ng       2981:     $request->print(<<VIEWJAVASCRIPT);
                   2982: <script type="text/javascript" language="javascript">
1.45      ng       2983:    function writePoint(partid,weight,point) {
1.125     ng       2984: 	var radioButton = document.classgrade["RADVAL_"+partid];
                   2985: 	var textbox = document.classgrade["TEXTVAL_"+partid];
1.42      ng       2986: 	if (point == "textval") {
1.125     ng       2987: 	    point = document.classgrade["TEXTVAL_"+partid].value;
1.109     matthew  2988: 	    if (isNaN(point) || parseFloat(point) < 0) {
                   2989: 		alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point));
1.42      ng       2990: 		var resetbox = false;
                   2991: 		for (var i=0; i<radioButton.length; i++) {
                   2992: 		    if (radioButton[i].checked) {
                   2993: 			textbox.value = i;
                   2994: 			resetbox = true;
                   2995: 		    }
                   2996: 		}
                   2997: 		if (!resetbox) {
                   2998: 		    textbox.value = "";
                   2999: 		}
                   3000: 		return;
                   3001: 	    }
1.109     matthew  3002: 	    if (parseFloat(point) > parseFloat(weight)) {
                   3003: 		var resp = confirm("You entered a value ("+parseFloat(point)+
1.44      ng       3004: 				   ") greater than the weight for the part. Accept?");
                   3005: 		if (resp == false) {
                   3006: 		    textbox.value = "";
                   3007: 		    return;
                   3008: 		}
                   3009: 	    }
1.42      ng       3010: 	    for (var i=0; i<radioButton.length; i++) {
                   3011: 		radioButton[i].checked=false;
1.109     matthew  3012: 		if (parseFloat(point) == i) {
1.42      ng       3013: 		    radioButton[i].checked=true;
                   3014: 		}
                   3015: 	    }
1.41      ng       3016: 
1.42      ng       3017: 	} else {
1.125     ng       3018: 	    textbox.value = parseFloat(point);
1.42      ng       3019: 	}
1.41      ng       3020: 	for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3021: 	    var user = document.classgrade["ctr"+i].value;
1.289     albertel 3022: 	    user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3023: 	    var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3024: 	    var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3025: 	    var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.42      ng       3026: 	    if (saveval != "correct") {
                   3027: 		scorename.value = point;
1.43      ng       3028: 		if (selname[0].selected != true) {
                   3029: 		    selname[0].selected = true;
                   3030: 		}
1.42      ng       3031: 	    }
                   3032: 	}
1.125     ng       3033: 	document.classgrade["SELVAL_"+partid][0].selected = true;
1.42      ng       3034:     }
                   3035: 
                   3036:     function writeRadText(partid,weight) {
1.125     ng       3037: 	var selval   = document.classgrade["SELVAL_"+partid];
                   3038: 	var radioButton = document.classgrade["RADVAL_"+partid];
1.265     www      3039:         var override = document.classgrade["FORCE_"+partid].checked;
1.125     ng       3040: 	var textbox = document.classgrade["TEXTVAL_"+partid];
                   3041: 	if (selval[1].selected || selval[2].selected) {
1.42      ng       3042: 	    for (var i=0; i<radioButton.length; i++) {
                   3043: 		radioButton[i].checked=false;
                   3044: 
                   3045: 	    }
                   3046: 	    textbox.value = "";
                   3047: 
                   3048: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3049: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3050: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3051: 		var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3052: 		var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3053: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.265     www      3054: 		if ((saveval != "correct") || override) {
1.42      ng       3055: 		    scorename.value = "";
1.125     ng       3056: 		    if (selval[1].selected) {
                   3057: 			selname[1].selected = true;
                   3058: 		    } else {
                   3059: 			selname[2].selected = true;
                   3060: 			if (Number(document.classgrade["GD_"+user+"_"+partid+"_tries"].value)) 
                   3061: 			{document.classgrade["GD_"+user+"_"+partid+"_tries"].value = '0';}
                   3062: 		    }
1.42      ng       3063: 		}
                   3064: 	    }
1.43      ng       3065: 	} else {
                   3066: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3067: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3068: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3069: 		var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3070: 		var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3071: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.265     www      3072: 		if ((saveval != "correct") || override) {
1.125     ng       3073: 		    scorename.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value;
1.43      ng       3074: 		    selname[0].selected = true;
                   3075: 		}
                   3076: 	    }
                   3077: 	}	    
1.42      ng       3078:     }
                   3079: 
                   3080:     function changeSelect(partid,user) {
1.125     ng       3081: 	var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"];
                   3082: 	var textbox = document.classgrade["GD_"+user+'_'+partid+"_awarded"];
1.44      ng       3083: 	var point  = textbox.value;
1.125     ng       3084: 	var weight = document.classgrade["weight_"+partid].value;
1.44      ng       3085: 
1.109     matthew  3086: 	if (isNaN(point) || parseFloat(point) < 0) {
                   3087: 	    alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point));
1.44      ng       3088: 	    textbox.value = "";
                   3089: 	    return;
                   3090: 	}
1.109     matthew  3091: 	if (parseFloat(point) > parseFloat(weight)) {
                   3092: 	    var resp = confirm("You entered a value ("+parseFloat(point)+
1.44      ng       3093: 			       ") greater than the weight of the part. Accept?");
                   3094: 	    if (resp == false) {
                   3095: 		textbox.value = "";
                   3096: 		return;
                   3097: 	    }
                   3098: 	}
1.42      ng       3099: 	selval[0].selected = true;
                   3100:     }
                   3101: 
                   3102:     function changeOneScore(partid,user) {
1.125     ng       3103: 	var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"];
                   3104: 	if (selval[1].selected || selval[2].selected) {
                   3105: 	    document.classgrade["GD_"+user+'_'+partid+"_awarded"].value = "";
                   3106: 	    if (selval[2].selected) {
                   3107: 		document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0";
                   3108: 	    }
1.269     raeburn  3109:         }
1.42      ng       3110:     }
                   3111: 
                   3112:     function resetEntry(numpart) {
                   3113: 	for (ctpart=0;ctpart<numpart;ctpart++) {
1.125     ng       3114: 	    var partid = document.classgrade["partid_"+ctpart].value;
                   3115: 	    var radioButton = document.classgrade["RADVAL_"+partid];
                   3116: 	    var textbox = document.classgrade["TEXTVAL_"+partid];
                   3117: 	    var selval  = document.classgrade["SELVAL_"+partid];
1.42      ng       3118: 	    for (var i=0; i<radioButton.length; i++) {
                   3119: 		radioButton[i].checked=false;
                   3120: 
                   3121: 	    }
                   3122: 	    textbox.value = "";
                   3123: 	    selval[0].selected = true;
                   3124: 
                   3125: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3126: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3127: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3128: 		var resetscore = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3129: 		resetscore.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value;
                   3130: 		var resettries = document.classgrade["GD_"+user+"_"+partid+"_tries"];
                   3131: 		resettries.value = document.classgrade["GD_"+user+"_"+partid+"_tries_s"].value;
                   3132: 		var saveselval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3133: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.42      ng       3134: 		if (saveselval == "excused") {
1.43      ng       3135: 		    if (selname[1].selected == false) { selname[1].selected = true;}
1.42      ng       3136: 		} else {
1.43      ng       3137: 		    if (selname[0].selected == false) {selname[0].selected = true};
1.42      ng       3138: 		}
                   3139: 	    }
1.41      ng       3140: 	}
1.42      ng       3141:     }
                   3142: 
1.41      ng       3143: </script>
                   3144: VIEWJAVASCRIPT
1.42      ng       3145: }
                   3146: 
1.44      ng       3147: #--- show scores for a section or whole class w/ option to change/update a score
1.42      ng       3148: sub viewgrades {
                   3149:     my ($request) = shift;
                   3150:     &viewgrades_js($request);
1.41      ng       3151: 
1.324     albertel 3152:     my ($symb) = &get_symb($request);
1.168     albertel 3153:     #need to make sure we have the correct data for later EXT calls, 
                   3154:     #thus invalidate the cache
                   3155:     &Apache::lonnet::devalidatecourseresdata(
1.257     albertel 3156:                  $env{'course.'.$env{'request.course.id'}.'.num'},
                   3157:                  $env{'course.'.$env{'request.course.id'}.'.domain'});
1.168     albertel 3158:     &Apache::lonnet::clear_EXT_cache_status();
                   3159: 
1.398     albertel 3160:     my $result='<h3><span class="LC_info">'.&mt('Manual Grading').'</span></h3>';
1.485     albertel 3161:     $result.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4>'."\n";
1.41      ng       3162: 
                   3163:     #view individual student submission form - called using Javascript viewOneStudent
1.324     albertel 3164:     $result.=&jscriptNform($symb);
1.41      ng       3165: 
1.44      ng       3166:     #beginning of class grading form
1.442     banghart 3167:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.41      ng       3168:     $result.= '<form action="/adm/grades" method="post" name="classgrade">'."\n".
1.418     albertel 3169: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.38      ng       3170: 	'<input type="hidden" name="command" value="editgrades" />'."\n".
1.432     banghart 3171: 	&build_section_inputs().
1.257     albertel 3172: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
1.442     banghart 3173: 	'<input type="hidden" name="Status" value="'.$env{'stu_status'}.'" />'."\n".
1.257     albertel 3174: 	'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
1.72      ng       3175: 
1.126     ng       3176:     my $sectionClass;
1.430     banghart 3177:     my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
1.257     albertel 3178:     if ($env{'form.section'} eq 'all') {
1.485     albertel 3179: 	$sectionClass='Class';
1.257     albertel 3180:     } elsif ($env{'form.section'} eq 'none') {
1.485     albertel 3181: 	$sectionClass='Students in no Section';
1.52      albertel 3182:     } else {
1.485     albertel 3183: 	$sectionClass='Students in Section(s) [_1]';
1.52      albertel 3184:     }
1.485     albertel 3185:     $result.=
                   3186: 	'<h3>'.
                   3187: 	&mt("Assign Common Grade To $sectionClass",$section_display).'</h3>';
1.474     albertel 3188:     $result.= &Apache::loncommon::start_data_table();
1.44      ng       3189:     #radio buttons/text box for assigning points for a section or class.
                   3190:     #handles different parts of a problem
1.375     albertel 3191:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.42      ng       3192:     my %weight = ();
                   3193:     my $ctsparts = 0;
1.45      ng       3194:     my %seen = ();
1.375     albertel 3195:     my @part_response_id = &flatten_responseType($responseType);
                   3196:     foreach my $part_response_id (@part_response_id) {
                   3197:     	my ($partid,$respid) = @{ $part_response_id };
                   3198: 	my $part_resp = join('_',@{ $part_response_id });
1.45      ng       3199: 	next if $seen{$partid};
                   3200: 	$seen{$partid}++;
1.375     albertel 3201: 	my $handgrade=$$handgrade{$part_resp};
1.42      ng       3202: 	my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);
                   3203: 	$weight{$partid} = $wgt eq '' ? '1' : $wgt;
                   3204: 
1.324     albertel 3205: 	my $display_part=&get_display_part($partid,$symb);
1.485     albertel 3206: 	my $radio.='<table border="0"><tr>';  
1.41      ng       3207: 	my $ctr = 0;
1.42      ng       3208: 	while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across
1.485     albertel 3209: 	    $radio.= '<td><label><input type="radio" name="RADVAL_'.$partid.'" '.
1.54      albertel 3210: 		'onclick="javascript:writePoint(\''.$partid.'\','.$weight{$partid}.
1.288     albertel 3211: 		','.$ctr.')" />'.$ctr."</label></td>\n";
1.41      ng       3212: 	    $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');
                   3213: 	    $ctr++;
                   3214: 	}
1.485     albertel 3215: 	$radio.='</tr></table>';
                   3216: 	my $line = '<input type="text" name="TEXTVAL_'.
1.54      albertel 3217: 	    $partid.'" size="4" '.'onChange="javascript:writePoint(\''.
                   3218: 		$partid.'\','.$weight{$partid}.',\'textval\')" /> /'.
1.42      ng       3219: 	    $weight{$partid}.' (problem weight)</td>'."\n";
1.485     albertel 3220: 	$line.= '<td><select name="SELVAL_'.$partid.'"'.
1.54      albertel 3221: 	    'onChange="javascript:writeRadText(\''.$partid.'\','.
1.59      albertel 3222: 		$weight{$partid}.')"> '.
1.401     albertel 3223: 	    '<option selected="selected"> </option>'.
1.485     albertel 3224: 	    '<option value="excused">'.&mt('excused').'</option>'.
                   3225: 	    '<option value="reset status">'.&mt('reset status').'</option>'.
                   3226: 	    '</select></td>'.
                   3227:             '<td><label><input type="checkbox" name="FORCE_'.$partid.'" />'.&mt('Override "Correct"').'</label>';
                   3228: 	$line.='<input type="hidden" name="partid_'.
                   3229: 	    $ctsparts.'" value="'.$partid.'" />'."\n";
                   3230: 	$line.='<input type="hidden" name="weight_'.
                   3231: 	    $partid.'" value="'.$weight{$partid}.'" />'."\n";
                   3232: 
                   3233: 	$result.=
                   3234: 	    &Apache::loncommon::start_data_table_row()."\n".
                   3235: 	    &mt('<td><b>Part:</b></td><td>[_1]</td><td><b>Points:</b></td><td>[_2]</td><td>or</td><td>[_3]</td>',$display_part,$radio,$line).
                   3236: 	    &Apache::loncommon::end_data_table_row()."\n";
1.42      ng       3237: 	$ctsparts++;
1.41      ng       3238:     }
1.474     albertel 3239:     $result.=&Apache::loncommon::end_data_table()."\n".
1.52      albertel 3240: 	'<input type="hidden" name="totalparts" value="'.$ctsparts.'" />';
1.485     albertel 3241:     $result.='<input type="button" value="'.&mt('Revert to Default').'" '.
1.474     albertel 3242: 	'onClick="javascript:resetEntry('.$ctsparts.');" />';
1.41      ng       3243: 
1.44      ng       3244:     #table listing all the students in a section/class
                   3245:     #header of table
1.485     albertel 3246:     $result.= '<h3>'.&mt('Assign Grade to Specific Students in '.$sectionClass,
                   3247: 			 $section_display).'</h3>';
1.474     albertel 3248:     $result.= &Apache::loncommon::start_data_table().
                   3249: 	&Apache::loncommon::start_data_table_header_row().
1.485     albertel 3250: 	'<th>'.&mt('No.').'</th>'.
1.474     albertel 3251: 	'<th>'.&nameUserString('header')."</th>\n";
1.324     albertel 3252:     my (@parts) = sort(&getpartlist($symb));
                   3253:     my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
1.269     raeburn  3254:     my @partids = ();
1.41      ng       3255:     foreach my $part (@parts) {
                   3256: 	my $display=&Apache::lonnet::metadata($url,$part.'.display');
1.126     ng       3257: 	$display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower
1.41      ng       3258: 	if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
1.207     albertel 3259: 	my ($partid) = &split_part_type($part);
1.524     raeburn  3260:         push(@partids,$partid);
1.324     albertel 3261: 	my $display_part=&get_display_part($partid,$symb);
1.41      ng       3262: 	if ($display =~ /^Partial Credit Factor/) {
1.485     albertel 3263: 	    $result.='<th>'.
                   3264: 		&mt('Score Part: [_1]<br /> (weight = [_2])',
                   3265: 		    $display_part,$weight{$partid}).'</th>'."\n";
1.41      ng       3266: 	    next;
1.485     albertel 3267: 	    
1.207     albertel 3268: 	} else {
1.485     albertel 3269: 	    if ($display =~ /Problem Status/) {
                   3270: 		my $grade_status_mt = &mt('Grade Status');
                   3271: 		$display =~ s{Problem Status}{$grade_status_mt<br />};
                   3272: 	    }
                   3273: 	    my $part_mt = &mt('Part:');
                   3274: 	    $display =~s{\[Part: \Q$partid\E\]}{$part_mt $display_part};
1.41      ng       3275: 	}
1.485     albertel 3276: 
1.474     albertel 3277: 	$result.='<th>'.$display.'</th>'."\n";
1.41      ng       3278:     }
1.474     albertel 3279:     $result.=&Apache::loncommon::end_data_table_header_row();
1.44      ng       3280: 
1.270     albertel 3281:     my %last_resets = 
                   3282: 	&get_last_resets($symb,$env{'request.course.id'},\@partids);
1.269     raeburn  3283: 
1.41      ng       3284:     #get info for each student
1.44      ng       3285:     #list all the students - with points and grade status
1.257     albertel 3286:     my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');
1.41      ng       3287:     my $ctr = 0;
1.294     albertel 3288:     foreach (sort 
                   3289: 	     {
                   3290: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   3291: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   3292: 		 }
                   3293: 		 return $a cmp $b;
                   3294: 	     } (keys(%$fullname))) {
1.126     ng       3295: 	$ctr++;
1.324     albertel 3296: 	$result.=&viewstudentgrade($symb,$env{'request.course.id'},
1.269     raeburn  3297: 				   $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets);
1.41      ng       3298:     }
1.474     albertel 3299:     $result.=&Apache::loncommon::end_data_table();
1.41      ng       3300:     $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n";
1.485     albertel 3301:     $result.='<input type="button" value="'.&mt('Save').'" '.
1.417     albertel 3302: 	'onClick="javascript:submit();" target="_self" /></form>'."\n";
1.96      albertel 3303:     if (scalar(%$fullname) eq 0) {
                   3304: 	my $colspan=3+scalar(@parts);
1.433     banghart 3305: 	my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
1.442     banghart 3306:         my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status'));
1.433     banghart 3307: 	$result='<span class="LC_warning">'.
1.485     albertel 3308: 	    &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.',
1.442     banghart 3309: 	        $section_display, $stu_status).
1.433     banghart 3310: 	    '</span>';
1.96      albertel 3311:     }
1.324     albertel 3312:     $result.=&show_grading_menu_form($symb);
1.41      ng       3313:     return $result;
                   3314: }
                   3315: 
1.44      ng       3316: #--- call by previous routine to display each student
1.41      ng       3317: sub viewstudentgrade {
1.324     albertel 3318:     my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_;
1.44      ng       3319:     my ($uname,$udom) = split(/:/,$student);
                   3320:     my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
1.269     raeburn  3321:     my %aggregates = (); 
1.474     albertel 3322:     my $result=&Apache::loncommon::start_data_table_row().'<td align="right">'.
1.233     albertel 3323: 	'<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.
                   3324: 	"\n".$ctr.'&nbsp;</td><td>&nbsp;'.
1.44      ng       3325: 	'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
1.417     albertel 3326: 	'\');" target="_self">'.$fullname.'</a> '.
1.398     albertel 3327: 	'<span class="LC_internal_info">('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')</span></td>'."\n";
1.281     albertel 3328:     $student=~s/:/_/; # colon doen't work in javascript for names
1.63      albertel 3329:     foreach my $apart (@$parts) {
                   3330: 	my ($part,$type) = &split_part_type($apart);
1.41      ng       3331: 	my $score=$record{"resource.$part.$type"};
1.276     albertel 3332:         $result.='<td align="center">';
1.269     raeburn  3333:         my ($aggtries,$totaltries);
                   3334:         unless (exists($aggregates{$part})) {
1.270     albertel 3335: 	    $totaltries = $record{'resource.'.$part.'.tries'};
                   3336: 
                   3337: 	    $aggtries = $totaltries;
1.269     raeburn  3338:             if ($$last_resets{$part}) {  
1.270     albertel 3339:                 $aggtries = &get_num_tries(\%record,$$last_resets{$part},
                   3340: 					   $part);
                   3341:             }
1.269     raeburn  3342:             $result.='<input type="hidden" name="'.
                   3343:                 'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n";
                   3344:             $result.='<input type="hidden" name="'.
                   3345:                 'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n";
                   3346:             $aggregates{$part} = 1;
                   3347:         }
1.41      ng       3348: 	if ($type eq 'awarded') {
1.320     albertel 3349: 	    my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part});
1.42      ng       3350: 	    $result.='<input type="hidden" name="'.
1.89      albertel 3351: 		'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
1.233     albertel 3352: 	    $result.='<input type="text" name="'.
1.89      albertel 3353: 		'GD_'.$student.'_'.$part.'_awarded" '.
                   3354: 		'onChange="javascript:changeSelect(\''.$part.'\',\''.$student.
1.44      ng       3355: 		'\')" value="'.$pts.'" size="4" /></td>'."\n";
1.41      ng       3356: 	} elsif ($type eq 'solved') {
                   3357: 	    my ($status,$foo)=split(/_/,$score,2);
                   3358: 	    $status = 'nothing' if ($status eq '');
1.89      albertel 3359: 	    $result.='<input type="hidden" name="'.'GD_'.$student.'_'.
1.54      albertel 3360: 		$part.'_solved_s" value="'.$status.'" />'."\n";
1.233     albertel 3361: 	    $result.='&nbsp;<select name="'.
1.89      albertel 3362: 		'GD_'.$student.'_'.$part.'_solved" '.
                   3363: 		'onChange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n";
1.485     albertel 3364: 	    $result.= (($status eq 'excused') ? '<option> </option><option selected="selected" value="excused">'.&mt('excused').'</option>' 
                   3365: 		: '<option selected="selected"> </option><option value="excused">'.&mt('excused').'</option>')."\n";
                   3366: 	    $result.='<option value="reset status">'.&mt('reset status').'</option>';
1.126     ng       3367: 	    $result.="</select>&nbsp;</td>\n";
1.122     ng       3368: 	} else {
                   3369: 	    $result.='<input type="hidden" name="'.
                   3370: 		'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.
                   3371: 		    "\n";
1.233     albertel 3372: 	    $result.='<input type="text" name="'.
1.122     ng       3373: 		'GD_'.$student.'_'.$part.'_'.$type.'" '.
                   3374: 		'value="'.$score.'" size="4" /></td>'."\n";
1.41      ng       3375: 	}
                   3376:     }
1.474     albertel 3377:     $result.=&Apache::loncommon::end_data_table_row();
1.41      ng       3378:     return $result;
1.38      ng       3379: }
                   3380: 
1.44      ng       3381: #--- change scores for all the students in a section/class
                   3382: #    record does not get update if unchanged
1.38      ng       3383: sub editgrades {
1.41      ng       3384:     my ($request) = @_;
                   3385: 
1.324     albertel 3386:     my $symb=&get_symb($request);
1.433     banghart 3387:     my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
1.477     albertel 3388:     my $title='<h2>'.&mt('Current Grade Status').'</h2>';
                   3389:     $title.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4>'."\n";
1.433     banghart 3390:     $title.='<h4>'.&mt('<b>Section: </b>[_1]',$section_display).'</h4>'."\n";
1.126     ng       3391: 
1.477     albertel 3392:     my $result= &Apache::loncommon::start_data_table().
                   3393: 	&Apache::loncommon::start_data_table_header_row().
                   3394: 	'<th rowspan="2" valign="middle">'.&mt('No.').'</th>'.
                   3395: 	'<th rowspan="2" valign="middle">'.&nameUserString('header')."</th>\n";
1.43      ng       3396:     my %scoreptr = (
                   3397: 		    'correct'  =>'correct_by_override',
                   3398: 		    'incorrect'=>'incorrect_by_override',
                   3399: 		    'excused'  =>'excused',
                   3400: 		    'ungraded' =>'ungraded_attempted',
                   3401: 		    'nothing'  => '',
                   3402: 		    );
1.257     albertel 3403:     my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0');
1.34      ng       3404: 
1.44      ng       3405:     my (@partid);
                   3406:     my %weight = ();
1.54      albertel 3407:     my %columns = ();
1.44      ng       3408:     my ($i,$ctr,$count,$rec_update) = (0,0,0,0);
1.54      albertel 3409: 
1.324     albertel 3410:     my (@parts) = sort(&getpartlist($symb));
1.54      albertel 3411:     my $header;
1.257     albertel 3412:     while ($ctr < $env{'form.totalparts'}) {
                   3413: 	my $partid = $env{'form.partid_'.$ctr};
1.524     raeburn  3414: 	push(@partid,$partid);
1.257     albertel 3415: 	$weight{$partid} = $env{'form.weight_'.$partid};
1.44      ng       3416: 	$ctr++;
1.54      albertel 3417:     }
1.324     albertel 3418:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.54      albertel 3419:     foreach my $partid (@partid) {
1.478     albertel 3420: 	$header .= '<th align="center">'.&mt('Old Score').'</th>'.
                   3421: 	    '<th align="center">'.&mt('New Score').'</th>';
1.54      albertel 3422: 	$columns{$partid}=2;
                   3423: 	foreach my $stores (@parts) {
                   3424: 	    my ($part,$type) = &split_part_type($stores);
                   3425: 	    if ($part !~ m/^\Q$partid\E/) { next;}
                   3426: 	    if ($type eq 'awarded' || $type eq 'solved') { next; }
                   3427: 	    my $display=&Apache::lonnet::metadata($url,$stores.'.display');
                   3428: 	    $display =~ s/\[Part: (\w)+\]//;
1.125     ng       3429: 	    $display =~ s/Number of Attempts/Tries/;
1.478     albertel 3430: 	    $header .= '<th align="center">'.&mt('Old '.$display).'</th>'.
                   3431: 		'<th align="center">'.&mt('New '.$display).'</th>';
1.54      albertel 3432: 	    $columns{$partid}+=2;
                   3433: 	}
                   3434:     }
                   3435:     foreach my $partid (@partid) {
1.324     albertel 3436: 	my $display_part=&get_display_part($partid,$symb);
1.478     albertel 3437: 	$result .= '<th colspan="'.$columns{$partid}.'" align="center">'.
                   3438: 	    &mt('Part: [_1] (Weight = [_2])',$display_part,$weight{$partid}).
                   3439: 	    '</th>';
1.54      albertel 3440: 
1.44      ng       3441:     }
1.477     albertel 3442:     $result .= &Apache::loncommon::end_data_table_header_row().
                   3443: 	&Apache::loncommon::start_data_table_header_row().
                   3444: 	$header.
                   3445: 	&Apache::loncommon::end_data_table_header_row();
                   3446:     my @noupdate;
1.126     ng       3447:     my ($updateCtr,$noupdateCtr) = (1,1);
1.257     albertel 3448:     for ($i=0; $i<$env{'form.total'}; $i++) {
1.93      albertel 3449: 	my $line;
1.257     albertel 3450: 	my $user = $env{'form.ctr'.$i};
1.281     albertel 3451: 	my ($uname,$udom)=split(/:/,$user);
1.44      ng       3452: 	my %newrecord;
                   3453: 	my $updateflag = 0;
1.281     albertel 3454: 	$line .= '<td>'.&nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>';
1.108     albertel 3455: 	my $usec=$classlist->{"$uname:$udom"}[5];
1.105     albertel 3456: 	if (!&canmodify($usec)) {
1.126     ng       3457: 	    my $numcols=scalar(@partid)*4+2;
1.477     albertel 3458: 	    push(@noupdate,
1.478     albertel 3459: 		 $line."<td colspan=\"$numcols\"><span class=\"LC_warning\">".
                   3460: 		 &mt('Not allowed to modify student')."</span></td></tr>");
1.105     albertel 3461: 	    next;
                   3462: 	}
1.269     raeburn  3463:         my %aggregate = ();
                   3464:         my $aggregateflag = 0;
1.281     albertel 3465: 	$user=~s/:/_/; # colon doen't work in javascript for names
1.44      ng       3466: 	foreach (@partid) {
1.257     albertel 3467: 	    my $old_aw    = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
1.54      albertel 3468: 	    my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
                   3469: 	    my $old_part  = $old_aw eq '' ? '' : $old_part_pcr;
1.257     albertel 3470: 	    my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
                   3471: 	    my $awarded   = $env{'form.GD_'.$user.'_'.$_.'_awarded'};
1.54      albertel 3472: 	    my $pcr       = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
                   3473: 	    my $partial   = $awarded eq '' ? '' : $pcr;
1.44      ng       3474: 	    my $score;
                   3475: 	    if ($partial eq '') {
1.257     albertel 3476: 		$score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
1.44      ng       3477: 	    } elsif ($partial > 0) {
                   3478: 		$score = 'correct_by_override';
                   3479: 	    } elsif ($partial == 0) {
                   3480: 		$score = 'incorrect_by_override';
                   3481: 	    }
1.257     albertel 3482: 	    my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'};
1.125     ng       3483: 	    $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused'));
                   3484: 
1.292     albertel 3485: 	    $newrecord{'resource.'.$_.'.regrader'}=
                   3486: 		"$env{'user.name'}:$env{'user.domain'}";
1.125     ng       3487: 	    if ($dropMenu eq 'reset status' &&
                   3488: 		$old_score ne '') { # ignore if no previous attempts => nothing to reset
1.299     albertel 3489: 		$newrecord{'resource.'.$_.'.tries'} = '';
1.125     ng       3490: 		$newrecord{'resource.'.$_.'.solved'} = '';
                   3491: 		$newrecord{'resource.'.$_.'.award'} = '';
1.299     albertel 3492: 		$newrecord{'resource.'.$_.'.awarded'} = '';
1.125     ng       3493: 		$updateflag = 1;
1.269     raeburn  3494:                 if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) {
                   3495:                     my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'};
                   3496:                     my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'};
                   3497:                     my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'};
                   3498:                     &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                   3499:                     $aggregateflag = 1;
                   3500:                 }
1.139     albertel 3501: 	    } elsif (!($old_part eq $partial && $old_score eq $score)) {
                   3502: 		$updateflag = 1;
                   3503: 		$newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';
                   3504: 		$newrecord{'resource.'.$_.'.solved'}   = $score;
                   3505: 		$rec_update++;
1.125     ng       3506: 	    }
                   3507: 
1.93      albertel 3508: 	    $line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.
1.44      ng       3509: 		'<td align="center">'.$awarded.
                   3510: 		($score eq 'excused' ? $score : '').'&nbsp;</td>';
1.5       albertel 3511: 
1.54      albertel 3512: 
                   3513: 	    my $partid=$_;
                   3514: 	    foreach my $stores (@parts) {
                   3515: 		my ($part,$type) = &split_part_type($stores);
                   3516: 		if ($part !~ m/^\Q$partid\E/) { next;}
                   3517: 		if ($type eq 'awarded' || $type eq 'solved') { next; }
1.257     albertel 3518: 		my $old_aw    = $env{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'};
                   3519: 		my $awarded   = $env{'form.GD_'.$user.'_'.$part.'_'.$type};
1.54      albertel 3520: 		if ($awarded ne '' && $awarded ne $old_aw) {
                   3521: 		    $newrecord{'resource.'.$part.'.'.$type}= $awarded;
1.257     albertel 3522: 		    $newrecord{'resource.'.$part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
1.54      albertel 3523: 		    $updateflag=1;
                   3524: 		}
1.93      albertel 3525: 		$line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.
1.54      albertel 3526: 		    '<td align="center">'.$awarded.'&nbsp;</td>';
                   3527: 	    }
1.44      ng       3528: 	}
1.477     albertel 3529: 	$line.="\n";
1.301     albertel 3530: 
                   3531: 	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3532: 	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3533: 
1.44      ng       3534: 	if ($updateflag) {
                   3535: 	    $count++;
1.257     albertel 3536: 	    &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'},
1.89      albertel 3537: 				    $udom,$uname);
1.301     albertel 3538: 
                   3539: 	    if (&Apache::bridgetask::in_queue('gradingqueue',$symb,$cdom,
                   3540: 					      $cnum,$udom,$uname)) {
                   3541: 		# need to figure out if should be in queue.
                   3542: 		my %record =  
                   3543: 		    &Apache::lonnet::restore($symb,$env{'request.course.id'},
                   3544: 					     $udom,$uname);
                   3545: 		my $all_graded = 1;
                   3546: 		my $none_graded = 1;
                   3547: 		foreach my $part (@parts) {
                   3548: 		    if ( $record{'resource.'.$part.'.awarded'} eq '' ) {
                   3549: 			$all_graded = 0;
                   3550: 		    } else {
                   3551: 			$none_graded = 0;
                   3552: 		    }
                   3553: 		}
                   3554: 
                   3555: 		if ($all_graded || $none_graded) {
                   3556: 		    &Apache::bridgetask::remove_from_queue('gradingqueue',
                   3557: 							   $symb,$cdom,$cnum,
                   3558: 							   $udom,$uname);
                   3559: 		}
                   3560: 	    }
                   3561: 
1.477     albertel 3562: 	    $result.=&Apache::loncommon::start_data_table_row().
                   3563: 		'<td align="right">&nbsp;'.$updateCtr.'&nbsp;</td>'.$line.
                   3564: 		&Apache::loncommon::end_data_table_row();
1.126     ng       3565: 	    $updateCtr++;
1.93      albertel 3566: 	} else {
1.477     albertel 3567: 	    push(@noupdate,
                   3568: 		 '<td align="right">&nbsp;'.$noupdateCtr.'&nbsp;</td>'.$line);
1.126     ng       3569: 	    $noupdateCtr++;
1.44      ng       3570: 	}
1.269     raeburn  3571:         if ($aggregateflag) {
                   3572:             &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
1.301     albertel 3573: 				  $cdom,$cnum);
1.269     raeburn  3574:         }
1.93      albertel 3575:     }
1.477     albertel 3576:     if (@noupdate) {
1.126     ng       3577: #	my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
                   3578: 	my $numcols=scalar(@partid)*4+2;
1.477     albertel 3579: 	$result .= &Apache::loncommon::start_data_table_row('LC_empty_row').
1.478     albertel 3580: 	    '<td align="center" colspan="'.$numcols.'">'.
                   3581: 	    &mt('No Changes Occurred For the Students Below').
                   3582: 	    '</td>'.
1.477     albertel 3583: 	    &Apache::loncommon::end_data_table_row();
                   3584: 	foreach my $line (@noupdate) {
                   3585: 	    $result.=
                   3586: 		&Apache::loncommon::start_data_table_row().
                   3587: 		$line.
                   3588: 		&Apache::loncommon::end_data_table_row();
                   3589: 	}
1.44      ng       3590:     }
1.477     albertel 3591:     $result .= &Apache::loncommon::end_data_table().
                   3592: 	&show_grading_menu_form($symb);
1.478     albertel 3593:     my $msg = '<p><b>'.
                   3594: 	&mt('Number of records updated = [_1] for [quant,_2,student].',
                   3595: 	    $rec_update,$count).'</b><br />'.
                   3596: 	'<b>'.&mt('Total number of students = [_1]',$env{'form.total'}).
                   3597: 	'</b></p>';
1.44      ng       3598:     return $title.$msg.$result;
1.5       albertel 3599: }
1.54      albertel 3600: 
                   3601: sub split_part_type {
                   3602:     my ($partstr) = @_;
                   3603:     my ($temp,@allparts)=split(/_/,$partstr);
                   3604:     my $type=pop(@allparts);
1.439     albertel 3605:     my $part=join('_',@allparts);
1.54      albertel 3606:     return ($part,$type);
                   3607: }
                   3608: 
1.44      ng       3609: #------------- end of section for handling grading by section/class ---------
                   3610: #
                   3611: #----------------------------------------------------------------------------
                   3612: 
1.5       albertel 3613: 
1.44      ng       3614: #----------------------------------------------------------------------------
                   3615: #
                   3616: #-------------------------- Next few routines handles grading by csv upload
                   3617: #
                   3618: #--- Javascript to handle csv upload
1.27      albertel 3619: sub csvupload_javascript_reverse_associate {
1.246     albertel 3620:     my $error1=&mt('You need to specify the username or ID');
                   3621:     my $error2=&mt('You need to specify at least one grading field');
1.27      albertel 3622:   return(<<ENDPICK);
                   3623:   function verify(vf) {
                   3624:     var foundsomething=0;
                   3625:     var founduname=0;
1.243     albertel 3626:     var foundID=0;
1.27      albertel 3627:     for (i=0;i<=vf.nfields.value;i++) {
                   3628:       tw=eval('vf.f'+i+'.selectedIndex');
1.243     albertel 3629:       if (i==0 && tw!=0) { foundID=1; }
                   3630:       if (i==1 && tw!=0) { founduname=1; }
                   3631:       if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; }
1.27      albertel 3632:     }
1.246     albertel 3633:     if (founduname==0 && foundID==0) {
                   3634: 	alert('$error1');
                   3635: 	return;
1.27      albertel 3636:     }
                   3637:     if (foundsomething==0) {
1.246     albertel 3638: 	alert('$error2');
                   3639: 	return;
1.27      albertel 3640:     }
                   3641:     vf.submit();
                   3642:   }
                   3643:   function flip(vf,tf) {
                   3644:     var nw=eval('vf.f'+tf+'.selectedIndex');
                   3645:     var i;
                   3646:     for (i=0;i<=vf.nfields.value;i++) {
                   3647:       //can not pick the same destination field for both name and domain
                   3648:       if (((i ==0)||(i ==1)) && 
                   3649:           ((tf==0)||(tf==1)) && 
                   3650:           (i!=tf) &&
                   3651:           (eval('vf.f'+i+'.selectedIndex')==nw)) {
                   3652:         eval('vf.f'+i+'.selectedIndex=0;')
                   3653:       }
                   3654:     }
                   3655:   }
                   3656: ENDPICK
                   3657: }
                   3658: 
                   3659: sub csvupload_javascript_forward_associate {
1.246     albertel 3660:     my $error1=&mt('You need to specify the username or ID');
                   3661:     my $error2=&mt('You need to specify at least one grading field');
1.27      albertel 3662:   return(<<ENDPICK);
                   3663:   function verify(vf) {
                   3664:     var foundsomething=0;
                   3665:     var founduname=0;
1.243     albertel 3666:     var foundID=0;
1.27      albertel 3667:     for (i=0;i<=vf.nfields.value;i++) {
                   3668:       tw=eval('vf.f'+i+'.selectedIndex');
1.243     albertel 3669:       if (tw==1) { foundID=1; }
                   3670:       if (tw==2) { founduname=1; }
                   3671:       if (tw>3) { foundsomething=1; }
1.27      albertel 3672:     }
1.246     albertel 3673:     if (founduname==0 && foundID==0) {
                   3674: 	alert('$error1');
                   3675: 	return;
1.27      albertel 3676:     }
                   3677:     if (foundsomething==0) {
1.246     albertel 3678: 	alert('$error2');
                   3679: 	return;
1.27      albertel 3680:     }
                   3681:     vf.submit();
                   3682:   }
                   3683:   function flip(vf,tf) {
                   3684:     var nw=eval('vf.f'+tf+'.selectedIndex');
                   3685:     var i;
                   3686:     //can not pick the same destination field twice
                   3687:     for (i=0;i<=vf.nfields.value;i++) {
                   3688:       if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) {
                   3689:         eval('vf.f'+i+'.selectedIndex=0;')
                   3690:       }
                   3691:     }
                   3692:   }
                   3693: ENDPICK
                   3694: }
                   3695: 
1.26      albertel 3696: sub csvuploadmap_header {
1.324     albertel 3697:     my ($request,$symb,$datatoken,$distotal)= @_;
1.41      ng       3698:     my $javascript;
1.257     albertel 3699:     if ($env{'form.upfile_associate'} eq 'reverse') {
1.41      ng       3700: 	$javascript=&csvupload_javascript_reverse_associate();
                   3701:     } else {
                   3702: 	$javascript=&csvupload_javascript_forward_associate();
                   3703:     }
1.45      ng       3704: 
1.324     albertel 3705:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.257     albertel 3706:     my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
1.245     albertel 3707:     my $ignore=&mt('Ignore First Line');
1.418     albertel 3708:     $symb = &Apache::lonenc::check_encrypt($symb);
1.41      ng       3709:     $request->print(<<ENDPICK);
1.26      albertel 3710: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.398     albertel 3711: <h3><span class="LC_info">Uploading Class Grades</span></h3>
1.45      ng       3712: $result
1.326     albertel 3713: <hr />
1.26      albertel 3714: <h3>Identify fields</h3>
                   3715: Total number of records found in file: $distotal <hr />
                   3716: Enter as many fields as you can. The system will inform you and bring you back
                   3717: to this page if the data selected is insufficient to run your class.<hr />
                   3718: <input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />
1.245     albertel 3719: <label><input type="checkbox" name="noFirstLine" $checked />$ignore</label>
1.26      albertel 3720: <input type="hidden" name="associate"  value="" />
                   3721: <input type="hidden" name="phase"      value="three" />
                   3722: <input type="hidden" name="datatoken"  value="$datatoken" />
1.257     albertel 3723: <input type="hidden" name="fileupload" value="$env{'form.fileupload'}" />
                   3724: <input type="hidden" name="upfiletype" value="$env{'form.upfiletype'}" />
1.26      albertel 3725: <input type="hidden" name="upfile_associate" 
1.257     albertel 3726:                                        value="$env{'form.upfile_associate'}" />
1.26      albertel 3727: <input type="hidden" name="symb"       value="$symb" />
1.257     albertel 3728: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
                   3729: <input type="hidden" name="probTitle"  value="$env{'form.probTitle'}" />
1.246     albertel 3730: <input type="hidden" name="command"    value="csvuploadoptions" />
1.26      albertel 3731: <hr />
                   3732: <script type="text/javascript" language="Javascript">
                   3733: $javascript
                   3734: </script>
                   3735: ENDPICK
1.118     ng       3736:     return '';
1.26      albertel 3737: 
                   3738: }
                   3739: 
                   3740: sub csvupload_fields {
1.324     albertel 3741:     my ($symb) = @_;
                   3742:     my (@parts) = &getpartlist($symb);
1.243     albertel 3743:     my @fields=(['ID','Student ID'],
                   3744: 		['username','Student Username'],
                   3745: 		['domain','Student Domain']);
1.324     albertel 3746:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.41      ng       3747:     foreach my $part (sort(@parts)) {
                   3748: 	my @datum;
                   3749: 	my $display=&Apache::lonnet::metadata($url,$part.'.display');
                   3750: 	my $name=$part;
                   3751: 	if  (!$display) { $display = $name; }
                   3752: 	@datum=($name,$display);
1.244     albertel 3753: 	if ($name=~/^stores_(.*)_awarded/) {
                   3754: 	    push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]);
                   3755: 	}
1.41      ng       3756: 	push(@fields,\@datum);
                   3757:     }
                   3758:     return (@fields);
1.26      albertel 3759: }
                   3760: 
                   3761: sub csvuploadmap_footer {
1.41      ng       3762:     my ($request,$i,$keyfields) =@_;
                   3763:     $request->print(<<ENDPICK);
1.26      albertel 3764: </table>
                   3765: <input type="hidden" name="nfields" value="$i" />
                   3766: <input type="hidden" name="keyfields" value="$keyfields" />
                   3767: <input type="button" onClick="javascript:verify(this.form)" value="Assign Grades" /><br />
                   3768: </form>
                   3769: ENDPICK
                   3770: }
                   3771: 
1.283     albertel 3772: sub checkforfile_js {
1.86      ng       3773:     my $result =<<CSVFORMJS;
                   3774: <script type="text/javascript" language="javascript">
                   3775:     function checkUpload(formname) {
                   3776: 	if (formname.upfile.value == "") {
                   3777: 	    alert("Please use the browse button to select a file from your local directory.");
                   3778: 	    return false;
                   3779: 	}
                   3780: 	formname.submit();
                   3781:     }
                   3782:     </script>
                   3783: CSVFORMJS
1.283     albertel 3784:     return $result;
                   3785: }
                   3786: 
                   3787: sub upcsvScores_form {
                   3788:     my ($request) = shift;
1.324     albertel 3789:     my ($symb)=&get_symb($request);
1.283     albertel 3790:     if (!$symb) {return '';}
                   3791:     my $result=&checkforfile_js();
1.257     albertel 3792:     $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
1.324     albertel 3793:     my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
1.118     ng       3794:     $result.=$table;
1.326     albertel 3795:     $result.='<br /><table width="100%" border="0"><tr><td bgcolor="#777777">'."\n";
                   3796:     $result.='<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>'."\n";
1.370     www      3797:     $result.='&nbsp;<b>'.&mt('Specify a file containing the class scores for current resource').
1.86      ng       3798: 	'.</b></td></tr>'."\n";
                   3799:     $result.='<tr bgcolor=#ffffe6><td>'."\n";
1.370     www      3800:     my $upload=&mt("Upload Scores");
1.86      ng       3801:     my $upfile_select=&Apache::loncommon::upfile_select_html();
1.245     albertel 3802:     my $ignore=&mt('Ignore First Line');
1.418     albertel 3803:     $symb = &Apache::lonenc::check_encrypt($symb);
1.86      ng       3804:     $result.=<<ENDUPFORM;
1.106     albertel 3805: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.86      ng       3806: <input type="hidden" name="symb" value="$symb" />
                   3807: <input type="hidden" name="command" value="csvuploadmap" />
1.257     albertel 3808: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   3809: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
1.86      ng       3810: $upfile_select
1.370     www      3811: <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="$upload" />
1.283     albertel 3812: <label><input type="checkbox" name="noFirstLine" />$ignore</label>
1.86      ng       3813: </form>
                   3814: ENDUPFORM
1.370     www      3815:     $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV",
                   3816:                            &mt("How do I create a CSV file from a spreadsheet"))
                   3817:     .'</td></tr></table>'."\n";
1.86      ng       3818:     $result.='</td></tr></table><br /><br />'."\n";
1.324     albertel 3819:     $result.=&show_grading_menu_form($symb);
1.86      ng       3820:     return $result;
                   3821: }
                   3822: 
                   3823: 
1.26      albertel 3824: sub csvuploadmap {
1.41      ng       3825:     my ($request)= @_;
1.324     albertel 3826:     my ($symb)=&get_symb($request);
1.41      ng       3827:     if (!$symb) {return '';}
1.72      ng       3828: 
1.41      ng       3829:     my $datatoken;
1.257     albertel 3830:     if (!$env{'form.datatoken'}) {
1.41      ng       3831: 	$datatoken=&Apache::loncommon::upfile_store($request);
1.26      albertel 3832:     } else {
1.257     albertel 3833: 	$datatoken=$env{'form.datatoken'};
1.41      ng       3834: 	&Apache::loncommon::load_tmp_file($request);
1.26      albertel 3835:     }
1.41      ng       3836:     my @records=&Apache::loncommon::upfile_record_sep();
1.257     albertel 3837:     if ($env{'form.noFirstLine'}) { shift(@records); }
1.324     albertel 3838:     &csvuploadmap_header($request,$symb,$datatoken,$#records+1);
1.41      ng       3839:     my ($i,$keyfields);
                   3840:     if (@records) {
1.324     albertel 3841: 	my @fields=&csvupload_fields($symb);
1.45      ng       3842: 
1.257     albertel 3843: 	if ($env{'form.upfile_associate'} eq 'reverse') {	
1.41      ng       3844: 	    &Apache::loncommon::csv_print_samples($request,\@records);
                   3845: 	    $i=&Apache::loncommon::csv_print_select_table($request,\@records,
                   3846: 							  \@fields);
                   3847: 	    foreach (@fields) { $keyfields.=$_->[0].','; }
                   3848: 	    chop($keyfields);
                   3849: 	} else {
                   3850: 	    unshift(@fields,['none','']);
                   3851: 	    $i=&Apache::loncommon::csv_samples_select_table($request,\@records,
                   3852: 							    \@fields);
1.311     banghart 3853:             foreach my $rec (@records) {
                   3854:                 my %temp = &Apache::loncommon::record_sep($rec);
                   3855:                 if (%temp) {
                   3856:                     $keyfields=join(',',sort(keys(%temp)));
                   3857:                     last;
                   3858:                 }
                   3859:             }
1.41      ng       3860: 	}
                   3861:     }
                   3862:     &csvuploadmap_footer($request,$i,$keyfields);
1.324     albertel 3863:     $request->print(&show_grading_menu_form($symb));
1.72      ng       3864: 
1.41      ng       3865:     return '';
1.27      albertel 3866: }
                   3867: 
1.246     albertel 3868: sub csvuploadoptions {
1.41      ng       3869:     my ($request)= @_;
1.324     albertel 3870:     my ($symb)=&get_symb($request);
1.257     albertel 3871:     my $checked=(($env{'form.noFirstLine'})?'1':'0');
1.246     albertel 3872:     my $ignore=&mt('Ignore First Line');
                   3873:     $request->print(<<ENDPICK);
                   3874: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.398     albertel 3875: <h3><span class="LC_info">Uploading Class Grade Options</span></h3>
1.246     albertel 3876: <input type="hidden" name="command"    value="csvuploadassign" />
1.302     albertel 3877: <!--
1.246     albertel 3878: <p>
                   3879: <label>
                   3880:    <input type="checkbox" name="show_full_results" />
                   3881:    Show a table of all changes
                   3882: </label>
                   3883: </p>
1.302     albertel 3884: -->
1.246     albertel 3885: <p>
                   3886: <label>
                   3887:    <input type="checkbox" name="overwite_scores" checked="checked" />
                   3888:    Overwrite any existing score
                   3889: </label>
                   3890: </p>
                   3891: ENDPICK
                   3892:     my %fields=&get_fields();
                   3893:     if (!defined($fields{'domain'})) {
1.257     albertel 3894: 	my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain');
1.246     albertel 3895: 	$request->print("\n<p> Users are in domain: ".$domform."</p>\n");
                   3896:     }
1.257     albertel 3897:     foreach my $key (sort(keys(%env))) {
1.246     albertel 3898: 	if ($key !~ /^form\.(.*)$/) { next; }
                   3899: 	my $cleankey=$1;
                   3900: 	if ($cleankey eq 'command') { next; }
                   3901: 	$request->print('<input type="hidden" name="'.$cleankey.
1.257     albertel 3902: 			'"  value="'.$env{$key}.'" />'."\n");
1.246     albertel 3903:     }
                   3904:     # FIXME do a check for any duplicated user ids...
                   3905:     # FIXME do a check for any invalid user ids?...
1.290     albertel 3906:     $request->print('<input type="submit" value="Assign Grades" /><br />
                   3907: <hr /></form>'."\n");
1.324     albertel 3908:     $request->print(&show_grading_menu_form($symb));
1.246     albertel 3909:     return '';
                   3910: }
                   3911: 
                   3912: sub get_fields {
                   3913:     my %fields;
1.257     albertel 3914:     my @keyfields = split(/\,/,$env{'form.keyfields'});
                   3915:     for (my $i=0; $i<=$env{'form.nfields'}; $i++) {
                   3916: 	if ($env{'form.upfile_associate'} eq 'reverse') {
                   3917: 	    if ($env{'form.f'.$i} ne 'none') {
                   3918: 		$fields{$keyfields[$i]}=$env{'form.f'.$i};
1.41      ng       3919: 	    }
                   3920: 	} else {
1.257     albertel 3921: 	    if ($env{'form.f'.$i} ne 'none') {
                   3922: 		$fields{$env{'form.f'.$i}}=$keyfields[$i];
1.41      ng       3923: 	    }
                   3924: 	}
1.27      albertel 3925:     }
1.246     albertel 3926:     return %fields;
                   3927: }
                   3928: 
                   3929: sub csvuploadassign {
                   3930:     my ($request)= @_;
1.324     albertel 3931:     my ($symb)=&get_symb($request);
1.246     albertel 3932:     if (!$symb) {return '';}
1.345     bowersj2 3933:     my $error_msg = '';
1.246     albertel 3934:     &Apache::loncommon::load_tmp_file($request);
                   3935:     my @gradedata = &Apache::loncommon::upfile_record_sep();
1.257     albertel 3936:     if ($env{'form.noFirstLine'}) { shift(@gradedata); }
1.246     albertel 3937:     my %fields=&get_fields();
1.41      ng       3938:     $request->print('<h3>Assigning Grades</h3>');
1.257     albertel 3939:     my $courseid=$env{'request.course.id'};
1.97      albertel 3940:     my ($classlist) = &getclasslist('all',0);
1.106     albertel 3941:     my @notallowed;
1.41      ng       3942:     my @skipped;
                   3943:     my $countdone=0;
                   3944:     foreach my $grade (@gradedata) {
                   3945: 	my %entries=&Apache::loncommon::record_sep($grade);
1.246     albertel 3946: 	my $domain;
                   3947: 	if ($entries{$fields{'domain'}}) {
                   3948: 	    $domain=$entries{$fields{'domain'}};
                   3949: 	} else {
1.257     albertel 3950: 	    $domain=$env{'form.default_domain'};
1.246     albertel 3951: 	}
1.243     albertel 3952: 	$domain=~s/\s//g;
1.41      ng       3953: 	my $username=$entries{$fields{'username'}};
1.160     albertel 3954: 	$username=~s/\s//g;
1.243     albertel 3955: 	if (!$username) {
                   3956: 	    my $id=$entries{$fields{'ID'}};
1.247     albertel 3957: 	    $id=~s/\s//g;
1.243     albertel 3958: 	    my %ids=&Apache::lonnet::idget($domain,$id);
                   3959: 	    $username=$ids{$id};
                   3960: 	}
1.41      ng       3961: 	if (!exists($$classlist{"$username:$domain"})) {
1.247     albertel 3962: 	    my $id=$entries{$fields{'ID'}};
                   3963: 	    $id=~s/\s//g;
                   3964: 	    if ($id) {
                   3965: 		push(@skipped,"$id:$domain");
                   3966: 	    } else {
                   3967: 		push(@skipped,"$username:$domain");
                   3968: 	    }
1.41      ng       3969: 	    next;
                   3970: 	}
1.108     albertel 3971: 	my $usec=$classlist->{"$username:$domain"}[5];
1.106     albertel 3972: 	if (!&canmodify($usec)) {
                   3973: 	    push(@notallowed,"$username:$domain");
                   3974: 	    next;
                   3975: 	}
1.244     albertel 3976: 	my %points;
1.41      ng       3977: 	my %grades;
                   3978: 	foreach my $dest (keys(%fields)) {
1.244     albertel 3979: 	    if ($dest eq 'ID' || $dest eq 'username' ||
                   3980: 		$dest eq 'domain') { next; }
                   3981: 	    if ($entries{$fields{$dest}} =~ /^\s*$/) { next; }
                   3982: 	    if ($dest=~/stores_(.*)_points/) {
                   3983: 		my $part=$1;
                   3984: 		my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',
                   3985: 					      $symb,$domain,$username);
1.345     bowersj2 3986:                 if ($wgt) {
                   3987:                     $entries{$fields{$dest}}=~s/\s//g;
                   3988:                     my $pcr=$entries{$fields{$dest}} / $wgt;
1.463     albertel 3989:                     my $award=($pcr == 0) ? 'incorrect_by_override'
                   3990:                                           : 'correct_by_override';
1.345     bowersj2 3991:                     $grades{"resource.$part.awarded"}=$pcr;
                   3992:                     $grades{"resource.$part.solved"}=$award;
                   3993:                     $points{$part}=1;
                   3994:                 } else {
                   3995:                     $error_msg = "<br />" .
                   3996:                         &mt("Some point values were assigned"
                   3997:                             ." for problems with a weight "
                   3998:                             ."of zero. These values were "
                   3999:                             ."ignored.");
                   4000:                 }
1.244     albertel 4001: 	    } else {
                   4002: 		if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }
                   4003: 		if ($dest=~/stores_(.*)_solved/)  { if ($points{$1}) {next;} }
                   4004: 		my $store_key=$dest;
                   4005: 		$store_key=~s/^stores/resource/;
                   4006: 		$store_key=~s/_/\./g;
                   4007: 		$grades{$store_key}=$entries{$fields{$dest}};
                   4008: 	    }
1.41      ng       4009: 	}
1.508     www      4010: 	if (! %grades) { 
                   4011:            push(@skipped,&mt("[_1]: no data to save","$username:$domain")); 
                   4012:         } else {
                   4013: 	   $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
                   4014: 	   my $result=&Apache::lonnet::cstore(\%grades,$symb,
1.302     albertel 4015: 					   $env{'request.course.id'},
                   4016: 					   $domain,$username);
1.508     www      4017: 	   if ($result eq 'ok') {
                   4018: 	      $request->print('.');
                   4019: 	   } else {
                   4020: 	      $request->print("<p><span class=\"LC_error\">".
                   4021:                               &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]",
                   4022:                                   "$username:$domain",$result)."</span></p>");
                   4023: 	   }
                   4024: 	   $request->rflush();
                   4025: 	   $countdone++;
                   4026:         }
1.41      ng       4027:     }
1.508     www      4028:     $request->print('<br /><span class="LC_info">'.&mt("Saved [_1] students",$countdone)."</span>\n");
1.41      ng       4029:     if (@skipped) {
1.508     www      4030: 	$request->print('<p><span class="LC_warning">'.&mt('Skipped Students').'</span></p>');
1.106     albertel 4031: 	foreach my $student (@skipped) { $request->print("$student<br />\n"); }
                   4032:     }
                   4033:     if (@notallowed) {
1.508     www      4034: 	$request->print('<p><span class="LC_error">'.&mt('Students Not Allowed to Modify').'</span></p>');
1.106     albertel 4035: 	foreach my $student (@notallowed) { $request->print("$student<br />\n"); }
1.41      ng       4036:     }
1.106     albertel 4037:     $request->print("<br />\n");
1.324     albertel 4038:     $request->print(&show_grading_menu_form($symb));
1.345     bowersj2 4039:     return $error_msg;
1.26      albertel 4040: }
1.44      ng       4041: #------------- end of section for handling csv file upload ---------
                   4042: #
                   4043: #-------------------------------------------------------------------
                   4044: #
1.122     ng       4045: #-------------- Next few routines handle grading by page/sequence
1.72      ng       4046: #
                   4047: #--- Select a page/sequence and a student to grade
1.68      ng       4048: sub pickStudentPage {
                   4049:     my ($request) = shift;
                   4050: 
                   4051:     $request->print(<<LISTJAVASCRIPT);
                   4052: <script type="text/javascript" language="javascript">
                   4053: 
                   4054: function checkPickOne(formname) {
1.76      ng       4055:     if (radioSelection(formname.student) == null) {
1.68      ng       4056: 	alert("Please select the student you wish to grade.");
                   4057: 	return;
                   4058:     }
1.125     ng       4059:     ptr = pullDownSelection(formname.selectpage);
                   4060:     formname.page.value = formname["page"+ptr].value;
                   4061:     formname.title.value = formname["title"+ptr].value;
1.68      ng       4062:     formname.submit();
                   4063: }
                   4064: 
                   4065: </script>
                   4066: LISTJAVASCRIPT
1.118     ng       4067:     &commonJSfunctions($request);
1.324     albertel 4068:     my ($symb) = &get_symb($request);
1.257     albertel 4069:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4070:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4071:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
1.68      ng       4072: 
1.398     albertel 4073:     my $result='<h3><span class="LC_info">&nbsp;'.
1.485     albertel 4074: 	&mt('Manual Grading by Page or Sequence').'</span></h3>';
1.68      ng       4075: 
1.80      ng       4076:     $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";
1.423     albertel 4077:     my ($titles,$symbx) = &getSymbMap();
1.137     albertel 4078:     my ($curpage) =&Apache::lonnet::decode_symb($symb); 
                   4079: #    my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 
                   4080: #    my $type=($curpage =~ /\.(page|sequence)/);
1.485     albertel 4081:     my $select = '<select name="selectpage">'."\n";
1.70      ng       4082:     my $ctr=0;
1.68      ng       4083:     foreach (@$titles) {
                   4084: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
1.485     albertel 4085: 	$select.='<option value="'.$ctr.'" '.
1.401     albertel 4086: 	    ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : '').
1.71      ng       4087: 	    '>'.$showtitle.'</option>'."\n";
1.70      ng       4088: 	$ctr++;
1.68      ng       4089:     }
1.485     albertel 4090:     $select.= '</select>';
                   4091:     $result.=&mt('&nbsp;<b>Problems from:</b> [_1]',$select)."<br />\n";
                   4092: 
1.70      ng       4093:     $ctr=0;
                   4094:     foreach (@$titles) {
                   4095: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
                   4096: 	$result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n";
                   4097: 	$result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n";
                   4098: 	$ctr++;
                   4099:     }
1.72      ng       4100:     $result.='<input type="hidden" name="page" />'."\n".
                   4101: 	'<input type="hidden" name="title" />'."\n";
1.68      ng       4102: 
1.485     albertel 4103:     my $options =
                   4104: 	'<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n".
                   4105: 	'<label><input type="radio" name="vProb" value="yes" /> '.&mt('yes').' </label>'."<br />\n";
                   4106:     $result.='&nbsp;'.&mt('<b>View Problems Text: </b> [_1]',$options);
                   4107: 
                   4108:     $options =
                   4109: 	'<label><input type="radio" name="lastSub" value="none" /> '.&mt('none').' </label>'."\n".
                   4110: 	'<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '.&mt('by dates and submissions').'</label>'."\n".
                   4111: 	'<label><input type="radio" name="lastSub" value="all" /> '.&mt('all details').' </label>'."\n";
                   4112:     $result.='&nbsp;'.&mt('<b>Submission Details: </b>[_1]',$options);
1.432     banghart 4113:     
                   4114:     $result.=&build_section_inputs();
1.442     banghart 4115:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
                   4116:     $result.='<input type="hidden" name="Status"  value="'.$stu_status.'" />'."\n".
1.72      ng       4117: 	'<input type="hidden" name="command" value="displayPage" />'."\n".
1.418     albertel 4118: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 4119: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."<br />\n";
1.72      ng       4120: 
1.485     albertel 4121:     $result.='&nbsp;'.&mt('<b>Use CODE: [_1] </b>',
                   4122: 			  '<input type="text" name="CODE" value="" />').
                   4123: 			      '<br />'."\n";
1.382     albertel 4124: 
1.80      ng       4125:     $result.='&nbsp;<input type="button" '.
1.485     albertel 4126: 	'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next-&gt;').'" /><br />'."\n";
1.72      ng       4127: 
1.68      ng       4128:     $request->print($result);
                   4129: 
1.485     albertel 4130:     my $studentTable.='&nbsp;<b>'.&mt('Select a student you wish to grade and then click on the Next button.').'</b><br />'.
1.484     albertel 4131: 	&Apache::loncommon::start_data_table().
                   4132: 	&Apache::loncommon::start_data_table_header_row().
1.485     albertel 4133: 	'<th align="right">&nbsp;'.&mt('No.').'</th>'.
1.484     albertel 4134: 	'<th>'.&nameUserString('header').'</th>'.
1.485     albertel 4135: 	'<th align="right">&nbsp;'.&mt('No.').'</th>'.
1.484     albertel 4136: 	'<th>'.&nameUserString('header').'</th>'.
                   4137: 	&Apache::loncommon::end_data_table_header_row();
1.68      ng       4138:  
1.76      ng       4139:     my (undef,undef,$fullname) = &getclasslist($getsec,'1');
1.68      ng       4140:     my $ptr = 1;
1.294     albertel 4141:     foreach my $student (sort 
                   4142: 			 {
                   4143: 			     if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   4144: 				 return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   4145: 			     }
                   4146: 			     return $a cmp $b;
                   4147: 			 } (keys(%$fullname))) {
1.68      ng       4148: 	my ($uname,$udom) = split(/:/,$student);
1.484     albertel 4149: 	$studentTable.=($ptr%2==1 ? &Apache::loncommon::start_data_table_row()
                   4150:                                   : '</td>');
1.126     ng       4151: 	$studentTable.='<td align="right">'.$ptr.'&nbsp;</td>';
1.288     albertel 4152: 	$studentTable.='<td>&nbsp;<label><input type="radio" name="student" value="'.$student.'" /> '
                   4153: 	    .&nameUserString(undef,$$fullname{$student},$uname,$udom)."</label>\n";
1.484     albertel 4154: 	$studentTable.=
                   4155: 	    ($ptr%2 == 0 ? '</td>'.&Apache::loncommon::end_data_table_row() 
                   4156:                          : '');
1.68      ng       4157: 	$ptr++;
                   4158:     }
1.484     albertel 4159:     if ($ptr%2 == 0) {
                   4160: 	$studentTable.='</td><td>&nbsp;</td><td>&nbsp;</td>'.
                   4161: 	    &Apache::loncommon::end_data_table_row();
                   4162:     }
                   4163:     $studentTable.=&Apache::loncommon::end_data_table()."\n";
1.126     ng       4164:     $studentTable.='<input type="button" '.
1.485     albertel 4165: 	'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next-&gt;').'" /></form>'."\n";
1.68      ng       4166: 
1.324     albertel 4167:     $studentTable.=&show_grading_menu_form($symb);
1.68      ng       4168:     $request->print($studentTable);
                   4169: 
                   4170:     return '';
                   4171: }
                   4172: 
                   4173: sub getSymbMap {
1.132     bowersj2 4174:     my $navmap = Apache::lonnavmaps::navmap->new();
1.68      ng       4175: 
                   4176:     my %symbx = ();
                   4177:     my @titles = ();
1.117     bowersj2 4178:     my $minder = 0;
                   4179: 
                   4180:     # Gather every sequence that has problems.
1.240     albertel 4181:     my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); },
                   4182: 					       1,0,1);
1.117     bowersj2 4183:     for my $sequence ($navmap->getById('0.0'), @sequences) {
1.241     albertel 4184: 	if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {
1.381     albertel 4185: 	    my $title = $minder.'.'.
                   4186: 		&HTML::Entities::encode($sequence->compTitle(),'"\'&');
                   4187: 	    push(@titles, $title); # minder in case two titles are identical
                   4188: 	    $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&');
1.117     bowersj2 4189: 	    $minder++;
1.241     albertel 4190: 	}
1.68      ng       4191:     }
                   4192:     return \@titles,\%symbx;
                   4193: }
                   4194: 
1.72      ng       4195: #
                   4196: #--- Displays a page/sequence w/wo problems, w/wo submissions
1.68      ng       4197: sub displayPage {
                   4198:     my ($request) = shift;
                   4199: 
1.324     albertel 4200:     my ($symb) = &get_symb($request);
1.257     albertel 4201:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4202:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4203:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
                   4204:     my $pageTitle = $env{'form.page'};
1.103     albertel 4205:     my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
1.257     albertel 4206:     my ($uname,$udom) = split(/:/,$env{'form.student'});
                   4207:     my $usec=$classlist->{$env{'form.student'}}[5];
1.168     albertel 4208: 
                   4209:     #need to make sure we have the correct data for later EXT calls, 
                   4210:     #thus invalidate the cache
                   4211:     &Apache::lonnet::devalidatecourseresdata(
1.257     albertel 4212:                  $env{'course.'.$env{'request.course.id'}.'.num'},
                   4213:                  $env{'course.'.$env{'request.course.id'}.'.domain'});
1.168     albertel 4214:     &Apache::lonnet::clear_EXT_cache_status();
                   4215: 
1.103     albertel 4216:     if (!&canview($usec)) {
1.485     albertel 4217: 	$request->print('<span class="LC_warning">'.&mt('Unable to view requested student. ([_1])',$env{'form.student'}).'</span>');
1.324     albertel 4218: 	$request->print(&show_grading_menu_form($symb));
1.103     albertel 4219: 	return;
                   4220:     }
1.398     albertel 4221:     my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';
1.485     albertel 4222:     $result.='<h3>&nbsp;'.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)).
1.129     ng       4223: 	'</h3>'."\n";
1.500     albertel 4224:     $env{'form.CODE'} = uc($env{'form.CODE'});
1.501     foxr     4225:     if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) {
1.485     albertel 4226: 	$result.='<h3>&nbsp;'.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n";
1.382     albertel 4227:     } else {
                   4228: 	delete($env{'form.CODE'});
                   4229:     }
1.71      ng       4230:     &sub_page_js($request);
                   4231:     $request->print($result);
                   4232: 
1.132     bowersj2 4233:     my $navmap = Apache::lonnavmaps::navmap->new();
1.257     albertel 4234:     my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'});
1.68      ng       4235:     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
1.288     albertel 4236:     if (!$map) {
1.485     albertel 4237: 	$request->print('<span class="LC_warning">'.&mt('Unable to view requested sequence. ([_1])',$resUrl).'</span>');
1.324     albertel 4238: 	$request->print(&show_grading_menu_form($symb));
1.288     albertel 4239: 	return; 
                   4240:     }
1.68      ng       4241:     my $iterator = $navmap->getIterator($map->map_start(),
                   4242: 					$map->map_finish());
                   4243: 
1.71      ng       4244:     my $studentTable='<form action="/adm/grades" method="post" name="gradePage">'."\n".
1.72      ng       4245: 	'<input type="hidden" name="command" value="gradeByPage" />'."\n".
1.257     albertel 4246: 	'<input type="hidden" name="fullname" value="'.$$fullname{$env{'form.student'}}.'" />'."\n".
                   4247: 	'<input type="hidden" name="student" value="'.$env{'form.student'}.'" />'."\n".
1.72      ng       4248: 	'<input type="hidden" name="page"    value="'.$pageTitle.'" />'."\n".
1.257     albertel 4249: 	'<input type="hidden" name="title"   value="'.$env{'form.title'}.'" />'."\n".
1.418     albertel 4250: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.125     ng       4251: 	'<input type="hidden" name="overRideScore" value="no" />'."\n".
1.257     albertel 4252: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n";
1.71      ng       4253: 
1.382     albertel 4254:     if (defined($env{'form.CODE'})) {
                   4255: 	$studentTable.=
                   4256: 	    '<input type="hidden" name="CODE" value="'.$env{'form.CODE'}.'" />'."\n";
                   4257:     }
1.381     albertel 4258:     my $checkIcon = '<img alt="'.&mt('Check Mark').
1.485     albertel 4259: 	'" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />';
1.71      ng       4260: 
1.485     albertel 4261:     $studentTable.='&nbsp;'.&mt('<b>Note:</b> Problems graded correct by the computer are marked with a [_1] symbol.',$checkIcon)."\n".
1.484     albertel 4262: 	&Apache::loncommon::start_data_table().
                   4263: 	&Apache::loncommon::start_data_table_header_row().
                   4264: 	'<th align="center">&nbsp;Prob.&nbsp;</th>'.
1.485     albertel 4265: 	'<th>&nbsp;'.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').'</th>'.
1.484     albertel 4266: 	&Apache::loncommon::end_data_table_header_row();
1.71      ng       4267: 
1.329     albertel 4268:     &Apache::lonxml::clear_problem_counter();
1.196     albertel 4269:     my ($depth,$question,$prob) = (1,1,1);
1.68      ng       4270:     $iterator->next(); # skip the first BEGIN_MAP
                   4271:     my $curRes = $iterator->next(); # for "current resource"
1.101     albertel 4272:     while ($depth > 0) {
1.68      ng       4273:         if($curRes == $iterator->BEGIN_MAP) { $depth++; }
1.100     bowersj2 4274:         if($curRes == $iterator->END_MAP) { $depth--; }
1.68      ng       4275: 
1.385     albertel 4276:         if (ref($curRes) && $curRes->is_problem()) {
1.91      albertel 4277: 	    my $parts = $curRes->parts();
1.68      ng       4278:             my $title = $curRes->compTitle();
1.71      ng       4279: 	    my $symbx = $curRes->symb();
1.484     albertel 4280: 	    $studentTable.=
                   4281: 		&Apache::loncommon::start_data_table_row().
                   4282: 		'<td align="center" valign="top" >'.$prob.
1.485     albertel 4283: 		(scalar(@{$parts}) == 1 ? '' 
                   4284: 		                        : '<br />('.&mt('[_1]&nbsp;parts)',
                   4285: 							scalar(@{$parts}))
                   4286: 		 ).
                   4287: 		 '</td>';
1.71      ng       4288: 	    $studentTable.='<td valign="top">';
1.382     albertel 4289: 	    my %form = ('CODE' => $env{'form.CODE'},);
1.257     albertel 4290: 	    if ($env{'form.vProb'} eq 'yes' ) {
1.144     albertel 4291: 		$studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
1.383     albertel 4292: 					     undef,'both',\%form);
1.71      ng       4293: 	    } else {
1.382     albertel 4294: 		my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form);
1.80      ng       4295: 		$companswer =~ s|<form(.*?)>||g;
                   4296: 		$companswer =~ s|</form>||g;
1.71      ng       4297: #		while ($companswer =~ /(<a href\=\"javascript:newWindow.*?Script Vars<\/a>)/s) { #<a href="javascript:newWindow</a>
1.116     ng       4298: #		    $companswer =~ s/$1/ /ms;
1.326     albertel 4299: #		    $request->print('match='.$1."<br />\n");
1.71      ng       4300: #		}
1.116     ng       4301: #		$companswer =~ s|<table border=\"1\">|<table border=\"0\">|g;
1.485     albertel 4302: 		$studentTable.='&nbsp;<b>'.$title.'</b>&nbsp;<br />&nbsp;'.&mt('<b>Correct answer:</b><br />[_1]',$companswer);
1.71      ng       4303: 	    }
                   4304: 
1.257     albertel 4305: 	    my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);
1.125     ng       4306: 
1.257     albertel 4307: 	    if ($env{'form.lastSub'} eq 'datesub') {
1.71      ng       4308: 		if ($record{'version'} eq '') {
1.485     albertel 4309: 		    $studentTable.='<br />&nbsp;<span class="LC_warning">'.&mt('No recorded submission for this problem.').'</span><br />';
1.71      ng       4310: 		} else {
1.116     ng       4311: 		    my %responseType = ();
                   4312: 		    foreach my $partid (@{$parts}) {
1.147     albertel 4313: 			my @responseIds =$curRes->responseIds($partid);
                   4314: 			my @responseType =$curRes->responseType($partid);
                   4315: 			my %responseIds;
                   4316: 			for (my $i=0;$i<=$#responseIds;$i++) {
                   4317: 			    $responseIds{$responseIds[$i]}=$responseType[$i];
                   4318: 			}
                   4319: 			$responseType{$partid} = \%responseIds;
1.116     ng       4320: 		    }
1.148     albertel 4321: 		    $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom);
1.147     albertel 4322: 
1.71      ng       4323: 		}
1.257     albertel 4324: 	    } elsif ($env{'form.lastSub'} eq 'all') {
                   4325: 		my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
1.71      ng       4326: 		$studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom,
1.257     albertel 4327: 									$env{'request.course.id'},
1.71      ng       4328: 									'','.submission');
                   4329:  
                   4330: 	    }
1.103     albertel 4331: 	    if (&canmodify($usec)) {
                   4332: 		foreach my $partid (@{$parts}) {
                   4333: 		    $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record);
                   4334: 		    $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n";
                   4335: 		    $question++;
                   4336: 		}
1.196     albertel 4337: 		$prob++;
1.71      ng       4338: 	    }
                   4339: 	    $studentTable.='</td></tr>';
1.68      ng       4340: 
1.103     albertel 4341: 	}
1.68      ng       4342:         $curRes = $iterator->next();
                   4343:     }
                   4344: 
1.485     albertel 4345:     $studentTable.='</table>'."\n".
                   4346: 	'<input type="button" value="'.&mt('Save').'" '.
1.381     albertel 4347: 	'onClick="javascript:checkSubmitPage(this.form,'.$question.');" />'.
1.71      ng       4348: 	'</form>'."\n";
1.324     albertel 4349:     $studentTable.=&show_grading_menu_form($symb);
1.71      ng       4350:     $request->print($studentTable);
                   4351: 
                   4352:     return '';
1.119     ng       4353: }
                   4354: 
                   4355: sub displaySubByDates {
1.148     albertel 4356:     my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
1.224     albertel 4357:     my $isCODE=0;
1.335     albertel 4358:     my $isTask = ($symb =~/\.task$/);
1.224     albertel 4359:     if (exists($record->{'resource.CODE'})) { $isCODE=1; }
1.467     albertel 4360:     my $studentTable=&Apache::loncommon::start_data_table().
                   4361: 	&Apache::loncommon::start_data_table_header_row().
                   4362: 	'<th>'.&mt('Date/Time').'</th>'.
                   4363: 	($isCODE?'<th>'.&mt('CODE').'</th>':'').
                   4364: 	'<th>'.&mt('Submission').'</th>'.
                   4365: 	'<th>'.&mt('Status').'</th>'.
                   4366: 	&Apache::loncommon::end_data_table_header_row();
1.119     ng       4367:     my ($version);
                   4368:     my %mark;
1.148     albertel 4369:     my %orders;
1.119     ng       4370:     $mark{'correct_by_student'} = $checkIcon;
1.147     albertel 4371:     if (!exists($$record{'1:timestamp'})) {
1.467     albertel 4372: 	return '<br />&nbsp;<span class="LC_warning">'.&mt('Nothing submitted - no attempts').'</span><br />';
1.147     albertel 4373:     }
1.335     albertel 4374: 
                   4375:     my $interaction;
1.525     raeburn  4376:     my $no_increment = 1;
1.119     ng       4377:     for ($version=1;$version<=$$record{'version'};$version++) {
1.467     albertel 4378: 	my $timestamp = 
                   4379: 	    &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'});
1.335     albertel 4380: 	if (exists($$record{$version.':resource.0.version'})) {
                   4381: 	    $interaction = $$record{$version.':resource.0.version'};
                   4382: 	}
                   4383: 
                   4384: 	my $where = ($isTask ? "$version:resource.$interaction"
                   4385: 		             : "$version:resource");
1.467     albertel 4386: 	$studentTable.=&Apache::loncommon::start_data_table_row().
                   4387: 	    '<td>'.$timestamp.'</td>';
1.224     albertel 4388: 	if ($isCODE) {
                   4389: 	    $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';
                   4390: 	}
1.119     ng       4391: 	my @versionKeys = split(/\:/,$$record{$version.':keys'});
                   4392: 	my @displaySub = ();
                   4393: 	foreach my $partid (@{$parts}) {
1.335     albertel 4394: 	    my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)
                   4395: 			            : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
                   4396: 	    
                   4397: 
1.122     ng       4398: #	    next if ($$record{"$version:resource.$partid.solved"} eq '');
1.324     albertel 4399: 	    my $display_part=&get_display_part($partid,$symb);
1.147     albertel 4400: 	    foreach my $matchKey (@matchKey) {
1.198     albertel 4401: 		if (exists($$record{$version.':'.$matchKey}) &&
                   4402: 		    $$record{$version.':'.$matchKey} ne '') {
1.335     albertel 4403: 
                   4404: 		    my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
                   4405: 				               : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
1.467     albertel 4406: 		    $displaySub[0].='<b>'.&mt('Part:').'</b>&nbsp;'.$display_part.'&nbsp;';
                   4407: 		    $displaySub[0].='<span class="LC_internal_info">('.&mt('ID').'&nbsp;'.
1.398     albertel 4408: 			$responseId.')</span>&nbsp;<b>';
1.335     albertel 4409: 		    if ($$record{"$where.$partid.tries"} eq '') {
1.467     albertel 4410: 			$displaySub[0].=&mt('Trial&nbsp;not&nbsp;counted');
1.147     albertel 4411: 		    } else {
1.467     albertel 4412: 			$displaySub[0].=&mt('Trial&nbsp;[_1]',
                   4413: 					    $$record{"$where.$partid.tries"});
1.147     albertel 4414: 		    }
1.335     albertel 4415: 		    my $responseType=($isTask ? 'Task'
                   4416:                                               : $responseType->{$partid}->{$responseId});
1.148     albertel 4417: 		    if (!exists($orders{$partid})) { $orders{$partid}={}; }
                   4418: 		    if (!exists($orders{$partid}->{$responseId})) {
                   4419: 			$orders{$partid}->{$responseId}=
1.525     raeburn  4420: 			    &get_order($partid,$responseId,$symb,$uname,$udom,
                   4421:                                        $no_increment);
1.148     albertel 4422: 		    }
1.147     albertel 4423: 		    $displaySub[0].='</b>&nbsp; '.
1.336     albertel 4424: 			&cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'<br />';
1.147     albertel 4425: 		}
                   4426: 	    }
1.335     albertel 4427: 	    if (exists($$record{"$where.$partid.checkedin"})) {
1.485     albertel 4428: 		$displaySub[1].=&mt('Checked in by [_1] into slot [_2]',
                   4429: 				    $$record{"$where.$partid.checkedin"},
                   4430: 				    $$record{"$where.$partid.checkedin.slot"}).
                   4431: 					'<br />';
1.335     albertel 4432: 	    }
                   4433: 	    if (exists $$record{"$where.$partid.award"}) {
1.485     albertel 4434: 		$displaySub[1].='<b>'.&mt('Part:').'</b>&nbsp;'.$display_part.' &nbsp;'.
1.335     albertel 4435: 		    lc($$record{"$where.$partid.award"}).' '.
                   4436: 		    $mark{$$record{"$where.$partid.solved"}}.
1.147     albertel 4437: 		    '<br />';
                   4438: 	    }
1.335     albertel 4439: 	    if (exists $$record{"$where.$partid.regrader"}) {
                   4440: 		$displaySub[2].=$$record{"$where.$partid.regrader"}.
                   4441: 		    ' (<b>'.&mt('Part').':</b> '.$display_part.')';
                   4442: 	    } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) {
                   4443: 		$displaySub[2].=
                   4444: 		    $$record{"$version:resource.$partid.regrader"}.
1.207     albertel 4445: 		    ' (<b>'.&mt('Part').':</b> '.$display_part.')';
1.147     albertel 4446: 	    }
                   4447: 	}
                   4448: 	# needed because old essay regrader has not parts info
                   4449: 	if (exists $$record{"$version:resource.regrader"}) {
                   4450: 	    $displaySub[2].=$$record{"$version:resource.regrader"};
                   4451: 	}
                   4452: 	$studentTable.='<td>'.$displaySub[0].'&nbsp;</td><td>'.$displaySub[1];
                   4453: 	if ($displaySub[2]) {
1.467     albertel 4454: 	    $studentTable.=&mt('Manually graded by [_1]',$displaySub[2]);
1.147     albertel 4455: 	}
1.467     albertel 4456: 	$studentTable.='&nbsp;</td>'.
                   4457: 	    &Apache::loncommon::end_data_table_row();
1.119     ng       4458:     }
1.467     albertel 4459:     $studentTable.=&Apache::loncommon::end_data_table();
1.119     ng       4460:     return $studentTable;
1.71      ng       4461: }
                   4462: 
                   4463: sub updateGradeByPage {
                   4464:     my ($request) = shift;
                   4465: 
1.257     albertel 4466:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4467:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4468:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
                   4469:     my $pageTitle = $env{'form.page'};
1.103     albertel 4470:     my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
1.257     albertel 4471:     my ($uname,$udom) = split(/:/,$env{'form.student'});
                   4472:     my $usec=$classlist->{$env{'form.student'}}[5];
1.103     albertel 4473:     if (!&canmodify($usec)) {
1.526     raeburn  4474: 	$request->print('<span class="LC_warning">'.&mt('Unable to modify requested student ([_1])',$env{'form.student'}).'</span>');
1.324     albertel 4475: 	$request->print(&show_grading_menu_form($env{'form.symb'}));
1.103     albertel 4476: 	return;
                   4477:     }
1.398     albertel 4478:     my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';
1.526     raeburn  4479:     $result.='<h3>&nbsp;'.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
1.129     ng       4480: 	'</h3>'."\n";
1.70      ng       4481: 
1.68      ng       4482:     $request->print($result);
                   4483: 
1.132     bowersj2 4484:     my $navmap = Apache::lonnavmaps::navmap->new();
1.257     albertel 4485:     my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'});
1.71      ng       4486:     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
1.288     albertel 4487:     if (!$map) {
1.527     raeburn  4488: 	$request->print('<span class="LC_warning">'.&mt('Unable to grade requested sequence ([_1]).',$resUrl).'</span>');
1.324     albertel 4489: 	my ($symb)=&get_symb($request);
                   4490: 	$request->print(&show_grading_menu_form($symb));
1.288     albertel 4491: 	return; 
                   4492:     }
1.71      ng       4493:     my $iterator = $navmap->getIterator($map->map_start(),
                   4494: 					$map->map_finish());
1.70      ng       4495: 
1.484     albertel 4496:     my $studentTable=
                   4497: 	&Apache::loncommon::start_data_table().
                   4498: 	&Apache::loncommon::start_data_table_header_row().
1.485     albertel 4499: 	'<th align="center">&nbsp;'.&mt('Prob.').'&nbsp;</th>'.
                   4500: 	'<th>&nbsp;'.&mt('Title').'&nbsp;</th>'.
                   4501: 	'<th>&nbsp;'.&mt('Previous Score').'&nbsp;</th>'.
                   4502: 	'<th>&nbsp;'.&mt('New Score').'&nbsp;</th>'.
1.484     albertel 4503: 	&Apache::loncommon::end_data_table_header_row();
1.71      ng       4504: 
                   4505:     $iterator->next(); # skip the first BEGIN_MAP
                   4506:     my $curRes = $iterator->next(); # for "current resource"
1.196     albertel 4507:     my ($depth,$question,$prob,$changeflag)= (1,1,1,0);
1.101     albertel 4508:     while ($depth > 0) {
1.71      ng       4509:         if($curRes == $iterator->BEGIN_MAP) { $depth++; }
1.100     bowersj2 4510:         if($curRes == $iterator->END_MAP) { $depth--; }
1.71      ng       4511: 
1.385     albertel 4512:         if (ref($curRes) && $curRes->is_problem()) {
1.91      albertel 4513: 	    my $parts = $curRes->parts();
1.71      ng       4514:             my $title = $curRes->compTitle();
                   4515: 	    my $symbx = $curRes->symb();
1.484     albertel 4516: 	    $studentTable.=
                   4517: 		&Apache::loncommon::start_data_table_row().
                   4518: 		'<td align="center" valign="top" >'.$prob.
1.485     albertel 4519: 		(scalar(@{$parts}) == 1 ? '' 
1.526     raeburn  4520:                                         : '<br />('.&mt('[quant,_1,&nbsp;part]',scalar(@{$parts}))
                   4521: 		.')').'</td>';
1.71      ng       4522: 	    $studentTable.='<td valign="top">&nbsp;<b>'.$title.'</b>&nbsp;</td>';
                   4523: 
                   4524: 	    my %newrecord=();
                   4525: 	    my @displayPts=();
1.269     raeburn  4526:             my %aggregate = ();
                   4527:             my $aggregateflag = 0;
1.71      ng       4528: 	    foreach my $partid (@{$parts}) {
1.257     albertel 4529: 		my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};
                   4530: 		my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};
1.71      ng       4531: 
1.257     albertel 4532: 		my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? 
                   4533: 		    $env{'form.WGT'.$question.'_'.$partid} : 1;
1.71      ng       4534: 		my $partial = $newpts/$wgt;
                   4535: 		my $score;
                   4536: 		if ($partial > 0) {
                   4537: 		    $score = 'correct_by_override';
1.125     ng       4538: 		} elsif ($newpts ne '') { #empty is taken as 0
1.71      ng       4539: 		    $score = 'incorrect_by_override';
                   4540: 		}
1.257     albertel 4541: 		my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid};
1.125     ng       4542: 		if ($dropMenu eq 'excused') {
1.71      ng       4543: 		    $partial = '';
                   4544: 		    $score = 'excused';
1.125     ng       4545: 		} elsif ($dropMenu eq 'reset status'
1.257     albertel 4546: 			 && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists
1.125     ng       4547: 		    $newrecord{'resource.'.$partid.'.tries'} = 0;
                   4548: 		    $newrecord{'resource.'.$partid.'.solved'} = '';
                   4549: 		    $newrecord{'resource.'.$partid.'.award'} = '';
                   4550: 		    $newrecord{'resource.'.$partid.'.awarded'} = 0;
1.257     albertel 4551: 		    $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}";
1.125     ng       4552: 		    $changeflag++;
                   4553: 		    $newpts = '';
1.269     raeburn  4554:                     
                   4555:                     my $aggtries =  $env{'form.aggtries'.$question.'_'.$partid};
                   4556:                     my $totaltries = $env{'form.totaltries'.$question.'_'.$partid};
                   4557:                     my $solvedstatus = $env{'form.solved'.$question.'_'.$partid};
                   4558:                     if ($aggtries > 0) {
                   4559:                         &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                   4560:                         $aggregateflag = 1;
                   4561:                     }
1.71      ng       4562: 		}
1.324     albertel 4563: 		my $display_part=&get_display_part($partid,$curRes->symb());
1.257     albertel 4564: 		my $oldstatus = $env{'form.solved'.$question.'_'.$partid};
1.526     raeburn  4565: 		$displayPts[0].='&nbsp;<b>'.&mt('Part').':</b> '.$display_part.' = '.
1.71      ng       4566: 		    (($oldstatus eq 'excused') ? 'excused' : $oldpts).
1.326     albertel 4567: 		    '&nbsp;<br />';
1.526     raeburn  4568: 		$displayPts[1].='&nbsp;<b>'.&mt('Part').':</b> '.$display_part.' = '.
1.125     ng       4569: 		     (($score eq 'excused') ? 'excused' : $newpts).
1.326     albertel 4570: 		    '&nbsp;<br />';
1.71      ng       4571: 		$question++;
1.380     albertel 4572: 		next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused'));
1.125     ng       4573: 
1.71      ng       4574: 		$newrecord{'resource.'.$partid.'.awarded'}  = $partial if $partial ne '';
1.125     ng       4575: 		$newrecord{'resource.'.$partid.'.solved'}   = $score if $score ne '';
1.257     albertel 4576: 		$newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"
1.125     ng       4577: 		    if (scalar(keys(%newrecord)) > 0);
1.71      ng       4578: 
                   4579: 		$changeflag++;
                   4580: 	    }
                   4581: 	    if (scalar(keys(%newrecord)) > 0) {
1.382     albertel 4582: 		my %record = 
                   4583: 		    &Apache::lonnet::restore($symbx,$env{'request.course.id'},
                   4584: 					     $udom,$uname);
                   4585: 
                   4586: 		if (&Apache::lonnet::validCODE($env{'form.CODE'})) {
                   4587: 		    $newrecord{'resource.CODE'} = $env{'form.CODE'};
                   4588: 		} elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) {
                   4589: 		    $newrecord{'resource.CODE'} = '';
                   4590: 		}
1.257     albertel 4591: 		&Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'},
1.71      ng       4592: 					$udom,$uname);
1.382     albertel 4593: 		%record = &Apache::lonnet::restore($symbx,
                   4594: 						   $env{'request.course.id'},
                   4595: 						   $udom,$uname);
1.380     albertel 4596: 		&check_and_remove_from_queue($parts,\%record,undef,$symbx,
                   4597: 					     $cdom,$cnum,$udom,$uname);
1.71      ng       4598: 	    }
1.380     albertel 4599: 	    
1.269     raeburn  4600:             if ($aggregateflag) {
                   4601:                 &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
                   4602:                       $env{'course.'.$env{'request.course.id'}.'.domain'},
                   4603:                       $env{'course.'.$env{'request.course.id'}.'.num'});
                   4604:             }
1.125     ng       4605: 
1.71      ng       4606: 	    $studentTable.='<td valign="top">'.$displayPts[0].'</td>'.
                   4607: 		'<td valign="top">'.$displayPts[1].'</td>'.
1.484     albertel 4608: 		&Apache::loncommon::end_data_table_row();
1.68      ng       4609: 
1.196     albertel 4610: 	    $prob++;
1.68      ng       4611: 	}
1.71      ng       4612:         $curRes = $iterator->next();
1.68      ng       4613:     }
1.98      albertel 4614: 
1.484     albertel 4615:     $studentTable.=&Apache::loncommon::end_data_table();
1.324     albertel 4616:     $studentTable.=&show_grading_menu_form($env{'form.symb'});
1.526     raeburn  4617:     my $grademsg=($changeflag == 0 ? &mt('No score was changed or updated.') :
                   4618: 		  &mt('The scores were changed for [quant,_1,problem].',
                   4619: 		  $changeflag));
1.76      ng       4620:     $request->print($grademsg.$studentTable);
1.68      ng       4621: 
1.70      ng       4622:     return '';
                   4623: }
                   4624: 
1.72      ng       4625: #-------- end of section for handling grading by page/sequence ---------
                   4626: #
                   4627: #-------------------------------------------------------------------
                   4628: 
1.75      albertel 4629: #--------------------Scantron Grading-----------------------------------
                   4630: #
                   4631: #------ start of section for handling grading by page/sequence ---------
                   4632: 
1.423     albertel 4633: =pod
                   4634: 
                   4635: =head1 Bubble sheet grading routines
                   4636: 
1.424     albertel 4637:   For this documentation:
                   4638: 
                   4639:    'scanline' refers to the full line of characters
                   4640:    from the file that we are parsing that represents one entire sheet
                   4641: 
                   4642:    'bubble line' refers to the data
                   4643:    representing the line of bubbles that are on the physical bubble sheet
                   4644: 
                   4645: 
                   4646: The overall process is that a scanned in bubble sheet data is uploaded
                   4647: into a course. When a user wants to grade, they select a
                   4648: sequence/folder of resources, a file of bubble sheet info, and pick
                   4649: one of the predefined configurations for what each scanline looks
                   4650: like.
                   4651: 
                   4652: Next each scanline is checked for any errors of either 'missing
1.435     foxr     4653: bubbles' (it's an error because it may have been mis-scanned
1.424     albertel 4654: because too light bubbling), 'double bubble' (each bubble line should
                   4655: have no more that one letter picked), invalid or duplicated CODE,
                   4656: invalid student ID
                   4657: 
                   4658: If the CODE option is used that determines the randomization of the
                   4659: homework problems, either way the student ID is looked up into a
                   4660: username:domain.
                   4661: 
                   4662: During the validation phase the instructor can choose to skip scanlines. 
                   4663: 
1.435     foxr     4664: After the validation phase, there are now 3 bubble sheet files
1.424     albertel 4665: 
                   4666:   scantron_original_filename (unmodified original file)
                   4667:   scantron_corrected_filename (file where the corrected information has replaced the original information)
                   4668:   scantron_skipped_filename (contains the exact text of scanlines that where skipped)
                   4669: 
                   4670: Also there is a separate hash nohist_scantrondata that contains extra
                   4671: correction information that isn't representable in the bubble sheet
                   4672: file (see &scantron_getfile() for more information)
                   4673: 
                   4674: After all scanlines are either valid, marked as valid or skipped, then
                   4675: foreach line foreach problem in the picked sequence, an ssi request is
                   4676: made that simulates a user submitting their selected letter(s) against
                   4677: the homework problem.
1.423     albertel 4678: 
                   4679: =over 4
                   4680: 
                   4681: 
                   4682: 
                   4683: =item defaultFormData
                   4684: 
                   4685:   Returns html hidden inputs used to hold context/default values.
                   4686: 
                   4687:  Arguments:
                   4688:   $symb - $symb of the current resource 
                   4689: 
                   4690: =cut
1.422     foxr     4691: 
1.81      albertel 4692: sub defaultFormData {
1.324     albertel 4693:     my ($symb)=@_;
1.447     foxr     4694:     return '<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 4695:      '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
                   4696:      '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
1.81      albertel 4697: }
                   4698: 
1.447     foxr     4699: 
1.423     albertel 4700: =pod 
                   4701: 
                   4702: =item getSequenceDropDown
                   4703: 
                   4704:    Return html dropdown of possible sequences to grade
                   4705:  
                   4706:  Arguments:
                   4707:    $symb - $symb of the current resource 
                   4708: 
                   4709: =cut
1.422     foxr     4710: 
1.75      albertel 4711: sub getSequenceDropDown {
1.423     albertel 4712:     my ($symb)=@_;
1.75      albertel 4713:     my $result='<select name="selectpage">'."\n";
1.423     albertel 4714:     my ($titles,$symbx) = &getSymbMap();
1.137     albertel 4715:     my ($curpage)=&Apache::lonnet::decode_symb($symb); 
1.75      albertel 4716:     my $ctr=0;
                   4717:     foreach (@$titles) {
                   4718: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
                   4719: 	$result.='<option value="'.$$symbx{$_}.'" '.
1.401     albertel 4720: 	    ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : '').
1.75      albertel 4721: 	    '>'.$showtitle.'</option>'."\n";
                   4722: 	$ctr++;
                   4723:     }
                   4724:     $result.= '</select>';
                   4725:     return $result;
                   4726: }
                   4727: 
1.495     albertel 4728: my %bubble_lines_per_response;     # no. bubble lines for each response.
                   4729:                                    # index is "symb.part_id"
                   4730: 
                   4731: my %first_bubble_line;             # First bubble line no. for each bubble.
                   4732: 
1.509     raeburn  4733: my %subdivided_bubble_lines;       # no. bubble lines for optionresponse, 
                   4734:                                    # matchresponse or rankresponse, where 
                   4735:                                    # an individual response can have multiple 
                   4736:                                    # lines
1.503     raeburn  4737: 
                   4738: my %responsetype_per_response;     # responsetype for each response
                   4739: 
1.495     albertel 4740: # Save and restore the bubble lines array to the form env.
                   4741: 
                   4742: 
                   4743: sub save_bubble_lines {
                   4744:     foreach my $line (keys(%bubble_lines_per_response)) {
                   4745: 	$env{"form.scantron.bubblelines.$line"}  = $bubble_lines_per_response{$line};
                   4746: 	$env{"form.scantron.first_bubble_line.$line"} =
                   4747: 	    $first_bubble_line{$line};
1.503     raeburn  4748:         $env{"form.scantron.sub_bubblelines.$line"} = 
                   4749:             $subdivided_bubble_lines{$line};
                   4750:         $env{"form.scantron.responsetype.$line"} =
                   4751:             $responsetype_per_response{$line};
1.495     albertel 4752:     }
                   4753: }
                   4754: 
                   4755: 
                   4756: sub restore_bubble_lines {
                   4757:     my $line = 0;
                   4758:     %bubble_lines_per_response = ();
                   4759:     while ($env{"form.scantron.bubblelines.$line"}) {
                   4760: 	my $value = $env{"form.scantron.bubblelines.$line"};
                   4761: 	$bubble_lines_per_response{$line} = $value;
                   4762: 	$first_bubble_line{$line}  =
                   4763: 	    $env{"form.scantron.first_bubble_line.$line"};
1.503     raeburn  4764:         $subdivided_bubble_lines{$line} =
                   4765:             $env{"form.scantron.sub_bubblelines.$line"};
                   4766:         $responsetype_per_response{$line} =
                   4767:             $env{"form.scantron.responsetype.$line"};
1.495     albertel 4768: 	$line++;
                   4769:     }
                   4770: 
                   4771: }
                   4772: 
                   4773: #  Given the parsed scanline, get the response for 
                   4774: #  'answer' number n:
                   4775: 
                   4776: sub get_response_bubbles {
                   4777:     my ($parsed_line, $response)  = @_;
                   4778: 
                   4779: 
                   4780:     my $bubble_line = $first_bubble_line{$response-1} +1;
                   4781:     my $bubble_lines= $bubble_lines_per_response{$response-1};
                   4782:     
                   4783:     my $selected = "";
                   4784: 
                   4785:     for (my $bline = 0; $bline < $bubble_lines; $bline++) {
                   4786: 	$selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":";
                   4787: 	$bubble_line++;
                   4788:     }
                   4789:     return $selected;
                   4790: }
1.423     albertel 4791: 
                   4792: =pod 
                   4793: 
                   4794: =item scantron_filenames
                   4795: 
                   4796:    Returns a list of the scantron files in the current course 
                   4797: 
                   4798: =cut
1.422     foxr     4799: 
1.202     albertel 4800: sub scantron_filenames {
1.257     albertel 4801:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   4802:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
1.517     raeburn  4803:     my $getpropath = 1;
1.157     albertel 4804:     my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
1.517     raeburn  4805:                                        $getpropath);
1.202     albertel 4806:     my @possiblenames;
1.201     albertel 4807:     foreach my $filename (sort(@files)) {
1.157     albertel 4808: 	($filename)=split(/&/,$filename);
                   4809: 	if ($filename!~/^scantron_orig_/) { next ; }
                   4810: 	$filename=~s/^scantron_orig_//;
1.202     albertel 4811: 	push(@possiblenames,$filename);
                   4812:     }
                   4813:     return @possiblenames;
                   4814: }
                   4815: 
1.423     albertel 4816: =pod 
                   4817: 
                   4818: =item scantron_uploads
                   4819: 
                   4820:    Returns  html drop-down list of scantron files in current course.
                   4821: 
                   4822:  Arguments:
                   4823:    $file2grade - filename to set as selected in the dropdown
                   4824: 
                   4825: =cut
1.422     foxr     4826: 
1.202     albertel 4827: sub scantron_uploads {
1.209     ng       4828:     my ($file2grade) = @_;
1.202     albertel 4829:     my $result=	'<select name="scantron_selectfile">';
                   4830:     $result.="<option></option>";
                   4831:     foreach my $filename (sort(&scantron_filenames())) {
1.401     albertel 4832: 	$result.="<option".($filename eq $file2grade ? ' selected="selected"':'').">$filename</option>\n";
1.81      albertel 4833:     }
                   4834:     $result.="</select>";
                   4835:     return $result;
                   4836: }
                   4837: 
1.423     albertel 4838: =pod 
                   4839: 
                   4840: =item scantron_scantab
                   4841: 
                   4842:   Returns html drop down of the scantron formats in the scantronformat.tab
                   4843:   file.
                   4844: 
                   4845: =cut
1.422     foxr     4846: 
1.82      albertel 4847: sub scantron_scantab {
                   4848:     my $result='<select name="scantron_format">'."\n";
1.191     albertel 4849:     $result.='<option></option>'."\n";
1.518     raeburn  4850:     my @lines = &get_scantronformat_file();
                   4851:     if (@lines > 0) {
                   4852:         foreach my $line (@lines) {
                   4853:             next if (($line =~ /^\#/) || ($line eq ''));
                   4854: 	    my ($name,$descrip)=split(/:/,$line);
                   4855: 	    $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n";
                   4856:         }
1.82      albertel 4857:     }
                   4858:     $result.='</select>'."\n";
1.518     raeburn  4859:     return $result;
                   4860: }
                   4861: 
                   4862: =pod
                   4863: 
                   4864: =item get_scantronformat_file
                   4865: 
                   4866:   Returns an array containing lines from the scantron format file for
                   4867:   the domain of the course.
                   4868: 
                   4869:   If a url for a custom.tab file is listed in domain's configuration.db, 
                   4870:   lines are from this file.
                   4871: 
                   4872:   Otherwise, if a default.tab has been published in RES space by the 
                   4873:   domainconfig user, lines are from this file.
                   4874: 
                   4875:   Otherwise, fall back to getting lines from the legacy file on the
1.519     raeburn  4876:   local server:  /home/httpd/lonTabs/default_scantronformat.tab    
1.82      albertel 4877: 
1.518     raeburn  4878: =cut
                   4879: 
                   4880: sub get_scantronformat_file {
                   4881:     my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4882:     my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom);
                   4883:     my $gottab = 0;
                   4884:     my @lines;
                   4885:     if (ref($domconfig{'scantron'}) eq 'HASH') {
                   4886:         if ($domconfig{'scantron'}{'scantronformat'} ne '') {
                   4887:             my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'});
                   4888:             if ($formatfile ne '-1') {
                   4889:                 @lines = split("\n",$formatfile,-1);
                   4890:                 $gottab = 1;
                   4891:             }
                   4892:         }
                   4893:     }
                   4894:     if (!$gottab) {
                   4895:         my $confname = $cdom.'-domainconfig';
                   4896:         my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab';
                   4897:         my $formatfile =  &Apache::lonnet::getfile($default);
                   4898:         if ($formatfile ne '-1') {
                   4899:             @lines = split("\n",$formatfile,-1);
                   4900:             $gottab = 1;
                   4901:         }
                   4902:     }
                   4903:     if (!$gottab) {
1.519     raeburn  4904:         my @domains = &Apache::lonnet::current_machine_domains();
                   4905:         if (grep(/^\Q$cdom\E$/,@domains)) {
                   4906:             my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
                   4907:             @lines = <$fh>;
                   4908:             close($fh);
                   4909:         } else {
                   4910:             my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab');
                   4911:             @lines = <$fh>;
                   4912:             close($fh);
                   4913:         }
1.518     raeburn  4914:     }
                   4915:     return @lines;
1.82      albertel 4916: }
                   4917: 
1.423     albertel 4918: =pod 
                   4919: 
                   4920: =item scantron_CODElist
                   4921: 
                   4922:   Returns html drop down of the saved CODE lists from current course,
                   4923:   generated from earlier printings.
                   4924: 
                   4925: =cut
1.422     foxr     4926: 
1.186     albertel 4927: sub scantron_CODElist {
1.257     albertel 4928:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4929:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.186     albertel 4930:     my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum);
                   4931:     my $namechoice='<option></option>';
1.225     albertel 4932:     foreach my $name (sort {uc($a) cmp uc($b)} @names) {
1.191     albertel 4933: 	if ($name =~ /^error: 2 /) { next; }
1.278     albertel 4934: 	if ($name =~ /^type\0/) { next; }
1.186     albertel 4935: 	$namechoice.='<option value="'.$name.'">'.$name.'</option>';
                   4936:     }
                   4937:     $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>';
                   4938:     return $namechoice;
                   4939: }
                   4940: 
1.423     albertel 4941: =pod 
                   4942: 
                   4943: =item scantron_CODEunique
                   4944: 
                   4945:   Returns the html for "Each CODE to be used once" radio.
                   4946: 
                   4947: =cut
1.422     foxr     4948: 
1.186     albertel 4949: sub scantron_CODEunique {
1.532     bisitz   4950:     my $result='<span class="LC_nobreak">
1.272     albertel 4951:                  <label><input type="radio" name="scantron_CODEunique"
1.423     albertel 4952:                         value="yes" checked="checked" />'.&mt('Yes').' </label>
1.381     albertel 4953:                 </span>
1.532     bisitz   4954:                 <span class="LC_nobreak">
1.272     albertel 4955:                  <label><input type="radio" name="scantron_CODEunique"
1.423     albertel 4956:                         value="no" />'.&mt('No').' </label>
1.381     albertel 4957:                 </span>';
1.186     albertel 4958:     return $result;
                   4959: }
1.423     albertel 4960: 
                   4961: =pod 
                   4962: 
                   4963: =item scantron_selectphase
                   4964: 
                   4965:   Generates the initial screen to start the bubble sheet process.
                   4966:   Allows for - starting a grading run.
1.424     albertel 4967:              - downloading existing scan data (original, corrected
1.423     albertel 4968:                                                 or skipped info)
                   4969: 
                   4970:              - uploading new scan data
                   4971: 
                   4972:  Arguments:
                   4973:   $r          - The Apache request object
                   4974:   $file2grade - name of the file that contain the scanned data to score
                   4975: 
                   4976: =cut
1.186     albertel 4977: 
1.75      albertel 4978: sub scantron_selectphase {
1.209     ng       4979:     my ($r,$file2grade) = @_;
1.324     albertel 4980:     my ($symb)=&get_symb($r);
1.75      albertel 4981:     if (!$symb) {return '';}
1.423     albertel 4982:     my $sequence_selector=&getSequenceDropDown($symb);
1.324     albertel 4983:     my $default_form_data=&defaultFormData($symb);
                   4984:     my $grading_menu_button=&show_grading_menu_form($symb);
1.209     ng       4985:     my $file_selector=&scantron_uploads($file2grade);
1.82      albertel 4986:     my $format_selector=&scantron_scantab();
1.186     albertel 4987:     my $CODE_selector=&scantron_CODElist();
                   4988:     my $CODE_unique=&scantron_CODEunique();
1.75      albertel 4989:     my $result;
1.422     foxr     4990: 
1.513     foxr     4991:     $ssi_error = 0;
                   4992: 
1.422     foxr     4993:     # Chunk of form to prompt for a file to grade and how:
                   4994: 
1.489     albertel 4995:     $result.= '
                   4996:     <br />
                   4997:     <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process">
                   4998:     <input type="hidden" name="command" value="scantron_warning" />
                   4999:     '.$default_form_data.'
                   5000:     '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   5001:        '.&Apache::loncommon::start_data_table_header_row().'
                   5002:             <th colspan="2">
1.492     albertel 5003:               &nbsp;'.&mt('Specify file and which Folder/Sequence to grade').'
1.489     albertel 5004:             </th>
                   5005:        '.&Apache::loncommon::end_data_table_header_row().'
                   5006:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5007:             <td> '.&mt('Sequence to grade:').' </td><td> '.$sequence_selector.' </td>
1.489     albertel 5008:        '.&Apache::loncommon::end_data_table_row().'
                   5009:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5010:             <td> '.&mt('Filename of scoring office file:').' </td><td> '.$file_selector.' </td>
1.489     albertel 5011:        '.&Apache::loncommon::end_data_table_row().'
                   5012:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5013:             <td> '.&mt('Format of data file:').' </td><td> '.$format_selector.' </td>
1.489     albertel 5014:        '.&Apache::loncommon::end_data_table_row().'
                   5015:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5016:             <td> '.&mt('Saved CODEs to validate against:').' </td><td> '.$CODE_selector.' </td>
1.489     albertel 5017:        '.&Apache::loncommon::end_data_table_row().'
                   5018:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5019:             <td> '.&mt('Each CODE is only to be used once:').'</td><td> '.$CODE_unique.' </td>
1.489     albertel 5020:        '.&Apache::loncommon::end_data_table_row().'
                   5021:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5022: 	    <td> '.&mt('Options:').' </td>
1.187     albertel 5023:             <td>
1.492     albertel 5024: 	       <label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> '.&mt('Do only previously skipped records').'</label> <br />
                   5025:                <label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> '.&mt('Remove all existing corrections').'</label> <br />
                   5026:                <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources when grading').'</label>
1.187     albertel 5027: 	    </td>
1.489     albertel 5028:        '.&Apache::loncommon::end_data_table_row().'
                   5029:        '.&Apache::loncommon::start_data_table_row().'
1.174     albertel 5030:             <td colspan="2">
1.492     albertel 5031:               <input type="submit" value="'.&mt('Grading: Validate Scantron Records').'" />
1.162     albertel 5032:             </td>
1.489     albertel 5033:        '.&Apache::loncommon::end_data_table_row().'
                   5034:     '.&Apache::loncommon::end_data_table().'
                   5035:     </form>
                   5036: ';
1.162     albertel 5037:    
                   5038:     $r->print($result);
                   5039: 
1.257     albertel 5040:     if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||
                   5041:         &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
1.162     albertel 5042: 
1.422     foxr     5043: 	# Chunk of form to prompt for a scantron file upload.
                   5044: 
1.489     albertel 5045:         $r->print('
                   5046:     <br />
                   5047:     '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   5048:        '.&Apache::loncommon::start_data_table_header_row().'
                   5049:             <th>
1.492     albertel 5050:               &nbsp;'.&mt('Specify a Scantron data file to upload.').'
1.489     albertel 5051:             </th>
                   5052:        '.&Apache::loncommon::end_data_table_header_row().'
                   5053:        '.&Apache::loncommon::start_data_table_row().'
1.162     albertel 5054:             <td>
1.489     albertel 5055: ');
1.324     albertel 5056:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.257     albertel 5057:     my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5058:     my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'};
1.492     albertel 5059:     $r->print('
1.174     albertel 5060:               <script type="text/javascript" language="javascript">
                   5061:     function checkUpload(formname) {
                   5062: 	if (formname.upfile.value == "") {
1.492     albertel 5063: 	    alert("'.&mt('Please use the browse button to select a file from your local directory.').'");
1.174     albertel 5064: 	    return false;
                   5065: 	}
                   5066: 	formname.submit();
                   5067:     }
                   5068:               </script>
                   5069: 
1.492     albertel 5070:               <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post">
                   5071:                 '.$default_form_data.'
                   5072:                 <input name="courseid" type="hidden" value="'.$cnum.'" />
                   5073:                 <input name="domainid" type="hidden" value="'.$cdom.'" />
                   5074:                 <input name="command" value="scantronupload_save" type="hidden" />
                   5075:                 '.&mt('File to upload: [_1]','<input type="file" name="upfile" size="50" />').'
1.174     albertel 5076:                 <br />
1.492     albertel 5077:                 <input type="button" onClick="javascript:checkUpload(this.form);" value="'.&mt('Upload Scantron Data').'" />
1.174     albertel 5078:               </form>
1.492     albertel 5079: ');
1.162     albertel 5080: 
1.489     albertel 5081:         $r->print('
1.162     albertel 5082:             </td>
1.489     albertel 5083:        '.&Apache::loncommon::end_data_table_row().'
                   5084:        '.&Apache::loncommon::end_data_table().'
                   5085: ');
1.162     albertel 5086:     }
1.422     foxr     5087: 
                   5088:     # Chunk of the form that prompts to view a scoring office file,
                   5089:     # corrected file, skipped records in a file.
                   5090: 
1.489     albertel 5091:     $r->print('
                   5092:    <br />
                   5093:    <form action="/adm/grades" name="scantron_download">
                   5094:      '.$default_form_data.'
                   5095:      <input type="hidden" name="command" value="scantron_download" />
                   5096:      '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   5097:        '.&Apache::loncommon::start_data_table_header_row().'
                   5098:               <th>
1.492     albertel 5099:                 &nbsp;'.&mt('Download a scoring office file').'
1.489     albertel 5100:               </th>
                   5101:        '.&Apache::loncommon::end_data_table_header_row().'
                   5102:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5103:               <td> '.&mt('Filename of scoring office file: [_1]',$file_selector).' 
1.489     albertel 5104:                 <br />
1.492     albertel 5105:                 <input type="submit" value="'.&mt('Download: Show List of Associated Files').'" />
1.489     albertel 5106:        '.&Apache::loncommon::end_data_table_row().'
                   5107:      '.&Apache::loncommon::end_data_table().'
                   5108:    </form>
                   5109:    <br />
                   5110: ');
1.162     albertel 5111: 
1.457     banghart 5112:     &Apache::lonpickcode::code_list($r,2);
1.523     raeburn  5113: 
1.528     raeburn  5114:     $r->print('<br /><form method="post" name="checkscantron">'.
1.523     raeburn  5115:              $default_form_data."\n".
                   5116:              &Apache::loncommon::start_data_table('LC_scantron_action')."\n".
                   5117:              &Apache::loncommon::start_data_table_header_row()."\n".
                   5118:              '<th colspan="2">
                   5119:               &nbsp;'.&mt('Review scantron data and submissions for a previously graded folder/sequence')."\n".
                   5120:              '</th>'."\n".
                   5121:               &Apache::loncommon::end_data_table_header_row()."\n".
                   5122:               &Apache::loncommon::start_data_table_row()."\n".
                   5123:               '<td> '.&mt('Graded folder/sequence:').' </td>'."\n".
                   5124:               '<td> '.$sequence_selector.' </td>'.
                   5125:               &Apache::loncommon::end_data_table_row()."\n".
                   5126:               &Apache::loncommon::start_data_table_row()."\n".
                   5127:               '<td> '.&mt('Filename of scoring office file:').' </td>'."\n".
                   5128:               '<td> '.$file_selector.' </td>'."\n".
                   5129:               &Apache::loncommon::end_data_table_row()."\n".
                   5130:               &Apache::loncommon::start_data_table_row()."\n".
                   5131:               '<td> '.&mt('Format of data file:').' </td>'."\n".
                   5132:               '<td> '.$format_selector.' </td>'."\n".
                   5133:               &Apache::loncommon::end_data_table_row()."\n".
                   5134:               &Apache::loncommon::start_data_table_row()."\n".
                   5135:               '<td colspan="2">'."\n".
                   5136:               '<input type="hidden" name="command" value="checksubmissions" />'."\n".
                   5137:               '<input type="submit" value="'.&mt('Review Scantron Data and Submission Records').'" />'."\n".
                   5138:               '</td>'."\n".
                   5139:               &Apache::loncommon::end_data_table_row()."\n".
                   5140:               &Apache::loncommon::end_data_table()."\n".
                   5141:               '</form><br />');
1.457     banghart 5142:     $r->print($grading_menu_button);
1.523     raeburn  5143:     return;
1.75      albertel 5144: }
                   5145: 
1.423     albertel 5146: =pod
                   5147: 
                   5148: =item get_scantron_config
                   5149: 
                   5150:    Parse and return the scantron configuration line selected as a
                   5151:    hash of configuration file fields.
                   5152: 
                   5153:  Arguments:
                   5154:     which - the name of the configuration to parse from the file.
                   5155: 
                   5156: 
                   5157:  Returns:
                   5158:             If the named configuration is not in the file, an empty
                   5159:             hash is returned.
                   5160:     a hash with the fields
                   5161:       name         - internal name for the this configuration setup
                   5162:       description  - text to display to operator that describes this config
                   5163:       CODElocation - if 0 or the string 'none'
                   5164:                           - no CODE exists for this config
                   5165:                      if -1 || the string 'letter'
                   5166:                           - a CODE exists for this config and is
                   5167:                             a string of letters
                   5168:                      Unsupported value (but planned for future support)
                   5169:                           if a positive integer
                   5170:                                - The CODE exists as the first n items from
                   5171:                                  the question section of the form
                   5172:                           if the string 'number'
                   5173:                                - The CODE exists for this config and is
                   5174:                                  a string of numbers
                   5175:       CODEstart   - (only matter if a CODE exists) column in the line where
                   5176:                      the CODE starts
                   5177:       CODElength  - length of the CODE
                   5178:       IDstart     - column where the student ID number starts
                   5179:       IDlength    - length of the student ID info
                   5180:       Qstart      - column where the information from the bubbled
                   5181:                     'questions' start
                   5182:       Qlength     - number of columns comprising a single bubble line from
                   5183:                     the sheet. (usually either 1 or 10)
1.424     albertel 5184:       Qon         - either a single character representing the character used
1.423     albertel 5185:                     to signal a bubble was chosen in the positional setup, or
                   5186:                     the string 'letter' if the letter of the chosen bubble is
                   5187:                     in the final, or 'number' if a number representing the
                   5188:                     chosen bubble is in the file (1->A 0->J)
1.424     albertel 5189:       Qoff        - the character used to represent that a bubble was
                   5190:                     left blank
1.423     albertel 5191:       PaperID     - if the scanning process generates a unique number for each
                   5192:                     sheet scanned the column that this ID number starts in
                   5193:       PaperIDlength - number of columns that comprise the unique ID number
                   5194:                       for the sheet of paper
1.424     albertel 5195:       FirstName   - column that the first name starts in
1.423     albertel 5196:       FirstNameLength - number of columns that the first name spans
                   5197:  
                   5198:       LastName    - column that the last name starts in
                   5199:       LastNameLength - number of columns that the last name spans
                   5200: 
                   5201: =cut
1.422     foxr     5202: 
1.82      albertel 5203: sub get_scantron_config {
                   5204:     my ($which) = @_;
1.518     raeburn  5205:     my @lines = &get_scantronformat_file();
1.82      albertel 5206:     my %config;
1.157     albertel 5207:     #FIXME probably should move to XML it has already gotten a bit much now
1.518     raeburn  5208:     foreach my $line (@lines) {
1.82      albertel 5209: 	my ($name,$descrip)=split(/:/,$line);
                   5210: 	if ($name ne $which ) { next; }
                   5211: 	chomp($line);
                   5212: 	my @config=split(/:/,$line);
                   5213: 	$config{'name'}=$config[0];
                   5214: 	$config{'description'}=$config[1];
                   5215: 	$config{'CODElocation'}=$config[2];
                   5216: 	$config{'CODEstart'}=$config[3];
                   5217: 	$config{'CODElength'}=$config[4];
                   5218: 	$config{'IDstart'}=$config[5];
                   5219: 	$config{'IDlength'}=$config[6];
                   5220: 	$config{'Qstart'}=$config[7];
1.497     foxr     5221:  	$config{'Qlength'}=$config[8];
1.82      albertel 5222: 	$config{'Qoff'}=$config[9];
                   5223: 	$config{'Qon'}=$config[10];
1.157     albertel 5224: 	$config{'PaperID'}=$config[11];
                   5225: 	$config{'PaperIDlength'}=$config[12];
                   5226: 	$config{'FirstName'}=$config[13];
                   5227: 	$config{'FirstNamelength'}=$config[14];
                   5228: 	$config{'LastName'}=$config[15];
                   5229: 	$config{'LastNamelength'}=$config[16];
1.82      albertel 5230: 	last;
                   5231:     }
                   5232:     return %config;
                   5233: }
                   5234: 
1.423     albertel 5235: =pod 
                   5236: 
                   5237: =item username_to_idmap
                   5238: 
                   5239:     creates a hash keyed by student id with values of the corresponding
                   5240:     student username:domain.
                   5241: 
                   5242:   Arguments:
                   5243: 
                   5244:     $classlist - reference to the class list hash. This is a hash
                   5245:                  keyed by student name:domain  whose elements are references
1.424     albertel 5246:                  to arrays containing various chunks of information
1.423     albertel 5247:                  about the student. (See loncoursedata for more info).
                   5248: 
                   5249:   Returns
                   5250:     %idmap - the constructed hash
                   5251: 
                   5252: =cut
                   5253: 
1.82      albertel 5254: sub username_to_idmap {
                   5255:     my ($classlist)= @_;
                   5256:     my %idmap;
                   5257:     foreach my $student (keys(%$classlist)) {
                   5258: 	$idmap{$classlist->{$student}->[&Apache::loncoursedata::CL_ID]}=
                   5259: 	    $student;
                   5260:     }
                   5261:     return %idmap;
                   5262: }
1.423     albertel 5263: 
                   5264: =pod
                   5265: 
1.424     albertel 5266: =item scantron_fixup_scanline
1.423     albertel 5267: 
                   5268:    Process a requested correction to a scanline.
                   5269: 
                   5270:   Arguments:
                   5271:     $scantron_config   - hash from &get_scantron_config()
                   5272:     $scan_data         - hash of correction information 
                   5273:                           (see &scantron_getfile())
                   5274:     $line              - existing scanline
                   5275:     $whichline         - line number of the passed in scanline
                   5276:     $field             - type of change to process 
                   5277:                          (either 
                   5278:                           'ID'     -> correct the student ID number
                   5279:                           'CODE'   -> correct the CODE
                   5280:                           'answer' -> fixup the submitted answers)
                   5281:     
                   5282:    $args               - hash of additional info,
                   5283:                           - 'ID' 
                   5284:                                'newid' -> studentID to use in replacement
1.424     albertel 5285:                                           of existing one
1.423     albertel 5286:                           - 'CODE' 
                   5287:                                'CODE_ignore_dup' - set to true if duplicates
                   5288:                                                    should be ignored.
                   5289: 	                       'CODE' - is new code or 'use_unfound'
1.424     albertel 5290:                                         if the existing unfound code should
1.423     albertel 5291:                                         be used as is
                   5292:                           - 'answer'
                   5293:                                'response' - new answer or 'none' if blank
                   5294:                                'question' - the bubble line to change
1.503     raeburn  5295:                                'questionnum' - the question identifier,
                   5296:                                                may include subquestion. 
1.423     albertel 5297: 
                   5298:   Returns:
                   5299:     $line - the modified scanline
                   5300: 
                   5301:   Side effects: 
                   5302:     $scan_data - may be updated
                   5303: 
                   5304: =cut
                   5305: 
1.82      albertel 5306: 
1.157     albertel 5307: sub scantron_fixup_scanline {
                   5308:     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
                   5309:     if ($field eq 'ID') {
                   5310: 	if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
1.186     albertel 5311: 	    return ($line,1,'New value too large');
1.157     albertel 5312: 	}
                   5313: 	if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {
                   5314: 	    $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
                   5315: 				     $args->{'newid'});
                   5316: 	}
                   5317: 	substr($line,$$scantron_config{'IDstart'}-1,
                   5318: 	       $$scantron_config{'IDlength'})=$args->{'newid'};
                   5319: 	if ($args->{'newid'}=~/^\s*$/) {
                   5320: 	    &scan_data($scan_data,"$whichline.user",
                   5321: 		       $args->{'username'}.':'.$args->{'domain'});
                   5322: 	}
1.186     albertel 5323:     } elsif ($field eq 'CODE') {
1.192     albertel 5324: 	if ($args->{'CODE_ignore_dup'}) {
                   5325: 	    &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');
                   5326: 	}
                   5327: 	&scan_data($scan_data,"$whichline.useCODE",'1');
                   5328: 	if ($args->{'CODE'} ne 'use_unfound') {
1.191     albertel 5329: 	    if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) {
                   5330: 		return ($line,1,'New CODE value too large');
                   5331: 	    }
                   5332: 	    if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) {
                   5333: 		$args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'});
                   5334: 	    }
                   5335: 	    substr($line,$$scantron_config{'CODEstart'}-1,
                   5336: 		   $$scantron_config{'CODElength'})=$args->{'CODE'};
1.186     albertel 5337: 	}
1.157     albertel 5338:     } elsif ($field eq 'answer') {
1.497     foxr     5339: 	my $length=$scantron_config->{'Qlength'};
1.157     albertel 5340: 	my $off=$scantron_config->{'Qoff'};
                   5341: 	my $on=$scantron_config->{'Qon'};
1.497     foxr     5342: 	my $answer=${off}x$length;
                   5343: 	if ($args->{'response'} eq 'none') {
                   5344: 	    &scan_data($scan_data,
1.503     raeburn  5345: 		       "$whichline.no_bubble.".$args->{'questionnum'},'1');
1.497     foxr     5346: 	} else {
                   5347: 	    if ($on eq 'letter') {
                   5348: 		my @alphabet=('A'..'Z');
                   5349: 		$answer=$alphabet[$args->{'response'}];
                   5350: 	    } elsif ($on eq 'number') {
                   5351: 		$answer=$args->{'response'}+1;
                   5352: 		if ($answer == 10) { $answer = '0'; }
1.274     albertel 5353: 	    } else {
1.497     foxr     5354: 		substr($answer,$args->{'response'},1)=$on;
1.274     albertel 5355: 	    }
1.497     foxr     5356: 	    &scan_data($scan_data,
1.503     raeburn  5357: 		       "$whichline.no_bubble.".$args->{'questionnum'},undef,'1');
1.157     albertel 5358: 	}
1.497     foxr     5359: 	my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
                   5360: 	substr($line,$where-1,$length)=$answer;
1.157     albertel 5361:     }
                   5362:     return $line;
                   5363: }
1.423     albertel 5364: 
                   5365: =pod
                   5366: 
                   5367: =item scan_data
                   5368: 
                   5369:     Edit or look up  an item in the scan_data hash.
                   5370: 
                   5371:   Arguments:
                   5372:     $scan_data  - The hash (see scantron_getfile)
                   5373:     $key        - shorthand of the key to edit (actual key is
1.424     albertel 5374:                   scantronfilename_key).
1.423     albertel 5375:     $data        - New value of the hash entry.
                   5376:     $delete      - If true, the entry is removed from the hash.
                   5377: 
                   5378:   Returns:
                   5379:     The new value of the hash table field (undefined if deleted).
                   5380: 
                   5381: =cut
                   5382: 
                   5383: 
1.157     albertel 5384: sub scan_data {
                   5385:     my ($scan_data,$key,$value,$delete)=@_;
1.257     albertel 5386:     my $filename=$env{'form.scantron_selectfile'};
1.157     albertel 5387:     if (defined($value)) {
                   5388: 	$scan_data->{$filename.'_'.$key} = $value;
                   5389:     }
                   5390:     if ($delete) { delete($scan_data->{$filename.'_'.$key}); }
                   5391:     return $scan_data->{$filename.'_'.$key};
                   5392: }
1.423     albertel 5393: 
1.495     albertel 5394: # ----- These first few routines are general use routines.----
                   5395: 
                   5396: # Return the number of occurences of a pattern in a string.
                   5397: 
                   5398: sub occurence_count {
                   5399:     my ($string, $pattern) = @_;
                   5400: 
                   5401:     my @matches = ($string =~ /$pattern/g);
                   5402: 
                   5403:     return scalar(@matches);
                   5404: }
                   5405: 
                   5406: 
                   5407: # Take a string known to have digits and convert all the
                   5408: # digits into letters in the range J,A..I.
                   5409: 
                   5410: sub digits_to_letters {
                   5411:     my ($input) = @_;
                   5412: 
                   5413:     my @alphabet = ('J', 'A'..'I');
                   5414: 
                   5415:     my @input    = split(//, $input);
                   5416:     my $output ='';
                   5417:     for (my $i = 0; $i < scalar(@input); $i++) {
                   5418: 	if ($input[$i] =~ /\d/) {
                   5419: 	    $output .= $alphabet[$input[$i]];
                   5420: 	} else {
                   5421: 	    $output .= $input[$i];
                   5422: 	}
                   5423:     }
                   5424:     return $output;
                   5425: }
                   5426: 
1.423     albertel 5427: =pod 
                   5428: 
                   5429: =item scantron_parse_scanline
                   5430: 
                   5431:   Decodes a scanline from the selected scantron file
                   5432: 
                   5433:  Arguments:
                   5434:     line             - The text of the scantron file line to process
                   5435:     whichline        - Line number
                   5436:     scantron_config  - Hash describing the format of the scantron lines.
                   5437:     scan_data        - Hash of extra information about the scanline
                   5438:                        (see scantron_getfile for more information)
                   5439:     just_header      - True if should not process question answers but only
                   5440:                        the stuff to the left of the answers.
                   5441:  Returns:
                   5442:    Hash containing the result of parsing the scanline
                   5443: 
                   5444:    Keys are all proceeded by the string 'scantron.'
                   5445: 
                   5446:        CODE    - the CODE in use for this scanline
                   5447:        useCODE - 1 if the CODE is invalid but it usage has been forced
                   5448:                  by the operator
                   5449:        CODE_ignore_dup - 1 if the CODE is a duplicated use when unique
                   5450:                             CODEs were selected, but the usage has been
                   5451:                             forced by the operator
                   5452:        ID  - student ID
                   5453:        PaperID - if used, the ID number printed on the sheet when the 
                   5454:                  paper was scanned
                   5455:        FirstName - first name from the sheet
                   5456:        LastName  - last name from the sheet
                   5457: 
                   5458:      if just_header was not true these key may also exist
                   5459: 
1.447     foxr     5460:        missingerror - a list of bubble ranges that are considered to be answers
                   5461:                       to a single question that don't have any bubbles filled in.
                   5462:                       Of the form questionnumber:firstbubblenumber:count.
                   5463:        doubleerror  - a list of bubble ranges that are considered to be answers
                   5464:                       to a single question that have more than one bubble filled in.
                   5465:                       Of the form questionnumber::firstbubblenumber:count
                   5466:    
                   5467:                 In the above, count is the number of bubble responses in the
                   5468:                 input line needed to represent the possible answers to the question.
                   5469:                 e.g. a radioresponse with 15 choices in an answer sheet with 10 choices
                   5470:                 per line would have count = 2.
                   5471: 
1.423     albertel 5472:        maxquest     - the number of the last bubble line that was parsed
                   5473: 
                   5474:        (<number> starts at 1)
                   5475:        <number>.answer - zero or more letters representing the selected
                   5476:                          letters from the scanline for the bubble line 
                   5477:                          <number>.
                   5478:                          if blank there was either no bubble or there where
                   5479:                          multiple bubbles, (consult the keys missingerror and
                   5480:                          doubleerror if this is an error condition)
                   5481: 
                   5482: =cut
                   5483: 
1.82      albertel 5484: sub scantron_parse_scanline {
1.423     albertel 5485:     my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;
1.470     foxr     5486: 
1.82      albertel 5487:     my %record;
1.422     foxr     5488:     my $questions=substr($line,$$scantron_config{'Qstart'}-1);  # Answers
                   5489:     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff
1.278     albertel 5490:     if (!($$scantron_config{'CODElocation'} eq 0 ||
                   5491: 	  $$scantron_config{'CODElocation'} eq 'none')) {
                   5492: 	if ($$scantron_config{'CODElocation'} < 0 ||
                   5493: 	    $$scantron_config{'CODElocation'} eq 'letter' ||
                   5494: 	    $$scantron_config{'CODElocation'} eq 'number') {
1.191     albertel 5495: 	    $record{'scantron.CODE'}=substr($data,
                   5496: 					    $$scantron_config{'CODEstart'}-1,
1.83      albertel 5497: 					    $$scantron_config{'CODElength'});
1.191     albertel 5498: 	    if (&scan_data($scan_data,"$whichline.useCODE")) {
                   5499: 		$record{'scantron.useCODE'}=1;
                   5500: 	    }
1.192     albertel 5501: 	    if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) {
                   5502: 		$record{'scantron.CODE_ignore_dup'}=1;
                   5503: 	    }
1.82      albertel 5504: 	} else {
                   5505: 	    #FIXME interpret first N questions
                   5506: 	}
                   5507:     }
1.83      albertel 5508:     $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
                   5509: 				  $$scantron_config{'IDlength'});
1.157     albertel 5510:     $record{'scantron.PaperID'}=
                   5511: 	substr($data,$$scantron_config{'PaperID'}-1,
                   5512: 	       $$scantron_config{'PaperIDlength'});
                   5513:     $record{'scantron.FirstName'}=
                   5514: 	substr($data,$$scantron_config{'FirstName'}-1,
                   5515: 	       $$scantron_config{'FirstNamelength'});
                   5516:     $record{'scantron.LastName'}=
                   5517: 	substr($data,$$scantron_config{'LastName'}-1,
                   5518: 	       $$scantron_config{'LastNamelength'});
1.423     albertel 5519:     if ($just_header) { return \%record; }
1.194     albertel 5520: 
1.82      albertel 5521:     my @alphabet=('A'..'Z');
                   5522:     my $questnum=0;
1.447     foxr     5523:     my $ansnum  =1;		# Multiple 'answer lines'/question.
                   5524: 
1.470     foxr     5525:     chomp($questions);		# Get rid of any trailing \n.
                   5526:     $questions =~ s/\r$//;      # Get rid of trailing \r too (MAC or Win uploads).
                   5527:     while (length($questions)) {
1.447     foxr     5528: 	my $answers_needed = $bubble_lines_per_response{$questnum};
1.503     raeburn  5529:         my $answer_length  = ($$scantron_config{'Qlength'} * $answers_needed)
                   5530:                              || 1;
                   5531:         $questnum++;
                   5532:         my $quest_id = $questnum;
                   5533:         my $currentquest = substr($questions,0,$answer_length);
                   5534:         $questions       = substr($questions,$answer_length);
                   5535:         if (length($currentquest) < $answer_length) { next; }
                   5536: 
                   5537:         if ($subdivided_bubble_lines{$questnum-1} =~ /,/) {
                   5538:             my $subquestnum = 1;
                   5539:             my $subquestions = $currentquest;
                   5540:             my @subanswers_needed = 
                   5541:                 split(/,/,$subdivided_bubble_lines{$questnum-1});  
                   5542:             foreach my $subans (@subanswers_needed) {
                   5543:                 my $subans_length =
                   5544:                     ($$scantron_config{'Qlength'} * $subans)  || 1;
                   5545:                 my $currsubquest = substr($subquestions,0,$subans_length);
                   5546:                 $subquestions   = substr($subquestions,$subans_length);
                   5547:                 $quest_id = "$questnum.$subquestnum";
                   5548:                 if (($$scantron_config{'Qon'} eq 'letter') ||
                   5549:                     ($$scantron_config{'Qon'} eq 'number')) {
                   5550:                     $ansnum = &scantron_validator_lettnum($ansnum, 
                   5551:                         $questnum,$quest_id,$subans,$currsubquest,$whichline,
                   5552:                         \@alphabet,\%record,$scantron_config,$scan_data);
                   5553:                 } else {
                   5554:                     $ansnum = &scantron_validator_positional($ansnum,
                   5555:                         $questnum,$quest_id,$subans,$currsubquest,$whichline,                        \@alphabet,\%record,$scantron_config,$scan_data);
                   5556:                 }
                   5557:                 $subquestnum ++;
                   5558:             }
                   5559:         } else {
                   5560:             if (($$scantron_config{'Qon'} eq 'letter') ||
                   5561:                 ($$scantron_config{'Qon'} eq 'number')) {
                   5562:                 $ansnum = &scantron_validator_lettnum($ansnum,$questnum,
                   5563:                     $quest_id,$answers_needed,$currentquest,$whichline,
                   5564:                     \@alphabet,\%record,$scantron_config,$scan_data);
                   5565:             } else {
                   5566:                 $ansnum = &scantron_validator_positional($ansnum,$questnum,
                   5567:                     $quest_id,$answers_needed,$currentquest,$whichline,
                   5568:                     \@alphabet,\%record,$scantron_config,$scan_data);
                   5569:             }
                   5570:         }
                   5571:     }
                   5572:     $record{'scantron.maxquest'}=$questnum;
                   5573:     return \%record;
                   5574: }
1.447     foxr     5575: 
1.503     raeburn  5576: sub scantron_validator_lettnum {
                   5577:     my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline,
                   5578:         $alphabet,$record,$scantron_config,$scan_data) = @_;
                   5579: 
                   5580:     # Qon 'letter' implies for each slot in currquest we have:
                   5581:     #    ? or * for doubles, a letter in A-Z for a bubble, and
                   5582:     #    about anything else (esp. a value of Qoff) for missing
                   5583:     #    bubbles.
                   5584:     #
                   5585:     # Qon 'number' implies each slot gives a digit that indexes the
                   5586:     #    bubbles filled, or Qoff, or a non-number for unbubbled lines,
                   5587:     #    and * or ? for double bubbles on a single line.
                   5588:     #
1.447     foxr     5589: 
1.503     raeburn  5590:     my $matchon;
                   5591:     if ($$scantron_config{'Qon'} eq 'letter') {
                   5592:         $matchon = '[A-Z]';
                   5593:     } elsif ($$scantron_config{'Qon'} eq 'number') {
                   5594:         $matchon = '\d';
                   5595:     }
                   5596:     my $occurrences = 0;
                   5597:     if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
                   5598:         ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
1.510     raeburn  5599:         ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
                   5600:         ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
                   5601:         ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
                   5602:         ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
1.503     raeburn  5603:         my @singlelines = split('',$currquest);
                   5604:         foreach my $entry (@singlelines) {
                   5605:             $occurrences = &occurence_count($entry,$matchon);
                   5606:             if ($occurrences > 1) {
                   5607:                 last;
                   5608:             }
                   5609:         } 
                   5610:     } else {
                   5611:         $occurrences = &occurence_count($currquest,$matchon); 
                   5612:     }
                   5613:     if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) {
                   5614:         push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5615:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5616:             my $bubble = substr($currquest,$ans,1);
                   5617:             if ($bubble =~ /$matchon/ ) {
                   5618:                 if ($$scantron_config{'Qon'} eq 'number') {
                   5619:                     if ($bubble == 0) {
                   5620:                         $bubble = 10; 
                   5621:                     }
                   5622:                     $record->{"scantron.$ansnum.answer"} = 
                   5623:                         $alphabet->[$bubble-1];
                   5624:                 } else {
                   5625:                     $record->{"scantron.$ansnum.answer"} = $bubble;
                   5626:                 }
                   5627:             } else {
                   5628:                 $record->{"scantron.$ansnum.answer"}='';
                   5629:             }
                   5630:             $ansnum++;
                   5631:         }
                   5632:     } elsif (!defined($currquest)
                   5633:             || (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest))
                   5634:             || (&occurence_count($currquest,$matchon) == 0)) {
                   5635:         for (my $ans=0; $ans<$answers_needed; $ans++ ) {
                   5636:             $record->{"scantron.$ansnum.answer"}='';
                   5637:             $ansnum++;
                   5638:         }
                   5639:         if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) {
                   5640:             push(@{$record->{'scantron.missingerror'}},$quest_id);
                   5641:         }
                   5642:     } else {
                   5643:         if ($$scantron_config{'Qon'} eq 'number') {
                   5644:             $currquest = &digits_to_letters($currquest);            
                   5645:         }
                   5646:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5647:             my $bubble = substr($currquest,$ans,1);
                   5648:             $record->{"scantron.$ansnum.answer"} = $bubble;
                   5649:             $ansnum++;
                   5650:         }
                   5651:     }
                   5652:     return $ansnum;
                   5653: }
1.447     foxr     5654: 
1.503     raeburn  5655: sub scantron_validator_positional {
                   5656:     my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,
                   5657:         $whichline,$alphabet,$record,$scantron_config,$scan_data) = @_;
1.447     foxr     5658: 
1.503     raeburn  5659:     # Otherwise there's a positional notation;
                   5660:     # each bubble line requires Qlength items, and there are filled in
                   5661:     # bubbles for each case where there 'Qon' characters.
                   5662:     #
1.447     foxr     5663: 
1.503     raeburn  5664:     my @array=split($$scantron_config{'Qon'},$currquest,-1);
1.447     foxr     5665: 
1.503     raeburn  5666:     # If the split only gives us one element.. the full length of the
                   5667:     # answer string, no bubbles are filled in:
1.447     foxr     5668: 
1.507     raeburn  5669:     if ($answers_needed eq '') {
                   5670:         return;
                   5671:     }
                   5672: 
1.503     raeburn  5673:     if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) {
                   5674:         for (my $ans=0; $ans<$answers_needed; $ans++ ) {
                   5675:             $record->{"scantron.$ansnum.answer"}='';
                   5676:             $ansnum++;
                   5677:         }
                   5678:         if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) {
                   5679:             push(@{$record->{"scantron.missingerror"}},$quest_id);
                   5680:         }
                   5681:     } elsif (scalar(@array) == 2) {
                   5682:         my $location = length($array[0]);
                   5683:         my $line_num = int($location / $$scantron_config{'Qlength'});
                   5684:         my $bubble   = $alphabet->[$location % $$scantron_config{'Qlength'}];
                   5685:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5686:             if ($ans eq $line_num) {
                   5687:                 $record->{"scantron.$ansnum.answer"} = $bubble;
                   5688:             } else {
                   5689:                 $record->{"scantron.$ansnum.answer"} = ' ';
                   5690:             }
                   5691:             $ansnum++;
                   5692:          }
                   5693:     } else {
                   5694:         #  If there's more than one instance of a bubble character
                   5695:         #  That's a double bubble; with positional notation we can
                   5696:         #  record all the bubbles filled in as well as the
                   5697:         #  fact this response consists of multiple bubbles.
                   5698:         #
                   5699:         if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
                   5700:             ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
1.510     raeburn  5701:             ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
                   5702:             ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
                   5703:             ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
                   5704:             ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
1.503     raeburn  5705:             my $doubleerror = 0;
                   5706:             while (($currquest >= $$scantron_config{'Qlength'}) && 
                   5707:                    (!$doubleerror)) {
                   5708:                my $currline = substr($currquest,0,$$scantron_config{'Qlength'});
                   5709:                $currquest = substr($currquest,$$scantron_config{'Qlength'});
                   5710:                my @currarray = split($$scantron_config{'Qon'},$currline,-1);
                   5711:                if (length(@currarray) > 2) {
                   5712:                    $doubleerror = 1;
                   5713:                } 
                   5714:             }
                   5715:             if ($doubleerror) {
                   5716:                 push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5717:             }
                   5718:         } else {
                   5719:             push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5720:         }
                   5721:         my $item = $ansnum;
                   5722:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5723:             $record->{"scantron.$item.answer"} = '';
                   5724:             $item ++;
                   5725:         }
1.447     foxr     5726: 
1.503     raeburn  5727:         my @ans=@array;
                   5728:         my $i=0;
                   5729:         my $increment = 0;
                   5730:         while ($#ans) {
                   5731:             $i+=length($ans[0]) + $increment;
                   5732:             my $line   = int($i/$$scantron_config{'Qlength'} + $ansnum);
                   5733:             my $bubble = $i%$$scantron_config{'Qlength'};
                   5734:             $record->{"scantron.$line.answer"}.=$alphabet->[$bubble];
                   5735:             shift(@ans);
                   5736:             $increment = 1;
                   5737:         }
                   5738:         $ansnum += $answers_needed;
1.82      albertel 5739:     }
1.503     raeburn  5740:     return $ansnum;
1.82      albertel 5741: }
                   5742: 
1.423     albertel 5743: =pod
                   5744: 
                   5745: =item scantron_add_delay
                   5746: 
                   5747:    Adds an error message that occurred during the grading phase to a
                   5748:    queue of messages to be shown after grading pass is complete
                   5749: 
                   5750:  Arguments:
1.424     albertel 5751:    $delayqueue  - arrary ref of hash ref of error messages
1.423     albertel 5752:    $scanline    - the scanline that caused the error
                   5753:    $errormesage - the error message
                   5754:    $errorcode   - a numeric code for the error
                   5755: 
                   5756:  Side Effects:
1.424     albertel 5757:    updates the $delayqueue to have a new hash ref of the error
1.423     albertel 5758: 
                   5759: =cut
                   5760: 
1.82      albertel 5761: sub scantron_add_delay {
1.140     albertel 5762:     my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;
                   5763:     push(@$delayqueue,
                   5764: 	 {'line' => $scanline, 'emsg' => $errormessage,
                   5765: 	  'ecode' => $errorcode }
                   5766: 	 );
1.82      albertel 5767: }
                   5768: 
1.423     albertel 5769: =pod
                   5770: 
                   5771: =item scantron_find_student
                   5772: 
1.424     albertel 5773:    Finds the username for the current scanline
                   5774: 
                   5775:   Arguments:
                   5776:    $scantron_record - hash result from scantron_parse_scanline
                   5777:    $scan_data       - hash of correction information 
                   5778:                       (see &scantron_getfile() form more information)
                   5779:    $idmap           - hash from &username_to_idmap()
                   5780:    $line            - number of current scanline
                   5781:  
                   5782:   Returns:
                   5783:    Either 'username:domain' or undef if unknown
                   5784: 
1.423     albertel 5785: =cut
                   5786: 
1.82      albertel 5787: sub scantron_find_student {
1.157     albertel 5788:     my ($scantron_record,$scan_data,$idmap,$line)=@_;
1.83      albertel 5789:     my $scanID=$$scantron_record{'scantron.ID'};
1.157     albertel 5790:     if ($scanID =~ /^\s*$/) {
                   5791:  	return &scan_data($scan_data,"$line.user");
                   5792:     }
1.83      albertel 5793:     foreach my $id (keys(%$idmap)) {
1.157     albertel 5794:  	if (lc($id) eq lc($scanID)) {
                   5795:  	    return $$idmap{$id};
                   5796:  	}
1.83      albertel 5797:     }
                   5798:     return undef;
                   5799: }
                   5800: 
1.423     albertel 5801: =pod
                   5802: 
                   5803: =item scantron_filter
                   5804: 
1.424     albertel 5805:    Filter sub for lonnavmaps, filters out hidden resources if ignore
                   5806:    hidden resources was selected
                   5807: 
1.423     albertel 5808: =cut
                   5809: 
1.83      albertel 5810: sub scantron_filter {
                   5811:     my ($curres)=@_;
1.331     albertel 5812: 
                   5813:     if (ref($curres) && $curres->is_problem()) {
                   5814: 	# if the user has asked to not have either hidden
                   5815: 	# or 'randomout' controlled resources to be graded
                   5816: 	# don't include them
                   5817: 	if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
                   5818: 	    && $curres->randomout) {
                   5819: 	    return 0;
                   5820: 	}
1.83      albertel 5821: 	return 1;
                   5822:     }
                   5823:     return 0;
1.82      albertel 5824: }
                   5825: 
1.423     albertel 5826: =pod
                   5827: 
                   5828: =item scantron_process_corrections
                   5829: 
1.424     albertel 5830:    Gets correction information out of submitted form data and corrects
                   5831:    the scanline
                   5832: 
1.423     albertel 5833: =cut
                   5834: 
1.157     albertel 5835: sub scantron_process_corrections {
                   5836:     my ($r) = @_;
1.257     albertel 5837:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 5838:     my ($scanlines,$scan_data)=&scantron_getfile();
                   5839:     my $classlist=&Apache::loncoursedata::get_classlist();
1.257     albertel 5840:     my $which=$env{'form.scantron_line'};
1.200     albertel 5841:     my $line=&scantron_get_line($scanlines,$scan_data,$which);
1.157     albertel 5842:     my ($skip,$err,$errmsg);
1.257     albertel 5843:     if ($env{'form.scantron_skip_record'}) {
1.157     albertel 5844: 	$skip=1;
1.257     albertel 5845:     } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
                   5846: 	my $newstudent=$env{'form.scantron_username'}.':'.
                   5847: 	    $env{'form.scantron_domain'};
1.157     albertel 5848: 	my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
                   5849: 	($line,$err,$errmsg)=
                   5850: 	    &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
                   5851: 				     'ID',{'newid'=>$newid,
1.257     albertel 5852: 				    'username'=>$env{'form.scantron_username'},
                   5853: 				    'domain'=>$env{'form.scantron_domain'}});
                   5854:     } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) {
                   5855: 	my $resolution=$env{'form.scantron_CODE_resolution'};
1.190     albertel 5856: 	my $newCODE;
1.192     albertel 5857: 	my %args;
1.190     albertel 5858: 	if      ($resolution eq 'use_unfound') {
1.191     albertel 5859: 	    $newCODE='use_unfound';
1.190     albertel 5860: 	} elsif ($resolution eq 'use_found') {
1.257     albertel 5861: 	    $newCODE=$env{'form.scantron_CODE_selectedvalue'};
1.190     albertel 5862: 	} elsif ($resolution eq 'use_typed') {
1.257     albertel 5863: 	    $newCODE=$env{'form.scantron_CODE_newvalue'};
1.194     albertel 5864: 	} elsif ($resolution =~ /^use_closest_(\d+)/) {
1.257     albertel 5865: 	    $newCODE=$env{"form.scantron_CODE_closest_$1"};
1.190     albertel 5866: 	}
1.257     albertel 5867: 	if ($env{'form.scantron_corrections'} eq 'duplicateCODE') {
1.192     albertel 5868: 	    $args{'CODE_ignore_dup'}=1;
                   5869: 	}
                   5870: 	$args{'CODE'}=$newCODE;
1.186     albertel 5871: 	($line,$err,$errmsg)=
                   5872: 	    &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
1.192     albertel 5873: 				     'CODE',\%args);
1.257     albertel 5874:     } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
                   5875: 	foreach my $question (split(',',$env{'form.scantron_questions'})) {
1.157     albertel 5876: 	    ($line,$err,$errmsg)=
                   5877: 		&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
                   5878: 					 $which,'answer',
                   5879: 					 { 'question'=>$question,
1.503     raeburn  5880: 		      		   'response'=>$env{"form.scantron_correct_Q_$question"},
                   5881:                                    'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}});
1.157     albertel 5882: 	    if ($err) { last; }
                   5883: 	}
                   5884:     }
                   5885:     if ($err) {
1.398     albertel 5886: 	$r->print("<span class=\"LC_warning\">Unable to accept last correction, an error occurred :$errmsg:</span>");
1.157     albertel 5887:     } else {
1.200     albertel 5888: 	&scantron_put_line($scanlines,$scan_data,$which,$line,$skip);
1.157     albertel 5889: 	&scantron_putfile($scanlines,$scan_data);
                   5890:     }
                   5891: }
                   5892: 
1.423     albertel 5893: =pod
                   5894: 
                   5895: =item reset_skipping_status
                   5896: 
1.424     albertel 5897:    Forgets the current set of remember skipped scanlines (and thus
                   5898:    reverts back to considering all lines in the
                   5899:    scantron_skipped_<filename> file)
                   5900: 
1.423     albertel 5901: =cut
                   5902: 
1.200     albertel 5903: sub reset_skipping_status {
                   5904:     my ($scanlines,$scan_data)=&scantron_getfile();
                   5905:     &scan_data($scan_data,'remember_skipping',undef,1);
                   5906:     &scantron_putfile(undef,$scan_data);
                   5907: }
                   5908: 
1.423     albertel 5909: =pod
                   5910: 
                   5911: =item start_skipping
                   5912: 
1.424     albertel 5913:    Marks a scanline to be skipped. 
                   5914: 
1.423     albertel 5915: =cut
                   5916: 
1.376     albertel 5917: sub start_skipping {
1.200     albertel 5918:     my ($scan_data,$i)=@_;
                   5919:     my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
1.376     albertel 5920:     if ($env{'form.scantron_options_redo'} =~ /^redo_/) {
                   5921: 	$remembered{$i}=2;
                   5922:     } else {
                   5923: 	$remembered{$i}=1;
                   5924:     }
1.200     albertel 5925:     &scan_data($scan_data,'remember_skipping',join(':',%remembered));
                   5926: }
                   5927: 
1.423     albertel 5928: =pod
                   5929: 
                   5930: =item should_be_skipped
                   5931: 
1.424     albertel 5932:    Checks whether a scanline should be skipped.
                   5933: 
1.423     albertel 5934: =cut
                   5935: 
1.200     albertel 5936: sub should_be_skipped {
1.376     albertel 5937:     my ($scanlines,$scan_data,$i)=@_;
1.257     albertel 5938:     if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
1.200     albertel 5939: 	# not redoing old skips
1.376     albertel 5940: 	if ($scanlines->{'skipped'}[$i]) { return 1; }
1.200     albertel 5941: 	return 0;
                   5942:     }
                   5943:     my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
1.376     albertel 5944: 
                   5945:     if (exists($remembered{$i}) && $remembered{$i} != 2 ) {
                   5946: 	return 0;
                   5947:     }
1.200     albertel 5948:     return 1;
                   5949: }
                   5950: 
1.423     albertel 5951: =pod
                   5952: 
                   5953: =item remember_current_skipped
                   5954: 
1.424     albertel 5955:    Discovers what scanlines are in the scantron_skipped_<filename>
                   5956:    file and remembers them into scan_data for later use.
                   5957: 
1.423     albertel 5958: =cut
                   5959: 
1.200     albertel 5960: sub remember_current_skipped {
                   5961:     my ($scanlines,$scan_data)=&scantron_getfile();
                   5962:     my %to_remember;
                   5963:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
                   5964: 	if ($scanlines->{'skipped'}[$i]) {
                   5965: 	    $to_remember{$i}=1;
                   5966: 	}
                   5967:     }
1.376     albertel 5968: 
1.200     albertel 5969:     &scan_data($scan_data,'remember_skipping',join(':',%to_remember));
                   5970:     &scantron_putfile(undef,$scan_data);
                   5971: }
                   5972: 
1.423     albertel 5973: =pod
                   5974: 
                   5975: =item check_for_error
                   5976: 
1.424     albertel 5977:     Checks if there was an error when attempting to remove a specific
                   5978:     scantron_.. bubble sheet data file. Prints out an error if
                   5979:     something went wrong.
                   5980: 
1.423     albertel 5981: =cut
                   5982: 
1.200     albertel 5983: sub check_for_error {
                   5984:     my ($r,$result)=@_;
                   5985:     if ($result ne 'ok' && $result ne 'not_found' ) {
1.492     albertel 5986: 	$r->print(&mt("An error occurred ([_1]) when trying to remove the existing corrections.",$result));
1.200     albertel 5987:     }
                   5988: }
1.157     albertel 5989: 
1.423     albertel 5990: =pod
                   5991: 
                   5992: =item scantron_warning_screen
                   5993: 
1.424     albertel 5994:    Interstitial screen to make sure the operator has selected the
                   5995:    correct options before we start the validation phase.
                   5996: 
1.423     albertel 5997: =cut
                   5998: 
1.203     albertel 5999: sub scantron_warning_screen {
                   6000:     my ($button_text)=@_;
1.257     albertel 6001:     my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});
1.284     albertel 6002:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.373     albertel 6003:     my $CODElist;
1.284     albertel 6004:     if ($scantron_config{'CODElocation'} &&
                   6005: 	$scantron_config{'CODEstart'} &&
                   6006: 	$scantron_config{'CODElength'}) {
                   6007: 	$CODElist=$env{'form.scantron_CODElist'};
1.398     albertel 6008: 	if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">None</span>'; }
1.284     albertel 6009: 	$CODElist=
1.492     albertel 6010: 	    '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.
1.373     albertel 6011: 	    $env{'form.scantron_CODElist'}.'</tt></td></tr>';
1.284     albertel 6012:     }
1.492     albertel 6013:     return ('
1.203     albertel 6014: <p>
1.492     albertel 6015: <span class="LC_warning">
                   6016: '.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).'</span>
1.203     albertel 6017: </p>
                   6018: <table>
1.492     albertel 6019: <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>
                   6020: <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>
                   6021: '.$CODElist.'
1.203     albertel 6022: </table>
                   6023: <br />
1.492     albertel 6024: <p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p>
                   6025: <p> '.&mt('If something is incorrect, please click the \'Grading Menu\' button to start over.').'</p>
1.203     albertel 6026: 
                   6027: <br />
1.492     albertel 6028: ');
1.203     albertel 6029: }
                   6030: 
1.423     albertel 6031: =pod
                   6032: 
                   6033: =item scantron_do_warning
                   6034: 
1.424     albertel 6035:    Check if the operator has picked something for all required
                   6036:    fields. Error out if something is missing.
                   6037: 
1.423     albertel 6038: =cut
                   6039: 
1.203     albertel 6040: sub scantron_do_warning {
                   6041:     my ($r)=@_;
1.324     albertel 6042:     my ($symb)=&get_symb($r);
1.203     albertel 6043:     if (!$symb) {return '';}
1.324     albertel 6044:     my $default_form_data=&defaultFormData($symb);
1.203     albertel 6045:     $r->print(&scantron_form_start().$default_form_data);
1.257     albertel 6046:     if ( $env{'form.selectpage'} eq '' ||
                   6047: 	 $env{'form.scantron_selectfile'} eq '' ||
                   6048: 	 $env{'form.scantron_format'} eq '' ) {
1.492     albertel 6049: 	$r->print("<p>".&mt('You have forgetten to specify some information. Please go Back and try again.')."</p>");
1.257     albertel 6050: 	if ( $env{'form.selectpage'} eq '') {
1.492     albertel 6051: 	    $r->print('<p><span class="LC_error">'.&mt('You have not selected a Sequence to grade').'</span></p>');
1.237     albertel 6052: 	} 
1.257     albertel 6053: 	if ( $env{'form.scantron_selectfile'} eq '') {
1.492     albertel 6054: 	    $r->print('<p><span class="LC_error">'.&mt('You have not selected a file that contains the student\'s response data.').'</span></p>');
1.237     albertel 6055: 	} 
1.257     albertel 6056: 	if ( $env{'form.scantron_format'} eq '') {
1.492     albertel 6057: 	    $r->print('<p><span class="LC_error">'.&mt('You have not selected a the format of the student\'s response data.').'</span></p>');
1.237     albertel 6058: 	} 
                   6059:     } else {
1.265     www      6060: 	my $warning=&scantron_warning_screen('Grading: Validate Records');
1.492     albertel 6061: 	$r->print('
                   6062: '.$warning.'
                   6063: <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />
1.203     albertel 6064: <input type="hidden" name="command" value="scantron_validate" />
1.492     albertel 6065: ');
1.237     albertel 6066:     }
1.352     albertel 6067:     $r->print("</form><br />".&show_grading_menu_form($symb));
1.203     albertel 6068:     return '';
                   6069: }
                   6070: 
1.423     albertel 6071: =pod
                   6072: 
                   6073: =item scantron_form_start
                   6074: 
1.424     albertel 6075:     html hidden input for remembering all selected grading options
                   6076: 
1.423     albertel 6077: =cut
                   6078: 
1.203     albertel 6079: sub scantron_form_start {
                   6080:     my ($max_bubble)=@_;
                   6081:     my $result= <<SCANTRONFORM;
                   6082: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
1.257     albertel 6083:   <input type="hidden" name="selectpage" value="$env{'form.selectpage'}" />
                   6084:   <input type="hidden" name="scantron_format" value="$env{'form.scantron_format'}" />
                   6085:   <input type="hidden" name="scantron_selectfile" value="$env{'form.scantron_selectfile'}" />
1.218     albertel 6086:   <input type="hidden" name="scantron_maxbubble" value="$max_bubble" />
1.257     albertel 6087:   <input type="hidden" name="scantron_CODElist" value="$env{'form.scantron_CODElist'}" />
                   6088:   <input type="hidden" name="scantron_CODEunique" value="$env{'form.scantron_CODEunique'}" />
                   6089:   <input type="hidden" name="scantron_options_redo" value="$env{'form.scantron_options_redo'}" />
                   6090:   <input type="hidden" name="scantron_options_ignore" value="$env{'form.scantron_options_ignore'}" />
1.331     albertel 6091:   <input type="hidden" name="scantron_options_hidden" value="$env{'form.scantron_options_hidden'}" />
1.203     albertel 6092: SCANTRONFORM
1.447     foxr     6093: 
                   6094:   my $line = 0;
                   6095:     while (defined($env{"form.scantron.bubblelines.$line"})) {
                   6096:        my $chunk =
                   6097: 	   '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n";
1.448     foxr     6098:        $chunk .=
                   6099: 	   '<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n";
1.503     raeburn  6100:        $chunk .= 
                   6101:            '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n";
1.504     raeburn  6102:        $chunk .=
                   6103:            '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n";
1.447     foxr     6104:        $result .= $chunk;
                   6105:        $line++;
                   6106:    }
1.203     albertel 6107:     return $result;
                   6108: }
                   6109: 
1.423     albertel 6110: =pod
                   6111: 
                   6112: =item scantron_validate_file
                   6113: 
1.424     albertel 6114:     Dispatch routine for doing validation of a bubble sheet data file.
                   6115: 
                   6116:     Also processes any necessary information resets that need to
                   6117:     occur before validation begins (ignore previous corrections,
                   6118:     restarting the skipped records processing)
                   6119: 
1.423     albertel 6120: =cut
                   6121: 
1.157     albertel 6122: sub scantron_validate_file {
                   6123:     my ($r) = @_;
1.324     albertel 6124:     my ($symb)=&get_symb($r);
1.157     albertel 6125:     if (!$symb) {return '';}
1.324     albertel 6126:     my $default_form_data=&defaultFormData($symb);
1.200     albertel 6127:     
                   6128:     # do the detection of only doing skipped records first befroe we delete
1.424     albertel 6129:     # them when doing the corrections reset
1.257     albertel 6130:     if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') {
1.200     albertel 6131: 	&reset_skipping_status();
                   6132:     }
1.257     albertel 6133:     if ($env{'form.scantron_options_redo'} eq 'redo_skipped') {
1.200     albertel 6134: 	&remember_current_skipped();
1.257     albertel 6135: 	$env{'form.scantron_options_redo'}='redo_skipped_ready';
1.200     albertel 6136:     }
                   6137: 
1.257     albertel 6138:     if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') {
1.200     albertel 6139: 	&check_for_error($r,&scantron_remove_file('corrected'));
                   6140: 	&check_for_error($r,&scantron_remove_file('skipped'));
                   6141: 	&check_for_error($r,&scantron_remove_scan_data());
1.257     albertel 6142: 	$env{'form.scantron_options_ignore'}='done';
1.192     albertel 6143:     }
1.200     albertel 6144: 
1.257     albertel 6145:     if ($env{'form.scantron_corrections'}) {
1.157     albertel 6146: 	&scantron_process_corrections($r);
                   6147:     }
1.503     raeburn  6148:     $r->print('<p>'.&mt('Gathering necessary information.').'</p>');$r->rflush();
1.157     albertel 6149:     #get the student pick code ready
                   6150:     $r->print(&Apache::loncommon::studentbrowser_javascript());
1.330     albertel 6151:     my $max_bubble=&scantron_get_maxbubble();
1.203     albertel 6152:     my $result=&scantron_form_start($max_bubble).$default_form_data;
1.157     albertel 6153:     $r->print($result);
                   6154:     
1.334     albertel 6155:     my @validate_phases=( 'sequence',
                   6156: 			  'ID',
1.157     albertel 6157: 			  'CODE',
                   6158: 			  'doublebubble',
                   6159: 			  'missingbubbles');
1.257     albertel 6160:     if (!$env{'form.validatepass'}) {
                   6161: 	$env{'form.validatepass'} = 0;
1.157     albertel 6162:     }
1.257     albertel 6163:     my $currentphase=$env{'form.validatepass'};
1.157     albertel 6164: 
1.448     foxr     6165: 
1.157     albertel 6166:     my $stop=0;
                   6167:     while (!$stop && $currentphase < scalar(@validate_phases)) {
1.503     raeburn  6168: 	$r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />');
1.157     albertel 6169: 	$r->rflush();
                   6170: 	my $which="scantron_validate_".$validate_phases[$currentphase];
                   6171: 	{
                   6172: 	    no strict 'refs';
                   6173: 	    ($stop,$currentphase)=&$which($r,$currentphase);
                   6174: 	}
                   6175:     }
                   6176:     if (!$stop) {
1.203     albertel 6177: 	my $warning=&scantron_warning_screen('Start Grading');
1.512     www      6178: 	$r->print(&mt('Validation process complete.').'<br />
1.492     albertel 6179: '.$warning.'
                   6180: <input type="submit" name="submit" value="'.&mt('Start Grading').'" />
1.203     albertel 6181: <input type="hidden" name="command" value="scantron_process" />
1.492     albertel 6182: ');
1.203     albertel 6183: 
1.157     albertel 6184:     } else {
                   6185: 	$r->print('<input type="hidden" name="command" value="scantron_validate" />');
                   6186: 	$r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
                   6187:     }
                   6188:     if ($stop) {
1.334     albertel 6189: 	if ($validate_phases[$currentphase] eq 'sequence') {
1.492     albertel 6190: 	    $r->print('<input type="submit" name="submit" value="'.&mt('Ignore -&gt;').' " />');
                   6191: 	    $r->print(' '.&mt('this error').' <br />');
1.334     albertel 6192: 
1.492     albertel 6193: 	    $r->print(" <p>".&mt("Or click the 'Grading Menu' button to start over.")."</p>");
1.334     albertel 6194: 	} else {
1.503     raeburn  6195:             if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') {
                   6196: 	        $r->print('<input type="button" name="submitbutton" value="'.&mt('Continue -&gt;').'" onclick="javascript:verify_bubble_radio(this.form)" />');
                   6197:             } else {
                   6198:                 $r->print('<input type="submit" name="submit" value="'.&mt('Continue -&gt;').'" />');
                   6199:             }
1.492     albertel 6200: 	    $r->print(' '.&mt('using corrected info').' <br />');
                   6201: 	    $r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />");
                   6202: 	    $r->print(" ".&mt("this scanline saving it for later."));
1.334     albertel 6203: 	}
1.157     albertel 6204:     }
1.352     albertel 6205:     $r->print(" </form><br />".&show_grading_menu_form($symb));
1.157     albertel 6206:     return '';
                   6207: }
                   6208: 
1.423     albertel 6209: 
                   6210: =pod
                   6211: 
                   6212: =item scantron_remove_file
                   6213: 
1.424     albertel 6214:    Removes the requested bubble sheet data file, makes sure that
                   6215:    scantron_original_<filename> is never removed
                   6216: 
                   6217: 
1.423     albertel 6218: =cut
                   6219: 
1.200     albertel 6220: sub scantron_remove_file {
1.192     albertel 6221:     my ($which)=@_;
1.257     albertel 6222:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6223:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.192     albertel 6224:     my $file='scantron_';
1.200     albertel 6225:     if ($which eq 'corrected' || $which eq 'skipped') {
                   6226: 	$file.=$which.'_';
1.192     albertel 6227:     } else {
                   6228: 	return 'refused';
                   6229:     }
1.257     albertel 6230:     $file.=$env{'form.scantron_selectfile'};
1.200     albertel 6231:     return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
                   6232: }
                   6233: 
1.423     albertel 6234: 
                   6235: =pod
                   6236: 
                   6237: =item scantron_remove_scan_data
                   6238: 
1.424     albertel 6239:    Removes all scan_data correction for the requested bubble sheet
                   6240:    data file.  (In the case that both the are doing skipped records we need
                   6241:    to remember the old skipped lines for the time being so that element
                   6242:    persists for a while.)
                   6243: 
1.423     albertel 6244: =cut
                   6245: 
1.200     albertel 6246: sub scantron_remove_scan_data {
1.257     albertel 6247:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6248:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.192     albertel 6249:     my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname);
                   6250:     my @todelete;
1.257     albertel 6251:     my $filename=$env{'form.scantron_selectfile'};
1.192     albertel 6252:     foreach my $key (@keys) {
                   6253: 	if ($key=~/^\Q$filename\E_/) {
1.257     albertel 6254: 	    if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' &&
1.200     albertel 6255: 		$key=~/remember_skipping/) {
                   6256: 		next;
                   6257: 	    }
1.192     albertel 6258: 	    push(@todelete,$key);
                   6259: 	}
                   6260:     }
1.200     albertel 6261:     my $result;
1.192     albertel 6262:     if (@todelete) {
1.491     albertel 6263: 	$result = &Apache::lonnet::del('nohist_scantrondata',
                   6264: 				       \@todelete,$cdom,$cname);
                   6265:     } else {
                   6266: 	$result = 'ok';
1.192     albertel 6267:     }
                   6268:     return $result;
                   6269: }
                   6270: 
1.423     albertel 6271: 
                   6272: =pod
                   6273: 
                   6274: =item scantron_getfile
                   6275: 
1.424     albertel 6276:     Fetches the requested bubble sheet data file (all 3 versions), and
                   6277:     the scan_data hash
                   6278:   
                   6279:   Arguments:
                   6280:     None
                   6281: 
                   6282:   Returns:
                   6283:     2 hash references
                   6284: 
                   6285:      - first one has 
                   6286:          orig      -
                   6287:          corrected -
                   6288:          skipped   -  each of which points to an array ref of the specified
                   6289:                       file broken up into individual lines
                   6290:          count     - number of scanlines
                   6291:  
                   6292:      - second is the scan_data hash possible keys are
1.425     albertel 6293:        ($number refers to scanline numbered $number and thus the key affects
                   6294:         only that scanline
                   6295:         $bubline refers to the specific bubble line element and the aspects
                   6296:         refers to that specific bubble line element)
                   6297: 
                   6298:        $number.user - username:domain to use
                   6299:        $number.CODE_ignore_dup 
                   6300:                     - ignore the duplicate CODE error 
                   6301:        $number.useCODE
                   6302:                     - use the CODE in the scanline as is
                   6303:        $number.no_bubble.$bubline
                   6304:                     - it is valid that there is no bubbled in bubble
                   6305:                       at $number $bubline
                   6306:        remember_skipping
                   6307:                     - a frozen hash containing keys of $number and values
                   6308:                       of either 
                   6309:                         1 - we are on a 'do skipped records pass' and plan
                   6310:                             on processing this line
                   6311:                         2 - we are on a 'do skipped records pass' and this
                   6312:                             scanline has been marked to skip yet again
1.424     albertel 6313: 
1.423     albertel 6314: =cut
                   6315: 
1.157     albertel 6316: sub scantron_getfile {
1.200     albertel 6317:     #FIXME really would prefer a scantron directory
1.257     albertel 6318:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6319:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.157     albertel 6320:     my $lines;
                   6321:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6322: 		       'scantron_orig_'.$env{'form.scantron_selectfile'});
1.157     albertel 6323:     my %scanlines;
                   6324:     $scanlines{'orig'}=[(split("\n",$lines,-1))];
                   6325:     my $temp=$scanlines{'orig'};
                   6326:     $scanlines{'count'}=$#$temp;
                   6327: 
                   6328:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6329: 		       'scantron_corrected_'.$env{'form.scantron_selectfile'});
1.157     albertel 6330:     if ($lines eq '-1') {
                   6331: 	$scanlines{'corrected'}=[];
                   6332:     } else {
                   6333: 	$scanlines{'corrected'}=[(split("\n",$lines,-1))];
                   6334:     }
                   6335:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6336: 		       'scantron_skipped_'.$env{'form.scantron_selectfile'});
1.157     albertel 6337:     if ($lines eq '-1') {
                   6338: 	$scanlines{'skipped'}=[];
                   6339:     } else {
                   6340: 	$scanlines{'skipped'}=[(split("\n",$lines,-1))];
                   6341:     }
1.175     albertel 6342:     my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname);
1.157     albertel 6343:     if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
                   6344:     my %scan_data = @tmp;
                   6345:     return (\%scanlines,\%scan_data);
                   6346: }
                   6347: 
1.423     albertel 6348: =pod
                   6349: 
                   6350: =item lonnet_putfile
                   6351: 
1.424     albertel 6352:    Wrapper routine to call &Apache::lonnet::finishuserfileupload
                   6353: 
                   6354:  Arguments:
                   6355:    $contents - data to store
                   6356:    $filename - filename to store $contents into
                   6357: 
                   6358:  Returns:
                   6359:    result value from &Apache::lonnet::finishuserfileupload
                   6360: 
1.423     albertel 6361: =cut
                   6362: 
1.157     albertel 6363: sub lonnet_putfile {
                   6364:     my ($contents,$filename)=@_;
1.257     albertel 6365:     my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6366:     my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   6367:     $env{'form.sillywaytopassafilearound'}=$contents;
1.275     albertel 6368:     &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename);
1.157     albertel 6369: 
                   6370: }
                   6371: 
1.423     albertel 6372: =pod
                   6373: 
                   6374: =item scantron_putfile
                   6375: 
1.424     albertel 6376:     Stores the current version of the bubble sheet data files, and the
                   6377:     scan_data hash. (Does not modify the original version only the
                   6378:     corrected and skipped versions.
                   6379: 
                   6380:  Arguments:
                   6381:     $scanlines - hash ref that looks like the first return value from
                   6382:                  &scantron_getfile()
                   6383:     $scan_data - hash ref that looks like the second return value from
                   6384:                  &scantron_getfile()
                   6385: 
1.423     albertel 6386: =cut
                   6387: 
1.157     albertel 6388: sub scantron_putfile {
                   6389:     my ($scanlines,$scan_data) = @_;
1.200     albertel 6390:     #FIXME really would prefer a scantron directory
1.257     albertel 6391:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6392:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.200     albertel 6393:     if ($scanlines) {
                   6394: 	my $prefix='scantron_';
1.157     albertel 6395: # no need to update orig, shouldn't change
                   6396: #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
1.257     albertel 6397: #		    $env{'form.scantron_selectfile'});
1.200     albertel 6398: 	&lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
                   6399: 			$prefix.'corrected_'.
1.257     albertel 6400: 			$env{'form.scantron_selectfile'});
1.200     albertel 6401: 	&lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
                   6402: 			$prefix.'skipped_'.
1.257     albertel 6403: 			$env{'form.scantron_selectfile'});
1.200     albertel 6404:     }
1.175     albertel 6405:     &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
1.157     albertel 6406: }
                   6407: 
1.423     albertel 6408: =pod
                   6409: 
                   6410: =item scantron_get_line
                   6411: 
1.424     albertel 6412:    Returns the correct version of the scanline
                   6413: 
                   6414:  Arguments:
                   6415:     $scanlines - hash ref that looks like the first return value from
                   6416:                  &scantron_getfile()
                   6417:     $scan_data - hash ref that looks like the second return value from
                   6418:                  &scantron_getfile()
                   6419:     $i         - number of the requested line (starts at 0)
                   6420: 
                   6421:  Returns:
                   6422:    A scanline, (either the original or the corrected one if it
                   6423:    exists), or undef if the requested scanline should be
                   6424:    skipped. (Either because it's an skipped scanline, or it's an
                   6425:    unskipped scanline and we are not doing a 'do skipped scanlines'
                   6426:    pass.
                   6427: 
1.423     albertel 6428: =cut
                   6429: 
1.157     albertel 6430: sub scantron_get_line {
1.200     albertel 6431:     my ($scanlines,$scan_data,$i)=@_;
1.376     albertel 6432:     if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; }
                   6433:     #if ($scanlines->{'skipped'}[$i]) { return undef; }
1.157     albertel 6434:     if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
                   6435:     return $scanlines->{'orig'}[$i]; 
                   6436: }
                   6437: 
1.423     albertel 6438: =pod
                   6439: 
                   6440: =item scantron_todo_count
                   6441: 
1.424     albertel 6442:     Counts the number of scanlines that need processing.
                   6443: 
                   6444:  Arguments:
                   6445:     $scanlines - hash ref that looks like the first return value from
                   6446:                  &scantron_getfile()
                   6447:     $scan_data - hash ref that looks like the second return value from
                   6448:                  &scantron_getfile()
                   6449: 
                   6450:  Returns:
                   6451:     $count - number of scanlines to process
                   6452: 
1.423     albertel 6453: =cut
                   6454: 
1.200     albertel 6455: sub get_todo_count {
                   6456:     my ($scanlines,$scan_data)=@_;
                   6457:     my $count=0;
                   6458:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
                   6459: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
                   6460: 	if ($line=~/^[\s\cz]*$/) { next; }
                   6461: 	$count++;
                   6462:     }
                   6463:     return $count;
                   6464: }
                   6465: 
1.423     albertel 6466: =pod
                   6467: 
                   6468: =item scantron_put_line
                   6469: 
1.424     albertel 6470:     Updates the 'corrected' or 'skipped' versions of the bubble sheet
                   6471:     data file.
                   6472: 
                   6473:  Arguments:
                   6474:     $scanlines - hash ref that looks like the first return value from
                   6475:                  &scantron_getfile()
                   6476:     $scan_data - hash ref that looks like the second return value from
                   6477:                  &scantron_getfile()
                   6478:     $i         - line number to update
                   6479:     $newline   - contents of the updated scanline
                   6480:     $skip      - if true make the line for skipping and update the
                   6481:                  'skipped' file
                   6482: 
1.423     albertel 6483: =cut
                   6484: 
1.157     albertel 6485: sub scantron_put_line {
1.200     albertel 6486:     my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
1.157     albertel 6487:     if ($skip) {
                   6488: 	$scanlines->{'skipped'}[$i]=$newline;
1.376     albertel 6489: 	&start_skipping($scan_data,$i);
1.157     albertel 6490: 	return;
                   6491:     }
                   6492:     $scanlines->{'corrected'}[$i]=$newline;
                   6493: }
                   6494: 
1.423     albertel 6495: =pod
                   6496: 
                   6497: =item scantron_clear_skip
                   6498: 
1.424     albertel 6499:    Remove a line from the 'skipped' file
                   6500: 
                   6501:  Arguments:
                   6502:     $scanlines - hash ref that looks like the first return value from
                   6503:                  &scantron_getfile()
                   6504:     $scan_data - hash ref that looks like the second return value from
                   6505:                  &scantron_getfile()
                   6506:     $i         - line number to update
                   6507: 
1.423     albertel 6508: =cut
                   6509: 
1.376     albertel 6510: sub scantron_clear_skip {
                   6511:     my ($scanlines,$scan_data,$i)=@_;
                   6512:     if (exists($scanlines->{'skipped'}[$i])) {
                   6513: 	undef($scanlines->{'skipped'}[$i]);
                   6514: 	return 1;
                   6515:     }
                   6516:     return 0;
                   6517: }
                   6518: 
1.423     albertel 6519: =pod
                   6520: 
                   6521: =item scantron_filter_not_exam
                   6522: 
1.424     albertel 6523:    Filter routine used by &Apache::lonnavmaps::retrieveResources(), to
                   6524:    filter out resources that are not marked as 'exam' mode
                   6525: 
1.423     albertel 6526: =cut
                   6527: 
1.334     albertel 6528: sub scantron_filter_not_exam {
                   6529:     my ($curres)=@_;
                   6530:     
                   6531:     if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) {
                   6532: 	# if the user has asked to not have either hidden
                   6533: 	# or 'randomout' controlled resources to be graded
                   6534: 	# don't include them
                   6535: 	if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
                   6536: 	    && $curres->randomout) {
                   6537: 	    return 0;
                   6538: 	}
                   6539: 	return 1;
                   6540:     }
                   6541:     return 0;
                   6542: }
                   6543: 
1.423     albertel 6544: =pod
                   6545: 
                   6546: =item scantron_validate_sequence
                   6547: 
1.424     albertel 6548:     Validates the selected sequence, checking for resource that are
                   6549:     not set to exam mode.
                   6550: 
1.423     albertel 6551: =cut
                   6552: 
1.334     albertel 6553: sub scantron_validate_sequence {
                   6554:     my ($r,$currentphase) = @_;
                   6555: 
                   6556:     my $navmap=Apache::lonnavmaps::navmap->new();
                   6557:     my (undef,undef,$sequence)=
                   6558: 	&Apache::lonnet::decode_symb($env{'form.selectpage'});
                   6559: 
                   6560:     my $map=$navmap->getResourceByUrl($sequence);
                   6561: 
                   6562:     $r->print('<input type="hidden" name="validate_sequence_exam"
                   6563:                                     value="ignore" />');
                   6564:     if ($env{'form.validate_sequence_exam'} ne 'ignore') {
                   6565: 	my @resources=
                   6566: 	    $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
                   6567: 	if (@resources) {
1.357     banghart 6568: 	    $r->print("<p>".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."</p>");
1.334     albertel 6569: 	    return (1,$currentphase);
                   6570: 	}
                   6571:     }
                   6572: 
                   6573:     return (0,$currentphase+1);
                   6574: }
                   6575: 
1.423     albertel 6576: 
                   6577: 
1.157     albertel 6578: sub scantron_validate_ID {
                   6579:     my ($r,$currentphase) = @_;
                   6580:     
                   6581:     #get student info
                   6582:     my $classlist=&Apache::loncoursedata::get_classlist();
                   6583:     my %idmap=&username_to_idmap($classlist);
                   6584: 
                   6585:     #get scantron line setup
1.257     albertel 6586:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 6587:     my ($scanlines,$scan_data)=&scantron_getfile();
1.447     foxr     6588:     
                   6589:     &scantron_get_maxbubble();	# parse needs the bubble_lines.. array.
1.157     albertel 6590: 
                   6591:     my %found=('ids'=>{},'usernames'=>{});
                   6592:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 6593: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 6594: 	if ($line=~/^[\s\cz]*$/) { next; }
                   6595: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   6596: 						 $scan_data);
                   6597: 	my $id=$$scan_record{'scantron.ID'};
                   6598: 	my $found;
                   6599: 	foreach my $checkid (keys(%idmap)) {
                   6600: 	    if (lc($checkid) eq lc($id)) { $found=$checkid;last; }
                   6601: 	}
                   6602: 	if ($found) {
                   6603: 	    my $username=$idmap{$found};
                   6604: 	    if ($found{'ids'}{$found}) {
                   6605: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6606: 					 $line,'duplicateID',$found);
1.194     albertel 6607: 		return(1,$currentphase);
1.157     albertel 6608: 	    } elsif ($found{'usernames'}{$username}) {
                   6609: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6610: 					 $line,'duplicateID',$username);
1.194     albertel 6611: 		return(1,$currentphase);
1.157     albertel 6612: 	    }
1.186     albertel 6613: 	    #FIXME store away line we previously saw the ID on to use above
1.157     albertel 6614: 	    $found{'ids'}{$found}++;
                   6615: 	    $found{'usernames'}{$username}++;
                   6616: 	} else {
                   6617: 	    if ($id =~ /^\s*$/) {
1.158     albertel 6618: 		my $username=&scan_data($scan_data,"$i.user");
1.157     albertel 6619: 		if (defined($username) && $found{'usernames'}{$username}) {
                   6620: 		    &scantron_get_correction($r,$i,$scan_record,
                   6621: 					     \%scantron_config,
                   6622: 					     $line,'duplicateID',$username);
1.194     albertel 6623: 		    return(1,$currentphase);
1.157     albertel 6624: 		} elsif (!defined($username)) {
                   6625: 		    &scantron_get_correction($r,$i,$scan_record,
                   6626: 					     \%scantron_config,
                   6627: 					     $line,'incorrectID');
1.194     albertel 6628: 		    return(1,$currentphase);
1.157     albertel 6629: 		}
                   6630: 		$found{'usernames'}{$username}++;
                   6631: 	    } else {
                   6632: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6633: 					 $line,'incorrectID');
1.194     albertel 6634: 		return(1,$currentphase);
1.157     albertel 6635: 	    }
                   6636: 	}
                   6637:     }
                   6638: 
                   6639:     return (0,$currentphase+1);
                   6640: }
                   6641: 
1.423     albertel 6642: 
1.157     albertel 6643: sub scantron_get_correction {
                   6644:     my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;
1.454     banghart 6645: #FIXME in the case of a duplicated ID the previous line, probably need
1.157     albertel 6646: #to show both the current line and the previous one and allow skipping
                   6647: #the previous one or the current one
                   6648: 
1.333     albertel 6649:     if ( $$scan_record{'scantron.PaperID'} =~ /\S/) {
1.492     albertel 6650: 	$r->print("<p>".&mt("<b>An error was detected ($error)</b>".
                   6651: 			    " for PaperID <tt>[_1]</tt>",
                   6652: 			    $$scan_record{'scantron.PaperID'})."</p> \n");
1.157     albertel 6653:     } else {
1.492     albertel 6654: 	$r->print("<p>".&mt("<b>An error was detected ($error)</b>".
                   6655: 			    " in scanline [_1] <pre>[_2]</pre>",
                   6656: 			    $i,$line)."</p> \n");
                   6657:     }
                   6658:     my $message="<p>".&mt("The ID on the form is  <tt>[_1]</tt><br />".
                   6659: 			  "The name on the paper is [_2],[_3]",
                   6660: 			  $$scan_record{'scantron.ID'},
                   6661: 			  $$scan_record{'scantron.LastName'},
                   6662: 			  $$scan_record{'scantron.FirstName'})."</p>";
1.242     albertel 6663: 
1.157     albertel 6664:     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
                   6665:     $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
1.503     raeburn  6666:                            # Array populated for doublebubble or
                   6667:     my @lines_to_correct;  # missingbubble errors to build javascript
                   6668:                            # to validate radio button checking   
                   6669: 
1.157     albertel 6670:     if ($error =~ /ID$/) {
1.186     albertel 6671: 	if ($error eq 'incorrectID') {
1.492     albertel 6672: 	    $r->print("<p>".&mt("The encoded ID is not in the classlist").
                   6673: 		      "</p>\n");
1.157     albertel 6674: 	} elsif ($error eq 'duplicateID') {
1.492     albertel 6675: 	    $r->print("<p>".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n");
1.157     albertel 6676: 	}
1.242     albertel 6677: 	$r->print($message);
1.492     albertel 6678: 	$r->print("<p>".&mt("How should I handle this?")." <br /> \n");
1.157     albertel 6679: 	$r->print("\n<ul><li> ");
                   6680: 	#FIXME it would be nice if this sent back the user ID and
                   6681: 	#could do partial userID matches
                   6682: 	$r->print(&Apache::loncommon::selectstudent_link('scantronupload',
                   6683: 				       'scantron_username','scantron_domain'));
                   6684: 	$r->print(": <input type='text' name='scantron_username' value='' />");
                   6685: 	$r->print("\n@".
1.257     albertel 6686: 		 &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));
1.157     albertel 6687: 
                   6688: 	$r->print('</li>');
1.186     albertel 6689:     } elsif ($error =~ /CODE$/) {
                   6690: 	if ($error eq 'incorrectCODE') {
1.492     albertel 6691: 	    $r->print("<p>".&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n");
1.186     albertel 6692: 	} elsif ($error eq 'duplicateCODE') {
1.492     albertel 6693: 	    $r->print("<p>".&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."</p>\n");
1.186     albertel 6694: 	}
1.492     albertel 6695: 	$r->print("<p>".&mt("The CODE on the form is  <tt>'[_1]'</tt>",
                   6696: 			    $$scan_record{'scantron.CODE'})."<br />\n");
1.242     albertel 6697: 	$r->print($message);
1.492     albertel 6698: 	$r->print("<p>".&mt("How should I handle this?")." <br /> \n");
1.187     albertel 6699: 	$r->print("\n<br /> ");
1.194     albertel 6700: 	my $i=0;
1.273     albertel 6701: 	if ($error eq 'incorrectCODE' 
                   6702: 	    && $$scan_record{'scantron.CODE'}=~/\S/ ) {
1.194     albertel 6703: 	    my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'});
1.278     albertel 6704: 	    if ($closest > 0) {
                   6705: 		foreach my $testcode (@{$closest}) {
                   6706: 		    my $checked='';
1.401     albertel 6707: 		    if (!$i) { $checked=' checked="checked" '; }
1.492     albertel 6708: 		    $r->print("
                   6709:    <label>
                   6710:        <input type='radio' name='scantron_CODE_resolution' value='use_closest_$i' $checked />
                   6711:        ".&mt("Use the similar CODE [_1] instead.",
                   6712: 	    "<b><tt>".$testcode."</tt></b>")."
                   6713:     </label>
                   6714:     <input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />");
1.278     albertel 6715: 		    $r->print("\n<br />");
                   6716: 		    $i++;
                   6717: 		}
1.194     albertel 6718: 	    }
                   6719: 	}
1.273     albertel 6720: 	if ($$scan_record{'scantron.CODE'}=~/\S/ ) {
1.401     albertel 6721: 	    my $checked; if (!$i) { $checked=' checked="checked" '; }
1.492     albertel 6722: 	    $r->print("
                   6723:     <label>
                   6724:         <input type='radio' name='scantron_CODE_resolution' value='use_unfound' $checked />
                   6725:        ".&mt("Use the CODE [_1] that is was on the paper, ignoring the error.",
                   6726: 	     "<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")."
                   6727:     </label>");
1.273     albertel 6728: 	    $r->print("\n<br />");
                   6729: 	}
1.194     albertel 6730: 
1.188     albertel 6731: 	$r->print(<<ENDSCRIPT);
                   6732: <script type="text/javascript">
                   6733: function change_radio(field) {
1.190     albertel 6734:     var slct=document.scantronupload.scantron_CODE_resolution;
1.188     albertel 6735:     var i;
                   6736:     for (i=0;i<slct.length;i++) {
                   6737:         if (slct[i].value==field) { slct[i].checked=true; }
                   6738:     }
                   6739: }
                   6740: </script>
                   6741: ENDSCRIPT
1.187     albertel 6742: 	my $href="/adm/pickcode?".
1.359     www      6743: 	   "form=".&escape("scantronupload").
                   6744: 	   "&scantron_format=".&escape($env{'form.scantron_format'}).
                   6745: 	   "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}).
                   6746: 	   "&curCODE=".&escape($$scan_record{'scantron.CODE'}).
                   6747: 	   "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'});
1.332     albertel 6748: 	if ($env{'form.scantron_CODElist'} =~ /\S/) { 
1.492     albertel 6749: 	    $r->print("
                   6750:     <label>
                   6751:        <input type='radio' name='scantron_CODE_resolution' value='use_found' />
                   6752:        ".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.",
                   6753: 	     "<a target='_blank' href='$href'>","</a>")."
                   6754:     </label> 
                   6755:     ".&mt("Selected CODE is [_1]","<input readonly='true' type='text' size='8' name='scantron_CODE_selectedvalue' onfocus=\"javascript:change_radio('use_found')\" onchange=\"javascript:change_radio('use_found')\" />"));
1.332     albertel 6756: 	    $r->print("\n<br />");
                   6757: 	}
1.492     albertel 6758: 	$r->print("
                   6759:     <label>
                   6760:        <input type='radio' name='scantron_CODE_resolution' value='use_typed' />
                   6761:        ".&mt("Use [_1] as the CODE.",
                   6762: 	     "</label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" />"));
1.187     albertel 6763: 	$r->print("\n<br /><br />");
1.157     albertel 6764:     } elsif ($error eq 'doublebubble') {
1.503     raeburn  6765: 	$r->print("<p>".&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n");
1.497     foxr     6766: 
                   6767: 	# The form field scantron_questions is acutally a list of line numbers.
                   6768: 	# represented by this form so:
                   6769: 
                   6770: 	my $line_list = &questions_to_line_list($arg);
                   6771: 
1.157     albertel 6772: 	$r->print('<input type="hidden" name="scantron_questions" value="'.
1.497     foxr     6773: 		  $line_list.'" />');
1.242     albertel 6774: 	$r->print($message);
1.492     albertel 6775: 	$r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>");
1.157     albertel 6776: 	foreach my $question (@{$arg}) {
1.503     raeburn  6777: 	    my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                   6778:                                                    $scan_record, $error);
1.524     raeburn  6779:             push(@lines_to_correct,@linenums);
1.157     albertel 6780: 	}
1.503     raeburn  6781:         $r->print(&verify_bubbles_checked(@lines_to_correct));
1.157     albertel 6782:     } elsif ($error eq 'missingbubble') {
1.492     albertel 6783: 	$r->print("<p>".&mt("There have been <b>no</b> bubbles scanned for some question(s)")."</p>\n");
1.242     albertel 6784: 	$r->print($message);
1.492     albertel 6785: 	$r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>");
1.503     raeburn  6786: 	$r->print(&mt("Some questions have no scanned bubbles.")."\n");
1.497     foxr     6787: 
1.503     raeburn  6788: 	# The form field scantron_questions is actually a list of line numbers not
1.497     foxr     6789: 	# a list of question numbers. Therefore:
                   6790: 	#
                   6791: 	
                   6792: 	my $line_list = &questions_to_line_list($arg);
                   6793: 
1.157     albertel 6794: 	$r->print('<input type="hidden" name="scantron_questions" value="'.
1.497     foxr     6795: 		  $line_list.'" />');
1.157     albertel 6796: 	foreach my $question (@{$arg}) {
1.503     raeburn  6797: 	    my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                   6798:                                                    $scan_record, $error);
1.524     raeburn  6799:             push(@lines_to_correct,@linenums);
1.157     albertel 6800: 	}
1.503     raeburn  6801:         $r->print(&verify_bubbles_checked(@lines_to_correct));
1.157     albertel 6802:     } else {
                   6803: 	$r->print("\n<ul>");
                   6804:     }
                   6805:     $r->print("\n</li></ul>");
1.497     foxr     6806: }
                   6807: 
1.503     raeburn  6808: sub verify_bubbles_checked {
                   6809:     my (@ansnums) = @_;
                   6810:     my $ansnumstr = join('","',@ansnums);
                   6811:     my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines.");
                   6812:     my $output = (<<ENDSCRIPT);
                   6813: <script type="text/javascript">
                   6814: function verify_bubble_radio(form) {
                   6815:     var ansnumArray = new Array ("$ansnumstr");
                   6816:     var need_bubble_count = 0;
                   6817:     for (var i=0; i<ansnumArray.length; i++) {
                   6818:         if (form.elements["scantron_correct_Q_"+ansnumArray[i]].length > 1) {
                   6819:             var bubble_picked = 0; 
                   6820:             for (var j=0; j<form.elements["scantron_correct_Q_"+ansnumArray[i]].length; j++) {
                   6821:                 if (form.elements["scantron_correct_Q_"+ansnumArray[i]][j].checked == true) {
                   6822:                     bubble_picked = 1;
                   6823:                 }
                   6824:             }
                   6825:             if (bubble_picked == 0) {
                   6826:                 need_bubble_count ++;
                   6827:             }
                   6828:         }
                   6829:     }
                   6830:     if (need_bubble_count) {
                   6831:         alert("$warning");
                   6832:         return;
                   6833:     }
                   6834:     form.submit(); 
                   6835: }
                   6836: </script>
                   6837: ENDSCRIPT
                   6838:     return $output;
                   6839: }
                   6840: 
1.497     foxr     6841: =pod
                   6842: 
                   6843: =item  questions_to_line_list
1.157     albertel 6844: 
1.497     foxr     6845: Converts a list of questions into a string of comma separated
                   6846: line numbers in the answer sheet used by the questions.  This is
                   6847: used to fill in the scantron_questions form field.
                   6848: 
                   6849:   Arguments:
                   6850:      questions    - Reference to an array of questions.
                   6851: 
                   6852: =cut
                   6853: 
                   6854: 
                   6855: sub questions_to_line_list {
                   6856:     my ($questions) = @_;
                   6857:     my @lines;
                   6858: 
1.503     raeburn  6859:     foreach my $item (@{$questions}) {
                   6860:         my $question = $item;
                   6861:         my ($first,$count,$last);
                   6862:         if ($item =~ /^(\d+)\.(\d+)$/) {
                   6863:             $question = $1;
                   6864:             my $subquestion = $2;
                   6865:             $first = $first_bubble_line{$question-1} + 1;
                   6866:             my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   6867:             my $subcount = 1;
                   6868:             while ($subcount<$subquestion) {
                   6869:                 $first += $subans[$subcount-1];
                   6870:                 $subcount ++;
                   6871:             }
                   6872:             $count = $subans[$subquestion-1];
                   6873:         } else {
                   6874: 	    $first   = $first_bubble_line{$question-1} + 1;
                   6875: 	    $count   = $bubble_lines_per_response{$question-1};
                   6876:         }
1.506     raeburn  6877:         $last = $first+$count-1;
1.503     raeburn  6878:         push(@lines, ($first..$last));
1.497     foxr     6879:     }
                   6880:     return join(',', @lines);
                   6881: }
                   6882: 
                   6883: =pod 
                   6884: 
                   6885: =item prompt_for_corrections
                   6886: 
                   6887: Prompts for a potentially multiline correction to the
                   6888: user's bubbling (factors out common code from scantron_get_correction
                   6889: for multi and missing bubble cases).
                   6890: 
                   6891:  Arguments:
                   6892:    $r           - Apache request object.
                   6893:    $question    - The question number to prompt for.
                   6894:    $scan_config - The scantron file configuration hash.
                   6895:    $scan_record - Reference to the hash that has the the parsed scanlines.
1.503     raeburn  6896:    $error       - Type of error
1.497     foxr     6897: 
                   6898:  Implicit inputs:
                   6899:    %bubble_lines_per_response   - Starting line numbers for each question.
                   6900:                                   Numbered from 0 (but question numbers are from
                   6901:                                   1.
                   6902:    %first_bubble_line           - Starting bubble line for each question.
1.509     raeburn  6903:    %subdivided_bubble_lines     - optionresponse, matchresponse and rankresponse 
                   6904:                                   type problems render as separate sub-questions, 
1.503     raeburn  6905:                                   in exam mode. This hash contains a 
                   6906:                                   comma-separated list of the lines per 
                   6907:                                   sub-question.
1.510     raeburn  6908:    %responsetype_per_response   - essayresponse, formularesponse,
                   6909:                                   stringresponse, imageresponse, reactionresponse,
                   6910:                                   and organicresponse type problem parts can have
1.503     raeburn  6911:                                   multiple lines per response if the weight
                   6912:                                   assigned exceeds 10.  In this case, only
                   6913:                                   one bubble per line is permitted, but more 
                   6914:                                   than one line might contain bubbles, e.g.
                   6915:                                   bubbling of: line 1 - J, line 2 - J, 
                   6916:                                   line 3 - B would assign 22 points.  
1.497     foxr     6917: 
                   6918: =cut
                   6919: 
                   6920: sub prompt_for_corrections {
1.503     raeburn  6921:     my ($r, $question, $scan_config, $scan_record, $error) = @_;
                   6922:     my ($current_line,$lines);
                   6923:     my @linenums;
                   6924:     my $questionnum = $question;
                   6925:     if ($question =~ /^(\d+)\.(\d+)$/) {
                   6926:         $question = $1;
                   6927:         $current_line = $first_bubble_line{$question-1} + 1 ;
                   6928:         my $subquestion = $2;
                   6929:         my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   6930:         my $subcount = 1;
                   6931:         while ($subcount<$subquestion) {
                   6932:             $current_line += $subans[$subcount-1];
                   6933:             $subcount ++;
                   6934:         }
                   6935:         $lines = $subans[$subquestion-1];
                   6936:     } else {
                   6937:         $current_line = $first_bubble_line{$question-1} + 1 ;
                   6938:         $lines        = $bubble_lines_per_response{$question-1};
                   6939:     }
1.497     foxr     6940:     if ($lines > 1) {
1.503     raeburn  6941:         $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />');
                   6942:         if (($responsetype_per_response{$question-1} eq 'essayresponse') ||
                   6943:             ($responsetype_per_response{$question-1} eq 'formularesponse') ||
1.510     raeburn  6944:             ($responsetype_per_response{$question-1} eq 'stringresponse') ||
                   6945:             ($responsetype_per_response{$question-1} eq 'imageresponse') ||
                   6946:             ($responsetype_per_response{$question-1} eq 'reactionresponse') ||
                   6947:             ($responsetype_per_response{$question-1} eq 'organicresponse')) {
1.503     raeburn  6948:             $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their scantron sheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during scantron 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 />');
                   6949:         } else {
                   6950:             $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />");
                   6951:         }
1.497     foxr     6952:     }
                   6953:     for (my $i =0; $i < $lines; $i++) {
1.503     raeburn  6954:         my $selected = $$scan_record{"scantron.$current_line.answer"};
                   6955: 	&scantron_bubble_selector($r,$scan_config,$current_line, 
                   6956: 	        		  $questionnum,$error,split('', $selected));
1.524     raeburn  6957:         push(@linenums,$current_line);
1.497     foxr     6958: 	$current_line++;
                   6959:     }
                   6960:     if ($lines > 1) {
                   6961: 	$r->print("<hr /><br />");
                   6962:     }
1.503     raeburn  6963:     return @linenums;
1.157     albertel 6964: }
1.423     albertel 6965: 
                   6966: =pod
                   6967: 
                   6968: =item scantron_bubble_selector
                   6969:   
                   6970:    Generates the html radiobuttons to correct a single bubble line
1.424     albertel 6971:    possibly showing the existing the selected bubbles if known
1.423     albertel 6972: 
                   6973:  Arguments:
                   6974:     $r           - Apache request object
                   6975:     $scan_config - hash from &get_scantron_config()
1.497     foxr     6976:     $line        - Number of the line being displayed.
1.503     raeburn  6977:     $questionnum - Question number (may include subquestion)
                   6978:     $error       - Type of error.
1.497     foxr     6979:     @selected    - Array of bubbles picked on this line.
1.423     albertel 6980: 
                   6981: =cut
                   6982: 
1.157     albertel 6983: sub scantron_bubble_selector {
1.503     raeburn  6984:     my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_;
1.157     albertel 6985:     my $max=$$scan_config{'Qlength'};
1.274     albertel 6986: 
                   6987:     my $scmode=$$scan_config{'Qon'};
                   6988:     if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }	     
                   6989: 
1.157     albertel 6990:     my @alphabet=('A'..'Z');
1.503     raeburn  6991:     $r->print(&Apache::loncommon::start_data_table().
                   6992:               &Apache::loncommon::start_data_table_row());
                   6993:     $r->print('<td rowspan="2" class="LC_leftcol_header">'.$line.'</td>');
1.497     foxr     6994:     for (my $i=0;$i<$max+1;$i++) {
                   6995: 	$r->print("\n".'<td align="center">');
                   6996: 	if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
                   6997: 	else { $r->print('&nbsp;'); }
                   6998: 	$r->print('</td>');
                   6999:     }
1.503     raeburn  7000:     $r->print(&Apache::loncommon::end_data_table_row().
                   7001:               &Apache::loncommon::start_data_table_row());
1.497     foxr     7002:     for (my $i=0;$i<$max;$i++) {
                   7003: 	$r->print("\n".
                   7004: 		  '<td><label><input type="radio" name="scantron_correct_Q_'.
                   7005: 		  $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
                   7006:     }
1.503     raeburn  7007:     my $nobub_checked = ' ';
                   7008:     if ($error eq 'missingbubble') {
                   7009:         $nobub_checked = ' checked = "checked" ';
                   7010:     }
                   7011:     $r->print("\n".'<td><label><input type="radio" name="scantron_correct_Q_'.
                   7012: 	      $line.'" value="none"'.$nobub_checked.'/>'.&mt('No bubble').
                   7013:               '</label>'."\n".'<input type="hidden" name="scantron_questionnum_Q_'.
                   7014:               $line.'" value="'.$questionnum.'" /></td>');
                   7015:     $r->print(&Apache::loncommon::end_data_table_row().
                   7016:               &Apache::loncommon::end_data_table());
1.157     albertel 7017: }
                   7018: 
1.423     albertel 7019: =pod
                   7020: 
                   7021: =item num_matches
                   7022: 
1.424     albertel 7023:    Counts the number of characters that are the same between the two arguments.
                   7024: 
                   7025:  Arguments:
                   7026:    $orig - CODE from the scanline
                   7027:    $code - CODE to match against
                   7028: 
                   7029:  Returns:
                   7030:    $count - integer count of the number of same characters between the
                   7031:             two arguments
                   7032: 
1.423     albertel 7033: =cut
                   7034: 
1.194     albertel 7035: sub num_matches {
                   7036:     my ($orig,$code) = @_;
                   7037:     my @code=split(//,$code);
                   7038:     my @orig=split(//,$orig);
                   7039:     my $same=0;
                   7040:     for (my $i=0;$i<scalar(@code);$i++) {
                   7041: 	if ($code[$i] eq $orig[$i]) { $same++; }
                   7042:     }
                   7043:     return $same;
                   7044: }
                   7045: 
1.423     albertel 7046: =pod
                   7047: 
                   7048: =item scantron_get_closely_matching_CODEs
                   7049: 
1.424     albertel 7050:    Cycles through all CODEs and finds the set that has the greatest
                   7051:    number of same characters as the provided CODE
                   7052: 
                   7053:  Arguments:
                   7054:    $allcodes - hash ref returned by &get_codes()
                   7055:    $CODE     - CODE from the current scanline
                   7056: 
                   7057:  Returns:
                   7058:    2 element list
                   7059:     - first elements is number of how closely matching the best fit is 
                   7060:       (5 means best set has 5 matching characters)
                   7061:     - second element is an arrary ref containing the set of valid CODEs
                   7062:       that best fit the passed in CODE
                   7063: 
1.423     albertel 7064: =cut
                   7065: 
1.194     albertel 7066: sub scantron_get_closely_matching_CODEs {
                   7067:     my ($allcodes,$CODE)=@_;
                   7068:     my @CODEs;
                   7069:     foreach my $testcode (sort(keys(%{$allcodes}))) {
                   7070: 	push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode);
                   7071:     }
                   7072: 
                   7073:     return ($#CODEs,$CODEs[-1]);
                   7074: }
                   7075: 
1.423     albertel 7076: =pod
                   7077: 
                   7078: =item get_codes
                   7079: 
1.424     albertel 7080:    Builds a hash which has keys of all of the valid CODEs from the selected
                   7081:    set of remembered CODEs.
                   7082: 
                   7083:  Arguments:
                   7084:   $old_name - name of the set of remembered CODEs
                   7085:   $cdom     - domain of the course
                   7086:   $cnum     - internal course name
                   7087: 
                   7088:  Returns:
                   7089:   %allcodes - keys are the valid CODEs, values are all 1
                   7090: 
1.423     albertel 7091: =cut
                   7092: 
1.194     albertel 7093: sub get_codes {
1.280     foxr     7094:     my ($old_name, $cdom, $cnum) = @_;
                   7095:     if (!$old_name) {
                   7096: 	$old_name=$env{'form.scantron_CODElist'};
                   7097:     }
                   7098:     if (!$cdom) {
                   7099: 	$cdom =$env{'course.'.$env{'request.course.id'}.'.domain'};
                   7100:     }
                   7101:     if (!$cnum) {
                   7102: 	$cnum =$env{'course.'.$env{'request.course.id'}.'.num'};
                   7103:     }
1.278     albertel 7104:     my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"],
                   7105: 				    $cdom,$cnum);
                   7106:     my %allcodes;
                   7107:     if ($result{"type\0$old_name"} eq 'number') {
                   7108: 	%allcodes=map {($_,1)} split(',',$result{$old_name});
                   7109:     } else {
                   7110: 	%allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name});
                   7111:     }
1.194     albertel 7112:     return %allcodes;
                   7113: }
                   7114: 
1.423     albertel 7115: =pod
                   7116: 
                   7117: =item scantron_validate_CODE
                   7118: 
1.424     albertel 7119:    Validates all scanlines in the selected file to not have any
                   7120:    invalid or underspecified CODEs and that none of the codes are
                   7121:    duplicated if this was requested.
                   7122: 
1.423     albertel 7123: =cut
                   7124: 
1.157     albertel 7125: sub scantron_validate_CODE {
                   7126:     my ($r,$currentphase) = @_;
1.257     albertel 7127:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.186     albertel 7128:     if ($scantron_config{'CODElocation'} &&
                   7129: 	$scantron_config{'CODEstart'} &&
                   7130: 	$scantron_config{'CODElength'}) {
1.257     albertel 7131: 	if (!defined($env{'form.scantron_CODElist'})) {
1.186     albertel 7132: 	    &FIXME_blow_up()
                   7133: 	}
                   7134:     } else {
                   7135: 	return (0,$currentphase+1);
                   7136:     }
                   7137:     
                   7138:     my %usedCODEs;
                   7139: 
1.194     albertel 7140:     my %allcodes=&get_codes();
1.186     albertel 7141: 
1.447     foxr     7142:     &scantron_get_maxbubble();	# parse needs the lines per response array.
                   7143: 
1.186     albertel 7144:     my ($scanlines,$scan_data)=&scantron_getfile();
                   7145:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7146: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.186     albertel 7147: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7148: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7149: 						 $scan_data);
                   7150: 	my $CODE=$$scan_record{'scantron.CODE'};
                   7151: 	my $error=0;
1.224     albertel 7152: 	if (!&Apache::lonnet::validCODE($CODE)) {
                   7153: 	    &scantron_get_correction($r,$i,$scan_record,
                   7154: 				     \%scantron_config,
                   7155: 				     $line,'incorrectCODE',\%allcodes);
                   7156: 	    return(1,$currentphase);
                   7157: 	}
1.221     albertel 7158: 	if (%allcodes && !exists($allcodes{$CODE}) 
                   7159: 	    && !$$scan_record{'scantron.useCODE'}) {
1.186     albertel 7160: 	    &scantron_get_correction($r,$i,$scan_record,
                   7161: 				     \%scantron_config,
1.194     albertel 7162: 				     $line,'incorrectCODE',\%allcodes);
                   7163: 	    return(1,$currentphase);
1.186     albertel 7164: 	}
1.214     albertel 7165: 	if (exists($usedCODEs{$CODE}) 
1.257     albertel 7166: 	    && $env{'form.scantron_CODEunique'} eq 'yes'
1.192     albertel 7167: 	    && !$$scan_record{'scantron.CODE_ignore_dup'}) {
1.186     albertel 7168: 	    &scantron_get_correction($r,$i,$scan_record,
                   7169: 				     \%scantron_config,
1.194     albertel 7170: 				     $line,'duplicateCODE',$usedCODEs{$CODE});
                   7171: 	    return(1,$currentphase);
1.186     albertel 7172: 	}
1.524     raeburn  7173: 	push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
1.186     albertel 7174:     }
1.157     albertel 7175:     return (0,$currentphase+1);
                   7176: }
                   7177: 
1.423     albertel 7178: =pod
                   7179: 
                   7180: =item scantron_validate_doublebubble
                   7181: 
1.424     albertel 7182:    Validates all scanlines in the selected file to not have any
                   7183:    bubble lines with multiple bubbles marked.
                   7184: 
1.423     albertel 7185: =cut
                   7186: 
1.157     albertel 7187: sub scantron_validate_doublebubble {
                   7188:     my ($r,$currentphase) = @_;
                   7189:     #get student info
                   7190:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7191:     my %idmap=&username_to_idmap($classlist);
                   7192: 
                   7193:     #get scantron line setup
1.257     albertel 7194:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7195:     my ($scanlines,$scan_data)=&scantron_getfile();
1.447     foxr     7196:     &scantron_get_maxbubble();	# parse needs the bubble line array.
                   7197: 
1.157     albertel 7198:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7199: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7200: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7201: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7202: 						 $scan_data);
                   7203: 	if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
                   7204: 	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,
                   7205: 				 'doublebubble',
                   7206: 				 $$scan_record{'scantron.doubleerror'});
                   7207:     	return (1,$currentphase);
                   7208:     }
                   7209:     return (0,$currentphase+1);
                   7210: }
                   7211: 
1.423     albertel 7212: 
1.503     raeburn  7213: sub scantron_get_maxbubble {
1.257     albertel 7214:     if (defined($env{'form.scantron_maxbubble'}) &&
                   7215: 	$env{'form.scantron_maxbubble'}) {
1.447     foxr     7216: 	&restore_bubble_lines();
1.257     albertel 7217: 	return $env{'form.scantron_maxbubble'};
1.191     albertel 7218:     }
1.330     albertel 7219: 
1.447     foxr     7220:     my (undef, undef, $sequence) =
1.257     albertel 7221: 	&Apache::lonnet::decode_symb($env{'form.selectpage'});
1.330     albertel 7222: 
1.447     foxr     7223:     my $navmap=Apache::lonnavmaps::navmap->new();
1.191     albertel 7224:     my $map=$navmap->getResourceByUrl($sequence);
                   7225:     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
1.330     albertel 7226: 
                   7227:     &Apache::lonxml::clear_problem_counter();
                   7228: 
1.435     foxr     7229:     my $uname       = $env{'form.student'};
                   7230:     my $udom        = $env{'form.userdom'};
                   7231:     my $cid         = $env{'request.course.id'};
                   7232:     my $total_lines = 0;
                   7233:     %bubble_lines_per_response = ();
1.447     foxr     7234:     %first_bubble_line         = ();
1.503     raeburn  7235:     %subdivided_bubble_lines   = ();
                   7236:     %responsetype_per_response = ();
1.447     foxr     7237:   
                   7238:     my $response_number = 0;
                   7239:     my $bubble_line     = 0;
1.191     albertel 7240:     foreach my $resource (@resources) {
1.515     raeburn  7241:         my $symb = $resource->symb();
1.523     raeburn  7242: 
                   7243:         my (@parts,@allparts,@possible_parts);
                   7244: 
1.510     raeburn  7245:         # Need to retrieve part IDs and response IDs because essayresponse,
                   7246:         # reactionresponse and organicresponse items are not included in 
                   7247:         # $analysis{'parts'} from lonnet::ssi.  
1.523     raeburn  7248:         if (ref($resource->parts()) eq 'ARRAY') {
1.503     raeburn  7249:             foreach my $part (@{$resource->parts()}) {
1.515     raeburn  7250:                 if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {
                   7251:                     my @resp_ids = $resource->responseIds($part);
                   7252:                     foreach my $id (@resp_ids) {
1.523     raeburn  7253:                         my $part_id = $part.'.'.$id;
                   7254:                         push(@possible_parts,$part_id);
1.515     raeburn  7255:                     }
1.503     raeburn  7256:                 }
                   7257:             }
                   7258:         }
1.435     foxr     7259: 
1.523     raeburn  7260:         my $result=&ssi_with_retries($resource->src(), $ssi_retries,
                   7261:                                         ('symb' => $symb,
                   7262:                                          'grade_target' => 'analyze',
                   7263:                                          'grade_courseid' => $cid,
                   7264:                                          'grade_domain' => $udom,
                   7265:                                          'grade_username' => $uname));
                   7266:         my (undef, $an) =
                   7267:             split(/_HASH_REF__/,$result, 2);
1.503     raeburn  7268: 
1.435     foxr     7269: 	my %analysis = &Apache::lonnet::str2hash($an);
                   7270: 
1.503     raeburn  7271:         if (ref($analysis{'parts'}) eq 'ARRAY') {
1.515     raeburn  7272:             foreach my $part (@{$analysis{'parts'}}) {
                   7273:                 my ($id,$respid) = split(/\./,$part);
                   7274:                 if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) {
                   7275:                     push(@parts,$part);
                   7276:                 }
                   7277:             }
1.503     raeburn  7278:         }
1.523     raeburn  7279:         # Add part_ids for any essayresponse, reactionresponse or 
                   7280:         # organicresponse items. 
                   7281:         foreach my $part_id (@possible_parts) {
                   7282:             if (grep(/^\Q$part_id\E$/,@parts)) {
                   7283:                 push(@allparts,$part_id);
                   7284:             } else {
                   7285:                 if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
                   7286:                     ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
                   7287:                     ($analysis{$part_id.'.type'} eq 'organicresponse')) {
1.524     raeburn  7288:                     push(@allparts,$part_id);
1.503     raeburn  7289:                 }
                   7290:             }
                   7291:         }
1.435     foxr     7292: 
1.523     raeburn  7293: 	foreach my $part_id (@allparts) {
                   7294:             my $lines;
1.447     foxr     7295: 
                   7296: 	    # TODO - make this a persistent hash not an array.
                   7297: 
1.509     raeburn  7298:             # optionresponse, matchresponse and rankresponse type items 
                   7299:             # render as separate sub-questions in exam mode.
1.503     raeburn  7300:             if (($analysis{$part_id.'.type'} eq 'optionresponse') ||
1.509     raeburn  7301:                 ($analysis{$part_id.'.type'} eq 'matchresponse') ||
                   7302:                 ($analysis{$part_id.'.type'} eq 'rankresponse')) {
1.503     raeburn  7303:                 my ($numbub,$numshown);
                   7304:                 if ($analysis{$part_id.'.type'} eq 'optionresponse') {
                   7305:                     if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') {
                   7306:                         $numbub = scalar(@{$analysis{$part_id.'.options'}});
                   7307:                     }
                   7308:                 } elsif ($analysis{$part_id.'.type'} eq 'matchresponse') {
                   7309:                     if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') {
                   7310:                         $numbub = scalar(@{$analysis{$part_id.'.items'}});
                   7311:                     }
1.509     raeburn  7312:                 } elsif ($analysis{$part_id.'.type'} eq 'rankresponse') {
                   7313:                     if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') {
                   7314:                         $numbub = scalar(@{$analysis{$part_id.'.foils'}});
                   7315:                     }
1.503     raeburn  7316:                 }
                   7317:                 if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') {
                   7318:                     $numshown = scalar(@{$analysis{$part_id.'.shown'}});
                   7319:                 }
                   7320:                 my $bubbles_per_line = 10;
1.523     raeburn  7321:                 my $inner_bubble_lines = int($numbub/$bubbles_per_line);
                   7322:                 if (($numbub % $bubbles_per_line) != 0) {
1.503     raeburn  7323:                     $inner_bubble_lines++;
                   7324:                 }
                   7325:                 for (my $i=0; $i<$numshown; $i++) {
                   7326:                     $subdivided_bubble_lines{$response_number} .= 
                   7327:                         $inner_bubble_lines.',';
                   7328:                 }
                   7329:                 $subdivided_bubble_lines{$response_number} =~ s/,$//;
1.523     raeburn  7330:                 $lines = $numshown * $inner_bubble_lines;
                   7331:             } else {
                   7332:                 $lines = $analysis{"$part_id.bubble_lines"};
1.503     raeburn  7333:             } 
1.447     foxr     7334: 
1.503     raeburn  7335:             $first_bubble_line{$response_number} = $bubble_line;
                   7336: 	    $bubble_lines_per_response{$response_number} = $lines;
                   7337:             $responsetype_per_response{$response_number} = 
                   7338:                 $analysis{$part_id.'.type'};
1.447     foxr     7339: 	    $response_number++;
                   7340: 
                   7341: 	    $bubble_line +=  $lines;
                   7342: 	    $total_lines +=  $lines;
1.435     foxr     7343: 	}
                   7344: 
1.191     albertel 7345:     }
                   7346:     &Apache::lonnet::delenv('scantron\.');
1.447     foxr     7347: 
                   7348:     &save_bubble_lines();
1.330     albertel 7349:     $env{'form.scantron_maxbubble'} =
1.435     foxr     7350: 	$total_lines;
1.257     albertel 7351:     return $env{'form.scantron_maxbubble'};
1.191     albertel 7352: }
                   7353: 
1.423     albertel 7354: 
1.157     albertel 7355: sub scantron_validate_missingbubbles {
                   7356:     my ($r,$currentphase) = @_;
                   7357:     #get student info
                   7358:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7359:     my %idmap=&username_to_idmap($classlist);
                   7360: 
                   7361:     #get scantron line setup
1.257     albertel 7362:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7363:     my ($scanlines,$scan_data)=&scantron_getfile();
1.191     albertel 7364:     my $max_bubble=&scantron_get_maxbubble();
1.157     albertel 7365:     if (!$max_bubble) { $max_bubble=2**31; }
                   7366:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7367: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7368: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7369: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7370: 						 $scan_data);
                   7371: 	if (!defined($$scan_record{'scantron.missingerror'})) { next; }
                   7372: 	my @to_correct;
1.470     foxr     7373: 	
                   7374: 	# Probably here's where the error is...
                   7375: 
1.157     albertel 7376: 	foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
1.505     raeburn  7377:             my $lastbubble;
                   7378:             if ($missing =~ /^(\d+)\.(\d+)$/) {
                   7379:                my $question = $1;
                   7380:                my $subquestion = $2;
                   7381:                if (!defined($first_bubble_line{$question -1})) { next; }
                   7382:                my $first = $first_bubble_line{$question-1};
                   7383:                my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   7384:                my $subcount = 1;
                   7385:                while ($subcount<$subquestion) {
                   7386:                    $first += $subans[$subcount-1];
                   7387:                    $subcount ++;
                   7388:                }
                   7389:                my $count = $subans[$subquestion-1];
                   7390:                $lastbubble = $first + $count;
                   7391:             } else {
                   7392:                 if (!defined($first_bubble_line{$missing - 1})) { next; }
                   7393:                 $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1};
                   7394:             }
                   7395:             if ($lastbubble > $max_bubble) { next; }
1.157     albertel 7396: 	    push(@to_correct,$missing);
                   7397: 	}
                   7398: 	if (@to_correct) {
                   7399: 	    &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   7400: 				     $line,'missingbubble',\@to_correct);
                   7401: 	    return (1,$currentphase);
                   7402: 	}
                   7403: 
                   7404:     }
                   7405:     return (0,$currentphase+1);
                   7406: }
                   7407: 
1.423     albertel 7408: 
1.82      albertel 7409: sub scantron_process_students {
1.75      albertel 7410:     my ($r) = @_;
1.513     foxr     7411: 
1.257     albertel 7412:     my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
1.324     albertel 7413:     my ($symb)=&get_symb($r);
1.513     foxr     7414:     if (!$symb) {
                   7415: 	return '';
                   7416:     }
1.324     albertel 7417:     my $default_form_data=&defaultFormData($symb);
1.82      albertel 7418: 
1.257     albertel 7419:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7420:     my ($scanlines,$scan_data)=&scantron_getfile();
1.82      albertel 7421:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7422:     my %idmap=&username_to_idmap($classlist);
1.132     bowersj2 7423:     my $navmap=Apache::lonnavmaps::navmap->new();
1.83      albertel 7424:     my $map=$navmap->getResourceByUrl($sequence);
                   7425:     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
1.140     albertel 7426: #    $r->print("geto ".scalar(@resources)."<br />");
1.82      albertel 7427:     my $result= <<SCANTRONFORM;
1.81      albertel 7428: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
                   7429:   <input type="hidden" name="command" value="scantron_configphase" />
                   7430:   $default_form_data
                   7431: SCANTRONFORM
1.82      albertel 7432:     $r->print($result);
                   7433: 
                   7434:     my @delayqueue;
1.140     albertel 7435:     my %completedstudents;
                   7436:     
1.520     www      7437:     my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
1.200     albertel 7438:     my $count=&get_todo_count($scanlines,$scan_data);
1.157     albertel 7439:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
1.200     albertel 7440:  				    'Scantron Progress',$count,
1.195     albertel 7441: 				    'inline',undef,'scantronupload');
1.140     albertel 7442:     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
                   7443: 					  'Processing first student');
                   7444:     my $start=&Time::HiRes::time();
1.158     albertel 7445:     my $i=-1;
1.200     albertel 7446:     my ($uname,$udom,$started);
1.447     foxr     7447: 
                   7448:     &scantron_get_maxbubble();	# Need the bubble lines array to parse.
1.513     foxr     7449:     
                   7450: 
                   7451:     # If an ssi failed in scantron_get_maxbubble, put an error message out to
                   7452:     # the user and return.
                   7453: 
                   7454:     if ($ssi_error) {
                   7455: 	$r->print("</form>");
                   7456: 	&ssi_print_error($r);
                   7457: 	$r->print(&show_grading_menu_form($symb));
1.520     www      7458:         &Apache::lonnet::remove_lock($lock);
1.513     foxr     7459: 	return '';		# Dunno why the other returns return '' rather than just returning.
                   7460:     }
1.447     foxr     7461: 
1.157     albertel 7462:     while ($i<$scanlines->{'count'}) {
                   7463:  	($uname,$udom)=('','');
                   7464:  	$i++;
1.200     albertel 7465:  	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7466:  	if ($line=~/^[\s\cz]*$/) { next; }
1.200     albertel 7467: 	if ($started) {
                   7468: 	    &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   7469: 						     'last student');
                   7470: 	}
                   7471: 	$started=1;
1.157     albertel 7472:  	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7473:  						 $scan_data);
                   7474:  	unless ($uname=&scantron_find_student($scan_record,$scan_data,
                   7475:  					      \%idmap,$i)) {
                   7476:   	    &scantron_add_delay(\@delayqueue,$line,
                   7477:  				'Unable to find a student that matches',1);
                   7478:  	    next;
                   7479:   	}
                   7480:  	if (exists $completedstudents{$uname}) {
                   7481:  	    &scantron_add_delay(\@delayqueue,$line,
                   7482:  				'Student '.$uname.' has multiple sheets',2);
                   7483:  	    next;
                   7484:  	}
                   7485:   	($uname,$udom)=split(/:/,$uname);
1.330     albertel 7486: 
                   7487: 	&Apache::lonxml::clear_problem_counter();
1.514     raeburn  7488:   	&Apache::lonnet::appenv($scan_record);
1.376     albertel 7489: 
                   7490: 	if (&scantron_clear_skip($scanlines,$scan_data,$i)) {
                   7491: 	    &scantron_putfile($scanlines,$scan_data);
                   7492: 	}
1.161     albertel 7493: 	
                   7494: 	my $i=0;
1.83      albertel 7495: 	foreach my $resource (@resources) {
1.85      albertel 7496: 	    $i++;
1.193     albertel 7497: 	    my %form=('submitted'     =>'scantron',
                   7498: 		      'grade_target'  =>'grade',
                   7499: 		      'grade_username'=>$uname,
                   7500: 		      'grade_domain'  =>$udom,
1.257     albertel 7501: 		      'grade_courseid'=>$env{'request.course.id'},
1.193     albertel 7502: 		      'grade_symb'    =>$resource->symb());
1.383     albertel 7503: 	    if (exists($scan_record->{'scantron.CODE'})
                   7504: 		&& 
                   7505: 		&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) {
1.193     albertel 7506: 		$form{'CODE'}=$scan_record->{'scantron.CODE'};
1.224     albertel 7507: 	    } else {
                   7508: 		$form{'CODE'}='';
1.513     foxr     7509: 	    } 
                   7510: 	    my $result=&ssi_with_retries($resource->src(), $ssi_retries, %form);
                   7511: 	    if ($ssi_error) {
                   7512: 		$ssi_error = 0;	# So end of handler error message does not trigger.
                   7513: 		$r->print("</form>");
                   7514: 		&ssi_print_error($r);
                   7515: 		$r->print(&show_grading_menu_form($symb));
1.520     www      7516:                 &Apache::lonnet::remove_lock($lock);
1.513     foxr     7517: 		return '';	# Why return ''?  Beats me.
1.193     albertel 7518: 	    }
1.513     foxr     7519: 
1.213     albertel 7520: 	    if (&Apache::loncommon::connection_aborted($r)) { last; }
1.83      albertel 7521: 	}
1.140     albertel 7522: 	$completedstudents{$uname}={'line'=>$line};
1.213     albertel 7523: 	if (&Apache::loncommon::connection_aborted($r)) { last; }
1.140     albertel 7524:     } continue {
1.330     albertel 7525: 	&Apache::lonxml::clear_problem_counter();
1.83      albertel 7526: 	&Apache::lonnet::delenv('scantron\.');
1.82      albertel 7527:     }
1.140     albertel 7528:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
1.520     www      7529:     &Apache::lonnet::remove_lock($lock);
1.172     albertel 7530: #    my $lasttime = &Time::HiRes::time()-$start;
                   7531: #    $r->print("<p>took $lasttime</p>");
1.140     albertel 7532: 
1.200     albertel 7533:     $r->print("</form>");
1.324     albertel 7534:     $r->print(&show_grading_menu_form($symb));
1.157     albertel 7535:     return '';
1.75      albertel 7536: }
1.157     albertel 7537: 
                   7538: sub scantron_upload_scantron_data {
                   7539:     my ($r)=@_;
1.257     albertel 7540:     $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));
1.157     albertel 7541:     my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',
1.181     albertel 7542: 							  'domainid',
                   7543: 							  'coursename');
1.257     albertel 7544:     my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'},
1.157     albertel 7545: 						   'domainid');
1.324     albertel 7546:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.492     albertel 7547:     $r->print('
1.157     albertel 7548: <script type="text/javascript" language="javascript">
                   7549:     function checkUpload(formname) {
                   7550: 	if (formname.upfile.value == "") {
                   7551: 	    alert("Please use the browse button to select a file from your local directory.");
                   7552: 	    return false;
                   7553: 	}
                   7554: 	formname.submit();
                   7555:     }
                   7556: </script>
                   7557: 
1.492     albertel 7558: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post">
                   7559: '.$default_form_data.'
1.181     albertel 7560: <table>
1.492     albertel 7561: <tr><td>'.$select_link.'                             </td></tr>
                   7562: <tr><td>'.&mt('Course ID:').'     </td>
                   7563:     <td><input name="courseid"   type="text" />      </td></tr>
                   7564: <tr><td>'.&mt('Course Name:').'   </td>
                   7565:     <td><input name="coursename" type="text" />      </td></tr>
                   7566: <tr><td>'.&mt('Domain:').'        </td>
                   7567:     <td>'.$domsel.'                                  </td></tr>
                   7568: <tr><td>'.&mt('File to upload:').'</td>
                   7569:     <td><input type="file" name="upfile" size="50" /></td></tr>
1.181     albertel 7570: </table>
1.492     albertel 7571: <input name="command" value="scantronupload_save" type="hidden" />
                   7572: <input type="button" onClick="javascript:checkUpload(this.form);" value="'.&mt('Upload Scantron Data').'" />
1.157     albertel 7573: </form>
1.492     albertel 7574: ');
1.157     albertel 7575:     return '';
                   7576: }
                   7577: 
1.423     albertel 7578: 
1.157     albertel 7579: sub scantron_upload_scantron_data_save {
                   7580:     my($r)=@_;
1.324     albertel 7581:     my ($symb)=&get_symb($r,1);
1.182     albertel 7582:     my $doanotherupload=
                   7583: 	'<br /><form action="/adm/grades" method="post">'."\n".
                   7584: 	'<input type="hidden" name="command" value="scantronupload" />'."\n".
1.492     albertel 7585: 	'<input type="submit" name="submit" value="'.&mt('Do Another Upload').'" />'."\n".
1.182     albertel 7586: 	'</form>'."\n";
1.257     albertel 7587:     if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) &&
1.162     albertel 7588: 	!&Apache::lonnet::allowed('usc',
1.257     albertel 7589: 			    $env{'form.domainid'}.'_'.$env{'form.courseid'})) {
1.492     albertel 7590: 	$r->print(&mt("You are not allowed to upload Scantron data to the requested course.")."<br />");
1.182     albertel 7591: 	if ($symb) {
1.324     albertel 7592: 	    $r->print(&show_grading_menu_form($symb));
1.182     albertel 7593: 	} else {
                   7594: 	    $r->print($doanotherupload);
                   7595: 	}
1.162     albertel 7596: 	return '';
                   7597:     }
1.257     albertel 7598:     my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'});
1.492     albertel 7599:     $r->print(&mt("Doing upload to [_1]",$coursedata{'description'})." <br />");
1.257     albertel 7600:     my $fname=$env{'form.upfile.filename'};
1.157     albertel 7601:     #FIXME
                   7602:     #copied from lonnet::userfileupload()
                   7603:     #make that function able to target a specified course
                   7604:     # Replace Windows backslashes by forward slashes
                   7605:     $fname=~s/\\/\//g;
                   7606:     # Get rid of everything but the actual filename
                   7607:     $fname=~s/^.*\/([^\/]+)$/$1/;
                   7608:     # Replace spaces by underscores
                   7609:     $fname=~s/\s+/\_/g;
                   7610:     # Replace all other weird characters by nothing
                   7611:     $fname=~s/[^\w\.\-]//g;
                   7612:     # See if there is anything left
                   7613:     unless ($fname) { return 'error: no uploaded file'; }
1.209     ng       7614:     my $uploadedfile=$fname;
1.157     albertel 7615:     $fname='scantron_orig_'.$fname;
1.257     albertel 7616:     if (length($env{'form.upfile'}) < 2) {
1.492     albertel 7617: 	$r->print(&mt("<span class=\"LC_error\">Error:</span> The file you attempted to upload, [_1]  contained no information. Please check that you entered the correct filename.",'<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</span>"));
1.183     albertel 7618:     } else {
1.275     albertel 7619: 	my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname);
1.210     albertel 7620: 	if ($result =~ m|^/uploaded/|) {
1.492     albertel 7621: 	    $r->print(&mt("<span class=\"LC_success\">Success:</span> Successfully uploaded [_1] bytes of data into location [_2]",
                   7622: 			  (length($env{'form.upfile'})-1),
                   7623: 			  '<span class="LC_filename">'.$result."</span>"));
1.210     albertel 7624: 	} else {
1.492     albertel 7625: 	    $r->print(&mt("<span class=\"LC_error\">Error:</span> An error ([_1]) occurred when attempting to upload the file, [_2]",
                   7626: 			  $result,
                   7627: 			  '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</span>"));
                   7628: 
1.183     albertel 7629: 	}
                   7630:     }
1.174     albertel 7631:     if ($symb) {
1.209     ng       7632: 	$r->print(&scantron_selectphase($r,$uploadedfile));
1.174     albertel 7633:     } else {
1.182     albertel 7634: 	$r->print($doanotherupload);
1.174     albertel 7635:     }
1.157     albertel 7636:     return '';
                   7637: }
                   7638: 
1.202     albertel 7639: sub valid_file {
                   7640:     my ($requested_file)=@_;
                   7641:     foreach my $filename (sort(&scantron_filenames())) {
                   7642: 	if ($requested_file eq $filename) { return 1; }
                   7643:     }
                   7644:     return 0;
                   7645: }
                   7646: 
                   7647: sub scantron_download_scantron_data {
                   7648:     my ($r)=@_;
1.324     albertel 7649:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.257     albertel 7650:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   7651:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   7652:     my $file=$env{'form.scantron_selectfile'};
1.202     albertel 7653:     if (! &valid_file($file)) {
1.492     albertel 7654: 	$r->print('
1.202     albertel 7655: 	<p>
1.492     albertel 7656: 	    '.&mt('The requested file name was invalid.').'
1.202     albertel 7657:         </p>
1.492     albertel 7658: ');
1.324     albertel 7659: 	$r->print(&show_grading_menu_form(&get_symb($r,1)));
1.202     albertel 7660: 	return;
                   7661:     }
                   7662:     my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file;
                   7663:     my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file;
                   7664:     my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file;
                   7665:     &Apache::lonnet::allowuploaded('/adm/grades',$orig);
                   7666:     &Apache::lonnet::allowuploaded('/adm/grades',$corrected);
                   7667:     &Apache::lonnet::allowuploaded('/adm/grades',$skipped);
1.492     albertel 7668:     $r->print('
1.202     albertel 7669:     <p>
1.492     albertel 7670: 	'.&mt('[_1]Original[_2] file as uploaded by the scantron office.',
                   7671: 	      '<a href="'.$orig.'">','</a>').'
1.202     albertel 7672:     </p>
                   7673:     <p>
1.492     albertel 7674: 	'.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.',
                   7675: 	      '<a href="'.$corrected.'">','</a>').'
1.202     albertel 7676:     </p>
                   7677:     <p>
1.492     albertel 7678: 	'.&mt('[_1]Skipped[_2], a file of records that were skipped.',
                   7679: 	      '<a href="'.$skipped.'">','</a>').'
1.202     albertel 7680:     </p>
1.492     albertel 7681: ');
1.324     albertel 7682:     $r->print(&show_grading_menu_form(&get_symb($r,1)));
1.202     albertel 7683:     return '';
                   7684: }
1.157     albertel 7685: 
1.523     raeburn  7686: sub checkscantron_results {
                   7687:     my ($r) = @_;
                   7688:     my ($symb)=&get_symb($r);
                   7689:     if (!$symb) {return '';}
                   7690:     my $grading_menu_button=&show_grading_menu_form($symb);
                   7691:     my $cid = $env{'request.course.id'};
                   7692:     my %lettdig = (
                   7693:                     A => 1,
                   7694:                     B => 2,
                   7695:                     C => 3,
                   7696:                     D => 4,
                   7697:                     E => 5,
                   7698:                     F => 6,
                   7699:                     G => 7,
                   7700:                     H => 8,
                   7701:                     I => 9,
                   7702:                     J => 0,
                   7703:                   );
                   7704:     my $numletts = scalar(keys(%lettdig));
                   7705:     my $cnum = $env{'course.'.$cid.'.num'};
                   7706:     my $cdom = $env{'course.'.$cid.'.domain'};
                   7707:     my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'});
                   7708:     my %record;
                   7709:     my %scantron_config =
                   7710:         &Apache::grades::get_scantron_config($env{'form.scantron_format'});
                   7711:     my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
                   7712:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7713:     my %idmap=&Apache::grades::username_to_idmap($classlist);
                   7714:     my $navmap=Apache::lonnavmaps::navmap->new();
                   7715:     my $map=$navmap->getResourceByUrl($sequence);
                   7716:     my @resources=$navmap->retrieveResources($map,undef,1,0);
                   7717:     my (%scandata,%lastname,%bylast);
                   7718:     $r->print('
                   7719: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n");
                   7720: 
                   7721:     my @delayqueue;
                   7722:     my %completedstudents;
                   7723: 
                   7724:     my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);
                   7725:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron/Submissions Comparison Status',
                   7726:                                     'Progress of Scantron Data/Submission Records Comparison',$count,
                   7727:                                     'inline',undef,'checkscantron');
                   7728:     my ($username,$domain,$uname,$started);
                   7729: 
                   7730:     &Apache::grades::scantron_get_maxbubble();  # Need the bubble lines array to parse.
                   7731: 
                   7732:     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
                   7733:                                           'Processing first student');
                   7734:     my $start=&Time::HiRes::time();
                   7735:     my $i=-1;
                   7736: 
                   7737:     while ($i<$scanlines->{'count'}) {
                   7738:         ($username,$domain,$uname)=('','','');
                   7739:         $i++;
                   7740:         my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i);
                   7741:         if ($line=~/^[\s\cz]*$/) { next; }
                   7742:         if ($started) {
                   7743:             &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   7744:                                                      'last student');
                   7745:         }
                   7746:         $started=1;
                   7747:         my $scan_record=
                   7748:             &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,
                   7749:                                                      $scan_data);
                   7750:         unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data,
                   7751:                                                               \%idmap,$i)) {
                   7752:             &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                   7753:                                 'Unable to find a student that matches',1);
                   7754:             next;
                   7755:         }
                   7756:         if (exists $completedstudents{$uname}) {
                   7757:             &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                   7758:                                 'Student '.$uname.' has multiple sheets',2);
                   7759:             next;
                   7760:         }
                   7761:         my $pid = $scan_record->{'scantron.ID'};
                   7762:         $lastname{$pid} = $scan_record->{'scantron.LastName'};
                   7763:         push(@{$bylast{$lastname{$pid}}},$pid);
                   7764:         my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
                   7765:         $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
                   7766:         chomp($scandata{$pid});
                   7767:         $scandata{$pid} =~ s/\r$//;
                   7768:         ($username,$domain)=split(/:/,$uname);
                   7769:         my $counter = -1;
                   7770:         my (%expected,%startpos);
                   7771:         foreach my $resource (@resources) {
                   7772:             next if (!$resource->is_problem());
                   7773:             my $symb = $resource->symb();
                   7774:             my $partsref = $resource->parts();
                   7775:             my @parts;
                   7776:             my @part_ids = ();
                   7777:             if (ref($partsref) eq 'ARRAY') {
                   7778:                @parts = @{$partsref};
                   7779:                foreach my $part (@parts) {
                   7780:                    my @resp_ids = $resource->responseIds($part);
                   7781:                    foreach my $resp (@resp_ids) {
                   7782:                        $counter ++;
                   7783:                        my $part_id = $part.'.'.$resp;
                   7784:                        $expected{$part_id} = 0;
                   7785:                        push(@part_ids,$part_id);
                   7786:                        if ($env{"form.scantron.sub_bubblelines.$counter"}) {
                   7787:                            my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"});
                   7788:                            foreach my $item (@sub_lines) {
                   7789:                                $expected{$part_id} += $item;
                   7790:                            }
                   7791:                        } else {
                   7792:                            $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"};
                   7793:                        }
                   7794:                        $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
                   7795:                    }
                   7796:                 }
                   7797:             }
                   7798:             if ($symb) {
                   7799:                 my %recorded;
                   7800:                 my (%returnhash) =
                   7801:                     &Apache::lonnet::restore($symb,$cid,$domain,$username);
                   7802:                 if ($returnhash{'version'}) {
                   7803:                     my %lasthash=();
                   7804:                     my $version;
                   7805:                     for ($version=1;$version<=$returnhash{'version'};$version++) {
                   7806:                         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   7807:                             $lasthash{$key}=$returnhash{$version.':'.$key};
                   7808:                         }
                   7809:                     }
                   7810:                     foreach my $key (keys(%lasthash)) {
                   7811:                         if ($key =~ /\.scantron$/) {
                   7812:                             my $value = &unescape($lasthash{$key});
                   7813:                             my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/);
                   7814:                             if ($value eq '') {
                   7815:                                 for (my $i=0; $i<$expected{$part_id}; $i++) {
                   7816:                                     for (my $j=0; $j<$scantron_config{'length'}; $j++) {
                   7817:                                         $recorded{$part_id} .= $;
                   7818:                                     }
                   7819:                                 }
                   7820:                             } else {
                   7821:                                 my @tocheck;
                   7822:                                 my @items = split(//,$value);
                   7823:                                 if (($scantron_config{'Qon'} eq 'letter') ||
                   7824:                                     ($scantron_config{'Qon'} eq 'number')) {
                   7825:                                     if (@items < $expected{$part_id}) {
                   7826:                                         my $fragment = substr($scandata{$pid},$startpos{$part_id},$expected{$part_id});
                   7827:                                         my @singles = split(//,$fragment);
                   7828:                                         foreach my $pos (@singles) {
                   7829:                                             if ($pos eq ' ') {
                   7830:                                                 push(@tocheck,$pos);
                   7831:                                             } else {
                   7832:                                                 my $next = shift(@items);
                   7833:                                                 push(@tocheck,$next);
                   7834:                                             }
                   7835:                                         }
                   7836:                                     } else {
                   7837:                                         @tocheck = @items;
                   7838:                                     }
                   7839:                                     foreach my $letter (@tocheck) {
                   7840:                                         if ($scantron_config{'Qon'} eq 'letter') {
                   7841:                                             if ($letter !~ /^[A-J]$/) {
                   7842:                                                 $letter = $scantron_config{'Qoff'};
                   7843:                                             }
                   7844:                                             $recorded{$part_id} .= $letter;
                   7845:                                         } elsif ($scantron_config{'Qon'} eq 'number') {
                   7846:                                             my $digit;
                   7847:                                             if ($letter !~ /^[A-J]$/) {
                   7848:                                                 $digit = $scantron_config{'Qoff'};
                   7849:                                             } else {
                   7850:                                                 $digit = $lettdig{$letter};
                   7851:                                             }
                   7852:                                             $recorded{$part_id} .= $digit;
                   7853:                                         }
                   7854:                                     }
                   7855:                                 } else {
                   7856:                                     @tocheck = @items;
                   7857:                                     for (my $i=0; $i<$expected{$part_id}; $i++) {
                   7858:                                         my $curr_sub = shift(@tocheck);
                   7859:                                         my $digit;
                   7860:                                         if ($curr_sub =~ /^[A-J]$/) {
                   7861:                                             $digit = $lettdig{$curr_sub}-1;
                   7862:                                         }
                   7863:                                         if ($curr_sub eq 'J') {
                   7864:                                             $digit += scalar($numletts);
                   7865:                                         }
                   7866:                                         for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
                   7867:                                             if ($j == $digit) {
                   7868:                                                 $recorded{$part_id} .= $scantron_config{'Qon'};
                   7869:                                             } else {
                   7870:                                                 $recorded{$part_id} .= $scantron_config{'Qoff'};
                   7871:                                             }
                   7872:                                         }
                   7873:                                     }
                   7874:                                 }
                   7875:                             }
                   7876:                         }
                   7877:                     }
                   7878:                 }
                   7879:                 foreach my $part_id (@part_ids) {
                   7880:                     if ($recorded{$part_id} eq '') {
                   7881:                         for (my $i=0; $i<$expected{$part_id}; $i++) {
                   7882:                             for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
                   7883:                                 $recorded{$part_id} .= $scantron_config{'Qoff'};
                   7884:                             }
                   7885:                         }
                   7886:                     }
                   7887:                     $record{$pid} .= $recorded{$part_id};
                   7888:                 }
                   7889:             }
                   7890:         }
                   7891:     }
                   7892:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
                   7893:     $r->print('<br />');
                   7894:     my ($okstudents,$badstudents,$numstudents,$passed,$failed);
                   7895:     $passed = 0;
                   7896:     $failed = 0;
                   7897:     $numstudents = 0;
                   7898:     foreach my $last (sort(keys(%bylast))) {
                   7899:         if (ref($bylast{$last}) eq 'ARRAY') {
                   7900:             foreach my $pid (sort(@{$bylast{$last}})) {
                   7901:                 my $showscandata = $scandata{$pid};
                   7902:                 my $showrecord = $record{$pid};
                   7903:                 $showscandata =~ s/\s/&nbsp;/g;
                   7904:                 $showrecord =~ s/\s/&nbsp;/g;
                   7905:                 if ($scandata{$pid} eq $record{$pid}) {
                   7906:                     my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row';
                   7907:                     $okstudents .= '<tr class="'.$css_class.'">'.
                   7908: '<td>'.&mt('Scantron').'</td><td>'.$showscandata.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
                   7909: '</tr>'."\n".
                   7910: '<tr class="'.$css_class.'">'."\n".
                   7911: '<td>Submissions</td><td>'.$showrecord.'</td></tr>'."\n";
                   7912:                     $passed ++;
                   7913:                 } else {
                   7914:                     my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row';
                   7915:                     $badstudents .= '<tr class="'.$css_class.'"><td>'.&mt('Scantron').'</td><td><span class="LC_nobreak">'.$scandata{$pid}.'</span></td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
                   7916: '</tr>'."\n".
                   7917: '<tr class="'.$css_class.'">'."\n".
                   7918: '<td>Submissions</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n".
                   7919: '</tr>'."\n";
                   7920:                     $failed ++;
                   7921:                 }
                   7922:                 $numstudents ++;
                   7923:             }
                   7924:         }
                   7925:     }
                   7926:     $r->print('<p>'.&mt('Comparison of scantron data (including corrections) with corresponding submission records (most recent submission) for <b>[quant,_1,student]</b>  ([_2] scantron lines/student).',$numstudents,$env{'form.scantron_maxbubble'}).'</p>');
                   7927:     $r->print('<p>'.&mt('Exact matches for <b>[quant,_1,student]</b>.',$passed).'<br />'.&mt('Discrepancies detected for <b>[quant,_1,student]</b>.',$failed).'</p>');
                   7928:     if ($passed) {
                   7929:         $r->print(&mt('Students with exact correspondence between scantron data and submissions are as follows:').'<br /><br />');
                   7930:         $r->print(&Apache::loncommon::start_data_table()."\n".
                   7931:                  &Apache::loncommon::start_data_table_header_row()."\n".
                   7932:                  '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
                   7933:                  &Apache::loncommon::end_data_table_header_row()."\n".
                   7934:                  $okstudents."\n".
                   7935:                  &Apache::loncommon::end_data_table().'<br />');
                   7936:     }
                   7937:     if ($failed) {
                   7938:         $r->print(&mt('Students with differences between scantron data and submissions are as follows:').'<br /><br />');
                   7939:         $r->print(&Apache::loncommon::start_data_table()."\n".
                   7940:                  &Apache::loncommon::start_data_table_header_row()."\n".
                   7941:                  '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
                   7942:                  &Apache::loncommon::end_data_table_header_row()."\n".
                   7943:                  $badstudents."\n".
                   7944:                  &Apache::loncommon::end_data_table()).'<br />'.
                   7945:                  &mt('Differences can occur if submissions were modified using manual grading after a scantron grading pass.').'<br />'.&mt('If unexpected discrepancies were detected, it is recommended that you inspect the original scantron sheets.');  
                   7946:     }
                   7947:     $r->print('</form><br />'.$grading_menu_button);
                   7948:     return;
                   7949: }
                   7950: 
1.423     albertel 7951: 
1.75      albertel 7952: #-------- end of section for handling grading scantron forms -------
                   7953: #
                   7954: #-------------------------------------------------------------------
                   7955: 
1.72      ng       7956: #-------------------------- Menu interface -------------------------
                   7957: #
                   7958: #--- Show a Grading Menu button - Calls the next routine ---
                   7959: sub show_grading_menu_form {
1.324     albertel 7960:     my ($symb)=@_;
1.125     ng       7961:     my $result.='<br /><form action="/adm/grades" method="post">'."\n".
1.418     albertel 7962: 	'<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 7963: 	'<input type="hidden" name="saveState"  value="'.$env{'form.saveState'}.'" />'."\n".
1.72      ng       7964: 	'<input type="hidden" name="command" value="gradingmenu" />'."\n".
1.478     albertel 7965: 	'<input type="submit" name="submit" value="'.&mt('Grading Menu').'" />'."\n".
1.72      ng       7966: 	'</form>'."\n";
                   7967:     return $result;
                   7968: }
                   7969: 
1.77      ng       7970: # -- Retrieve choices for grading form
                   7971: sub savedState {
                   7972:     my %savedState = ();
1.257     albertel 7973:     if ($env{'form.saveState'}) {
                   7974: 	foreach (split(/:/,$env{'form.saveState'})) {
1.77      ng       7975: 	    my ($key,$value) = split(/=/,$_,2);
                   7976: 	    $savedState{$key} = $value;
                   7977: 	}
                   7978:     }
                   7979:     return \%savedState;
                   7980: }
1.76      ng       7981: 
1.443     banghart 7982: sub grading_menu {
                   7983:     my ($request) = @_;
                   7984:     my ($symb)=&get_symb($request);
                   7985:     if (!$symb) {return '';}
                   7986:     my $probTitle = &Apache::lonnet::gettitle($symb);
                   7987:     my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
                   7988: 
1.444     banghart 7989:     $request->print($table);
1.443     banghart 7990:     my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb),
                   7991:                   'handgrade'=>$hdgrade,
                   7992:                   'probTitle'=>$probTitle,
                   7993:                   'command'=>'submit_options',
                   7994:                   'saveState'=>"",
                   7995:                   'gradingMenu'=>1,
                   7996:                   'showgrading'=>"yes");
                   7997:     my $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   7998:     my @menu = ({ url => $url,
                   7999:                      name => &mt('Manual Grading/View Submissions'),
                   8000:                      short_description => 
                   8001:     &mt('Start the process of hand grading submissions.'),
                   8002:                  });
                   8003:     $fields{'command'} = 'csvform';
                   8004:     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
1.524     raeburn  8005:     push(@menu, { url => $url,
1.443     banghart 8006:                    name => &mt('Upload Scores'),
                   8007:                    short_description => 
                   8008:             &mt('Specify a file containing the class scores for current resource.')});
                   8009:     $fields{'command'} = 'processclicker';
                   8010:     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
1.524     raeburn  8011:     push(@menu, { url => $url,
1.443     banghart 8012:                    name => &mt('Process Clicker'),
                   8013:                    short_description => 
                   8014:             &mt('Specify a file containing the clicker information for this resource.')});
                   8015:     $fields{'command'} = 'scantron_selectphase';
                   8016:     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
1.524     raeburn  8017:     push(@menu, { url => $url,
1.523     raeburn  8018:                    name => &mt('Grade/Manage/Review Scantron Forms'),
1.454     banghart 8019:                    short_description => 
1.523     raeburn  8020:             &mt('Grade scantron exams, upload/download scantron data files, and review previously graded scantron exams.')});
1.443     banghart 8021:     $fields{'command'} = 'verify';
                   8022:     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
1.524     raeburn  8023:     push(@menu, { url => "",
1.443     banghart 8024:                    name => &mt('Verify Receipt'),
                   8025:                    short_description => 
                   8026:             &mt('')});
                   8027:     #
                   8028:     # Create the menu
                   8029:     my $Str;
1.444     banghart 8030:     # $Str .= '<h2>'.&mt('Please select a grading task').'</h2>';
1.445     banghart 8031:     $Str .= '<form method="post" action="" name="gradingMenu">';
                   8032:     $Str .= '<input type="hidden" name="command" value="" />'.
                   8033:     	'<input type="hidden" name="symb"        value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
                   8034: 	'<input type="hidden" name="handgrade"   value="'.$hdgrade.'" />'."\n".
1.476     albertel 8035: 	'<input type="hidden" name="probTitle"   value="'.$probTitle.'" />'."\n".
1.445     banghart 8036: 	'<input type="hidden" name="saveState"   value="" />'."\n".
                   8037: 	'<input type="hidden" name="gradingMenu" value="1" />'."\n".
                   8038: 	'<input type="hidden" name="showgrading" value="yes" />'."\n";
                   8039: 
1.443     banghart 8040:     foreach my $menudata (@menu) {
1.445     banghart 8041:         if ($menudata->{'name'} ne &mt('Verify Receipt')) {
                   8042:             $Str .='    <h3><a '.
                   8043:                 $menudata->{'jscript'}.
                   8044:                 ' href="'.
                   8045:                 $menudata->{'url'}.'" >'.
                   8046:                 $menudata->{'name'}."</a></h3>\n";
                   8047:         } else {
1.511     www      8048:             $Str .='<hr /><input type="button" value="'.&mt('Verify Receipt').'" '.
1.445     banghart 8049:                 $menudata->{'jscript'}.
1.458     banghart 8050:                 ' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '.
1.511     www      8051:                 ' /> '.
                   8052: 		&Apache::lonnet::recprefix($env{'request.course.id'}).
                   8053:                     '-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')" />';
1.444     banghart 8054:         }
1.443     banghart 8055:         $Str .= '    '.('&nbsp;'x8).$menudata->{'short_description'}.
                   8056:             "\n";
                   8057:     }
1.444     banghart 8058:     $Str .="</form>\n";
1.443     banghart 8059:     $request->print(<<GRADINGMENUJS);
                   8060: <script type="text/javascript" language="javascript">
                   8061:     function checkChoice(formname,val,cmdx) {
                   8062: 	if (val <= 2) {
                   8063: 	    var cmd = radioSelection(formname.radioChoice);
                   8064: 	    var cmdsave = cmd;
                   8065: 	} else {
                   8066: 	    cmd = cmdx;
                   8067: 	    cmdsave = 'submission';
                   8068: 	}
                   8069: 	formname.command.value = cmd;
                   8070: 	if (val < 5) formname.submit();
                   8071: 	if (val == 5) {
1.458     banghart 8072: 	    if (!checkReceiptNo(formname,'notOK')) { 
                   8073: 	        return false;
                   8074: 	    } else {
                   8075: 	        formname.submit();
                   8076: 	    }
1.445     banghart 8077: 	}
                   8078:     }
1.443     banghart 8079: 
                   8080:     function checkReceiptNo(formname,nospace) {
                   8081: 	var receiptNo = formname.receipt.value;
                   8082: 	var checkOpt = false;
                   8083: 	if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;}
                   8084: 	if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;}
                   8085: 	if (checkOpt) {
                   8086: 	    alert("Please enter a receipt number given by a student in the receipt box.");
                   8087: 	    formname.receipt.value = "";
                   8088: 	    formname.receipt.focus();
                   8089: 	    return false;
                   8090: 	}
                   8091: 	return true;
                   8092:     }
                   8093: </script>
                   8094: GRADINGMENUJS
                   8095:     &commonJSfunctions($request);
                   8096:     return $Str;    
                   8097: }
                   8098: 
                   8099: 
                   8100: #--- Displays the submissions first page -------
                   8101: sub submit_options {
1.72      ng       8102:     my ($request) = @_;
1.324     albertel 8103:     my ($symb)=&get_symb($request);
1.72      ng       8104:     if (!$symb) {return '';}
1.76      ng       8105:     my $probTitle = &Apache::lonnet::gettitle($symb);
1.72      ng       8106: 
                   8107:     $request->print(<<GRADINGMENUJS);
                   8108: <script type="text/javascript" language="javascript">
1.116     ng       8109:     function checkChoice(formname,val,cmdx) {
                   8110: 	if (val <= 2) {
                   8111: 	    var cmd = radioSelection(formname.radioChoice);
1.118     ng       8112: 	    var cmdsave = cmd;
1.116     ng       8113: 	} else {
                   8114: 	    cmd = cmdx;
1.118     ng       8115: 	    cmdsave = 'submission';
1.116     ng       8116: 	}
                   8117: 	formname.command.value = cmd;
1.118     ng       8118: 	formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+
1.145     albertel 8119: 	    ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);
1.116     ng       8120: 	if (val < 5) formname.submit();
                   8121: 	if (val == 5) {
1.72      ng       8122: 	    if (!checkReceiptNo(formname,'notOK')) { return false;}
                   8123: 	    formname.submit();
                   8124: 	}
1.238     albertel 8125: 	if (val < 7) formname.submit();
1.72      ng       8126:     }
                   8127: 
                   8128:     function checkReceiptNo(formname,nospace) {
                   8129: 	var receiptNo = formname.receipt.value;
                   8130: 	var checkOpt = false;
                   8131: 	if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;}
                   8132: 	if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;}
                   8133: 	if (checkOpt) {
                   8134: 	    alert("Please enter a receipt number given by a student in the receipt box.");
                   8135: 	    formname.receipt.value = "";
                   8136: 	    formname.receipt.focus();
                   8137: 	    return false;
                   8138: 	}
                   8139: 	return true;
                   8140:     }
                   8141: </script>
                   8142: GRADINGMENUJS
1.118     ng       8143:     &commonJSfunctions($request);
1.324     albertel 8144:     my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
1.473     albertel 8145:     my $result;
1.76      ng       8146:     my (undef,$sections) = &getclasslist('all','0');
1.77      ng       8147:     my $savedState = &savedState();
1.118     ng       8148:     my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'});
1.77      ng       8149:     my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'});
1.118     ng       8150:     my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'});
1.77      ng       8151:     my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
1.72      ng       8152: 
1.533   ! bisitz   8153:     # Preselect sections
        !          8154:     my $selsec="";
        !          8155:     if (ref($sections)) {
        !          8156:         foreach my $section (sort(@$sections)) {
        !          8157:             $selsec.='<option value="'.$section.'" '.
        !          8158:                 ($saveSec eq $section ? 'selected="selected"':'').'>'.$section.'</option>'."\n";
        !          8159:         }
        !          8160:     }
        !          8161: 
1.72      ng       8162:     $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n".
1.418     albertel 8163: 	'<input type="hidden" name="symb"        value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.72      ng       8164: 	'<input type="hidden" name="handgrade"   value="'.$hdgrade.'" />'."\n".
                   8165: 	'<input type="hidden" name="probTitle"   value="'.$probTitle.'" />'."\n".
1.116     ng       8166: 	'<input type="hidden" name="command"     value="" />'."\n".
1.77      ng       8167: 	'<input type="hidden" name="saveState"   value="" />'."\n".
1.124     ng       8168: 	'<input type="hidden" name="gradingMenu" value="1" />'."\n".
1.72      ng       8169: 	'<input type="hidden" name="showgrading" value="yes" />'."\n";
                   8170: 
1.472     albertel 8171:     $result.='
1.533   ! bisitz   8172: <h2>
        !          8173:   '.&mt('Grade Current Resource').'
        !          8174: </h2>
        !          8175: <div>
        !          8176:   '.$table.'
        !          8177: </div>
        !          8178: 
        !          8179: <div class="columnSection">
        !          8180:   <div>
        !          8181:     <fieldset>
        !          8182:       <legend>
        !          8183:        '.&mt('Sections').'
        !          8184:       </legend>
        !          8185:       <select name="section" multiple="multiple" size="5">'."\n";
        !          8186:     $result.= $selsec;
1.401     albertel 8187:     $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="selected"' : ''). '>all</option></select> &nbsp; ';
1.472     albertel 8188:     $result.='
1.533   ! bisitz   8189:     </fieldset>
        !          8190:   </div>
        !          8191: 
        !          8192:   <div>
        !          8193:     <fieldset>
        !          8194:       <legend>
        !          8195:         '.&mt('Groups').'
        !          8196:       </legend>
        !          8197:       '.&Apache::lonstatistics::GroupSelect('group','multiple',5).'
        !          8198:     </fieldset>
        !          8199:   </div>
        !          8200: 
        !          8201:   <div>
        !          8202:     <fieldset>
        !          8203:       <legend>
        !          8204:         '.&mt('Access Status').'
        !          8205:       </legend>
        !          8206:       '.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,5,undef,'mult').'
        !          8207:     </fieldset>
        !          8208:   </div>
        !          8209: 
        !          8210:   <div>
        !          8211:     <fieldset>
        !          8212:       <legend>
        !          8213:         '.&mt('Submission Status').'
        !          8214:       </legend>
        !          8215:       <select name="submitonly" size="5">
1.473     albertel 8216: 	         <option value="yes" '.      ($saveSub eq 'yes'       ? 'selected="selected"' : '').'>'.&mt('with submissions').'</option>
                   8217: 	         <option value="queued" '.   ($saveSub eq 'queued'    ? 'selected="selected"' : '').'>'.&mt('in grading queue').'</option>
                   8218: 	         <option value="graded" '.   ($saveSub eq 'graded'    ? 'selected="selected"' : '').'>'.&mt('with ungraded submissions').'</option>
                   8219: 	         <option value="incorrect" '.($saveSub eq 'incorrect' ? 'selected="selected"' : '').'>'.&mt('with incorrect submissions').'</option>
                   8220:                  <option value="all" '.      ($saveSub eq 'all'       ? 'selected="selected"' : '').'>'.&mt('with any status').'</option>
1.533   ! bisitz   8221:       </select>
        !          8222:     </fieldset>
        !          8223:   </div>
        !          8224: </div>
        !          8225: 
        !          8226: <br />
        !          8227:           <div>
        !          8228:             <div>
1.473     albertel 8229:               <label>
                   8230:                 <input type="radio" name="radioChoice" value="submission" '.
                   8231:                   ($saveCmd eq 'submission' ? 'checked="checked"' : '').' /> '.
                   8232:              &mt('Select individual students to grade and view submissions.').'
                   8233: 	      </label> 
                   8234:             </div>
1.533   ! bisitz   8235:             <div>
1.473     albertel 8236: 	      <label>
                   8237:                 <input type="radio" name="radioChoice" value="viewgrades" '.
                   8238:                   ($saveCmd eq 'viewgrades' ? 'checked="checked"' : '').' /> '.
                   8239:                     &mt('Grade all selected students in a grading table.').'
                   8240:               </label>
                   8241:             </div>
1.533   ! bisitz   8242:             <div>
1.473     albertel 8243: 	      <input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next-&gt;').'" />
                   8244:             </div>
1.472     albertel 8245:           </div>
1.533   ! bisitz   8246: 
        !          8247: 
1.473     albertel 8248:         <h2>
                   8249:          '.&mt('Grade Complete Folder for One Student').'
                   8250:         </h2>
1.533   ! bisitz   8251:         <div>
        !          8252:             <div>
1.473     albertel 8253:               <label>
                   8254:                 <input type="radio" name="radioChoice" value="pickStudentPage" '.
                   8255: 	  ($saveCmd eq 'pickStudentPage' ? 'checked="checked"' : '').' /> '.
                   8256:   &mt('The <b>complete</b> page/sequence/folder: For one student').'
                   8257:               </label>
                   8258:             </div>
1.533   ! bisitz   8259:             <div>
1.473     albertel 8260: 	      <input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next-&gt;').'" />
                   8261:             </div>
1.472     albertel 8262:         </div>
                   8263:   </form>';
1.499     albertel 8264:     $result .= &show_grading_menu_form($symb);
1.44      ng       8265:     return $result;
1.2       albertel 8266: }
                   8267: 
1.285     albertel 8268: sub reset_perm {
                   8269:     undef(%perm);
                   8270: }
                   8271: 
                   8272: sub init_perm {
                   8273:     &reset_perm();
1.300     albertel 8274:     foreach my $test_perm ('vgr','mgr','opa') {
                   8275: 
                   8276: 	my $scope = $env{'request.course.id'};
                   8277: 	if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) {
                   8278: 
                   8279: 	    $scope .= '/'.$env{'request.course.sec'};
                   8280: 	    if ( $perm{$test_perm}=
                   8281: 		 &Apache::lonnet::allowed($test_perm,$scope)) {
                   8282: 		$perm{$test_perm.'_section'}=$env{'request.course.sec'};
                   8283: 	    } else {
                   8284: 		delete($perm{$test_perm});
                   8285: 	    }
1.285     albertel 8286: 	}
                   8287:     }
                   8288: }
                   8289: 
1.400     www      8290: sub gather_clicker_ids {
1.408     albertel 8291:     my %clicker_ids;
1.400     www      8292: 
                   8293:     my $classlist = &Apache::loncoursedata::get_classlist();
                   8294: 
                   8295:     # Set up a couple variables.
1.407     albertel 8296:     my $username_idx = &Apache::loncoursedata::CL_SNAME();
                   8297:     my $domain_idx   = &Apache::loncoursedata::CL_SDOM();
1.438     www      8298:     my $status_idx   = &Apache::loncoursedata::CL_STATUS();
1.400     www      8299: 
1.407     albertel 8300:     foreach my $student (keys(%$classlist)) {
1.438     www      8301:         if ($classlist->{$student}->[$status_idx] ne 'Active') { next; }
1.407     albertel 8302:         my $username = $classlist->{$student}->[$username_idx];
                   8303:         my $domain   = $classlist->{$student}->[$domain_idx];
1.400     www      8304:         my $clickers =
1.408     albertel 8305: 	    (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1];
1.400     www      8306:         foreach my $id (split(/\,/,$clickers)) {
1.414     www      8307:             $id=~s/^[\#0]+//;
1.421     www      8308:             $id=~s/[\-\:]//g;
1.407     albertel 8309:             if (exists($clicker_ids{$id})) {
1.408     albertel 8310: 		$clicker_ids{$id}.=','.$username.':'.$domain;
1.400     www      8311:             } else {
1.408     albertel 8312: 		$clicker_ids{$id}=$username.':'.$domain;
1.400     www      8313:             }
                   8314:         }
                   8315:     }
1.407     albertel 8316:     return %clicker_ids;
1.400     www      8317: }
                   8318: 
1.402     www      8319: sub gather_adv_clicker_ids {
1.408     albertel 8320:     my %clicker_ids;
1.402     www      8321:     my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
                   8322:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   8323:     my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum);
1.409     albertel 8324:     foreach my $element (sort(keys(%coursepersonnel))) {
1.402     www      8325:         foreach my $person (split(/\,/,$coursepersonnel{$element})) {
                   8326:             my ($puname,$pudom)=split(/\:/,$person);
                   8327:             my $clickers =
1.408     albertel 8328: 		(&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
1.405     www      8329:             foreach my $id (split(/\,/,$clickers)) {
1.414     www      8330: 		$id=~s/^[\#0]+//;
1.421     www      8331:                 $id=~s/[\-\:]//g;
1.408     albertel 8332: 		if (exists($clicker_ids{$id})) {
                   8333: 		    $clicker_ids{$id}.=','.$puname.':'.$pudom;
                   8334: 		} else {
                   8335: 		    $clicker_ids{$id}=$puname.':'.$pudom;
                   8336: 		}
1.405     www      8337:             }
1.402     www      8338:         }
                   8339:     }
1.407     albertel 8340:     return %clicker_ids;
1.402     www      8341: }
                   8342: 
1.413     www      8343: sub clicker_grading_parameters {
                   8344:     return ('gradingmechanism' => 'scalar',
                   8345:             'upfiletype' => 'scalar',
                   8346:             'specificid' => 'scalar',
                   8347:             'pcorrect' => 'scalar',
                   8348:             'pincorrect' => 'scalar');
                   8349: }
                   8350: 
1.400     www      8351: sub process_clicker {
                   8352:     my ($r)=@_;
                   8353:     my ($symb)=&get_symb($r);
                   8354:     if (!$symb) {return '';}
                   8355:     my $result=&checkforfile_js();
                   8356:     $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
                   8357:     my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
                   8358:     $result.=$table;
                   8359:     $result.='<br /><table width="100%" border="0"><tr><td bgcolor="#777777">'."\n";
                   8360:     $result.='<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>'."\n";
                   8361:     $result.='&nbsp;<b>'.&mt('Specify a file containing the clicker information for this resource').
                   8362:         '.</b></td></tr>'."\n";
                   8363:     $result.='<tr bgcolor=#ffffe6><td>'."\n";
1.413     www      8364: # Attempt to restore parameters from last session, set defaults if not present
                   8365:     my %Saveable_Parameters=&clicker_grading_parameters();
                   8366:     &Apache::loncommon::restore_course_settings('grades_clicker',
                   8367:                                                  \%Saveable_Parameters);
                   8368:     if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; }
                   8369:     if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; }
                   8370:     if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; }
                   8371:     if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
                   8372: 
                   8373:     my %checked;
1.521     www      8374:     foreach my $gradingmechanism ('attendance','personnel','specific','given') {
1.413     www      8375:        if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
                   8376:           $checked{$gradingmechanism}="checked='checked'";
                   8377:        }
                   8378:     }
                   8379: 
1.400     www      8380:     my $upload=&mt("Upload File");
                   8381:     my $type=&mt("Type");
1.402     www      8382:     my $attendance=&mt("Award points just for participation");
                   8383:     my $personnel=&mt("Correctness determined from response by course personnel");
1.414     www      8384:     my $specific=&mt("Correctness determined from response with clicker ID(s)"); 
1.521     www      8385:     my $given=&mt("Correctness determined from given list of answers").' '.
                   8386:               '<font size="-2"><tt>('.&mt("Provide comma-separated list. Use '*' for any answer correct, '-' for skip").')</tt></font>';
1.402     www      8387:     my $pcorrect=&mt("Percentage points for correct solution");
                   8388:     my $pincorrect=&mt("Percentage points for incorrect solution");
1.413     www      8389:     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
1.419     www      8390: 						   ('iclicker' => 'i>clicker',
                   8391:                                                     'interwrite' => 'interwrite PRS'));
1.418     albertel 8392:     $symb = &Apache::lonenc::check_encrypt($symb);
1.400     www      8393:     $result.=<<ENDUPFORM;
1.402     www      8394: <script type="text/javascript">
                   8395: function sanitycheck() {
                   8396: // Accept only integer percentages
                   8397:    document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value);
                   8398:    document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value);
                   8399: // Find out grading choice
                   8400:    for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) {
                   8401:       if (document.forms.gradesupload.gradingmechanism[i].checked) {
                   8402:          gradingchoice=document.forms.gradesupload.gradingmechanism[i].value;
                   8403:       }
                   8404:    }
                   8405: // By default, new choice equals user selection
                   8406:    newgradingchoice=gradingchoice;
                   8407: // Not good to give more points for false answers than correct ones
                   8408:    if (Math.round(document.forms.gradesupload.pcorrect.value)<Math.round(document.forms.gradesupload.pincorrect.value)) {
                   8409:       document.forms.gradesupload.pcorrect.value=document.forms.gradesupload.pincorrect.value;
                   8410:    }
                   8411: // If new choice is attendance only, and old choice was correctness-based, restore defaults
                   8412:    if ((gradingchoice=='attendance') && (document.forms.gradesupload.waschecked.value!='attendance')) {
                   8413:       document.forms.gradesupload.pcorrect.value=100;
                   8414:       document.forms.gradesupload.pincorrect.value=100;
                   8415:    }
                   8416: // If the values are different, cannot be attendance only
                   8417:    if ((Math.round(document.forms.gradesupload.pcorrect.value)!=Math.round(document.forms.gradesupload.pincorrect.value)) &&
                   8418:        (gradingchoice=='attendance')) {
                   8419:        newgradingchoice='personnel';
                   8420:    }
                   8421: // Change grading choice to new one
                   8422:    for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) {
                   8423:       if (document.forms.gradesupload.gradingmechanism[i].value==newgradingchoice) {
                   8424:          document.forms.gradesupload.gradingmechanism[i].checked=true;
                   8425:       } else {
                   8426:          document.forms.gradesupload.gradingmechanism[i].checked=false;
                   8427:       }
                   8428:    }
                   8429: // Remember the old state
                   8430:    document.forms.gradesupload.waschecked.value=newgradingchoice;
                   8431: }
                   8432: </script>
1.400     www      8433: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
                   8434: <input type="hidden" name="symb" value="$symb" />
                   8435: <input type="hidden" name="command" value="processclickerfile" />
                   8436: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   8437: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
                   8438: <input type="file" name="upfile" size="50" />
                   8439: <br /><label>$type: $selectform</label>
1.451     albertel 8440: <br /><label><input type="radio" name="gradingmechanism" value="attendance" $checked{'attendance'} onClick="sanitycheck()" />$attendance </label>
                   8441: <br /><label><input type="radio" name="gradingmechanism" value="personnel" $checked{'personnel'} onClick="sanitycheck()" />$personnel</label>
                   8442: <br /><label><input type="radio" name="gradingmechanism" value="specific" $checked{'specific'} onClick="sanitycheck()" />$specific </label>
1.414     www      8443: <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" />
1.521     www      8444: <br /><label><input type="radio" name="gradingmechanism" value="given" $checked{'given'} onClick="sanitycheck()" />$given </label>
                   8445: <br />&nbsp;&nbsp;&nbsp;
                   8446: <input type="text" name="givenanswer" size="50" />
1.413     www      8447: <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" />
                   8448: <br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onChange="sanitycheck()" /></label>
                   8449: <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onChange="sanitycheck()" /></label>
1.400     www      8450: <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="$upload" />
                   8451: </form>
                   8452: ENDUPFORM
                   8453:     $result.='</td></tr></table>'."\n".
                   8454:              '</td></tr></table><br /><br />'."\n";
                   8455:     $result.=&show_grading_menu_form($symb);
                   8456:     return $result;
                   8457: }
                   8458: 
                   8459: sub process_clicker_file {
                   8460:     my ($r)=@_;
                   8461:     my ($symb)=&get_symb($r);
                   8462:     if (!$symb) {return '';}
1.413     www      8463: 
                   8464:     my %Saveable_Parameters=&clicker_grading_parameters();
                   8465:     &Apache::loncommon::store_course_settings('grades_clicker',
                   8466:                                               \%Saveable_Parameters);
                   8467: 
1.400     www      8468:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.404     www      8469:     if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) {
1.408     albertel 8470: 	$result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';
                   8471: 	return $result.&show_grading_menu_form($symb);
1.404     www      8472:     }
1.522     www      8473:     if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\S/)) {
1.521     www      8474:         $result.='<span class="LC_error">'.&mt('You need to specify the correct answer').'</span>';
                   8475:         return $result.&show_grading_menu_form($symb);
                   8476:     }
1.522     www      8477:     my $foundgiven=0;
1.521     www      8478:     if ($env{'form.gradingmechanism'} eq 'given') {
                   8479:         $env{'form.givenanswer'}=~s/^\s*//gs;
                   8480:         $env{'form.givenanswer'}=~s/\s*$//gs;
                   8481:         $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-]+/\,/g;
                   8482:         $env{'form.givenanswer'}=uc($env{'form.givenanswer'});
1.522     www      8483:         my @answers=split(/\,/,$env{'form.givenanswer'});
                   8484:         $foundgiven=$#answers+1;
1.521     www      8485:     }
1.407     albertel 8486:     my %clicker_ids=&gather_clicker_ids();
1.408     albertel 8487:     my %correct_ids;
1.404     www      8488:     if ($env{'form.gradingmechanism'} eq 'personnel') {
1.408     albertel 8489: 	%correct_ids=&gather_adv_clicker_ids();
1.404     www      8490:     }
                   8491:     if ($env{'form.gradingmechanism'} eq 'specific') {
1.414     www      8492: 	foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {;
                   8493: 	   $correct_id=~tr/a-z/A-Z/;
                   8494: 	   $correct_id=~s/\s//gs;
                   8495: 	   $correct_id=~s/^[\#0]+//;
1.421     www      8496:            $correct_id=~s/[\-\:]//g;
1.414     www      8497:            if ($correct_id) {
                   8498: 	      $correct_ids{$correct_id}='specified';
                   8499:            }
                   8500:         }
1.400     www      8501:     }
1.404     www      8502:     if ($env{'form.gradingmechanism'} eq 'attendance') {
1.408     albertel 8503: 	$result.=&mt('Score based on attendance only');
1.521     www      8504:     } elsif ($env{'form.gradingmechanism'} eq 'given') {
1.522     www      8505:         $result.=&mt('Score based on [_1] ([_2] answers)','<tt>'.$env{'form.givenanswer'}.'</tt>',$foundgiven);
1.404     www      8506:     } else {
1.408     albertel 8507: 	my $number=0;
1.411     www      8508: 	$result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>';
1.408     albertel 8509: 	foreach my $id (sort(keys(%correct_ids))) {
1.411     www      8510: 	    $result.='<br /><tt>'.$id.'</tt> - ';
1.408     albertel 8511: 	    if ($correct_ids{$id} eq 'specified') {
                   8512: 		$result.=&mt('specified');
                   8513: 	    } else {
                   8514: 		my ($uname,$udom)=split(/\:/,$correct_ids{$id});
                   8515: 		$result.=&Apache::loncommon::plainname($uname,$udom);
                   8516: 	    }
                   8517: 	    $number++;
                   8518: 	}
1.411     www      8519:         $result.="</p>\n";
1.408     albertel 8520: 	if ($number==0) {
                   8521: 	    $result.='<span class="LC_error">'.&mt('No IDs found to determine correct answer').'</span>';
                   8522: 	    return $result.&show_grading_menu_form($symb);
                   8523: 	}
1.404     www      8524:     }
1.405     www      8525:     if (length($env{'form.upfile'}) < 2) {
1.407     albertel 8526:         $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.',
                   8527: 		     '<span class="LC_error">',
                   8528: 		     '</span>',
                   8529: 		     '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>');
1.405     www      8530:         return $result.&show_grading_menu_form($symb);
                   8531:     }
1.410     www      8532: 
                   8533: # Were able to get all the info needed, now analyze the file
                   8534: 
1.411     www      8535:     $result.=&Apache::loncommon::studentbrowser_javascript();
1.418     albertel 8536:     $symb = &Apache::lonenc::check_encrypt($symb);
1.410     www      8537:     my $heading=&mt('Scanning clicker file');
                   8538:     $result.=(<<ENDHEADER);
                   8539: <br /><table width="100%" border="0"><tr><td bgcolor="#777777">
                   8540: <table width="100%" border="0"><tr bgcolor="#e6ffff"><td>
                   8541: <b>$heading</b></td></tr><tr bgcolor=#ffffe6><td>
                   8542: <form method="post" action="/adm/grades" name="clickeranalysis">
                   8543: <input type="hidden" name="symb" value="$symb" />
                   8544: <input type="hidden" name="command" value="assignclickergrades" />
                   8545: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   8546: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
1.411     www      8547: <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" />
                   8548: <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" />
                   8549: <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" />
1.410     www      8550: ENDHEADER
1.522     www      8551:     if ($env{'form.gradingmechanism'} eq 'given') {
                   8552:        $result.='<input type="hidden" name="correct:given" value="'.$env{'form.givenanswer'}.'" />';
                   8553:     } 
1.408     albertel 8554:     my %responses;
                   8555:     my @questiontitles;
1.405     www      8556:     my $errormsg='';
                   8557:     my $number=0;
                   8558:     if ($env{'form.upfiletype'} eq 'iclicker') {
1.408     albertel 8559: 	($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
1.406     www      8560:     }
1.419     www      8561:     if ($env{'form.upfiletype'} eq 'interwrite') {
                   8562:         ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
                   8563:     }
1.411     www      8564:     $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.
                   8565:              '<input type="hidden" name="number" value="'.$number.'" />'.
                   8566:              &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
                   8567:                  $env{'form.pcorrect'},$env{'form.pincorrect'}).
                   8568:              '<br />';
1.522     www      8569:     if (($env{'form.gradingmechanism'} eq 'given') && ($number!=$foundgiven)) {
                   8570:        $result.='<span class="LC_error">'.&mt('Number of given answers does not agree with number of questions in file.').'</span>';
                   8571:        return $result.&show_grading_menu_form($symb);
                   8572:     } 
1.414     www      8573: # Remember Question Titles
                   8574: # FIXME: Possibly need delimiter other than ":"
                   8575:     for (my $i=0;$i<$number;$i++) {
                   8576:         $result.='<input type="hidden" name="question:'.$i.'" value="'.
                   8577:                  &HTML::Entities::encode($questiontitles[$i],'"&<>').'" />';
                   8578:     }
1.411     www      8579:     my $correct_count=0;
                   8580:     my $student_count=0;
                   8581:     my $unknown_count=0;
1.414     www      8582: # Match answers with usernames
                   8583: # FIXME: Possibly need delimiter other than ":"
1.409     albertel 8584:     foreach my $id (keys(%responses)) {
1.410     www      8585:        if ($correct_ids{$id}) {
1.414     www      8586:           $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />';
1.411     www      8587:           $correct_count++;
1.410     www      8588:        } elsif ($clicker_ids{$id}) {
1.437     www      8589:           if ($clicker_ids{$id}=~/\,/) {
                   8590: # More than one user with the same clicker!
                   8591:              $result.="\n<hr />".&mt('Clicker registered more than once').": <tt>".$id."</tt><br />";
                   8592:              $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
                   8593:                            "<select name='multi".$id."'>";
                   8594:              foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) {
                   8595:                  $result.="<option value='".$reguser."'>".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.')</option>';
                   8596:              }
                   8597:              $result.='</select>';
                   8598:              $unknown_count++;
                   8599:           } else {
                   8600: # Good: found one and only one user with the right clicker
                   8601:              $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />';
                   8602:              $student_count++;
                   8603:           }
1.410     www      8604:        } else {
1.411     www      8605:           $result.="\n<hr />".&mt('Unregistered Clicker')." <tt>".$id."</tt><br />";
                   8606:           $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
                   8607:                    "\n".&mt("Username").": <input type='text' name='uname".$id."' />&nbsp;".
                   8608:                    "\n".&mt("Domain").": ".
                   8609:                    &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).'&nbsp;'.
                   8610:                    &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id);
                   8611:           $unknown_count++;
1.410     www      8612:        }
1.405     www      8613:     }
1.412     www      8614:     $result.='<hr />'.
                   8615:              &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
1.521     www      8616:     if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) {
1.412     www      8617:        if ($correct_count==0) {
                   8618:           $errormsg.="Found no correct answers answers for grading!";
                   8619:        } elsif ($correct_count>1) {
1.414     www      8620:           $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>';
1.412     www      8621:        }
                   8622:     }
1.428     www      8623:     if ($number<1) {
                   8624:        $errormsg.="Found no questions.";
                   8625:     }
1.412     www      8626:     if ($errormsg) {
                   8627:        $result.='<br /><span class="LC_error">'.&mt($errormsg).'</span>';
                   8628:     } else {
                   8629:        $result.='<br /><input type="submit" name="finalize" value="'.&mt('Finalize Grading').'" />';
                   8630:     }
                   8631:     $result.='</form></td></tr></table>'."\n".
1.410     www      8632:              '</td></tr></table><br /><br />'."\n";
1.404     www      8633:     return $result.&show_grading_menu_form($symb);
1.400     www      8634: }
                   8635: 
1.405     www      8636: sub iclicker_eval {
1.406     www      8637:     my ($questiontitles,$responses)=@_;
1.405     www      8638:     my $number=0;
                   8639:     my $errormsg='';
                   8640:     foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
1.410     www      8641:         my %components=&Apache::loncommon::record_sep($line);
                   8642:         my @entries=map {$components{$_}} (sort(keys(%components)));
1.408     albertel 8643: 	if ($entries[0] eq 'Question') {
                   8644: 	    for (my $i=3;$i<$#entries;$i+=6) {
                   8645: 		$$questiontitles[$number]=$entries[$i];
                   8646: 		$number++;
                   8647: 	    }
                   8648: 	}
                   8649: 	if ($entries[0]=~/^\#/) {
                   8650: 	    my $id=$entries[0];
                   8651: 	    my @idresponses;
                   8652: 	    $id=~s/^[\#0]+//;
                   8653: 	    for (my $i=0;$i<$number;$i++) {
                   8654: 		my $idx=3+$i*6;
                   8655: 		push(@idresponses,$entries[$idx]);
                   8656: 	    }
                   8657: 	    $$responses{$id}=join(',',@idresponses);
                   8658: 	}
1.405     www      8659:     }
                   8660:     return ($errormsg,$number);
                   8661: }
                   8662: 
1.419     www      8663: sub interwrite_eval {
                   8664:     my ($questiontitles,$responses)=@_;
                   8665:     my $number=0;
                   8666:     my $errormsg='';
1.420     www      8667:     my $skipline=1;
                   8668:     my $questionnumber=0;
                   8669:     my %idresponses=();
1.419     www      8670:     foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
                   8671:         my %components=&Apache::loncommon::record_sep($line);
                   8672:         my @entries=map {$components{$_}} (sort(keys(%components)));
1.420     www      8673:         if ($entries[1] eq 'Time') { $skipline=0; next; }
                   8674:         if ($entries[1] eq 'Response') { $skipline=1; }
                   8675:         next if $skipline;
                   8676:         if ($entries[0]!=$questionnumber) {
                   8677:            $questionnumber=$entries[0];
                   8678:            $$questiontitles[$number]=&mt('Question [_1]',$questionnumber);
                   8679:            $number++;
1.419     www      8680:         }
1.420     www      8681:         my $id=$entries[4];
                   8682:         $id=~s/^[\#0]+//;
1.421     www      8683:         $id=~s/^v\d*\://i;
                   8684:         $id=~s/[\-\:]//g;
1.420     www      8685:         $idresponses{$id}[$number]=$entries[6];
                   8686:     }
1.524     raeburn  8687:     foreach my $id (keys(%idresponses)) {
1.420     www      8688:        $$responses{$id}=join(',',@{$idresponses{$id}});
                   8689:        $$responses{$id}=~s/^\s*\,//;
1.419     www      8690:     }
                   8691:     return ($errormsg,$number);
                   8692: }
                   8693: 
1.414     www      8694: sub assign_clicker_grades {
                   8695:     my ($r)=@_;
                   8696:     my ($symb)=&get_symb($r);
                   8697:     if (!$symb) {return '';}
1.416     www      8698: # See which part we are saving to
                   8699:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
                   8700: # FIXME: This should probably look for the first handgradeable part
                   8701:     my $part=$$partlist[0];
                   8702: # Start screen output
1.414     www      8703:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.416     www      8704: 
1.414     www      8705:     my $heading=&mt('Assigning grades based on clicker file');
                   8706:     $result.=(<<ENDHEADER);
                   8707: <br /><table width="100%" border="0"><tr><td bgcolor="#777777">
                   8708: <table width="100%" border="0"><tr bgcolor="#e6ffff"><td>
                   8709: <b>$heading</b></td></tr><tr bgcolor=#ffffe6><td>
                   8710: ENDHEADER
                   8711: # Get correct result
                   8712: # FIXME: Possibly need delimiter other than ":"
                   8713:     my @correct=();
1.415     www      8714:     my $gradingmechanism=$env{'form.gradingmechanism'};
                   8715:     my $number=$env{'form.number'};
                   8716:     if ($gradingmechanism ne 'attendance') {
1.414     www      8717:        foreach my $key (keys(%env)) {
                   8718:           if ($key=~/^form\.correct\:/) {
                   8719:              my @input=split(/\,/,$env{$key});
                   8720:              for (my $i=0;$i<=$#input;$i++) {
                   8721:                  if (($correct[$i]) && ($input[$i]) &&
                   8722:                      ($correct[$i] ne $input[$i])) {
                   8723:                     $result.='<br /><span class="LC_warning">'.
                   8724:                              &mt('More than one correct result given for question "[_1]": [_2] versus [_3].',
                   8725:                                  $env{'form.question:'.$i},$correct[$i],$input[$i]).'</span>';
                   8726:                  } elsif ($input[$i]) {
                   8727:                     $correct[$i]=$input[$i];
                   8728:                  }
                   8729:              }
                   8730:           }
                   8731:        }
1.415     www      8732:        for (my $i=0;$i<$number;$i++) {
1.414     www      8733:           if (!$correct[$i]) {
                   8734:              $result.='<br /><span class="LC_error">'.
                   8735:                       &mt('No correct result given for question "[_1]"!',
                   8736:                           $env{'form.question:'.$i}).'</span>';
                   8737:           }
                   8738:        }
                   8739:        $result.='<br />'.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct));
                   8740:     }
                   8741: # Start grading
1.415     www      8742:     my $pcorrect=$env{'form.pcorrect'};
                   8743:     my $pincorrect=$env{'form.pincorrect'};
1.416     www      8744:     my $storecount=0;
1.415     www      8745:     foreach my $key (keys(%env)) {
1.420     www      8746:        my $user='';
1.415     www      8747:        if ($key=~/^form\.student\:(.*)$/) {
1.420     www      8748:           $user=$1;
                   8749:        }
                   8750:        if ($key=~/^form\.unknown\:(.*)$/) {
                   8751:           my $id=$1;
                   8752:           if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {
                   8753:              $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};
1.437     www      8754:           } elsif ($env{'form.multi'.$id}) {
                   8755:              $user=$env{'form.multi'.$id};
1.420     www      8756:           }
                   8757:        }
                   8758:        if ($user) { 
1.415     www      8759:           my @answer=split(/\,/,$env{$key});
                   8760:           my $sum=0;
1.522     www      8761:           my $realnumber=$number;
1.415     www      8762:           for (my $i=0;$i<$number;$i++) {
                   8763:              if ($answer[$i]) {
                   8764:                 if ($gradingmechanism eq 'attendance') {
                   8765:                    $sum+=$pcorrect;
1.522     www      8766:                 } elsif ($answer[$i] eq '*') {
                   8767:                    $sum+=$pcorrect;
                   8768:                 } elsif ($answer[$i] eq '-') {
                   8769:                    $realnumber--;
1.415     www      8770:                 } else {
                   8771:                    if ($answer[$i] eq $correct[$i]) {
                   8772:                       $sum+=$pcorrect;
                   8773:                    } else {
                   8774:                       $sum+=$pincorrect;
                   8775:                    }
                   8776:                 }
                   8777:              }
                   8778:           }
1.522     www      8779:           my $ave=$sum/(100*$realnumber);
1.416     www      8780: # Store
                   8781:           my ($username,$domain)=split(/\:/,$user);
                   8782:           my %grades=();
                   8783:           $grades{"resource.$part.solved"}='correct_by_override';
                   8784:           $grades{"resource.$part.awarded"}=$ave;
                   8785:           $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
                   8786:           my $returncode=&Apache::lonnet::cstore(\%grades,$symb,
                   8787:                                                  $env{'request.course.id'},
                   8788:                                                  $domain,$username);
                   8789:           if ($returncode ne 'ok') {
                   8790:              $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>";
                   8791:           } else {
                   8792:              $storecount++;
                   8793:           }
1.415     www      8794:        }
                   8795:     }
                   8796: # We are done
1.416     www      8797:     $result.='<br />'.&mt('Successfully stored grades for [_1] student(s).',$storecount).
                   8798:              '</td></tr></table>'."\n".
1.414     www      8799:              '</td></tr></table><br /><br />'."\n";
                   8800:     return $result.&show_grading_menu_form($symb);
                   8801: }
                   8802: 
1.1       albertel 8803: sub handler {
1.41      ng       8804:     my $request=$_[0];
1.434     albertel 8805:     &reset_caches();
1.257     albertel 8806:     if ($env{'browser.mathml'}) {
1.141     www      8807: 	&Apache::loncommon::content_type($request,'text/xml');
1.41      ng       8808:     } else {
1.141     www      8809: 	&Apache::loncommon::content_type($request,'text/html');
1.41      ng       8810:     }
                   8811:     $request->send_http_header;
1.44      ng       8812:     return '' if $request->header_only;
1.41      ng       8813:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.324     albertel 8814:     my $symb=&get_symb($request,1);
1.160     albertel 8815:     my @commands=&Apache::loncommon::get_env_multiple('form.command');
                   8816:     my $command=$commands[0];
1.447     foxr     8817: 
1.160     albertel 8818:     if ($#commands > 0) {
                   8819: 	&Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
                   8820:     }
1.447     foxr     8821: 
1.513     foxr     8822:     $ssi_error = 0;
1.353     albertel 8823:     $request->print(&Apache::loncommon::start_page('Grading'));
1.324     albertel 8824:     if ($symb eq '' && $command eq '') {
1.257     albertel 8825: 	if ($env{'user.adv'}) {
                   8826: 	    if (($env{'form.codeone'}) && ($env{'form.codetwo'}) &&
                   8827: 		($env{'form.codethree'})) {
                   8828: 		my $token=$env{'form.codeone'}.'*'.$env{'form.codetwo'}.'*'.
                   8829: 		    $env{'form.codethree'};
1.41      ng       8830: 		my ($tsymb,$tuname,$tudom,$tcrsid)=
                   8831: 		    &Apache::lonnet::checkin($token);
                   8832: 		if ($tsymb) {
1.137     albertel 8833: 		    my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);
1.41      ng       8834: 		    if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
1.513     foxr     8835: 			$request->print(&ssi_with_retries('/res/'.$url, $ssi_retries,
1.99      albertel 8836: 					  ('grade_username' => $tuname,
                   8837: 					   'grade_domain' => $tudom,
                   8838: 					   'grade_courseid' => $tcrsid,
                   8839: 					   'grade_symb' => $tsymb)));
1.41      ng       8840: 		    } else {
1.45      ng       8841: 			$request->print('<h3>Not authorized: '.$token.'</h3>');
1.99      albertel 8842: 		    }
1.41      ng       8843: 		} else {
1.45      ng       8844: 		    $request->print('<h3>Not a valid DocID: '.$token.'</h3>');
1.41      ng       8845: 		}
1.14      www      8846: 	    } else {
1.41      ng       8847: 		$request->print(&Apache::lonxml::tokeninputfield());
                   8848: 	    }
                   8849: 	}
                   8850:     } else {
1.285     albertel 8851: 	&init_perm();
1.104     albertel 8852: 	if ($command eq 'submission' && $perm{'vgr'}) {
1.257     albertel 8853: 	    ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
1.103     albertel 8854: 	} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
1.68      ng       8855: 	    &pickStudentPage($request);
1.103     albertel 8856: 	} elsif ($command eq 'displayPage' && $perm{'vgr'}) {
1.68      ng       8857: 	    &displayPage($request);
1.104     albertel 8858: 	} elsif ($command eq 'gradeByPage' && $perm{'mgr'}) {
1.71      ng       8859: 	    &updateGradeByPage($request);
1.104     albertel 8860: 	} elsif ($command eq 'processGroup' && $perm{'vgr'}) {
1.41      ng       8861: 	    &processGroup($request);
1.104     albertel 8862: 	} elsif ($command eq 'gradingmenu' && $perm{'vgr'}) {
1.443     banghart 8863: 	    $request->print(&grading_menu($request));
                   8864: 	} elsif ($command eq 'submit_options' && $perm{'vgr'}) {
                   8865: 	    $request->print(&submit_options($request));
1.104     albertel 8866: 	} elsif ($command eq 'viewgrades' && $perm{'vgr'}) {
1.41      ng       8867: 	    $request->print(&viewgrades($request));
1.104     albertel 8868: 	} elsif ($command eq 'handgrade' && $perm{'mgr'}) {
1.41      ng       8869: 	    $request->print(&processHandGrade($request));
1.106     albertel 8870: 	} elsif ($command eq 'editgrades' && $perm{'mgr'}) {
1.41      ng       8871: 	    $request->print(&editgrades($request));
1.106     albertel 8872: 	} elsif ($command eq 'verify' && $perm{'vgr'}) {
1.41      ng       8873: 	    $request->print(&verifyreceipt($request));
1.400     www      8874:         } elsif ($command eq 'processclicker' && $perm{'mgr'}) {
                   8875:             $request->print(&process_clicker($request));
                   8876:         } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) {
                   8877:             $request->print(&process_clicker_file($request));
1.414     www      8878:         } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) {
                   8879:             $request->print(&assign_clicker_grades($request));
1.106     albertel 8880: 	} elsif ($command eq 'csvform' && $perm{'mgr'}) {
1.72      ng       8881: 	    $request->print(&upcsvScores_form($request));
1.106     albertel 8882: 	} elsif ($command eq 'csvupload' && $perm{'mgr'}) {
1.41      ng       8883: 	    $request->print(&csvupload($request));
1.106     albertel 8884: 	} elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {
1.41      ng       8885: 	    $request->print(&csvuploadmap($request));
1.246     albertel 8886: 	} elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) {
1.257     albertel 8887: 	    if ($env{'form.associate'} ne 'Reverse Association') {
1.246     albertel 8888: 		$request->print(&csvuploadoptions($request));
1.41      ng       8889: 	    } else {
1.257     albertel 8890: 		if ( $env{'form.upfile_associate'} ne 'reverse' ) {
                   8891: 		    $env{'form.upfile_associate'} = 'reverse';
1.41      ng       8892: 		} else {
1.257     albertel 8893: 		    $env{'form.upfile_associate'} = 'forward';
1.41      ng       8894: 		}
                   8895: 		$request->print(&csvuploadmap($request));
                   8896: 	    }
1.246     albertel 8897: 	} elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
                   8898: 	    $request->print(&csvuploadassign($request));
1.106     albertel 8899: 	} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
1.75      albertel 8900: 	    $request->print(&scantron_selectphase($request));
1.203     albertel 8901:  	} elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
                   8902:  	    $request->print(&scantron_do_warning($request));
1.142     albertel 8903: 	} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {
                   8904: 	    $request->print(&scantron_validate_file($request));
1.106     albertel 8905: 	} elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
1.82      albertel 8906: 	    $request->print(&scantron_process_students($request));
1.157     albertel 8907:  	} elsif ($command eq 'scantronupload' && 
1.257     albertel 8908:  		 (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
                   8909: 		  &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
1.162     albertel 8910:  	    $request->print(&scantron_upload_scantron_data($request)); 
1.157     albertel 8911:  	} elsif ($command eq 'scantronupload_save' &&
1.257     albertel 8912:  		 (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
                   8913: 		  &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
1.157     albertel 8914:  	    $request->print(&scantron_upload_scantron_data_save($request));
1.202     albertel 8915:  	} elsif ($command eq 'scantron_download' &&
1.257     albertel 8916: 		 &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
1.162     albertel 8917:  	    $request->print(&scantron_download_scantron_data($request));
1.523     raeburn  8918:         } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) {
                   8919:             $request->print(&checkscantron_results($request));     
1.106     albertel 8920: 	} elsif ($command) {
1.157     albertel 8921: 	    $request->print("Access Denied ($command)");
1.26      albertel 8922: 	}
1.2       albertel 8923:     }
1.513     foxr     8924:     if ($ssi_error) {
                   8925: 	&ssi_print_error($request);
                   8926:     }
1.353     albertel 8927:     $request->print(&Apache::loncommon::end_page());
1.434     albertel 8928:     &reset_caches();
1.44      ng       8929:     return '';
                   8930: }
                   8931: 
1.1       albertel 8932: 1;
                   8933: 
1.13      albertel 8934: __END__;
1.531     jms      8935: 
                   8936: 
                   8937: =head1 NAME
                   8938: 
                   8939: Apache::grades
                   8940: 
                   8941: =head1 SYNOPSIS
                   8942: 
                   8943: Handles the viewing of grades.
                   8944: 
                   8945: This is part of the LearningOnline Network with CAPA project
                   8946: described at http://www.lon-capa.org.
                   8947: 
                   8948: =head1 OVERVIEW
                   8949: 
                   8950: Do an ssi with retries:
                   8951: While I'd love to factor out this with the vesrion in lonprintout,
                   8952: 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
                   8953: I'm not quite ready to invent (e.g. an ssi_with_retry object).
                   8954: 
                   8955: At least the logic that drives this has been pulled out into loncommon.
                   8956: 
                   8957: 
                   8958: 
                   8959: ssi_with_retries - Does the server side include of a resource.
                   8960:                      if the ssi call returns an error we'll retry it up to
                   8961:                      the number of times requested by the caller.
                   8962:                      If we still have a proble, no text is appended to the
                   8963:                      output and we set some global variables.
                   8964:                      to indicate to the caller an SSI error occurred.  
                   8965:                      All of this is supposed to deal with the issues described
                   8966:                      in LonCAPA BZ 5631 see:
                   8967:                      http://bugs.lon-capa.org/show_bug.cgi?id=5631
                   8968:                      by informing the user that this happened.
                   8969: 
                   8970: Parameters:
                   8971:   resource   - The resource to include.  This is passed directly, without
                   8972:                interpretation to lonnet::ssi.
                   8973:   form       - The form hash parameters that guide the interpretation of the resource
                   8974:                
                   8975:   retries    - Number of retries allowed before giving up completely.
                   8976: Returns:
                   8977:   On success, returns the rendered resource identified by the resource parameter.
                   8978: Side Effects:
                   8979:   The following global variables can be set:
                   8980:    ssi_error                - If an unrecoverable error occurred this becomes true.
                   8981:                               It is up to the caller to initialize this to false
                   8982:                               if desired.
                   8983:    ssi_error_resource  - If an unrecoverable error occurred, this is the value
                   8984:                               of the resource that could not be rendered by the ssi
                   8985:                               call.
                   8986:    ssi_error_message   - The error string fetched from the ssi response
                   8987:                               in the event of an error.
                   8988: 
                   8989: 
                   8990: =head1 HANDLER SUBROUTINE
                   8991: 
                   8992: ssi_with_retries()
                   8993: 
                   8994: =head1 SUBROUTINES
                   8995: 
                   8996: =over
                   8997: 
                   8998: =item scantron_get_correction() : 
                   8999: 
                   9000:    Builds the interface screen to interact with the operator to fix a
                   9001:    specific error condition in a specific scanline
                   9002: 
                   9003:  Arguments:
                   9004:     $r           - Apache request object
                   9005:     $i           - number of the current scanline
                   9006:     $scan_record - hash ref as returned from &scantron_parse_scanline()
                   9007:     $scan_config - hash ref as returned from &get_scantron_config()
                   9008:     $line        - full contents of the current scanline
                   9009:     $error       - error condition, valid values are
                   9010:                    'incorrectCODE', 'duplicateCODE',
                   9011:                    'doublebubble', 'missingbubble',
                   9012:                    'duplicateID', 'incorrectID'
                   9013:     $arg         - extra information needed
                   9014:        For errors:
                   9015:          - duplicateID   - paper number that this studentID was seen before on
                   9016:          - duplicateCODE - array ref of the paper numbers this CODE was
                   9017:                            seen on before
                   9018:          - incorrectCODE - current incorrect CODE 
                   9019:          - doublebubble  - array ref of the bubble lines that have double
                   9020:                            bubble errors
                   9021:          - missingbubble - array ref of the bubble lines that have missing
                   9022:                            bubble errors
                   9023: 
                   9024: =item  scantron_get_maxbubble() : 
                   9025: 
                   9026:    Returns the maximum number of bubble lines that are expected to
                   9027:    occur. Does this by walking the selected sequence rendering the
                   9028:    resource and then checking &Apache::lonxml::get_problem_counter()
                   9029:    for what the current value of the problem counter is.
                   9030: 
                   9031:    Caches the results to $env{'form.scantron_maxbubble'},
                   9032:    $env{'form.scantron.bubble_lines.n'}, 
                   9033:    $env{'form.scantron.first_bubble_line.n'} and
                   9034:    $env{"form.scantron.sub_bubblelines.n"}
                   9035:    which are the total number of bubble, lines, the number of bubble
                   9036:    lines for response n and number of the first bubble line for response n,
                   9037:    and a comma separated list of numbers of bubble lines for sub-questions
                   9038:    (for optionresponse, matchresponse, and rankresponse items), for response n.  
                   9039: 
                   9040: 
                   9041: =item  scantron_validate_missingbubbles() : 
                   9042: 
                   9043:    Validates all scanlines in the selected file to not have any
                   9044:     answers that don't have bubbles that have not been verified
                   9045:     to be bubble free.
                   9046: 
                   9047: =item  scantron_process_students() : 
                   9048: 
                   9049:    Routine that does the actual grading of the bubble sheet information.
                   9050: 
                   9051:    The parsed scanline hash is added to %env 
                   9052: 
                   9053:    Then foreach unskipped scanline it does an &Apache::lonnet::ssi()
                   9054:    foreach resource , with the form data of
                   9055: 
                   9056: 	'submitted'     =>'scantron' 
                   9057: 	'grade_target'  =>'grade',
                   9058: 	'grade_username'=> username of student
                   9059: 	'grade_domain'  => domain of student
                   9060: 	'grade_courseid'=> of course
                   9061: 	'grade_symb'    => symb of resource to grade
                   9062: 
                   9063:     This triggers a grading pass. The problem grading code takes care
                   9064:     of converting the bubbled letter information (now in %env) into a
                   9065:     valid submission.
                   9066: 
                   9067: =item  scantron_upload_scantron_data() :
                   9068: 
                   9069:     Creates the screen for adding a new bubble sheet data file to a course.
                   9070: 
                   9071: =item  scantron_upload_scantron_data_save() : 
                   9072: 
                   9073:    Adds a provided bubble information data file to the course if user
                   9074:    has the correct privileges to do so. 
                   9075: 
                   9076: =item  valid_file() :
                   9077: 
                   9078:    Validates that the requested bubble data file exists in the course.
                   9079: 
                   9080: =item  scantron_download_scantron_data() : 
                   9081: 
                   9082:    Shows a list of the three internal files (original, corrected,
                   9083:    skipped) for a specific bubble sheet data file that exists in the
                   9084:    course.
                   9085: 
                   9086: =item  scantron_validate_ID() : 
                   9087: 
                   9088:    Validates all scanlines in the selected file to not have any
                   9089:    invalid or underspecified student IDs
                   9090: 
                   9091: =back
                   9092: 
                   9093: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.