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

1.17      albertel    1: # The LearningOnline Network with CAPA
1.13      albertel    2: # The LON-CAPA Grading handler
1.17      albertel    3: #
1.596.2.1! raeburn     4: # $Id: grades.pm,v 1.596 2010/02/28 23:31:42 raeburn 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.582     raeburn   100:     my ($symb,$errorref) = @_;
1.439     albertel  101: 
                    102:     my $navmap   = Apache::lonnavmaps::navmap->new();
1.582     raeburn   103:     unless (ref($navmap)) {
                    104:         if (ref($errorref)) { 
                    105:             $$errorref = 'navmap';
                    106:             return;
                    107:         }
                    108:     }
1.439     albertel  109:     my $res      = $navmap->getBySymb($symb);
                    110:     my $partlist = $res->parts();
                    111:     my $url      = $res->src();
                    112:     my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys'));
                    113: 
1.146     albertel  114:     my @stores;
1.439     albertel  115:     foreach my $part (@{ $partlist }) {
1.146     albertel  116: 	foreach my $key (@metakeys) {
                    117: 	    if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
                    118: 	}
                    119:     }
                    120:     return @stores;
1.2       albertel  121: }
                    122: 
1.44      ng        123: # --- Get the symbolic name of a problem and the url
1.324     albertel  124: sub get_symb {
1.173     albertel  125:     my ($request,$silent) = @_;
1.257     albertel  126:     (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                    127:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
1.173     albertel  128:     if ($symb eq '') { 
                    129: 	if (!$silent) {
                    130: 	    $request->print("Unable to handle ambiguous references:$url:.");
                    131: 	    return ();
                    132: 	}
                    133:     }
1.418     albertel  134:     &Apache::lonenc::check_decrypt(\$symb);
1.324     albertel  135:     return ($symb);
1.32      ng        136: }
                    137: 
1.129     ng        138: #--- Format fullname, username:domain if different for display
                    139: #--- Use anywhere where the student names are listed
                    140: sub nameUserString {
                    141:     my ($type,$fullname,$uname,$udom) = @_;
                    142:     if ($type eq 'header') {
1.485     albertel  143: 	return '<b>&nbsp;'.&mt('Fullname').'&nbsp;</b><span class="LC_internal_info">('.&mt('Username').')</span>';
1.129     ng        144:     } else {
1.398     albertel  145: 	return '&nbsp;'.$fullname.'<span class="LC_internal_info">&nbsp;('.$uname.
                    146: 	    ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')</span>';
1.129     ng        147:     }
                    148: }
                    149: 
1.44      ng        150: #--- Get the partlist and the response type for a given problem. ---
                    151: #--- Indicate if a response type is coded handgraded or not. ---
1.39      ng        152: sub response_type {
1.582     raeburn   153:     my ($symb,$response_error) = @_;
1.377     albertel  154: 
                    155:     my $navmap = Apache::lonnavmaps::navmap->new();
1.582     raeburn   156:     unless (ref($navmap)) {
                    157:         if (ref($response_error)) {
                    158:             $$response_error = 1;
                    159:         }
                    160:         return;
                    161:     }
1.377     albertel  162:     my $res = $navmap->getBySymb($symb);
1.593     raeburn   163:     unless (ref($res)) {
                    164:         $$response_error = 1;
                    165:         return;
                    166:     }
1.377     albertel  167:     my $partlist = $res->parts();
1.392     albertel  168:     my %vPart = 
                    169: 	map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart'));
1.377     albertel  170:     my (%response_types,%handgrade);
                    171:     foreach my $part (@{ $partlist }) {
1.392     albertel  172: 	next if (%vPart && !exists($vPart{$part}));
                    173: 
1.377     albertel  174: 	my @types = $res->responseType($part);
                    175: 	my @ids = $res->responseIds($part);
                    176: 	for (my $i=0; $i < scalar(@ids); $i++) {
                    177: 	    $response_types{$part}{$ids[$i]} = $types[$i];
                    178: 	    $handgrade{$part.'_'.$ids[$i]} = 
                    179: 		&Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i].
                    180: 				     '.handgrade',$symb);
1.41      ng        181: 	}
                    182:     }
1.377     albertel  183:     return ($partlist,\%handgrade,\%response_types);
1.39      ng        184: }
                    185: 
1.375     albertel  186: sub flatten_responseType {
                    187:     my ($responseType) = @_;
                    188:     my @part_response_id =
                    189: 	map { 
                    190: 	    my $part = $_;
                    191: 	    map {
                    192: 		[$part,$_]
                    193: 		} sort(keys(%{ $responseType->{$part} }));
                    194: 	} sort(keys(%$responseType));
                    195:     return @part_response_id;
                    196: }
                    197: 
1.207     albertel  198: sub get_display_part {
1.324     albertel  199:     my ($partID,$symb)=@_;
1.207     albertel  200:     my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb);
                    201:     if (defined($display) and $display ne '') {
1.577     bisitz    202:         $display.= ' (<span class="LC_internal_info">'
                    203:                   .&mt('Part ID: [_1]',$partID).'</span>)';
1.207     albertel  204:     } else {
                    205: 	$display=$partID;
                    206:     }
                    207:     return $display;
                    208: }
1.269     raeburn   209: 
1.118     ng        210: #--- Show resource title
                    211: #--- and parts and response type
                    212: sub showResourceInfo {
1.582     raeburn   213:     my ($symb,$probTitle,$checkboxes,$res_error) = @_;
1.398     albertel  214:     my $result = '<h3>'.&mt('Current Resource').': '.$probTitle.'</h3>'."\n";
1.582     raeburn   215:     my ($partlist,$handgrade,$responseType) = &response_type($symb,$res_error);
                    216:     if (ref($res_error)) {
                    217:         if ($$res_error) {
                    218:             return;
                    219:         }
                    220:     }
1.584     bisitz    221:     $result.=&Apache::loncommon::start_data_table()
                    222:             .&Apache::loncommon::start_data_table_header_row();
                    223:     if ($checkboxes) {
                    224:         $result.='<th>&nbsp;</th>';
                    225:     }
                    226:     $result.='<th>'.&mt('Problem Part').'</th>'
                    227:             .'<th>'.&mt('Res. ID').'</th>'
                    228:             .'<th>'.&mt('Type').'</th>'
                    229:             .&Apache::loncommon::end_data_table_header_row();
1.126     ng        230:     my %resptype = ();
1.122     ng        231:     my $hdgrade='no';
1.154     albertel  232:     my %partsseen;
1.524     raeburn   233:     foreach my $partID (sort(keys(%$responseType))) {
1.584     bisitz    234:         foreach my $resID (sort(keys(%{ $responseType->{$partID} }))) {
                    235:             my $handgrade=$$handgrade{$partID.'_'.$resID};
                    236:             my $responsetype = $responseType->{$partID}->{$resID};
                    237:             $hdgrade = $handgrade if ($handgrade eq 'yes');
                    238:             $result.=&Apache::loncommon::start_data_table_row();
                    239:             if ($checkboxes) {
                    240:                 if (exists($partsseen{$partID})) {
                    241:                     $result.="<td>&nbsp;</td>";
                    242:                 } else {
                    243:                     $result.="<td><input type='checkbox' name='vPart' value='$partID' checked='checked' /></td>";
                    244:                 }
                    245:                 $partsseen{$partID}=1;
                    246:             }
                    247:             my $display_part=&get_display_part($partID,$symb);
                    248:             $result.='<td>'.$display_part.'</td>'
                    249:                     .'<td>'.'<span class="LC_internal_info">'.$resID.'</span></td>'
                    250:                     .'<td>'.&mt($responsetype).'</td>'
                    251: #                   .'<td>'.&mt('<b>Handgrade: </b>[_1]',$handgrade).'</td>'
                    252:                     .&Apache::loncommon::end_data_table_row();
                    253:         }
1.118     ng        254:     }
1.584     bisitz    255:     $result.=&Apache::loncommon::end_data_table();
1.147     albertel  256:     return $result,$responseType,$hdgrade,$partlist,$handgrade;
1.118     ng        257: }
                    258: 
1.434     albertel  259: sub reset_caches {
                    260:     &reset_analyze_cache();
                    261:     &reset_perm();
                    262: }
                    263: 
                    264: {
                    265:     my %analyze_cache;
1.557     raeburn   266:     my %analyze_cache_formkeys;
1.148     albertel  267: 
1.434     albertel  268:     sub reset_analyze_cache {
                    269: 	undef(%analyze_cache);
1.557     raeburn   270:         undef(%analyze_cache_formkeys);
1.434     albertel  271:     }
                    272: 
                    273:     sub get_analyze {
1.557     raeburn   274: 	my ($symb,$uname,$udom,$no_increment,$add_to_hash)=@_;
1.434     albertel  275: 	my $key = "$symb\0$uname\0$udom";
1.557     raeburn   276: 	if (exists($analyze_cache{$key})) {
                    277:             my $getupdate = 0;
                    278:             if (ref($add_to_hash) eq 'HASH') {
                    279:                 foreach my $item (keys(%{$add_to_hash})) {
                    280:                     if (ref($analyze_cache_formkeys{$key}) eq 'HASH') {
                    281:                         if (!exists($analyze_cache_formkeys{$key}{$item})) {
                    282:                             $getupdate = 1;
                    283:                             last;
                    284:                         }
                    285:                     } else {
                    286:                         $getupdate = 1;
                    287:                     }
                    288:                 }
                    289:             }
                    290:             if (!$getupdate) {
                    291:                 return $analyze_cache{$key};
                    292:             }
                    293:         }
1.434     albertel  294: 
                    295: 	my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
                    296: 	$url=&Apache::lonnet::clutter($url);
1.557     raeburn   297:         my %form = ('grade_target'      => 'analyze',
                    298:                     'grade_domain'      => $udom,
                    299:                     'grade_symb'        => $symb,
                    300:                     'grade_courseid'    =>  $env{'request.course.id'},
                    301:                     'grade_username'    => $uname,
                    302:                     'grade_noincrement' => $no_increment);
                    303:         if (ref($add_to_hash)) {
                    304:             %form = (%form,%{$add_to_hash});
                    305:         } 
                    306: 	my $subresult=&ssi_with_retries($url, $ssi_retries,%form);
1.434     albertel  307: 	(undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
                    308: 	my %analyze=&Apache::lonnet::str2hash($subresult);
1.557     raeburn   309:         if (ref($add_to_hash) eq 'HASH') {
                    310:             $analyze_cache_formkeys{$key} = $add_to_hash;
                    311:         } else {
                    312:             $analyze_cache_formkeys{$key} = {};
                    313:         }
1.434     albertel  314: 	return $analyze_cache{$key} = \%analyze;
                    315:     }
                    316: 
                    317:     sub get_order {
1.525     raeburn   318: 	my ($partid,$respid,$symb,$uname,$udom,$no_increment)=@_;
                    319: 	my $analyze = &get_analyze($symb,$uname,$udom,$no_increment);
1.434     albertel  320: 	return $analyze->{"$partid.$respid.shown"};
                    321:     }
                    322: 
                    323:     sub get_radiobutton_correct_foil {
                    324: 	my ($partid,$respid,$symb,$uname,$udom)=@_;
                    325: 	my $analyze = &get_analyze($symb,$uname,$udom);
1.555     raeburn   326:         my $foils = &get_order($partid,$respid,$symb,$uname,$udom);
                    327:         if (ref($foils) eq 'ARRAY') {
                    328: 	    foreach my $foil (@{$foils}) {
                    329: 	        if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
                    330: 		    return $foil;
                    331: 	        }
1.434     albertel  332: 	    }
                    333: 	}
                    334:     }
1.554     raeburn   335: 
                    336:     sub scantron_partids_tograde {
1.557     raeburn   337:         my ($resource,$cid,$uname,$udom,$check_for_randomlist) = @_;
1.554     raeburn   338:         my (%analysis,@parts);
                    339:         if (ref($resource)) {
                    340:             my $symb = $resource->symb();
1.557     raeburn   341:             my $add_to_form;
                    342:             if ($check_for_randomlist) {
                    343:                 $add_to_form = { 'check_parts_withrandomlist' => 1,};
                    344:             }
                    345:             my $analyze = &get_analyze($symb,$uname,$udom,undef,$add_to_form);
1.554     raeburn   346:             if (ref($analyze) eq 'HASH') {
                    347:                 %analysis = %{$analyze};
                    348:             }
                    349:             if (ref($analysis{'parts'}) eq 'ARRAY') {
                    350:                 foreach my $part (@{$analysis{'parts'}}) {
                    351:                     my ($id,$respid) = split(/\./,$part);
                    352:                     if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) {
                    353:                         push(@parts,$part);
                    354:                     }
                    355:                 }
                    356:             }
                    357:         }
                    358:         return (\%analysis,\@parts);
                    359:     }
                    360: 
1.148     albertel  361: }
1.434     albertel  362: 
1.118     ng        363: #--- Clean response type for display
1.335     albertel  364: #--- Currently filters option/rank/radiobutton/match/essay/Task
                    365: #        response types only.
1.118     ng        366: sub cleanRecord {
1.336     albertel  367:     my ($answer,$response,$symb,$partid,$respid,$record,$order,$version,
                    368: 	$uname,$udom) = @_;
1.398     albertel  369:     my $grayFont = '<span class="LC_internal_info">';
1.148     albertel  370:     if ($response =~ /^(option|rank)$/) {
                    371: 	my %answer=&Apache::lonnet::str2hash($answer);
                    372: 	my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
                    373: 	my ($toprow,$bottomrow);
                    374: 	foreach my $foil (@$order) {
                    375: 	    if ($grading{$foil} == 1) {
                    376: 		$toprow.='<td><b>'.$answer{$foil}.'&nbsp;</b></td>';
                    377: 	    } else {
                    378: 		$toprow.='<td><i>'.$answer{$foil}.'&nbsp;</i></td>';
                    379: 	    }
1.398     albertel  380: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.148     albertel  381: 	}
                    382: 	return '<blockquote><table border="1">'.
1.466     albertel  383: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    384: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.596.2.1! raeburn   385: 	    $bottomrow.'</tr></table></blockquote>';
1.148     albertel  386:     } elsif ($response eq 'match') {
                    387: 	my %answer=&Apache::lonnet::str2hash($answer);
                    388: 	my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
                    389: 	my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"});
                    390: 	my ($toprow,$middlerow,$bottomrow);
                    391: 	foreach my $foil (@$order) {
                    392: 	    my $item=shift(@items);
                    393: 	    if ($grading{$foil} == 1) {
                    394: 		$toprow.='<td><b>'.$item.'&nbsp;</b></td>';
1.398     albertel  395: 		$middlerow.='<td><b>'.$grayFont.$answer{$foil}.'&nbsp;</span></b></td>';
1.148     albertel  396: 	    } else {
                    397: 		$toprow.='<td><i>'.$item.'&nbsp;</i></td>';
1.398     albertel  398: 		$middlerow.='<td><i>'.$grayFont.$answer{$foil}.'&nbsp;</span></i></td>';
1.148     albertel  399: 	    }
1.398     albertel  400: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.118     ng        401: 	}
1.126     ng        402: 	return '<blockquote><table border="1">'.
1.466     albertel  403: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    404: 	    '<tr valign="top"><td>'.$grayFont.&mt('Item ID').'</span></td>'.
1.148     albertel  405: 	    $middlerow.'</tr>'.
1.466     albertel  406: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.148     albertel  407: 	    $bottomrow.'</tr>'.'</table></blockquote>';
                    408:     } elsif ($response eq 'radiobutton') {
                    409: 	my %answer=&Apache::lonnet::str2hash($answer);
                    410: 	my ($toprow,$bottomrow);
1.434     albertel  411: 	my $correct = 
                    412: 	    &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom);
                    413: 	foreach my $foil (@$order) {
1.148     albertel  414: 	    if (exists($answer{$foil})) {
1.434     albertel  415: 		if ($foil eq $correct) {
1.466     albertel  416: 		    $toprow.='<td><b>'.&mt('true').'</b></td>';
1.148     albertel  417: 		} else {
1.466     albertel  418: 		    $toprow.='<td><i>'.&mt('true').'</i></td>';
1.148     albertel  419: 		}
                    420: 	    } else {
1.466     albertel  421: 		$toprow.='<td>'.&mt('false').'</td>';
1.148     albertel  422: 	    }
1.398     albertel  423: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.148     albertel  424: 	}
                    425: 	return '<blockquote><table border="1">'.
1.466     albertel  426: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    427: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.148     albertel  428: 	    $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
                    429:     } elsif ($response eq 'essay') {
1.257     albertel  430: 	if (! exists ($env{'form.'.$symb})) {
1.122     ng        431: 	    my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',
1.257     albertel  432: 						  $env{'course.'.$env{'request.course.id'}.'.domain'},
                    433: 						  $env{'course.'.$env{'request.course.id'}.'.num'});
1.122     ng        434: 
1.257     albertel  435: 	    my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
                    436: 	    $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : '';
                    437: 	    $env{'form.kwclr'}    = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red';
                    438: 	    $env{'form.kwsize'}   = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0';
                    439: 	    $env{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
                    440: 	    $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        441: 	}
1.166     albertel  442: 	$answer =~ s-\n-<br />-g;
                    443: 	return '<br /><br /><blockquote><tt>'.&keywords_highlight($answer).'</tt></blockquote>';
1.268     albertel  444:     } elsif ( $response eq 'organic') {
                    445: 	my $result='Smile representation: "<tt>'.$answer.'</tt>"';
                    446: 	my $jme=$record->{$version."resource.$partid.$respid.molecule"};
                    447: 	$result.=&Apache::chemresponse::jme_img($jme,$answer,400);
                    448: 	return $result;
1.335     albertel  449:     } elsif ( $response eq 'Task') {
                    450: 	if ( $answer eq 'SUBMITTED') {
                    451: 	    my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"};
1.336     albertel  452: 	    my $result = &Apache::bridgetask::file_list($files,$uname,$udom);
1.335     albertel  453: 	    return $result;
                    454: 	} elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) {
                    455: 	    my @matches = grep(/^\Q$version\E.*?\.instance$/,
                    456: 			       keys(%{$record}));
                    457: 	    return join('<br />',($version,@matches));
                    458: 			       
                    459: 			       
                    460: 	} else {
                    461: 	    my $result =
                    462: 		'<p>'
                    463: 		.&mt('Overall result: [_1]',
                    464: 		     $record->{$version."resource.$respid.$partid.status"})
                    465: 		.'</p>';
                    466: 	    
                    467: 	    $result .= '<ul>';
                    468: 	    my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/,
                    469: 			     keys(%{$record}));
                    470: 	    foreach my $grade (sort(@grade)) {
                    471: 		my ($dim) = ($grade =~/[.]([^.]+)[.]status$/);
                    472: 		$result.= '<li>'.&mt("Dimension: [_1], status [_2] ",
                    473: 				     $dim, $record->{$grade}).
                    474: 			  '</li>';
                    475: 	    }
                    476: 	    $result.='</ul>';
                    477: 	    return $result;
                    478: 	}
1.440     albertel  479:     } elsif ( $response =~ m/(?:numerical|formula)/) {
                    480: 	$answer = 
                    481: 	    &Apache::loncommon::format_previous_attempt_value('submission',
                    482: 							      $answer);
1.122     ng        483:     }
1.118     ng        484:     return $answer;
                    485: }
                    486: 
                    487: #-- A couple of common js functions
                    488: sub commonJSfunctions {
                    489:     my $request = shift;
                    490:     $request->print(<<COMMONJSFUNCTIONS);
                    491: <script type="text/javascript" language="javascript">
                    492:     function radioSelection(radioButton) {
                    493: 	var selection=null;
                    494: 	if (radioButton.length > 1) {
                    495: 	    for (var i=0; i<radioButton.length; i++) {
                    496: 		if (radioButton[i].checked) {
                    497: 		    return radioButton[i].value;
                    498: 		}
                    499: 	    }
                    500: 	} else {
                    501: 	    if (radioButton.checked) return radioButton.value;
                    502: 	}
                    503: 	return selection;
                    504:     }
                    505: 
                    506:     function pullDownSelection(selectOne) {
                    507: 	var selection="";
                    508: 	if (selectOne.length > 1) {
                    509: 	    for (var i=0; i<selectOne.length; i++) {
                    510: 		if (selectOne[i].selected) {
                    511: 		    return selectOne[i].value;
                    512: 		}
                    513: 	    }
                    514: 	} else {
1.138     albertel  515:             // only one value it must be the selected one
                    516: 	    return selectOne.value;
1.118     ng        517: 	}
                    518:     }
                    519: </script>
                    520: COMMONJSFUNCTIONS
                    521: }
                    522: 
1.44      ng        523: #--- Dumps the class list with usernames,list of sections,
                    524: #--- section, ids and fullnames for each user.
                    525: sub getclasslist {
1.449     banghart  526:     my ($getsec,$filterlist,$getgroup) = @_;
1.291     albertel  527:     my @getsec;
1.450     banghart  528:     my @getgroup;
1.442     banghart  529:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.291     albertel  530:     if (!ref($getsec)) {
                    531: 	if ($getsec ne '' && $getsec ne 'all') {
                    532: 	    @getsec=($getsec);
                    533: 	}
                    534:     } else {
                    535: 	@getsec=@{$getsec};
                    536:     }
                    537:     if (grep(/^all$/,@getsec)) { undef(@getsec); }
1.450     banghart  538:     if (!ref($getgroup)) {
                    539: 	if ($getgroup ne '' && $getgroup ne 'all') {
                    540: 	    @getgroup=($getgroup);
                    541: 	}
                    542:     } else {
                    543: 	@getgroup=@{$getgroup};
                    544:     }
                    545:     if (grep(/^all$/,@getgroup)) { undef(@getgroup); }
1.291     albertel  546: 
1.449     banghart  547:     my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
1.49      albertel  548:     # Bail out if we were unable to get the classlist
1.56      matthew   549:     return if (! defined($classlist));
1.449     banghart  550:     &Apache::loncoursedata::get_group_memberships($classlist,$keylist);
1.56      matthew   551:     #
                    552:     my %sections;
                    553:     my %fullnames;
1.205     matthew   554:     foreach my $student (keys(%$classlist)) {
                    555:         my $end      = 
                    556:             $classlist->{$student}->[&Apache::loncoursedata::CL_END()];
                    557:         my $start    = 
                    558:             $classlist->{$student}->[&Apache::loncoursedata::CL_START()];
                    559:         my $id       = 
                    560:             $classlist->{$student}->[&Apache::loncoursedata::CL_ID()];
                    561:         my $section  = 
                    562:             $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
                    563:         my $fullname = 
                    564:             $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()];
                    565:         my $status   = 
                    566:             $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()];
1.449     banghart  567:         my $group   = 
                    568:             $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
1.76      ng        569: 	# filter students according to status selected
1.442     banghart  570: 	if ($filterlist && (!($stu_status =~ /Any/))) {
                    571: 	    if (!($stu_status =~ $status)) {
1.450     banghart  572: 		delete($classlist->{$student});
1.76      ng        573: 		next;
                    574: 	    }
                    575: 	}
1.450     banghart  576: 	# filter students according to groups selected
1.453     banghart  577: 	my @stu_groups = split(/,/,$group);
1.450     banghart  578: 	if (@getgroup) {
                    579: 	    my $exclude = 1;
1.454     banghart  580: 	    foreach my $grp (@getgroup) {
                    581: 	        foreach my $stu_group (@stu_groups) {
1.453     banghart  582: 	            if ($stu_group eq $grp) {
                    583: 	                $exclude = 0;
                    584:     	            } 
1.450     banghart  585: 	        }
1.453     banghart  586:     	        if (($grp eq 'none') && !$group) {
                    587:         	        $exclude = 0;
                    588:         	}
1.450     banghart  589: 	    }
                    590: 	    if ($exclude) {
                    591: 	        delete($classlist->{$student});
                    592: 	    }
                    593: 	}
1.205     matthew   594: 	$section = ($section ne '' ? $section : 'none');
1.106     albertel  595: 	if (&canview($section)) {
1.291     albertel  596: 	    if (!@getsec || grep(/^\Q$section\E$/,@getsec)) {
1.103     albertel  597: 		$sections{$section}++;
1.450     banghart  598: 		if ($classlist->{$student}) {
                    599: 		    $fullnames{$student}=$fullname;
                    600: 		}
1.103     albertel  601: 	    } else {
1.205     matthew   602: 		delete($classlist->{$student});
1.103     albertel  603: 	    }
                    604: 	} else {
1.205     matthew   605: 	    delete($classlist->{$student});
1.103     albertel  606: 	}
1.44      ng        607:     }
                    608:     my %seen = ();
1.56      matthew   609:     my @sections = sort(keys(%sections));
                    610:     return ($classlist,\@sections,\%fullnames);
1.44      ng        611: }
                    612: 
1.103     albertel  613: sub canmodify {
                    614:     my ($sec)=@_;
                    615:     if ($perm{'mgr'}) {
                    616: 	if (!defined($perm{'mgr_section'})) {
                    617: 	    # can modify whole class
                    618: 	    return 1;
                    619: 	} else {
                    620: 	    if ($sec eq $perm{'mgr_section'}) {
                    621: 		#can modify the requested section
                    622: 		return 1;
                    623: 	    } else {
                    624: 		# can't modify the request section
                    625: 		return 0;
                    626: 	    }
                    627: 	}
                    628:     }
                    629:     #can't modify
                    630:     return 0;
                    631: }
                    632: 
                    633: sub canview {
                    634:     my ($sec)=@_;
                    635:     if ($perm{'vgr'}) {
                    636: 	if (!defined($perm{'vgr_section'})) {
                    637: 	    # can modify whole class
                    638: 	    return 1;
                    639: 	} else {
                    640: 	    if ($sec eq $perm{'vgr_section'}) {
                    641: 		#can modify the requested section
                    642: 		return 1;
                    643: 	    } else {
                    644: 		# can't modify the request section
                    645: 		return 0;
                    646: 	    }
                    647: 	}
                    648:     }
                    649:     #can't modify
                    650:     return 0;
                    651: }
                    652: 
1.44      ng        653: #--- Retrieve the grade status of a student for all the parts
                    654: sub student_gradeStatus {
1.324     albertel  655:     my ($symb,$udom,$uname,$partlist) = @_;
1.257     albertel  656:     my %record     = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.44      ng        657:     my %partstatus = ();
                    658:     foreach (@$partlist) {
1.128     ng        659: 	my ($status,undef)   = split(/_/,$record{"resource.$_.solved"},2);
1.44      ng        660: 	$status              = 'nothing' if ($status eq '');
                    661: 	$partstatus{$_}      = $status;
                    662: 	my $subkey           = "resource.$_.submitted_by";
                    663: 	$partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne '');
                    664:     }
                    665:     return %partstatus;
                    666: }
                    667: 
1.45      ng        668: # hidden form and javascript that calls the form
                    669: # Use by verifyscript and viewgrades
                    670: # Shows a student's view of problem and submission
                    671: sub jscriptNform {
1.324     albertel  672:     my ($symb) = @_;
1.442     banghart  673:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.45      ng        674:     my $jscript='<script type="text/javascript" language="javascript">'."\n".
                    675: 	'    function viewOneStudent(user,domain) {'."\n".
                    676: 	'	document.onestudent.student.value = user;'."\n".
                    677: 	'	document.onestudent.userdom.value = domain;'."\n".
                    678: 	'	document.onestudent.submit();'."\n".
                    679: 	'    }'."\n".
                    680: 	'</script>'."\n";
                    681:     $jscript.= '<form action="/adm/grades" method="post" name="onestudent">'."\n".
1.418     albertel  682: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel  683: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
                    684: 	'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n".
1.442     banghart  685: 	'<input type="hidden" name="Status"  value="'.$stu_status.'" />'."\n".
1.45      ng        686: 	'<input type="hidden" name="command" value="submission" />'."\n".
                    687: 	'<input type="hidden" name="student" value="" />'."\n".
                    688: 	'<input type="hidden" name="userdom" value="" />'."\n".
                    689: 	'</form>'."\n";
                    690:     return $jscript;
                    691: }
1.39      ng        692: 
1.447     foxr      693: 
                    694: 
1.315     bowersj2  695: # Given the score (as a number [0-1] and the weight) what is the final
                    696: # point value? This function will round to the nearest tenth, third,
                    697: # or quarter if one of those is within the tolerance of .00001.
1.316     albertel  698: sub compute_points {
1.315     bowersj2  699:     my ($score, $weight) = @_;
                    700:     
                    701:     my $tolerance = .00001;
                    702:     my $points = $score * $weight;
                    703: 
                    704:     # Check for nearness to 1/x.
                    705:     my $check_for_nearness = sub {
                    706:         my ($factor) = @_;
                    707:         my $num = ($points * $factor) + $tolerance;
                    708:         my $floored_num = floor($num);
1.316     albertel  709:         if ($num - $floored_num < 2 * $tolerance * $factor) {
1.315     bowersj2  710:             return $floored_num / $factor;
                    711:         }
                    712:         return $points;
                    713:     };
                    714: 
                    715:     $points = $check_for_nearness->(10);
                    716:     $points = $check_for_nearness->(3);
                    717:     $points = $check_for_nearness->(4);
                    718:     
                    719:     return $points;
                    720: }
                    721: 
1.44      ng        722: #------------------ End of general use routines --------------------
1.87      www       723: 
                    724: #
                    725: # Find most similar essay
                    726: #
                    727: 
                    728: sub most_similar {
1.426     albertel  729:     my ($uname,$udom,$uessay,$old_essays)=@_;
1.87      www       730: 
                    731: # ignore spaces and punctuation
                    732: 
                    733:     $uessay=~s/\W+/ /gs;
                    734: 
1.282     www       735: # ignore empty submissions (occuring when only files are sent)
                    736: 
                    737:     unless ($uessay=~/\w+/) { return ''; }
                    738: 
1.87      www       739: # these will be returned. Do not care if not at least 50 percent similar
1.88      www       740:     my $limit=0.6;
1.87      www       741:     my $sname='';
                    742:     my $sdom='';
                    743:     my $scrsid='';
                    744:     my $sessay='';
                    745: # go through all essays ...
1.426     albertel  746:     foreach my $tkey (keys(%$old_essays)) {
                    747: 	my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));
1.87      www       748: # ... except the same student
1.426     albertel  749:         next if (($tname eq $uname) && ($tdom eq $udom));
                    750: 	my $tessay=$old_essays->{$tkey};
                    751: 	$tessay=~s/\W+/ /gs;
1.87      www       752: # String similarity gives up if not even limit
1.426     albertel  753: 	my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
1.87      www       754: # Found one
1.426     albertel  755: 	if ($tsimilar>$limit) {
                    756: 	    $limit=$tsimilar;
                    757: 	    $sname=$tname;
                    758: 	    $sdom=$tdom;
                    759: 	    $scrsid=$tcrsid;
                    760: 	    $sessay=$old_essays->{$tkey};
                    761: 	}
1.87      www       762:     }
1.88      www       763:     if ($limit>0.6) {
1.87      www       764:        return ($sname,$sdom,$scrsid,$sessay,$limit);
                    765:     } else {
                    766:        return ('','','','',0);
                    767:     }
                    768: }
                    769: 
1.44      ng        770: #-------------------------------------------------------------------
                    771: 
                    772: #------------------------------------ Receipt Verification Routines
1.45      ng        773: #
1.44      ng        774: #--- Check whether a receipt number is valid.---
                    775: sub verifyreceipt {
                    776:     my $request  = shift;
                    777: 
1.257     albertel  778:     my $courseid = $env{'request.course.id'};
1.184     www       779:     my $receipt  = &Apache::lonnet::recprefix($courseid).'-'.
1.257     albertel  780: 	$env{'form.receipt'};
1.44      ng        781:     $receipt     =~ s/[^\-\d]//g;
1.378     albertel  782:     my ($symb)   = &get_symb($request);
1.44      ng        783: 
1.487     albertel  784:     my $title.=
                    785: 	'<h3><span class="LC_info">'.
1.584     bisitz    786: 	&mt('Verifying Receipt No. [_1]',$receipt).
1.487     albertel  787: 	'</span></h3>'."\n".
                    788: 	'<h4>'.&mt('<b>Resource: </b>[_1]',$env{'form.probTitle'}).
                    789: 	'</h4>'."\n";
1.44      ng        790: 
                    791:     my ($string,$contents,$matches) = ('','',0);
1.56      matthew   792:     my (undef,undef,$fullname) = &getclasslist('all','0');
1.177     albertel  793:     
                    794:     my $receiptparts=0;
1.390     albertel  795:     if ($env{"course.$courseid.receiptalg"} eq 'receipt2' ||
                    796: 	$env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; }
1.177     albertel  797:     my $parts=['0'];
1.582     raeburn   798:     if ($receiptparts) {
                    799:         my $res_error; 
                    800:         ($parts)=&response_type($symb,\$res_error);
                    801:         if ($res_error) {
                    802:             return &navmap_errormsg();
                    803:         } 
                    804:     }
1.486     albertel  805:     
                    806:     my $header = 
                    807: 	&Apache::loncommon::start_data_table().
                    808: 	&Apache::loncommon::start_data_table_header_row().
1.487     albertel  809: 	'<th>&nbsp;'.&mt('Fullname').'&nbsp;</th>'."\n".
                    810: 	'<th>&nbsp;'.&mt('Username').'&nbsp;</th>'."\n".
                    811: 	'<th>&nbsp;'.&mt('Domain').'&nbsp;</th>';
1.486     albertel  812:     if ($receiptparts) {
1.487     albertel  813: 	$header.='<th>&nbsp;'.&mt('Problem Part').'&nbsp;</th>';
1.486     albertel  814:     }
                    815:     $header.=
                    816: 	&Apache::loncommon::end_data_table_header_row();
                    817: 
1.294     albertel  818:     foreach (sort 
                    819: 	     {
                    820: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                    821: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                    822: 		 }
                    823: 		 return $a cmp $b;
                    824: 	     } (keys(%$fullname))) {
1.44      ng        825: 	my ($uname,$udom)=split(/\:/);
1.177     albertel  826: 	foreach my $part (@$parts) {
                    827: 	    if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) {
1.486     albertel  828: 		$contents.=
                    829: 		    &Apache::loncommon::start_data_table_row().
                    830: 		    '<td>&nbsp;'."\n".
1.177     albertel  831: 		    '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
1.417     albertel  832: 		    '\');" target="_self">'.$$fullname{$_}.'</a>&nbsp;</td>'."\n".
1.177     albertel  833: 		    '<td>&nbsp;'.$uname.'&nbsp;</td>'.
                    834: 		    '<td>&nbsp;'.$udom.'&nbsp;</td>';
                    835: 		if ($receiptparts) {
                    836: 		    $contents.='<td>&nbsp;'.$part.'&nbsp;</td>';
                    837: 		}
1.486     albertel  838: 		$contents.= 
                    839: 		    &Apache::loncommon::end_data_table_row()."\n";
1.177     albertel  840: 		
                    841: 		$matches++;
                    842: 	    }
1.44      ng        843: 	}
                    844:     }
                    845:     if ($matches == 0) {
1.584     bisitz    846:         $string = $title
                    847:                  .'<p class="LC_warning">'
                    848:                  .&mt('No match found for the above receipt number.')
                    849:                  .'</p>';
1.44      ng        850:     } else {
1.324     albertel  851: 	$string = &jscriptNform($symb).$title.
1.487     albertel  852: 	    '<p>'.
1.584     bisitz    853: 	    &mt('The above receipt number matches the following [quant,_1,student].',$matches).
1.487     albertel  854: 	    '</p>'.
1.486     albertel  855: 	    $header.
                    856: 	    $contents.
                    857: 	    &Apache::loncommon::end_data_table()."\n";
1.44      ng        858:     }
1.324     albertel  859:     return $string.&show_grading_menu_form($symb);
1.44      ng        860: }
                    861: 
                    862: #--- This is called by a number of programs.
                    863: #--- Called from the Grading Menu - View/Grade an individual student
                    864: #--- Also called directly when one clicks on the subm button 
                    865: #    on the problem page.
1.30      ng        866: sub listStudents {
1.41      ng        867:     my ($request) = shift;
1.49      albertel  868: 
1.324     albertel  869:     my ($symb) = &get_symb($request);
1.257     albertel  870:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                    871:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                    872:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
1.449     banghart  873:     my $getgroup  = $env{'form.group'} eq '' ? 'all' : $env{'form.group'};
1.257     albertel  874:     my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};
1.548     bisitz    875:     my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View';
1.257     albertel  876:     $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 
                    877: 	&Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
1.49      albertel  878: 
1.548     bisitz    879:     my $result='<h3><span class="LC_info">&nbsp;'
                    880: 	.&mt("$viewgrade Submissions for a Student or a Group of Students")
1.485     albertel  881: 	.'</span></h3>';
1.118     ng        882: 
1.324     albertel  883:     my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes'));
1.49      albertel  884: 
1.559     raeburn   885:     my %lt = &Apache::lonlocal::texthash (
                    886: 		'multiple' => 'Please select a student or group of students before clicking on the Next button.',
                    887: 		'single'   => 'Please select the student before clicking on the Next button.',
                    888: 	     );
1.45      ng        889:     $request->print(<<LISTJAVASCRIPT);
                    890: <script type="text/javascript" language="javascript">
1.110     ng        891:     function checkSelect(checkBox) {
                    892: 	var ctr=0;
                    893: 	var sense="";
                    894: 	if (checkBox.length > 1) {
                    895: 	    for (var i=0; i<checkBox.length; i++) {
                    896: 		if (checkBox[i].checked) {
                    897: 		    ctr++;
                    898: 		}
                    899: 	    }
1.485     albertel  900: 	    sense = '$lt{'multiple'}';
1.110     ng        901: 	} else {
                    902: 	    if (checkBox.checked) {
                    903: 		ctr = 1;
                    904: 	    }
1.485     albertel  905: 	    sense = '$lt{'single'}';
1.110     ng        906: 	}
                    907: 	if (ctr == 0) {
1.485     albertel  908: 	    alert(sense);
1.110     ng        909: 	    return false;
                    910: 	}
                    911: 	document.gradesub.submit();
                    912:     }
                    913: 
                    914:     function reLoadList(formname) {
1.112     ng        915: 	if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;}
1.110     ng        916: 	formname.command.value = 'submission';
                    917: 	formname.submit();
                    918:     }
1.45      ng        919: </script>
                    920: LISTJAVASCRIPT
                    921: 
1.118     ng        922:     &commonJSfunctions($request);
1.41      ng        923:     $request->print($result);
1.39      ng        924: 
1.401     albertel  925:     my $checkhdgrade = ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked="checked"' : '';
                    926:     my $checklastsub = $checkhdgrade eq '' ? 'checked="checked"' : '';
1.154     albertel  927:     my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'.
1.485     albertel  928: 	"\n".$table;
                    929: 	
1.561     bisitz    930:     $gradeTable .= &Apache::lonhtmlcommon::start_pick_box();
                    931:     $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text'))
                    932:                   .'<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n"
                    933:                   .'<label><input type="radio" name="vProb" value="yes" /> '.&mt('one student').' </label>'."\n"
                    934:                   .'<label><input type="radio" name="vProb" value="all" /> '.&mt('all students').' </label><br />'."\n"
                    935:                   .&Apache::lonhtmlcommon::row_closure();
                    936:     $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer'))
                    937:                   .'<label><input type="radio" name="vAns" value="no"  /> '.&mt('no').' </label>'."\n"
                    938:                   .'<label><input type="radio" name="vAns" value="yes" /> '.&mt('one student').' </label>'."\n"
                    939:                   .'<label><input type="radio" name="vAns" value="all" checked="checked" /> '.&mt('all students').' </label><br />'."\n"
                    940:                   .&Apache::lonhtmlcommon::row_closure();
1.485     albertel  941: 
                    942:     my $submission_options;
1.257     albertel  943:     if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {
1.485     albertel  944: 	$submission_options.=
                    945: 	    '<label><input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> '.&mt('essay part only').' </label>'."\n";
1.49      albertel  946:     }
1.442     banghart  947:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
                    948:     my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status;
1.257     albertel  949:     $env{'form.Status'} = $saveStatus;
1.485     albertel  950:     $submission_options.=
1.592     bisitz    951:         '<span class="LC_nobreak">'.
                    952:         '<label><input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> '.
                    953:         &mt('last submission only').' </label></span>'."\n".
                    954:         '<span class="LC_nobreak">'.
                    955:         '<label><input type="radio" name="lastSub" value="last" /> '.
                    956:         &mt('last submission &amp; parts info').' </label></span>'."\n".
                    957:         '<span class="LC_nobreak">'.
                    958:         '<label><input type="radio" name="lastSub" value="datesub" /> '.
                    959:         &mt('by dates and submissions').'</label></span>'."\n".
                    960:         '<span class="LC_nobreak">'.
                    961:         '<label><input type="radio" name="lastSub" value="all" /> '.
                    962:         &mt('all details').'</label></span>';
1.561     bisitz    963:     $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Submissions'))
                    964:                   .$submission_options
                    965:                   .&Apache::lonhtmlcommon::row_closure();
                    966: 
                    967:     $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Grading Increments'))
                    968:                   .'<select name="increment">'
                    969:                   .'<option value="1">'.&mt('Whole Points').'</option>'
                    970:                   .'<option value=".5">'.&mt('Half Points').'</option>'
                    971:                   .'<option value=".25">'.&mt('Quarter Points').'</option>'
                    972:                   .'<option value=".1">'.&mt('Tenths of a Point').'</option>'
                    973:                   .'</select>'
                    974:                   .&Apache::lonhtmlcommon::row_closure();
1.485     albertel  975: 
                    976:     $gradeTable .= 
1.432     banghart  977:         &build_section_inputs().
1.45      ng        978: 	'<input type="hidden" name="submitonly"  value="'.$submitonly.'" />'."\n".
1.257     albertel  979: 	'<input type="hidden" name="handgrade"   value="'.$env{'form.handgrade'}.'" /><br />'."\n".
                    980: 	'<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" /><br />'."\n".
                    981: 	'<input type="hidden" name="saveState"   value="'.$env{'form.saveState'}.'" />'."\n".
                    982: 	'<input type="hidden" name="probTitle"   value="'.$env{'form.probTitle'}.'" />'."\n".
1.418     albertel  983: 	'<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.110     ng        984: 	'<input type="hidden" name="saveStatusOld" value="'.$saveStatus.'" />'."\n";
                    985: 
1.257     albertel  986:     if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) {
1.561     bisitz    987: 	$gradeTable .= '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n";
1.124     ng        988:     } else {
1.561     bisitz    989:         $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Student Status'))
                    990:                       .&Apache::lonhtmlcommon::StatusOptions(
                    991:                            $saveStatus,undef,1,'javascript:reLoadList(this.form);')
                    992:                       .&Apache::lonhtmlcommon::row_closure();
1.124     ng        993:     }
1.112     ng        994: 
1.561     bisitz    995:     $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism'))
                    996:                   .'<input type="checkbox" name="checkPlag" checked="checked" />'
                    997:                   .&Apache::lonhtmlcommon::row_closure(1)
                    998:                   .&Apache::lonhtmlcommon::end_pick_box();
                    999: 
                   1000:     $gradeTable .= '<p>'
                   1001:                   .&mt('To '.lc($viewgrade)." a submission or a group of submissions, click on the check box(es) next to the student's name(s). Then click on the Next button.")."\n"
                   1002:                   .'<input type="hidden" name="command" value="processGroup" />'
                   1003:                   .'</p>';
1.249     albertel 1004: 
                   1005: # checkall buttons
                   1006:     $gradeTable.=&check_script('gradesub', 'stuinfo');
1.110     ng       1007:     $gradeTable.='<input type="button" '."\n".
1.589     bisitz   1008:         'onclick="javascript:checkSelect(this.form.stuinfo);" '."\n".
                   1009:         'value="'.&mt('Next').' &rarr;" /> <br />'."\n";
1.249     albertel 1010:     $gradeTable.=&check_buttons();
1.450     banghart 1011:     my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup);
1.474     albertel 1012:     $gradeTable.= &Apache::loncommon::start_data_table().
                   1013: 	&Apache::loncommon::start_data_table_header_row();
1.110     ng       1014:     my $loop = 0;
                   1015:     while ($loop < 2) {
1.485     albertel 1016: 	$gradeTable.='<th>'.&mt('No.').'</th><th>'.&mt('Select').'</th>'.
                   1017: 	    '<th>'.&nameUserString('header').'&nbsp;'.&mt('Section/Group').'</th>';
1.301     albertel 1018: 	if ($env{'form.showgrading'} eq 'yes' 
                   1019: 	    && $submitonly ne 'queued'
                   1020: 	    && $submitonly ne 'all') {
1.485     albertel 1021: 	    foreach my $part (sort(@$partlist)) {
                   1022: 		my $display_part=
                   1023: 		    &get_display_part((split(/_/,$part))[0],$symb);
                   1024: 		$gradeTable.=
                   1025: 		    '<th>'.&mt('Part: [_1] Status',$display_part).'</th>';
1.110     ng       1026: 	    }
1.301     albertel 1027: 	} elsif ($submitonly eq 'queued') {
1.474     albertel 1028: 	    $gradeTable.='<th>'.&mt('Queue Status').'&nbsp;</th>';
1.110     ng       1029: 	}
                   1030: 	$loop++;
1.126     ng       1031: #	$gradeTable.='<td></td>' if ($loop%2 ==1);
1.41      ng       1032:     }
1.474     albertel 1033:     $gradeTable.=&Apache::loncommon::end_data_table_header_row()."\n";
1.41      ng       1034: 
1.45      ng       1035:     my $ctr = 0;
1.294     albertel 1036:     foreach my $student (sort 
                   1037: 			 {
                   1038: 			     if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   1039: 				 return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   1040: 			     }
                   1041: 			     return $a cmp $b;
                   1042: 			 }
                   1043: 			 (keys(%$fullname))) {
1.41      ng       1044: 	my ($uname,$udom) = split(/:/,$student);
1.301     albertel 1045: 
1.110     ng       1046: 	my %status = ();
1.301     albertel 1047: 
                   1048: 	if ($submitonly eq 'queued') {
                   1049: 	    my %queue_status = 
                   1050: 		&Apache::bridgetask::get_student_status($symb,$cdom,$cnum,
                   1051: 							$udom,$uname);
                   1052: 	    next if (!defined($queue_status{'gradingqueue'}));
                   1053: 	    $status{'gradingqueue'} = $queue_status{'gradingqueue'};
                   1054: 	}
                   1055: 
                   1056: 	if ($env{'form.showgrading'} eq 'yes' 
                   1057: 	    && $submitonly ne 'queued'
                   1058: 	    && $submitonly ne 'all') {
1.324     albertel 1059: 	    (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist);
1.145     albertel 1060: 	    my $submitted = 0;
1.164     albertel 1061: 	    my $graded = 0;
1.248     albertel 1062: 	    my $incorrect = 0;
1.110     ng       1063: 	    foreach (keys(%status)) {
1.145     albertel 1064: 		$submitted = 1 if ($status{$_} ne 'nothing');
1.248     albertel 1065: 		$graded = 1 if ($status{$_} =~ /^ungraded/);
                   1066: 		$incorrect = 1 if ($status{$_} =~ /^incorrect/);
                   1067: 		
1.110     ng       1068: 		my ($foo,$partid,$foo1) = split(/\./,$_);
                   1069: 		if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
1.145     albertel 1070: 		    $submitted = 0;
1.150     albertel 1071: 		    my ($part)=split(/\./,$partid);
1.110     ng       1072: 		    $gradeTable.='<input type="hidden" name="'.
1.150     albertel 1073: 			$student.':'.$part.':submitted_by" value="'.
1.110     ng       1074: 			$status{'resource.'.$partid.'.submitted_by'}.'" />';
                   1075: 		}
1.41      ng       1076: 	    }
1.248     albertel 1077: 	    
1.156     albertel 1078: 	    next if (!$submitted && ($submitonly eq 'yes' ||
                   1079: 				     $submitonly eq 'incorrect' ||
                   1080: 				     $submitonly eq 'graded'));
1.248     albertel 1081: 	    next if (!$graded && ($submitonly eq 'graded'));
                   1082: 	    next if (!$incorrect && $submitonly eq 'incorrect');
1.41      ng       1083: 	}
1.34      ng       1084: 
1.45      ng       1085: 	$ctr++;
1.249     albertel 1086: 	my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
1.452     banghart 1087:         my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
1.104     albertel 1088: 	if ( $perm{'vgr'} eq 'F' ) {
1.474     albertel 1089: 	    if ($ctr%2 ==1) {
                   1090: 		$gradeTable.= &Apache::loncommon::start_data_table_row();
                   1091: 	    }
1.126     ng       1092: 	    $gradeTable.='<td align="right">'.$ctr.'&nbsp;</td>'.
1.563     bisitz   1093:                '<td align="center"><label><input type="checkbox" name="stuinfo" value="'.
1.249     albertel 1094:                $student.':'.$$fullname{$student}.':::SECTION'.$section.
                   1095: 	       ')&nbsp;" />&nbsp;&nbsp;</label></td>'."\n".'<td>'.
                   1096: 	       &nameUserString(undef,$$fullname{$student},$uname,$udom).
1.474     albertel 1097: 	       '&nbsp;'.$section.($group ne '' ?'/'.$group:'').'</td>'."\n";
1.110     ng       1098: 
1.257     albertel 1099: 	    if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
1.524     raeburn  1100: 		foreach (sort(keys(%status))) {
1.485     albertel 1101: 		    next if ($_ =~ /^resource.*?submitted_by$/);
                   1102: 		    $gradeTable.='<td align="center">&nbsp;'.&mt($status{$_}).'&nbsp;</td>'."\n";
1.110     ng       1103: 		}
1.41      ng       1104: 	    }
1.126     ng       1105: #	    $gradeTable.='<td></td>' if ($ctr%2 ==1);
1.474     albertel 1106: 	    if ($ctr%2 ==0) {
                   1107: 		$gradeTable.=&Apache::loncommon::end_data_table_row()."\n";
                   1108: 	    }
1.41      ng       1109: 	}
                   1110:     }
1.110     ng       1111:     if ($ctr%2 ==1) {
1.126     ng       1112: 	$gradeTable.='<td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td>';
1.301     albertel 1113: 	    if ($env{'form.showgrading'} eq 'yes' 
                   1114: 		&& $submitonly ne 'queued'
                   1115: 		&& $submitonly ne 'all') {
1.110     ng       1116: 		foreach (@$partlist) {
                   1117: 		    $gradeTable.='<td>&nbsp;</td>';
                   1118: 		}
1.301     albertel 1119: 	    } elsif ($submitonly eq 'queued') {
                   1120: 		$gradeTable.='<td>&nbsp;</td>';
1.110     ng       1121: 	    }
1.474     albertel 1122: 	$gradeTable.=&Apache::loncommon::end_data_table_row();
1.110     ng       1123:     }
                   1124: 
1.474     albertel 1125:     $gradeTable.=&Apache::loncommon::end_data_table()."\n".
1.589     bisitz   1126:         '<input type="button" '.
                   1127:         'onclick="javascript:checkSelect(this.form.stuinfo);" '.
                   1128:         'value="'.&mt('Next').' &rarr;" /></form>'."\n";
1.45      ng       1129:     if ($ctr == 0) {
1.96      albertel 1130: 	my $num_students=(scalar(keys(%$fullname)));
                   1131: 	if ($num_students eq 0) {
1.485     albertel 1132: 	    $gradeTable='<br />&nbsp;<span class="LC_warning">'.&mt('There are no students currently enrolled.').'</span>';
1.96      albertel 1133: 	} else {
1.171     albertel 1134: 	    my $submissions='submissions';
                   1135: 	    if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; }
                   1136: 	    if ($submitonly eq 'graded'   ) { $submissions = 'ungraded submissions'; }
1.301     albertel 1137: 	    if ($submitonly eq 'queued'   ) { $submissions = 'queued submissions'; }
1.398     albertel 1138: 	    $gradeTable='<br />&nbsp;<span class="LC_warning">'.
1.485     albertel 1139: 		&mt('No '.$submissions.' found for this resource for any students. ([_1] students checked for '.$submissions.')',
                   1140: 		    $num_students).
                   1141: 		'</span><br />';
1.96      albertel 1142: 	}
1.46      ng       1143:     } elsif ($ctr == 1) {
1.474     albertel 1144: 	$gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/;
1.45      ng       1145:     }
1.324     albertel 1146:     $gradeTable.=&show_grading_menu_form($symb);
1.45      ng       1147:     $request->print($gradeTable);
1.44      ng       1148:     return '';
1.10      ng       1149: }
                   1150: 
1.44      ng       1151: #---- Called from the listStudents routine
1.249     albertel 1152: 
                   1153: sub check_script {
                   1154:     my ($form, $type)=@_;
                   1155:     my $chkallscript='<script type="text/javascript">
                   1156:     function checkall() {
                   1157:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1158:             ele = document.forms.'.$form.'.elements[i];
                   1159:             if (ele.name == "'.$type.'") {
                   1160:             document.forms.'.$form.'.elements[i].checked=true;
                   1161:                                        }
                   1162:         }
                   1163:     }
                   1164: 
                   1165:     function checksec() {
                   1166:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1167:             ele = document.forms.'.$form.'.elements[i];
                   1168:            string = document.forms.'.$form.'.chksec.value;
                   1169:            if
                   1170:           (ele.value.indexOf(":::SECTION"+string)>0) {
                   1171:               document.forms.'.$form.'.elements[i].checked=true;
                   1172:             }
                   1173:         }
                   1174:     }
                   1175: 
                   1176: 
                   1177:     function uncheckall() {
                   1178:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1179:             ele = document.forms.'.$form.'.elements[i];
                   1180:             if (ele.name == "'.$type.'") {
                   1181:             document.forms.'.$form.'.elements[i].checked=false;
                   1182:                                        }
                   1183:         }
                   1184:     }
                   1185: 
                   1186: </script>'."\n";
                   1187:     return $chkallscript;
                   1188: }
                   1189: 
                   1190: sub check_buttons {
1.485     albertel 1191:     my $buttons.='<input type="button" onclick="checkall()" value="'.&mt('Check All').'" />';
                   1192:     $buttons.='<input type="button" onclick="uncheckall()" value="'.&mt('Uncheck All').'" />&nbsp;';
                   1193:     $buttons.='<input type="button" onclick="checksec()" value="'.&mt('Check Section/Group').'" />';
1.249     albertel 1194:     $buttons.='<input type="text" size="5" name="chksec" />&nbsp;';
                   1195:     return $buttons;
                   1196: }
                   1197: 
1.44      ng       1198: #     Displays the submissions for one student or a group of students
1.34      ng       1199: sub processGroup {
1.41      ng       1200:     my ($request)  = shift;
                   1201:     my $ctr        = 0;
1.155     albertel 1202:     my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo');
1.41      ng       1203:     my $total      = scalar(@stuchecked)-1;
1.45      ng       1204: 
1.396     banghart 1205:     foreach my $student (@stuchecked) {
                   1206: 	my ($uname,$udom,$fullname) = split(/:/,$student);
1.257     albertel 1207: 	$env{'form.student'}        = $uname;
                   1208: 	$env{'form.userdom'}        = $udom;
                   1209: 	$env{'form.fullname'}       = $fullname;
1.41      ng       1210: 	&submission($request,$ctr,$total);
                   1211: 	$ctr++;
                   1212:     }
                   1213:     return '';
1.35      ng       1214: }
1.34      ng       1215: 
1.44      ng       1216: #------------------------------------------------------------------------------------
                   1217: #
                   1218: #-------------------------- Next few routines handles grading by student, essentially
                   1219: #                           handles essay response type problem/part
                   1220: #
                   1221: #--- Javascript to handle the submission page functionality ---
                   1222: sub sub_page_js {
                   1223:     my $request = shift;
1.539     riegler  1224: 	    my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = ');
1.44      ng       1225:     $request->print(<<SUBJAVASCRIPT);
                   1226: <script type="text/javascript" language="javascript">
1.71      ng       1227:     function updateRadio(formname,id,weight) {
1.125     ng       1228: 	var gradeBox = formname["GD_BOX"+id];
                   1229: 	var radioButton = formname["RADVAL"+id];
                   1230: 	var oldpts = formname["oldpts"+id].value;
1.72      ng       1231: 	var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts;
1.71      ng       1232: 	gradeBox.value = pts;
                   1233: 	var resetbox = false;
                   1234: 	if (isNaN(pts) || pts < 0) {
1.539     riegler  1235: 	    alert("$alertmsg"+pts);
1.71      ng       1236: 	    for (var i=0; i<radioButton.length; i++) {
                   1237: 		if (radioButton[i].checked) {
                   1238: 		    gradeBox.value = i;
                   1239: 		    resetbox = true;
                   1240: 		}
                   1241: 	    }
                   1242: 	    if (!resetbox) {
                   1243: 		formtextbox.value = "";
                   1244: 	    }
                   1245: 	    return;
1.44      ng       1246: 	}
1.71      ng       1247: 
                   1248: 	if (pts > weight) {
                   1249: 	    var resp = confirm("You entered a value ("+pts+
                   1250: 			       ") greater than the weight for the part. Accept?");
                   1251: 	    if (resp == false) {
1.125     ng       1252: 		gradeBox.value = oldpts;
1.71      ng       1253: 		return;
                   1254: 	    }
1.44      ng       1255: 	}
1.13      albertel 1256: 
1.71      ng       1257: 	for (var i=0; i<radioButton.length; i++) {
                   1258: 	    radioButton[i].checked=false;
                   1259: 	    if (pts == i && pts != "") {
                   1260: 		radioButton[i].checked=true;
                   1261: 	    }
                   1262: 	}
                   1263: 	updateSelect(formname,id);
1.125     ng       1264: 	formname["stores"+id].value = "0";
1.41      ng       1265:     }
1.5       albertel 1266: 
1.72      ng       1267:     function writeBox(formname,id,pts) {
1.125     ng       1268: 	var gradeBox = formname["GD_BOX"+id];
1.71      ng       1269: 	if (checkSolved(formname,id) == 'update') {
                   1270: 	    gradeBox.value = pts;
                   1271: 	} else {
1.125     ng       1272: 	    var oldpts = formname["oldpts"+id].value;
1.72      ng       1273: 	    gradeBox.value = oldpts;
1.125     ng       1274: 	    var radioButton = formname["RADVAL"+id];
1.71      ng       1275: 	    for (var i=0; i<radioButton.length; i++) {
                   1276: 		radioButton[i].checked=false;
1.72      ng       1277: 		if (i == oldpts) {
1.71      ng       1278: 		    radioButton[i].checked=true;
                   1279: 		}
                   1280: 	    }
1.41      ng       1281: 	}
1.125     ng       1282: 	formname["stores"+id].value = "0";
1.71      ng       1283: 	updateSelect(formname,id);
                   1284: 	return;
1.41      ng       1285:     }
1.44      ng       1286: 
1.71      ng       1287:     function clearRadBox(formname,id) {
                   1288: 	if (checkSolved(formname,id) == 'noupdate') {
                   1289: 	    updateSelect(formname,id);
                   1290: 	    return;
                   1291: 	}
1.125     ng       1292: 	gradeSelect = formname["GD_SEL"+id];
1.71      ng       1293: 	for (var i=0; i<gradeSelect.length; i++) {
                   1294: 	    if (gradeSelect[i].selected) {
                   1295: 		var selectx=i;
                   1296: 	    }
                   1297: 	}
1.125     ng       1298: 	var stores = formname["stores"+id];
1.71      ng       1299: 	if (selectx == stores.value) { return };
1.125     ng       1300: 	var gradeBox = formname["GD_BOX"+id];
1.71      ng       1301: 	gradeBox.value = "";
1.125     ng       1302: 	var radioButton = formname["RADVAL"+id];
1.71      ng       1303: 	for (var i=0; i<radioButton.length; i++) {
                   1304: 	    radioButton[i].checked=false;
                   1305: 	}
                   1306: 	stores.value = selectx;
                   1307:     }
1.5       albertel 1308: 
1.71      ng       1309:     function checkSolved(formname,id) {
1.125     ng       1310: 	if (formname["solved"+id].value == "correct_by_student" && formname.overRideScore.value == 'no') {
1.118     ng       1311: 	    var reply = confirm("This problem has been graded correct by the computer. Do you want to change the score?");
                   1312: 	    if (!reply) {return "noupdate";}
1.120     ng       1313: 	    formname.overRideScore.value = 'yes';
1.41      ng       1314: 	}
1.71      ng       1315: 	return "update";
1.13      albertel 1316:     }
1.71      ng       1317: 
                   1318:     function updateSelect(formname,id) {
1.125     ng       1319: 	formname["GD_SEL"+id][0].selected = true;
1.71      ng       1320: 	return;
1.41      ng       1321:     }
1.33      ng       1322: 
1.121     ng       1323: //=========== Check that a point is assigned for all the parts  ============
1.71      ng       1324:     function checksubmit(formname,val,total,parttot) {
1.121     ng       1325: 	formname.gradeOpt.value = val;
1.71      ng       1326: 	if (val == "Save & Next") {
                   1327: 	    for (i=0;i<=total;i++) {
                   1328: 		for (j=0;j<parttot;j++) {
1.125     ng       1329: 		    var partid = formname["partid"+i+"_"+j].value;
1.127     ng       1330: 		    if (formname["GD_SEL"+i+"_"+partid][0].selected) {
1.125     ng       1331: 			var points = formname["GD_BOX"+i+"_"+partid].value;
1.71      ng       1332: 			if (points == "") {
1.125     ng       1333: 			    var name = formname["name"+i].value;
1.129     ng       1334: 			    var studentID = (name != '' ? name : formname["unamedom"+i].value);
                   1335: 			    var resp = confirm("You did not assign a score for "+studentID+
                   1336: 					       ", part "+partid+". Continue?");
1.71      ng       1337: 			    if (resp == false) {
1.125     ng       1338: 				formname["GD_BOX"+i+"_"+partid].focus();
1.71      ng       1339: 				return false;
                   1340: 			    }
                   1341: 			}
                   1342: 		    }
                   1343: 		    
                   1344: 		}
                   1345: 	    }
                   1346: 	    
                   1347: 	}
1.121     ng       1348: 	if (val == "Grade Student") {
                   1349: 	    formname.showgrading.value = "yes";
                   1350: 	    if (formname.Status.value == "") {
                   1351: 		formname.Status.value = "Active";
                   1352: 	    }
                   1353: 	    formname.studentNo.value = total;
                   1354: 	}
1.120     ng       1355: 	formname.submit();
                   1356:     }
                   1357: 
1.71      ng       1358: //======= Check that a score is assigned for all the problems (page/sequence grading only) =========
                   1359:     function checkSubmitPage(formname,total) {
                   1360: 	noscore = new Array(100);
                   1361: 	var ptr = 0;
                   1362: 	for (i=1;i<total;i++) {
1.125     ng       1363: 	    var partid = formname["q_"+i].value;
1.127     ng       1364: 	    if (formname["GD_SEL"+i+"_"+partid][0].selected) {
1.125     ng       1365: 		var points = formname["GD_BOX"+i+"_"+partid].value;
                   1366: 		var status = formname["solved"+i+"_"+partid].value;
1.71      ng       1367: 		if (points == "" && status != "correct_by_student") {
                   1368: 		    noscore[ptr] = i;
                   1369: 		    ptr++;
                   1370: 		}
                   1371: 	    }
                   1372: 	}
                   1373: 	if (ptr != 0) {
                   1374: 	    var sense = ptr == 1 ? ": " : "s: ";
                   1375: 	    var prolist = "";
                   1376: 	    if (ptr == 1) {
                   1377: 		prolist = noscore[0];
                   1378: 	    } else {
                   1379: 		var i = 0;
                   1380: 		while (i < ptr-1) {
                   1381: 		    prolist += noscore[i]+", ";
                   1382: 		    i++;
                   1383: 		}
                   1384: 		prolist += "and "+noscore[i];
                   1385: 	    }
                   1386: 	    var resp = confirm("You did not assign any score for the following problem"+sense+prolist+". Continue?");
                   1387: 	    if (resp == false) {
                   1388: 		return false;
                   1389: 	    }
                   1390: 	}
1.45      ng       1391: 
1.71      ng       1392: 	formname.submit();
                   1393:     }
                   1394: </script>
                   1395: SUBJAVASCRIPT
                   1396: }
1.45      ng       1397: 
1.71      ng       1398: #--- javascript for essay type problem --
                   1399: sub sub_page_kw_js {
                   1400:     my $request = shift;
1.80      ng       1401:     my $iconpath = $request->dir_config('lonIconsURL');
1.118     ng       1402:     &commonJSfunctions($request);
1.350     albertel 1403: 
1.351     albertel 1404:     my $inner_js_msg_central=<<INNERJS;
1.350     albertel 1405:     <script text="text/javascript">
                   1406:     function checkInput() {
                   1407:       opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value);
                   1408:       var nmsg   = opener.document.SCORE.savemsgN.value;
                   1409:       var usrctr = document.msgcenter.usrctr.value;
                   1410:       var newval = opener.document.SCORE["newmsg"+usrctr];
                   1411:       newval.value = opener.checkEntities(document.msgcenter.newmsg.value);
                   1412: 
                   1413:       var msgchk = "";
                   1414:       if (document.msgcenter.subchk.checked) {
                   1415:          msgchk = "msgsub,";
                   1416:       }
                   1417:       var includemsg = 0;
                   1418:       for (var i=1; i<=nmsg; i++) {
                   1419:           var opnmsg = opener.document.SCORE["savemsg"+i];
                   1420:           var frmmsg = document.msgcenter["msg"+i];
                   1421:           opnmsg.value = opener.checkEntities(frmmsg.value);
                   1422:           var showflg = opener.document.SCORE["shownOnce"+i];
                   1423:           showflg.value = "1";
                   1424:           var chkbox = document.msgcenter["msgn"+i];
                   1425:           if (chkbox.checked) {
                   1426:              msgchk += "savemsg"+i+",";
                   1427:              includemsg = 1;
                   1428:           }
                   1429:       }
                   1430:       if (document.msgcenter.newmsgchk.checked) {
                   1431:          msgchk += "newmsg"+usrctr;
                   1432:          includemsg = 1;
                   1433:       }
                   1434:       imgformname = opener.document.SCORE["mailicon"+usrctr];
                   1435:       imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif");
                   1436:       var includemsg = opener.document.SCORE["includemsg"+usrctr];
                   1437:       includemsg.value = msgchk;
                   1438: 
                   1439:       self.close()
                   1440: 
                   1441:     }
                   1442:     </script>
                   1443: INNERJS
                   1444: 
1.351     albertel 1445:     my $inner_js_highlight_central=<<INNERJS;
                   1446:  <script type="text/javascript">
                   1447:     function updateChoice(flag) {
                   1448:       opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr);
                   1449:       opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize);
                   1450:       opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle);
                   1451:       opener.document.SCORE.refresh.value = "on";
                   1452:       if (opener.document.SCORE.keywords.value!=""){
                   1453:          opener.document.SCORE.submit();
                   1454:       }
                   1455:       self.close()
                   1456:     }
                   1457: </script>
                   1458: INNERJS
                   1459: 
                   1460:     my $start_page_msg_central = 
                   1461:         &Apache::loncommon::start_page('Message Central',$inner_js_msg_central,
                   1462: 				       {'js_ready'  => 1,
                   1463: 					'only_body' => 1,
                   1464: 					'bgcolor'   =>'#FFFFFF',});
                   1465:     my $end_page_msg_central = 
                   1466: 	&Apache::loncommon::end_page({'js_ready' => 1});
                   1467: 
                   1468: 
                   1469:     my $start_page_highlight_central = 
                   1470:         &Apache::loncommon::start_page('Highlight Central',
                   1471: 				       $inner_js_highlight_central,
1.350     albertel 1472: 				       {'js_ready'  => 1,
                   1473: 					'only_body' => 1,
                   1474: 					'bgcolor'   =>'#FFFFFF',});
1.351     albertel 1475:     my $end_page_highlight_central = 
1.350     albertel 1476: 	&Apache::loncommon::end_page({'js_ready' => 1});
                   1477: 
1.219     www      1478:     my $docopen=&Apache::lonhtmlcommon::javascript_docopen();
1.236     albertel 1479:     $docopen=~s/^document\.//;
1.539     riegler  1480:     my $alertmsg = &mt('Please select a word or group of words from document and then click this link.');
1.71      ng       1481:     $request->print(<<SUBJAVASCRIPT);
                   1482: <script type="text/javascript" language="javascript">
1.45      ng       1483: 
1.44      ng       1484: //===================== Show list of keywords ====================
1.122     ng       1485:   function keywords(formname) {
                   1486:     var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",formname.keywords.value);
1.44      ng       1487:     if (nret==null) return;
1.122     ng       1488:     formname.keywords.value = nret;
1.44      ng       1489: 
1.122     ng       1490:     if (formname.keywords.value != "") {
1.128     ng       1491: 	formname.refresh.value = "on";
1.122     ng       1492: 	formname.submit();
1.44      ng       1493:     }
                   1494:     return;
                   1495:   }
                   1496: 
                   1497: //===================== Script to view submitted by ==================
                   1498:   function viewSubmitter(submitter) {
                   1499:     document.SCORE.refresh.value = "on";
                   1500:     document.SCORE.NCT.value = "1";
                   1501:     document.SCORE.unamedom0.value = submitter;
                   1502:     document.SCORE.submit();
                   1503:     return;
                   1504:   }
                   1505: 
                   1506: //===================== Script to add keyword(s) ==================
                   1507:   function getSel() {
                   1508:     if (document.getSelection) txt = document.getSelection();
                   1509:     else if (document.selection) txt = document.selection.createRange().text;
                   1510:     else return;
                   1511:     var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," ");
                   1512:     if (cleantxt=="") {
1.539     riegler  1513: 	alert("$alertmsg");
1.44      ng       1514: 	return;
                   1515:     }
                   1516:     var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt);
                   1517:     if (nret==null) return;
1.127     ng       1518:     document.SCORE.keywords.value = document.SCORE.keywords.value+" "+nret;
1.44      ng       1519:     if (document.SCORE.keywords.value != "") {
1.127     ng       1520: 	document.SCORE.refresh.value = "on";
1.44      ng       1521: 	document.SCORE.submit();
                   1522:     }
                   1523:     return;
                   1524:   }
                   1525: 
                   1526: //====================== Script for composing message ==============
1.80      ng       1527:    // preload images
                   1528:    img1 = new Image();
                   1529:    img1.src = "$iconpath/mailbkgrd.gif";
                   1530:    img2 = new Image();
                   1531:    img2.src = "$iconpath/mailto.gif";
                   1532: 
1.44      ng       1533:   function msgCenter(msgform,usrctr,fullname) {
                   1534:     var Nmsg  = msgform.savemsgN.value;
                   1535:     savedMsgHeader(Nmsg,usrctr,fullname);
                   1536:     var subject = msgform.msgsub.value;
1.127     ng       1537:     var msgchk = document.SCORE["includemsg"+usrctr].value;
1.44      ng       1538:     re = /msgsub/;
                   1539:     var shwsel = "";
                   1540:     if (re.test(msgchk)) { shwsel = "checked" }
1.123     ng       1541:     subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject);
                   1542:     displaySubject(checkEntities(subject),shwsel);
1.44      ng       1543:     for (var i=1; i<=Nmsg; i++) {
1.123     ng       1544: 	var testmsg = "savemsg"+i+",";
                   1545: 	re = new RegExp(testmsg,"g");
1.44      ng       1546: 	shwsel = "";
                   1547: 	if (re.test(msgchk)) { shwsel = "checked" }
1.125     ng       1548: 	var message = document.SCORE["savemsg"+i].value;
1.126     ng       1549: 	message = (document.SCORE["shownOnce"+i].value == 0 ? checkEntities(message) : message);
1.123     ng       1550: 	displaySavedMsg(i,message,shwsel); //I do not get it. w/o checkEntities on saved messages,
                   1551: 	                                   //any &lt; is already converted to <, etc. However, only once!!
1.44      ng       1552:     }
1.125     ng       1553:     newmsg = document.SCORE["newmsg"+usrctr].value;
1.44      ng       1554:     shwsel = "";
                   1555:     re = /newmsg/;
                   1556:     if (re.test(msgchk)) { shwsel = "checked" }
                   1557:     newMsg(newmsg,shwsel);
                   1558:     msgTail(); 
                   1559:     return;
                   1560:   }
                   1561: 
1.123     ng       1562:   function checkEntities(strx) {
                   1563:     if (strx.length == 0) return strx;
                   1564:     var orgStr = ["&", "<", ">", '"']; 
                   1565:     var newStr = ["&amp;", "&lt;", "&gt;", "&quot;"];
                   1566:     var counter = 0;
                   1567:     while (counter < 4) {
                   1568: 	strx = strReplace(strx,orgStr[counter],newStr[counter]);
                   1569: 	counter++;
                   1570:     }
                   1571:     return strx;
                   1572:   }
                   1573: 
                   1574:   function strReplace(strx, orgStr, newStr) {
                   1575:     return strx.split(orgStr).join(newStr);
                   1576:   }
                   1577: 
1.44      ng       1578:   function savedMsgHeader(Nmsg,usrctr,fullname) {
1.76      ng       1579:     var height = 70*Nmsg+250;
1.44      ng       1580:     var scrollbar = "no";
                   1581:     if (height > 600) {
                   1582: 	height = 600;
                   1583: 	scrollbar = "yes";
                   1584:     }
1.118     ng       1585:     var xpos = (screen.width-600)/2;
                   1586:     xpos = (xpos < 0) ? '0' : xpos;
                   1587:     var ypos = (screen.height-height)/2-30;
                   1588:     ypos = (ypos < 0) ? '0' : ypos;
                   1589: 
1.206     albertel 1590:     pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height);
1.76      ng       1591:     pWin.focus();
                   1592:     pDoc = pWin.document;
1.219     www      1593:     pDoc.$docopen;
1.351     albertel 1594:     pDoc.write('$start_page_msg_central');
1.76      ng       1595: 
                   1596:     pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">");
                   1597:     pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">");
1.465     albertel 1598:     pDoc.write("<h3><span class=\\"LC_info\\">&nbsp;Compose Message for \"+fullname+\"<\\/span><\\/h3><br /><br />");
1.76      ng       1599: 
1.564     bisitz   1600:     pDoc.write('<table border="0" width="100%"><tr><td bgcolor="#777777">');
                   1601:     pDoc.write('<table border="0" width="100%"><tr bgcolor="#DDFFFF">');
1.465     albertel 1602:     pDoc.write("<td><b>Type<\\/b><\\/td><td><b>Include<\\/b><\\/td><td><b>Message<\\/td><\\/tr>");
1.44      ng       1603: }
                   1604:     function displaySubject(msg,shwsel) {
1.76      ng       1605:     pDoc = pWin.document;
                   1606:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1607:     pDoc.write("<td>Subject<\\/td>");
                   1608:     pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1609:     pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"60\\" maxlength=\\"80\\"><\\/td><\\/tr>");
1.44      ng       1610: }
                   1611: 
1.72      ng       1612:   function displaySavedMsg(ctr,msg,shwsel) {
1.76      ng       1613:     pDoc = pWin.document;
                   1614:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1615:     pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>");
                   1616:     pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1617:     pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>");
1.44      ng       1618: }
                   1619: 
                   1620:   function newMsg(newmsg,shwsel) {
1.76      ng       1621:     pDoc = pWin.document;
                   1622:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1623:     pDoc.write("<td align=\\"center\\">New<\\/td>");
                   1624:     pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1625:     pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>");
1.44      ng       1626: }
                   1627: 
                   1628:   function msgTail() {
1.76      ng       1629:     pDoc = pWin.document;
1.465     albertel 1630:     pDoc.write("<\\/table>");
                   1631:     pDoc.write("<\\/td><\\/tr><\\/table>&nbsp;");
1.589     bisitz   1632:     pDoc.write("<input type=\\"button\\" value=\\"Save\\" onclick=\\"javascript:checkInput()\\">&nbsp;&nbsp;");
                   1633:     pDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onclick=\\"self.close()\\"><br /><br />");
1.465     albertel 1634:     pDoc.write("<\\/form>");
1.351     albertel 1635:     pDoc.write('$end_page_msg_central');
1.128     ng       1636:     pDoc.close();
1.44      ng       1637: }
                   1638: 
                   1639: //====================== Script for keyword highlight options ==============
                   1640:   function kwhighlight() {
                   1641:     var kwclr    = document.SCORE.kwclr.value;
                   1642:     var kwsize   = document.SCORE.kwsize.value;
                   1643:     var kwstyle  = document.SCORE.kwstyle.value;
                   1644:     var redsel = "";
                   1645:     var grnsel = "";
                   1646:     var blusel = "";
                   1647:     if (kwclr=="red")   {var redsel="checked"};
                   1648:     if (kwclr=="green") {var grnsel="checked"};
                   1649:     if (kwclr=="blue")  {var blusel="checked"};
                   1650:     var sznsel = "";
                   1651:     var sz1sel = "";
                   1652:     var sz2sel = "";
                   1653:     if (kwsize=="0")  {var sznsel="checked"};
                   1654:     if (kwsize=="+1") {var sz1sel="checked"};
                   1655:     if (kwsize=="+2") {var sz2sel="checked"};
                   1656:     var synsel = "";
                   1657:     var syisel = "";
                   1658:     var sybsel = "";
                   1659:     if (kwstyle=="")    {var synsel="checked"};
                   1660:     if (kwstyle=="<i>") {var syisel="checked"};
                   1661:     if (kwstyle=="<b>") {var sybsel="checked"};
                   1662:     highlightCentral();
                   1663:     highlightbody('red','red',redsel,'0','normal',sznsel,'','normal',synsel);
                   1664:     highlightbody('green','green',grnsel,'+1','+1',sz1sel,'<i>','italic',syisel);
                   1665:     highlightbody('blue','blue',blusel,'+2','+2',sz2sel,'<b>','bold',sybsel);
                   1666:     highlightend();
                   1667:     return;
                   1668:   }
                   1669: 
                   1670:   function highlightCentral() {
1.76      ng       1671: //    if (window.hwdWin) window.hwdWin.close();
1.118     ng       1672:     var xpos = (screen.width-400)/2;
                   1673:     xpos = (xpos < 0) ? '0' : xpos;
                   1674:     var ypos = (screen.height-330)/2-30;
                   1675:     ypos = (ypos < 0) ? '0' : ypos;
                   1676: 
1.206     albertel 1677:     hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos);
1.76      ng       1678:     hwdWin.focus();
                   1679:     var hDoc = hwdWin.document;
1.219     www      1680:     hDoc.$docopen;
1.351     albertel 1681:     hDoc.write('$start_page_highlight_central');
1.76      ng       1682:     hDoc.write("<form action=\\"inactive\\" name=\\"hlCenter\\">");
1.465     albertel 1683:     hDoc.write("<h3><span class=\\"LC_info\\">&nbsp;Keyword Highlight Options<\\/span><\\/h3><br /><br />");
1.76      ng       1684: 
1.564     bisitz   1685:     hDoc.write('<table border="0" width="100%"><tr><td bgcolor="#777777">');
                   1686:     hDoc.write('<table border="0" width="100%"><tr bgcolor="#DDFFFF">');
1.465     albertel 1687:     hDoc.write("<td><b>Text Color<\\/b><\\/td><td><b>Font Size<\\/b><\\/td><td><b>Font Style<\\/td><\\/tr>");
1.44      ng       1688:   }
                   1689: 
                   1690:   function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) { 
1.76      ng       1691:     var hDoc = hwdWin.document;
                   1692:     hDoc.write("<tr bgcolor=\\"#ffffdd\\">");
                   1693:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1694:     hDoc.write("<input name=\\"kwdclr\\" type=\\"radio\\" value=\\""+clrval+"\\" "+clrsel+">&nbsp;"+clrtxt+"<\\/td>");
1.76      ng       1695:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1696:     hDoc.write("<input name=\\"kwdsize\\" type=\\"radio\\" value=\\""+szval+"\\" "+szsel+">&nbsp;"+sztxt+"<\\/td>");
1.76      ng       1697:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1698:     hDoc.write("<input name=\\"kwdstyle\\" type=\\"radio\\" value=\\""+syval+"\\" "+sysel+">&nbsp;"+sytxt+"<\\/td>");
                   1699:     hDoc.write("<\\/tr>");
1.44      ng       1700:   }
                   1701: 
                   1702:   function highlightend() { 
1.76      ng       1703:     var hDoc = hwdWin.document;
1.465     albertel 1704:     hDoc.write("<\\/table>");
                   1705:     hDoc.write("<\\/td><\\/tr><\\/table>&nbsp;");
1.589     bisitz   1706:     hDoc.write("<input type=\\"button\\" value=\\"Save\\" onclick=\\"javascript:updateChoice(1)\\">&nbsp;&nbsp;");
                   1707:     hDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onclick=\\"self.close()\\"><br /><br />");
1.465     albertel 1708:     hDoc.write("<\\/form>");
1.351     albertel 1709:     hDoc.write('$end_page_highlight_central');
1.128     ng       1710:     hDoc.close();
1.44      ng       1711:   }
                   1712: 
                   1713: </script>
                   1714: SUBJAVASCRIPT
                   1715: }
                   1716: 
1.349     albertel 1717: sub get_increment {
1.348     bowersj2 1718:     my $increment = $env{'form.increment'};
                   1719:     if ($increment != 1 && $increment != .5 && $increment != .25 &&
                   1720:         $increment != .1) {
                   1721:         $increment = 1;
                   1722:     }
                   1723:     return $increment;
                   1724: }
                   1725: 
1.585     bisitz   1726: sub gradeBox_start {
                   1727:     return (
                   1728:         &Apache::loncommon::start_data_table()
                   1729:        .&Apache::loncommon::start_data_table_header_row()
                   1730:        .'<th>'.&mt('Part').'</th>'
                   1731:        .'<th>'.&mt('Points').'</th>'
                   1732:        .'<th>&nbsp;</th>'
                   1733:        .'<th>'.&mt('Assign Grade').'</th>'
                   1734:        .'<th>'.&mt('Weight').'</th>'
                   1735:        .'<th>'.&mt('Grade Status').'</th>'
                   1736:        .&Apache::loncommon::end_data_table_header_row()
                   1737:     );
                   1738: }
                   1739: 
                   1740: sub gradeBox_end {
                   1741:     return (
                   1742:         &Apache::loncommon::end_data_table()
                   1743:     );
                   1744: }
1.71      ng       1745: #--- displays the grading box, used in essay type problem and grading by page/sequence
                   1746: sub gradeBox {
1.322     albertel 1747:     my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_;
1.381     albertel 1748:     my $checkIcon = '<img alt="'.&mt('Check Mark').
1.485     albertel 1749: 	'" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />';
1.71      ng       1750:     my $wgt    = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
1.466     albertel 1751:     my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)') 
                   1752:                            : '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>';
1.71      ng       1753:     $wgt       = ($wgt > 0 ? $wgt : '1');
                   1754:     my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
1.320     albertel 1755: 		  '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
1.71      ng       1756:     my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
1.466     albertel 1757:     my $display_part= &get_display_part($partid,$symb);
1.270     albertel 1758:     my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
                   1759: 				       [$partid]);
                   1760:     my $aggtries = $$record{'resource.'.$partid.'.tries'};
1.269     raeburn  1761:     if ($last_resets{$partid}) {
                   1762:         $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
                   1763:     }
1.585     bisitz   1764:     $result.=&Apache::loncommon::start_data_table_row();
1.71      ng       1765:     my $ctr = 0;
1.348     bowersj2 1766:     my $thisweight = 0;
1.349     albertel 1767:     my $increment = &get_increment();
1.485     albertel 1768: 
                   1769:     my $radio.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across
1.348     bowersj2 1770:     while ($thisweight<=$wgt) {
1.532     bisitz   1771: 	$radio.= '<td><span class="LC_nobreak"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.
1.589     bisitz   1772:         'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.
1.348     bowersj2 1773: 	    $thisweight.')" value="'.$thisweight.'" '.
1.401     albertel 1774: 	    ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n";
1.485     albertel 1775: 	$radio.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');
1.348     bowersj2 1776:         $thisweight += $increment;
1.71      ng       1777: 	$ctr++;
                   1778:     }
1.485     albertel 1779:     $radio.='</tr></table>';
                   1780: 
                   1781:     my $line.='<input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'.
1.71      ng       1782: 	($score ne ''? ' value = "'.$score.'"':'').' size="4" '.
1.589     bisitz   1783: 	'onchange="javascript:updateRadio(this.form,\''.$counter.'_'.$partid.'\','.
1.71      ng       1784: 	$wgt.')" /></td>'."\n";
1.485     albertel 1785:     $line.='<td>/'.$wgt.' '.$wgtmsg.
1.71      ng       1786: 	($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? '&nbsp;'.$checkIcon : '').
1.585     bisitz   1787: 	' </td>'."\n";
                   1788:     $line.='<td><select name="GD_SEL'.$counter.'_'.$partid.'" '.
1.589     bisitz   1789: 	'onchange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n";
1.71      ng       1790:     if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {
1.485     albertel 1791: 	$line.='<option></option>'.
                   1792: 	    '<option value="excused" selected="selected">'.&mt('excused').'</option>';
1.71      ng       1793:     } else {
1.485     albertel 1794: 	$line.='<option selected="selected"></option>'.
                   1795: 	    '<option value="excused" >'.&mt('excused').'</option>';
1.71      ng       1796:     }
1.485     albertel 1797:     $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n";
                   1798: 
                   1799: 
1.540     riegler  1800: 	#&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);
1.485     albertel 1801:     $result .= 
1.585     bisitz   1802: 	    '<td>'.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>';
                   1803:     $result.=&Apache::loncommon::end_data_table_row();
1.71      ng       1804:     $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".
                   1805: 	'<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n".
                   1806: 	'<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'.
1.269     raeburn  1807: 	$$record{'resource.'.$partid.'.solved'}.'" />'."\n".
                   1808:         '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'.
                   1809:         $$record{'resource.'.$partid.'.tries'}.'" />'."\n".
                   1810:         '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'.
                   1811:         $aggtries.'" />'."\n";
1.582     raeburn  1812:     my $res_error;
                   1813:     $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record,\$res_error);
                   1814:     if ($res_error) {
                   1815:         return &navmap_errormsg();
                   1816:     }
1.318     banghart 1817:     return $result;
                   1818: }
1.322     albertel 1819: 
                   1820: sub handback_box {
1.582     raeburn  1821:     my ($symb,$uname,$udom,$counter,$partid,$record,$res_error) = @_;
                   1822:     my ($partlist,$handgrade,$responseType) = &response_type($symb,$res_error);
1.323     banghart 1823:     my (@respids);
1.375     albertel 1824:      my @part_response_id = &flatten_responseType($responseType);
                   1825:     foreach my $part_response_id (@part_response_id) {
                   1826:     	my ($part,$resp) = @{ $part_response_id };
1.323     banghart 1827:         if ($part eq $partid) {
1.375     albertel 1828:             push(@respids,$resp);
1.323     banghart 1829:         }
                   1830:     }
1.318     banghart 1831:     my $result;
1.323     banghart 1832:     foreach my $respid (@respids) {
1.322     albertel 1833: 	my $prefix = $counter.'_'.$partid.'_'.$respid.'_';
                   1834: 	my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record);
                   1835: 	next if (!@$files);
                   1836: 	my $file_counter = 1;
1.313     banghart 1837: 	foreach my $file (@$files) {
1.368     banghart 1838: 	    if ($file =~ /\/portfolio\//) {
                   1839:     	        my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|);
                   1840:     	        my ($name,$version,$ext) = &file_name_version_ext($file_disp);
                   1841:     	        $file_disp = "$name.$ext";
                   1842:     	        $file = $file_path.$file_disp;
                   1843:     	        $result.=&mt('Return commented version of [_1] to student.',
                   1844:     			 '<span class="LC_filename">'.$file_disp.'</span>');
                   1845:     	        $result.='<input type="file"   name="'.$prefix.'returndoc'.$file_counter.'" />'."\n";
                   1846:     	        $result.='<input type="hidden" name="'.$prefix.'origdoc'.$file_counter.'" value="'.$file.'" /><br />';
1.485     albertel 1847:     	        $result.='('.&mt('File will be uploaded when you click on Save &amp; Next below.').')<br />';
1.368     banghart 1848:     	        $file_counter++;
                   1849: 	    }
1.322     albertel 1850: 	}
1.313     banghart 1851:     }
1.318     banghart 1852:     return $result;    
1.71      ng       1853: }
1.44      ng       1854: 
1.58      albertel 1855: sub show_problem {
1.382     albertel 1856:     my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_;
1.144     albertel 1857:     my $rendered;
1.382     albertel 1858:     my %form = ((ref($form) eq 'HASH')? %{$form} : ());
1.329     albertel 1859:     &Apache::lonxml::remember_problem_counter();
1.144     albertel 1860:     if ($mode eq 'both' or $mode eq 'text') {
                   1861: 	$rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
1.382     albertel 1862: 						       $env{'request.course.id'},
                   1863: 						       undef,\%form);
1.144     albertel 1864:     }
1.58      albertel 1865:     if ($removeform) {
                   1866: 	$rendered=~s|<form(.*?)>||g;
                   1867: 	$rendered=~s|</form>||g;
1.374     albertel 1868: 	$rendered=~s|(<input[^>]*name\s*=\s*"?)(\w+)("?)|$1would_have_been_$2$3|g;
1.58      albertel 1869:     }
1.144     albertel 1870:     my $companswer;
                   1871:     if ($mode eq 'both' or $mode eq 'answer') {
1.329     albertel 1872: 	&Apache::lonxml::restore_problem_counter();
1.382     albertel 1873: 	$companswer=
                   1874: 	    &Apache::loncommon::get_student_answers($symb,$uname,$udom,
                   1875: 						    $env{'request.course.id'},
                   1876: 						    %form);
1.144     albertel 1877:     }
1.58      albertel 1878:     if ($removeform) {
                   1879: 	$companswer=~s|<form(.*?)>||g;
                   1880: 	$companswer=~s|</form>||g;
1.144     albertel 1881: 	$companswer=~s|name="submit"|name="would_have_been_submit"|g;
1.58      albertel 1882:     }
1.468     albertel 1883:     $rendered=
1.588     bisitz   1884:         '<div class="LC_Box">'
                   1885:        .'<h3 class="LC_hcell">'.&mt('View of the problem').'</h3>'
                   1886:        .$rendered
                   1887:        .'</div>';
1.468     albertel 1888:     $companswer=
1.588     bisitz   1889:         '<div class="LC_Box">'
                   1890:        .'<h3 class="LC_hcell">'.&mt('Correct answer').'</h3>'
                   1891:        .$companswer
                   1892:        .'</div>';
1.468     albertel 1893:     my $result;
1.144     albertel 1894:     if ($mode eq 'both') {
1.588     bisitz   1895:         $result=$rendered.$companswer;
1.144     albertel 1896:     } elsif ($mode eq 'text') {
1.588     bisitz   1897:         $result=$rendered;
1.144     albertel 1898:     } elsif ($mode eq 'answer') {
1.588     bisitz   1899:         $result=$companswer;
1.144     albertel 1900:     }
1.71      ng       1901:     return $result;
1.58      albertel 1902: }
1.397     albertel 1903: 
1.396     banghart 1904: sub files_exist {
                   1905:     my ($r, $symb) = @_;
                   1906:     my @students = &Apache::loncommon::get_env_multiple('form.stuinfo');
1.397     albertel 1907: 
1.396     banghart 1908:     foreach my $student (@students) {
                   1909:         my ($uname,$udom,$fullname) = split(/:/,$student);
1.397     albertel 1910:         my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
                   1911: 					      $udom,$uname);
1.396     banghart 1912:         my ($string,$timestamp)= &get_last_submission(\%record);
1.397     albertel 1913:         foreach my $submission (@$string) {
                   1914:             my ($partid,$respid) =
                   1915: 		($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
                   1916:             my $files=&get_submitted_files($udom,$uname,$partid,$respid,
                   1917: 					   \%record);
                   1918:             return 1 if (@$files);
1.396     banghart 1919:         }
                   1920:     }
1.397     albertel 1921:     return 0;
1.396     banghart 1922: }
1.397     albertel 1923: 
1.394     banghart 1924: sub download_all_link {
                   1925:     my ($r,$symb) = @_;
1.395     albertel 1926:     my $all_students = 
                   1927: 	join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo'));
                   1928: 
                   1929:     my $parts =
                   1930: 	join("\n",&Apache::loncommon::get_env_multiple('form.vPart'));
                   1931: 
1.394     banghart 1932:     my $identifier = &Apache::loncommon::get_cgi_id();
1.514     raeburn  1933:     &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students,
                   1934:                              'cgi.'.$identifier.'.symb' => $symb,
                   1935:                              'cgi.'.$identifier.'.parts' => $parts,});
1.395     albertel 1936:     $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'.
                   1937: 	      &mt('Download All Submitted Documents').'</a>');
1.394     banghart 1938:     return
                   1939: }
1.395     albertel 1940: 
1.432     banghart 1941: sub build_section_inputs {
                   1942:     my $section_inputs;
                   1943:     if ($env{'form.section'} eq '') {
                   1944:         $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n";
                   1945:     } else {
                   1946:         my @sections = &Apache::loncommon::get_env_multiple('form.section');
1.434     albertel 1947:         foreach my $section (@sections) {
1.432     banghart 1948:             $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n";
                   1949:         }
                   1950:     }
                   1951:     return $section_inputs;
                   1952: }
                   1953: 
1.44      ng       1954: # --------------------------- show submissions of a student, option to grade 
                   1955: sub submission {
                   1956:     my ($request,$counter,$total) = @_;
1.257     albertel 1957:     my ($uname,$udom)     = ($env{'form.student'},$env{'form.userdom'});
                   1958:     $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student?
                   1959:     my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
                   1960:     $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';
1.324     albertel 1961:     my $symb = &get_symb($request); 
                   1962:     if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
1.104     albertel 1963: 
                   1964:     if (!&canview($usec)) {
1.398     albertel 1965: 	$request->print('<span class="LC_warning">Unable to view requested student.('.
                   1966: 			$uname.':'.$udom.' in section '.$usec.' in course id '.
                   1967: 			$env{'request.course.id'}.')</span>');
1.324     albertel 1968: 	$request->print(&show_grading_menu_form($symb));
1.104     albertel 1969: 	return;
                   1970:     }
                   1971: 
1.257     albertel 1972:     if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; }
                   1973:     if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; }
                   1974:     if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; }
                   1975:     my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
1.381     albertel 1976:     my $checkIcon = '<img alt="'.&mt('Check Mark').
                   1977: 	'" src="'.$request->dir_config('lonIconsURL').
1.122     ng       1978: 	'/check.gif" height="16" border="0" />';
1.41      ng       1979: 
1.426     albertel 1980:     my %old_essays;
1.41      ng       1981:     # header info
                   1982:     if ($counter == 0) {
                   1983: 	&sub_page_js($request);
1.257     albertel 1984: 	&sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes');
                   1985: 	$env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 
                   1986: 	    &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
1.397     albertel 1987: 	if ($env{'form.handgrade'} eq 'yes' && &files_exist($request, $symb)) {
1.396     banghart 1988: 	    &download_all_link($request, $symb);
                   1989: 	}
1.485     albertel 1990: 	$request->print('<h3>&nbsp;<span class="LC_info">'.&mt('Submission Record').'</span></h3>'."\n".
                   1991: 			'<h4>&nbsp;'.&mt('<b>Resource: </b> [_1]',$env{'form.probTitle'}).'</h4>'."\n");
1.118     ng       1992: 
1.44      ng       1993: 	# option to display problem, only once else it cause problems 
                   1994:         # with the form later since the problem has a form.
1.257     albertel 1995: 	if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') {
1.144     albertel 1996: 	    my $mode;
1.257     albertel 1997: 	    if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') {
1.144     albertel 1998: 		$mode='both';
1.257     albertel 1999: 	    } elsif ($env{'form.vProb'} eq 'yes') {
1.144     albertel 2000: 		$mode='text';
1.257     albertel 2001: 	    } elsif ($env{'form.vAns'} eq 'yes') {
1.144     albertel 2002: 		$mode='answer';
                   2003: 	    }
1.329     albertel 2004: 	    &Apache::lonxml::clear_problem_counter();
1.144     albertel 2005: 	    $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));
1.41      ng       2006: 	}
1.441     www      2007: 
1.44      ng       2008: 	# kwclr is the only variable that is guaranteed to be non blank 
                   2009:         # if this subroutine has been called once.
1.41      ng       2010: 	my %keyhash = ();
1.257     albertel 2011: 	if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') {
1.41      ng       2012: 	    %keyhash = &Apache::lonnet::dump('nohist_handgrade',
1.257     albertel 2013: 					     $env{'course.'.$env{'request.course.id'}.'.domain'},
                   2014: 					     $env{'course.'.$env{'request.course.id'}.'.num'});
1.41      ng       2015: 
1.257     albertel 2016: 	    my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
                   2017: 	    $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : '';
                   2018: 	    $env{'form.kwclr'}    = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red';
                   2019: 	    $env{'form.kwsize'}   = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0';
                   2020: 	    $env{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
                   2021: 	    $env{'form.msgsub'}   = $keyhash{$symb.'_subject'} ne '' ? 
                   2022: 		$keyhash{$symb.'_subject'} : $env{'form.probTitle'};
                   2023: 	    $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0';
1.41      ng       2024: 	}
1.257     albertel 2025: 	my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'};
1.442     banghart 2026: 	my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.303     banghart 2027: 	$request->print('<form action="/adm/grades" method="post" name="SCORE" enctype="multipart/form-data">'."\n".
1.41      ng       2028: 			'<input type="hidden" name="command"    value="handgrade" />'."\n".
1.257     albertel 2029: 			'<input type="hidden" name="saveState"  value="'.$env{'form.saveState'}.'" />'."\n".
1.442     banghart 2030: 			'<input type="hidden" name="Status"     value="'.$stu_status.'" />'."\n".
1.120     ng       2031: 			'<input type="hidden" name="overRideScore" value="'.$overRideScore.'" />'."\n".
1.257     albertel 2032: 			'<input type="hidden" name="probTitle"  value="'.$env{'form.probTitle'}.'" />'."\n".
1.41      ng       2033: 			'<input type="hidden" name="refresh"    value="off" />'."\n".
1.120     ng       2034: 			'<input type="hidden" name="studentNo"  value="" />'."\n".
                   2035: 			'<input type="hidden" name="gradeOpt"   value="" />'."\n".
1.418     albertel 2036: 			'<input type="hidden" name="symb"       value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 2037: 			'<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" />'."\n".
                   2038: 			'<input type="hidden" name="vProb"      value="'.$env{'form.vProb'}.'" />'."\n".
                   2039: 			'<input type="hidden" name="vAns"       value="'.$env{'form.vAns'}.'" />'."\n".
                   2040: 			'<input type="hidden" name="lastSub"    value="'.$env{'form.lastSub'}.'" />'."\n".
1.432     banghart 2041: 			&build_section_inputs().
1.326     albertel 2042: 			'<input type="hidden" name="submitonly" value="'.$env{'form.submitonly'}.'" />'."\n".
                   2043: 			'<input type="hidden" name="handgrade"  value="'.$env{'form.handgrade'}.'" />'."\n".
1.41      ng       2044: 			'<input type="hidden" name="NCT"'.
1.257     albertel 2045: 			' value="'.($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : $total+1).'" />'."\n");
                   2046: 	if ($env{'form.handgrade'} eq 'yes') {
                   2047: 	    $request->print('<input type="hidden" name="keywords" value="'.$env{'form.keywords'}.'" />'."\n".
                   2048: 			    '<input type="hidden" name="kwclr"    value="'.$env{'form.kwclr'}.'" />'."\n".
                   2049: 			    '<input type="hidden" name="kwsize"   value="'.$env{'form.kwsize'}.'" />'."\n".
                   2050: 			    '<input type="hidden" name="kwstyle"  value="'.$env{'form.kwstyle'}.'" />'."\n".
                   2051: 			    '<input type="hidden" name="msgsub"   value="'.$env{'form.msgsub'}.'" />'."\n".
1.123     ng       2052: 			    '<input type="hidden" name="shownSub" value="0" />'."\n".
1.257     albertel 2053: 			    '<input type="hidden" name="savemsgN" value="'.$env{'form.savemsgN'}.'" />'."\n");
1.154     albertel 2054: 	    foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) {
                   2055: 		$request->print('<input type="hidden" name="vPart" value="'.$partid.'" />'."\n");
                   2056: 	    }
1.123     ng       2057: 	}
1.41      ng       2058: 	
                   2059: 	my ($cts,$prnmsg) = (1,'');
1.257     albertel 2060: 	while ($cts <= $env{'form.savemsgN'}) {
1.41      ng       2061: 	    $prnmsg.='<input type="hidden" name="savemsg'.$cts.'" value="'.
1.123     ng       2062: 		(!exists($keyhash{$symb.'_savemsg'.$cts}) ? 
1.257     albertel 2063: 		 &Apache::lonfeedback::clear_out_html($env{'form.savemsg'.$cts}) :
1.80      ng       2064: 		 &Apache::lonfeedback::clear_out_html($keyhash{$symb.'_savemsg'.$cts})).
1.123     ng       2065: 		'" />'."\n".
                   2066: 		'<input type="hidden" name="shownOnce'.$cts.'" value="0" />'."\n";
1.41      ng       2067: 	    $cts++;
                   2068: 	}
                   2069: 	$request->print($prnmsg);
1.32      ng       2070: 
1.257     albertel 2071: 	if ($env{'form.handgrade'} eq 'yes' && $env{'form.showgrading'} eq 'yes') {
1.88      www      2072: #
                   2073: # Print out the keyword options line
                   2074: #
1.41      ng       2075: 	    $request->print(<<KEYWORDS);
1.38      ng       2076: &nbsp;<b>Keyword Options:</b>&nbsp;
1.417     albertel 2077: <a href="javascript:keywords(document.SCORE);" target="_self">List</a>&nbsp; &nbsp;
1.589     bisitz   2078: <a href="#" onmousedown="javascript:getSel(); return false"
1.38      ng       2079:  CLASS="page">Paste Selection to List</a>&nbsp; &nbsp;
1.417     albertel 2080: <a href="javascript:kwhighlight();" target="_self">Highlight Attribute</a><br /><br />
1.38      ng       2081: KEYWORDS
1.88      www      2082: #
                   2083: # Load the other essays for similarity check
                   2084: #
1.324     albertel 2085:             my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb);
1.384     albertel 2086: 	    my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
1.359     www      2087: 	    $apath=&escape($apath);
1.88      www      2088: 	    $apath=~s/\W/\_/gs;
1.426     albertel 2089: 	    %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);
1.41      ng       2090:         }
                   2091:     }
1.44      ng       2092: 
1.441     www      2093: # This is where output for one specific student would start
1.592     bisitz   2094:     my $add_class = ($counter%2) ? ' LC_grade_show_user_odd_row' : '';
                   2095:     $request->print(
                   2096:         "\n\n"
                   2097:        .'<div class="LC_grade_show_user'.$add_class.'">'
                   2098:        .'<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).'</h2>'
                   2099:        ."\n"
                   2100:     );
1.441     www      2101: 
1.592     bisitz   2102:     # Show additional functions if allowed
                   2103:     if ($perm{'vgr'}) {
                   2104:         $request->print(
                   2105:             &Apache::loncommon::track_student_link(
                   2106:                 &mt('View recent activity'),
                   2107:                 $uname,$udom,'check')
                   2108:            .' '
                   2109:         );
                   2110:     }
                   2111:     if ($perm{'opa'}) {
                   2112:         $request->print(
                   2113:             &Apache::loncommon::pprmlink(
                   2114:                 &mt('Set/Change parameters'),
                   2115:                 $uname,$udom,$symb,'check'));
                   2116:     }
                   2117: 
                   2118:     # Show Problem
1.257     albertel 2119:     if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') {
1.144     albertel 2120: 	my $mode;
1.257     albertel 2121: 	if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') {
1.144     albertel 2122: 	    $mode='both';
1.257     albertel 2123: 	} elsif ($env{'form.vProb'} eq 'all' ) {
1.144     albertel 2124: 	    $mode='text';
1.257     albertel 2125: 	} elsif ($env{'form.vAns'} eq 'all') {
1.144     albertel 2126: 	    $mode='answer';
                   2127: 	}
1.329     albertel 2128: 	&Apache::lonxml::clear_problem_counter();
1.475     albertel 2129: 	$request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode,{'request.prefix' => 'ctr'.$counter}));
1.58      albertel 2130:     }
1.144     albertel 2131: 
1.257     albertel 2132:     my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.582     raeburn  2133:     my $res_error;
                   2134:     my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error);
                   2135:     if ($res_error) {
                   2136:         $request->print(&navmap_errormsg());
                   2137:         return;
                   2138:     }
1.41      ng       2139: 
1.44      ng       2140:     # Display student info
1.41      ng       2141:     $request->print(($counter == 0 ? '' : '<br />'));
1.590     bisitz   2142: 
                   2143:     my $result='<div class="LC_Box">'
                   2144:               .'<h3 class="LC_hcell">'.&mt('Submissions').'</h3>';
1.45      ng       2145:     $result.='<input type="hidden" name="name'.$counter.
1.588     bisitz   2146:              '" value="'.$env{'form.fullname'}.'" />'."\n";
1.469     albertel 2147:     if ($env{'form.handgrade'} eq 'no') {
1.588     bisitz   2148:         $result.='<p class="LC_info">'
                   2149:                 .&mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon)
                   2150:                 ."</p>\n";
1.469     albertel 2151:     }
                   2152: 
1.118     ng       2153:     # If any part of the problem is an essay-response (handgraded), then check for collaborators
1.464     albertel 2154:     my $fullname;
                   2155:     my $col_fullnames = [];
1.257     albertel 2156:     if ($env{'form.handgrade'} eq 'yes') {
1.464     albertel 2157: 	(my $sub_result,$fullname,$col_fullnames)=
                   2158: 	    &check_collaborators($symb,$uname,$udom,\%record,$handgrade,
                   2159: 				 $counter);
                   2160: 	$result.=$sub_result;
1.41      ng       2161:     }
1.44      ng       2162:     $request->print($result."\n");
1.588     bisitz   2163: 
1.44      ng       2164:     # print student answer/submission
1.588     bisitz   2165:     # Options are (1) Handgraded submission only
1.44      ng       2166:     #             (2) Last submission, includes submission that is not handgraded 
                   2167:     #                  (for multi-response type part)
                   2168:     #             (3) Last submission plus the parts info
                   2169:     #             (4) The whole record for this student
1.257     albertel 2170:     if ($env{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) {
1.151     albertel 2171: 	my ($string,$timestamp)= &get_last_submission(\%record);
1.468     albertel 2172: 	
                   2173: 	my $lastsubonly;
                   2174: 
1.588     bisitz   2175:         if ($$timestamp eq '') {
                   2176:             $lastsubonly.='<div class="LC_grade_submissions_body">'.$$string[0].'</div>'; 
                   2177:         } else {
1.592     bisitz   2178:             $lastsubonly =
                   2179:                 '<div class="LC_grade_submissions_body">'
                   2180:                .'<b>'.&mt('Date Submitted:').'</b> '.$$timestamp."\n";
1.468     albertel 2181: 
1.151     albertel 2182: 	    my %seenparts;
1.375     albertel 2183: 	    my @part_response_id = &flatten_responseType($responseType);
                   2184: 	    foreach my $part (@part_response_id) {
1.393     albertel 2185: 		next if ($env{'form.lastSub'} eq 'hdgrade' 
                   2186: 			 && $$handgrade{$$part[0].'_'.$$part[1]} ne 'yes');
                   2187: 
1.375     albertel 2188: 		my ($partid,$respid) = @{ $part };
1.324     albertel 2189: 		my $display_part=&get_display_part($partid,$symb);
1.257     albertel 2190: 		if ($env{"form.$uname:$udom:$partid:submitted_by"}) {
1.151     albertel 2191: 		    if (exists($seenparts{$partid})) { next; }
                   2192: 		    $seenparts{$partid}=1;
1.207     albertel 2193: 		    my $submitby='<b>Part:</b> '.$display_part.
                   2194: 			' <b>Collaborative submission by:</b> '.
1.151     albertel 2195: 			'<a href="javascript:viewSubmitter(\''.
1.257     albertel 2196: 			$env{"form.$uname:$udom:$partid:submitted_by"}.
1.417     albertel 2197: 			'\');" target="_self">'.
1.257     albertel 2198: 			$$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />';
1.151     albertel 2199: 		    $request->print($submitby);
                   2200: 		    next;
                   2201: 		}
                   2202: 		my $responsetype = $responseType->{$partid}->{$respid};
                   2203: 		if (!exists($record{"resource.$partid.$respid.submission"})) {
1.577     bisitz   2204:                     $lastsubonly.="\n".'<div class="LC_grade_submission_part">'.
                   2205:                         '<b>'.&mt('Part: [_1]',$display_part).'</b>'.
                   2206:                         ' <span class="LC_internal_info">'.
                   2207:                         '('.&mt('Part ID: [_1]',$respid).')</b>'.
                   2208:                         '</span>&nbsp; &nbsp;'.
1.539     riegler  2209: 			'<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br /><br /></div>';
1.151     albertel 2210: 		    next;
                   2211: 		}
1.468     albertel 2212: 		foreach my $submission (@$string) {
                   2213: 		    my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
1.375     albertel 2214: 		    if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; }
1.596     raeburn  2215: 		    my ($ressub,$hide,$subval) = split(/:/,$submission,3);
1.151     albertel 2216: 		    # Similarity check
                   2217: 		    my $similar='';
1.257     albertel 2218: 		    if($env{'form.checkPlag'}){
1.151     albertel 2219: 			my ($oname,$odom,$ocrsid,$oessay,$osim)=
1.426     albertel 2220: 			    &most_similar($uname,$udom,$subval,\%old_essays);
1.151     albertel 2221: 			if ($osim) {
                   2222: 			    $osim=int($osim*100.0);
1.426     albertel 2223: 			    my %old_course_desc = 
                   2224: 				&Apache::lonnet::coursedescription($ocrsid,
                   2225: 								   {'one_time' => 1});
                   2226: 
1.596     raeburn  2227:                             if ($hide) {
                   2228:                                 $similar='<hr /><span class="LC_warning">'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'<br />'.
                   2229:                                          &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />';
                   2230:                             } else {
                   2231: 			        $similar="<hr /><h3><span class=\"LC_warning\">".
                   2232: 				    &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])',
                   2233: 				        $osim,
                   2234: 				        &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')',
                   2235: 				        $old_course_desc{'description'},
                   2236: 				        $old_course_desc{'num'},
                   2237: 				        $old_course_desc{'domain'}).
                   2238: 				    '</span></h3><blockquote><i>'.
                   2239: 				    &keywords_highlight($oessay).
                   2240: 				    '</i></blockquote><hr />';
                   2241:                             }
1.151     albertel 2242: 			}
1.150     albertel 2243: 		    }
1.151     albertel 2244: 		    my $order=&get_order($partid,$respid,$symb,$uname,$udom);
1.257     albertel 2245: 		    if ($env{'form.lastSub'} eq 'lastonly' || 
                   2246: 			($env{'form.lastSub'} eq 'hdgrade' && 
1.377     albertel 2247: 			 $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) {
1.324     albertel 2248: 			my $display_part=&get_display_part($partid,$symb);
1.577     bisitz   2249:                         $lastsubonly.='<div class="LC_grade_submission_part">'.
                   2250:                             '<b>'.&mt('Part: [_1]',$display_part).'</b>'.
                   2251:                             ' <span class="LC_internal_info">'.
                   2252:                             '('.&mt('Part ID: [_1]',$respid).')'.
                   2253:                             '</b></span>&nbsp; &nbsp;';
1.313     banghart 2254: 			my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);
                   2255: 			if (@$files) {
1.596     raeburn  2256:                             if ($hide) {
                   2257:                                 $lastsubonly.='<br />'.&mt('[quant,_1,file] uploaded to this anonymous survey',scalar(@{$files}));
                   2258:                             } else {
                   2259:                                 $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain viruses').'</span><br />';
                   2260:                                 foreach my $file (@$files) {
                   2261:                                     &Apache::lonnet::allowuploaded('/adm/grades',$file);
                   2262:                                     $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" /> '.$file.'</a>';
                   2263:                                 }
                   2264:                             }
1.236     albertel 2265: 			    $lastsubonly.='<br />';
1.41      ng       2266: 			}
1.596     raeburn  2267:                         if ($hide) {
                   2268:                             $lastsubonly.='<b>'.&mt('Anonymous Survey').'</b>'; 
                   2269:                         } else {
                   2270: 			    $lastsubonly.='<b>'.&mt('Submitted Answer:').' </b>'.
                   2271: 			        &cleanRecord($subval,$responsetype,$symb,$partid,
                   2272: 					     $respid,\%record,$order,undef,$uname,$udom);
                   2273:                         }
1.151     albertel 2274: 			if ($similar) {$lastsubonly.="<br /><br />$similar\n";}
1.468     albertel 2275: 			$lastsubonly.='</div>';
1.41      ng       2276: 		    }
                   2277: 		}
                   2278: 	    }
1.588     bisitz   2279: 	    $lastsubonly.='</div>'."\n"; # End: LC_grade_submissions_body
1.151     albertel 2280: 	}
                   2281: 	$request->print($lastsubonly);
1.468     albertel 2282:    } elsif ($env{'form.lastSub'} eq 'datesub') {
1.324     albertel 2283: 	my (undef,$responseType,undef,$parts) = &showResourceInfo($symb);
1.148     albertel 2284: 	$request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom));
1.257     albertel 2285:     } elsif ($env{'form.lastSub'} =~ /^(last|all)$/) {
1.41      ng       2286: 	$request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
1.257     albertel 2287: 								 $env{'request.course.id'},
1.44      ng       2288: 								 $last,'.submission',
                   2289: 								 'Apache::grades::keywords_highlight'));
1.41      ng       2290:     }
1.120     ng       2291: 
1.121     ng       2292:     $request->print('<input type="hidden" name="unamedom'.$counter.'" value="'.$uname.':'
                   2293: 	.$udom.'" />'."\n");
1.44      ng       2294:     # return if view submission with no grading option
1.257     albertel 2295:     if ($env{'form.showgrading'} eq '' || (!&canmodify($usec))) {
1.120     ng       2296: 	my $toGrade.='<input type="button" value="Grade Student" '.
1.589     bisitz   2297: 	    'onclick="javascript:checksubmit(this.form,\'Grade Student\',\''
1.417     albertel 2298: 	    .$counter.'\');" target="_self" /> &nbsp;'."\n" if (&canmodify($usec));
1.468     albertel 2299: 	$toGrade.='</div>'."\n";
1.257     albertel 2300: 	if (($env{'form.command'} eq 'submission') || 
                   2301: 	    ($env{'form.command'} eq 'processGroup' && $counter == $total)) {
1.324     albertel 2302: 	    $toGrade.='</form>'.&show_grading_menu_form($symb); 
1.169     albertel 2303: 	}
1.180     albertel 2304: 	$request->print($toGrade);
1.41      ng       2305: 	return;
1.180     albertel 2306:     } else {
1.468     albertel 2307: 	$request->print('</div>'."\n");
1.41      ng       2308:     }
1.33      ng       2309: 
1.121     ng       2310:     # essay grading message center
1.257     albertel 2311:     if ($env{'form.handgrade'} eq 'yes') {
1.468     albertel 2312: 	my $result='<div class="LC_grade_message_center">';
                   2313:     
                   2314: 	$result.='<div class="LC_grade_message_center_header">'.
                   2315: 	    &mt('Send Message').'</div><div class="LC_grade_message_center_body">';
1.257     albertel 2316: 	my ($lastname,$givenn) = split(/,/,$env{'form.fullname'});
1.118     ng       2317: 	my $msgfor = $givenn.' '.$lastname;
1.464     albertel 2318: 	if (scalar(@$col_fullnames) > 0) {
                   2319: 	    my $lastone = pop(@$col_fullnames);
                   2320: 	    $msgfor .= ', '.(join ', ',@$col_fullnames).' and '.$lastone.'.';
1.118     ng       2321: 	}
                   2322: 	$msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript
1.468     albertel 2323: 	$result.='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n".
1.121     ng       2324: 	    '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n";
                   2325: 	$result.='&nbsp;<a href="javascript:msgCenter(document.SCORE,'.$counter.
1.417     albertel 2326: 	    ',\''.$msgfor.'\');" target="_self">'.
1.464     albertel 2327: 	    &mt('Compose message to student').(scalar(@$col_fullnames) >= 1 ? 's' : '').'</a><label> ('.
1.350     albertel 2328: 	    &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'.
1.118     ng       2329: 	    '<img src="'.$request->dir_config('lonIconsURL').
                   2330: 	    '/mailbkgrd.gif" width="14" height="10" name="mailicon'.$counter.'" />'."\n".
1.298     www      2331: 	    '<br />&nbsp;('.
1.468     albertel 2332: 	    &mt('Message will be sent when you click on Save &amp; Next below.').")\n";
                   2333: 	$result.='</div></div>';
1.121     ng       2334: 	$request->print($result);
1.118     ng       2335:     }
1.41      ng       2336: 
                   2337:     my %seen = ();
                   2338:     my @partlist;
1.129     ng       2339:     my @gradePartRespid;
1.375     albertel 2340:     my @part_response_id = &flatten_responseType($responseType);
1.585     bisitz   2341:     $request->print(
1.588     bisitz   2342:         '<div class="LC_Box">'
                   2343:        .'<h3 class="LC_hcell">'.&mt('Assign Grades').'</h3>'
1.585     bisitz   2344:     );
1.592     bisitz   2345:     $request->print(&gradeBox_start());
1.375     albertel 2346:     foreach my $part_response_id (@part_response_id) {
                   2347:     	my ($partid,$respid) = @{ $part_response_id };
                   2348: 	my $part_resp = join('_',@{ $part_response_id });
1.322     albertel 2349: 	next if ($seen{$partid} > 0);
1.41      ng       2350: 	$seen{$partid}++;
1.393     albertel 2351: 	next if ($$handgrade{$part_resp} ne 'yes' 
                   2352: 		 && $env{'form.lastSub'} eq 'hdgrade');
1.524     raeburn  2353: 	push(@partlist,$partid);
                   2354: 	push(@gradePartRespid,$partid.'.'.$respid);
1.322     albertel 2355: 	$request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
1.41      ng       2356:     }
1.585     bisitz   2357:     $request->print(&gradeBox_end()); # </div>
                   2358:     $request->print('</div>');
1.468     albertel 2359: 
                   2360:     $request->print('<div class="LC_grade_info_links">');
                   2361:     $request->print('</div>');
                   2362: 
1.45      ng       2363:     $result='<input type="hidden" name="partlist'.$counter.
                   2364: 	'" value="'.(join ":",@partlist).'" />'."\n";
1.129     ng       2365:     $result.='<input type="hidden" name="gradePartRespid'.
                   2366: 	'" value="'.(join ":",@gradePartRespid).'" />'."\n" if ($counter == 0);
1.45      ng       2367:     my $ctr = 0;
                   2368:     while ($ctr < scalar(@partlist)) {
                   2369: 	$result.='<input type="hidden" name="partid'.$counter.'_'.$ctr.'" value="'.
                   2370: 	    $partlist[$ctr].'" />'."\n";
                   2371: 	$ctr++;
                   2372:     }
1.468     albertel 2373:     $request->print($result.''."\n");
1.41      ng       2374: 
1.441     www      2375: # Done with printing info for one student
                   2376: 
1.468     albertel 2377:     $request->print('</div>');#LC_grade_show_user
1.441     www      2378: 
                   2379: 
1.41      ng       2380:     # print end of form
                   2381:     if ($counter == $total) {
1.592     bisitz   2382:         my $endform='<br /><hr /><table border="0"><tr><td>'."\n";
1.485     albertel 2383: 	$endform.='<input type="button" value="'.&mt('Save &amp; Next').'" '.
1.589     bisitz   2384: 	    'onclick="javascript:checksubmit(this.form,\'Save & Next\','.
1.417     albertel 2385: 	    $total.','.scalar(@partlist).');" target="_self" /> &nbsp;'."\n";
1.119     ng       2386: 	my $ntstu ='<select name="NTSTU">'.
                   2387: 	    '<option>1</option><option>2</option>'.
                   2388: 	    '<option>3</option><option>5</option>'.
                   2389: 	    '<option>7</option><option>10</option></select>'."\n";
1.257     albertel 2390: 	my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1');
1.401     albertel 2391: 	$ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</;
1.578     raeburn  2392:         $endform.=&mt('[_1]student(s)',$ntstu);
1.485     albertel 2393: 	$endform.='&nbsp;&nbsp;<input type="button" value="'.&mt('Previous').'" '.
1.589     bisitz   2394: 	    'onclick="javascript:checksubmit(this.form,\'Previous\');" target="_self" /> &nbsp;'."\n".
1.485     albertel 2395: 	    '<input type="button" value="'.&mt('Next').'" '.
1.589     bisitz   2396: 	    'onclick="javascript:checksubmit(this.form,\'Next\');" target="_self" /> &nbsp;';
1.592     bisitz   2397:         $endform.='<span class="LC_warning">'.
                   2398:                   &mt('(Next and Previous (student) do not save the scores.)').
                   2399:                   '</span>'."\n" ;
1.349     albertel 2400:         $endform.="<input type='hidden' value='".&get_increment().
1.348     bowersj2 2401:             "' name='increment' />";
1.485     albertel 2402: 	$endform.='</td></tr></table></form>';
1.324     albertel 2403: 	$endform.=&show_grading_menu_form($symb);
1.41      ng       2404: 	$request->print($endform);
                   2405:     }
                   2406:     return '';
1.38      ng       2407: }
                   2408: 
1.464     albertel 2409: sub check_collaborators {
                   2410:     my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_;
                   2411:     my ($result,@col_fullnames);
                   2412:     my ($classlist,undef,$fullname) = &getclasslist('all','0');
                   2413:     foreach my $part (keys(%$handgrade)) {
                   2414: 	my $ncol = &Apache::lonnet::EXT('resource.'.$part.
                   2415: 					'.maxcollaborators',
                   2416: 					$symb,$udom,$uname);
                   2417: 	next if ($ncol <= 0);
                   2418: 	$part =~ s/\_/\./g;
                   2419: 	next if ($record->{'resource.'.$part.'.collaborators'} eq '');
                   2420: 	my (@good_collaborators, @bad_collaborators);
                   2421: 	foreach my $possible_collaborator
                   2422: 	    (split(/,?\s+/,$record->{'resource.'.$part.'.collaborators'})) { 
                   2423: 	    $possible_collaborator =~ s/[\$\^\(\)]//g;
                   2424: 	    next if ($possible_collaborator eq '');
                   2425: 	    my ($co_name,$co_dom) = split(/\@|:/,$possible_collaborator);
                   2426: 	    $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i);
                   2427: 	    next if ($co_name eq $uname && $co_dom eq $udom);
                   2428: 	    # Doing this grep allows 'fuzzy' specification
                   2429: 	    my @matches = grep(/^\Q$co_name\E:\Q$co_dom\E$/i, 
                   2430: 			       keys(%$classlist));
                   2431: 	    if (! scalar(@matches)) {
                   2432: 		push(@bad_collaborators, $possible_collaborator);
                   2433: 	    } else {
                   2434: 		push(@good_collaborators, @matches);
                   2435: 	    }
                   2436: 	}
                   2437: 	if (scalar(@good_collaborators) != 0) {
1.466     albertel 2438: 	    $result.='<br />'.&mt('Collaborators: ');
1.464     albertel 2439: 	    foreach my $name (@good_collaborators) {
                   2440: 		my ($lastname,$givenn) = split(/,/,$$fullname{$name});
                   2441: 		push(@col_fullnames, $givenn.' '.$lastname);
                   2442: 		$result.=$fullname->{$name}.'&nbsp; &nbsp; &nbsp;';
                   2443: 	    }
                   2444: 	    $result.='<br />'."\n";
1.466     albertel 2445: 	    my ($part)=split(/\./,$part);
1.464     albertel 2446: 	    $result.='<input type="hidden" name="collaborator'.$counter.
                   2447: 		'" value="'.$part.':'.(join ':',@good_collaborators).'" />'.
                   2448: 		"\n";
                   2449: 	}
                   2450: 	if (scalar(@bad_collaborators) > 0) {
1.466     albertel 2451: 	    $result.='<div class="LC_warning">';
1.464     albertel 2452: 	    $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators));
                   2453: 	    $result .= '</div>';
                   2454: 	}         
                   2455: 	if (scalar(@bad_collaborators > $ncol)) {
1.466     albertel 2456: 	    $result .= '<div class="LC_warning">';
1.464     albertel 2457: 	    $result .= &mt('This student has submitted too many '.
                   2458: 		'collaborators.  Maximum is [_1].',$ncol);
                   2459: 	    $result .= '</div>';
                   2460: 	}
                   2461:     }
                   2462:     return ($result,$fullname,\@col_fullnames);
                   2463: }
                   2464: 
1.44      ng       2465: #--- Retrieve the last submission for all the parts
1.38      ng       2466: sub get_last_submission {
1.119     ng       2467:     my ($returnhash)=@_;
1.596     raeburn  2468:     my (@string,$timestamp,%lasthidden);
1.119     ng       2469:     if ($$returnhash{'version'}) {
1.46      ng       2470: 	my %lasthash=();
                   2471: 	my ($version);
1.119     ng       2472: 	for ($version=1;$version<=$$returnhash{'version'};$version++) {
1.397     albertel 2473: 	    foreach my $key (sort(split(/\:/,
                   2474: 					$$returnhash{$version.':keys'}))) {
                   2475: 		$lasthash{$key}=$$returnhash{$version.':'.$key};
                   2476: 		$timestamp = 
1.545     raeburn  2477: 		    &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'});
1.46      ng       2478: 	    }
                   2479: 	}
1.596     raeburn  2480:         my %typeparts;
                   2481:         my $showsurv = 
                   2482:             &Apache::lonnet::allowed('vas',$env{'request.course.id'});
                   2483:         foreach my $key (sort(keys(%lasthash))) {
                   2484:             if ($key =~ /\.type$/) {
                   2485:                 if (($lasthash{$key} eq 'anonsurvey') || 
                   2486:                     ($lasthash{$key} eq 'anonsurveycred')) {
                   2487:                     my ($ign,@parts) = split(/\./,$key);
                   2488:                     pop(@parts);
                   2489:                     unless ($showsurv) {
                   2490:                         my $id = join(',',@parts);
                   2491:                         $typeparts{$ign.'.'.$id} = $lasthash{$key};
                   2492:                     }
                   2493:                     delete($lasthash{$key});
                   2494:                 }
                   2495:             }
                   2496:         }
                   2497:         my @hidden = keys(%typeparts);
1.397     albertel 2498: 	foreach my $key (keys(%lasthash)) {
                   2499: 	    next if ($key !~ /\.submission$/);
1.596     raeburn  2500:             my $hide;
                   2501:             if (@hidden) {
                   2502:                 foreach my $id (@hidden) {
                   2503:                     if ($key =~ /^\Q$id\E/) {
                   2504:                         $hide = 1;
                   2505:                         last;
                   2506:                     }
                   2507:                 }
                   2508:             }
1.397     albertel 2509: 	    my ($partid,$foo) = split(/submission$/,$key);
                   2510: 	    my $draft  = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?
1.398     albertel 2511: 		'<span class="LC_warning">Draft Copy</span> ' : '';
1.596     raeburn  2512: 	    push(@string, join(':', $key, $hide, $draft.$lasthash{$key}));
1.41      ng       2513: 	}
                   2514:     }
1.397     albertel 2515:     if (!@string) {
                   2516: 	$string[0] =
1.539     riegler  2517: 	    '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span>';
1.397     albertel 2518:     }
                   2519:     return (\@string,\$timestamp);
1.38      ng       2520: }
1.35      ng       2521: 
1.44      ng       2522: #--- High light keywords, with style choosen by user.
1.38      ng       2523: sub keywords_highlight {
1.44      ng       2524:     my $string    = shift;
1.257     albertel 2525:     my $size      = $env{'form.kwsize'} eq '0' ? '' : 'size='.$env{'form.kwsize'};
                   2526:     my $styleon   = $env{'form.kwstyle'} eq ''  ? '' : $env{'form.kwstyle'};
1.41      ng       2527:     (my $styleoff = $styleon) =~ s/\</\<\//;
1.257     albertel 2528:     my @keylist   = split(/[,\s+]/,$env{'form.keywords'});
1.398     albertel 2529:     foreach my $keyword (@keylist) {
                   2530: 	$string =~ s/\b\Q$keyword\E(\b|\.)/<font color\=$env{'form.kwclr'} $size\>$styleon$keyword$styleoff<\/font>/gi;
1.41      ng       2531:     }
                   2532:     return $string;
1.38      ng       2533: }
1.36      ng       2534: 
1.44      ng       2535: #--- Called from submission routine
1.38      ng       2536: sub processHandGrade {
1.41      ng       2537:     my ($request) = shift;
1.324     albertel 2538:     my $symb   = &get_symb($request);
                   2539:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.257     albertel 2540:     my $button = $env{'form.gradeOpt'};
                   2541:     my $ngrade = $env{'form.NCT'};
                   2542:     my $ntstu  = $env{'form.NTSTU'};
1.301     albertel 2543:     my $cdom   = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2544:     my $cnum   = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2545: 
1.44      ng       2546:     if ($button eq 'Save & Next') {
                   2547: 	my $ctr = 0;
                   2548: 	while ($ctr < $ngrade) {
1.257     albertel 2549: 	    my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr});
1.324     albertel 2550: 	    my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$symb,$uname,$udom,$ctr);
1.71      ng       2551: 	    if ($errorflag eq 'no_score') {
                   2552: 		$ctr++;
                   2553: 		next;
                   2554: 	    }
1.104     albertel 2555: 	    if ($errorflag eq 'not_allowed') {
1.398     albertel 2556: 		$request->print("<span class=\"LC_warning\">Not allowed to modify grades for $uname:$udom</span>");
1.104     albertel 2557: 		$ctr++;
                   2558: 		next;
                   2559: 	    }
1.257     albertel 2560: 	    my $includemsg = $env{'form.includemsg'.$ctr};
1.44      ng       2561: 	    my ($subject,$message,$msgstatus) = ('','','');
1.418     albertel 2562: 	    my $restitle = &Apache::lonnet::gettitle($symb);
                   2563:             my ($feedurl,$showsymb) =
                   2564: 		&get_feedurl_and_symb($symb,$uname,$udom);
                   2565: 	    my $messagetail;
1.62      albertel 2566: 	    if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
1.298     www      2567: 		$subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/);
1.295     www      2568: 		unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); }
1.386     raeburn  2569: 		$subject.=' ['.$restitle.']';
1.44      ng       2570: 		my (@msgnum) = split(/,/,$includemsg);
                   2571: 		foreach (@msgnum) {
1.257     albertel 2572: 		    $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne '');
1.44      ng       2573: 		}
1.80      ng       2574: 		$message =&Apache::lonfeedback::clear_out_html($message);
1.298     www      2575: 		if ($env{'form.withgrades'.$ctr}) {
                   2576: 		    $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt;
1.386     raeburn  2577: 		    $messagetail = " for <a href=\"".
1.418     albertel 2578: 		                   $feedurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
1.386     raeburn  2579: 		}
                   2580: 		$msgstatus = 
                   2581:                     &Apache::lonmsg::user_normal_msg($uname,$udom,$subject,
                   2582: 						     $message.$messagetail,
1.418     albertel 2583:                                                      undef,$feedurl,undef,
1.386     raeburn  2584:                                                      undef,undef,$showsymb,
                   2585:                                                      $restitle);
1.574     bisitz   2586: 		$request->print('<br />'.&mt('Sending message to [_1]',$uname.':'.$udom).': '.
1.296     www      2587: 				$msgstatus);
1.44      ng       2588: 	    }
1.257     albertel 2589: 	    if ($env{'form.collaborator'.$ctr}) {
1.155     albertel 2590: 		my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr");
1.150     albertel 2591: 		foreach my $collabstr (@collabstrs) {
                   2592: 		    my ($part,@collaborators) = split(/:/,$collabstr);
1.310     banghart 2593: 		    foreach my $collaborator (@collaborators) {
1.150     albertel 2594: 			my ($errorflag,$pts,$wgt) = 
1.324     albertel 2595: 			    &saveHandGrade($request,$symb,$collaborator,$udom,$ctr,
1.257     albertel 2596: 					   $env{'form.unamedom'.$ctr},$part);
1.150     albertel 2597: 			if ($errorflag eq 'not_allowed') {
1.362     albertel 2598: 			    $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>");
1.150     albertel 2599: 			    next;
1.418     albertel 2600: 			} elsif ($message ne '') {
                   2601: 			    my ($baseurl,$showsymb) = 
                   2602: 				&get_feedurl_and_symb($symb,$collaborator,
                   2603: 						      $udom);
                   2604: 			    if ($env{'form.withgrades'.$ctr}) {
                   2605: 				$messagetail = " for <a href=\"".
1.386     raeburn  2606:                                     $baseurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
1.150     albertel 2607: 			    }
1.418     albertel 2608: 			    $msgstatus = 
                   2609: 				&Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle);
1.104     albertel 2610: 			}
1.44      ng       2611: 		    }
                   2612: 		}
                   2613: 	    }
                   2614: 	    $ctr++;
                   2615: 	}
                   2616:     }
                   2617: 
1.257     albertel 2618:     if ($env{'form.handgrade'} eq 'yes') {
1.119     ng       2619: 	# Keywords sorted in alphabatical order
1.257     albertel 2620: 	my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
1.119     ng       2621: 	my %keyhash = ();
1.257     albertel 2622: 	$env{'form.keywords'}           =~ s/,\s{0,}|\s+/ /g;
                   2623: 	$env{'form.keywords'}           =~ s/^\s+|\s+$//;
                   2624: 	my (@keywords) = sort(split(/\s+/,$env{'form.keywords'}));
                   2625: 	$env{'form.keywords'} = join(' ',@keywords);
                   2626: 	$keyhash{$symb.'_keywords'}     = $env{'form.keywords'};
                   2627: 	$keyhash{$symb.'_subject'}      = $env{'form.msgsub'};
                   2628: 	$keyhash{$loginuser.'_kwclr'}   = $env{'form.kwclr'};
                   2629: 	$keyhash{$loginuser.'_kwsize'}  = $env{'form.kwsize'};
                   2630: 	$keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'};
1.119     ng       2631: 
                   2632: 	# message center - Order of message gets changed. Blank line is eliminated.
1.257     albertel 2633: 	# New messages are saved in env for the next student.
1.119     ng       2634: 	# All messages are saved in nohist_handgrade.db
                   2635: 	my ($ctr,$idx) = (1,1);
1.257     albertel 2636: 	while ($ctr <= $env{'form.savemsgN'}) {
                   2637: 	    if ($env{'form.savemsg'.$ctr} ne '') {
                   2638: 		$keyhash{$symb.'_savemsg'.$idx} = $env{'form.savemsg'.$ctr};
1.119     ng       2639: 		$idx++;
                   2640: 	    }
                   2641: 	    $ctr++;
1.41      ng       2642: 	}
1.119     ng       2643: 	$ctr = 0;
                   2644: 	while ($ctr < $ngrade) {
1.257     albertel 2645: 	    if ($env{'form.newmsg'.$ctr} ne '') {
                   2646: 		$keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr};
                   2647: 		$env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr};
1.119     ng       2648: 		$idx++;
                   2649: 	    }
                   2650: 	    $ctr++;
1.41      ng       2651: 	}
1.257     albertel 2652: 	$env{'form.savemsgN'} = --$idx;
                   2653: 	$keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'};
1.119     ng       2654: 	my $putresult = &Apache::lonnet::put
1.301     albertel 2655: 	    ('nohist_handgrade',\%keyhash,$cdom,$cnum);
1.41      ng       2656:     }
1.44      ng       2657:     # Called by Save & Refresh from Highlight Attribute Window
1.257     albertel 2658:     my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');
                   2659:     if ($env{'form.refresh'} eq 'on') {
1.86      ng       2660: 	my ($ctr,$total) = (0,0);
                   2661: 	while ($ctr < $ngrade) {
1.257     albertel 2662: 	    $total++ if  $env{'form.unamedom'.$ctr} ne '';
1.86      ng       2663: 	    $ctr++;
                   2664: 	}
1.257     albertel 2665: 	$env{'form.NTSTU'}=$ngrade;
1.86      ng       2666: 	$ctr = 0;
                   2667: 	while ($ctr < $total) {
1.257     albertel 2668: 	    my $processUser = $env{'form.unamedom'.$ctr};
                   2669: 	    ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser);
                   2670: 	    $env{'form.fullname'} = $$fullname{$processUser};
1.86      ng       2671: 	    &submission($request,$ctr,$total-1);
1.41      ng       2672: 	    $ctr++;
                   2673: 	}
                   2674: 	return '';
                   2675:     }
1.36      ng       2676: 
1.121     ng       2677: # Go directly to grade student - from submission or link from chart page
1.120     ng       2678:     if ($button eq 'Grade Student') {
1.324     albertel 2679: 	(undef,undef,$env{'form.handgrade'},undef,undef) = &showResourceInfo($symb);
1.257     albertel 2680: 	my $processUser = $env{'form.unamedom'.$env{'form.studentNo'}};
                   2681: 	($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser);
                   2682: 	$env{'form.fullname'} = $$fullname{$processUser};
1.120     ng       2683: 	&submission($request,0,0);
                   2684: 	return '';
                   2685:     }
                   2686: 
1.44      ng       2687:     # Get the next/previous one or group of students
1.257     albertel 2688:     my $firststu = $env{'form.unamedom0'};
                   2689:     my $laststu = $env{'form.unamedom'.($ngrade-1)};
1.119     ng       2690:     my $ctr = 2;
1.41      ng       2691:     while ($laststu eq '') {
1.257     albertel 2692: 	$laststu  = $env{'form.unamedom'.($ngrade-$ctr)};
1.41      ng       2693: 	$ctr++;
                   2694: 	$laststu = $firststu if ($ctr > $ngrade);
                   2695:     }
1.44      ng       2696: 
1.41      ng       2697:     my (@parsedlist,@nextlist);
                   2698:     my ($nextflg) = 0;
1.524     raeburn  2699:     foreach my $item (sort 
1.294     albertel 2700: 	     {
                   2701: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   2702: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   2703: 		 }
                   2704: 		 return $a cmp $b;
                   2705: 	     } (keys(%$fullname))) {
1.41      ng       2706: 	if ($nextflg == 1 && $button =~ /Next$/) {
1.524     raeburn  2707: 	    push(@parsedlist,$item);
1.41      ng       2708: 	}
1.524     raeburn  2709: 	$nextflg = 1 if ($item eq $laststu);
1.41      ng       2710: 	if ($button eq 'Previous') {
1.524     raeburn  2711: 	    last if ($item eq $firststu);
                   2712: 	    push(@parsedlist,$item);
1.41      ng       2713: 	}
                   2714:     }
                   2715:     $ctr = 0;
                   2716:     @parsedlist = reverse @parsedlist if ($button eq 'Previous');
1.582     raeburn  2717:     my $res_error;
                   2718:     my ($partlist) = &response_type($symb,\$res_error);
                   2719:     if ($res_error) {
                   2720:         $request->print(&navmap_errormsg());
                   2721:         return;
                   2722:     }
1.41      ng       2723:     foreach my $student (@parsedlist) {
1.257     albertel 2724: 	my $submitonly=$env{'form.submitonly'};
1.41      ng       2725: 	my ($uname,$udom) = split(/:/,$student);
1.301     albertel 2726: 	
                   2727: 	if ($submitonly eq 'queued') {
                   2728: 	    my %queue_status = 
                   2729: 		&Apache::bridgetask::get_student_status($symb,$cdom,$cnum,
                   2730: 							$udom,$uname);
                   2731: 	    next if (!defined($queue_status{'gradingqueue'}));
                   2732: 	}
                   2733: 
1.156     albertel 2734: 	if ($submitonly =~ /^(yes|graded|incorrect)$/) {
1.257     albertel 2735: #	    my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.324     albertel 2736: 	    my %status=&student_gradeStatus($symb,$udom,$uname,$partlist);
1.145     albertel 2737: 	    my $submitted = 0;
1.248     albertel 2738: 	    my $ungraded = 0;
                   2739: 	    my $incorrect = 0;
1.524     raeburn  2740: 	    foreach my $item (keys(%status)) {
                   2741: 		$submitted = 1 if ($status{$item} ne 'nothing');
                   2742: 		$ungraded = 1 if ($status{$item} =~ /^ungraded/);
                   2743: 		$incorrect = 1 if ($status{$item} =~ /^incorrect/);
                   2744: 		my ($foo,$partid,$foo1) = split(/\./,$item);
1.145     albertel 2745: 		if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
                   2746: 		    $submitted = 0;
                   2747: 		}
1.41      ng       2748: 	    }
1.156     albertel 2749: 	    next if (!$submitted && ($submitonly eq 'yes' ||
                   2750: 				     $submitonly eq 'incorrect' ||
                   2751: 				     $submitonly eq 'graded'));
1.248     albertel 2752: 	    next if (!$ungraded && ($submitonly eq 'graded'));
                   2753: 	    next if (!$incorrect && $submitonly eq 'incorrect');
1.41      ng       2754: 	}
1.524     raeburn  2755: 	push(@nextlist,$student) if ($ctr < $ntstu);
1.129     ng       2756: 	last if ($ctr == $ntstu);
1.41      ng       2757: 	$ctr++;
                   2758:     }
1.36      ng       2759: 
1.41      ng       2760:     $ctr = 0;
                   2761:     my $total = scalar(@nextlist)-1;
1.39      ng       2762: 
1.524     raeburn  2763:     foreach (sort(@nextlist)) {
1.41      ng       2764: 	my ($uname,$udom,$submitter) = split(/:/);
1.257     albertel 2765: 	$env{'form.student'}  = $uname;
                   2766: 	$env{'form.userdom'}  = $udom;
                   2767: 	$env{'form.fullname'} = $$fullname{$_};
1.41      ng       2768: 	&submission($request,$ctr,$total);
                   2769: 	$ctr++;
                   2770:     }
                   2771:     if ($total < 0) {
1.485     albertel 2772: 	my $the_end = '<h3><span class="LC_info">'.&mt('LON-CAPA User Message').'</span></h3><br />'."\n";
                   2773: 	$the_end.=&mt('<b>Message: </b> No more students for this section or class.').'<br /><br />'."\n";
                   2774: 	$the_end.=&mt('Click on the button below to return to the grading menu.').'<br /><br />'."\n";
1.324     albertel 2775: 	$the_end.=&show_grading_menu_form($symb);
1.41      ng       2776: 	$request->print($the_end);
                   2777:     }
                   2778:     return '';
1.38      ng       2779: }
1.36      ng       2780: 
1.44      ng       2781: #---- Save the score and award for each student, if changed
1.38      ng       2782: sub saveHandGrade {
1.324     albertel 2783:     my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_;
1.342     banghart 2784:     my @version_parts;
1.104     albertel 2785:     my $usec = &Apache::lonnet::getsection($domain,$stuname,
1.257     albertel 2786: 					   $env{'request.course.id'});
1.104     albertel 2787:     if (!&canmodify($usec)) { return('not_allowed'); }
1.337     banghart 2788:     my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);
1.251     banghart 2789:     my @parts_graded;
1.77      ng       2790:     my %newrecord  = ();
                   2791:     my ($pts,$wgt) = ('','');
1.269     raeburn  2792:     my %aggregate = ();
                   2793:     my $aggregateflag = 0;
1.301     albertel 2794:     my @parts = split(/:/,$env{'form.partlist'.$newflg});
                   2795:     foreach my $new_part (@parts) {
1.337     banghart 2796: 	#collaborator ($submi may vary for different parts
1.259     banghart 2797: 	if ($submitter && $new_part ne $part) { next; }
                   2798: 	my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};
1.125     ng       2799: 	if ($dropMenu eq 'excused') {
1.259     banghart 2800: 	    if ($record{'resource.'.$new_part.'.solved'} ne 'excused') {
                   2801: 		$newrecord{'resource.'.$new_part.'.solved'} = 'excused';
                   2802: 		if (exists($record{'resource.'.$new_part.'.awarded'})) {
                   2803: 		    $newrecord{'resource.'.$new_part.'.awarded'} = '';
1.58      albertel 2804: 		}
1.364     banghart 2805: 	        $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
1.58      albertel 2806: 	    }
1.125     ng       2807: 	} elsif ($dropMenu eq 'reset status'
1.259     banghart 2808: 		 && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts
1.524     raeburn  2809: 	    foreach my $key (keys(%record)) {
1.259     banghart 2810: 		if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; }
1.197     albertel 2811: 	    }
1.259     banghart 2812: 	    $newrecord{'resource.'.$new_part.'.regrader'}=
1.257     albertel 2813: 		"$env{'user.name'}:$env{'user.domain'}";
1.270     albertel 2814:             my $totaltries = $record{'resource.'.$part.'.tries'};
                   2815: 
                   2816:             my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
                   2817: 					       [$new_part]);
                   2818:             my $aggtries =$totaltries;
1.269     raeburn  2819:             if ($last_resets{$new_part}) {
1.270     albertel 2820:                 $aggtries = &get_num_tries(\%record,$last_resets{$new_part},
                   2821: 					   $new_part);
1.269     raeburn  2822:             }
1.270     albertel 2823: 
                   2824:             my $solvedstatus = $record{'resource.'.$new_part.'.solved'};
1.269     raeburn  2825:             if ($aggtries > 0) {
1.327     albertel 2826:                 &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus);
1.269     raeburn  2827:                 $aggregateflag = 1;
                   2828:             }
1.125     ng       2829: 	} elsif ($dropMenu eq '') {
1.259     banghart 2830: 	    $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 
                   2831: 		    $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 
                   2832: 		    $env{'form.RADVAL'.$newflg.'_'.$new_part});
                   2833: 	    if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$new_part} eq '') {
1.153     albertel 2834: 		next;
                   2835: 	    }
1.259     banghart 2836: 	    $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : 
                   2837: 		$env{'form.WGT'.$newflg.'_'.$new_part};
1.41      ng       2838: 	    my $partial= $pts/$wgt;
1.259     banghart 2839: 	    if ($partial eq $record{'resource.'.$new_part.'.awarded'}) {
1.153     albertel 2840: 		#do not update score for part if not changed.
1.346     banghart 2841:                 &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
1.153     albertel 2842: 		next;
1.251     banghart 2843: 	    } else {
1.524     raeburn  2844: 	        push(@parts_graded,$new_part);
1.153     albertel 2845: 	    }
1.259     banghart 2846: 	    if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {
                   2847: 		$newrecord{'resource.'.$new_part.'.awarded'}  = $partial;
1.153     albertel 2848: 	    }
1.259     banghart 2849: 	    my $reckey = 'resource.'.$new_part.'.solved';
1.41      ng       2850: 	    if ($partial == 0) {
1.153     albertel 2851: 		if ($record{$reckey} ne 'incorrect_by_override') {
                   2852: 		    $newrecord{$reckey} = 'incorrect_by_override';
                   2853: 		}
1.41      ng       2854: 	    } else {
1.153     albertel 2855: 		if ($record{$reckey} ne 'correct_by_override') {
                   2856: 		    $newrecord{$reckey} = 'correct_by_override';
                   2857: 		}
                   2858: 	    }	    
                   2859: 	    if ($submitter && 
1.259     banghart 2860: 		($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) {
                   2861: 		$newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter;
1.41      ng       2862: 	    }
1.259     banghart 2863: 	    $newrecord{'resource.'.$new_part.'.regrader'}=
1.257     albertel 2864: 		"$env{'user.name'}:$env{'user.domain'}";
1.41      ng       2865: 	}
1.259     banghart 2866: 	# unless problem has been graded, set flag to version the submitted files
1.305     banghart 2867: 	unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/  || 
                   2868: 	        $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||
                   2869: 	        $dropMenu eq 'reset status')
                   2870: 	   {
1.524     raeburn  2871: 	    push(@version_parts,$new_part);
1.259     banghart 2872: 	}
1.41      ng       2873:     }
1.301     albertel 2874:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2875:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2876: 
1.344     albertel 2877:     if (%newrecord) {
                   2878:         if (@version_parts) {
1.364     banghart 2879:             my @changed_keys = &version_portfiles(\%record, \@parts_graded, 
                   2880:                                 $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts);
1.344     albertel 2881: 	    @newrecord{@changed_keys} = @record{@changed_keys};
1.367     albertel 2882: 	    foreach my $new_part (@version_parts) {
                   2883: 		&handback_files($request,$symb,$stuname,$domain,$newflg,
                   2884: 				$new_part,\%newrecord);
                   2885: 	    }
1.259     banghart 2886:         }
1.44      ng       2887: 	&Apache::lonnet::cstore(\%newrecord,$symb,
1.257     albertel 2888: 				$env{'request.course.id'},$domain,$stuname);
1.380     albertel 2889: 	&check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb,
                   2890: 				     $cdom,$cnum,$domain,$stuname);
1.41      ng       2891:     }
1.269     raeburn  2892:     if ($aggregateflag) {
                   2893:         &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
1.301     albertel 2894: 			      $cdom,$cnum);
1.269     raeburn  2895:     }
1.301     albertel 2896:     return ('',$pts,$wgt);
1.36      ng       2897: }
1.322     albertel 2898: 
1.380     albertel 2899: sub check_and_remove_from_queue {
                   2900:     my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_;
                   2901:     my @ungraded_parts;
                   2902:     foreach my $part (@{$parts}) {
                   2903: 	if (    $record->{   'resource.'.$part.'.awarded'} eq ''
                   2904: 	     && $record->{   'resource.'.$part.'.solved' } ne 'excused'
                   2905: 	     && $newrecord->{'resource.'.$part.'.awarded'} eq ''
                   2906: 	     && $newrecord->{'resource.'.$part.'.solved' } ne 'excused'
                   2907: 		) {
                   2908: 	    push(@ungraded_parts, $part);
                   2909: 	}
                   2910:     }
                   2911:     if ( !@ungraded_parts ) {
                   2912: 	&Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,
                   2913: 					       $cnum,$domain,$stuname);
                   2914:     }
                   2915: }
                   2916: 
1.337     banghart 2917: sub handback_files {
                   2918:     my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
1.517     raeburn  2919:     my $portfolio_root = '/userfiles/portfolio';
1.582     raeburn  2920:     my $res_error;
                   2921:     my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error);
                   2922:     if ($res_error) {
                   2923:         $request->print('<br />'.&navmap_errormsg().'<br />');
                   2924:         return;
                   2925:     }
1.375     albertel 2926:     my @part_response_id = &flatten_responseType($responseType);
                   2927:     foreach my $part_response_id (@part_response_id) {
                   2928:     	my ($part_id,$resp_id) = @{ $part_response_id };
                   2929: 	my $part_resp = join('_',@{ $part_response_id });
1.337     banghart 2930:             if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) {
                   2931:                 # if multiple files are uploaded names will be 'returndoc2','returndoc3'
                   2932:                 my $file_counter = 1;
1.367     albertel 2933: 		my $file_msg;
1.337     banghart 2934:                 while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {
                   2935:                     my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};
1.338     banghart 2936:                     my ($directory,$answer_file) = 
                   2937:                         ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/);
                   2938:                     my ($answer_name,$answer_ver,$answer_ext) =
                   2939: 		        &file_name_version_ext($answer_file);
1.355     banghart 2940: 		    my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
1.517     raeburn  2941:                     my $getpropath = 1;
                   2942: 		    my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath);
1.338     banghart 2943: 		    my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
1.355     banghart 2944:                     # fix file name
                   2945:                     my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
                   2946:                     my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,
                   2947:             	                                $newflg.'_'.$part_resp.'_returndoc'.$file_counter,
                   2948:             	                                $save_file_name);
1.337     banghart 2949:                     if ($result !~ m|^/uploaded/|) {
1.536     raeburn  2950:                         $request->print('<br /><span class="LC_error">'.
                   2951:                             &mt('An error occurred ([_1]) while trying to upload [_2].',
                   2952:                                 $result,$newflg.'_'.$part_resp.'_returndoc'.$file_counter).
                   2953:                                         '</span>');
1.356     banghart 2954:                     } else {
1.360     banghart 2955:                         # mark the file as read only
                   2956:                         my @files = ($save_file_name);
1.372     albertel 2957:                         my @what = ($symb,$env{'request.course.id'},'handback');
1.360     banghart 2958:                         &Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what);
1.367     albertel 2959: 			if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) {
                   2960: 			    $$newrecord{"resource.$new_part.$resp_id.handback"}.=',';
                   2961: 			}
                   2962:                         $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name;
                   2963: 			$file_msg.= "\n".'<br /><span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span><br />";
                   2964: 
1.337     banghart 2965:                     }
                   2966:                     $request->print("<br />".$fname." will be the uploaded file name");
1.354     albertel 2967:                     $request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter});
1.337     banghart 2968:                     $file_counter++;
                   2969:                 }
1.367     albertel 2970: 		my $subject = "File Handed Back by Instructor ";
                   2971: 		my $message = "A file has been returned that was originally submitted in reponse to: <br />";
                   2972: 		$message .= "<strong>".&Apache::lonnet::gettitle($symb)."</strong><br />";
                   2973: 		$message .= ' The returned file(s) are named: '. $file_msg;
                   2974: 		$message .= " and can be found in your portfolio space.";
1.418     albertel 2975: 		my ($feedurl,$showsymb) = 
                   2976: 		    &get_feedurl_and_symb($symb,$domain,$stuname);
1.386     raeburn  2977:                 my $restitle = &Apache::lonnet::gettitle($symb);
                   2978: 		my $msgstatus = 
                   2979:                    &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject.
                   2980: 			 ' (File Returned) ['.$restitle.']',$message,undef,
1.418     albertel 2981:                          $feedurl,undef,undef,undef,$showsymb,$restitle);
1.337     banghart 2982:             }
                   2983:         }
1.338     banghart 2984:     return;
1.337     banghart 2985: }
                   2986: 
1.418     albertel 2987: sub get_feedurl_and_symb {
                   2988:     my ($symb,$uname,$udom) = @_;
                   2989:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
                   2990:     $url = &Apache::lonnet::clutter($url);
                   2991:     my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl',
                   2992: 					$symb,$udom,$uname);
                   2993:     if ($encrypturl =~ /^yes$/i) {
                   2994: 	&Apache::lonenc::encrypted(\$url,1);
                   2995: 	&Apache::lonenc::encrypted(\$symb,1);
                   2996:     }
                   2997:     return ($url,$symb);
                   2998: }
                   2999: 
1.313     banghart 3000: sub get_submitted_files {
                   3001:     my ($udom,$uname,$partid,$respid,$record) = @_;
                   3002:     my @files;
                   3003:     if ($$record{"resource.$partid.$respid.portfiles"}) {
                   3004:         my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio';
                   3005:         foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) {
                   3006:     	    push(@files,$file_url.$file);
                   3007:         }
                   3008:     }
                   3009:     if ($$record{"resource.$partid.$respid.uploadedurl"}) {
                   3010:         push(@files,$$record{"resource.$partid.$respid.uploadedurl"});
                   3011:     }
                   3012:     return (\@files);
                   3013: }
1.322     albertel 3014: 
1.269     raeburn  3015: # ----------- Provides number of tries since last reset.
                   3016: sub get_num_tries {
                   3017:     my ($record,$last_reset,$part) = @_;
                   3018:     my $timestamp = '';
                   3019:     my $num_tries = 0;
                   3020:     if ($$record{'version'}) {
                   3021:         for (my $version=$$record{'version'};$version>=1;$version--) {
                   3022:             if (exists($$record{$version.':resource.'.$part.'.solved'})) {
                   3023:                 $timestamp = $$record{$version.':timestamp'};
                   3024:                 if ($timestamp > $last_reset) {
                   3025:                     $num_tries ++;
                   3026:                 } else {
                   3027:                     last;
                   3028:                 }
                   3029:             }
                   3030:         }
                   3031:     }
                   3032:     return $num_tries;
                   3033: }
                   3034: 
                   3035: # ----------- Determine decrements required in aggregate totals 
                   3036: sub decrement_aggs {
                   3037:     my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_;
                   3038:     my %decrement = (
                   3039:                         attempts => 0,
                   3040:                         users => 0,
                   3041:                         correct => 0
                   3042:                     );
                   3043:     $decrement{'attempts'} = $aggtries;
                   3044:     if ($solvedstatus =~ /^correct/) {
                   3045:         $decrement{'correct'} = 1;
                   3046:     }
                   3047:     if ($aggtries == $totaltries) {
                   3048:         $decrement{'users'} = 1;
                   3049:     }
1.524     raeburn  3050:     foreach my $type (keys(%decrement)) {
1.269     raeburn  3051:         $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type};
                   3052:     }
                   3053:     return;
                   3054: }
                   3055: 
                   3056: # ----------- Determine timestamps for last reset of aggregate totals for parts  
                   3057: sub get_last_resets {
1.270     albertel 3058:     my ($symb,$courseid,$partids) =@_;
                   3059:     my %last_resets;
1.269     raeburn  3060:     my $cdom = $env{'course.'.$courseid.'.domain'};
                   3061:     my $cname = $env{'course.'.$courseid.'.num'};
1.271     albertel 3062:     my @keys;
                   3063:     foreach my $part (@{$partids}) {
                   3064: 	push(@keys,"$symb\0$part\0resettime");
                   3065:     }
                   3066:     my %results=&Apache::lonnet::get('nohist_resourcetracker',\@keys,
                   3067: 				     $cdom,$cname);
                   3068:     foreach my $part (@{$partids}) {
                   3069: 	$last_resets{$part}=$results{"$symb\0$part\0resettime"};
1.269     raeburn  3070:     }
1.270     albertel 3071:     return %last_resets;
1.269     raeburn  3072: }
                   3073: 
1.251     banghart 3074: # ----------- Handles creating versions for portfolio files as answers
                   3075: sub version_portfiles {
1.343     banghart 3076:     my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_;
1.263     banghart 3077:     my $version_parts = join('|',@$v_flag);
1.343     banghart 3078:     my @returned_keys;
1.255     banghart 3079:     my $parts = join('|', @$parts_graded);
1.517     raeburn  3080:     my $portfolio_root = '/userfiles/portfolio';
1.277     albertel 3081:     foreach my $key (keys(%$record)) {
1.259     banghart 3082:         my $new_portfiles;
1.263     banghart 3083:         if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {
1.342     banghart 3084:             my @versioned_portfiles;
1.367     albertel 3085:             my @portfiles = split(/\s*,\s*/,$$record{$key});
1.252     banghart 3086:             foreach my $file (@portfiles) {
1.306     banghart 3087:                 &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file);
1.304     albertel 3088:                 my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
                   3089: 		my ($answer_name,$answer_ver,$answer_ext) =
                   3090: 		    &file_name_version_ext($answer_file);
1.517     raeburn  3091:                 my $getpropath = 1;    
                   3092:                 my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath);
1.342     banghart 3093:                 my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
1.306     banghart 3094:                 my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
                   3095:                 if ($new_answer ne 'problem getting file') {
1.342     banghart 3096:                     push(@versioned_portfiles, $directory.$new_answer);
1.306     banghart 3097:                     &Apache::lonnet::mark_as_readonly($domain,$stu_name,
1.367     albertel 3098:                         [$directory.$new_answer],
1.306     banghart 3099:                         [$symb,$env{'request.course.id'},'graded']);
1.259     banghart 3100:                 }
1.252     banghart 3101:             }
1.343     banghart 3102:             $$record{$key} = join(',',@versioned_portfiles);
                   3103:             push(@returned_keys,$key);
1.251     banghart 3104:         }
                   3105:     } 
1.343     banghart 3106:     return (@returned_keys);   
1.305     banghart 3107: }
                   3108: 
1.307     banghart 3109: sub get_next_version {
1.341     banghart 3110:     my ($answer_name, $answer_ext, $dir_list) = @_;
1.307     banghart 3111:     my $version;
                   3112:     foreach my $row (@$dir_list) {
                   3113:         my ($file) = split(/\&/,$row,2);
                   3114:         my ($file_name,$file_version,$file_ext) =
                   3115: 	    &file_name_version_ext($file);
                   3116:         if (($file_name eq $answer_name) && 
                   3117: 	    ($file_ext eq $answer_ext)) {
                   3118:                 # gets here if filename and extension match, regardless of version
                   3119:                 if ($file_version ne '') {
                   3120:                 # a versioned file is found  so save it for later
                   3121:                 if ($file_version > $version) {
                   3122: 		    $version = $file_version;
                   3123: 	        }
                   3124:             }
                   3125:         }
                   3126:     } 
                   3127:     $version ++;
                   3128:     return($version);
                   3129: }
                   3130: 
1.305     banghart 3131: sub version_selected_portfile {
1.306     banghart 3132:     my ($domain,$stu_name,$directory,$file_name,$version) = @_;
                   3133:     my ($answer_name,$answer_ver,$answer_ext) =
                   3134:         &file_name_version_ext($file_name);
                   3135:     my $new_answer;
                   3136:     $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name");
                   3137:     if($env{'form.copy'} eq '-1') {
                   3138:         $new_answer = 'problem getting file';
                   3139:     } else {
                   3140:         $new_answer = $answer_name.'.'.$version.'.'.$answer_ext;
                   3141:         my $copy_result = &Apache::lonnet::finishuserfileupload(
                   3142:                             $stu_name,$domain,'copy',
                   3143: 		        '/portfolio'.$directory.$new_answer);
                   3144:     }    
                   3145:     return ($new_answer);
1.251     banghart 3146: }
                   3147: 
1.304     albertel 3148: sub file_name_version_ext {
                   3149:     my ($file)=@_;
                   3150:     my @file_parts = split(/\./, $file);
                   3151:     my ($name,$version,$ext);
                   3152:     if (@file_parts > 1) {
                   3153: 	$ext=pop(@file_parts);
                   3154: 	if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) {
                   3155: 	    $version=pop(@file_parts);
                   3156: 	}
                   3157: 	$name=join('.',@file_parts);
                   3158:     } else {
                   3159: 	$name=join('.',@file_parts);
                   3160:     }
                   3161:     return($name,$version,$ext);
                   3162: }
                   3163: 
1.44      ng       3164: #--------------------------------------------------------------------------------------
                   3165: #
                   3166: #-------------------------- Next few routines handles grading by section or whole class
                   3167: #
                   3168: #--- Javascript to handle grading by section or whole class
1.42      ng       3169: sub viewgrades_js {
                   3170:     my ($request) = shift;
                   3171: 
1.539     riegler  3172:     my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = ');
1.41      ng       3173:     $request->print(<<VIEWJAVASCRIPT);
                   3174: <script type="text/javascript" language="javascript">
1.45      ng       3175:    function writePoint(partid,weight,point) {
1.125     ng       3176: 	var radioButton = document.classgrade["RADVAL_"+partid];
                   3177: 	var textbox = document.classgrade["TEXTVAL_"+partid];
1.42      ng       3178: 	if (point == "textval") {
1.125     ng       3179: 	    point = document.classgrade["TEXTVAL_"+partid].value;
1.109     matthew  3180: 	    if (isNaN(point) || parseFloat(point) < 0) {
1.539     riegler  3181: 		alert("$alertmsg"+parseFloat(point));
1.42      ng       3182: 		var resetbox = false;
                   3183: 		for (var i=0; i<radioButton.length; i++) {
                   3184: 		    if (radioButton[i].checked) {
                   3185: 			textbox.value = i;
                   3186: 			resetbox = true;
                   3187: 		    }
                   3188: 		}
                   3189: 		if (!resetbox) {
                   3190: 		    textbox.value = "";
                   3191: 		}
                   3192: 		return;
                   3193: 	    }
1.109     matthew  3194: 	    if (parseFloat(point) > parseFloat(weight)) {
                   3195: 		var resp = confirm("You entered a value ("+parseFloat(point)+
1.44      ng       3196: 				   ") greater than the weight for the part. Accept?");
                   3197: 		if (resp == false) {
                   3198: 		    textbox.value = "";
                   3199: 		    return;
                   3200: 		}
                   3201: 	    }
1.42      ng       3202: 	    for (var i=0; i<radioButton.length; i++) {
                   3203: 		radioButton[i].checked=false;
1.109     matthew  3204: 		if (parseFloat(point) == i) {
1.42      ng       3205: 		    radioButton[i].checked=true;
                   3206: 		}
                   3207: 	    }
1.41      ng       3208: 
1.42      ng       3209: 	} else {
1.125     ng       3210: 	    textbox.value = parseFloat(point);
1.42      ng       3211: 	}
1.41      ng       3212: 	for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3213: 	    var user = document.classgrade["ctr"+i].value;
1.289     albertel 3214: 	    user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3215: 	    var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3216: 	    var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3217: 	    var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.42      ng       3218: 	    if (saveval != "correct") {
                   3219: 		scorename.value = point;
1.43      ng       3220: 		if (selname[0].selected != true) {
                   3221: 		    selname[0].selected = true;
                   3222: 		}
1.42      ng       3223: 	    }
                   3224: 	}
1.125     ng       3225: 	document.classgrade["SELVAL_"+partid][0].selected = true;
1.42      ng       3226:     }
                   3227: 
                   3228:     function writeRadText(partid,weight) {
1.125     ng       3229: 	var selval   = document.classgrade["SELVAL_"+partid];
                   3230: 	var radioButton = document.classgrade["RADVAL_"+partid];
1.265     www      3231:         var override = document.classgrade["FORCE_"+partid].checked;
1.125     ng       3232: 	var textbox = document.classgrade["TEXTVAL_"+partid];
                   3233: 	if (selval[1].selected || selval[2].selected) {
1.42      ng       3234: 	    for (var i=0; i<radioButton.length; i++) {
                   3235: 		radioButton[i].checked=false;
                   3236: 
                   3237: 	    }
                   3238: 	    textbox.value = "";
                   3239: 
                   3240: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3241: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3242: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3243: 		var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3244: 		var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3245: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.265     www      3246: 		if ((saveval != "correct") || override) {
1.42      ng       3247: 		    scorename.value = "";
1.125     ng       3248: 		    if (selval[1].selected) {
                   3249: 			selname[1].selected = true;
                   3250: 		    } else {
                   3251: 			selname[2].selected = true;
                   3252: 			if (Number(document.classgrade["GD_"+user+"_"+partid+"_tries"].value)) 
                   3253: 			{document.classgrade["GD_"+user+"_"+partid+"_tries"].value = '0';}
                   3254: 		    }
1.42      ng       3255: 		}
                   3256: 	    }
1.43      ng       3257: 	} else {
                   3258: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3259: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3260: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3261: 		var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3262: 		var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3263: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.265     www      3264: 		if ((saveval != "correct") || override) {
1.125     ng       3265: 		    scorename.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value;
1.43      ng       3266: 		    selname[0].selected = true;
                   3267: 		}
                   3268: 	    }
                   3269: 	}	    
1.42      ng       3270:     }
                   3271: 
                   3272:     function changeSelect(partid,user) {
1.125     ng       3273: 	var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"];
                   3274: 	var textbox = document.classgrade["GD_"+user+'_'+partid+"_awarded"];
1.44      ng       3275: 	var point  = textbox.value;
1.125     ng       3276: 	var weight = document.classgrade["weight_"+partid].value;
1.44      ng       3277: 
1.109     matthew  3278: 	if (isNaN(point) || parseFloat(point) < 0) {
1.539     riegler  3279: 	    alert("$alertmsg"+parseFloat(point));
1.44      ng       3280: 	    textbox.value = "";
                   3281: 	    return;
                   3282: 	}
1.109     matthew  3283: 	if (parseFloat(point) > parseFloat(weight)) {
                   3284: 	    var resp = confirm("You entered a value ("+parseFloat(point)+
1.44      ng       3285: 			       ") greater than the weight of the part. Accept?");
                   3286: 	    if (resp == false) {
                   3287: 		textbox.value = "";
                   3288: 		return;
                   3289: 	    }
                   3290: 	}
1.42      ng       3291: 	selval[0].selected = true;
                   3292:     }
                   3293: 
                   3294:     function changeOneScore(partid,user) {
1.125     ng       3295: 	var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"];
                   3296: 	if (selval[1].selected || selval[2].selected) {
                   3297: 	    document.classgrade["GD_"+user+'_'+partid+"_awarded"].value = "";
                   3298: 	    if (selval[2].selected) {
                   3299: 		document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0";
                   3300: 	    }
1.269     raeburn  3301:         }
1.42      ng       3302:     }
                   3303: 
                   3304:     function resetEntry(numpart) {
                   3305: 	for (ctpart=0;ctpart<numpart;ctpart++) {
1.125     ng       3306: 	    var partid = document.classgrade["partid_"+ctpart].value;
                   3307: 	    var radioButton = document.classgrade["RADVAL_"+partid];
                   3308: 	    var textbox = document.classgrade["TEXTVAL_"+partid];
                   3309: 	    var selval  = document.classgrade["SELVAL_"+partid];
1.42      ng       3310: 	    for (var i=0; i<radioButton.length; i++) {
                   3311: 		radioButton[i].checked=false;
                   3312: 
                   3313: 	    }
                   3314: 	    textbox.value = "";
                   3315: 	    selval[0].selected = true;
                   3316: 
                   3317: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3318: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3319: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3320: 		var resetscore = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3321: 		resetscore.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value;
                   3322: 		var resettries = document.classgrade["GD_"+user+"_"+partid+"_tries"];
                   3323: 		resettries.value = document.classgrade["GD_"+user+"_"+partid+"_tries_s"].value;
                   3324: 		var saveselval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3325: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.42      ng       3326: 		if (saveselval == "excused") {
1.43      ng       3327: 		    if (selname[1].selected == false) { selname[1].selected = true;}
1.42      ng       3328: 		} else {
1.43      ng       3329: 		    if (selname[0].selected == false) {selname[0].selected = true};
1.42      ng       3330: 		}
                   3331: 	    }
1.41      ng       3332: 	}
1.42      ng       3333:     }
                   3334: 
1.41      ng       3335: </script>
                   3336: VIEWJAVASCRIPT
1.42      ng       3337: }
                   3338: 
1.44      ng       3339: #--- show scores for a section or whole class w/ option to change/update a score
1.42      ng       3340: sub viewgrades {
                   3341:     my ($request) = shift;
                   3342:     &viewgrades_js($request);
1.41      ng       3343: 
1.324     albertel 3344:     my ($symb) = &get_symb($request);
1.168     albertel 3345:     #need to make sure we have the correct data for later EXT calls, 
                   3346:     #thus invalidate the cache
                   3347:     &Apache::lonnet::devalidatecourseresdata(
1.257     albertel 3348:                  $env{'course.'.$env{'request.course.id'}.'.num'},
                   3349:                  $env{'course.'.$env{'request.course.id'}.'.domain'});
1.168     albertel 3350:     &Apache::lonnet::clear_EXT_cache_status();
                   3351: 
1.398     albertel 3352:     my $result='<h3><span class="LC_info">'.&mt('Manual Grading').'</span></h3>';
1.485     albertel 3353:     $result.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4>'."\n";
1.41      ng       3354: 
                   3355:     #view individual student submission form - called using Javascript viewOneStudent
1.324     albertel 3356:     $result.=&jscriptNform($symb);
1.41      ng       3357: 
1.44      ng       3358:     #beginning of class grading form
1.442     banghart 3359:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.41      ng       3360:     $result.= '<form action="/adm/grades" method="post" name="classgrade">'."\n".
1.418     albertel 3361: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.38      ng       3362: 	'<input type="hidden" name="command" value="editgrades" />'."\n".
1.432     banghart 3363: 	&build_section_inputs().
1.257     albertel 3364: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
1.442     banghart 3365: 	'<input type="hidden" name="Status" value="'.$env{'stu_status'}.'" />'."\n".
1.257     albertel 3366: 	'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
1.72      ng       3367: 
1.560     raeburn  3368:     my ($common_header,$specific_header);
1.257     albertel 3369:     if ($env{'form.section'} eq 'all') {
1.560     raeburn  3370: 	$common_header = &mt('Assign Common Grade to Class');
                   3371:         $specific_header = &mt('Assign Grade to Specific Students in Class');
1.257     albertel 3372:     } elsif ($env{'form.section'} eq 'none') {
1.560     raeburn  3373:         $common_header = &mt('Assign Common Grade to Students in no Section');
                   3374: 	$specific_header = &mt('Assign Grade to Specific Students in no Section');
1.52      albertel 3375:     } else {
1.560     raeburn  3376:         my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
                   3377:         $common_header = &mt('Assign Common Grade to Students in Section(s) [_1]',$section_display);
                   3378: 	$specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1]',$section_display);
1.52      albertel 3379:     }
1.560     raeburn  3380:     $result.= '<h3>'.$common_header.'</h3>'.&Apache::loncommon::start_data_table();
1.44      ng       3381:     #radio buttons/text box for assigning points for a section or class.
                   3382:     #handles different parts of a problem
1.582     raeburn  3383:     my $res_error;
                   3384:     my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error);
                   3385:     if ($res_error) {
                   3386:         return &navmap_errormsg();
                   3387:     }
1.42      ng       3388:     my %weight = ();
                   3389:     my $ctsparts = 0;
1.45      ng       3390:     my %seen = ();
1.375     albertel 3391:     my @part_response_id = &flatten_responseType($responseType);
                   3392:     foreach my $part_response_id (@part_response_id) {
                   3393:     	my ($partid,$respid) = @{ $part_response_id };
                   3394: 	my $part_resp = join('_',@{ $part_response_id });
1.45      ng       3395: 	next if $seen{$partid};
                   3396: 	$seen{$partid}++;
1.375     albertel 3397: 	my $handgrade=$$handgrade{$part_resp};
1.42      ng       3398: 	my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);
                   3399: 	$weight{$partid} = $wgt eq '' ? '1' : $wgt;
                   3400: 
1.324     albertel 3401: 	my $display_part=&get_display_part($partid,$symb);
1.485     albertel 3402: 	my $radio.='<table border="0"><tr>';  
1.41      ng       3403: 	my $ctr = 0;
1.42      ng       3404: 	while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across
1.485     albertel 3405: 	    $radio.= '<td><label><input type="radio" name="RADVAL_'.$partid.'" '.
1.54      albertel 3406: 		'onclick="javascript:writePoint(\''.$partid.'\','.$weight{$partid}.
1.288     albertel 3407: 		','.$ctr.')" />'.$ctr."</label></td>\n";
1.41      ng       3408: 	    $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');
                   3409: 	    $ctr++;
                   3410: 	}
1.485     albertel 3411: 	$radio.='</tr></table>';
                   3412: 	my $line = '<input type="text" name="TEXTVAL_'.
1.589     bisitz   3413: 	    $partid.'" size="4" '.'onchange="javascript:writePoint(\''.
1.54      albertel 3414: 		$partid.'\','.$weight{$partid}.',\'textval\')" /> /'.
1.539     riegler  3415: 	    $weight{$partid}.' '.&mt('(problem weight)').'</td>'."\n";
                   3416: 	$line.= '<td><b>'.&mt('Grade Status').':</b><select name="SELVAL_'.$partid.'"'.
1.589     bisitz   3417: 	    'onchange="javascript:writeRadText(\''.$partid.'\','.
1.59      albertel 3418: 		$weight{$partid}.')"> '.
1.401     albertel 3419: 	    '<option selected="selected"> </option>'.
1.485     albertel 3420: 	    '<option value="excused">'.&mt('excused').'</option>'.
                   3421: 	    '<option value="reset status">'.&mt('reset status').'</option>'.
                   3422: 	    '</select></td>'.
                   3423:             '<td><label><input type="checkbox" name="FORCE_'.$partid.'" />'.&mt('Override "Correct"').'</label>';
                   3424: 	$line.='<input type="hidden" name="partid_'.
                   3425: 	    $ctsparts.'" value="'.$partid.'" />'."\n";
                   3426: 	$line.='<input type="hidden" name="weight_'.
                   3427: 	    $partid.'" value="'.$weight{$partid}.'" />'."\n";
                   3428: 
                   3429: 	$result.=
                   3430: 	    &Apache::loncommon::start_data_table_row()."\n".
1.577     bisitz   3431: 	    '<td><b>'.&mt('Part:').'</b></td><td>'.$display_part.'</td><td><b>'.&mt('Points:').'</b></td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'.
1.485     albertel 3432: 	    &Apache::loncommon::end_data_table_row()."\n";
1.42      ng       3433: 	$ctsparts++;
1.41      ng       3434:     }
1.474     albertel 3435:     $result.=&Apache::loncommon::end_data_table()."\n".
1.52      albertel 3436: 	'<input type="hidden" name="totalparts" value="'.$ctsparts.'" />';
1.485     albertel 3437:     $result.='<input type="button" value="'.&mt('Revert to Default').'" '.
1.589     bisitz   3438: 	'onclick="javascript:resetEntry('.$ctsparts.');" />';
1.41      ng       3439: 
1.44      ng       3440:     #table listing all the students in a section/class
                   3441:     #header of table
1.560     raeburn  3442:     $result.= '<h3>'.$specific_header.'</h3>'.
                   3443:               &Apache::loncommon::start_data_table().
                   3444: 	      &Apache::loncommon::start_data_table_header_row().
                   3445: 	      '<th>'.&mt('No.').'</th>'.
                   3446: 	      '<th>'.&nameUserString('header')."</th>\n";
1.582     raeburn  3447:     my $partserror;
                   3448:     my (@parts) = sort(&getpartlist($symb,\$partserror));
                   3449:     if ($partserror) {
                   3450:         return &navmap_errormsg();
                   3451:     }
1.324     albertel 3452:     my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
1.269     raeburn  3453:     my @partids = ();
1.41      ng       3454:     foreach my $part (@parts) {
                   3455: 	my $display=&Apache::lonnet::metadata($url,$part.'.display');
1.539     riegler  3456:         my $narrowtext = &mt('Tries');
                   3457: 	$display =~ s|^Number of Attempts|$narrowtext <br />|; # makes the column narrower
1.41      ng       3458: 	if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
1.207     albertel 3459: 	my ($partid) = &split_part_type($part);
1.524     raeburn  3460:         push(@partids,$partid);
1.324     albertel 3461: 	my $display_part=&get_display_part($partid,$symb);
1.41      ng       3462: 	if ($display =~ /^Partial Credit Factor/) {
1.485     albertel 3463: 	    $result.='<th>'.
                   3464: 		&mt('Score Part: [_1]<br /> (weight = [_2])',
                   3465: 		    $display_part,$weight{$partid}).'</th>'."\n";
1.41      ng       3466: 	    next;
1.485     albertel 3467: 	    
1.207     albertel 3468: 	} else {
1.485     albertel 3469: 	    if ($display =~ /Problem Status/) {
                   3470: 		my $grade_status_mt = &mt('Grade Status');
                   3471: 		$display =~ s{Problem Status}{$grade_status_mt<br />};
                   3472: 	    }
                   3473: 	    my $part_mt = &mt('Part:');
                   3474: 	    $display =~s{\[Part: \Q$partid\E\]}{$part_mt $display_part};
1.41      ng       3475: 	}
1.485     albertel 3476: 
1.474     albertel 3477: 	$result.='<th>'.$display.'</th>'."\n";
1.41      ng       3478:     }
1.474     albertel 3479:     $result.=&Apache::loncommon::end_data_table_header_row();
1.44      ng       3480: 
1.270     albertel 3481:     my %last_resets = 
                   3482: 	&get_last_resets($symb,$env{'request.course.id'},\@partids);
1.269     raeburn  3483: 
1.41      ng       3484:     #get info for each student
1.44      ng       3485:     #list all the students - with points and grade status
1.257     albertel 3486:     my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');
1.41      ng       3487:     my $ctr = 0;
1.294     albertel 3488:     foreach (sort 
                   3489: 	     {
                   3490: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   3491: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   3492: 		 }
                   3493: 		 return $a cmp $b;
                   3494: 	     } (keys(%$fullname))) {
1.126     ng       3495: 	$ctr++;
1.324     albertel 3496: 	$result.=&viewstudentgrade($symb,$env{'request.course.id'},
1.269     raeburn  3497: 				   $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets);
1.41      ng       3498:     }
1.474     albertel 3499:     $result.=&Apache::loncommon::end_data_table();
1.41      ng       3500:     $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n";
1.485     albertel 3501:     $result.='<input type="button" value="'.&mt('Save').'" '.
1.589     bisitz   3502: 	'onclick="javascript:submit();" target="_self" /></form>'."\n";
1.96      albertel 3503:     if (scalar(%$fullname) eq 0) {
                   3504: 	my $colspan=3+scalar(@parts);
1.433     banghart 3505: 	my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
1.442     banghart 3506:         my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status'));
1.433     banghart 3507: 	$result='<span class="LC_warning">'.
1.485     albertel 3508: 	    &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.',
1.442     banghart 3509: 	        $section_display, $stu_status).
1.433     banghart 3510: 	    '</span>';
1.96      albertel 3511:     }
1.324     albertel 3512:     $result.=&show_grading_menu_form($symb);
1.41      ng       3513:     return $result;
                   3514: }
                   3515: 
1.44      ng       3516: #--- call by previous routine to display each student
1.41      ng       3517: sub viewstudentgrade {
1.324     albertel 3518:     my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_;
1.44      ng       3519:     my ($uname,$udom) = split(/:/,$student);
                   3520:     my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
1.269     raeburn  3521:     my %aggregates = (); 
1.474     albertel 3522:     my $result=&Apache::loncommon::start_data_table_row().'<td align="right">'.
1.233     albertel 3523: 	'<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.
                   3524: 	"\n".$ctr.'&nbsp;</td><td>&nbsp;'.
1.44      ng       3525: 	'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
1.417     albertel 3526: 	'\');" target="_self">'.$fullname.'</a> '.
1.398     albertel 3527: 	'<span class="LC_internal_info">('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')</span></td>'."\n";
1.281     albertel 3528:     $student=~s/:/_/; # colon doen't work in javascript for names
1.63      albertel 3529:     foreach my $apart (@$parts) {
                   3530: 	my ($part,$type) = &split_part_type($apart);
1.41      ng       3531: 	my $score=$record{"resource.$part.$type"};
1.276     albertel 3532:         $result.='<td align="center">';
1.269     raeburn  3533:         my ($aggtries,$totaltries);
                   3534:         unless (exists($aggregates{$part})) {
1.270     albertel 3535: 	    $totaltries = $record{'resource.'.$part.'.tries'};
                   3536: 
                   3537: 	    $aggtries = $totaltries;
1.269     raeburn  3538:             if ($$last_resets{$part}) {  
1.270     albertel 3539:                 $aggtries = &get_num_tries(\%record,$$last_resets{$part},
                   3540: 					   $part);
                   3541:             }
1.269     raeburn  3542:             $result.='<input type="hidden" name="'.
                   3543:                 'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n";
                   3544:             $result.='<input type="hidden" name="'.
                   3545:                 'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n";
                   3546:             $aggregates{$part} = 1;
                   3547:         }
1.41      ng       3548: 	if ($type eq 'awarded') {
1.320     albertel 3549: 	    my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part});
1.42      ng       3550: 	    $result.='<input type="hidden" name="'.
1.89      albertel 3551: 		'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
1.233     albertel 3552: 	    $result.='<input type="text" name="'.
1.89      albertel 3553: 		'GD_'.$student.'_'.$part.'_awarded" '.
1.589     bisitz   3554:                 'onchange="javascript:changeSelect(\''.$part.'\',\''.$student.
1.44      ng       3555: 		'\')" value="'.$pts.'" size="4" /></td>'."\n";
1.41      ng       3556: 	} elsif ($type eq 'solved') {
                   3557: 	    my ($status,$foo)=split(/_/,$score,2);
                   3558: 	    $status = 'nothing' if ($status eq '');
1.89      albertel 3559: 	    $result.='<input type="hidden" name="'.'GD_'.$student.'_'.
1.54      albertel 3560: 		$part.'_solved_s" value="'.$status.'" />'."\n";
1.233     albertel 3561: 	    $result.='&nbsp;<select name="'.
1.89      albertel 3562: 		'GD_'.$student.'_'.$part.'_solved" '.
1.589     bisitz   3563:                 'onchange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n";
1.485     albertel 3564: 	    $result.= (($status eq 'excused') ? '<option> </option><option selected="selected" value="excused">'.&mt('excused').'</option>' 
                   3565: 		: '<option selected="selected"> </option><option value="excused">'.&mt('excused').'</option>')."\n";
                   3566: 	    $result.='<option value="reset status">'.&mt('reset status').'</option>';
1.126     ng       3567: 	    $result.="</select>&nbsp;</td>\n";
1.122     ng       3568: 	} else {
                   3569: 	    $result.='<input type="hidden" name="'.
                   3570: 		'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.
                   3571: 		    "\n";
1.233     albertel 3572: 	    $result.='<input type="text" name="'.
1.122     ng       3573: 		'GD_'.$student.'_'.$part.'_'.$type.'" '.
                   3574: 		'value="'.$score.'" size="4" /></td>'."\n";
1.41      ng       3575: 	}
                   3576:     }
1.474     albertel 3577:     $result.=&Apache::loncommon::end_data_table_row();
1.41      ng       3578:     return $result;
1.38      ng       3579: }
                   3580: 
1.44      ng       3581: #--- change scores for all the students in a section/class
                   3582: #    record does not get update if unchanged
1.38      ng       3583: sub editgrades {
1.41      ng       3584:     my ($request) = @_;
                   3585: 
1.324     albertel 3586:     my $symb=&get_symb($request);
1.433     banghart 3587:     my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
1.477     albertel 3588:     my $title='<h2>'.&mt('Current Grade Status').'</h2>';
                   3589:     $title.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4>'."\n";
1.433     banghart 3590:     $title.='<h4>'.&mt('<b>Section: </b>[_1]',$section_display).'</h4>'."\n";
1.126     ng       3591: 
1.477     albertel 3592:     my $result= &Apache::loncommon::start_data_table().
                   3593: 	&Apache::loncommon::start_data_table_header_row().
                   3594: 	'<th rowspan="2" valign="middle">'.&mt('No.').'</th>'.
                   3595: 	'<th rowspan="2" valign="middle">'.&nameUserString('header')."</th>\n";
1.43      ng       3596:     my %scoreptr = (
                   3597: 		    'correct'  =>'correct_by_override',
                   3598: 		    'incorrect'=>'incorrect_by_override',
                   3599: 		    'excused'  =>'excused',
                   3600: 		    'ungraded' =>'ungraded_attempted',
1.596     raeburn  3601:                     'credited' =>'credit_attempted',
1.43      ng       3602: 		    'nothing'  => '',
                   3603: 		    );
1.257     albertel 3604:     my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0');
1.34      ng       3605: 
1.44      ng       3606:     my (@partid);
                   3607:     my %weight = ();
1.54      albertel 3608:     my %columns = ();
1.44      ng       3609:     my ($i,$ctr,$count,$rec_update) = (0,0,0,0);
1.54      albertel 3610: 
1.582     raeburn  3611:     my $partserror;
                   3612:     my (@parts) = sort(&getpartlist($symb,\$partserror));
                   3613:     if ($partserror) {
                   3614:         return &navmap_errormsg();
                   3615:     }
1.54      albertel 3616:     my $header;
1.257     albertel 3617:     while ($ctr < $env{'form.totalparts'}) {
                   3618: 	my $partid = $env{'form.partid_'.$ctr};
1.524     raeburn  3619: 	push(@partid,$partid);
1.257     albertel 3620: 	$weight{$partid} = $env{'form.weight_'.$partid};
1.44      ng       3621: 	$ctr++;
1.54      albertel 3622:     }
1.324     albertel 3623:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.54      albertel 3624:     foreach my $partid (@partid) {
1.478     albertel 3625: 	$header .= '<th align="center">'.&mt('Old Score').'</th>'.
                   3626: 	    '<th align="center">'.&mt('New Score').'</th>';
1.54      albertel 3627: 	$columns{$partid}=2;
                   3628: 	foreach my $stores (@parts) {
                   3629: 	    my ($part,$type) = &split_part_type($stores);
                   3630: 	    if ($part !~ m/^\Q$partid\E/) { next;}
                   3631: 	    if ($type eq 'awarded' || $type eq 'solved') { next; }
                   3632: 	    my $display=&Apache::lonnet::metadata($url,$stores.'.display');
1.551     raeburn  3633: 	    $display =~ s/\[Part: \Q$part\E\]//;
1.539     riegler  3634:             my $narrowtext = &mt('Tries');
                   3635: 	    $display =~ s/Number of Attempts/$narrowtext/;
                   3636: 	    $header .= '<th align="center">'.&mt('Old').' '.$display.'</th>'.
                   3637: 		'<th align="center">'.&mt('New').' '.$display.'</th>';
1.54      albertel 3638: 	    $columns{$partid}+=2;
                   3639: 	}
                   3640:     }
                   3641:     foreach my $partid (@partid) {
1.324     albertel 3642: 	my $display_part=&get_display_part($partid,$symb);
1.478     albertel 3643: 	$result .= '<th colspan="'.$columns{$partid}.'" align="center">'.
                   3644: 	    &mt('Part: [_1] (Weight = [_2])',$display_part,$weight{$partid}).
                   3645: 	    '</th>';
1.54      albertel 3646: 
1.44      ng       3647:     }
1.477     albertel 3648:     $result .= &Apache::loncommon::end_data_table_header_row().
                   3649: 	&Apache::loncommon::start_data_table_header_row().
                   3650: 	$header.
                   3651: 	&Apache::loncommon::end_data_table_header_row();
                   3652:     my @noupdate;
1.126     ng       3653:     my ($updateCtr,$noupdateCtr) = (1,1);
1.257     albertel 3654:     for ($i=0; $i<$env{'form.total'}; $i++) {
1.93      albertel 3655: 	my $line;
1.257     albertel 3656: 	my $user = $env{'form.ctr'.$i};
1.281     albertel 3657: 	my ($uname,$udom)=split(/:/,$user);
1.44      ng       3658: 	my %newrecord;
                   3659: 	my $updateflag = 0;
1.281     albertel 3660: 	$line .= '<td>'.&nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>';
1.108     albertel 3661: 	my $usec=$classlist->{"$uname:$udom"}[5];
1.105     albertel 3662: 	if (!&canmodify($usec)) {
1.126     ng       3663: 	    my $numcols=scalar(@partid)*4+2;
1.477     albertel 3664: 	    push(@noupdate,
1.478     albertel 3665: 		 $line."<td colspan=\"$numcols\"><span class=\"LC_warning\">".
                   3666: 		 &mt('Not allowed to modify student')."</span></td></tr>");
1.105     albertel 3667: 	    next;
                   3668: 	}
1.269     raeburn  3669:         my %aggregate = ();
                   3670:         my $aggregateflag = 0;
1.281     albertel 3671: 	$user=~s/:/_/; # colon doen't work in javascript for names
1.44      ng       3672: 	foreach (@partid) {
1.257     albertel 3673: 	    my $old_aw    = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
1.54      albertel 3674: 	    my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
                   3675: 	    my $old_part  = $old_aw eq '' ? '' : $old_part_pcr;
1.257     albertel 3676: 	    my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
                   3677: 	    my $awarded   = $env{'form.GD_'.$user.'_'.$_.'_awarded'};
1.54      albertel 3678: 	    my $pcr       = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
                   3679: 	    my $partial   = $awarded eq '' ? '' : $pcr;
1.44      ng       3680: 	    my $score;
                   3681: 	    if ($partial eq '') {
1.257     albertel 3682: 		$score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
1.44      ng       3683: 	    } elsif ($partial > 0) {
                   3684: 		$score = 'correct_by_override';
                   3685: 	    } elsif ($partial == 0) {
                   3686: 		$score = 'incorrect_by_override';
                   3687: 	    }
1.257     albertel 3688: 	    my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'};
1.125     ng       3689: 	    $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused'));
                   3690: 
1.292     albertel 3691: 	    $newrecord{'resource.'.$_.'.regrader'}=
                   3692: 		"$env{'user.name'}:$env{'user.domain'}";
1.125     ng       3693: 	    if ($dropMenu eq 'reset status' &&
                   3694: 		$old_score ne '') { # ignore if no previous attempts => nothing to reset
1.299     albertel 3695: 		$newrecord{'resource.'.$_.'.tries'} = '';
1.125     ng       3696: 		$newrecord{'resource.'.$_.'.solved'} = '';
                   3697: 		$newrecord{'resource.'.$_.'.award'} = '';
1.299     albertel 3698: 		$newrecord{'resource.'.$_.'.awarded'} = '';
1.125     ng       3699: 		$updateflag = 1;
1.269     raeburn  3700:                 if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) {
                   3701:                     my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'};
                   3702:                     my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'};
                   3703:                     my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'};
                   3704:                     &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                   3705:                     $aggregateflag = 1;
                   3706:                 }
1.139     albertel 3707: 	    } elsif (!($old_part eq $partial && $old_score eq $score)) {
                   3708: 		$updateflag = 1;
                   3709: 		$newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';
                   3710: 		$newrecord{'resource.'.$_.'.solved'}   = $score;
                   3711: 		$rec_update++;
1.125     ng       3712: 	    }
                   3713: 
1.93      albertel 3714: 	    $line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.
1.44      ng       3715: 		'<td align="center">'.$awarded.
                   3716: 		($score eq 'excused' ? $score : '').'&nbsp;</td>';
1.5       albertel 3717: 
1.54      albertel 3718: 
                   3719: 	    my $partid=$_;
                   3720: 	    foreach my $stores (@parts) {
                   3721: 		my ($part,$type) = &split_part_type($stores);
                   3722: 		if ($part !~ m/^\Q$partid\E/) { next;}
                   3723: 		if ($type eq 'awarded' || $type eq 'solved') { next; }
1.257     albertel 3724: 		my $old_aw    = $env{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'};
                   3725: 		my $awarded   = $env{'form.GD_'.$user.'_'.$part.'_'.$type};
1.54      albertel 3726: 		if ($awarded ne '' && $awarded ne $old_aw) {
                   3727: 		    $newrecord{'resource.'.$part.'.'.$type}= $awarded;
1.257     albertel 3728: 		    $newrecord{'resource.'.$part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
1.54      albertel 3729: 		    $updateflag=1;
                   3730: 		}
1.93      albertel 3731: 		$line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.
1.54      albertel 3732: 		    '<td align="center">'.$awarded.'&nbsp;</td>';
                   3733: 	    }
1.44      ng       3734: 	}
1.477     albertel 3735: 	$line.="\n";
1.301     albertel 3736: 
                   3737: 	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3738: 	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3739: 
1.44      ng       3740: 	if ($updateflag) {
                   3741: 	    $count++;
1.257     albertel 3742: 	    &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'},
1.89      albertel 3743: 				    $udom,$uname);
1.301     albertel 3744: 
                   3745: 	    if (&Apache::bridgetask::in_queue('gradingqueue',$symb,$cdom,
                   3746: 					      $cnum,$udom,$uname)) {
                   3747: 		# need to figure out if should be in queue.
                   3748: 		my %record =  
                   3749: 		    &Apache::lonnet::restore($symb,$env{'request.course.id'},
                   3750: 					     $udom,$uname);
                   3751: 		my $all_graded = 1;
                   3752: 		my $none_graded = 1;
                   3753: 		foreach my $part (@parts) {
                   3754: 		    if ( $record{'resource.'.$part.'.awarded'} eq '' ) {
                   3755: 			$all_graded = 0;
                   3756: 		    } else {
                   3757: 			$none_graded = 0;
                   3758: 		    }
                   3759: 		}
                   3760: 
                   3761: 		if ($all_graded || $none_graded) {
                   3762: 		    &Apache::bridgetask::remove_from_queue('gradingqueue',
                   3763: 							   $symb,$cdom,$cnum,
                   3764: 							   $udom,$uname);
                   3765: 		}
                   3766: 	    }
                   3767: 
1.477     albertel 3768: 	    $result.=&Apache::loncommon::start_data_table_row().
                   3769: 		'<td align="right">&nbsp;'.$updateCtr.'&nbsp;</td>'.$line.
                   3770: 		&Apache::loncommon::end_data_table_row();
1.126     ng       3771: 	    $updateCtr++;
1.93      albertel 3772: 	} else {
1.477     albertel 3773: 	    push(@noupdate,
                   3774: 		 '<td align="right">&nbsp;'.$noupdateCtr.'&nbsp;</td>'.$line);
1.126     ng       3775: 	    $noupdateCtr++;
1.44      ng       3776: 	}
1.269     raeburn  3777:         if ($aggregateflag) {
                   3778:             &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
1.301     albertel 3779: 				  $cdom,$cnum);
1.269     raeburn  3780:         }
1.93      albertel 3781:     }
1.477     albertel 3782:     if (@noupdate) {
1.126     ng       3783: #	my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
                   3784: 	my $numcols=scalar(@partid)*4+2;
1.477     albertel 3785: 	$result .= &Apache::loncommon::start_data_table_row('LC_empty_row').
1.478     albertel 3786: 	    '<td align="center" colspan="'.$numcols.'">'.
                   3787: 	    &mt('No Changes Occurred For the Students Below').
                   3788: 	    '</td>'.
1.477     albertel 3789: 	    &Apache::loncommon::end_data_table_row();
                   3790: 	foreach my $line (@noupdate) {
                   3791: 	    $result.=
                   3792: 		&Apache::loncommon::start_data_table_row().
                   3793: 		$line.
                   3794: 		&Apache::loncommon::end_data_table_row();
                   3795: 	}
1.44      ng       3796:     }
1.477     albertel 3797:     $result .= &Apache::loncommon::end_data_table().
                   3798: 	&show_grading_menu_form($symb);
1.478     albertel 3799:     my $msg = '<p><b>'.
                   3800: 	&mt('Number of records updated = [_1] for [quant,_2,student].',
                   3801: 	    $rec_update,$count).'</b><br />'.
                   3802: 	'<b>'.&mt('Total number of students = [_1]',$env{'form.total'}).
                   3803: 	'</b></p>';
1.44      ng       3804:     return $title.$msg.$result;
1.5       albertel 3805: }
1.54      albertel 3806: 
                   3807: sub split_part_type {
                   3808:     my ($partstr) = @_;
                   3809:     my ($temp,@allparts)=split(/_/,$partstr);
                   3810:     my $type=pop(@allparts);
1.439     albertel 3811:     my $part=join('_',@allparts);
1.54      albertel 3812:     return ($part,$type);
                   3813: }
                   3814: 
1.44      ng       3815: #------------- end of section for handling grading by section/class ---------
                   3816: #
                   3817: #----------------------------------------------------------------------------
                   3818: 
1.5       albertel 3819: 
1.44      ng       3820: #----------------------------------------------------------------------------
                   3821: #
                   3822: #-------------------------- Next few routines handles grading by csv upload
                   3823: #
                   3824: #--- Javascript to handle csv upload
1.27      albertel 3825: sub csvupload_javascript_reverse_associate {
1.573     bisitz   3826:     my $error1=&mt('You need to specify the username or the student/employee ID');
1.246     albertel 3827:     my $error2=&mt('You need to specify at least one grading field');
1.27      albertel 3828:   return(<<ENDPICK);
                   3829:   function verify(vf) {
                   3830:     var foundsomething=0;
                   3831:     var founduname=0;
1.243     albertel 3832:     var foundID=0;
1.27      albertel 3833:     for (i=0;i<=vf.nfields.value;i++) {
                   3834:       tw=eval('vf.f'+i+'.selectedIndex');
1.243     albertel 3835:       if (i==0 && tw!=0) { foundID=1; }
                   3836:       if (i==1 && tw!=0) { founduname=1; }
                   3837:       if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; }
1.27      albertel 3838:     }
1.246     albertel 3839:     if (founduname==0 && foundID==0) {
                   3840: 	alert('$error1');
                   3841: 	return;
1.27      albertel 3842:     }
                   3843:     if (foundsomething==0) {
1.246     albertel 3844: 	alert('$error2');
                   3845: 	return;
1.27      albertel 3846:     }
                   3847:     vf.submit();
                   3848:   }
                   3849:   function flip(vf,tf) {
                   3850:     var nw=eval('vf.f'+tf+'.selectedIndex');
                   3851:     var i;
                   3852:     for (i=0;i<=vf.nfields.value;i++) {
                   3853:       //can not pick the same destination field for both name and domain
                   3854:       if (((i ==0)||(i ==1)) && 
                   3855:           ((tf==0)||(tf==1)) && 
                   3856:           (i!=tf) &&
                   3857:           (eval('vf.f'+i+'.selectedIndex')==nw)) {
                   3858:         eval('vf.f'+i+'.selectedIndex=0;')
                   3859:       }
                   3860:     }
                   3861:   }
                   3862: ENDPICK
                   3863: }
                   3864: 
                   3865: sub csvupload_javascript_forward_associate {
1.573     bisitz   3866:     my $error1=&mt('You need to specify the username or the student/employee ID');
1.246     albertel 3867:     my $error2=&mt('You need to specify at least one grading field');
1.27      albertel 3868:   return(<<ENDPICK);
                   3869:   function verify(vf) {
                   3870:     var foundsomething=0;
                   3871:     var founduname=0;
1.243     albertel 3872:     var foundID=0;
1.27      albertel 3873:     for (i=0;i<=vf.nfields.value;i++) {
                   3874:       tw=eval('vf.f'+i+'.selectedIndex');
1.243     albertel 3875:       if (tw==1) { foundID=1; }
                   3876:       if (tw==2) { founduname=1; }
                   3877:       if (tw>3) { foundsomething=1; }
1.27      albertel 3878:     }
1.246     albertel 3879:     if (founduname==0 && foundID==0) {
                   3880: 	alert('$error1');
                   3881: 	return;
1.27      albertel 3882:     }
                   3883:     if (foundsomething==0) {
1.246     albertel 3884: 	alert('$error2');
                   3885: 	return;
1.27      albertel 3886:     }
                   3887:     vf.submit();
                   3888:   }
                   3889:   function flip(vf,tf) {
                   3890:     var nw=eval('vf.f'+tf+'.selectedIndex');
                   3891:     var i;
                   3892:     //can not pick the same destination field twice
                   3893:     for (i=0;i<=vf.nfields.value;i++) {
                   3894:       if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) {
                   3895:         eval('vf.f'+i+'.selectedIndex=0;')
                   3896:       }
                   3897:     }
                   3898:   }
                   3899: ENDPICK
                   3900: }
                   3901: 
1.26      albertel 3902: sub csvuploadmap_header {
1.324     albertel 3903:     my ($request,$symb,$datatoken,$distotal)= @_;
1.41      ng       3904:     my $javascript;
1.257     albertel 3905:     if ($env{'form.upfile_associate'} eq 'reverse') {
1.41      ng       3906: 	$javascript=&csvupload_javascript_reverse_associate();
                   3907:     } else {
                   3908: 	$javascript=&csvupload_javascript_forward_associate();
                   3909:     }
1.45      ng       3910: 
1.324     albertel 3911:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.257     albertel 3912:     my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
1.245     albertel 3913:     my $ignore=&mt('Ignore First Line');
1.418     albertel 3914:     $symb = &Apache::lonenc::check_encrypt($symb);
1.41      ng       3915:     $request->print(<<ENDPICK);
1.26      albertel 3916: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.398     albertel 3917: <h3><span class="LC_info">Uploading Class Grades</span></h3>
1.45      ng       3918: $result
1.326     albertel 3919: <hr />
1.26      albertel 3920: <h3>Identify fields</h3>
                   3921: Total number of records found in file: $distotal <hr />
                   3922: Enter as many fields as you can. The system will inform you and bring you back
                   3923: to this page if the data selected is insufficient to run your class.<hr />
1.589     bisitz   3924: <input type="button" value="Reverse Association" onclick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />
1.245     albertel 3925: <label><input type="checkbox" name="noFirstLine" $checked />$ignore</label>
1.26      albertel 3926: <input type="hidden" name="associate"  value="" />
                   3927: <input type="hidden" name="phase"      value="three" />
                   3928: <input type="hidden" name="datatoken"  value="$datatoken" />
1.257     albertel 3929: <input type="hidden" name="fileupload" value="$env{'form.fileupload'}" />
                   3930: <input type="hidden" name="upfiletype" value="$env{'form.upfiletype'}" />
1.26      albertel 3931: <input type="hidden" name="upfile_associate" 
1.257     albertel 3932:                                        value="$env{'form.upfile_associate'}" />
1.26      albertel 3933: <input type="hidden" name="symb"       value="$symb" />
1.257     albertel 3934: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
                   3935: <input type="hidden" name="probTitle"  value="$env{'form.probTitle'}" />
1.246     albertel 3936: <input type="hidden" name="command"    value="csvuploadoptions" />
1.26      albertel 3937: <hr />
                   3938: <script type="text/javascript" language="Javascript">
                   3939: $javascript
                   3940: </script>
                   3941: ENDPICK
1.118     ng       3942:     return '';
1.26      albertel 3943: 
                   3944: }
                   3945: 
                   3946: sub csvupload_fields {
1.582     raeburn  3947:     my ($symb,$errorref) = @_;
                   3948:     my (@parts) = &getpartlist($symb,$errorref);
                   3949:     if (ref($errorref)) {
                   3950:         if ($$errorref) {
                   3951:             return;
                   3952:         }
                   3953:     }
                   3954: 
1.556     weissno  3955:     my @fields=(['ID','Student/Employee ID'],
1.243     albertel 3956: 		['username','Student Username'],
                   3957: 		['domain','Student Domain']);
1.324     albertel 3958:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.41      ng       3959:     foreach my $part (sort(@parts)) {
                   3960: 	my @datum;
                   3961: 	my $display=&Apache::lonnet::metadata($url,$part.'.display');
                   3962: 	my $name=$part;
                   3963: 	if  (!$display) { $display = $name; }
                   3964: 	@datum=($name,$display);
1.244     albertel 3965: 	if ($name=~/^stores_(.*)_awarded/) {
                   3966: 	    push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]);
                   3967: 	}
1.41      ng       3968: 	push(@fields,\@datum);
                   3969:     }
                   3970:     return (@fields);
1.26      albertel 3971: }
                   3972: 
                   3973: sub csvuploadmap_footer {
1.41      ng       3974:     my ($request,$i,$keyfields) =@_;
                   3975:     $request->print(<<ENDPICK);
1.26      albertel 3976: </table>
                   3977: <input type="hidden" name="nfields" value="$i" />
                   3978: <input type="hidden" name="keyfields" value="$keyfields" />
1.589     bisitz   3979: <input type="button" onclick="javascript:verify(this.form)" value="Assign Grades" /><br />
1.26      albertel 3980: </form>
                   3981: ENDPICK
                   3982: }
                   3983: 
1.283     albertel 3984: sub checkforfile_js {
1.539     riegler  3985:     my $alertmsg = &mt('Please use the browse button to select a file from your local directory.');
1.86      ng       3986:     my $result =<<CSVFORMJS;
                   3987: <script type="text/javascript" language="javascript">
                   3988:     function checkUpload(formname) {
                   3989: 	if (formname.upfile.value == "") {
1.539     riegler  3990: 	    alert("$alertmsg");
1.86      ng       3991: 	    return false;
                   3992: 	}
                   3993: 	formname.submit();
                   3994:     }
                   3995:     </script>
                   3996: CSVFORMJS
1.283     albertel 3997:     return $result;
                   3998: }
                   3999: 
                   4000: sub upcsvScores_form {
                   4001:     my ($request) = shift;
1.324     albertel 4002:     my ($symb)=&get_symb($request);
1.283     albertel 4003:     if (!$symb) {return '';}
                   4004:     my $result=&checkforfile_js();
1.257     albertel 4005:     $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
1.324     albertel 4006:     my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
1.118     ng       4007:     $result.=$table;
1.326     albertel 4008:     $result.='<br /><table width="100%" border="0"><tr><td bgcolor="#777777">'."\n";
                   4009:     $result.='<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>'."\n";
1.538     schulted 4010:     $result.='&nbsp;<b>'.&mt('Specify a file containing the class scores for current resource.').
                   4011: 	'</b></td></tr>'."\n";
1.86      ng       4012:     $result.='<tr bgcolor=#ffffe6><td>'."\n";
1.370     www      4013:     my $upload=&mt("Upload Scores");
1.86      ng       4014:     my $upfile_select=&Apache::loncommon::upfile_select_html();
1.245     albertel 4015:     my $ignore=&mt('Ignore First Line');
1.418     albertel 4016:     $symb = &Apache::lonenc::check_encrypt($symb);
1.86      ng       4017:     $result.=<<ENDUPFORM;
1.106     albertel 4018: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.86      ng       4019: <input type="hidden" name="symb" value="$symb" />
                   4020: <input type="hidden" name="command" value="csvuploadmap" />
1.257     albertel 4021: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   4022: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
1.86      ng       4023: $upfile_select
1.589     bisitz   4024: <br /><input type="button" onclick="javascript:checkUpload(this.form);" value="$upload" />
1.283     albertel 4025: <label><input type="checkbox" name="noFirstLine" />$ignore</label>
1.86      ng       4026: </form>
                   4027: ENDUPFORM
1.370     www      4028:     $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV",
                   4029:                            &mt("How do I create a CSV file from a spreadsheet"))
                   4030:     .'</td></tr></table>'."\n";
1.86      ng       4031:     $result.='</td></tr></table><br /><br />'."\n";
1.324     albertel 4032:     $result.=&show_grading_menu_form($symb);
1.86      ng       4033:     return $result;
                   4034: }
                   4035: 
                   4036: 
1.26      albertel 4037: sub csvuploadmap {
1.41      ng       4038:     my ($request)= @_;
1.324     albertel 4039:     my ($symb)=&get_symb($request);
1.41      ng       4040:     if (!$symb) {return '';}
1.72      ng       4041: 
1.41      ng       4042:     my $datatoken;
1.257     albertel 4043:     if (!$env{'form.datatoken'}) {
1.41      ng       4044: 	$datatoken=&Apache::loncommon::upfile_store($request);
1.26      albertel 4045:     } else {
1.257     albertel 4046: 	$datatoken=$env{'form.datatoken'};
1.41      ng       4047: 	&Apache::loncommon::load_tmp_file($request);
1.26      albertel 4048:     }
1.41      ng       4049:     my @records=&Apache::loncommon::upfile_record_sep();
1.257     albertel 4050:     if ($env{'form.noFirstLine'}) { shift(@records); }
1.324     albertel 4051:     &csvuploadmap_header($request,$symb,$datatoken,$#records+1);
1.41      ng       4052:     my ($i,$keyfields);
                   4053:     if (@records) {
1.582     raeburn  4054:         my $fieldserror;
                   4055: 	my @fields=&csvupload_fields($symb,\$fieldserror);
                   4056:         if ($fieldserror) {
                   4057:             $request->print(&navmap_errormsg());
                   4058:             return;
                   4059:         }
1.257     albertel 4060: 	if ($env{'form.upfile_associate'} eq 'reverse') {	
1.41      ng       4061: 	    &Apache::loncommon::csv_print_samples($request,\@records);
                   4062: 	    $i=&Apache::loncommon::csv_print_select_table($request,\@records,
                   4063: 							  \@fields);
                   4064: 	    foreach (@fields) { $keyfields.=$_->[0].','; }
                   4065: 	    chop($keyfields);
                   4066: 	} else {
                   4067: 	    unshift(@fields,['none','']);
                   4068: 	    $i=&Apache::loncommon::csv_samples_select_table($request,\@records,
                   4069: 							    \@fields);
1.311     banghart 4070:             foreach my $rec (@records) {
                   4071:                 my %temp = &Apache::loncommon::record_sep($rec);
                   4072:                 if (%temp) {
                   4073:                     $keyfields=join(',',sort(keys(%temp)));
                   4074:                     last;
                   4075:                 }
                   4076:             }
1.41      ng       4077: 	}
                   4078:     }
                   4079:     &csvuploadmap_footer($request,$i,$keyfields);
1.324     albertel 4080:     $request->print(&show_grading_menu_form($symb));
1.72      ng       4081: 
1.41      ng       4082:     return '';
1.27      albertel 4083: }
                   4084: 
1.246     albertel 4085: sub csvuploadoptions {
1.41      ng       4086:     my ($request)= @_;
1.324     albertel 4087:     my ($symb)=&get_symb($request);
1.257     albertel 4088:     my $checked=(($env{'form.noFirstLine'})?'1':'0');
1.246     albertel 4089:     my $ignore=&mt('Ignore First Line');
                   4090:     $request->print(<<ENDPICK);
                   4091: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.398     albertel 4092: <h3><span class="LC_info">Uploading Class Grade Options</span></h3>
1.246     albertel 4093: <input type="hidden" name="command"    value="csvuploadassign" />
1.302     albertel 4094: <!--
1.246     albertel 4095: <p>
                   4096: <label>
                   4097:    <input type="checkbox" name="show_full_results" />
                   4098:    Show a table of all changes
                   4099: </label>
                   4100: </p>
1.302     albertel 4101: -->
1.246     albertel 4102: <p>
                   4103: <label>
                   4104:    <input type="checkbox" name="overwite_scores" checked="checked" />
                   4105:    Overwrite any existing score
                   4106: </label>
                   4107: </p>
                   4108: ENDPICK
                   4109:     my %fields=&get_fields();
                   4110:     if (!defined($fields{'domain'})) {
1.257     albertel 4111: 	my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain');
1.246     albertel 4112: 	$request->print("\n<p> Users are in domain: ".$domform."</p>\n");
                   4113:     }
1.257     albertel 4114:     foreach my $key (sort(keys(%env))) {
1.246     albertel 4115: 	if ($key !~ /^form\.(.*)$/) { next; }
                   4116: 	my $cleankey=$1;
                   4117: 	if ($cleankey eq 'command') { next; }
                   4118: 	$request->print('<input type="hidden" name="'.$cleankey.
1.257     albertel 4119: 			'"  value="'.$env{$key}.'" />'."\n");
1.246     albertel 4120:     }
                   4121:     # FIXME do a check for any duplicated user ids...
                   4122:     # FIXME do a check for any invalid user ids?...
1.290     albertel 4123:     $request->print('<input type="submit" value="Assign Grades" /><br />
                   4124: <hr /></form>'."\n");
1.324     albertel 4125:     $request->print(&show_grading_menu_form($symb));
1.246     albertel 4126:     return '';
                   4127: }
                   4128: 
                   4129: sub get_fields {
                   4130:     my %fields;
1.257     albertel 4131:     my @keyfields = split(/\,/,$env{'form.keyfields'});
                   4132:     for (my $i=0; $i<=$env{'form.nfields'}; $i++) {
                   4133: 	if ($env{'form.upfile_associate'} eq 'reverse') {
                   4134: 	    if ($env{'form.f'.$i} ne 'none') {
                   4135: 		$fields{$keyfields[$i]}=$env{'form.f'.$i};
1.41      ng       4136: 	    }
                   4137: 	} else {
1.257     albertel 4138: 	    if ($env{'form.f'.$i} ne 'none') {
                   4139: 		$fields{$env{'form.f'.$i}}=$keyfields[$i];
1.41      ng       4140: 	    }
                   4141: 	}
1.27      albertel 4142:     }
1.246     albertel 4143:     return %fields;
                   4144: }
                   4145: 
                   4146: sub csvuploadassign {
                   4147:     my ($request)= @_;
1.324     albertel 4148:     my ($symb)=&get_symb($request);
1.246     albertel 4149:     if (!$symb) {return '';}
1.345     bowersj2 4150:     my $error_msg = '';
1.246     albertel 4151:     &Apache::loncommon::load_tmp_file($request);
                   4152:     my @gradedata = &Apache::loncommon::upfile_record_sep();
1.257     albertel 4153:     if ($env{'form.noFirstLine'}) { shift(@gradedata); }
1.246     albertel 4154:     my %fields=&get_fields();
1.41      ng       4155:     $request->print('<h3>Assigning Grades</h3>');
1.257     albertel 4156:     my $courseid=$env{'request.course.id'};
1.97      albertel 4157:     my ($classlist) = &getclasslist('all',0);
1.106     albertel 4158:     my @notallowed;
1.41      ng       4159:     my @skipped;
                   4160:     my $countdone=0;
                   4161:     foreach my $grade (@gradedata) {
                   4162: 	my %entries=&Apache::loncommon::record_sep($grade);
1.246     albertel 4163: 	my $domain;
                   4164: 	if ($entries{$fields{'domain'}}) {
                   4165: 	    $domain=$entries{$fields{'domain'}};
                   4166: 	} else {
1.257     albertel 4167: 	    $domain=$env{'form.default_domain'};
1.246     albertel 4168: 	}
1.243     albertel 4169: 	$domain=~s/\s//g;
1.41      ng       4170: 	my $username=$entries{$fields{'username'}};
1.160     albertel 4171: 	$username=~s/\s//g;
1.243     albertel 4172: 	if (!$username) {
                   4173: 	    my $id=$entries{$fields{'ID'}};
1.247     albertel 4174: 	    $id=~s/\s//g;
1.243     albertel 4175: 	    my %ids=&Apache::lonnet::idget($domain,$id);
                   4176: 	    $username=$ids{$id};
                   4177: 	}
1.41      ng       4178: 	if (!exists($$classlist{"$username:$domain"})) {
1.247     albertel 4179: 	    my $id=$entries{$fields{'ID'}};
                   4180: 	    $id=~s/\s//g;
                   4181: 	    if ($id) {
                   4182: 		push(@skipped,"$id:$domain");
                   4183: 	    } else {
                   4184: 		push(@skipped,"$username:$domain");
                   4185: 	    }
1.41      ng       4186: 	    next;
                   4187: 	}
1.108     albertel 4188: 	my $usec=$classlist->{"$username:$domain"}[5];
1.106     albertel 4189: 	if (!&canmodify($usec)) {
                   4190: 	    push(@notallowed,"$username:$domain");
                   4191: 	    next;
                   4192: 	}
1.244     albertel 4193: 	my %points;
1.41      ng       4194: 	my %grades;
                   4195: 	foreach my $dest (keys(%fields)) {
1.244     albertel 4196: 	    if ($dest eq 'ID' || $dest eq 'username' ||
                   4197: 		$dest eq 'domain') { next; }
                   4198: 	    if ($entries{$fields{$dest}} =~ /^\s*$/) { next; }
                   4199: 	    if ($dest=~/stores_(.*)_points/) {
                   4200: 		my $part=$1;
                   4201: 		my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',
                   4202: 					      $symb,$domain,$username);
1.345     bowersj2 4203:                 if ($wgt) {
                   4204:                     $entries{$fields{$dest}}=~s/\s//g;
                   4205:                     my $pcr=$entries{$fields{$dest}} / $wgt;
1.463     albertel 4206:                     my $award=($pcr == 0) ? 'incorrect_by_override'
                   4207:                                           : 'correct_by_override';
1.345     bowersj2 4208:                     $grades{"resource.$part.awarded"}=$pcr;
                   4209:                     $grades{"resource.$part.solved"}=$award;
                   4210:                     $points{$part}=1;
                   4211:                 } else {
                   4212:                     $error_msg = "<br />" .
                   4213:                         &mt("Some point values were assigned"
                   4214:                             ." for problems with a weight "
                   4215:                             ."of zero. These values were "
                   4216:                             ."ignored.");
                   4217:                 }
1.244     albertel 4218: 	    } else {
                   4219: 		if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }
                   4220: 		if ($dest=~/stores_(.*)_solved/)  { if ($points{$1}) {next;} }
                   4221: 		my $store_key=$dest;
                   4222: 		$store_key=~s/^stores/resource/;
                   4223: 		$store_key=~s/_/\./g;
                   4224: 		$grades{$store_key}=$entries{$fields{$dest}};
                   4225: 	    }
1.41      ng       4226: 	}
1.508     www      4227: 	if (! %grades) { 
                   4228:            push(@skipped,&mt("[_1]: no data to save","$username:$domain")); 
                   4229:         } else {
                   4230: 	   $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
                   4231: 	   my $result=&Apache::lonnet::cstore(\%grades,$symb,
1.302     albertel 4232: 					   $env{'request.course.id'},
                   4233: 					   $domain,$username);
1.508     www      4234: 	   if ($result eq 'ok') {
                   4235: 	      $request->print('.');
                   4236: 	   } else {
                   4237: 	      $request->print("<p><span class=\"LC_error\">".
                   4238:                               &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]",
                   4239:                                   "$username:$domain",$result)."</span></p>");
                   4240: 	   }
                   4241: 	   $request->rflush();
                   4242: 	   $countdone++;
                   4243:         }
1.41      ng       4244:     }
1.570     www      4245:     $request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0));
1.41      ng       4246:     if (@skipped) {
1.571     www      4247: 	$request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('No scores stored for the following username(s):'),1).'<br />');
                   4248:         $request->print(join(', ',@skipped));
1.106     albertel 4249:     }
                   4250:     if (@notallowed) {
1.571     www      4251: 	$request->print('<br />'.&Apache::lonhtmlcommon::confirm_success(&mt('Modification of scores not allowed for the following username(s):'),1).'<br />');
                   4252: 	$request->print(join(', ',@notallowed));
1.41      ng       4253:     }
1.106     albertel 4254:     $request->print("<br />\n");
1.324     albertel 4255:     $request->print(&show_grading_menu_form($symb));
1.345     bowersj2 4256:     return $error_msg;
1.26      albertel 4257: }
1.44      ng       4258: #------------- end of section for handling csv file upload ---------
                   4259: #
                   4260: #-------------------------------------------------------------------
                   4261: #
1.122     ng       4262: #-------------- Next few routines handle grading by page/sequence
1.72      ng       4263: #
                   4264: #--- Select a page/sequence and a student to grade
1.68      ng       4265: sub pickStudentPage {
                   4266:     my ($request) = shift;
                   4267: 
1.539     riegler  4268:     my $alertmsg = &mt('Please select the student you wish to grade.');
1.68      ng       4269:     $request->print(<<LISTJAVASCRIPT);
                   4270: <script type="text/javascript" language="javascript">
                   4271: 
                   4272: function checkPickOne(formname) {
1.76      ng       4273:     if (radioSelection(formname.student) == null) {
1.539     riegler  4274: 	alert("$alertmsg");
1.68      ng       4275: 	return;
                   4276:     }
1.125     ng       4277:     ptr = pullDownSelection(formname.selectpage);
                   4278:     formname.page.value = formname["page"+ptr].value;
                   4279:     formname.title.value = formname["title"+ptr].value;
1.68      ng       4280:     formname.submit();
                   4281: }
                   4282: 
                   4283: </script>
                   4284: LISTJAVASCRIPT
1.118     ng       4285:     &commonJSfunctions($request);
1.324     albertel 4286:     my ($symb) = &get_symb($request);
1.257     albertel 4287:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4288:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4289:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
1.68      ng       4290: 
1.398     albertel 4291:     my $result='<h3><span class="LC_info">&nbsp;'.
1.485     albertel 4292: 	&mt('Manual Grading by Page or Sequence').'</span></h3>';
1.68      ng       4293: 
1.80      ng       4294:     $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";
1.582     raeburn  4295:     my $map_error;
                   4296:     my ($titles,$symbx) = &getSymbMap($map_error);
                   4297:     if ($map_error) {
                   4298:         $request->print(&navmap_errormsg());
                   4299:         return; 
                   4300:     }
1.137     albertel 4301:     my ($curpage) =&Apache::lonnet::decode_symb($symb); 
                   4302: #    my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 
                   4303: #    my $type=($curpage =~ /\.(page|sequence)/);
1.485     albertel 4304:     my $select = '<select name="selectpage">'."\n";
1.70      ng       4305:     my $ctr=0;
1.68      ng       4306:     foreach (@$titles) {
                   4307: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
1.485     albertel 4308: 	$select.='<option value="'.$ctr.'" '.
1.401     albertel 4309: 	    ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : '').
1.71      ng       4310: 	    '>'.$showtitle.'</option>'."\n";
1.70      ng       4311: 	$ctr++;
1.68      ng       4312:     }
1.485     albertel 4313:     $select.= '</select>';
1.539     riegler  4314:     $result.='&nbsp;<b>'.&mt('Problems from').':</b> '.$select."<br />\n";
1.485     albertel 4315: 
1.70      ng       4316:     $ctr=0;
                   4317:     foreach (@$titles) {
                   4318: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
                   4319: 	$result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n";
                   4320: 	$result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n";
                   4321: 	$ctr++;
                   4322:     }
1.72      ng       4323:     $result.='<input type="hidden" name="page" />'."\n".
                   4324: 	'<input type="hidden" name="title" />'."\n";
1.68      ng       4325: 
1.485     albertel 4326:     my $options =
                   4327: 	'<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n".
                   4328: 	'<label><input type="radio" name="vProb" value="yes" /> '.&mt('yes').' </label>'."<br />\n";
1.539     riegler  4329:     $result.='&nbsp;<b>'.&mt('View Problem Text').': </b>'.$options;
1.485     albertel 4330: 
                   4331:     $options =
                   4332: 	'<label><input type="radio" name="lastSub" value="none" /> '.&mt('none').' </label>'."\n".
                   4333: 	'<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '.&mt('by dates and submissions').'</label>'."\n".
                   4334: 	'<label><input type="radio" name="lastSub" value="all" /> '.&mt('all details').' </label>'."\n";
1.539     riegler  4335:     $result.='&nbsp;<b>'.&mt('Submissions').': </b>'.$options;
1.432     banghart 4336:     
                   4337:     $result.=&build_section_inputs();
1.442     banghart 4338:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
                   4339:     $result.='<input type="hidden" name="Status"  value="'.$stu_status.'" />'."\n".
1.72      ng       4340: 	'<input type="hidden" name="command" value="displayPage" />'."\n".
1.418     albertel 4341: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 4342: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."<br />\n";
1.72      ng       4343: 
1.539     riegler  4344:     $result.='&nbsp;<b>'.&mt('Use CODE').': </b> <input type="text" name="CODE" value="" /> <br />'."\n";
1.382     albertel 4345: 
1.80      ng       4346:     $result.='&nbsp;<input type="button" '.
1.589     bisitz   4347:              'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' &rarr;" /><br />'."\n";
1.72      ng       4348: 
1.68      ng       4349:     $request->print($result);
                   4350: 
1.485     albertel 4351:     my $studentTable.='&nbsp;<b>'.&mt('Select a student you wish to grade and then click on the Next button.').'</b><br />'.
1.484     albertel 4352: 	&Apache::loncommon::start_data_table().
                   4353: 	&Apache::loncommon::start_data_table_header_row().
1.485     albertel 4354: 	'<th align="right">&nbsp;'.&mt('No.').'</th>'.
1.484     albertel 4355: 	'<th>'.&nameUserString('header').'</th>'.
1.485     albertel 4356: 	'<th align="right">&nbsp;'.&mt('No.').'</th>'.
1.484     albertel 4357: 	'<th>'.&nameUserString('header').'</th>'.
                   4358: 	&Apache::loncommon::end_data_table_header_row();
1.68      ng       4359:  
1.76      ng       4360:     my (undef,undef,$fullname) = &getclasslist($getsec,'1');
1.68      ng       4361:     my $ptr = 1;
1.294     albertel 4362:     foreach my $student (sort 
                   4363: 			 {
                   4364: 			     if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   4365: 				 return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   4366: 			     }
                   4367: 			     return $a cmp $b;
                   4368: 			 } (keys(%$fullname))) {
1.68      ng       4369: 	my ($uname,$udom) = split(/:/,$student);
1.484     albertel 4370: 	$studentTable.=($ptr%2==1 ? &Apache::loncommon::start_data_table_row()
                   4371:                                   : '</td>');
1.126     ng       4372: 	$studentTable.='<td align="right">'.$ptr.'&nbsp;</td>';
1.288     albertel 4373: 	$studentTable.='<td>&nbsp;<label><input type="radio" name="student" value="'.$student.'" /> '
                   4374: 	    .&nameUserString(undef,$$fullname{$student},$uname,$udom)."</label>\n";
1.484     albertel 4375: 	$studentTable.=
                   4376: 	    ($ptr%2 == 0 ? '</td>'.&Apache::loncommon::end_data_table_row() 
                   4377:                          : '');
1.68      ng       4378: 	$ptr++;
                   4379:     }
1.484     albertel 4380:     if ($ptr%2 == 0) {
                   4381: 	$studentTable.='</td><td>&nbsp;</td><td>&nbsp;</td>'.
                   4382: 	    &Apache::loncommon::end_data_table_row();
                   4383:     }
                   4384:     $studentTable.=&Apache::loncommon::end_data_table()."\n";
1.126     ng       4385:     $studentTable.='<input type="button" '.
1.589     bisitz   4386:                    'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' &rarr;" /></form>'."\n";
1.68      ng       4387: 
1.324     albertel 4388:     $studentTable.=&show_grading_menu_form($symb);
1.68      ng       4389:     $request->print($studentTable);
                   4390: 
                   4391:     return '';
                   4392: }
                   4393: 
                   4394: sub getSymbMap {
1.582     raeburn  4395:     my ($map_error) = @_;
1.132     bowersj2 4396:     my $navmap = Apache::lonnavmaps::navmap->new();
1.582     raeburn  4397:     unless (ref($navmap)) {
                   4398:         if (ref($map_error)) {
                   4399:             $$map_error = 'navmap';
                   4400:         }
                   4401:         return;
                   4402:     }
1.68      ng       4403:     my %symbx = ();
                   4404:     my @titles = ();
1.117     bowersj2 4405:     my $minder = 0;
                   4406: 
                   4407:     # Gather every sequence that has problems.
1.240     albertel 4408:     my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); },
                   4409: 					       1,0,1);
1.117     bowersj2 4410:     for my $sequence ($navmap->getById('0.0'), @sequences) {
1.241     albertel 4411: 	if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {
1.381     albertel 4412: 	    my $title = $minder.'.'.
                   4413: 		&HTML::Entities::encode($sequence->compTitle(),'"\'&');
                   4414: 	    push(@titles, $title); # minder in case two titles are identical
                   4415: 	    $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&');
1.117     bowersj2 4416: 	    $minder++;
1.241     albertel 4417: 	}
1.68      ng       4418:     }
                   4419:     return \@titles,\%symbx;
                   4420: }
                   4421: 
1.72      ng       4422: #
                   4423: #--- Displays a page/sequence w/wo problems, w/wo submissions
1.68      ng       4424: sub displayPage {
                   4425:     my ($request) = shift;
                   4426: 
1.324     albertel 4427:     my ($symb) = &get_symb($request);
1.257     albertel 4428:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4429:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4430:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
                   4431:     my $pageTitle = $env{'form.page'};
1.103     albertel 4432:     my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
1.257     albertel 4433:     my ($uname,$udom) = split(/:/,$env{'form.student'});
                   4434:     my $usec=$classlist->{$env{'form.student'}}[5];
1.168     albertel 4435: 
                   4436:     #need to make sure we have the correct data for later EXT calls, 
                   4437:     #thus invalidate the cache
                   4438:     &Apache::lonnet::devalidatecourseresdata(
1.257     albertel 4439:                  $env{'course.'.$env{'request.course.id'}.'.num'},
                   4440:                  $env{'course.'.$env{'request.course.id'}.'.domain'});
1.168     albertel 4441:     &Apache::lonnet::clear_EXT_cache_status();
                   4442: 
1.103     albertel 4443:     if (!&canview($usec)) {
1.485     albertel 4444: 	$request->print('<span class="LC_warning">'.&mt('Unable to view requested student. ([_1])',$env{'form.student'}).'</span>');
1.324     albertel 4445: 	$request->print(&show_grading_menu_form($symb));
1.103     albertel 4446: 	return;
                   4447:     }
1.398     albertel 4448:     my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';
1.485     albertel 4449:     $result.='<h3>&nbsp;'.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)).
1.129     ng       4450: 	'</h3>'."\n";
1.500     albertel 4451:     $env{'form.CODE'} = uc($env{'form.CODE'});
1.501     foxr     4452:     if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) {
1.485     albertel 4453: 	$result.='<h3>&nbsp;'.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n";
1.382     albertel 4454:     } else {
                   4455: 	delete($env{'form.CODE'});
                   4456:     }
1.71      ng       4457:     &sub_page_js($request);
                   4458:     $request->print($result);
                   4459: 
1.132     bowersj2 4460:     my $navmap = Apache::lonnavmaps::navmap->new();
1.582     raeburn  4461:     unless (ref($navmap)) {
                   4462:         $request->print(&navmap_errormsg());
                   4463:         $request->print(&show_grading_menu_form($symb));
                   4464:         return;
                   4465:     }
1.257     albertel 4466:     my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'});
1.68      ng       4467:     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
1.288     albertel 4468:     if (!$map) {
1.485     albertel 4469: 	$request->print('<span class="LC_warning">'.&mt('Unable to view requested sequence. ([_1])',$resUrl).'</span>');
1.324     albertel 4470: 	$request->print(&show_grading_menu_form($symb));
1.288     albertel 4471: 	return; 
                   4472:     }
1.68      ng       4473:     my $iterator = $navmap->getIterator($map->map_start(),
                   4474: 					$map->map_finish());
                   4475: 
1.71      ng       4476:     my $studentTable='<form action="/adm/grades" method="post" name="gradePage">'."\n".
1.72      ng       4477: 	'<input type="hidden" name="command" value="gradeByPage" />'."\n".
1.257     albertel 4478: 	'<input type="hidden" name="fullname" value="'.$$fullname{$env{'form.student'}}.'" />'."\n".
                   4479: 	'<input type="hidden" name="student" value="'.$env{'form.student'}.'" />'."\n".
1.72      ng       4480: 	'<input type="hidden" name="page"    value="'.$pageTitle.'" />'."\n".
1.257     albertel 4481: 	'<input type="hidden" name="title"   value="'.$env{'form.title'}.'" />'."\n".
1.418     albertel 4482: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.125     ng       4483: 	'<input type="hidden" name="overRideScore" value="no" />'."\n".
1.257     albertel 4484: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n";
1.71      ng       4485: 
1.382     albertel 4486:     if (defined($env{'form.CODE'})) {
                   4487: 	$studentTable.=
                   4488: 	    '<input type="hidden" name="CODE" value="'.$env{'form.CODE'}.'" />'."\n";
                   4489:     }
1.381     albertel 4490:     my $checkIcon = '<img alt="'.&mt('Check Mark').
1.485     albertel 4491: 	'" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />';
1.71      ng       4492: 
1.594     bisitz   4493:     $studentTable.='&nbsp;<span class="LC_info">'.
                   4494:         &mt('Problems graded correct by the computer are marked with a [_1] symbol.',$checkIcon).
                   4495:         '</span>'."\n".
1.484     albertel 4496: 	&Apache::loncommon::start_data_table().
                   4497: 	&Apache::loncommon::start_data_table_header_row().
                   4498: 	'<th align="center">&nbsp;Prob.&nbsp;</th>'.
1.485     albertel 4499: 	'<th>&nbsp;'.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').'</th>'.
1.484     albertel 4500: 	&Apache::loncommon::end_data_table_header_row();
1.71      ng       4501: 
1.329     albertel 4502:     &Apache::lonxml::clear_problem_counter();
1.196     albertel 4503:     my ($depth,$question,$prob) = (1,1,1);
1.68      ng       4504:     $iterator->next(); # skip the first BEGIN_MAP
                   4505:     my $curRes = $iterator->next(); # for "current resource"
1.101     albertel 4506:     while ($depth > 0) {
1.68      ng       4507:         if($curRes == $iterator->BEGIN_MAP) { $depth++; }
1.100     bowersj2 4508:         if($curRes == $iterator->END_MAP) { $depth--; }
1.68      ng       4509: 
1.385     albertel 4510:         if (ref($curRes) && $curRes->is_problem()) {
1.91      albertel 4511: 	    my $parts = $curRes->parts();
1.68      ng       4512:             my $title = $curRes->compTitle();
1.71      ng       4513: 	    my $symbx = $curRes->symb();
1.484     albertel 4514: 	    $studentTable.=
                   4515: 		&Apache::loncommon::start_data_table_row().
                   4516: 		'<td align="center" valign="top" >'.$prob.
1.485     albertel 4517: 		(scalar(@{$parts}) == 1 ? '' 
                   4518: 		                        : '<br />('.&mt('[_1]&nbsp;parts)',
                   4519: 							scalar(@{$parts}))
                   4520: 		 ).
                   4521: 		 '</td>';
1.71      ng       4522: 	    $studentTable.='<td valign="top">';
1.382     albertel 4523: 	    my %form = ('CODE' => $env{'form.CODE'},);
1.257     albertel 4524: 	    if ($env{'form.vProb'} eq 'yes' ) {
1.144     albertel 4525: 		$studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
1.383     albertel 4526: 					     undef,'both',\%form);
1.71      ng       4527: 	    } else {
1.382     albertel 4528: 		my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form);
1.80      ng       4529: 		$companswer =~ s|<form(.*?)>||g;
                   4530: 		$companswer =~ s|</form>||g;
1.71      ng       4531: #		while ($companswer =~ /(<a href\=\"javascript:newWindow.*?Script Vars<\/a>)/s) { #<a href="javascript:newWindow</a>
1.116     ng       4532: #		    $companswer =~ s/$1/ /ms;
1.326     albertel 4533: #		    $request->print('match='.$1."<br />\n");
1.71      ng       4534: #		}
1.116     ng       4535: #		$companswer =~ s|<table border=\"1\">|<table border=\"0\">|g;
1.539     riegler  4536: 		$studentTable.='&nbsp;<b>'.$title.'</b>&nbsp;<br />&nbsp;<b>'.&mt('Correct answer').':</b><br />'.$companswer;
1.71      ng       4537: 	    }
                   4538: 
1.257     albertel 4539: 	    my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);
1.125     ng       4540: 
1.257     albertel 4541: 	    if ($env{'form.lastSub'} eq 'datesub') {
1.71      ng       4542: 		if ($record{'version'} eq '') {
1.485     albertel 4543: 		    $studentTable.='<br />&nbsp;<span class="LC_warning">'.&mt('No recorded submission for this problem.').'</span><br />';
1.71      ng       4544: 		} else {
1.116     ng       4545: 		    my %responseType = ();
                   4546: 		    foreach my $partid (@{$parts}) {
1.147     albertel 4547: 			my @responseIds =$curRes->responseIds($partid);
                   4548: 			my @responseType =$curRes->responseType($partid);
                   4549: 			my %responseIds;
                   4550: 			for (my $i=0;$i<=$#responseIds;$i++) {
                   4551: 			    $responseIds{$responseIds[$i]}=$responseType[$i];
                   4552: 			}
                   4553: 			$responseType{$partid} = \%responseIds;
1.116     ng       4554: 		    }
1.148     albertel 4555: 		    $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom);
1.147     albertel 4556: 
1.71      ng       4557: 		}
1.257     albertel 4558: 	    } elsif ($env{'form.lastSub'} eq 'all') {
                   4559: 		my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
1.71      ng       4560: 		$studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom,
1.257     albertel 4561: 									$env{'request.course.id'},
1.71      ng       4562: 									'','.submission');
                   4563:  
                   4564: 	    }
1.103     albertel 4565: 	    if (&canmodify($usec)) {
1.585     bisitz   4566:             $studentTable.=&gradeBox_start();
1.103     albertel 4567: 		foreach my $partid (@{$parts}) {
                   4568: 		    $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record);
                   4569: 		    $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n";
                   4570: 		    $question++;
                   4571: 		}
1.585     bisitz   4572:             $studentTable.=&gradeBox_end();
1.196     albertel 4573: 		$prob++;
1.71      ng       4574: 	    }
                   4575: 	    $studentTable.='</td></tr>';
1.68      ng       4576: 
1.103     albertel 4577: 	}
1.68      ng       4578:         $curRes = $iterator->next();
                   4579:     }
                   4580: 
1.589     bisitz   4581:     $studentTable.=
                   4582:         '</table>'."\n".
                   4583:         '<input type="button" value="'.&mt('Save').'" '.
                   4584:         'onclick="javascript:checkSubmitPage(this.form,'.$question.');" />'.
                   4585:         '</form>'."\n";
1.324     albertel 4586:     $studentTable.=&show_grading_menu_form($symb);
1.71      ng       4587:     $request->print($studentTable);
                   4588: 
                   4589:     return '';
1.119     ng       4590: }
                   4591: 
                   4592: sub displaySubByDates {
1.148     albertel 4593:     my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
1.224     albertel 4594:     my $isCODE=0;
1.335     albertel 4595:     my $isTask = ($symb =~/\.task$/);
1.224     albertel 4596:     if (exists($record->{'resource.CODE'})) { $isCODE=1; }
1.467     albertel 4597:     my $studentTable=&Apache::loncommon::start_data_table().
                   4598: 	&Apache::loncommon::start_data_table_header_row().
                   4599: 	'<th>'.&mt('Date/Time').'</th>'.
                   4600: 	($isCODE?'<th>'.&mt('CODE').'</th>':'').
                   4601: 	'<th>'.&mt('Submission').'</th>'.
                   4602: 	'<th>'.&mt('Status').'</th>'.
                   4603: 	&Apache::loncommon::end_data_table_header_row();
1.119     ng       4604:     my ($version);
                   4605:     my %mark;
1.148     albertel 4606:     my %orders;
1.119     ng       4607:     $mark{'correct_by_student'} = $checkIcon;
1.147     albertel 4608:     if (!exists($$record{'1:timestamp'})) {
1.539     riegler  4609: 	return '<br />&nbsp;<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br />';
1.147     albertel 4610:     }
1.335     albertel 4611: 
                   4612:     my $interaction;
1.525     raeburn  4613:     my $no_increment = 1;
1.119     ng       4614:     for ($version=1;$version<=$$record{'version'};$version++) {
1.467     albertel 4615: 	my $timestamp = 
                   4616: 	    &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'});
1.335     albertel 4617: 	if (exists($$record{$version.':resource.0.version'})) {
                   4618: 	    $interaction = $$record{$version.':resource.0.version'};
                   4619: 	}
                   4620: 
                   4621: 	my $where = ($isTask ? "$version:resource.$interaction"
                   4622: 		             : "$version:resource");
1.467     albertel 4623: 	$studentTable.=&Apache::loncommon::start_data_table_row().
                   4624: 	    '<td>'.$timestamp.'</td>';
1.224     albertel 4625: 	if ($isCODE) {
                   4626: 	    $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';
                   4627: 	}
1.119     ng       4628: 	my @versionKeys = split(/\:/,$$record{$version.':keys'});
                   4629: 	my @displaySub = ();
                   4630: 	foreach my $partid (@{$parts}) {
1.596     raeburn  4631:             my $hidden;
                   4632:             if (($$record{$version.':resource.'.$partid.'.type'} eq 'anonsurvey') ||
                   4633:                 ($$record{$version.':resource.'.$partid.'.type'} eq 'anonsurveycred')) {
                   4634:                 $hidden = 1;
                   4635:             }
1.335     albertel 4636: 	    my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)
                   4637: 			            : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
                   4638: 	    
1.122     ng       4639: #	    next if ($$record{"$version:resource.$partid.solved"} eq '');
1.324     albertel 4640: 	    my $display_part=&get_display_part($partid,$symb);
1.147     albertel 4641: 	    foreach my $matchKey (@matchKey) {
1.198     albertel 4642: 		if (exists($$record{$version.':'.$matchKey}) &&
                   4643: 		    $$record{$version.':'.$matchKey} ne '') {
1.596     raeburn  4644:                     
1.335     albertel 4645: 		    my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
                   4646: 				               : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
1.577     bisitz   4647:                     $displaySub[0].='<span class="LC_nobreak"';
                   4648:                     $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>'
                   4649:                                    .' <span class="LC_internal_info">'
                   4650:                                    .'('.&mt('Part ID: [_1]',$responseId).')'
                   4651:                                    .'</span>'
                   4652:                                    .' <b>';
1.596     raeburn  4653:                     if ($hidden) {
                   4654:                         $displaySub[0].= &mt('Anonymous Survey').'</b>';
                   4655:                     } else {
                   4656: 		        if ($$record{"$where.$partid.tries"} eq '') {
                   4657: 			    $displaySub[0].=&mt('Trial not counted');
                   4658: 		        } else {
                   4659: 			    $displaySub[0].=&mt('Trial: [_1]',
1.467     albertel 4660: 					    $$record{"$where.$partid.tries"});
1.596     raeburn  4661: 		        }
                   4662: 		        my $responseType=($isTask ? 'Task'
1.335     albertel 4663:                                               : $responseType->{$partid}->{$responseId});
1.596     raeburn  4664: 		        if (!exists($orders{$partid})) { $orders{$partid}={}; }
                   4665: 		        if (!exists($orders{$partid}->{$responseId})) {
                   4666: 			    $orders{$partid}->{$responseId}=
                   4667: 			        &get_order($partid,$responseId,$symb,$uname,$udom,
                   4668:                                            $no_increment);
                   4669: 		        }
                   4670: 		        $displaySub[0].='</b></span>'; # /nobreak
                   4671: 		        $displaySub[0].='&nbsp; '.
                   4672: 			    &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'<br />';
                   4673:                     }
1.147     albertel 4674: 		}
                   4675: 	    }
1.335     albertel 4676: 	    if (exists($$record{"$where.$partid.checkedin"})) {
1.485     albertel 4677: 		$displaySub[1].=&mt('Checked in by [_1] into slot [_2]',
                   4678: 				    $$record{"$where.$partid.checkedin"},
                   4679: 				    $$record{"$where.$partid.checkedin.slot"}).
                   4680: 					'<br />';
1.335     albertel 4681: 	    }
                   4682: 	    if (exists $$record{"$where.$partid.award"}) {
1.485     albertel 4683: 		$displaySub[1].='<b>'.&mt('Part:').'</b>&nbsp;'.$display_part.' &nbsp;'.
1.335     albertel 4684: 		    lc($$record{"$where.$partid.award"}).' '.
                   4685: 		    $mark{$$record{"$where.$partid.solved"}}.
1.147     albertel 4686: 		    '<br />';
                   4687: 	    }
1.335     albertel 4688: 	    if (exists $$record{"$where.$partid.regrader"}) {
                   4689: 		$displaySub[2].=$$record{"$where.$partid.regrader"}.
                   4690: 		    ' (<b>'.&mt('Part').':</b> '.$display_part.')';
                   4691: 	    } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) {
                   4692: 		$displaySub[2].=
                   4693: 		    $$record{"$version:resource.$partid.regrader"}.
1.207     albertel 4694: 		    ' (<b>'.&mt('Part').':</b> '.$display_part.')';
1.147     albertel 4695: 	    }
                   4696: 	}
                   4697: 	# needed because old essay regrader has not parts info
                   4698: 	if (exists $$record{"$version:resource.regrader"}) {
                   4699: 	    $displaySub[2].=$$record{"$version:resource.regrader"};
                   4700: 	}
                   4701: 	$studentTable.='<td>'.$displaySub[0].'&nbsp;</td><td>'.$displaySub[1];
                   4702: 	if ($displaySub[2]) {
1.467     albertel 4703: 	    $studentTable.=&mt('Manually graded by [_1]',$displaySub[2]);
1.147     albertel 4704: 	}
1.467     albertel 4705: 	$studentTable.='&nbsp;</td>'.
                   4706: 	    &Apache::loncommon::end_data_table_row();
1.119     ng       4707:     }
1.467     albertel 4708:     $studentTable.=&Apache::loncommon::end_data_table();
1.119     ng       4709:     return $studentTable;
1.71      ng       4710: }
                   4711: 
                   4712: sub updateGradeByPage {
                   4713:     my ($request) = shift;
                   4714: 
1.257     albertel 4715:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4716:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4717:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
                   4718:     my $pageTitle = $env{'form.page'};
1.103     albertel 4719:     my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
1.257     albertel 4720:     my ($uname,$udom) = split(/:/,$env{'form.student'});
                   4721:     my $usec=$classlist->{$env{'form.student'}}[5];
1.103     albertel 4722:     if (!&canmodify($usec)) {
1.526     raeburn  4723: 	$request->print('<span class="LC_warning">'.&mt('Unable to modify requested student ([_1])',$env{'form.student'}).'</span>');
1.324     albertel 4724: 	$request->print(&show_grading_menu_form($env{'form.symb'}));
1.103     albertel 4725: 	return;
                   4726:     }
1.398     albertel 4727:     my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';
1.526     raeburn  4728:     $result.='<h3>&nbsp;'.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
1.129     ng       4729: 	'</h3>'."\n";
1.70      ng       4730: 
1.68      ng       4731:     $request->print($result);
                   4732: 
1.582     raeburn  4733: 
1.132     bowersj2 4734:     my $navmap = Apache::lonnavmaps::navmap->new();
1.582     raeburn  4735:     unless (ref($navmap)) {
                   4736:         $request->print(&navmap_errormsg());
                   4737:         return;
                   4738:     }
1.257     albertel 4739:     my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'});
1.71      ng       4740:     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
1.288     albertel 4741:     if (!$map) {
1.527     raeburn  4742: 	$request->print('<span class="LC_warning">'.&mt('Unable to grade requested sequence ([_1]).',$resUrl).'</span>');
1.324     albertel 4743: 	my ($symb)=&get_symb($request);
                   4744: 	$request->print(&show_grading_menu_form($symb));
1.288     albertel 4745: 	return; 
                   4746:     }
1.71      ng       4747:     my $iterator = $navmap->getIterator($map->map_start(),
                   4748: 					$map->map_finish());
1.70      ng       4749: 
1.484     albertel 4750:     my $studentTable=
                   4751: 	&Apache::loncommon::start_data_table().
                   4752: 	&Apache::loncommon::start_data_table_header_row().
1.485     albertel 4753: 	'<th align="center">&nbsp;'.&mt('Prob.').'&nbsp;</th>'.
                   4754: 	'<th>&nbsp;'.&mt('Title').'&nbsp;</th>'.
                   4755: 	'<th>&nbsp;'.&mt('Previous Score').'&nbsp;</th>'.
                   4756: 	'<th>&nbsp;'.&mt('New Score').'&nbsp;</th>'.
1.484     albertel 4757: 	&Apache::loncommon::end_data_table_header_row();
1.71      ng       4758: 
                   4759:     $iterator->next(); # skip the first BEGIN_MAP
                   4760:     my $curRes = $iterator->next(); # for "current resource"
1.196     albertel 4761:     my ($depth,$question,$prob,$changeflag)= (1,1,1,0);
1.101     albertel 4762:     while ($depth > 0) {
1.71      ng       4763:         if($curRes == $iterator->BEGIN_MAP) { $depth++; }
1.100     bowersj2 4764:         if($curRes == $iterator->END_MAP) { $depth--; }
1.71      ng       4765: 
1.385     albertel 4766:         if (ref($curRes) && $curRes->is_problem()) {
1.91      albertel 4767: 	    my $parts = $curRes->parts();
1.71      ng       4768:             my $title = $curRes->compTitle();
                   4769: 	    my $symbx = $curRes->symb();
1.484     albertel 4770: 	    $studentTable.=
                   4771: 		&Apache::loncommon::start_data_table_row().
                   4772: 		'<td align="center" valign="top" >'.$prob.
1.485     albertel 4773: 		(scalar(@{$parts}) == 1 ? '' 
1.526     raeburn  4774:                                         : '<br />('.&mt('[quant,_1,&nbsp;part]',scalar(@{$parts}))
                   4775: 		.')').'</td>';
1.71      ng       4776: 	    $studentTable.='<td valign="top">&nbsp;<b>'.$title.'</b>&nbsp;</td>';
                   4777: 
                   4778: 	    my %newrecord=();
                   4779: 	    my @displayPts=();
1.269     raeburn  4780:             my %aggregate = ();
                   4781:             my $aggregateflag = 0;
1.71      ng       4782: 	    foreach my $partid (@{$parts}) {
1.257     albertel 4783: 		my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};
                   4784: 		my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};
1.71      ng       4785: 
1.257     albertel 4786: 		my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? 
                   4787: 		    $env{'form.WGT'.$question.'_'.$partid} : 1;
1.71      ng       4788: 		my $partial = $newpts/$wgt;
                   4789: 		my $score;
                   4790: 		if ($partial > 0) {
                   4791: 		    $score = 'correct_by_override';
1.125     ng       4792: 		} elsif ($newpts ne '') { #empty is taken as 0
1.71      ng       4793: 		    $score = 'incorrect_by_override';
                   4794: 		}
1.257     albertel 4795: 		my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid};
1.125     ng       4796: 		if ($dropMenu eq 'excused') {
1.71      ng       4797: 		    $partial = '';
                   4798: 		    $score = 'excused';
1.125     ng       4799: 		} elsif ($dropMenu eq 'reset status'
1.257     albertel 4800: 			 && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists
1.125     ng       4801: 		    $newrecord{'resource.'.$partid.'.tries'} = 0;
                   4802: 		    $newrecord{'resource.'.$partid.'.solved'} = '';
                   4803: 		    $newrecord{'resource.'.$partid.'.award'} = '';
                   4804: 		    $newrecord{'resource.'.$partid.'.awarded'} = 0;
1.257     albertel 4805: 		    $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}";
1.125     ng       4806: 		    $changeflag++;
                   4807: 		    $newpts = '';
1.269     raeburn  4808:                     
                   4809:                     my $aggtries =  $env{'form.aggtries'.$question.'_'.$partid};
                   4810:                     my $totaltries = $env{'form.totaltries'.$question.'_'.$partid};
                   4811:                     my $solvedstatus = $env{'form.solved'.$question.'_'.$partid};
                   4812:                     if ($aggtries > 0) {
                   4813:                         &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                   4814:                         $aggregateflag = 1;
                   4815:                     }
1.71      ng       4816: 		}
1.324     albertel 4817: 		my $display_part=&get_display_part($partid,$curRes->symb());
1.257     albertel 4818: 		my $oldstatus = $env{'form.solved'.$question.'_'.$partid};
1.526     raeburn  4819: 		$displayPts[0].='&nbsp;<b>'.&mt('Part').':</b> '.$display_part.' = '.
1.71      ng       4820: 		    (($oldstatus eq 'excused') ? 'excused' : $oldpts).
1.326     albertel 4821: 		    '&nbsp;<br />';
1.526     raeburn  4822: 		$displayPts[1].='&nbsp;<b>'.&mt('Part').':</b> '.$display_part.' = '.
1.125     ng       4823: 		     (($score eq 'excused') ? 'excused' : $newpts).
1.326     albertel 4824: 		    '&nbsp;<br />';
1.71      ng       4825: 		$question++;
1.380     albertel 4826: 		next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused'));
1.125     ng       4827: 
1.71      ng       4828: 		$newrecord{'resource.'.$partid.'.awarded'}  = $partial if $partial ne '';
1.125     ng       4829: 		$newrecord{'resource.'.$partid.'.solved'}   = $score if $score ne '';
1.257     albertel 4830: 		$newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"
1.125     ng       4831: 		    if (scalar(keys(%newrecord)) > 0);
1.71      ng       4832: 
                   4833: 		$changeflag++;
                   4834: 	    }
                   4835: 	    if (scalar(keys(%newrecord)) > 0) {
1.382     albertel 4836: 		my %record = 
                   4837: 		    &Apache::lonnet::restore($symbx,$env{'request.course.id'},
                   4838: 					     $udom,$uname);
                   4839: 
                   4840: 		if (&Apache::lonnet::validCODE($env{'form.CODE'})) {
                   4841: 		    $newrecord{'resource.CODE'} = $env{'form.CODE'};
                   4842: 		} elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) {
                   4843: 		    $newrecord{'resource.CODE'} = '';
                   4844: 		}
1.257     albertel 4845: 		&Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'},
1.71      ng       4846: 					$udom,$uname);
1.382     albertel 4847: 		%record = &Apache::lonnet::restore($symbx,
                   4848: 						   $env{'request.course.id'},
                   4849: 						   $udom,$uname);
1.380     albertel 4850: 		&check_and_remove_from_queue($parts,\%record,undef,$symbx,
                   4851: 					     $cdom,$cnum,$udom,$uname);
1.71      ng       4852: 	    }
1.380     albertel 4853: 	    
1.269     raeburn  4854:             if ($aggregateflag) {
                   4855:                 &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
                   4856:                       $env{'course.'.$env{'request.course.id'}.'.domain'},
                   4857:                       $env{'course.'.$env{'request.course.id'}.'.num'});
                   4858:             }
1.125     ng       4859: 
1.71      ng       4860: 	    $studentTable.='<td valign="top">'.$displayPts[0].'</td>'.
                   4861: 		'<td valign="top">'.$displayPts[1].'</td>'.
1.484     albertel 4862: 		&Apache::loncommon::end_data_table_row();
1.68      ng       4863: 
1.196     albertel 4864: 	    $prob++;
1.68      ng       4865: 	}
1.71      ng       4866:         $curRes = $iterator->next();
1.68      ng       4867:     }
1.98      albertel 4868: 
1.484     albertel 4869:     $studentTable.=&Apache::loncommon::end_data_table();
1.324     albertel 4870:     $studentTable.=&show_grading_menu_form($env{'form.symb'});
1.526     raeburn  4871:     my $grademsg=($changeflag == 0 ? &mt('No score was changed or updated.') :
                   4872: 		  &mt('The scores were changed for [quant,_1,problem].',
                   4873: 		  $changeflag));
1.76      ng       4874:     $request->print($grademsg.$studentTable);
1.68      ng       4875: 
1.70      ng       4876:     return '';
                   4877: }
                   4878: 
1.72      ng       4879: #-------- end of section for handling grading by page/sequence ---------
                   4880: #
                   4881: #-------------------------------------------------------------------
                   4882: 
1.581     www      4883: #-------------------- Bubblesheet (Scantron) Grading -------------------
1.75      albertel 4884: #
                   4885: #------ start of section for handling grading by page/sequence ---------
                   4886: 
1.423     albertel 4887: =pod
                   4888: 
                   4889: =head1 Bubble sheet grading routines
                   4890: 
1.424     albertel 4891:   For this documentation:
                   4892: 
                   4893:    'scanline' refers to the full line of characters
                   4894:    from the file that we are parsing that represents one entire sheet
                   4895: 
                   4896:    'bubble line' refers to the data
                   4897:    representing the line of bubbles that are on the physical bubble sheet
                   4898: 
                   4899: 
                   4900: The overall process is that a scanned in bubble sheet data is uploaded
                   4901: into a course. When a user wants to grade, they select a
                   4902: sequence/folder of resources, a file of bubble sheet info, and pick
                   4903: one of the predefined configurations for what each scanline looks
                   4904: like.
                   4905: 
                   4906: Next each scanline is checked for any errors of either 'missing
1.435     foxr     4907: bubbles' (it's an error because it may have been mis-scanned
1.424     albertel 4908: because too light bubbling), 'double bubble' (each bubble line should
                   4909: have no more that one letter picked), invalid or duplicated CODE,
1.556     weissno  4910: invalid student/employee ID
1.424     albertel 4911: 
                   4912: If the CODE option is used that determines the randomization of the
1.556     weissno  4913: homework problems, either way the student/employee ID is looked up into a
1.424     albertel 4914: username:domain.
                   4915: 
                   4916: During the validation phase the instructor can choose to skip scanlines. 
                   4917: 
1.435     foxr     4918: After the validation phase, there are now 3 bubble sheet files
1.424     albertel 4919: 
                   4920:   scantron_original_filename (unmodified original file)
                   4921:   scantron_corrected_filename (file where the corrected information has replaced the original information)
                   4922:   scantron_skipped_filename (contains the exact text of scanlines that where skipped)
                   4923: 
                   4924: Also there is a separate hash nohist_scantrondata that contains extra
                   4925: correction information that isn't representable in the bubble sheet
                   4926: file (see &scantron_getfile() for more information)
                   4927: 
                   4928: After all scanlines are either valid, marked as valid or skipped, then
                   4929: foreach line foreach problem in the picked sequence, an ssi request is
                   4930: made that simulates a user submitting their selected letter(s) against
                   4931: the homework problem.
1.423     albertel 4932: 
                   4933: =over 4
                   4934: 
                   4935: 
                   4936: 
                   4937: =item defaultFormData
                   4938: 
                   4939:   Returns html hidden inputs used to hold context/default values.
                   4940: 
                   4941:  Arguments:
                   4942:   $symb - $symb of the current resource 
                   4943: 
                   4944: =cut
1.422     foxr     4945: 
1.81      albertel 4946: sub defaultFormData {
1.324     albertel 4947:     my ($symb)=@_;
1.447     foxr     4948:     return '<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 4949:      '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
                   4950:      '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
1.81      albertel 4951: }
                   4952: 
1.447     foxr     4953: 
1.423     albertel 4954: =pod 
                   4955: 
                   4956: =item getSequenceDropDown
                   4957: 
                   4958:    Return html dropdown of possible sequences to grade
                   4959:  
                   4960:  Arguments:
1.582     raeburn  4961:    $symb - $symb of the current resource
                   4962:    $map_error - ref to scalar which will container error if
                   4963:                 $navmap object is unavailable in &getSymbMap().
1.423     albertel 4964: 
                   4965: =cut
1.422     foxr     4966: 
1.75      albertel 4967: sub getSequenceDropDown {
1.582     raeburn  4968:     my ($symb,$map_error)=@_;
1.75      albertel 4969:     my $result='<select name="selectpage">'."\n";
1.582     raeburn  4970:     my ($titles,$symbx) = &getSymbMap($map_error);
                   4971:     if (ref($map_error)) {
                   4972:         return if ($$map_error);
                   4973:     }
1.137     albertel 4974:     my ($curpage)=&Apache::lonnet::decode_symb($symb); 
1.75      albertel 4975:     my $ctr=0;
                   4976:     foreach (@$titles) {
                   4977: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
                   4978: 	$result.='<option value="'.$$symbx{$_}.'" '.
1.401     albertel 4979: 	    ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : '').
1.75      albertel 4980: 	    '>'.$showtitle.'</option>'."\n";
                   4981: 	$ctr++;
                   4982:     }
                   4983:     $result.= '</select>';
                   4984:     return $result;
                   4985: }
                   4986: 
1.495     albertel 4987: my %bubble_lines_per_response;     # no. bubble lines for each response.
1.554     raeburn  4988:                                    # key is zero-based index - 0, 1, 2 ...
1.495     albertel 4989: 
                   4990: my %first_bubble_line;             # First bubble line no. for each bubble.
                   4991: 
1.509     raeburn  4992: my %subdivided_bubble_lines;       # no. bubble lines for optionresponse, 
                   4993:                                    # matchresponse or rankresponse, where 
                   4994:                                    # an individual response can have multiple 
                   4995:                                    # lines
1.503     raeburn  4996: 
                   4997: my %responsetype_per_response;     # responsetype for each response
                   4998: 
1.495     albertel 4999: # Save and restore the bubble lines array to the form env.
                   5000: 
                   5001: 
                   5002: sub save_bubble_lines {
                   5003:     foreach my $line (keys(%bubble_lines_per_response)) {
                   5004: 	$env{"form.scantron.bubblelines.$line"}  = $bubble_lines_per_response{$line};
                   5005: 	$env{"form.scantron.first_bubble_line.$line"} =
                   5006: 	    $first_bubble_line{$line};
1.503     raeburn  5007:         $env{"form.scantron.sub_bubblelines.$line"} = 
                   5008:             $subdivided_bubble_lines{$line};
                   5009:         $env{"form.scantron.responsetype.$line"} =
                   5010:             $responsetype_per_response{$line};
1.495     albertel 5011:     }
                   5012: }
                   5013: 
                   5014: 
                   5015: sub restore_bubble_lines {
                   5016:     my $line = 0;
                   5017:     %bubble_lines_per_response = ();
                   5018:     while ($env{"form.scantron.bubblelines.$line"}) {
                   5019: 	my $value = $env{"form.scantron.bubblelines.$line"};
                   5020: 	$bubble_lines_per_response{$line} = $value;
                   5021: 	$first_bubble_line{$line}  =
                   5022: 	    $env{"form.scantron.first_bubble_line.$line"};
1.503     raeburn  5023:         $subdivided_bubble_lines{$line} =
                   5024:             $env{"form.scantron.sub_bubblelines.$line"};
                   5025:         $responsetype_per_response{$line} =
                   5026:             $env{"form.scantron.responsetype.$line"};
1.495     albertel 5027: 	$line++;
                   5028:     }
                   5029: }
                   5030: 
                   5031: #  Given the parsed scanline, get the response for 
                   5032: #  'answer' number n:
                   5033: 
                   5034: sub get_response_bubbles {
                   5035:     my ($parsed_line, $response)  = @_;
                   5036: 
                   5037:     my $bubble_line = $first_bubble_line{$response-1} +1;
                   5038:     my $bubble_lines= $bubble_lines_per_response{$response-1};
                   5039:     
                   5040:     my $selected = "";
                   5041: 
                   5042:     for (my $bline = 0; $bline < $bubble_lines; $bline++) {
                   5043: 	$selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":";
                   5044: 	$bubble_line++;
                   5045:     }
                   5046:     return $selected;
                   5047: }
1.423     albertel 5048: 
                   5049: =pod 
                   5050: 
                   5051: =item scantron_filenames
                   5052: 
                   5053:    Returns a list of the scantron files in the current course 
                   5054: 
                   5055: =cut
1.422     foxr     5056: 
1.202     albertel 5057: sub scantron_filenames {
1.257     albertel 5058:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   5059:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
1.517     raeburn  5060:     my $getpropath = 1;
1.157     albertel 5061:     my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
1.517     raeburn  5062:                                        $getpropath);
1.202     albertel 5063:     my @possiblenames;
1.201     albertel 5064:     foreach my $filename (sort(@files)) {
1.157     albertel 5065: 	($filename)=split(/&/,$filename);
                   5066: 	if ($filename!~/^scantron_orig_/) { next ; }
                   5067: 	$filename=~s/^scantron_orig_//;
1.202     albertel 5068: 	push(@possiblenames,$filename);
                   5069:     }
                   5070:     return @possiblenames;
                   5071: }
                   5072: 
1.423     albertel 5073: =pod 
                   5074: 
                   5075: =item scantron_uploads
                   5076: 
                   5077:    Returns  html drop-down list of scantron files in current course.
                   5078: 
                   5079:  Arguments:
                   5080:    $file2grade - filename to set as selected in the dropdown
                   5081: 
                   5082: =cut
1.422     foxr     5083: 
1.202     albertel 5084: sub scantron_uploads {
1.209     ng       5085:     my ($file2grade) = @_;
1.202     albertel 5086:     my $result=	'<select name="scantron_selectfile">';
                   5087:     $result.="<option></option>";
                   5088:     foreach my $filename (sort(&scantron_filenames())) {
1.401     albertel 5089: 	$result.="<option".($filename eq $file2grade ? ' selected="selected"':'').">$filename</option>\n";
1.81      albertel 5090:     }
                   5091:     $result.="</select>";
                   5092:     return $result;
                   5093: }
                   5094: 
1.423     albertel 5095: =pod 
                   5096: 
                   5097: =item scantron_scantab
                   5098: 
                   5099:   Returns html drop down of the scantron formats in the scantronformat.tab
                   5100:   file.
                   5101: 
                   5102: =cut
1.422     foxr     5103: 
1.82      albertel 5104: sub scantron_scantab {
                   5105:     my $result='<select name="scantron_format">'."\n";
1.191     albertel 5106:     $result.='<option></option>'."\n";
1.518     raeburn  5107:     my @lines = &get_scantronformat_file();
                   5108:     if (@lines > 0) {
                   5109:         foreach my $line (@lines) {
                   5110:             next if (($line =~ /^\#/) || ($line eq ''));
                   5111: 	    my ($name,$descrip)=split(/:/,$line);
                   5112: 	    $result.='<option value="'.$name.'">'.$descrip.'</option>'."\n";
                   5113:         }
1.82      albertel 5114:     }
                   5115:     $result.='</select>'."\n";
1.518     raeburn  5116:     return $result;
                   5117: }
                   5118: 
                   5119: =pod
                   5120: 
                   5121: =item get_scantronformat_file
                   5122: 
                   5123:   Returns an array containing lines from the scantron format file for
                   5124:   the domain of the course.
                   5125: 
                   5126:   If a url for a custom.tab file is listed in domain's configuration.db, 
                   5127:   lines are from this file.
                   5128: 
                   5129:   Otherwise, if a default.tab has been published in RES space by the 
                   5130:   domainconfig user, lines are from this file.
                   5131: 
                   5132:   Otherwise, fall back to getting lines from the legacy file on the
1.519     raeburn  5133:   local server:  /home/httpd/lonTabs/default_scantronformat.tab    
1.82      albertel 5134: 
1.518     raeburn  5135: =cut
                   5136: 
                   5137: sub get_scantronformat_file {
                   5138:     my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5139:     my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom);
                   5140:     my $gottab = 0;
                   5141:     my @lines;
                   5142:     if (ref($domconfig{'scantron'}) eq 'HASH') {
                   5143:         if ($domconfig{'scantron'}{'scantronformat'} ne '') {
                   5144:             my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'});
                   5145:             if ($formatfile ne '-1') {
                   5146:                 @lines = split("\n",$formatfile,-1);
                   5147:                 $gottab = 1;
                   5148:             }
                   5149:         }
                   5150:     }
                   5151:     if (!$gottab) {
                   5152:         my $confname = $cdom.'-domainconfig';
                   5153:         my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab';
                   5154:         my $formatfile =  &Apache::lonnet::getfile($default);
                   5155:         if ($formatfile ne '-1') {
                   5156:             @lines = split("\n",$formatfile,-1);
                   5157:             $gottab = 1;
                   5158:         }
                   5159:     }
                   5160:     if (!$gottab) {
1.519     raeburn  5161:         my @domains = &Apache::lonnet::current_machine_domains();
                   5162:         if (grep(/^\Q$cdom\E$/,@domains)) {
                   5163:             my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
                   5164:             @lines = <$fh>;
                   5165:             close($fh);
                   5166:         } else {
                   5167:             my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab');
                   5168:             @lines = <$fh>;
                   5169:             close($fh);
                   5170:         }
1.518     raeburn  5171:     }
                   5172:     return @lines;
1.82      albertel 5173: }
                   5174: 
1.423     albertel 5175: =pod 
                   5176: 
                   5177: =item scantron_CODElist
                   5178: 
                   5179:   Returns html drop down of the saved CODE lists from current course,
                   5180:   generated from earlier printings.
                   5181: 
                   5182: =cut
1.422     foxr     5183: 
1.186     albertel 5184: sub scantron_CODElist {
1.257     albertel 5185:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5186:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.186     albertel 5187:     my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum);
                   5188:     my $namechoice='<option></option>';
1.225     albertel 5189:     foreach my $name (sort {uc($a) cmp uc($b)} @names) {
1.191     albertel 5190: 	if ($name =~ /^error: 2 /) { next; }
1.278     albertel 5191: 	if ($name =~ /^type\0/) { next; }
1.186     albertel 5192: 	$namechoice.='<option value="'.$name.'">'.$name.'</option>';
                   5193:     }
                   5194:     $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>';
                   5195:     return $namechoice;
                   5196: }
                   5197: 
1.423     albertel 5198: =pod 
                   5199: 
                   5200: =item scantron_CODEunique
                   5201: 
                   5202:   Returns the html for "Each CODE to be used once" radio.
                   5203: 
                   5204: =cut
1.422     foxr     5205: 
1.186     albertel 5206: sub scantron_CODEunique {
1.532     bisitz   5207:     my $result='<span class="LC_nobreak">
1.272     albertel 5208:                  <label><input type="radio" name="scantron_CODEunique"
1.423     albertel 5209:                         value="yes" checked="checked" />'.&mt('Yes').' </label>
1.381     albertel 5210:                 </span>
1.532     bisitz   5211:                 <span class="LC_nobreak">
1.272     albertel 5212:                  <label><input type="radio" name="scantron_CODEunique"
1.423     albertel 5213:                         value="no" />'.&mt('No').' </label>
1.381     albertel 5214:                 </span>';
1.186     albertel 5215:     return $result;
                   5216: }
1.423     albertel 5217: 
                   5218: =pod 
                   5219: 
                   5220: =item scantron_selectphase
                   5221: 
                   5222:   Generates the initial screen to start the bubble sheet process.
                   5223:   Allows for - starting a grading run.
1.424     albertel 5224:              - downloading existing scan data (original, corrected
1.423     albertel 5225:                                                 or skipped info)
                   5226: 
                   5227:              - uploading new scan data
                   5228: 
                   5229:  Arguments:
                   5230:   $r          - The Apache request object
                   5231:   $file2grade - name of the file that contain the scanned data to score
                   5232: 
                   5233: =cut
1.186     albertel 5234: 
1.75      albertel 5235: sub scantron_selectphase {
1.209     ng       5236:     my ($r,$file2grade) = @_;
1.324     albertel 5237:     my ($symb)=&get_symb($r);
1.75      albertel 5238:     if (!$symb) {return '';}
1.582     raeburn  5239:     my $map_error;
                   5240:     my $sequence_selector=&getSequenceDropDown($symb,\$map_error);
                   5241:     if ($map_error) {
                   5242:         $r->print('<br />'.&navmap_errormsg().'<br />');
                   5243:         return;
                   5244:     }
1.324     albertel 5245:     my $default_form_data=&defaultFormData($symb);
                   5246:     my $grading_menu_button=&show_grading_menu_form($symb);
1.209     ng       5247:     my $file_selector=&scantron_uploads($file2grade);
1.82      albertel 5248:     my $format_selector=&scantron_scantab();
1.186     albertel 5249:     my $CODE_selector=&scantron_CODElist();
                   5250:     my $CODE_unique=&scantron_CODEunique();
1.75      albertel 5251:     my $result;
1.422     foxr     5252: 
1.513     foxr     5253:     $ssi_error = 0;
                   5254: 
1.422     foxr     5255:     # Chunk of form to prompt for a file to grade and how:
                   5256: 
1.489     albertel 5257:     $result.= '
                   5258:     <br />
                   5259:     <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process">
                   5260:     <input type="hidden" name="command" value="scantron_warning" />
                   5261:     '.$default_form_data.'
                   5262:     '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   5263:        '.&Apache::loncommon::start_data_table_header_row().'
                   5264:             <th colspan="2">
1.492     albertel 5265:               &nbsp;'.&mt('Specify file and which Folder/Sequence to grade').'
1.489     albertel 5266:             </th>
                   5267:        '.&Apache::loncommon::end_data_table_header_row().'
                   5268:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5269:             <td> '.&mt('Sequence to grade:').' </td><td> '.$sequence_selector.' </td>
1.489     albertel 5270:        '.&Apache::loncommon::end_data_table_row().'
                   5271:        '.&Apache::loncommon::start_data_table_row().'
1.572     www      5272:             <td> '.&mt('Filename of bubblesheet data file:').' </td><td> '.$file_selector.' </td>
1.489     albertel 5273:        '.&Apache::loncommon::end_data_table_row().'
                   5274:        '.&Apache::loncommon::start_data_table_row().'
1.572     www      5275:             <td> '.&mt('Format of bubblesheet data file:').' </td><td> '.$format_selector.' </td>
1.489     albertel 5276:        '.&Apache::loncommon::end_data_table_row().'
                   5277:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5278:             <td> '.&mt('Saved CODEs to validate against:').' </td><td> '.$CODE_selector.' </td>
1.489     albertel 5279:        '.&Apache::loncommon::end_data_table_row().'
                   5280:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5281:             <td> '.&mt('Each CODE is only to be used once:').'</td><td> '.$CODE_unique.' </td>
1.489     albertel 5282:        '.&Apache::loncommon::end_data_table_row().'
                   5283:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5284: 	    <td> '.&mt('Options:').' </td>
1.187     albertel 5285:             <td>
1.492     albertel 5286: 	       <label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> '.&mt('Do only previously skipped records').'</label> <br />
                   5287:                <label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> '.&mt('Remove all existing corrections').'</label> <br />
                   5288:                <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources when grading').'</label>
1.187     albertel 5289: 	    </td>
1.489     albertel 5290:        '.&Apache::loncommon::end_data_table_row().'
                   5291:        '.&Apache::loncommon::start_data_table_row().'
1.174     albertel 5292:             <td colspan="2">
1.572     www      5293:               <input type="submit" value="'.&mt('Grading: Validate Bubblesheet Records').'" />
1.162     albertel 5294:             </td>
1.489     albertel 5295:        '.&Apache::loncommon::end_data_table_row().'
                   5296:     '.&Apache::loncommon::end_data_table().'
                   5297:     </form>
                   5298: ';
1.162     albertel 5299:    
                   5300:     $r->print($result);
                   5301: 
1.257     albertel 5302:     if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||
                   5303:         &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
1.162     albertel 5304: 
1.422     foxr     5305: 	# Chunk of form to prompt for a scantron file upload.
                   5306: 
1.489     albertel 5307:         $r->print('
                   5308:     <br />
                   5309:     '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   5310:        '.&Apache::loncommon::start_data_table_header_row().'
                   5311:             <th>
1.572     www      5312:               &nbsp;'.&mt('Specify a bubblesheet data file to upload.').'
1.489     albertel 5313:             </th>
                   5314:        '.&Apache::loncommon::end_data_table_header_row().'
                   5315:        '.&Apache::loncommon::start_data_table_row().'
1.162     albertel 5316:             <td>
1.489     albertel 5317: ');
1.324     albertel 5318:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.257     albertel 5319:     my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5320:     my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'};
1.492     albertel 5321:     $r->print('
1.174     albertel 5322:               <script type="text/javascript" language="javascript">
                   5323:     function checkUpload(formname) {
                   5324: 	if (formname.upfile.value == "") {
1.492     albertel 5325: 	    alert("'.&mt('Please use the browse button to select a file from your local directory.').'");
1.174     albertel 5326: 	    return false;
                   5327: 	}
                   5328: 	formname.submit();
                   5329:     }
                   5330:               </script>
                   5331: 
1.492     albertel 5332:               <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post">
                   5333:                 '.$default_form_data.'
                   5334:                 <input name="courseid" type="hidden" value="'.$cnum.'" />
                   5335:                 <input name="domainid" type="hidden" value="'.$cdom.'" />
                   5336:                 <input name="command" value="scantronupload_save" type="hidden" />
                   5337:                 '.&mt('File to upload: [_1]','<input type="file" name="upfile" size="50" />').'
1.174     albertel 5338:                 <br />
1.589     bisitz   5339:                 <input type="button" onclick="javascript:checkUpload(this.form);" value="'.&mt('Upload Bubblesheet Data').'" />
1.174     albertel 5340:               </form>
1.492     albertel 5341: ');
1.162     albertel 5342: 
1.489     albertel 5343:         $r->print('
1.162     albertel 5344:             </td>
1.489     albertel 5345:        '.&Apache::loncommon::end_data_table_row().'
                   5346:        '.&Apache::loncommon::end_data_table().'
                   5347: ');
1.162     albertel 5348:     }
1.422     foxr     5349: 
                   5350:     # Chunk of the form that prompts to view a scoring office file,
                   5351:     # corrected file, skipped records in a file.
                   5352: 
1.489     albertel 5353:     $r->print('
                   5354:    <br />
                   5355:    <form action="/adm/grades" name="scantron_download">
                   5356:      '.$default_form_data.'
                   5357:      <input type="hidden" name="command" value="scantron_download" />
                   5358:      '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   5359:        '.&Apache::loncommon::start_data_table_header_row().'
                   5360:               <th>
1.492     albertel 5361:                 &nbsp;'.&mt('Download a scoring office file').'
1.489     albertel 5362:               </th>
                   5363:        '.&Apache::loncommon::end_data_table_header_row().'
                   5364:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5365:               <td> '.&mt('Filename of scoring office file: [_1]',$file_selector).' 
1.489     albertel 5366:                 <br />
1.492     albertel 5367:                 <input type="submit" value="'.&mt('Download: Show List of Associated Files').'" />
1.489     albertel 5368:        '.&Apache::loncommon::end_data_table_row().'
                   5369:      '.&Apache::loncommon::end_data_table().'
                   5370:    </form>
                   5371:    <br />
                   5372: ');
1.162     albertel 5373: 
1.457     banghart 5374:     &Apache::lonpickcode::code_list($r,2);
1.523     raeburn  5375: 
1.528     raeburn  5376:     $r->print('<br /><form method="post" name="checkscantron">'.
1.523     raeburn  5377:              $default_form_data."\n".
                   5378:              &Apache::loncommon::start_data_table('LC_scantron_action')."\n".
                   5379:              &Apache::loncommon::start_data_table_header_row()."\n".
                   5380:              '<th colspan="2">
1.572     www      5381:               &nbsp;'.&mt('Review bubblesheet data and submissions for a previously graded folder/sequence')."\n".
1.523     raeburn  5382:              '</th>'."\n".
                   5383:               &Apache::loncommon::end_data_table_header_row()."\n".
                   5384:               &Apache::loncommon::start_data_table_row()."\n".
                   5385:               '<td> '.&mt('Graded folder/sequence:').' </td>'."\n".
                   5386:               '<td> '.$sequence_selector.' </td>'.
                   5387:               &Apache::loncommon::end_data_table_row()."\n".
                   5388:               &Apache::loncommon::start_data_table_row()."\n".
                   5389:               '<td> '.&mt('Filename of scoring office file:').' </td>'."\n".
                   5390:               '<td> '.$file_selector.' </td>'."\n".
                   5391:               &Apache::loncommon::end_data_table_row()."\n".
                   5392:               &Apache::loncommon::start_data_table_row()."\n".
                   5393:               '<td> '.&mt('Format of data file:').' </td>'."\n".
                   5394:               '<td> '.$format_selector.' </td>'."\n".
                   5395:               &Apache::loncommon::end_data_table_row()."\n".
                   5396:               &Apache::loncommon::start_data_table_row()."\n".
1.557     raeburn  5397:               '<td> '.&mt('Options').' </td>'."\n".
                   5398:               '<td> <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources').'</label></td>'.
                   5399:               &Apache::loncommon::end_data_table_row()."\n".
                   5400:               &Apache::loncommon::start_data_table_row()."\n".
1.523     raeburn  5401:               '<td colspan="2">'."\n".
                   5402:               '<input type="hidden" name="command" value="checksubmissions" />'."\n".
1.575     www      5403:               '<input type="submit" value="'.&mt('Review Bubblesheet Data and Submission Records').'" />'."\n".
1.523     raeburn  5404:               '</td>'."\n".
                   5405:               &Apache::loncommon::end_data_table_row()."\n".
                   5406:               &Apache::loncommon::end_data_table()."\n".
                   5407:               '</form><br />');
1.457     banghart 5408:     $r->print($grading_menu_button);
1.523     raeburn  5409:     return;
1.75      albertel 5410: }
                   5411: 
1.423     albertel 5412: =pod
                   5413: 
                   5414: =item get_scantron_config
                   5415: 
                   5416:    Parse and return the scantron configuration line selected as a
                   5417:    hash of configuration file fields.
                   5418: 
                   5419:  Arguments:
                   5420:     which - the name of the configuration to parse from the file.
                   5421: 
                   5422: 
                   5423:  Returns:
                   5424:             If the named configuration is not in the file, an empty
                   5425:             hash is returned.
                   5426:     a hash with the fields
                   5427:       name         - internal name for the this configuration setup
                   5428:       description  - text to display to operator that describes this config
                   5429:       CODElocation - if 0 or the string 'none'
                   5430:                           - no CODE exists for this config
                   5431:                      if -1 || the string 'letter'
                   5432:                           - a CODE exists for this config and is
                   5433:                             a string of letters
                   5434:                      Unsupported value (but planned for future support)
                   5435:                           if a positive integer
                   5436:                                - The CODE exists as the first n items from
                   5437:                                  the question section of the form
                   5438:                           if the string 'number'
                   5439:                                - The CODE exists for this config and is
                   5440:                                  a string of numbers
                   5441:       CODEstart   - (only matter if a CODE exists) column in the line where
                   5442:                      the CODE starts
                   5443:       CODElength  - length of the CODE
1.573     bisitz   5444:       IDstart     - column where the student/employee ID starts
1.556     weissno  5445:       IDlength    - length of the student/employee ID info
1.423     albertel 5446:       Qstart      - column where the information from the bubbled
                   5447:                     'questions' start
                   5448:       Qlength     - number of columns comprising a single bubble line from
                   5449:                     the sheet. (usually either 1 or 10)
1.424     albertel 5450:       Qon         - either a single character representing the character used
1.423     albertel 5451:                     to signal a bubble was chosen in the positional setup, or
                   5452:                     the string 'letter' if the letter of the chosen bubble is
                   5453:                     in the final, or 'number' if a number representing the
                   5454:                     chosen bubble is in the file (1->A 0->J)
1.424     albertel 5455:       Qoff        - the character used to represent that a bubble was
                   5456:                     left blank
1.423     albertel 5457:       PaperID     - if the scanning process generates a unique number for each
                   5458:                     sheet scanned the column that this ID number starts in
                   5459:       PaperIDlength - number of columns that comprise the unique ID number
                   5460:                       for the sheet of paper
1.424     albertel 5461:       FirstName   - column that the first name starts in
1.423     albertel 5462:       FirstNameLength - number of columns that the first name spans
                   5463:  
                   5464:       LastName    - column that the last name starts in
                   5465:       LastNameLength - number of columns that the last name spans
                   5466: 
                   5467: =cut
1.422     foxr     5468: 
1.82      albertel 5469: sub get_scantron_config {
                   5470:     my ($which) = @_;
1.518     raeburn  5471:     my @lines = &get_scantronformat_file();
1.82      albertel 5472:     my %config;
1.157     albertel 5473:     #FIXME probably should move to XML it has already gotten a bit much now
1.518     raeburn  5474:     foreach my $line (@lines) {
1.82      albertel 5475: 	my ($name,$descrip)=split(/:/,$line);
                   5476: 	if ($name ne $which ) { next; }
                   5477: 	chomp($line);
                   5478: 	my @config=split(/:/,$line);
                   5479: 	$config{'name'}=$config[0];
                   5480: 	$config{'description'}=$config[1];
                   5481: 	$config{'CODElocation'}=$config[2];
                   5482: 	$config{'CODEstart'}=$config[3];
                   5483: 	$config{'CODElength'}=$config[4];
                   5484: 	$config{'IDstart'}=$config[5];
                   5485: 	$config{'IDlength'}=$config[6];
                   5486: 	$config{'Qstart'}=$config[7];
1.497     foxr     5487:  	$config{'Qlength'}=$config[8];
1.82      albertel 5488: 	$config{'Qoff'}=$config[9];
                   5489: 	$config{'Qon'}=$config[10];
1.157     albertel 5490: 	$config{'PaperID'}=$config[11];
                   5491: 	$config{'PaperIDlength'}=$config[12];
                   5492: 	$config{'FirstName'}=$config[13];
                   5493: 	$config{'FirstNamelength'}=$config[14];
                   5494: 	$config{'LastName'}=$config[15];
                   5495: 	$config{'LastNamelength'}=$config[16];
1.82      albertel 5496: 	last;
                   5497:     }
                   5498:     return %config;
                   5499: }
                   5500: 
1.423     albertel 5501: =pod 
                   5502: 
                   5503: =item username_to_idmap
                   5504: 
1.556     weissno  5505:     creates a hash keyed by student/employee ID with values of the corresponding
1.423     albertel 5506:     student username:domain.
                   5507: 
                   5508:   Arguments:
                   5509: 
                   5510:     $classlist - reference to the class list hash. This is a hash
                   5511:                  keyed by student name:domain  whose elements are references
1.424     albertel 5512:                  to arrays containing various chunks of information
1.423     albertel 5513:                  about the student. (See loncoursedata for more info).
                   5514: 
                   5515:   Returns
                   5516:     %idmap - the constructed hash
                   5517: 
                   5518: =cut
                   5519: 
1.82      albertel 5520: sub username_to_idmap {
                   5521:     my ($classlist)= @_;
                   5522:     my %idmap;
                   5523:     foreach my $student (keys(%$classlist)) {
                   5524: 	$idmap{$classlist->{$student}->[&Apache::loncoursedata::CL_ID]}=
                   5525: 	    $student;
                   5526:     }
                   5527:     return %idmap;
                   5528: }
1.423     albertel 5529: 
                   5530: =pod
                   5531: 
1.424     albertel 5532: =item scantron_fixup_scanline
1.423     albertel 5533: 
                   5534:    Process a requested correction to a scanline.
                   5535: 
                   5536:   Arguments:
                   5537:     $scantron_config   - hash from &get_scantron_config()
                   5538:     $scan_data         - hash of correction information 
                   5539:                           (see &scantron_getfile())
                   5540:     $line              - existing scanline
                   5541:     $whichline         - line number of the passed in scanline
                   5542:     $field             - type of change to process 
                   5543:                          (either 
1.573     bisitz   5544:                           'ID'     -> correct the student/employee ID
1.423     albertel 5545:                           'CODE'   -> correct the CODE
                   5546:                           'answer' -> fixup the submitted answers)
                   5547:     
                   5548:    $args               - hash of additional info,
                   5549:                           - 'ID' 
                   5550:                                'newid' -> studentID to use in replacement
1.424     albertel 5551:                                           of existing one
1.423     albertel 5552:                           - 'CODE' 
                   5553:                                'CODE_ignore_dup' - set to true if duplicates
                   5554:                                                    should be ignored.
                   5555: 	                       'CODE' - is new code or 'use_unfound'
1.424     albertel 5556:                                         if the existing unfound code should
1.423     albertel 5557:                                         be used as is
                   5558:                           - 'answer'
                   5559:                                'response' - new answer or 'none' if blank
                   5560:                                'question' - the bubble line to change
1.503     raeburn  5561:                                'questionnum' - the question identifier,
                   5562:                                                may include subquestion. 
1.423     albertel 5563: 
                   5564:   Returns:
                   5565:     $line - the modified scanline
                   5566: 
                   5567:   Side effects: 
                   5568:     $scan_data - may be updated
                   5569: 
                   5570: =cut
                   5571: 
1.82      albertel 5572: 
1.157     albertel 5573: sub scantron_fixup_scanline {
                   5574:     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
                   5575:     if ($field eq 'ID') {
                   5576: 	if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
1.186     albertel 5577: 	    return ($line,1,'New value too large');
1.157     albertel 5578: 	}
                   5579: 	if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {
                   5580: 	    $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
                   5581: 				     $args->{'newid'});
                   5582: 	}
                   5583: 	substr($line,$$scantron_config{'IDstart'}-1,
                   5584: 	       $$scantron_config{'IDlength'})=$args->{'newid'};
                   5585: 	if ($args->{'newid'}=~/^\s*$/) {
                   5586: 	    &scan_data($scan_data,"$whichline.user",
                   5587: 		       $args->{'username'}.':'.$args->{'domain'});
                   5588: 	}
1.186     albertel 5589:     } elsif ($field eq 'CODE') {
1.192     albertel 5590: 	if ($args->{'CODE_ignore_dup'}) {
                   5591: 	    &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');
                   5592: 	}
                   5593: 	&scan_data($scan_data,"$whichline.useCODE",'1');
                   5594: 	if ($args->{'CODE'} ne 'use_unfound') {
1.191     albertel 5595: 	    if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) {
                   5596: 		return ($line,1,'New CODE value too large');
                   5597: 	    }
                   5598: 	    if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) {
                   5599: 		$args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'});
                   5600: 	    }
                   5601: 	    substr($line,$$scantron_config{'CODEstart'}-1,
                   5602: 		   $$scantron_config{'CODElength'})=$args->{'CODE'};
1.186     albertel 5603: 	}
1.157     albertel 5604:     } elsif ($field eq 'answer') {
1.497     foxr     5605: 	my $length=$scantron_config->{'Qlength'};
1.157     albertel 5606: 	my $off=$scantron_config->{'Qoff'};
                   5607: 	my $on=$scantron_config->{'Qon'};
1.497     foxr     5608: 	my $answer=${off}x$length;
                   5609: 	if ($args->{'response'} eq 'none') {
                   5610: 	    &scan_data($scan_data,
1.503     raeburn  5611: 		       "$whichline.no_bubble.".$args->{'questionnum'},'1');
1.497     foxr     5612: 	} else {
                   5613: 	    if ($on eq 'letter') {
                   5614: 		my @alphabet=('A'..'Z');
                   5615: 		$answer=$alphabet[$args->{'response'}];
                   5616: 	    } elsif ($on eq 'number') {
                   5617: 		$answer=$args->{'response'}+1;
                   5618: 		if ($answer == 10) { $answer = '0'; }
1.274     albertel 5619: 	    } else {
1.497     foxr     5620: 		substr($answer,$args->{'response'},1)=$on;
1.274     albertel 5621: 	    }
1.497     foxr     5622: 	    &scan_data($scan_data,
1.503     raeburn  5623: 		       "$whichline.no_bubble.".$args->{'questionnum'},undef,'1');
1.157     albertel 5624: 	}
1.497     foxr     5625: 	my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
                   5626: 	substr($line,$where-1,$length)=$answer;
1.157     albertel 5627:     }
                   5628:     return $line;
                   5629: }
1.423     albertel 5630: 
                   5631: =pod
                   5632: 
                   5633: =item scan_data
                   5634: 
                   5635:     Edit or look up  an item in the scan_data hash.
                   5636: 
                   5637:   Arguments:
                   5638:     $scan_data  - The hash (see scantron_getfile)
                   5639:     $key        - shorthand of the key to edit (actual key is
1.424     albertel 5640:                   scantronfilename_key).
1.423     albertel 5641:     $data        - New value of the hash entry.
                   5642:     $delete      - If true, the entry is removed from the hash.
                   5643: 
                   5644:   Returns:
                   5645:     The new value of the hash table field (undefined if deleted).
                   5646: 
                   5647: =cut
                   5648: 
                   5649: 
1.157     albertel 5650: sub scan_data {
                   5651:     my ($scan_data,$key,$value,$delete)=@_;
1.257     albertel 5652:     my $filename=$env{'form.scantron_selectfile'};
1.157     albertel 5653:     if (defined($value)) {
                   5654: 	$scan_data->{$filename.'_'.$key} = $value;
                   5655:     }
                   5656:     if ($delete) { delete($scan_data->{$filename.'_'.$key}); }
                   5657:     return $scan_data->{$filename.'_'.$key};
                   5658: }
1.423     albertel 5659: 
1.495     albertel 5660: # ----- These first few routines are general use routines.----
                   5661: 
                   5662: # Return the number of occurences of a pattern in a string.
                   5663: 
                   5664: sub occurence_count {
                   5665:     my ($string, $pattern) = @_;
                   5666: 
                   5667:     my @matches = ($string =~ /$pattern/g);
                   5668: 
                   5669:     return scalar(@matches);
                   5670: }
                   5671: 
                   5672: 
                   5673: # Take a string known to have digits and convert all the
                   5674: # digits into letters in the range J,A..I.
                   5675: 
                   5676: sub digits_to_letters {
                   5677:     my ($input) = @_;
                   5678: 
                   5679:     my @alphabet = ('J', 'A'..'I');
                   5680: 
                   5681:     my @input    = split(//, $input);
                   5682:     my $output ='';
                   5683:     for (my $i = 0; $i < scalar(@input); $i++) {
                   5684: 	if ($input[$i] =~ /\d/) {
                   5685: 	    $output .= $alphabet[$input[$i]];
                   5686: 	} else {
                   5687: 	    $output .= $input[$i];
                   5688: 	}
                   5689:     }
                   5690:     return $output;
                   5691: }
                   5692: 
1.423     albertel 5693: =pod 
                   5694: 
                   5695: =item scantron_parse_scanline
                   5696: 
                   5697:   Decodes a scanline from the selected scantron file
                   5698: 
                   5699:  Arguments:
                   5700:     line             - The text of the scantron file line to process
                   5701:     whichline        - Line number
                   5702:     scantron_config  - Hash describing the format of the scantron lines.
                   5703:     scan_data        - Hash of extra information about the scanline
                   5704:                        (see scantron_getfile for more information)
                   5705:     just_header      - True if should not process question answers but only
                   5706:                        the stuff to the left of the answers.
                   5707:  Returns:
                   5708:    Hash containing the result of parsing the scanline
                   5709: 
                   5710:    Keys are all proceeded by the string 'scantron.'
                   5711: 
                   5712:        CODE    - the CODE in use for this scanline
                   5713:        useCODE - 1 if the CODE is invalid but it usage has been forced
                   5714:                  by the operator
                   5715:        CODE_ignore_dup - 1 if the CODE is a duplicated use when unique
                   5716:                             CODEs were selected, but the usage has been
                   5717:                             forced by the operator
1.556     weissno  5718:        ID  - student/employee ID
1.423     albertel 5719:        PaperID - if used, the ID number printed on the sheet when the 
                   5720:                  paper was scanned
                   5721:        FirstName - first name from the sheet
                   5722:        LastName  - last name from the sheet
                   5723: 
                   5724:      if just_header was not true these key may also exist
                   5725: 
1.447     foxr     5726:        missingerror - a list of bubble ranges that are considered to be answers
                   5727:                       to a single question that don't have any bubbles filled in.
                   5728:                       Of the form questionnumber:firstbubblenumber:count.
                   5729:        doubleerror  - a list of bubble ranges that are considered to be answers
                   5730:                       to a single question that have more than one bubble filled in.
                   5731:                       Of the form questionnumber::firstbubblenumber:count
                   5732:    
                   5733:                 In the above, count is the number of bubble responses in the
                   5734:                 input line needed to represent the possible answers to the question.
                   5735:                 e.g. a radioresponse with 15 choices in an answer sheet with 10 choices
                   5736:                 per line would have count = 2.
                   5737: 
1.423     albertel 5738:        maxquest     - the number of the last bubble line that was parsed
                   5739: 
                   5740:        (<number> starts at 1)
                   5741:        <number>.answer - zero or more letters representing the selected
                   5742:                          letters from the scanline for the bubble line 
                   5743:                          <number>.
                   5744:                          if blank there was either no bubble or there where
                   5745:                          multiple bubbles, (consult the keys missingerror and
                   5746:                          doubleerror if this is an error condition)
                   5747: 
                   5748: =cut
                   5749: 
1.82      albertel 5750: sub scantron_parse_scanline {
1.423     albertel 5751:     my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;
1.470     foxr     5752: 
1.82      albertel 5753:     my %record;
1.550     raeburn  5754:     my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'};
                   5755:     my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos);  # Answers
1.422     foxr     5756:     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff
1.278     albertel 5757:     if (!($$scantron_config{'CODElocation'} eq 0 ||
                   5758: 	  $$scantron_config{'CODElocation'} eq 'none')) {
                   5759: 	if ($$scantron_config{'CODElocation'} < 0 ||
                   5760: 	    $$scantron_config{'CODElocation'} eq 'letter' ||
                   5761: 	    $$scantron_config{'CODElocation'} eq 'number') {
1.191     albertel 5762: 	    $record{'scantron.CODE'}=substr($data,
                   5763: 					    $$scantron_config{'CODEstart'}-1,
1.83      albertel 5764: 					    $$scantron_config{'CODElength'});
1.191     albertel 5765: 	    if (&scan_data($scan_data,"$whichline.useCODE")) {
                   5766: 		$record{'scantron.useCODE'}=1;
                   5767: 	    }
1.192     albertel 5768: 	    if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) {
                   5769: 		$record{'scantron.CODE_ignore_dup'}=1;
                   5770: 	    }
1.82      albertel 5771: 	} else {
                   5772: 	    #FIXME interpret first N questions
                   5773: 	}
                   5774:     }
1.83      albertel 5775:     $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
                   5776: 				  $$scantron_config{'IDlength'});
1.157     albertel 5777:     $record{'scantron.PaperID'}=
                   5778: 	substr($data,$$scantron_config{'PaperID'}-1,
                   5779: 	       $$scantron_config{'PaperIDlength'});
                   5780:     $record{'scantron.FirstName'}=
                   5781: 	substr($data,$$scantron_config{'FirstName'}-1,
                   5782: 	       $$scantron_config{'FirstNamelength'});
                   5783:     $record{'scantron.LastName'}=
                   5784: 	substr($data,$$scantron_config{'LastName'}-1,
                   5785: 	       $$scantron_config{'LastNamelength'});
1.423     albertel 5786:     if ($just_header) { return \%record; }
1.194     albertel 5787: 
1.82      albertel 5788:     my @alphabet=('A'..'Z');
                   5789:     my $questnum=0;
1.447     foxr     5790:     my $ansnum  =1;		# Multiple 'answer lines'/question.
                   5791: 
1.470     foxr     5792:     chomp($questions);		# Get rid of any trailing \n.
                   5793:     $questions =~ s/\r$//;      # Get rid of trailing \r too (MAC or Win uploads).
                   5794:     while (length($questions)) {
1.447     foxr     5795: 	my $answers_needed = $bubble_lines_per_response{$questnum};
1.503     raeburn  5796:         my $answer_length  = ($$scantron_config{'Qlength'} * $answers_needed)
                   5797:                              || 1;
                   5798:         $questnum++;
                   5799:         my $quest_id = $questnum;
                   5800:         my $currentquest = substr($questions,0,$answer_length);
                   5801:         $questions       = substr($questions,$answer_length);
                   5802:         if (length($currentquest) < $answer_length) { next; }
                   5803: 
                   5804:         if ($subdivided_bubble_lines{$questnum-1} =~ /,/) {
                   5805:             my $subquestnum = 1;
                   5806:             my $subquestions = $currentquest;
                   5807:             my @subanswers_needed = 
                   5808:                 split(/,/,$subdivided_bubble_lines{$questnum-1});  
                   5809:             foreach my $subans (@subanswers_needed) {
                   5810:                 my $subans_length =
                   5811:                     ($$scantron_config{'Qlength'} * $subans)  || 1;
                   5812:                 my $currsubquest = substr($subquestions,0,$subans_length);
                   5813:                 $subquestions   = substr($subquestions,$subans_length);
                   5814:                 $quest_id = "$questnum.$subquestnum";
                   5815:                 if (($$scantron_config{'Qon'} eq 'letter') ||
                   5816:                     ($$scantron_config{'Qon'} eq 'number')) {
                   5817:                     $ansnum = &scantron_validator_lettnum($ansnum, 
                   5818:                         $questnum,$quest_id,$subans,$currsubquest,$whichline,
                   5819:                         \@alphabet,\%record,$scantron_config,$scan_data);
                   5820:                 } else {
                   5821:                     $ansnum = &scantron_validator_positional($ansnum,
                   5822:                         $questnum,$quest_id,$subans,$currsubquest,$whichline,                        \@alphabet,\%record,$scantron_config,$scan_data);
                   5823:                 }
                   5824:                 $subquestnum ++;
                   5825:             }
                   5826:         } else {
                   5827:             if (($$scantron_config{'Qon'} eq 'letter') ||
                   5828:                 ($$scantron_config{'Qon'} eq 'number')) {
                   5829:                 $ansnum = &scantron_validator_lettnum($ansnum,$questnum,
                   5830:                     $quest_id,$answers_needed,$currentquest,$whichline,
                   5831:                     \@alphabet,\%record,$scantron_config,$scan_data);
                   5832:             } else {
                   5833:                 $ansnum = &scantron_validator_positional($ansnum,$questnum,
                   5834:                     $quest_id,$answers_needed,$currentquest,$whichline,
                   5835:                     \@alphabet,\%record,$scantron_config,$scan_data);
                   5836:             }
                   5837:         }
                   5838:     }
                   5839:     $record{'scantron.maxquest'}=$questnum;
                   5840:     return \%record;
                   5841: }
1.447     foxr     5842: 
1.503     raeburn  5843: sub scantron_validator_lettnum {
                   5844:     my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline,
                   5845:         $alphabet,$record,$scantron_config,$scan_data) = @_;
                   5846: 
                   5847:     # Qon 'letter' implies for each slot in currquest we have:
                   5848:     #    ? or * for doubles, a letter in A-Z for a bubble, and
                   5849:     #    about anything else (esp. a value of Qoff) for missing
                   5850:     #    bubbles.
                   5851:     #
                   5852:     # Qon 'number' implies each slot gives a digit that indexes the
                   5853:     #    bubbles filled, or Qoff, or a non-number for unbubbled lines,
                   5854:     #    and * or ? for double bubbles on a single line.
                   5855:     #
1.447     foxr     5856: 
1.503     raeburn  5857:     my $matchon;
                   5858:     if ($$scantron_config{'Qon'} eq 'letter') {
                   5859:         $matchon = '[A-Z]';
                   5860:     } elsif ($$scantron_config{'Qon'} eq 'number') {
                   5861:         $matchon = '\d';
                   5862:     }
                   5863:     my $occurrences = 0;
                   5864:     if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
                   5865:         ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
1.510     raeburn  5866:         ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
                   5867:         ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
                   5868:         ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
                   5869:         ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
1.503     raeburn  5870:         my @singlelines = split('',$currquest);
                   5871:         foreach my $entry (@singlelines) {
                   5872:             $occurrences = &occurence_count($entry,$matchon);
                   5873:             if ($occurrences > 1) {
                   5874:                 last;
                   5875:             }
                   5876:         } 
                   5877:     } else {
                   5878:         $occurrences = &occurence_count($currquest,$matchon); 
                   5879:     }
                   5880:     if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) {
                   5881:         push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5882:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5883:             my $bubble = substr($currquest,$ans,1);
                   5884:             if ($bubble =~ /$matchon/ ) {
                   5885:                 if ($$scantron_config{'Qon'} eq 'number') {
                   5886:                     if ($bubble == 0) {
                   5887:                         $bubble = 10; 
                   5888:                     }
                   5889:                     $record->{"scantron.$ansnum.answer"} = 
                   5890:                         $alphabet->[$bubble-1];
                   5891:                 } else {
                   5892:                     $record->{"scantron.$ansnum.answer"} = $bubble;
                   5893:                 }
                   5894:             } else {
                   5895:                 $record->{"scantron.$ansnum.answer"}='';
                   5896:             }
                   5897:             $ansnum++;
                   5898:         }
                   5899:     } elsif (!defined($currquest)
                   5900:             || (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest))
                   5901:             || (&occurence_count($currquest,$matchon) == 0)) {
                   5902:         for (my $ans=0; $ans<$answers_needed; $ans++ ) {
                   5903:             $record->{"scantron.$ansnum.answer"}='';
                   5904:             $ansnum++;
                   5905:         }
                   5906:         if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) {
                   5907:             push(@{$record->{'scantron.missingerror'}},$quest_id);
                   5908:         }
                   5909:     } else {
                   5910:         if ($$scantron_config{'Qon'} eq 'number') {
                   5911:             $currquest = &digits_to_letters($currquest);            
                   5912:         }
                   5913:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5914:             my $bubble = substr($currquest,$ans,1);
                   5915:             $record->{"scantron.$ansnum.answer"} = $bubble;
                   5916:             $ansnum++;
                   5917:         }
                   5918:     }
                   5919:     return $ansnum;
                   5920: }
1.447     foxr     5921: 
1.503     raeburn  5922: sub scantron_validator_positional {
                   5923:     my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,
                   5924:         $whichline,$alphabet,$record,$scantron_config,$scan_data) = @_;
1.447     foxr     5925: 
1.503     raeburn  5926:     # Otherwise there's a positional notation;
                   5927:     # each bubble line requires Qlength items, and there are filled in
                   5928:     # bubbles for each case where there 'Qon' characters.
                   5929:     #
1.447     foxr     5930: 
1.503     raeburn  5931:     my @array=split($$scantron_config{'Qon'},$currquest,-1);
1.447     foxr     5932: 
1.503     raeburn  5933:     # If the split only gives us one element.. the full length of the
                   5934:     # answer string, no bubbles are filled in:
1.447     foxr     5935: 
1.507     raeburn  5936:     if ($answers_needed eq '') {
                   5937:         return;
                   5938:     }
                   5939: 
1.503     raeburn  5940:     if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) {
                   5941:         for (my $ans=0; $ans<$answers_needed; $ans++ ) {
                   5942:             $record->{"scantron.$ansnum.answer"}='';
                   5943:             $ansnum++;
                   5944:         }
                   5945:         if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) {
                   5946:             push(@{$record->{"scantron.missingerror"}},$quest_id);
                   5947:         }
                   5948:     } elsif (scalar(@array) == 2) {
                   5949:         my $location = length($array[0]);
                   5950:         my $line_num = int($location / $$scantron_config{'Qlength'});
                   5951:         my $bubble   = $alphabet->[$location % $$scantron_config{'Qlength'}];
                   5952:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5953:             if ($ans eq $line_num) {
                   5954:                 $record->{"scantron.$ansnum.answer"} = $bubble;
                   5955:             } else {
                   5956:                 $record->{"scantron.$ansnum.answer"} = ' ';
                   5957:             }
                   5958:             $ansnum++;
                   5959:          }
                   5960:     } else {
                   5961:         #  If there's more than one instance of a bubble character
                   5962:         #  That's a double bubble; with positional notation we can
                   5963:         #  record all the bubbles filled in as well as the
                   5964:         #  fact this response consists of multiple bubbles.
                   5965:         #
                   5966:         if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
                   5967:             ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
1.510     raeburn  5968:             ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
                   5969:             ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
                   5970:             ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
                   5971:             ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
1.503     raeburn  5972:             my $doubleerror = 0;
                   5973:             while (($currquest >= $$scantron_config{'Qlength'}) && 
                   5974:                    (!$doubleerror)) {
                   5975:                my $currline = substr($currquest,0,$$scantron_config{'Qlength'});
                   5976:                $currquest = substr($currquest,$$scantron_config{'Qlength'});
                   5977:                my @currarray = split($$scantron_config{'Qon'},$currline,-1);
                   5978:                if (length(@currarray) > 2) {
                   5979:                    $doubleerror = 1;
                   5980:                } 
                   5981:             }
                   5982:             if ($doubleerror) {
                   5983:                 push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5984:             }
                   5985:         } else {
                   5986:             push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5987:         }
                   5988:         my $item = $ansnum;
                   5989:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5990:             $record->{"scantron.$item.answer"} = '';
                   5991:             $item ++;
                   5992:         }
1.447     foxr     5993: 
1.503     raeburn  5994:         my @ans=@array;
                   5995:         my $i=0;
                   5996:         my $increment = 0;
                   5997:         while ($#ans) {
                   5998:             $i+=length($ans[0]) + $increment;
                   5999:             my $line   = int($i/$$scantron_config{'Qlength'} + $ansnum);
                   6000:             my $bubble = $i%$$scantron_config{'Qlength'};
                   6001:             $record->{"scantron.$line.answer"}.=$alphabet->[$bubble];
                   6002:             shift(@ans);
                   6003:             $increment = 1;
                   6004:         }
                   6005:         $ansnum += $answers_needed;
1.82      albertel 6006:     }
1.503     raeburn  6007:     return $ansnum;
1.82      albertel 6008: }
                   6009: 
1.423     albertel 6010: =pod
                   6011: 
                   6012: =item scantron_add_delay
                   6013: 
                   6014:    Adds an error message that occurred during the grading phase to a
                   6015:    queue of messages to be shown after grading pass is complete
                   6016: 
                   6017:  Arguments:
1.424     albertel 6018:    $delayqueue  - arrary ref of hash ref of error messages
1.423     albertel 6019:    $scanline    - the scanline that caused the error
                   6020:    $errormesage - the error message
                   6021:    $errorcode   - a numeric code for the error
                   6022: 
                   6023:  Side Effects:
1.424     albertel 6024:    updates the $delayqueue to have a new hash ref of the error
1.423     albertel 6025: 
                   6026: =cut
                   6027: 
1.82      albertel 6028: sub scantron_add_delay {
1.140     albertel 6029:     my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;
                   6030:     push(@$delayqueue,
                   6031: 	 {'line' => $scanline, 'emsg' => $errormessage,
                   6032: 	  'ecode' => $errorcode }
                   6033: 	 );
1.82      albertel 6034: }
                   6035: 
1.423     albertel 6036: =pod
                   6037: 
                   6038: =item scantron_find_student
                   6039: 
1.424     albertel 6040:    Finds the username for the current scanline
                   6041: 
                   6042:   Arguments:
                   6043:    $scantron_record - hash result from scantron_parse_scanline
                   6044:    $scan_data       - hash of correction information 
                   6045:                       (see &scantron_getfile() form more information)
                   6046:    $idmap           - hash from &username_to_idmap()
                   6047:    $line            - number of current scanline
                   6048:  
                   6049:   Returns:
                   6050:    Either 'username:domain' or undef if unknown
                   6051: 
1.423     albertel 6052: =cut
                   6053: 
1.82      albertel 6054: sub scantron_find_student {
1.157     albertel 6055:     my ($scantron_record,$scan_data,$idmap,$line)=@_;
1.83      albertel 6056:     my $scanID=$$scantron_record{'scantron.ID'};
1.157     albertel 6057:     if ($scanID =~ /^\s*$/) {
                   6058:  	return &scan_data($scan_data,"$line.user");
                   6059:     }
1.83      albertel 6060:     foreach my $id (keys(%$idmap)) {
1.157     albertel 6061:  	if (lc($id) eq lc($scanID)) {
                   6062:  	    return $$idmap{$id};
                   6063:  	}
1.83      albertel 6064:     }
                   6065:     return undef;
                   6066: }
                   6067: 
1.423     albertel 6068: =pod
                   6069: 
                   6070: =item scantron_filter
                   6071: 
1.424     albertel 6072:    Filter sub for lonnavmaps, filters out hidden resources if ignore
                   6073:    hidden resources was selected
                   6074: 
1.423     albertel 6075: =cut
                   6076: 
1.83      albertel 6077: sub scantron_filter {
                   6078:     my ($curres)=@_;
1.331     albertel 6079: 
                   6080:     if (ref($curres) && $curres->is_problem()) {
                   6081: 	# if the user has asked to not have either hidden
                   6082: 	# or 'randomout' controlled resources to be graded
                   6083: 	# don't include them
                   6084: 	if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
                   6085: 	    && $curres->randomout) {
                   6086: 	    return 0;
                   6087: 	}
1.83      albertel 6088: 	return 1;
                   6089:     }
                   6090:     return 0;
1.82      albertel 6091: }
                   6092: 
1.423     albertel 6093: =pod
                   6094: 
                   6095: =item scantron_process_corrections
                   6096: 
1.424     albertel 6097:    Gets correction information out of submitted form data and corrects
                   6098:    the scanline
                   6099: 
1.423     albertel 6100: =cut
                   6101: 
1.157     albertel 6102: sub scantron_process_corrections {
                   6103:     my ($r) = @_;
1.257     albertel 6104:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 6105:     my ($scanlines,$scan_data)=&scantron_getfile();
                   6106:     my $classlist=&Apache::loncoursedata::get_classlist();
1.257     albertel 6107:     my $which=$env{'form.scantron_line'};
1.200     albertel 6108:     my $line=&scantron_get_line($scanlines,$scan_data,$which);
1.157     albertel 6109:     my ($skip,$err,$errmsg);
1.257     albertel 6110:     if ($env{'form.scantron_skip_record'}) {
1.157     albertel 6111: 	$skip=1;
1.257     albertel 6112:     } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
                   6113: 	my $newstudent=$env{'form.scantron_username'}.':'.
                   6114: 	    $env{'form.scantron_domain'};
1.157     albertel 6115: 	my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
                   6116: 	($line,$err,$errmsg)=
                   6117: 	    &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
                   6118: 				     'ID',{'newid'=>$newid,
1.257     albertel 6119: 				    'username'=>$env{'form.scantron_username'},
                   6120: 				    'domain'=>$env{'form.scantron_domain'}});
                   6121:     } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) {
                   6122: 	my $resolution=$env{'form.scantron_CODE_resolution'};
1.190     albertel 6123: 	my $newCODE;
1.192     albertel 6124: 	my %args;
1.190     albertel 6125: 	if      ($resolution eq 'use_unfound') {
1.191     albertel 6126: 	    $newCODE='use_unfound';
1.190     albertel 6127: 	} elsif ($resolution eq 'use_found') {
1.257     albertel 6128: 	    $newCODE=$env{'form.scantron_CODE_selectedvalue'};
1.190     albertel 6129: 	} elsif ($resolution eq 'use_typed') {
1.257     albertel 6130: 	    $newCODE=$env{'form.scantron_CODE_newvalue'};
1.194     albertel 6131: 	} elsif ($resolution =~ /^use_closest_(\d+)/) {
1.257     albertel 6132: 	    $newCODE=$env{"form.scantron_CODE_closest_$1"};
1.190     albertel 6133: 	}
1.257     albertel 6134: 	if ($env{'form.scantron_corrections'} eq 'duplicateCODE') {
1.192     albertel 6135: 	    $args{'CODE_ignore_dup'}=1;
                   6136: 	}
                   6137: 	$args{'CODE'}=$newCODE;
1.186     albertel 6138: 	($line,$err,$errmsg)=
                   6139: 	    &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
1.192     albertel 6140: 				     'CODE',\%args);
1.257     albertel 6141:     } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
                   6142: 	foreach my $question (split(',',$env{'form.scantron_questions'})) {
1.157     albertel 6143: 	    ($line,$err,$errmsg)=
                   6144: 		&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
                   6145: 					 $which,'answer',
                   6146: 					 { 'question'=>$question,
1.503     raeburn  6147: 		      		   'response'=>$env{"form.scantron_correct_Q_$question"},
                   6148:                                    'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}});
1.157     albertel 6149: 	    if ($err) { last; }
                   6150: 	}
                   6151:     }
                   6152:     if ($err) {
1.398     albertel 6153: 	$r->print("<span class=\"LC_warning\">Unable to accept last correction, an error occurred :$errmsg:</span>");
1.157     albertel 6154:     } else {
1.200     albertel 6155: 	&scantron_put_line($scanlines,$scan_data,$which,$line,$skip);
1.157     albertel 6156: 	&scantron_putfile($scanlines,$scan_data);
                   6157:     }
                   6158: }
                   6159: 
1.423     albertel 6160: =pod
                   6161: 
                   6162: =item reset_skipping_status
                   6163: 
1.424     albertel 6164:    Forgets the current set of remember skipped scanlines (and thus
                   6165:    reverts back to considering all lines in the
                   6166:    scantron_skipped_<filename> file)
                   6167: 
1.423     albertel 6168: =cut
                   6169: 
1.200     albertel 6170: sub reset_skipping_status {
                   6171:     my ($scanlines,$scan_data)=&scantron_getfile();
                   6172:     &scan_data($scan_data,'remember_skipping',undef,1);
                   6173:     &scantron_putfile(undef,$scan_data);
                   6174: }
                   6175: 
1.423     albertel 6176: =pod
                   6177: 
                   6178: =item start_skipping
                   6179: 
1.424     albertel 6180:    Marks a scanline to be skipped. 
                   6181: 
1.423     albertel 6182: =cut
                   6183: 
1.376     albertel 6184: sub start_skipping {
1.200     albertel 6185:     my ($scan_data,$i)=@_;
                   6186:     my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
1.376     albertel 6187:     if ($env{'form.scantron_options_redo'} =~ /^redo_/) {
                   6188: 	$remembered{$i}=2;
                   6189:     } else {
                   6190: 	$remembered{$i}=1;
                   6191:     }
1.200     albertel 6192:     &scan_data($scan_data,'remember_skipping',join(':',%remembered));
                   6193: }
                   6194: 
1.423     albertel 6195: =pod
                   6196: 
                   6197: =item should_be_skipped
                   6198: 
1.424     albertel 6199:    Checks whether a scanline should be skipped.
                   6200: 
1.423     albertel 6201: =cut
                   6202: 
1.200     albertel 6203: sub should_be_skipped {
1.376     albertel 6204:     my ($scanlines,$scan_data,$i)=@_;
1.257     albertel 6205:     if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
1.200     albertel 6206: 	# not redoing old skips
1.376     albertel 6207: 	if ($scanlines->{'skipped'}[$i]) { return 1; }
1.200     albertel 6208: 	return 0;
                   6209:     }
                   6210:     my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
1.376     albertel 6211: 
                   6212:     if (exists($remembered{$i}) && $remembered{$i} != 2 ) {
                   6213: 	return 0;
                   6214:     }
1.200     albertel 6215:     return 1;
                   6216: }
                   6217: 
1.423     albertel 6218: =pod
                   6219: 
                   6220: =item remember_current_skipped
                   6221: 
1.424     albertel 6222:    Discovers what scanlines are in the scantron_skipped_<filename>
                   6223:    file and remembers them into scan_data for later use.
                   6224: 
1.423     albertel 6225: =cut
                   6226: 
1.200     albertel 6227: sub remember_current_skipped {
                   6228:     my ($scanlines,$scan_data)=&scantron_getfile();
                   6229:     my %to_remember;
                   6230:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
                   6231: 	if ($scanlines->{'skipped'}[$i]) {
                   6232: 	    $to_remember{$i}=1;
                   6233: 	}
                   6234:     }
1.376     albertel 6235: 
1.200     albertel 6236:     &scan_data($scan_data,'remember_skipping',join(':',%to_remember));
                   6237:     &scantron_putfile(undef,$scan_data);
                   6238: }
                   6239: 
1.423     albertel 6240: =pod
                   6241: 
                   6242: =item check_for_error
                   6243: 
1.424     albertel 6244:     Checks if there was an error when attempting to remove a specific
                   6245:     scantron_.. bubble sheet data file. Prints out an error if
                   6246:     something went wrong.
                   6247: 
1.423     albertel 6248: =cut
                   6249: 
1.200     albertel 6250: sub check_for_error {
                   6251:     my ($r,$result)=@_;
                   6252:     if ($result ne 'ok' && $result ne 'not_found' ) {
1.492     albertel 6253: 	$r->print(&mt("An error occurred ([_1]) when trying to remove the existing corrections.",$result));
1.200     albertel 6254:     }
                   6255: }
1.157     albertel 6256: 
1.423     albertel 6257: =pod
                   6258: 
                   6259: =item scantron_warning_screen
                   6260: 
1.424     albertel 6261:    Interstitial screen to make sure the operator has selected the
                   6262:    correct options before we start the validation phase.
                   6263: 
1.423     albertel 6264: =cut
                   6265: 
1.203     albertel 6266: sub scantron_warning_screen {
                   6267:     my ($button_text)=@_;
1.257     albertel 6268:     my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});
1.284     albertel 6269:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.373     albertel 6270:     my $CODElist;
1.284     albertel 6271:     if ($scantron_config{'CODElocation'} &&
                   6272: 	$scantron_config{'CODEstart'} &&
                   6273: 	$scantron_config{'CODElength'}) {
                   6274: 	$CODElist=$env{'form.scantron_CODElist'};
1.398     albertel 6275: 	if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">None</span>'; }
1.284     albertel 6276: 	$CODElist=
1.492     albertel 6277: 	    '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.
1.373     albertel 6278: 	    $env{'form.scantron_CODElist'}.'</tt></td></tr>';
1.284     albertel 6279:     }
1.492     albertel 6280:     return ('
1.203     albertel 6281: <p>
1.492     albertel 6282: <span class="LC_warning">
                   6283: '.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).'</span>
1.203     albertel 6284: </p>
                   6285: <table>
1.492     albertel 6286: <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>
                   6287: <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>
                   6288: '.$CODElist.'
1.203     albertel 6289: </table>
                   6290: <br />
1.492     albertel 6291: <p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p>
                   6292: <p> '.&mt('If something is incorrect, please click the \'Grading Menu\' button to start over.').'</p>
1.203     albertel 6293: 
                   6294: <br />
1.492     albertel 6295: ');
1.203     albertel 6296: }
                   6297: 
1.423     albertel 6298: =pod
                   6299: 
                   6300: =item scantron_do_warning
                   6301: 
1.424     albertel 6302:    Check if the operator has picked something for all required
                   6303:    fields. Error out if something is missing.
                   6304: 
1.423     albertel 6305: =cut
                   6306: 
1.203     albertel 6307: sub scantron_do_warning {
                   6308:     my ($r)=@_;
1.324     albertel 6309:     my ($symb)=&get_symb($r);
1.203     albertel 6310:     if (!$symb) {return '';}
1.324     albertel 6311:     my $default_form_data=&defaultFormData($symb);
1.203     albertel 6312:     $r->print(&scantron_form_start().$default_form_data);
1.257     albertel 6313:     if ( $env{'form.selectpage'} eq '' ||
                   6314: 	 $env{'form.scantron_selectfile'} eq '' ||
                   6315: 	 $env{'form.scantron_format'} eq '' ) {
1.492     albertel 6316: 	$r->print("<p>".&mt('You have forgetten to specify some information. Please go Back and try again.')."</p>");
1.257     albertel 6317: 	if ( $env{'form.selectpage'} eq '') {
1.492     albertel 6318: 	    $r->print('<p><span class="LC_error">'.&mt('You have not selected a Sequence to grade').'</span></p>');
1.237     albertel 6319: 	} 
1.257     albertel 6320: 	if ( $env{'form.scantron_selectfile'} eq '') {
1.492     albertel 6321: 	    $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 6322: 	} 
1.257     albertel 6323: 	if ( $env{'form.scantron_format'} eq '') {
1.492     albertel 6324: 	    $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 6325: 	} 
                   6326:     } else {
1.265     www      6327: 	my $warning=&scantron_warning_screen('Grading: Validate Records');
1.492     albertel 6328: 	$r->print('
                   6329: '.$warning.'
                   6330: <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />
1.203     albertel 6331: <input type="hidden" name="command" value="scantron_validate" />
1.492     albertel 6332: ');
1.237     albertel 6333:     }
1.352     albertel 6334:     $r->print("</form><br />".&show_grading_menu_form($symb));
1.203     albertel 6335:     return '';
                   6336: }
                   6337: 
1.423     albertel 6338: =pod
                   6339: 
                   6340: =item scantron_form_start
                   6341: 
1.424     albertel 6342:     html hidden input for remembering all selected grading options
                   6343: 
1.423     albertel 6344: =cut
                   6345: 
1.203     albertel 6346: sub scantron_form_start {
                   6347:     my ($max_bubble)=@_;
                   6348:     my $result= <<SCANTRONFORM;
                   6349: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
1.257     albertel 6350:   <input type="hidden" name="selectpage" value="$env{'form.selectpage'}" />
                   6351:   <input type="hidden" name="scantron_format" value="$env{'form.scantron_format'}" />
                   6352:   <input type="hidden" name="scantron_selectfile" value="$env{'form.scantron_selectfile'}" />
1.218     albertel 6353:   <input type="hidden" name="scantron_maxbubble" value="$max_bubble" />
1.257     albertel 6354:   <input type="hidden" name="scantron_CODElist" value="$env{'form.scantron_CODElist'}" />
                   6355:   <input type="hidden" name="scantron_CODEunique" value="$env{'form.scantron_CODEunique'}" />
                   6356:   <input type="hidden" name="scantron_options_redo" value="$env{'form.scantron_options_redo'}" />
                   6357:   <input type="hidden" name="scantron_options_ignore" value="$env{'form.scantron_options_ignore'}" />
1.331     albertel 6358:   <input type="hidden" name="scantron_options_hidden" value="$env{'form.scantron_options_hidden'}" />
1.203     albertel 6359: SCANTRONFORM
1.447     foxr     6360: 
                   6361:   my $line = 0;
                   6362:     while (defined($env{"form.scantron.bubblelines.$line"})) {
                   6363:        my $chunk =
                   6364: 	   '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n";
1.448     foxr     6365:        $chunk .=
                   6366: 	   '<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n";
1.503     raeburn  6367:        $chunk .= 
                   6368:            '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n";
1.504     raeburn  6369:        $chunk .=
                   6370:            '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n";
1.447     foxr     6371:        $result .= $chunk;
                   6372:        $line++;
                   6373:    }
1.203     albertel 6374:     return $result;
                   6375: }
                   6376: 
1.423     albertel 6377: =pod
                   6378: 
                   6379: =item scantron_validate_file
                   6380: 
1.424     albertel 6381:     Dispatch routine for doing validation of a bubble sheet data file.
                   6382: 
                   6383:     Also processes any necessary information resets that need to
                   6384:     occur before validation begins (ignore previous corrections,
                   6385:     restarting the skipped records processing)
                   6386: 
1.423     albertel 6387: =cut
                   6388: 
1.157     albertel 6389: sub scantron_validate_file {
                   6390:     my ($r) = @_;
1.324     albertel 6391:     my ($symb)=&get_symb($r);
1.157     albertel 6392:     if (!$symb) {return '';}
1.324     albertel 6393:     my $default_form_data=&defaultFormData($symb);
1.200     albertel 6394:     
                   6395:     # do the detection of only doing skipped records first befroe we delete
1.424     albertel 6396:     # them when doing the corrections reset
1.257     albertel 6397:     if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') {
1.200     albertel 6398: 	&reset_skipping_status();
                   6399:     }
1.257     albertel 6400:     if ($env{'form.scantron_options_redo'} eq 'redo_skipped') {
1.200     albertel 6401: 	&remember_current_skipped();
1.257     albertel 6402: 	$env{'form.scantron_options_redo'}='redo_skipped_ready';
1.200     albertel 6403:     }
                   6404: 
1.257     albertel 6405:     if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') {
1.200     albertel 6406: 	&check_for_error($r,&scantron_remove_file('corrected'));
                   6407: 	&check_for_error($r,&scantron_remove_file('skipped'));
                   6408: 	&check_for_error($r,&scantron_remove_scan_data());
1.257     albertel 6409: 	$env{'form.scantron_options_ignore'}='done';
1.192     albertel 6410:     }
1.200     albertel 6411: 
1.257     albertel 6412:     if ($env{'form.scantron_corrections'}) {
1.157     albertel 6413: 	&scantron_process_corrections($r);
                   6414:     }
1.503     raeburn  6415:     $r->print('<p>'.&mt('Gathering necessary information.').'</p>');$r->rflush();
1.157     albertel 6416:     #get the student pick code ready
                   6417:     $r->print(&Apache::loncommon::studentbrowser_javascript());
1.582     raeburn  6418:     my $nav_error;
                   6419:     my $max_bubble=&scantron_get_maxbubble(\$nav_error);
                   6420:     if ($nav_error) {
                   6421:         $r->print(&navmap_errormsg());
                   6422:         return '';
                   6423:     }
1.203     albertel 6424:     my $result=&scantron_form_start($max_bubble).$default_form_data;
1.157     albertel 6425:     $r->print($result);
                   6426:     
1.334     albertel 6427:     my @validate_phases=( 'sequence',
                   6428: 			  'ID',
1.157     albertel 6429: 			  'CODE',
                   6430: 			  'doublebubble',
                   6431: 			  'missingbubbles');
1.257     albertel 6432:     if (!$env{'form.validatepass'}) {
                   6433: 	$env{'form.validatepass'} = 0;
1.157     albertel 6434:     }
1.257     albertel 6435:     my $currentphase=$env{'form.validatepass'};
1.157     albertel 6436: 
1.448     foxr     6437: 
1.157     albertel 6438:     my $stop=0;
                   6439:     while (!$stop && $currentphase < scalar(@validate_phases)) {
1.503     raeburn  6440: 	$r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />');
1.157     albertel 6441: 	$r->rflush();
                   6442: 	my $which="scantron_validate_".$validate_phases[$currentphase];
                   6443: 	{
                   6444: 	    no strict 'refs';
                   6445: 	    ($stop,$currentphase)=&$which($r,$currentphase);
                   6446: 	}
                   6447:     }
                   6448:     if (!$stop) {
1.203     albertel 6449: 	my $warning=&scantron_warning_screen('Start Grading');
1.542     raeburn  6450: 	$r->print(&mt('Validation process complete.').'<br />'.
                   6451:                   $warning.
                   6452:                   &mt('Perform verification for each student after storage of submissions?').
                   6453:                   '&nbsp;<span class="LC_nobreak"><label>'.
                   6454:                   '<input type="radio" name="verifyrecord" value="1" />'.&mt('Yes').'</label>'.
                   6455:                   ('&nbsp;'x3).'<label>'.
                   6456:                   '<input type="radio" name="verifyrecord" value="0" checked="checked" />'.&mt('No').
                   6457:                   '</label></span><br />'.
                   6458:                   &mt('Grading will take longer if you use verification.').'<br />'.
1.572     www      6459:                   &mt("Alternatively, the 'Review bubblesheet data' utility (see grading menu) can be used for all students after grading is complete.").'<br /><br />'.
1.542     raeburn  6460:                   '<input type="submit" name="submit" value="'.&mt('Start Grading').'" />'.
                   6461:                   '<input type="hidden" name="command" value="scantron_process" />'."\n");
1.157     albertel 6462:     } else {
                   6463: 	$r->print('<input type="hidden" name="command" value="scantron_validate" />');
                   6464: 	$r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
                   6465:     }
                   6466:     if ($stop) {
1.334     albertel 6467: 	if ($validate_phases[$currentphase] eq 'sequence') {
1.539     riegler  6468: 	    $r->print('<input type="submit" name="submit" value="'.&mt('Ignore').' &rarr; " />');
1.492     albertel 6469: 	    $r->print(' '.&mt('this error').' <br />');
1.334     albertel 6470: 
1.492     albertel 6471: 	    $r->print(" <p>".&mt("Or click the 'Grading Menu' button to start over.")."</p>");
1.334     albertel 6472: 	} else {
1.503     raeburn  6473:             if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') {
1.539     riegler  6474: 	        $r->print('<input type="button" name="submitbutton" value="'.&mt('Continue').' &rarr;" onclick="javascript:verify_bubble_radio(this.form)" />');
1.503     raeburn  6475:             } else {
1.539     riegler  6476:                 $r->print('<input type="submit" name="submit" value="'.&mt('Continue').' &rarr;" />');
1.503     raeburn  6477:             }
1.492     albertel 6478: 	    $r->print(' '.&mt('using corrected info').' <br />');
                   6479: 	    $r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />");
                   6480: 	    $r->print(" ".&mt("this scanline saving it for later."));
1.334     albertel 6481: 	}
1.157     albertel 6482:     }
1.352     albertel 6483:     $r->print(" </form><br />".&show_grading_menu_form($symb));
1.157     albertel 6484:     return '';
                   6485: }
                   6486: 
1.423     albertel 6487: 
                   6488: =pod
                   6489: 
                   6490: =item scantron_remove_file
                   6491: 
1.424     albertel 6492:    Removes the requested bubble sheet data file, makes sure that
                   6493:    scantron_original_<filename> is never removed
                   6494: 
                   6495: 
1.423     albertel 6496: =cut
                   6497: 
1.200     albertel 6498: sub scantron_remove_file {
1.192     albertel 6499:     my ($which)=@_;
1.257     albertel 6500:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6501:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.192     albertel 6502:     my $file='scantron_';
1.200     albertel 6503:     if ($which eq 'corrected' || $which eq 'skipped') {
                   6504: 	$file.=$which.'_';
1.192     albertel 6505:     } else {
                   6506: 	return 'refused';
                   6507:     }
1.257     albertel 6508:     $file.=$env{'form.scantron_selectfile'};
1.200     albertel 6509:     return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
                   6510: }
                   6511: 
1.423     albertel 6512: 
                   6513: =pod
                   6514: 
                   6515: =item scantron_remove_scan_data
                   6516: 
1.424     albertel 6517:    Removes all scan_data correction for the requested bubble sheet
                   6518:    data file.  (In the case that both the are doing skipped records we need
                   6519:    to remember the old skipped lines for the time being so that element
                   6520:    persists for a while.)
                   6521: 
1.423     albertel 6522: =cut
                   6523: 
1.200     albertel 6524: sub scantron_remove_scan_data {
1.257     albertel 6525:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6526:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.192     albertel 6527:     my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname);
                   6528:     my @todelete;
1.257     albertel 6529:     my $filename=$env{'form.scantron_selectfile'};
1.192     albertel 6530:     foreach my $key (@keys) {
                   6531: 	if ($key=~/^\Q$filename\E_/) {
1.257     albertel 6532: 	    if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' &&
1.200     albertel 6533: 		$key=~/remember_skipping/) {
                   6534: 		next;
                   6535: 	    }
1.192     albertel 6536: 	    push(@todelete,$key);
                   6537: 	}
                   6538:     }
1.200     albertel 6539:     my $result;
1.192     albertel 6540:     if (@todelete) {
1.491     albertel 6541: 	$result = &Apache::lonnet::del('nohist_scantrondata',
                   6542: 				       \@todelete,$cdom,$cname);
                   6543:     } else {
                   6544: 	$result = 'ok';
1.192     albertel 6545:     }
                   6546:     return $result;
                   6547: }
                   6548: 
1.423     albertel 6549: 
                   6550: =pod
                   6551: 
                   6552: =item scantron_getfile
                   6553: 
1.424     albertel 6554:     Fetches the requested bubble sheet data file (all 3 versions), and
                   6555:     the scan_data hash
                   6556:   
                   6557:   Arguments:
                   6558:     None
                   6559: 
                   6560:   Returns:
                   6561:     2 hash references
                   6562: 
                   6563:      - first one has 
                   6564:          orig      -
                   6565:          corrected -
                   6566:          skipped   -  each of which points to an array ref of the specified
                   6567:                       file broken up into individual lines
                   6568:          count     - number of scanlines
                   6569:  
                   6570:      - second is the scan_data hash possible keys are
1.425     albertel 6571:        ($number refers to scanline numbered $number and thus the key affects
                   6572:         only that scanline
                   6573:         $bubline refers to the specific bubble line element and the aspects
                   6574:         refers to that specific bubble line element)
                   6575: 
                   6576:        $number.user - username:domain to use
                   6577:        $number.CODE_ignore_dup 
                   6578:                     - ignore the duplicate CODE error 
                   6579:        $number.useCODE
                   6580:                     - use the CODE in the scanline as is
                   6581:        $number.no_bubble.$bubline
                   6582:                     - it is valid that there is no bubbled in bubble
                   6583:                       at $number $bubline
                   6584:        remember_skipping
                   6585:                     - a frozen hash containing keys of $number and values
                   6586:                       of either 
                   6587:                         1 - we are on a 'do skipped records pass' and plan
                   6588:                             on processing this line
                   6589:                         2 - we are on a 'do skipped records pass' and this
                   6590:                             scanline has been marked to skip yet again
1.424     albertel 6591: 
1.423     albertel 6592: =cut
                   6593: 
1.157     albertel 6594: sub scantron_getfile {
1.200     albertel 6595:     #FIXME really would prefer a scantron directory
1.257     albertel 6596:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6597:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.157     albertel 6598:     my $lines;
                   6599:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6600: 		       'scantron_orig_'.$env{'form.scantron_selectfile'});
1.157     albertel 6601:     my %scanlines;
                   6602:     $scanlines{'orig'}=[(split("\n",$lines,-1))];
                   6603:     my $temp=$scanlines{'orig'};
                   6604:     $scanlines{'count'}=$#$temp;
                   6605: 
                   6606:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6607: 		       'scantron_corrected_'.$env{'form.scantron_selectfile'});
1.157     albertel 6608:     if ($lines eq '-1') {
                   6609: 	$scanlines{'corrected'}=[];
                   6610:     } else {
                   6611: 	$scanlines{'corrected'}=[(split("\n",$lines,-1))];
                   6612:     }
                   6613:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6614: 		       'scantron_skipped_'.$env{'form.scantron_selectfile'});
1.157     albertel 6615:     if ($lines eq '-1') {
                   6616: 	$scanlines{'skipped'}=[];
                   6617:     } else {
                   6618: 	$scanlines{'skipped'}=[(split("\n",$lines,-1))];
                   6619:     }
1.175     albertel 6620:     my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname);
1.157     albertel 6621:     if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
                   6622:     my %scan_data = @tmp;
                   6623:     return (\%scanlines,\%scan_data);
                   6624: }
                   6625: 
1.423     albertel 6626: =pod
                   6627: 
                   6628: =item lonnet_putfile
                   6629: 
1.424     albertel 6630:    Wrapper routine to call &Apache::lonnet::finishuserfileupload
                   6631: 
                   6632:  Arguments:
                   6633:    $contents - data to store
                   6634:    $filename - filename to store $contents into
                   6635: 
                   6636:  Returns:
                   6637:    result value from &Apache::lonnet::finishuserfileupload
                   6638: 
1.423     albertel 6639: =cut
                   6640: 
1.157     albertel 6641: sub lonnet_putfile {
                   6642:     my ($contents,$filename)=@_;
1.257     albertel 6643:     my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6644:     my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   6645:     $env{'form.sillywaytopassafilearound'}=$contents;
1.275     albertel 6646:     &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename);
1.157     albertel 6647: 
                   6648: }
                   6649: 
1.423     albertel 6650: =pod
                   6651: 
                   6652: =item scantron_putfile
                   6653: 
1.424     albertel 6654:     Stores the current version of the bubble sheet data files, and the
                   6655:     scan_data hash. (Does not modify the original version only the
                   6656:     corrected and skipped versions.
                   6657: 
                   6658:  Arguments:
                   6659:     $scanlines - hash ref that looks like the first return value from
                   6660:                  &scantron_getfile()
                   6661:     $scan_data - hash ref that looks like the second return value from
                   6662:                  &scantron_getfile()
                   6663: 
1.423     albertel 6664: =cut
                   6665: 
1.157     albertel 6666: sub scantron_putfile {
                   6667:     my ($scanlines,$scan_data) = @_;
1.200     albertel 6668:     #FIXME really would prefer a scantron directory
1.257     albertel 6669:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6670:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.200     albertel 6671:     if ($scanlines) {
                   6672: 	my $prefix='scantron_';
1.157     albertel 6673: # no need to update orig, shouldn't change
                   6674: #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
1.257     albertel 6675: #		    $env{'form.scantron_selectfile'});
1.200     albertel 6676: 	&lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
                   6677: 			$prefix.'corrected_'.
1.257     albertel 6678: 			$env{'form.scantron_selectfile'});
1.200     albertel 6679: 	&lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
                   6680: 			$prefix.'skipped_'.
1.257     albertel 6681: 			$env{'form.scantron_selectfile'});
1.200     albertel 6682:     }
1.175     albertel 6683:     &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
1.157     albertel 6684: }
                   6685: 
1.423     albertel 6686: =pod
                   6687: 
                   6688: =item scantron_get_line
                   6689: 
1.424     albertel 6690:    Returns the correct version of the scanline
                   6691: 
                   6692:  Arguments:
                   6693:     $scanlines - hash ref that looks like the first return value from
                   6694:                  &scantron_getfile()
                   6695:     $scan_data - hash ref that looks like the second return value from
                   6696:                  &scantron_getfile()
                   6697:     $i         - number of the requested line (starts at 0)
                   6698: 
                   6699:  Returns:
                   6700:    A scanline, (either the original or the corrected one if it
                   6701:    exists), or undef if the requested scanline should be
                   6702:    skipped. (Either because it's an skipped scanline, or it's an
                   6703:    unskipped scanline and we are not doing a 'do skipped scanlines'
                   6704:    pass.
                   6705: 
1.423     albertel 6706: =cut
                   6707: 
1.157     albertel 6708: sub scantron_get_line {
1.200     albertel 6709:     my ($scanlines,$scan_data,$i)=@_;
1.376     albertel 6710:     if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; }
                   6711:     #if ($scanlines->{'skipped'}[$i]) { return undef; }
1.157     albertel 6712:     if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
                   6713:     return $scanlines->{'orig'}[$i]; 
                   6714: }
                   6715: 
1.423     albertel 6716: =pod
                   6717: 
                   6718: =item scantron_todo_count
                   6719: 
1.424     albertel 6720:     Counts the number of scanlines that need processing.
                   6721: 
                   6722:  Arguments:
                   6723:     $scanlines - hash ref that looks like the first return value from
                   6724:                  &scantron_getfile()
                   6725:     $scan_data - hash ref that looks like the second return value from
                   6726:                  &scantron_getfile()
                   6727: 
                   6728:  Returns:
                   6729:     $count - number of scanlines to process
                   6730: 
1.423     albertel 6731: =cut
                   6732: 
1.200     albertel 6733: sub get_todo_count {
                   6734:     my ($scanlines,$scan_data)=@_;
                   6735:     my $count=0;
                   6736:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
                   6737: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
                   6738: 	if ($line=~/^[\s\cz]*$/) { next; }
                   6739: 	$count++;
                   6740:     }
                   6741:     return $count;
                   6742: }
                   6743: 
1.423     albertel 6744: =pod
                   6745: 
                   6746: =item scantron_put_line
                   6747: 
1.424     albertel 6748:     Updates the 'corrected' or 'skipped' versions of the bubble sheet
                   6749:     data file.
                   6750: 
                   6751:  Arguments:
                   6752:     $scanlines - hash ref that looks like the first return value from
                   6753:                  &scantron_getfile()
                   6754:     $scan_data - hash ref that looks like the second return value from
                   6755:                  &scantron_getfile()
                   6756:     $i         - line number to update
                   6757:     $newline   - contents of the updated scanline
                   6758:     $skip      - if true make the line for skipping and update the
                   6759:                  'skipped' file
                   6760: 
1.423     albertel 6761: =cut
                   6762: 
1.157     albertel 6763: sub scantron_put_line {
1.200     albertel 6764:     my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
1.157     albertel 6765:     if ($skip) {
                   6766: 	$scanlines->{'skipped'}[$i]=$newline;
1.376     albertel 6767: 	&start_skipping($scan_data,$i);
1.157     albertel 6768: 	return;
                   6769:     }
                   6770:     $scanlines->{'corrected'}[$i]=$newline;
                   6771: }
                   6772: 
1.423     albertel 6773: =pod
                   6774: 
                   6775: =item scantron_clear_skip
                   6776: 
1.424     albertel 6777:    Remove a line from the 'skipped' file
                   6778: 
                   6779:  Arguments:
                   6780:     $scanlines - hash ref that looks like the first return value from
                   6781:                  &scantron_getfile()
                   6782:     $scan_data - hash ref that looks like the second return value from
                   6783:                  &scantron_getfile()
                   6784:     $i         - line number to update
                   6785: 
1.423     albertel 6786: =cut
                   6787: 
1.376     albertel 6788: sub scantron_clear_skip {
                   6789:     my ($scanlines,$scan_data,$i)=@_;
                   6790:     if (exists($scanlines->{'skipped'}[$i])) {
                   6791: 	undef($scanlines->{'skipped'}[$i]);
                   6792: 	return 1;
                   6793:     }
                   6794:     return 0;
                   6795: }
                   6796: 
1.423     albertel 6797: =pod
                   6798: 
                   6799: =item scantron_filter_not_exam
                   6800: 
1.424     albertel 6801:    Filter routine used by &Apache::lonnavmaps::retrieveResources(), to
                   6802:    filter out resources that are not marked as 'exam' mode
                   6803: 
1.423     albertel 6804: =cut
                   6805: 
1.334     albertel 6806: sub scantron_filter_not_exam {
                   6807:     my ($curres)=@_;
                   6808:     
                   6809:     if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) {
                   6810: 	# if the user has asked to not have either hidden
                   6811: 	# or 'randomout' controlled resources to be graded
                   6812: 	# don't include them
                   6813: 	if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
                   6814: 	    && $curres->randomout) {
                   6815: 	    return 0;
                   6816: 	}
                   6817: 	return 1;
                   6818:     }
                   6819:     return 0;
                   6820: }
                   6821: 
1.423     albertel 6822: =pod
                   6823: 
                   6824: =item scantron_validate_sequence
                   6825: 
1.424     albertel 6826:     Validates the selected sequence, checking for resource that are
                   6827:     not set to exam mode.
                   6828: 
1.423     albertel 6829: =cut
                   6830: 
1.334     albertel 6831: sub scantron_validate_sequence {
                   6832:     my ($r,$currentphase) = @_;
                   6833: 
                   6834:     my $navmap=Apache::lonnavmaps::navmap->new();
1.582     raeburn  6835:     unless (ref($navmap)) {
                   6836:         $r->print(&navmap_errormsg());
                   6837:         return (1,$currentphase);
                   6838:     }
1.334     albertel 6839:     my (undef,undef,$sequence)=
                   6840: 	&Apache::lonnet::decode_symb($env{'form.selectpage'});
                   6841: 
                   6842:     my $map=$navmap->getResourceByUrl($sequence);
                   6843: 
                   6844:     $r->print('<input type="hidden" name="validate_sequence_exam"
                   6845:                                     value="ignore" />');
                   6846:     if ($env{'form.validate_sequence_exam'} ne 'ignore') {
                   6847: 	my @resources=
                   6848: 	    $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
                   6849: 	if (@resources) {
1.357     banghart 6850: 	    $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 6851: 	    return (1,$currentphase);
                   6852: 	}
                   6853:     }
                   6854: 
                   6855:     return (0,$currentphase+1);
                   6856: }
                   6857: 
1.423     albertel 6858: 
                   6859: 
1.157     albertel 6860: sub scantron_validate_ID {
                   6861:     my ($r,$currentphase) = @_;
                   6862:     
                   6863:     #get student info
                   6864:     my $classlist=&Apache::loncoursedata::get_classlist();
                   6865:     my %idmap=&username_to_idmap($classlist);
                   6866: 
                   6867:     #get scantron line setup
1.257     albertel 6868:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 6869:     my ($scanlines,$scan_data)=&scantron_getfile();
1.582     raeburn  6870: 
                   6871:     my $nav_error;
                   6872:     &scantron_get_maxbubble(\$nav_error); # parse needs the bubble_lines.. array.
                   6873:     if ($nav_error) {
                   6874:         $r->print(&navmap_errormsg());
                   6875:         return(1,$currentphase);
                   6876:     }
1.157     albertel 6877: 
                   6878:     my %found=('ids'=>{},'usernames'=>{});
                   6879:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 6880: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 6881: 	if ($line=~/^[\s\cz]*$/) { next; }
                   6882: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   6883: 						 $scan_data);
                   6884: 	my $id=$$scan_record{'scantron.ID'};
                   6885: 	my $found;
                   6886: 	foreach my $checkid (keys(%idmap)) {
                   6887: 	    if (lc($checkid) eq lc($id)) { $found=$checkid;last; }
                   6888: 	}
                   6889: 	if ($found) {
                   6890: 	    my $username=$idmap{$found};
                   6891: 	    if ($found{'ids'}{$found}) {
                   6892: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6893: 					 $line,'duplicateID',$found);
1.194     albertel 6894: 		return(1,$currentphase);
1.157     albertel 6895: 	    } elsif ($found{'usernames'}{$username}) {
                   6896: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6897: 					 $line,'duplicateID',$username);
1.194     albertel 6898: 		return(1,$currentphase);
1.157     albertel 6899: 	    }
1.186     albertel 6900: 	    #FIXME store away line we previously saw the ID on to use above
1.157     albertel 6901: 	    $found{'ids'}{$found}++;
                   6902: 	    $found{'usernames'}{$username}++;
                   6903: 	} else {
                   6904: 	    if ($id =~ /^\s*$/) {
1.158     albertel 6905: 		my $username=&scan_data($scan_data,"$i.user");
1.157     albertel 6906: 		if (defined($username) && $found{'usernames'}{$username}) {
                   6907: 		    &scantron_get_correction($r,$i,$scan_record,
                   6908: 					     \%scantron_config,
                   6909: 					     $line,'duplicateID',$username);
1.194     albertel 6910: 		    return(1,$currentphase);
1.157     albertel 6911: 		} elsif (!defined($username)) {
                   6912: 		    &scantron_get_correction($r,$i,$scan_record,
                   6913: 					     \%scantron_config,
                   6914: 					     $line,'incorrectID');
1.194     albertel 6915: 		    return(1,$currentphase);
1.157     albertel 6916: 		}
                   6917: 		$found{'usernames'}{$username}++;
                   6918: 	    } else {
                   6919: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6920: 					 $line,'incorrectID');
1.194     albertel 6921: 		return(1,$currentphase);
1.157     albertel 6922: 	    }
                   6923: 	}
                   6924:     }
                   6925: 
                   6926:     return (0,$currentphase+1);
                   6927: }
                   6928: 
1.423     albertel 6929: 
1.157     albertel 6930: sub scantron_get_correction {
                   6931:     my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;
1.454     banghart 6932: #FIXME in the case of a duplicated ID the previous line, probably need
1.157     albertel 6933: #to show both the current line and the previous one and allow skipping
                   6934: #the previous one or the current one
                   6935: 
1.333     albertel 6936:     if ( $$scan_record{'scantron.PaperID'} =~ /\S/) {
1.492     albertel 6937: 	$r->print("<p>".&mt("<b>An error was detected ($error)</b>".
                   6938: 			    " for PaperID <tt>[_1]</tt>",
                   6939: 			    $$scan_record{'scantron.PaperID'})."</p> \n");
1.157     albertel 6940:     } else {
1.492     albertel 6941: 	$r->print("<p>".&mt("<b>An error was detected ($error)</b>".
                   6942: 			    " in scanline [_1] <pre>[_2]</pre>",
                   6943: 			    $i,$line)."</p> \n");
                   6944:     }
                   6945:     my $message="<p>".&mt("The ID on the form is  <tt>[_1]</tt><br />".
                   6946: 			  "The name on the paper is [_2],[_3]",
                   6947: 			  $$scan_record{'scantron.ID'},
                   6948: 			  $$scan_record{'scantron.LastName'},
                   6949: 			  $$scan_record{'scantron.FirstName'})."</p>";
1.242     albertel 6950: 
1.157     albertel 6951:     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
                   6952:     $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
1.503     raeburn  6953:                            # Array populated for doublebubble or
                   6954:     my @lines_to_correct;  # missingbubble errors to build javascript
                   6955:                            # to validate radio button checking   
                   6956: 
1.157     albertel 6957:     if ($error =~ /ID$/) {
1.186     albertel 6958: 	if ($error eq 'incorrectID') {
1.492     albertel 6959: 	    $r->print("<p>".&mt("The encoded ID is not in the classlist").
                   6960: 		      "</p>\n");
1.157     albertel 6961: 	} elsif ($error eq 'duplicateID') {
1.492     albertel 6962: 	    $r->print("<p>".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n");
1.157     albertel 6963: 	}
1.242     albertel 6964: 	$r->print($message);
1.492     albertel 6965: 	$r->print("<p>".&mt("How should I handle this?")." <br /> \n");
1.157     albertel 6966: 	$r->print("\n<ul><li> ");
                   6967: 	#FIXME it would be nice if this sent back the user ID and
                   6968: 	#could do partial userID matches
                   6969: 	$r->print(&Apache::loncommon::selectstudent_link('scantronupload',
                   6970: 				       'scantron_username','scantron_domain'));
                   6971: 	$r->print(": <input type='text' name='scantron_username' value='' />");
                   6972: 	$r->print("\n@".
1.257     albertel 6973: 		 &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));
1.157     albertel 6974: 
                   6975: 	$r->print('</li>');
1.186     albertel 6976:     } elsif ($error =~ /CODE$/) {
                   6977: 	if ($error eq 'incorrectCODE') {
1.492     albertel 6978: 	    $r->print("<p>".&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n");
1.186     albertel 6979: 	} elsif ($error eq 'duplicateCODE') {
1.492     albertel 6980: 	    $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 6981: 	}
1.492     albertel 6982: 	$r->print("<p>".&mt("The CODE on the form is  <tt>'[_1]'</tt>",
                   6983: 			    $$scan_record{'scantron.CODE'})."<br />\n");
1.242     albertel 6984: 	$r->print($message);
1.492     albertel 6985: 	$r->print("<p>".&mt("How should I handle this?")." <br /> \n");
1.187     albertel 6986: 	$r->print("\n<br /> ");
1.194     albertel 6987: 	my $i=0;
1.273     albertel 6988: 	if ($error eq 'incorrectCODE' 
                   6989: 	    && $$scan_record{'scantron.CODE'}=~/\S/ ) {
1.194     albertel 6990: 	    my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'});
1.278     albertel 6991: 	    if ($closest > 0) {
                   6992: 		foreach my $testcode (@{$closest}) {
                   6993: 		    my $checked='';
1.569     bisitz   6994: 		    if (!$i) { $checked=' checked="checked"'; }
1.492     albertel 6995: 		    $r->print("
                   6996:    <label>
1.569     bisitz   6997:        <input type='radio' name='scantron_CODE_resolution' value='use_closest_$i'$checked />
1.492     albertel 6998:        ".&mt("Use the similar CODE [_1] instead.",
                   6999: 	    "<b><tt>".$testcode."</tt></b>")."
                   7000:     </label>
                   7001:     <input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />");
1.278     albertel 7002: 		    $r->print("\n<br />");
                   7003: 		    $i++;
                   7004: 		}
1.194     albertel 7005: 	    }
                   7006: 	}
1.273     albertel 7007: 	if ($$scan_record{'scantron.CODE'}=~/\S/ ) {
1.569     bisitz   7008: 	    my $checked; if (!$i) { $checked=' checked="checked"'; }
1.492     albertel 7009: 	    $r->print("
                   7010:     <label>
1.569     bisitz   7011:         <input type='radio' name='scantron_CODE_resolution' value='use_unfound'$checked />
1.492     albertel 7012:        ".&mt("Use the CODE [_1] that is was on the paper, ignoring the error.",
                   7013: 	     "<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")."
                   7014:     </label>");
1.273     albertel 7015: 	    $r->print("\n<br />");
                   7016: 	}
1.194     albertel 7017: 
1.188     albertel 7018: 	$r->print(<<ENDSCRIPT);
                   7019: <script type="text/javascript">
                   7020: function change_radio(field) {
1.190     albertel 7021:     var slct=document.scantronupload.scantron_CODE_resolution;
1.188     albertel 7022:     var i;
                   7023:     for (i=0;i<slct.length;i++) {
                   7024:         if (slct[i].value==field) { slct[i].checked=true; }
                   7025:     }
                   7026: }
                   7027: </script>
                   7028: ENDSCRIPT
1.187     albertel 7029: 	my $href="/adm/pickcode?".
1.359     www      7030: 	   "form=".&escape("scantronupload").
                   7031: 	   "&scantron_format=".&escape($env{'form.scantron_format'}).
                   7032: 	   "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}).
                   7033: 	   "&curCODE=".&escape($$scan_record{'scantron.CODE'}).
                   7034: 	   "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'});
1.332     albertel 7035: 	if ($env{'form.scantron_CODElist'} =~ /\S/) { 
1.492     albertel 7036: 	    $r->print("
                   7037:     <label>
                   7038:        <input type='radio' name='scantron_CODE_resolution' value='use_found' />
                   7039:        ".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.",
                   7040: 	     "<a target='_blank' href='$href'>","</a>")."
                   7041:     </label> 
1.558     bisitz   7042:     ".&mt("Selected CODE is [_1]",'<input readonly="readonly" type="text" size="8" name="scantron_CODE_selectedvalue" onfocus="javascript:change_radio(\'use_found\')" onchange="javascript:change_radio(\'use_found\')" />'));
1.332     albertel 7043: 	    $r->print("\n<br />");
                   7044: 	}
1.492     albertel 7045: 	$r->print("
                   7046:     <label>
                   7047:        <input type='radio' name='scantron_CODE_resolution' value='use_typed' />
                   7048:        ".&mt("Use [_1] as the CODE.",
                   7049: 	     "</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 7050: 	$r->print("\n<br /><br />");
1.157     albertel 7051:     } elsif ($error eq 'doublebubble') {
1.503     raeburn  7052: 	$r->print("<p>".&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n");
1.497     foxr     7053: 
                   7054: 	# The form field scantron_questions is acutally a list of line numbers.
                   7055: 	# represented by this form so:
                   7056: 
                   7057: 	my $line_list = &questions_to_line_list($arg);
                   7058: 
1.157     albertel 7059: 	$r->print('<input type="hidden" name="scantron_questions" value="'.
1.497     foxr     7060: 		  $line_list.'" />');
1.242     albertel 7061: 	$r->print($message);
1.492     albertel 7062: 	$r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>");
1.157     albertel 7063: 	foreach my $question (@{$arg}) {
1.503     raeburn  7064: 	    my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                   7065:                                                    $scan_record, $error);
1.524     raeburn  7066:             push(@lines_to_correct,@linenums);
1.157     albertel 7067: 	}
1.503     raeburn  7068:         $r->print(&verify_bubbles_checked(@lines_to_correct));
1.157     albertel 7069:     } elsif ($error eq 'missingbubble') {
1.492     albertel 7070: 	$r->print("<p>".&mt("There have been <b>no</b> bubbles scanned for some question(s)")."</p>\n");
1.242     albertel 7071: 	$r->print($message);
1.492     albertel 7072: 	$r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>");
1.503     raeburn  7073: 	$r->print(&mt("Some questions have no scanned bubbles.")."\n");
1.497     foxr     7074: 
1.503     raeburn  7075: 	# The form field scantron_questions is actually a list of line numbers not
1.497     foxr     7076: 	# a list of question numbers. Therefore:
                   7077: 	#
                   7078: 	
                   7079: 	my $line_list = &questions_to_line_list($arg);
                   7080: 
1.157     albertel 7081: 	$r->print('<input type="hidden" name="scantron_questions" value="'.
1.497     foxr     7082: 		  $line_list.'" />');
1.157     albertel 7083: 	foreach my $question (@{$arg}) {
1.503     raeburn  7084: 	    my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                   7085:                                                    $scan_record, $error);
1.524     raeburn  7086:             push(@lines_to_correct,@linenums);
1.157     albertel 7087: 	}
1.503     raeburn  7088:         $r->print(&verify_bubbles_checked(@lines_to_correct));
1.157     albertel 7089:     } else {
                   7090: 	$r->print("\n<ul>");
                   7091:     }
                   7092:     $r->print("\n</li></ul>");
1.497     foxr     7093: }
                   7094: 
1.503     raeburn  7095: sub verify_bubbles_checked {
                   7096:     my (@ansnums) = @_;
                   7097:     my $ansnumstr = join('","',@ansnums);
                   7098:     my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines.");
                   7099:     my $output = (<<ENDSCRIPT);
                   7100: <script type="text/javascript">
                   7101: function verify_bubble_radio(form) {
                   7102:     var ansnumArray = new Array ("$ansnumstr");
                   7103:     var need_bubble_count = 0;
                   7104:     for (var i=0; i<ansnumArray.length; i++) {
                   7105:         if (form.elements["scantron_correct_Q_"+ansnumArray[i]].length > 1) {
                   7106:             var bubble_picked = 0; 
                   7107:             for (var j=0; j<form.elements["scantron_correct_Q_"+ansnumArray[i]].length; j++) {
                   7108:                 if (form.elements["scantron_correct_Q_"+ansnumArray[i]][j].checked == true) {
                   7109:                     bubble_picked = 1;
                   7110:                 }
                   7111:             }
                   7112:             if (bubble_picked == 0) {
                   7113:                 need_bubble_count ++;
                   7114:             }
                   7115:         }
                   7116:     }
                   7117:     if (need_bubble_count) {
                   7118:         alert("$warning");
                   7119:         return;
                   7120:     }
                   7121:     form.submit(); 
                   7122: }
                   7123: </script>
                   7124: ENDSCRIPT
                   7125:     return $output;
                   7126: }
                   7127: 
1.497     foxr     7128: =pod
                   7129: 
                   7130: =item  questions_to_line_list
1.157     albertel 7131: 
1.497     foxr     7132: Converts a list of questions into a string of comma separated
                   7133: line numbers in the answer sheet used by the questions.  This is
                   7134: used to fill in the scantron_questions form field.
                   7135: 
                   7136:   Arguments:
                   7137:      questions    - Reference to an array of questions.
                   7138: 
                   7139: =cut
                   7140: 
                   7141: 
                   7142: sub questions_to_line_list {
                   7143:     my ($questions) = @_;
                   7144:     my @lines;
                   7145: 
1.503     raeburn  7146:     foreach my $item (@{$questions}) {
                   7147:         my $question = $item;
                   7148:         my ($first,$count,$last);
                   7149:         if ($item =~ /^(\d+)\.(\d+)$/) {
                   7150:             $question = $1;
                   7151:             my $subquestion = $2;
                   7152:             $first = $first_bubble_line{$question-1} + 1;
                   7153:             my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   7154:             my $subcount = 1;
                   7155:             while ($subcount<$subquestion) {
                   7156:                 $first += $subans[$subcount-1];
                   7157:                 $subcount ++;
                   7158:             }
                   7159:             $count = $subans[$subquestion-1];
                   7160:         } else {
                   7161: 	    $first   = $first_bubble_line{$question-1} + 1;
                   7162: 	    $count   = $bubble_lines_per_response{$question-1};
                   7163:         }
1.506     raeburn  7164:         $last = $first+$count-1;
1.503     raeburn  7165:         push(@lines, ($first..$last));
1.497     foxr     7166:     }
                   7167:     return join(',', @lines);
                   7168: }
                   7169: 
                   7170: =pod 
                   7171: 
                   7172: =item prompt_for_corrections
                   7173: 
                   7174: Prompts for a potentially multiline correction to the
                   7175: user's bubbling (factors out common code from scantron_get_correction
                   7176: for multi and missing bubble cases).
                   7177: 
                   7178:  Arguments:
                   7179:    $r           - Apache request object.
                   7180:    $question    - The question number to prompt for.
                   7181:    $scan_config - The scantron file configuration hash.
                   7182:    $scan_record - Reference to the hash that has the the parsed scanlines.
1.503     raeburn  7183:    $error       - Type of error
1.497     foxr     7184: 
                   7185:  Implicit inputs:
                   7186:    %bubble_lines_per_response   - Starting line numbers for each question.
                   7187:                                   Numbered from 0 (but question numbers are from
                   7188:                                   1.
                   7189:    %first_bubble_line           - Starting bubble line for each question.
1.509     raeburn  7190:    %subdivided_bubble_lines     - optionresponse, matchresponse and rankresponse 
                   7191:                                   type problems render as separate sub-questions, 
1.503     raeburn  7192:                                   in exam mode. This hash contains a 
                   7193:                                   comma-separated list of the lines per 
                   7194:                                   sub-question.
1.510     raeburn  7195:    %responsetype_per_response   - essayresponse, formularesponse,
                   7196:                                   stringresponse, imageresponse, reactionresponse,
                   7197:                                   and organicresponse type problem parts can have
1.503     raeburn  7198:                                   multiple lines per response if the weight
                   7199:                                   assigned exceeds 10.  In this case, only
                   7200:                                   one bubble per line is permitted, but more 
                   7201:                                   than one line might contain bubbles, e.g.
                   7202:                                   bubbling of: line 1 - J, line 2 - J, 
                   7203:                                   line 3 - B would assign 22 points.  
1.497     foxr     7204: 
                   7205: =cut
                   7206: 
                   7207: sub prompt_for_corrections {
1.503     raeburn  7208:     my ($r, $question, $scan_config, $scan_record, $error) = @_;
                   7209:     my ($current_line,$lines);
                   7210:     my @linenums;
                   7211:     my $questionnum = $question;
                   7212:     if ($question =~ /^(\d+)\.(\d+)$/) {
                   7213:         $question = $1;
                   7214:         $current_line = $first_bubble_line{$question-1} + 1 ;
                   7215:         my $subquestion = $2;
                   7216:         my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   7217:         my $subcount = 1;
                   7218:         while ($subcount<$subquestion) {
                   7219:             $current_line += $subans[$subcount-1];
                   7220:             $subcount ++;
                   7221:         }
                   7222:         $lines = $subans[$subquestion-1];
                   7223:     } else {
                   7224:         $current_line = $first_bubble_line{$question-1} + 1 ;
                   7225:         $lines        = $bubble_lines_per_response{$question-1};
                   7226:     }
1.497     foxr     7227:     if ($lines > 1) {
1.503     raeburn  7228:         $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />');
                   7229:         if (($responsetype_per_response{$question-1} eq 'essayresponse') ||
                   7230:             ($responsetype_per_response{$question-1} eq 'formularesponse') ||
1.510     raeburn  7231:             ($responsetype_per_response{$question-1} eq 'stringresponse') ||
                   7232:             ($responsetype_per_response{$question-1} eq 'imageresponse') ||
                   7233:             ($responsetype_per_response{$question-1} eq 'reactionresponse') ||
                   7234:             ($responsetype_per_response{$question-1} eq 'organicresponse')) {
1.572     www      7235:             $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.').'<br />'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'<br />'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'<br /><br />');
1.503     raeburn  7236:         } else {
                   7237:             $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />");
                   7238:         }
1.497     foxr     7239:     }
                   7240:     for (my $i =0; $i < $lines; $i++) {
1.503     raeburn  7241:         my $selected = $$scan_record{"scantron.$current_line.answer"};
                   7242: 	&scantron_bubble_selector($r,$scan_config,$current_line, 
                   7243: 	        		  $questionnum,$error,split('', $selected));
1.524     raeburn  7244:         push(@linenums,$current_line);
1.497     foxr     7245: 	$current_line++;
                   7246:     }
                   7247:     if ($lines > 1) {
                   7248: 	$r->print("<hr /><br />");
                   7249:     }
1.503     raeburn  7250:     return @linenums;
1.157     albertel 7251: }
1.423     albertel 7252: 
                   7253: =pod
                   7254: 
                   7255: =item scantron_bubble_selector
                   7256:   
                   7257:    Generates the html radiobuttons to correct a single bubble line
1.424     albertel 7258:    possibly showing the existing the selected bubbles if known
1.423     albertel 7259: 
                   7260:  Arguments:
                   7261:     $r           - Apache request object
                   7262:     $scan_config - hash from &get_scantron_config()
1.497     foxr     7263:     $line        - Number of the line being displayed.
1.503     raeburn  7264:     $questionnum - Question number (may include subquestion)
                   7265:     $error       - Type of error.
1.497     foxr     7266:     @selected    - Array of bubbles picked on this line.
1.423     albertel 7267: 
                   7268: =cut
                   7269: 
1.157     albertel 7270: sub scantron_bubble_selector {
1.503     raeburn  7271:     my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_;
1.157     albertel 7272:     my $max=$$scan_config{'Qlength'};
1.274     albertel 7273: 
                   7274:     my $scmode=$$scan_config{'Qon'};
                   7275:     if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }	     
                   7276: 
1.157     albertel 7277:     my @alphabet=('A'..'Z');
1.503     raeburn  7278:     $r->print(&Apache::loncommon::start_data_table().
                   7279:               &Apache::loncommon::start_data_table_row());
                   7280:     $r->print('<td rowspan="2" class="LC_leftcol_header">'.$line.'</td>');
1.497     foxr     7281:     for (my $i=0;$i<$max+1;$i++) {
                   7282: 	$r->print("\n".'<td align="center">');
                   7283: 	if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
                   7284: 	else { $r->print('&nbsp;'); }
                   7285: 	$r->print('</td>');
                   7286:     }
1.503     raeburn  7287:     $r->print(&Apache::loncommon::end_data_table_row().
                   7288:               &Apache::loncommon::start_data_table_row());
1.497     foxr     7289:     for (my $i=0;$i<$max;$i++) {
                   7290: 	$r->print("\n".
                   7291: 		  '<td><label><input type="radio" name="scantron_correct_Q_'.
                   7292: 		  $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
                   7293:     }
1.503     raeburn  7294:     my $nobub_checked = ' ';
                   7295:     if ($error eq 'missingbubble') {
                   7296:         $nobub_checked = ' checked = "checked" ';
                   7297:     }
                   7298:     $r->print("\n".'<td><label><input type="radio" name="scantron_correct_Q_'.
                   7299: 	      $line.'" value="none"'.$nobub_checked.'/>'.&mt('No bubble').
                   7300:               '</label>'."\n".'<input type="hidden" name="scantron_questionnum_Q_'.
                   7301:               $line.'" value="'.$questionnum.'" /></td>');
                   7302:     $r->print(&Apache::loncommon::end_data_table_row().
                   7303:               &Apache::loncommon::end_data_table());
1.157     albertel 7304: }
                   7305: 
1.423     albertel 7306: =pod
                   7307: 
                   7308: =item num_matches
                   7309: 
1.424     albertel 7310:    Counts the number of characters that are the same between the two arguments.
                   7311: 
                   7312:  Arguments:
                   7313:    $orig - CODE from the scanline
                   7314:    $code - CODE to match against
                   7315: 
                   7316:  Returns:
                   7317:    $count - integer count of the number of same characters between the
                   7318:             two arguments
                   7319: 
1.423     albertel 7320: =cut
                   7321: 
1.194     albertel 7322: sub num_matches {
                   7323:     my ($orig,$code) = @_;
                   7324:     my @code=split(//,$code);
                   7325:     my @orig=split(//,$orig);
                   7326:     my $same=0;
                   7327:     for (my $i=0;$i<scalar(@code);$i++) {
                   7328: 	if ($code[$i] eq $orig[$i]) { $same++; }
                   7329:     }
                   7330:     return $same;
                   7331: }
                   7332: 
1.423     albertel 7333: =pod
                   7334: 
                   7335: =item scantron_get_closely_matching_CODEs
                   7336: 
1.424     albertel 7337:    Cycles through all CODEs and finds the set that has the greatest
                   7338:    number of same characters as the provided CODE
                   7339: 
                   7340:  Arguments:
                   7341:    $allcodes - hash ref returned by &get_codes()
                   7342:    $CODE     - CODE from the current scanline
                   7343: 
                   7344:  Returns:
                   7345:    2 element list
                   7346:     - first elements is number of how closely matching the best fit is 
                   7347:       (5 means best set has 5 matching characters)
                   7348:     - second element is an arrary ref containing the set of valid CODEs
                   7349:       that best fit the passed in CODE
                   7350: 
1.423     albertel 7351: =cut
                   7352: 
1.194     albertel 7353: sub scantron_get_closely_matching_CODEs {
                   7354:     my ($allcodes,$CODE)=@_;
                   7355:     my @CODEs;
                   7356:     foreach my $testcode (sort(keys(%{$allcodes}))) {
                   7357: 	push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode);
                   7358:     }
                   7359: 
                   7360:     return ($#CODEs,$CODEs[-1]);
                   7361: }
                   7362: 
1.423     albertel 7363: =pod
                   7364: 
                   7365: =item get_codes
                   7366: 
1.424     albertel 7367:    Builds a hash which has keys of all of the valid CODEs from the selected
                   7368:    set of remembered CODEs.
                   7369: 
                   7370:  Arguments:
                   7371:   $old_name - name of the set of remembered CODEs
                   7372:   $cdom     - domain of the course
                   7373:   $cnum     - internal course name
                   7374: 
                   7375:  Returns:
                   7376:   %allcodes - keys are the valid CODEs, values are all 1
                   7377: 
1.423     albertel 7378: =cut
                   7379: 
1.194     albertel 7380: sub get_codes {
1.280     foxr     7381:     my ($old_name, $cdom, $cnum) = @_;
                   7382:     if (!$old_name) {
                   7383: 	$old_name=$env{'form.scantron_CODElist'};
                   7384:     }
                   7385:     if (!$cdom) {
                   7386: 	$cdom =$env{'course.'.$env{'request.course.id'}.'.domain'};
                   7387:     }
                   7388:     if (!$cnum) {
                   7389: 	$cnum =$env{'course.'.$env{'request.course.id'}.'.num'};
                   7390:     }
1.278     albertel 7391:     my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"],
                   7392: 				    $cdom,$cnum);
                   7393:     my %allcodes;
                   7394:     if ($result{"type\0$old_name"} eq 'number') {
                   7395: 	%allcodes=map {($_,1)} split(',',$result{$old_name});
                   7396:     } else {
                   7397: 	%allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name});
                   7398:     }
1.194     albertel 7399:     return %allcodes;
                   7400: }
                   7401: 
1.423     albertel 7402: =pod
                   7403: 
                   7404: =item scantron_validate_CODE
                   7405: 
1.424     albertel 7406:    Validates all scanlines in the selected file to not have any
                   7407:    invalid or underspecified CODEs and that none of the codes are
                   7408:    duplicated if this was requested.
                   7409: 
1.423     albertel 7410: =cut
                   7411: 
1.157     albertel 7412: sub scantron_validate_CODE {
                   7413:     my ($r,$currentphase) = @_;
1.257     albertel 7414:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.186     albertel 7415:     if ($scantron_config{'CODElocation'} &&
                   7416: 	$scantron_config{'CODEstart'} &&
                   7417: 	$scantron_config{'CODElength'}) {
1.257     albertel 7418: 	if (!defined($env{'form.scantron_CODElist'})) {
1.186     albertel 7419: 	    &FIXME_blow_up()
                   7420: 	}
                   7421:     } else {
                   7422: 	return (0,$currentphase+1);
                   7423:     }
                   7424:     
                   7425:     my %usedCODEs;
                   7426: 
1.194     albertel 7427:     my %allcodes=&get_codes();
1.186     albertel 7428: 
1.582     raeburn  7429:     my $nav_error;
                   7430:     &scantron_get_maxbubble(\$nav_error); # parse needs the lines per response array.
                   7431:     if ($nav_error) {
                   7432:         $r->print(&navmap_errormsg());
                   7433:         return(1,$currentphase);
                   7434:     }
1.447     foxr     7435: 
1.186     albertel 7436:     my ($scanlines,$scan_data)=&scantron_getfile();
                   7437:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7438: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.186     albertel 7439: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7440: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7441: 						 $scan_data);
                   7442: 	my $CODE=$$scan_record{'scantron.CODE'};
                   7443: 	my $error=0;
1.224     albertel 7444: 	if (!&Apache::lonnet::validCODE($CODE)) {
                   7445: 	    &scantron_get_correction($r,$i,$scan_record,
                   7446: 				     \%scantron_config,
                   7447: 				     $line,'incorrectCODE',\%allcodes);
                   7448: 	    return(1,$currentphase);
                   7449: 	}
1.221     albertel 7450: 	if (%allcodes && !exists($allcodes{$CODE}) 
                   7451: 	    && !$$scan_record{'scantron.useCODE'}) {
1.186     albertel 7452: 	    &scantron_get_correction($r,$i,$scan_record,
                   7453: 				     \%scantron_config,
1.194     albertel 7454: 				     $line,'incorrectCODE',\%allcodes);
                   7455: 	    return(1,$currentphase);
1.186     albertel 7456: 	}
1.214     albertel 7457: 	if (exists($usedCODEs{$CODE}) 
1.257     albertel 7458: 	    && $env{'form.scantron_CODEunique'} eq 'yes'
1.192     albertel 7459: 	    && !$$scan_record{'scantron.CODE_ignore_dup'}) {
1.186     albertel 7460: 	    &scantron_get_correction($r,$i,$scan_record,
                   7461: 				     \%scantron_config,
1.194     albertel 7462: 				     $line,'duplicateCODE',$usedCODEs{$CODE});
                   7463: 	    return(1,$currentphase);
1.186     albertel 7464: 	}
1.524     raeburn  7465: 	push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
1.186     albertel 7466:     }
1.157     albertel 7467:     return (0,$currentphase+1);
                   7468: }
                   7469: 
1.423     albertel 7470: =pod
                   7471: 
                   7472: =item scantron_validate_doublebubble
                   7473: 
1.424     albertel 7474:    Validates all scanlines in the selected file to not have any
                   7475:    bubble lines with multiple bubbles marked.
                   7476: 
1.423     albertel 7477: =cut
                   7478: 
1.157     albertel 7479: sub scantron_validate_doublebubble {
                   7480:     my ($r,$currentphase) = @_;
                   7481:     #get student info
                   7482:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7483:     my %idmap=&username_to_idmap($classlist);
                   7484: 
                   7485:     #get scantron line setup
1.257     albertel 7486:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7487:     my ($scanlines,$scan_data)=&scantron_getfile();
1.583     raeburn  7488:     my $nav_error;
                   7489:     &scantron_get_maxbubble(\$nav_error); # parse needs the bubble line array.
                   7490:     if ($nav_error) {
                   7491:         $r->print(&navmap_errormsg());
                   7492:         return(1,$currentphase);
                   7493:     }
1.447     foxr     7494: 
1.157     albertel 7495:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7496: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7497: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7498: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7499: 						 $scan_data);
                   7500: 	if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
                   7501: 	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,
                   7502: 				 'doublebubble',
                   7503: 				 $$scan_record{'scantron.doubleerror'});
                   7504:     	return (1,$currentphase);
                   7505:     }
                   7506:     return (0,$currentphase+1);
                   7507: }
                   7508: 
1.423     albertel 7509: 
1.503     raeburn  7510: sub scantron_get_maxbubble {
1.582     raeburn  7511:     my ($nav_error) = @_;
1.257     albertel 7512:     if (defined($env{'form.scantron_maxbubble'}) &&
                   7513: 	$env{'form.scantron_maxbubble'}) {
1.447     foxr     7514: 	&restore_bubble_lines();
1.257     albertel 7515: 	return $env{'form.scantron_maxbubble'};
1.191     albertel 7516:     }
1.330     albertel 7517: 
1.447     foxr     7518:     my (undef, undef, $sequence) =
1.257     albertel 7519: 	&Apache::lonnet::decode_symb($env{'form.selectpage'});
1.330     albertel 7520: 
1.447     foxr     7521:     my $navmap=Apache::lonnavmaps::navmap->new();
1.582     raeburn  7522:     unless (ref($navmap)) {
                   7523:         if (ref($nav_error)) {
                   7524:             $$nav_error = 1;
                   7525:         }
1.591     raeburn  7526:         return;
1.582     raeburn  7527:     }
1.191     albertel 7528:     my $map=$navmap->getResourceByUrl($sequence);
                   7529:     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
1.330     albertel 7530: 
                   7531:     &Apache::lonxml::clear_problem_counter();
                   7532: 
1.557     raeburn  7533:     my $uname       = $env{'user.name'};
                   7534:     my $udom        = $env{'user.domain'};
1.435     foxr     7535:     my $cid         = $env{'request.course.id'};
                   7536:     my $total_lines = 0;
                   7537:     %bubble_lines_per_response = ();
1.447     foxr     7538:     %first_bubble_line         = ();
1.503     raeburn  7539:     %subdivided_bubble_lines   = ();
                   7540:     %responsetype_per_response = ();
1.554     raeburn  7541: 
1.447     foxr     7542:     my $response_number = 0;
                   7543:     my $bubble_line     = 0;
1.191     albertel 7544:     foreach my $resource (@resources) {
1.542     raeburn  7545:         my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom);
                   7546:         if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
                   7547: 	    foreach my $part_id (@{$parts}) {
                   7548:                 my $lines;
                   7549: 
                   7550: 	        # TODO - make this a persistent hash not an array.
                   7551: 
                   7552:                 # optionresponse, matchresponse and rankresponse type items 
                   7553:                 # render as separate sub-questions in exam mode.
                   7554:                 if (($analysis->{$part_id.'.type'} eq 'optionresponse') ||
                   7555:                     ($analysis->{$part_id.'.type'} eq 'matchresponse') ||
                   7556:                     ($analysis->{$part_id.'.type'} eq 'rankresponse')) {
                   7557:                     my ($numbub,$numshown);
                   7558:                     if ($analysis->{$part_id.'.type'} eq 'optionresponse') {
                   7559:                         if (ref($analysis->{$part_id.'.options'}) eq 'ARRAY') {
                   7560:                             $numbub = scalar(@{$analysis->{$part_id.'.options'}});
                   7561:                         }
                   7562:                     } elsif ($analysis->{$part_id.'.type'} eq 'matchresponse') {
                   7563:                         if (ref($analysis->{$part_id.'.items'}) eq 'ARRAY') {
                   7564:                             $numbub = scalar(@{$analysis->{$part_id.'.items'}});
                   7565:                         }
                   7566:                     } elsif ($analysis->{$part_id.'.type'} eq 'rankresponse') {
                   7567:                         if (ref($analysis->{$part_id.'.foils'}) eq 'ARRAY') {
                   7568:                             $numbub = scalar(@{$analysis->{$part_id.'.foils'}});
                   7569:                         }
                   7570:                     }
                   7571:                     if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') {
                   7572:                         $numshown = scalar(@{$analysis->{$part_id.'.shown'}});
                   7573:                     }
                   7574:                     my $bubbles_per_line = 10;
                   7575:                     my $inner_bubble_lines = int($numbub/$bubbles_per_line);
                   7576:                     if (($numbub % $bubbles_per_line) != 0) {
                   7577:                         $inner_bubble_lines++;
                   7578:                     }
                   7579:                     for (my $i=0; $i<$numshown; $i++) {
                   7580:                         $subdivided_bubble_lines{$response_number} .= 
                   7581:                             $inner_bubble_lines.',';
                   7582:                     }
                   7583:                     $subdivided_bubble_lines{$response_number} =~ s/,$//;
                   7584:                     $lines = $numshown * $inner_bubble_lines;
                   7585:                 } else {
                   7586:                     $lines = $analysis->{"$part_id.bubble_lines"};
                   7587:                 } 
                   7588: 
                   7589:                 $first_bubble_line{$response_number} = $bubble_line;
                   7590: 	        $bubble_lines_per_response{$response_number} = $lines;
                   7591:                 $responsetype_per_response{$response_number} = 
                   7592:                     $analysis->{$part_id.'.type'};
                   7593: 	        $response_number++;
                   7594: 
                   7595: 	        $bubble_line +=  $lines;
                   7596: 	        $total_lines +=  $lines;
                   7597: 	    }
                   7598:         }
                   7599:     }
1.552     raeburn  7600:     &Apache::lonnet::delenv('scantron.');
1.542     raeburn  7601: 
                   7602:     &save_bubble_lines();
                   7603:     $env{'form.scantron_maxbubble'} =
                   7604: 	$total_lines;
                   7605:     return $env{'form.scantron_maxbubble'};
                   7606: }
1.523     raeburn  7607: 
1.157     albertel 7608: sub scantron_validate_missingbubbles {
                   7609:     my ($r,$currentphase) = @_;
                   7610:     #get student info
                   7611:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7612:     my %idmap=&username_to_idmap($classlist);
                   7613: 
                   7614:     #get scantron line setup
1.257     albertel 7615:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7616:     my ($scanlines,$scan_data)=&scantron_getfile();
1.582     raeburn  7617:     my $nav_error;
                   7618:     my $max_bubble=&scantron_get_maxbubble(\$nav_error);
                   7619:     if ($nav_error) {
                   7620:         return(1,$currentphase);
                   7621:     }
1.157     albertel 7622:     if (!$max_bubble) { $max_bubble=2**31; }
                   7623:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7624: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7625: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7626: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7627: 						 $scan_data);
                   7628: 	if (!defined($$scan_record{'scantron.missingerror'})) { next; }
                   7629: 	my @to_correct;
1.470     foxr     7630: 	
                   7631: 	# Probably here's where the error is...
                   7632: 
1.157     albertel 7633: 	foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
1.505     raeburn  7634:             my $lastbubble;
                   7635:             if ($missing =~ /^(\d+)\.(\d+)$/) {
                   7636:                my $question = $1;
                   7637:                my $subquestion = $2;
                   7638:                if (!defined($first_bubble_line{$question -1})) { next; }
                   7639:                my $first = $first_bubble_line{$question-1};
                   7640:                my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   7641:                my $subcount = 1;
                   7642:                while ($subcount<$subquestion) {
                   7643:                    $first += $subans[$subcount-1];
                   7644:                    $subcount ++;
                   7645:                }
                   7646:                my $count = $subans[$subquestion-1];
                   7647:                $lastbubble = $first + $count;
                   7648:             } else {
                   7649:                 if (!defined($first_bubble_line{$missing - 1})) { next; }
                   7650:                 $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1};
                   7651:             }
                   7652:             if ($lastbubble > $max_bubble) { next; }
1.157     albertel 7653: 	    push(@to_correct,$missing);
                   7654: 	}
                   7655: 	if (@to_correct) {
                   7656: 	    &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   7657: 				     $line,'missingbubble',\@to_correct);
                   7658: 	    return (1,$currentphase);
                   7659: 	}
                   7660: 
                   7661:     }
                   7662:     return (0,$currentphase+1);
                   7663: }
                   7664: 
1.423     albertel 7665: 
1.82      albertel 7666: sub scantron_process_students {
1.75      albertel 7667:     my ($r) = @_;
1.513     foxr     7668: 
1.257     albertel 7669:     my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
1.324     albertel 7670:     my ($symb)=&get_symb($r);
1.513     foxr     7671:     if (!$symb) {
                   7672: 	return '';
                   7673:     }
1.324     albertel 7674:     my $default_form_data=&defaultFormData($symb);
1.82      albertel 7675: 
1.257     albertel 7676:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7677:     my ($scanlines,$scan_data)=&scantron_getfile();
1.82      albertel 7678:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7679:     my %idmap=&username_to_idmap($classlist);
1.132     bowersj2 7680:     my $navmap=Apache::lonnavmaps::navmap->new();
1.582     raeburn  7681:     unless (ref($navmap)) {
                   7682:         $r->print(&navmap_errormsg());
                   7683:         return '';
                   7684:     }  
1.83      albertel 7685:     my $map=$navmap->getResourceByUrl($sequence);
                   7686:     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
1.557     raeburn  7687:     my (%grader_partids_by_symb,%grader_randomlists_by_symb);
                   7688:     &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                   7689:                             \%grader_randomlists_by_symb);
1.586     raeburn  7690:     my $resource_error;
1.557     raeburn  7691:     foreach my $resource (@resources) {
1.586     raeburn  7692:         my $ressymb;
                   7693:         if (ref($resource)) {
                   7694:             $ressymb = $resource->symb();
                   7695:         } else {
                   7696:             $resource_error = 1;
                   7697:             last;
                   7698:         }
1.557     raeburn  7699:         my ($analysis,$parts) =
                   7700:             &scantron_partids_tograde($resource,$env{'request.course.id'},
                   7701:                                       $env{'user.name'},$env{'user.domain'},1);
                   7702:         $grader_partids_by_symb{$ressymb} = $parts;
                   7703:         if (ref($analysis) eq 'HASH') {
                   7704:             if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
                   7705:                 $grader_randomlists_by_symb{$ressymb} = 
                   7706:                     $analysis->{'parts_withrandomlist'};
                   7707:             }
                   7708:         }
                   7709:     }
1.586     raeburn  7710:     if ($resource_error) {
                   7711:         $r->print(&navmap_errormsg());
                   7712:         return '';
                   7713:     }
1.557     raeburn  7714: 
1.554     raeburn  7715:     my ($uname,$udom);
1.82      albertel 7716:     my $result= <<SCANTRONFORM;
1.81      albertel 7717: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
                   7718:   <input type="hidden" name="command" value="scantron_configphase" />
                   7719:   $default_form_data
                   7720: SCANTRONFORM
1.82      albertel 7721:     $r->print($result);
                   7722: 
                   7723:     my @delayqueue;
1.542     raeburn  7724:     my (%completedstudents,%scandata);
1.140     albertel 7725:     
1.520     www      7726:     my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
1.200     albertel 7727:     my $count=&get_todo_count($scanlines,$scan_data);
1.575     www      7728:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet Status',
                   7729:  				    'Bubblesheet Progress',$count,
1.195     albertel 7730: 				    'inline',undef,'scantronupload');
1.140     albertel 7731:     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
                   7732: 					  'Processing first student');
1.542     raeburn  7733:     $r->print('<br />');
1.140     albertel 7734:     my $start=&Time::HiRes::time();
1.158     albertel 7735:     my $i=-1;
1.542     raeburn  7736:     my $started;
1.447     foxr     7737: 
1.582     raeburn  7738:     my $nav_error;
                   7739:     &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse.
                   7740:     if ($nav_error) {
                   7741:         $r->print(&navmap_errormsg());
                   7742:         return '';
                   7743:     }
                   7744: 
1.513     foxr     7745:     # If an ssi failed in scantron_get_maxbubble, put an error message out to
                   7746:     # the user and return.
                   7747: 
                   7748:     if ($ssi_error) {
                   7749: 	$r->print("</form>");
                   7750: 	&ssi_print_error($r);
                   7751: 	$r->print(&show_grading_menu_form($symb));
1.520     www      7752:         &Apache::lonnet::remove_lock($lock);
1.513     foxr     7753: 	return '';		# Dunno why the other returns return '' rather than just returning.
                   7754:     }
1.447     foxr     7755: 
1.542     raeburn  7756:     my %lettdig = &letter_to_digits();
                   7757:     my $numletts = scalar(keys(%lettdig));
                   7758: 
1.157     albertel 7759:     while ($i<$scanlines->{'count'}) {
                   7760:  	($uname,$udom)=('','');
                   7761:  	$i++;
1.200     albertel 7762:  	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7763:  	if ($line=~/^[\s\cz]*$/) { next; }
1.200     albertel 7764: 	if ($started) {
                   7765: 	    &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   7766: 						     'last student');
                   7767: 	}
                   7768: 	$started=1;
1.157     albertel 7769:  	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7770:  						 $scan_data);
                   7771:  	unless ($uname=&scantron_find_student($scan_record,$scan_data,
                   7772:  					      \%idmap,$i)) {
                   7773:   	    &scantron_add_delay(\@delayqueue,$line,
                   7774:  				'Unable to find a student that matches',1);
                   7775:  	    next;
                   7776:   	}
                   7777:  	if (exists $completedstudents{$uname}) {
                   7778:  	    &scantron_add_delay(\@delayqueue,$line,
                   7779:  				'Student '.$uname.' has multiple sheets',2);
                   7780:  	    next;
                   7781:  	}
                   7782:   	($uname,$udom)=split(/:/,$uname);
1.330     albertel 7783: 
1.586     raeburn  7784:         my (%partids_by_symb,$res_error);
1.554     raeburn  7785:         foreach my $resource (@resources) {
1.586     raeburn  7786:             my $ressymb;
                   7787:             if (ref($resource)) {
                   7788:                 $ressymb = $resource->symb();
                   7789:             } else {
                   7790:                 $res_error = 1;
                   7791:                 last;
                   7792:             }
1.557     raeburn  7793:             if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                   7794:                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                   7795:                 my ($analysis,$parts) =
                   7796:                     &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom);
                   7797:                 $partids_by_symb{$ressymb} = $parts;
                   7798:             } else {
                   7799:                 $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};
                   7800:             }
1.554     raeburn  7801:         }
                   7802: 
1.586     raeburn  7803:         if ($res_error) {
                   7804:             &scantron_add_delay(\@delayqueue,$line,
                   7805:                                 'An error occurred while grading student '.$uname,2);
                   7806:             next;
                   7807:         }
                   7808: 
1.330     albertel 7809: 	&Apache::lonxml::clear_problem_counter();
1.514     raeburn  7810:   	&Apache::lonnet::appenv($scan_record);
1.376     albertel 7811: 
                   7812: 	if (&scantron_clear_skip($scanlines,$scan_data,$i)) {
                   7813: 	    &scantron_putfile($scanlines,$scan_data);
                   7814: 	}
1.161     albertel 7815: 	
1.542     raeburn  7816:         my $scancode;
                   7817:         if ((exists($scan_record->{'scantron.CODE'})) &&
                   7818:             (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
                   7819:             $scancode = $scan_record->{'scantron.CODE'};
                   7820:         } else {
                   7821:             $scancode = '';
                   7822:         }
                   7823: 
                   7824:         if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
1.554     raeburn  7825:                                    \@resources,\%partids_by_symb) eq 'ssi_error') {
1.542     raeburn  7826:             $ssi_error = 0; # So end of handler error message does not trigger.
                   7827:             $r->print("</form>");
                   7828:             &ssi_print_error($r);
                   7829:             $r->print(&show_grading_menu_form($symb));
                   7830:             &Apache::lonnet::remove_lock($lock);
                   7831:             return '';      # Why return ''?  Beats me.
                   7832:         }
1.513     foxr     7833: 
1.140     albertel 7834: 	$completedstudents{$uname}={'line'=>$line};
1.542     raeburn  7835:         if ($env{'form.verifyrecord'}) {
                   7836:             my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
                   7837:             my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
                   7838:             chomp($studentdata);
                   7839:             $studentdata =~ s/\r$//;
                   7840:             my $studentrecord = '';
                   7841:             my $counter = -1;
                   7842:             foreach my $resource (@resources) {
1.554     raeburn  7843:                 my $ressymb = $resource->symb();
1.542     raeburn  7844:                 ($counter,my $recording) =
                   7845:                     &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
1.554     raeburn  7846:                                              $counter,$studentdata,$partids_by_symb{$ressymb},
1.542     raeburn  7847:                                              \%scantron_config,\%lettdig,$numletts);
                   7848:                 $studentrecord .= $recording;
                   7849:             }
                   7850:             if ($studentrecord ne $studentdata) {
1.554     raeburn  7851:                 &Apache::lonxml::clear_problem_counter();
                   7852:                 if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                   7853:                                            \@resources,\%partids_by_symb) eq 'ssi_error') {
                   7854:                     $ssi_error = 0; # So end of handler error message does not trigger.
                   7855:                     $r->print("</form>");
                   7856:                     &ssi_print_error($r);
                   7857:                     $r->print(&show_grading_menu_form($symb));
                   7858:                     &Apache::lonnet::remove_lock($lock);
                   7859:                     delete($completedstudents{$uname});
                   7860:                     return '';
                   7861:                 }
1.542     raeburn  7862:                 $counter = -1;
                   7863:                 $studentrecord = '';
                   7864:                 foreach my $resource (@resources) {
1.554     raeburn  7865:                     my $ressymb = $resource->symb();
1.542     raeburn  7866:                     ($counter,my $recording) =
                   7867:                         &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
1.554     raeburn  7868:                                                  $counter,$studentdata,$partids_by_symb{$ressymb},
1.542     raeburn  7869:                                                  \%scantron_config,\%lettdig,$numletts);
                   7870:                     $studentrecord .= $recording;
                   7871:                 }
                   7872:                 if ($studentrecord ne $studentdata) {
                   7873:                     $r->print('<p><span class="LC_error">');
                   7874:                     if ($scancode eq '') {
                   7875:                         $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].',
                   7876:                                   $uname.':'.$udom,$scan_record->{'scantron.ID'}));
                   7877:                     } else {
                   7878:                         $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2] and CODE: [_3].',
                   7879:                                   $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));
                   7880:                     }
                   7881:                     $r->print('</span><br />'.&Apache::loncommon::start_data_table()."\n".
                   7882:                               &Apache::loncommon::start_data_table_header_row()."\n".
                   7883:                               '<th>'.&mt('Source').'</th><th>'.&mt('Bubbled responses').'</th>'.
                   7884:                               &Apache::loncommon::end_data_table_header_row()."\n".
                   7885:                               &Apache::loncommon::start_data_table_row().
                   7886:                               '<td>'.&mt('Bubble Sheet').'</td>'.
                   7887:                               '<td><span class="LC_nobreak">'.$studentdata.'</span></td>'.
                   7888:                               &Apache::loncommon::end_data_table_row().
                   7889:                               &Apache::loncommon::start_data_table_row().
                   7890:                               '<td>Stored submissions</td>'.
                   7891:                               '<td><span class="LC_nobreak">'.$studentrecord.'</span></td>'."\n".
                   7892:                               &Apache::loncommon::end_data_table_row().
                   7893:                               &Apache::loncommon::end_data_table().'</p>');
                   7894:                 } else {
                   7895:                     $r->print('<br /><span class="LC_warning">'.
                   7896:                              &mt('A second grading pass was needed for user: [_1] with ID: [_2], because a mismatch was seen on the first pass.',$uname.':'.$udom,$scan_record->{'scantron.ID'}).'<br />'.
                   7897:                              &mt("As a consequence, this user's submission history records two tries.").
                   7898:                                  '</span><br />');
                   7899:                 }
                   7900:             }
                   7901:         }
1.543     raeburn  7902:         if (&Apache::loncommon::connection_aborted($r)) { last; }
1.140     albertel 7903:     } continue {
1.330     albertel 7904: 	&Apache::lonxml::clear_problem_counter();
1.552     raeburn  7905: 	&Apache::lonnet::delenv('scantron.');
1.82      albertel 7906:     }
1.140     albertel 7907:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
1.520     www      7908:     &Apache::lonnet::remove_lock($lock);
1.172     albertel 7909: #    my $lasttime = &Time::HiRes::time()-$start;
                   7910: #    $r->print("<p>took $lasttime</p>");
1.140     albertel 7911: 
1.200     albertel 7912:     $r->print("</form>");
1.324     albertel 7913:     $r->print(&show_grading_menu_form($symb));
1.157     albertel 7914:     return '';
1.75      albertel 7915: }
1.157     albertel 7916: 
1.557     raeburn  7917: sub graders_resources_pass {
                   7918:     my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb) = @_;
                   7919:     if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && 
                   7920:         (ref($grader_randomlists_by_symb) eq 'HASH')) {
                   7921:         foreach my $resource (@{$resources}) {
                   7922:             my $ressymb = $resource->symb();
                   7923:             my ($analysis,$parts) =
                   7924:                 &scantron_partids_tograde($resource,$env{'request.course.id'},
                   7925:                                           $env{'user.name'},$env{'user.domain'},1);
                   7926:             $grader_partids_by_symb->{$ressymb} = $parts;
                   7927:             if (ref($analysis) eq 'HASH') {
                   7928:                 if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
                   7929:                     $grader_randomlists_by_symb->{$ressymb} =
                   7930:                         $analysis->{'parts_withrandomlist'};
                   7931:                 }
                   7932:             }
                   7933:         }
                   7934:     }
                   7935:     return;
                   7936: }
                   7937: 
1.542     raeburn  7938: sub grade_student_bubbles {
1.554     raeburn  7939:     my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts) = @_;
                   7940:     if (ref($resources) eq 'ARRAY') {
                   7941:         my $count = 0;
                   7942:         foreach my $resource (@{$resources}) {
                   7943:             my $ressymb = $resource->symb();
                   7944:             my %form = ('submitted'      => 'scantron',
                   7945:                         'grade_target'   => 'grade',
                   7946:                         'grade_username' => $uname,
                   7947:                         'grade_domain'   => $udom,
                   7948:                         'grade_courseid' => $env{'request.course.id'},
                   7949:                         'grade_symb'     => $ressymb,
                   7950:                         'CODE'           => $scancode
                   7951:                        );
                   7952:             if (ref($parts) eq 'HASH') {
                   7953:                 if (ref($parts->{$ressymb}) eq 'ARRAY') {
                   7954:                     foreach my $part (@{$parts->{$ressymb}}) {
                   7955:                         $form{'scantron_questnum_start.'.$part} =
                   7956:                             1+$env{'form.scantron.first_bubble_line.'.$count};
                   7957:                         $count++;
                   7958:                     }
                   7959:                 }
                   7960:             }
                   7961:             my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form);
                   7962:             return 'ssi_error' if ($ssi_error);
                   7963:             last if (&Apache::loncommon::connection_aborted($r));
                   7964:         }
1.542     raeburn  7965:     }
                   7966:     return;
                   7967: }
                   7968: 
1.157     albertel 7969: sub scantron_upload_scantron_data {
                   7970:     my ($r)=@_;
1.565     raeburn  7971:     my $dom = $env{'request.role.domain'};
                   7972:     my $domdesc = &Apache::lonnet::domain($dom,'description');
                   7973:     $r->print(&Apache::loncommon::coursebrowser_javascript($dom));
1.157     albertel 7974:     my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',
1.181     albertel 7975: 							  'domainid',
1.565     raeburn  7976: 							  'coursename',$dom);
                   7977:     my $syllabuslink = '<a href="javascript:ToSyllabus();">'.&mt('Syllabus').'</a>'.
                   7978:                        ('&nbsp'x2).&mt('(shows course personnel)'); 
1.324     albertel 7979:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.579     raeburn  7980:     my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.');
                   7981:     my $nocourseid_alert = &mt("Please use the 'Select Course' link to open a separate window where you can search for a course to which a file can be uploaded.");
1.492     albertel 7982:     $r->print('
1.157     albertel 7983: <script type="text/javascript" language="javascript">
                   7984:     function checkUpload(formname) {
                   7985: 	if (formname.upfile.value == "") {
1.579     raeburn  7986: 	    alert("'.$nofile_alert.'");
1.157     albertel 7987: 	    return false;
                   7988: 	}
1.565     raeburn  7989:         if (formname.courseid.value == "") {
1.579     raeburn  7990:             alert("'.$nocourseid_alert.'");
1.565     raeburn  7991:             return false;
                   7992:         }
1.157     albertel 7993: 	formname.submit();
                   7994:     }
1.565     raeburn  7995: 
                   7996:     function ToSyllabus() {
                   7997:         var cdom = '."'$dom'".';
                   7998:         var cnum = document.rules.courseid.value;
                   7999:         if (cdom == "" || cdom == null) {
                   8000:             return;
                   8001:         }
                   8002:         if (cnum == "" || cnum == null) {
                   8003:            return;
                   8004:         }
                   8005:         syllwin=window.open("/public/"+cdom+"/"+cnum+"/syllabus","LONCAPASyllabus",
                   8006:                             "height=350,width=350,scrollbars=yes,menubar=no");
                   8007:         return;
                   8008:     }
                   8009: 
1.157     albertel 8010: </script>
                   8011: 
1.566     raeburn  8012: <h3>'.&mt('Send scanned bubblesheet data to a course').'</h3>
                   8013: 
1.492     albertel 8014: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post">
1.565     raeburn  8015: '.$default_form_data.
                   8016:   &Apache::lonhtmlcommon::start_pick_box().
                   8017:   &Apache::lonhtmlcommon::row_title(&mt('Course ID')).
                   8018:   '<input name="courseid" type="text" size="30" />'.$select_link.
                   8019:   &Apache::lonhtmlcommon::row_closure().
                   8020:   &Apache::lonhtmlcommon::row_title(&mt('Course Name')).
                   8021:   '<input name="coursename" type="text" size="30" />'.$syllabuslink.
                   8022:   &Apache::lonhtmlcommon::row_closure().
                   8023:   &Apache::lonhtmlcommon::row_title(&mt('Domain')).
                   8024:   '<input name="domainid" type="hidden" />'.$domdesc.
                   8025:   &Apache::lonhtmlcommon::row_closure().
                   8026:   &Apache::lonhtmlcommon::row_title(&mt('File to upload')).
                   8027:   '<input type="file" name="upfile" size="50" />'.
                   8028:   &Apache::lonhtmlcommon::row_closure(1).
                   8029:   &Apache::lonhtmlcommon::end_pick_box().'<br />
                   8030: 
1.492     albertel 8031: <input name="command" value="scantronupload_save" type="hidden" />
1.589     bisitz   8032: <input type="button" onclick="javascript:checkUpload(this.form);" value="'.&mt('Upload Bubblesheet Data').'" />
1.157     albertel 8033: </form>
1.492     albertel 8034: ');
1.157     albertel 8035:     return '';
                   8036: }
                   8037: 
1.423     albertel 8038: 
1.157     albertel 8039: sub scantron_upload_scantron_data_save {
                   8040:     my($r)=@_;
1.324     albertel 8041:     my ($symb)=&get_symb($r,1);
1.182     albertel 8042:     my $doanotherupload=
                   8043: 	'<br /><form action="/adm/grades" method="post">'."\n".
                   8044: 	'<input type="hidden" name="command" value="scantronupload" />'."\n".
1.492     albertel 8045: 	'<input type="submit" name="submit" value="'.&mt('Do Another Upload').'" />'."\n".
1.182     albertel 8046: 	'</form>'."\n";
1.257     albertel 8047:     if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) &&
1.162     albertel 8048: 	!&Apache::lonnet::allowed('usc',
1.257     albertel 8049: 			    $env{'form.domainid'}.'_'.$env{'form.courseid'})) {
1.575     www      8050: 	$r->print(&mt("You are not allowed to upload bubblesheet data to the requested course.")."<br />");
1.182     albertel 8051: 	if ($symb) {
1.324     albertel 8052: 	    $r->print(&show_grading_menu_form($symb));
1.182     albertel 8053: 	} else {
                   8054: 	    $r->print($doanotherupload);
                   8055: 	}
1.162     albertel 8056: 	return '';
                   8057:     }
1.257     albertel 8058:     my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'});
1.568     raeburn  8059:     my $uploadedfile;
1.567     raeburn  8060:     $r->print('<h3>'.&mt("Uploading file to [_1]",$coursedata{'description'}).'</h3>');
1.257     albertel 8061:     if (length($env{'form.upfile'}) < 2) {
1.568     raeburn  8062:         $r->print(&mt('[_1]Error:[_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.','<span class="LC_error">','</span>','<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'));
1.183     albertel 8063:     } else {
1.568     raeburn  8064:         my $result = 
                   8065:             &Apache::lonnet::userfileupload('upfile','','scantron','','','',
                   8066:                                             $env{'form.courseid'},$env{'form.domainid'});
                   8067: 	if ($result =~ m{^/uploaded/}) {
1.567     raeburn  8068: 	    $r->print(&mt('[_1]Success:[_2] Successfully uploaded [_3] bytes of data into location: [_4]',
                   8069:                           '<span class="LC_success">','</span>',(length($env{'form.upfile'})-1),
                   8070: 			  '<span class="LC_filename">'.$result.'</span>'));
1.568     raeburn  8071:             ($uploadedfile) = ($result =~ m{/([^/]+)$});
1.567     raeburn  8072:             $r->print(&validate_uploaded_scantron_file($env{'form.domainid'},
1.568     raeburn  8073:                                                        $env{'form.courseid'},$uploadedfile));
1.210     albertel 8074: 	} else {
1.567     raeburn  8075: 	    $r->print(&mt('[_1]Error:[_2] An error ([_3]) occurred when attempting to upload the file, [_4]',
                   8076:                           '<span class="LC_error">','</span>',$result,
1.568     raeburn  8077: 			  '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'));
1.183     albertel 8078: 	}
                   8079:     }
1.174     albertel 8080:     if ($symb) {
1.209     ng       8081: 	$r->print(&scantron_selectphase($r,$uploadedfile));
1.174     albertel 8082:     } else {
1.182     albertel 8083: 	$r->print($doanotherupload);
1.174     albertel 8084:     }
1.157     albertel 8085:     return '';
                   8086: }
                   8087: 
1.567     raeburn  8088: sub validate_uploaded_scantron_file {
                   8089:     my ($cdom,$cname,$fname) = @_;
                   8090:     my $scanlines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.$fname);
                   8091:     my @lines;
                   8092:     if ($scanlines ne '-1') {
                   8093:         @lines=split("\n",$scanlines,-1);
                   8094:     }
                   8095:     my $output;
                   8096:     if (@lines) {
                   8097:         my (%counts,$max_match_format);
                   8098:         my ($max_match_count,$max_match_pct) = (0,0);
                   8099:         my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cname);
                   8100:         my %idmap = &username_to_idmap($classlist);
                   8101:         foreach my $key (keys(%idmap)) {
                   8102:             my $lckey = lc($key);
                   8103:             $idmap{$lckey} = $idmap{$key};
                   8104:         }
                   8105:         my %unique_formats;
                   8106:         my @formatlines = &get_scantronformat_file();
                   8107:         foreach my $line (@formatlines) {
                   8108:             chomp($line);
                   8109:             my @config = split(/:/,$line);
                   8110:             my $idstart = $config[5];
                   8111:             my $idlength = $config[6];
                   8112:             if (($idstart ne '') && ($idlength > 0)) {
                   8113:                 if (ref($unique_formats{$idstart.':'.$idlength}) eq 'ARRAY') {
                   8114:                     push(@{$unique_formats{$idstart.':'.$idlength}},$config[0].':'.$config[1]); 
                   8115:                 } else {
                   8116:                     $unique_formats{$idstart.':'.$idlength} = [$config[0].':'.$config[1]];
                   8117:                 }
                   8118:             }
                   8119:         }
                   8120:         foreach my $key (keys(%unique_formats)) {
                   8121:             my ($idstart,$idlength) = split(':',$key);
                   8122:             %{$counts{$key}} = (
                   8123:                                'found'   => 0,
                   8124:                                'total'   => 0,
                   8125:                               );
                   8126:             foreach my $line (@lines) {
                   8127:                 next if ($line =~ /^#/);
                   8128:                 next if ($line =~ /^[\s\cz]*$/);
                   8129:                 my $id = substr($line,$idstart-1,$idlength);
                   8130:                 $id = lc($id);
                   8131:                 if (exists($idmap{$id})) {
                   8132:                     $counts{$key}{'found'} ++;
                   8133:                 }
                   8134:                 $counts{$key}{'total'} ++;
                   8135:             }
                   8136:             if ($counts{$key}{'total'}) {
                   8137:                 my $percent_match = (100*$counts{$key}{'found'})/($counts{$key}{'total'});
                   8138:                 if (($max_match_format eq '') || ($percent_match > $max_match_pct)) {
                   8139:                     $max_match_pct = $percent_match;
                   8140:                     $max_match_format = $key;
                   8141:                     $max_match_count = $counts{$key}{'total'};
                   8142:                 }
                   8143:             }
                   8144:         }
                   8145:         if (ref($unique_formats{$max_match_format}) eq 'ARRAY') {
                   8146:             my $format_descs;
                   8147:             my $numwithformat = @{$unique_formats{$max_match_format}};
                   8148:             for (my $i=0; $i<$numwithformat; $i++) {
                   8149:                 my ($name,$desc) = split(':',$unique_formats{$max_match_format}[$i]);
                   8150:                 if ($i<$numwithformat-2) {
                   8151:                     $format_descs .= '"<i>'.$desc.'</i>", ';
                   8152:                 } elsif ($i==$numwithformat-2) {
                   8153:                     $format_descs .= '"<i>'.$desc.'</i>" '.&mt('and').' ';
                   8154:                 } elsif ($i==$numwithformat-1) {
                   8155:                     $format_descs .= '"<i>'.$desc.'</i>"';
                   8156:                 }
                   8157:             }
                   8158:             my $showpct = sprintf("%.0f",$max_match_pct).'%';
                   8159:             $output .= '<br />'.&mt('Comparison of student IDs in the uploaded file with the course roster found matches for [_1] of the [_2] entries in the file (for the format defined for [_3]).','<b>'.$showpct.'</b>','<b>'.$max_match_count.'</b>',$format_descs).
                   8160:                        '<br />'.&mt('A low percentage of matches results from one of the following:').'<ul>'.
                   8161:                        '<li>'.&mt('The file was uploaded to the wrong course').'</li>'.
                   8162:                        '<li>'.&mt('The data are not in the format expected for the domain: [_1]',
                   8163:                                   '<i>'.$cdom.'</i>').'</li>'.
                   8164:                        '<li>'.&mt('Students did not bubble their IDs, or mis-bubbled them').'</li>'.
                   8165:                        '<li>'.&mt('The course roster is not up to date').'</li>'.
                   8166:                        '</ul>';
                   8167:         }
                   8168:     } else {
                   8169:         $output = '<span class="LC_warning">'.&mt('Uploaded file contained no data').'</span>';
                   8170:     }
                   8171:     return $output;
                   8172: }
                   8173: 
1.202     albertel 8174: sub valid_file {
                   8175:     my ($requested_file)=@_;
                   8176:     foreach my $filename (sort(&scantron_filenames())) {
                   8177: 	if ($requested_file eq $filename) { return 1; }
                   8178:     }
                   8179:     return 0;
                   8180: }
                   8181: 
                   8182: sub scantron_download_scantron_data {
                   8183:     my ($r)=@_;
1.324     albertel 8184:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.257     albertel 8185:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   8186:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   8187:     my $file=$env{'form.scantron_selectfile'};
1.202     albertel 8188:     if (! &valid_file($file)) {
1.492     albertel 8189: 	$r->print('
1.202     albertel 8190: 	<p>
1.492     albertel 8191: 	    '.&mt('The requested file name was invalid.').'
1.202     albertel 8192:         </p>
1.492     albertel 8193: ');
1.324     albertel 8194: 	$r->print(&show_grading_menu_form(&get_symb($r,1)));
1.202     albertel 8195: 	return;
                   8196:     }
                   8197:     my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file;
                   8198:     my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file;
                   8199:     my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file;
                   8200:     &Apache::lonnet::allowuploaded('/adm/grades',$orig);
                   8201:     &Apache::lonnet::allowuploaded('/adm/grades',$corrected);
                   8202:     &Apache::lonnet::allowuploaded('/adm/grades',$skipped);
1.492     albertel 8203:     $r->print('
1.202     albertel 8204:     <p>
1.492     albertel 8205: 	'.&mt('[_1]Original[_2] file as uploaded by the scantron office.',
                   8206: 	      '<a href="'.$orig.'">','</a>').'
1.202     albertel 8207:     </p>
                   8208:     <p>
1.492     albertel 8209: 	'.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.',
                   8210: 	      '<a href="'.$corrected.'">','</a>').'
1.202     albertel 8211:     </p>
                   8212:     <p>
1.492     albertel 8213: 	'.&mt('[_1]Skipped[_2], a file of records that were skipped.',
                   8214: 	      '<a href="'.$skipped.'">','</a>').'
1.202     albertel 8215:     </p>
1.492     albertel 8216: ');
1.324     albertel 8217:     $r->print(&show_grading_menu_form(&get_symb($r,1)));
1.202     albertel 8218:     return '';
                   8219: }
1.157     albertel 8220: 
1.523     raeburn  8221: sub checkscantron_results {
                   8222:     my ($r) = @_;
                   8223:     my ($symb)=&get_symb($r);
                   8224:     if (!$symb) {return '';}
                   8225:     my $grading_menu_button=&show_grading_menu_form($symb);
                   8226:     my $cid = $env{'request.course.id'};
1.542     raeburn  8227:     my %lettdig = &letter_to_digits();
1.523     raeburn  8228:     my $numletts = scalar(keys(%lettdig));
                   8229:     my $cnum = $env{'course.'.$cid.'.num'};
                   8230:     my $cdom = $env{'course.'.$cid.'.domain'};
                   8231:     my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'});
                   8232:     my %record;
                   8233:     my %scantron_config =
                   8234:         &Apache::grades::get_scantron_config($env{'form.scantron_format'});
                   8235:     my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
                   8236:     my $classlist=&Apache::loncoursedata::get_classlist();
                   8237:     my %idmap=&Apache::grades::username_to_idmap($classlist);
                   8238:     my $navmap=Apache::lonnavmaps::navmap->new();
1.582     raeburn  8239:     unless (ref($navmap)) {
                   8240:         $r->print(&navmap_errormsg());
                   8241:         return '';
                   8242:     }
1.523     raeburn  8243:     my $map=$navmap->getResourceByUrl($sequence);
1.557     raeburn  8244:     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
                   8245:     my (%grader_partids_by_symb,%grader_randomlists_by_symb);
                   8246:     &graders_resources_pass(\@resources,\%grader_partids_by_symb,                             \%grader_randomlists_by_symb);
                   8247: 
1.554     raeburn  8248:     my ($uname,$udom);
1.523     raeburn  8249:     my (%scandata,%lastname,%bylast);
                   8250:     $r->print('
                   8251: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n");
                   8252: 
                   8253:     my @delayqueue;
                   8254:     my %completedstudents;
                   8255: 
                   8256:     my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);
1.581     www      8257:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet/Submissions Comparison Status',
                   8258:                                     'Progress of Bubblesheet Data/Submission Records Comparison',$count,
1.523     raeburn  8259:                                     'inline',undef,'checkscantron');
1.546     raeburn  8260:     my ($username,$domain,$started);
1.582     raeburn  8261:     my $nav_error;
                   8262:     &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse.
                   8263:     if ($nav_error) {
                   8264:         $r->print(&navmap_errormsg());
                   8265:         return '';
                   8266:     }
1.523     raeburn  8267: 
                   8268:     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
                   8269:                                           'Processing first student');
                   8270:     my $start=&Time::HiRes::time();
                   8271:     my $i=-1;
                   8272: 
                   8273:     while ($i<$scanlines->{'count'}) {
                   8274:         ($username,$domain,$uname)=('','','');
                   8275:         $i++;
                   8276:         my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i);
                   8277:         if ($line=~/^[\s\cz]*$/) { next; }
                   8278:         if ($started) {
                   8279:             &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   8280:                                                      'last student');
                   8281:         }
                   8282:         $started=1;
                   8283:         my $scan_record=
                   8284:             &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,
                   8285:                                                      $scan_data);
                   8286:         unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data,
                   8287:                                                               \%idmap,$i)) {
                   8288:             &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                   8289:                                 'Unable to find a student that matches',1);
                   8290:             next;
                   8291:         }
                   8292:         if (exists $completedstudents{$uname}) {
                   8293:             &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                   8294:                                 'Student '.$uname.' has multiple sheets',2);
                   8295:             next;
                   8296:         }
                   8297:         my $pid = $scan_record->{'scantron.ID'};
                   8298:         $lastname{$pid} = $scan_record->{'scantron.LastName'};
                   8299:         push(@{$bylast{$lastname{$pid}}},$pid);
                   8300:         my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
                   8301:         $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
                   8302:         chomp($scandata{$pid});
                   8303:         $scandata{$pid} =~ s/\r$//;
                   8304:         ($username,$domain)=split(/:/,$uname);
                   8305:         my $counter = -1;
                   8306:         foreach my $resource (@resources) {
1.557     raeburn  8307:             my $parts;
1.554     raeburn  8308:             my $ressymb = $resource->symb();
1.557     raeburn  8309:             if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                   8310:                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                   8311:                 (my $analysis,$parts) =
                   8312:                     &scantron_partids_tograde($resource,$env{'request.course.id'},$username,$domain);
                   8313:             } else {
                   8314:                 $parts = $grader_partids_by_symb{$ressymb};
                   8315:             }
1.542     raeburn  8316:             ($counter,my $recording) =
                   8317:                 &verify_scantron_grading($resource,$domain,$username,$cid,$counter,
1.554     raeburn  8318:                                          $scandata{$pid},$parts,
1.542     raeburn  8319:                                          \%scantron_config,\%lettdig,$numletts);
                   8320:             $record{$pid} .= $recording;
1.523     raeburn  8321:         }
                   8322:     }
                   8323:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
                   8324:     $r->print('<br />');
                   8325:     my ($okstudents,$badstudents,$numstudents,$passed,$failed);
                   8326:     $passed = 0;
                   8327:     $failed = 0;
                   8328:     $numstudents = 0;
                   8329:     foreach my $last (sort(keys(%bylast))) {
                   8330:         if (ref($bylast{$last}) eq 'ARRAY') {
                   8331:             foreach my $pid (sort(@{$bylast{$last}})) {
                   8332:                 my $showscandata = $scandata{$pid};
                   8333:                 my $showrecord = $record{$pid};
                   8334:                 $showscandata =~ s/\s/&nbsp;/g;
                   8335:                 $showrecord =~ s/\s/&nbsp;/g;
                   8336:                 if ($scandata{$pid} eq $record{$pid}) {
                   8337:                     my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row';
                   8338:                     $okstudents .= '<tr class="'.$css_class.'">'.
1.581     www      8339: '<td>'.&mt('Bubblesheet').'</td><td>'.$showscandata.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
1.523     raeburn  8340: '</tr>'."\n".
                   8341: '<tr class="'.$css_class.'">'."\n".
                   8342: '<td>Submissions</td><td>'.$showrecord.'</td></tr>'."\n";
                   8343:                     $passed ++;
                   8344:                 } else {
                   8345:                     my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row';
1.581     www      8346:                     $badstudents .= '<tr class="'.$css_class.'"><td>'.&mt('Bubblesheet').'</td><td><span class="LC_nobreak">'.$scandata{$pid}.'</span></td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
1.523     raeburn  8347: '</tr>'."\n".
                   8348: '<tr class="'.$css_class.'">'."\n".
                   8349: '<td>Submissions</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n".
                   8350: '</tr>'."\n";
                   8351:                     $failed ++;
                   8352:                 }
                   8353:                 $numstudents ++;
                   8354:             }
                   8355:         }
                   8356:     }
1.572     www      8357:     $r->print('<p>'.&mt('Comparison of bubblesheet 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>');
1.523     raeburn  8358:     $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>');
                   8359:     if ($passed) {
1.572     www      8360:         $r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />');
1.523     raeburn  8361:         $r->print(&Apache::loncommon::start_data_table()."\n".
                   8362:                  &Apache::loncommon::start_data_table_header_row()."\n".
                   8363:                  '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
                   8364:                  &Apache::loncommon::end_data_table_header_row()."\n".
                   8365:                  $okstudents."\n".
                   8366:                  &Apache::loncommon::end_data_table().'<br />');
                   8367:     }
                   8368:     if ($failed) {
1.572     www      8369:         $r->print(&mt('Students with differences between bubblesheet data and submissions are as follows:').'<br /><br />');
1.523     raeburn  8370:         $r->print(&Apache::loncommon::start_data_table()."\n".
                   8371:                  &Apache::loncommon::start_data_table_header_row()."\n".
                   8372:                  '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
                   8373:                  &Apache::loncommon::end_data_table_header_row()."\n".
                   8374:                  $badstudents."\n".
                   8375:                  &Apache::loncommon::end_data_table()).'<br />'.
1.572     www      8376:                  &mt('Differences can occur if submissions were modified using manual grading after a bubblesheet grading pass.').'<br />'.&mt('If unexpected discrepancies were detected, it is recommended that you inspect the original bubblesheets.');  
1.523     raeburn  8377:     }
                   8378:     $r->print('</form><br />'.$grading_menu_button);
                   8379:     return;
                   8380: }
                   8381: 
1.542     raeburn  8382: sub verify_scantron_grading {
1.554     raeburn  8383:     my ($resource,$domain,$username,$cid,$counter,$scandata,$partids,
1.542     raeburn  8384:         $scantron_config,$lettdig,$numletts) = @_;
                   8385:     my ($record,%expected,%startpos);
                   8386:     return ($counter,$record) if (!ref($resource));
                   8387:     return ($counter,$record) if (!$resource->is_problem());
                   8388:     my $symb = $resource->symb();
1.554     raeburn  8389:     return ($counter,$record) if (ref($partids) ne 'ARRAY');
                   8390:     foreach my $part_id (@{$partids}) {
1.542     raeburn  8391:         $counter ++;
                   8392:         $expected{$part_id} = 0;
                   8393:         if ($env{"form.scantron.sub_bubblelines.$counter"}) {
                   8394:             my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"});
                   8395:             foreach my $item (@sub_lines) {
                   8396:                 $expected{$part_id} += $item;
                   8397:             }
                   8398:         } else {
                   8399:             $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"};
                   8400:         }
                   8401:         $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
                   8402:     }
                   8403:     if ($symb) {
                   8404:         my %recorded;
                   8405:         my (%returnhash) = &Apache::lonnet::restore($symb,$cid,$domain,$username);
                   8406:         if ($returnhash{'version'}) {
                   8407:             my %lasthash=();
                   8408:             my $version;
                   8409:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   8410:                 foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   8411:                     $lasthash{$key}=$returnhash{$version.':'.$key};
                   8412:                 }
                   8413:             }
                   8414:             foreach my $key (keys(%lasthash)) {
                   8415:                 if ($key =~ /\.scantron$/) {
                   8416:                     my $value = &unescape($lasthash{$key});
                   8417:                     my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/);
                   8418:                     if ($value eq '') {
                   8419:                         for (my $i=0; $i<$expected{$part_id}; $i++) {
                   8420:                             for (my $j=0; $j<$scantron_config->{'length'}; $j++) {
                   8421:                                 $recorded{$part_id} .= $scantron_config->{'Qoff'};
                   8422:                             }
                   8423:                         }
                   8424:                     } else {
                   8425:                         my @tocheck;
                   8426:                         my @items = split(//,$value);
                   8427:                         if (($scantron_config->{'Qon'} eq 'letter') ||
                   8428:                             ($scantron_config->{'Qon'} eq 'number')) {
                   8429:                             if (@items < $expected{$part_id}) {
                   8430:                                 my $fragment = substr($scandata,$startpos{$part_id},$expected{$part_id});
                   8431:                                 my @singles = split(//,$fragment);
                   8432:                                 foreach my $pos (@singles) {
                   8433:                                     if ($pos eq ' ') {
                   8434:                                         push(@tocheck,$pos);
                   8435:                                     } else {
                   8436:                                         my $next = shift(@items);
                   8437:                                         push(@tocheck,$next);
                   8438:                                     }
                   8439:                                 }
                   8440:                             } else {
                   8441:                                 @tocheck = @items;
                   8442:                             }
                   8443:                             foreach my $letter (@tocheck) {
                   8444:                                 if ($scantron_config->{'Qon'} eq 'letter') {
                   8445:                                     if ($letter !~ /^[A-J]$/) {
                   8446:                                         $letter = $scantron_config->{'Qoff'};
                   8447:                                     }
                   8448:                                     $recorded{$part_id} .= $letter;
                   8449:                                 } elsif ($scantron_config->{'Qon'} eq 'number') {
                   8450:                                     my $digit;
                   8451:                                     if ($letter !~ /^[A-J]$/) {
                   8452:                                         $digit = $scantron_config->{'Qoff'};
                   8453:                                     } else {
                   8454:                                         $digit = $lettdig->{$letter};
                   8455:                                     }
                   8456:                                     $recorded{$part_id} .= $digit;
                   8457:                                 }
                   8458:                             }
                   8459:                         } else {
                   8460:                             @tocheck = @items;
                   8461:                             for (my $i=0; $i<$expected{$part_id}; $i++) {
                   8462:                                 my $curr_sub = shift(@tocheck);
                   8463:                                 my $digit;
                   8464:                                 if ($curr_sub =~ /^[A-J]$/) {
                   8465:                                     $digit = $lettdig->{$curr_sub}-1;
                   8466:                                 }
                   8467:                                 if ($curr_sub eq 'J') {
                   8468:                                     $digit += scalar($numletts);
                   8469:                                 }
                   8470:                                 for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) {
                   8471:                                     if ($j == $digit) {
                   8472:                                         $recorded{$part_id} .= $scantron_config->{'Qon'};
                   8473:                                     } else {
                   8474:                                         $recorded{$part_id} .= $scantron_config->{'Qoff'};
                   8475:                                     }
                   8476:                                 }
                   8477:                             }
                   8478:                         }
                   8479:                     }
                   8480:                 }
                   8481:             }
                   8482:         }
1.554     raeburn  8483:         foreach my $part_id (@{$partids}) {
1.542     raeburn  8484:             if ($recorded{$part_id} eq '') {
                   8485:                 for (my $i=0; $i<$expected{$part_id}; $i++) {
                   8486:                     for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) {
                   8487:                         $recorded{$part_id} .= $scantron_config->{'Qoff'};
                   8488:                     }
                   8489:                 }
                   8490:             }
                   8491:             $record .= $recorded{$part_id};
                   8492:         }
                   8493:     }
                   8494:     return ($counter,$record);
                   8495: }
                   8496: 
                   8497: sub letter_to_digits { 
                   8498:     my %lettdig = (
                   8499:                     A => 1,
                   8500:                     B => 2,
                   8501:                     C => 3,
                   8502:                     D => 4,
                   8503:                     E => 5,
                   8504:                     F => 6,
                   8505:                     G => 7,
                   8506:                     H => 8,
                   8507:                     I => 9,
                   8508:                     J => 0,
                   8509:                   );
                   8510:     return %lettdig;
                   8511: }
                   8512: 
1.423     albertel 8513: 
1.75      albertel 8514: #-------- end of section for handling grading scantron forms -------
                   8515: #
                   8516: #-------------------------------------------------------------------
                   8517: 
1.72      ng       8518: #-------------------------- Menu interface -------------------------
                   8519: #
                   8520: #--- Show a Grading Menu button - Calls the next routine ---
                   8521: sub show_grading_menu_form {
1.324     albertel 8522:     my ($symb)=@_;
1.125     ng       8523:     my $result.='<br /><form action="/adm/grades" method="post">'."\n".
1.418     albertel 8524: 	'<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 8525: 	'<input type="hidden" name="saveState"  value="'.$env{'form.saveState'}.'" />'."\n".
1.72      ng       8526: 	'<input type="hidden" name="command" value="gradingmenu" />'."\n".
1.478     albertel 8527: 	'<input type="submit" name="submit" value="'.&mt('Grading Menu').'" />'."\n".
1.72      ng       8528: 	'</form>'."\n";
                   8529:     return $result;
                   8530: }
                   8531: 
1.77      ng       8532: # -- Retrieve choices for grading form
                   8533: sub savedState {
                   8534:     my %savedState = ();
1.257     albertel 8535:     if ($env{'form.saveState'}) {
                   8536: 	foreach (split(/:/,$env{'form.saveState'})) {
1.77      ng       8537: 	    my ($key,$value) = split(/=/,$_,2);
                   8538: 	    $savedState{$key} = $value;
                   8539: 	}
                   8540:     }
                   8541:     return \%savedState;
                   8542: }
1.76      ng       8543: 
1.443     banghart 8544: sub grading_menu {
                   8545:     my ($request) = @_;
                   8546:     my ($symb)=&get_symb($request);
                   8547:     if (!$symb) {return '';}
                   8548:     my $probTitle = &Apache::lonnet::gettitle($symb);
                   8549:     my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
                   8550: 
1.444     banghart 8551:     $request->print($table);
1.443     banghart 8552:     my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb),
                   8553:                   'handgrade'=>$hdgrade,
                   8554:                   'probTitle'=>$probTitle,
                   8555:                   'command'=>'submit_options',
                   8556:                   'saveState'=>"",
                   8557:                   'gradingMenu'=>1,
                   8558:                   'showgrading'=>"yes");
1.538     schulted 8559:     
                   8560:     my $url1 = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   8561:     
1.443     banghart 8562:     $fields{'command'} = 'csvform';
1.538     schulted 8563:     my $url2 = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   8564:     
1.443     banghart 8565:     $fields{'command'} = 'processclicker';
1.538     schulted 8566:     my $url3 = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   8567:     
1.443     banghart 8568:     $fields{'command'} = 'scantron_selectphase';
1.538     schulted 8569:     my $url4 = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   8570:     
                   8571:     my @menu = ({	categorytitle=>'Course Grading',
                   8572:             items =>[
                   8573:                         {	linktext => 'Manual Grading/View Submissions',
                   8574:                     		url => $url1,
                   8575:                     		permission => 'F',
                   8576:                     		icon => 'edit-find-replace.png',
                   8577:                     		linktitle => 'Start the process of hand grading submissions.'
                   8578:                         },
                   8579:                 	    {	linktext => 'Upload Scores',
                   8580:                     		url => $url2,
                   8581:                     		permission => 'F',
                   8582:                     		icon => 'uploadscores.png',
                   8583:                     		linktitle => 'Specify a file containing the class scores for current resource.'
                   8584:                 	    },
                   8585:                 	    {	linktext => 'Process Clicker',
                   8586:                     		url => $url3,
                   8587:                     		permission => 'F',
                   8588:                     		icon => 'addClickerInfoFile.png',
                   8589:                     		linktitle => 'Specify a file containing the clicker information for this resource.'
                   8590:                 	    },
1.587     raeburn  8591:                 	    {	linktext => 'Grade/Manage/Review Bubblesheets',
1.538     schulted 8592:                     		url => $url4,
                   8593:                     		permission => 'F',
                   8594:                     		icon => 'stat.png',
                   8595:                     		linktitle => 'Grade scantron exams, upload/download scantron data files, and review previously graded scantron exams.'
                   8596:                 	    }
                   8597:                     ]
                   8598:             });
                   8599: 
                   8600:     #$fields{'command'} = 'verify';
                   8601:     #$url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
1.443     banghart 8602:     #
                   8603:     # Create the menu
                   8604:     my $Str;
1.444     banghart 8605:     # $Str .= '<h2>'.&mt('Please select a grading task').'</h2>';
1.445     banghart 8606:     $Str .= '<form method="post" action="" name="gradingMenu">';
                   8607:     $Str .= '<input type="hidden" name="command" value="" />'.
                   8608:     	'<input type="hidden" name="symb"        value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
                   8609: 	'<input type="hidden" name="handgrade"   value="'.$hdgrade.'" />'."\n".
1.476     albertel 8610: 	'<input type="hidden" name="probTitle"   value="'.$probTitle.'" />'."\n".
1.445     banghart 8611: 	'<input type="hidden" name="saveState"   value="" />'."\n".
                   8612: 	'<input type="hidden" name="gradingMenu" value="1" />'."\n".
                   8613: 	'<input type="hidden" name="showgrading" value="yes" />'."\n";
                   8614: 
1.538     schulted 8615:     $Str .= Apache::lonhtmlcommon::generate_menu(@menu);
                   8616:     #$menudata->{'jscript'}
1.584     bisitz   8617:     $Str .='<hr /><input type="button" value="'.&mt('Verify Receipt No.').'" '.
1.589     bisitz   8618:         ' onclick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '.
1.538     schulted 8619:         ' /> '.
                   8620:         &Apache::lonnet::recprefix($env{'request.course.id'}).
1.589     bisitz   8621:         '-<input type="text" name="receipt" size="4" onchange="javascript:checkReceiptNo(this.form,\'OK\')" />';
1.538     schulted 8622: 
1.444     banghart 8623:     $Str .="</form>\n";
1.539     riegler  8624:     my $receiptalert = &mt("Please enter a receipt number given by a student in the receipt box.");
1.443     banghart 8625:     $request->print(<<GRADINGMENUJS);
                   8626: <script type="text/javascript" language="javascript">
                   8627:     function checkChoice(formname,val,cmdx) {
                   8628: 	if (val <= 2) {
                   8629: 	    var cmd = radioSelection(formname.radioChoice);
                   8630: 	    var cmdsave = cmd;
                   8631: 	} else {
                   8632: 	    cmd = cmdx;
                   8633: 	    cmdsave = 'submission';
                   8634: 	}
                   8635: 	formname.command.value = cmd;
                   8636: 	if (val < 5) formname.submit();
                   8637: 	if (val == 5) {
1.458     banghart 8638: 	    if (!checkReceiptNo(formname,'notOK')) { 
                   8639: 	        return false;
                   8640: 	    } else {
                   8641: 	        formname.submit();
                   8642: 	    }
1.445     banghart 8643: 	}
                   8644:     }
1.443     banghart 8645: 
                   8646:     function checkReceiptNo(formname,nospace) {
                   8647: 	var receiptNo = formname.receipt.value;
                   8648: 	var checkOpt = false;
                   8649: 	if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;}
                   8650: 	if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;}
                   8651: 	if (checkOpt) {
1.539     riegler  8652: 	    alert("$receiptalert");
1.443     banghart 8653: 	    formname.receipt.value = "";
                   8654: 	    formname.receipt.focus();
                   8655: 	    return false;
                   8656: 	}
                   8657: 	return true;
                   8658:     }
                   8659: </script>
                   8660: GRADINGMENUJS
                   8661:     &commonJSfunctions($request);
                   8662:     return $Str;    
                   8663: }
                   8664: 
                   8665: 
                   8666: #--- Displays the submissions first page -------
                   8667: sub submit_options {
1.72      ng       8668:     my ($request) = @_;
1.324     albertel 8669:     my ($symb)=&get_symb($request);
1.72      ng       8670:     if (!$symb) {return '';}
1.76      ng       8671:     my $probTitle = &Apache::lonnet::gettitle($symb);
1.72      ng       8672: 
1.539     riegler  8673:     my $receiptalert = &mt("Please enter a receipt number given by a student in the receipt box."); 
1.72      ng       8674:     $request->print(<<GRADINGMENUJS);
                   8675: <script type="text/javascript" language="javascript">
1.116     ng       8676:     function checkChoice(formname,val,cmdx) {
                   8677: 	if (val <= 2) {
                   8678: 	    var cmd = radioSelection(formname.radioChoice);
1.118     ng       8679: 	    var cmdsave = cmd;
1.116     ng       8680: 	} else {
                   8681: 	    cmd = cmdx;
1.118     ng       8682: 	    cmdsave = 'submission';
1.116     ng       8683: 	}
                   8684: 	formname.command.value = cmd;
1.118     ng       8685: 	formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+
1.145     albertel 8686: 	    ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);
1.116     ng       8687: 	if (val < 5) formname.submit();
                   8688: 	if (val == 5) {
1.72      ng       8689: 	    if (!checkReceiptNo(formname,'notOK')) { return false;}
                   8690: 	    formname.submit();
                   8691: 	}
1.238     albertel 8692: 	if (val < 7) formname.submit();
1.72      ng       8693:     }
                   8694: 
                   8695:     function checkReceiptNo(formname,nospace) {
                   8696: 	var receiptNo = formname.receipt.value;
                   8697: 	var checkOpt = false;
                   8698: 	if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;}
                   8699: 	if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;}
                   8700: 	if (checkOpt) {
1.539     riegler  8701: 	    alert("$receiptalert");
1.72      ng       8702: 	    formname.receipt.value = "";
                   8703: 	    formname.receipt.focus();
                   8704: 	    return false;
                   8705: 	}
                   8706: 	return true;
                   8707:     }
                   8708: </script>
                   8709: GRADINGMENUJS
1.118     ng       8710:     &commonJSfunctions($request);
1.324     albertel 8711:     my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
1.473     albertel 8712:     my $result;
1.76      ng       8713:     my (undef,$sections) = &getclasslist('all','0');
1.77      ng       8714:     my $savedState = &savedState();
1.118     ng       8715:     my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'});
1.77      ng       8716:     my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'});
1.118     ng       8717:     my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'});
1.77      ng       8718:     my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
1.72      ng       8719: 
1.533     bisitz   8720:     # Preselect sections
                   8721:     my $selsec="";
                   8722:     if (ref($sections)) {
                   8723:         foreach my $section (sort(@$sections)) {
                   8724:             $selsec.='<option value="'.$section.'" '.
                   8725:                 ($saveSec eq $section ? 'selected="selected"':'').'>'.$section.'</option>'."\n";
                   8726:         }
                   8727:     }
                   8728: 
1.72      ng       8729:     $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n".
1.418     albertel 8730: 	'<input type="hidden" name="symb"        value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.72      ng       8731: 	'<input type="hidden" name="handgrade"   value="'.$hdgrade.'" />'."\n".
                   8732: 	'<input type="hidden" name="probTitle"   value="'.$probTitle.'" />'."\n".
1.116     ng       8733: 	'<input type="hidden" name="command"     value="" />'."\n".
1.77      ng       8734: 	'<input type="hidden" name="saveState"   value="" />'."\n".
1.124     ng       8735: 	'<input type="hidden" name="gradingMenu" value="1" />'."\n".
1.72      ng       8736: 	'<input type="hidden" name="showgrading" value="yes" />'."\n";
                   8737: 
1.472     albertel 8738:     $result.='
1.533     bisitz   8739: <h2>
                   8740:   '.&mt('Grade Current Resource').'
                   8741: </h2>
                   8742: <div>
                   8743:   '.$table.'
                   8744: </div>
                   8745: 
1.537     harmsja  8746: <div class="LC_columnSection">
                   8747:   
1.533     bisitz   8748:     <fieldset>
                   8749:       <legend>
                   8750:        '.&mt('Sections').'
                   8751:       </legend>
                   8752:       <select name="section" multiple="multiple" size="5">'."\n";
                   8753:     $result.= $selsec;
1.401     albertel 8754:     $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="selected"' : ''). '>all</option></select> &nbsp; ';
1.472     albertel 8755:     $result.='
1.533     bisitz   8756:     </fieldset>
1.537     harmsja  8757:   
1.533     bisitz   8758:     <fieldset>
                   8759:       <legend>
                   8760:         '.&mt('Groups').'
                   8761:       </legend>
                   8762:       '.&Apache::lonstatistics::GroupSelect('group','multiple',5).'
                   8763:     </fieldset>
1.537     harmsja  8764:   
1.533     bisitz   8765:     <fieldset>
                   8766:       <legend>
                   8767:         '.&mt('Access Status').'
                   8768:       </legend>
                   8769:       '.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,5,undef,'mult').'
                   8770:     </fieldset>
1.537     harmsja  8771:   
1.533     bisitz   8772:     <fieldset>
                   8773:       <legend>
                   8774:         '.&mt('Submission Status').'
                   8775:       </legend>
                   8776:       <select name="submitonly" size="5">
1.473     albertel 8777: 	         <option value="yes" '.      ($saveSub eq 'yes'       ? 'selected="selected"' : '').'>'.&mt('with submissions').'</option>
                   8778: 	         <option value="queued" '.   ($saveSub eq 'queued'    ? 'selected="selected"' : '').'>'.&mt('in grading queue').'</option>
                   8779: 	         <option value="graded" '.   ($saveSub eq 'graded'    ? 'selected="selected"' : '').'>'.&mt('with ungraded submissions').'</option>
                   8780: 	         <option value="incorrect" '.($saveSub eq 'incorrect' ? 'selected="selected"' : '').'>'.&mt('with incorrect submissions').'</option>
                   8781:                  <option value="all" '.      ($saveSub eq 'all'       ? 'selected="selected"' : '').'>'.&mt('with any status').'</option>
1.533     bisitz   8782:       </select>
                   8783:     </fieldset>
1.537     harmsja  8784:   
1.533     bisitz   8785: </div>
                   8786: 
                   8787: <br />
                   8788:           <div>
                   8789:             <div>
1.473     albertel 8790:               <label>
                   8791:                 <input type="radio" name="radioChoice" value="submission" '.
                   8792:                   ($saveCmd eq 'submission' ? 'checked="checked"' : '').' /> '.
                   8793:              &mt('Select individual students to grade and view submissions.').'
                   8794: 	      </label> 
                   8795:             </div>
1.533     bisitz   8796:             <div>
1.473     albertel 8797: 	      <label>
                   8798:                 <input type="radio" name="radioChoice" value="viewgrades" '.
                   8799:                   ($saveCmd eq 'viewgrades' ? 'checked="checked"' : '').' /> '.
                   8800:                     &mt('Grade all selected students in a grading table.').'
                   8801:               </label>
                   8802:             </div>
1.533     bisitz   8803:             <div>
1.589     bisitz   8804: 	      <input type="button" onclick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next').' &rarr;" />
1.473     albertel 8805:             </div>
1.472     albertel 8806:           </div>
1.533     bisitz   8807: 
                   8808: 
1.473     albertel 8809:         <h2>
                   8810:          '.&mt('Grade Complete Folder for One Student').'
                   8811:         </h2>
1.533     bisitz   8812:         <div>
                   8813:             <div>
1.473     albertel 8814:               <label>
                   8815:                 <input type="radio" name="radioChoice" value="pickStudentPage" '.
                   8816: 	  ($saveCmd eq 'pickStudentPage' ? 'checked="checked"' : '').' /> '.
                   8817:   &mt('The <b>complete</b> page/sequence/folder: For one student').'
                   8818:               </label>
                   8819:             </div>
1.533     bisitz   8820:             <div>
1.589     bisitz   8821: 	      <input type="button" onclick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next').' &rarr;" />
1.473     albertel 8822:             </div>
1.472     albertel 8823:         </div>
                   8824:   </form>';
1.499     albertel 8825:     $result .= &show_grading_menu_form($symb);
1.44      ng       8826:     return $result;
1.2       albertel 8827: }
                   8828: 
1.285     albertel 8829: sub reset_perm {
                   8830:     undef(%perm);
                   8831: }
                   8832: 
                   8833: sub init_perm {
                   8834:     &reset_perm();
1.300     albertel 8835:     foreach my $test_perm ('vgr','mgr','opa') {
                   8836: 
                   8837: 	my $scope = $env{'request.course.id'};
                   8838: 	if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) {
                   8839: 
                   8840: 	    $scope .= '/'.$env{'request.course.sec'};
                   8841: 	    if ( $perm{$test_perm}=
                   8842: 		 &Apache::lonnet::allowed($test_perm,$scope)) {
                   8843: 		$perm{$test_perm.'_section'}=$env{'request.course.sec'};
                   8844: 	    } else {
                   8845: 		delete($perm{$test_perm});
                   8846: 	    }
1.285     albertel 8847: 	}
                   8848:     }
                   8849: }
                   8850: 
1.400     www      8851: sub gather_clicker_ids {
1.408     albertel 8852:     my %clicker_ids;
1.400     www      8853: 
                   8854:     my $classlist = &Apache::loncoursedata::get_classlist();
                   8855: 
                   8856:     # Set up a couple variables.
1.407     albertel 8857:     my $username_idx = &Apache::loncoursedata::CL_SNAME();
                   8858:     my $domain_idx   = &Apache::loncoursedata::CL_SDOM();
1.438     www      8859:     my $status_idx   = &Apache::loncoursedata::CL_STATUS();
1.400     www      8860: 
1.407     albertel 8861:     foreach my $student (keys(%$classlist)) {
1.438     www      8862:         if ($classlist->{$student}->[$status_idx] ne 'Active') { next; }
1.407     albertel 8863:         my $username = $classlist->{$student}->[$username_idx];
                   8864:         my $domain   = $classlist->{$student}->[$domain_idx];
1.400     www      8865:         my $clickers =
1.408     albertel 8866: 	    (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1];
1.400     www      8867:         foreach my $id (split(/\,/,$clickers)) {
1.414     www      8868:             $id=~s/^[\#0]+//;
1.421     www      8869:             $id=~s/[\-\:]//g;
1.407     albertel 8870:             if (exists($clicker_ids{$id})) {
1.408     albertel 8871: 		$clicker_ids{$id}.=','.$username.':'.$domain;
1.400     www      8872:             } else {
1.408     albertel 8873: 		$clicker_ids{$id}=$username.':'.$domain;
1.400     www      8874:             }
                   8875:         }
                   8876:     }
1.407     albertel 8877:     return %clicker_ids;
1.400     www      8878: }
                   8879: 
1.402     www      8880: sub gather_adv_clicker_ids {
1.408     albertel 8881:     my %clicker_ids;
1.402     www      8882:     my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
                   8883:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   8884:     my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum);
1.409     albertel 8885:     foreach my $element (sort(keys(%coursepersonnel))) {
1.402     www      8886:         foreach my $person (split(/\,/,$coursepersonnel{$element})) {
                   8887:             my ($puname,$pudom)=split(/\:/,$person);
                   8888:             my $clickers =
1.408     albertel 8889: 		(&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
1.405     www      8890:             foreach my $id (split(/\,/,$clickers)) {
1.414     www      8891: 		$id=~s/^[\#0]+//;
1.421     www      8892:                 $id=~s/[\-\:]//g;
1.408     albertel 8893: 		if (exists($clicker_ids{$id})) {
                   8894: 		    $clicker_ids{$id}.=','.$puname.':'.$pudom;
                   8895: 		} else {
                   8896: 		    $clicker_ids{$id}=$puname.':'.$pudom;
                   8897: 		}
1.405     www      8898:             }
1.402     www      8899:         }
                   8900:     }
1.407     albertel 8901:     return %clicker_ids;
1.402     www      8902: }
                   8903: 
1.413     www      8904: sub clicker_grading_parameters {
                   8905:     return ('gradingmechanism' => 'scalar',
                   8906:             'upfiletype' => 'scalar',
                   8907:             'specificid' => 'scalar',
                   8908:             'pcorrect' => 'scalar',
                   8909:             'pincorrect' => 'scalar');
                   8910: }
                   8911: 
1.400     www      8912: sub process_clicker {
                   8913:     my ($r)=@_;
                   8914:     my ($symb)=&get_symb($r);
                   8915:     if (!$symb) {return '';}
                   8916:     my $result=&checkforfile_js();
                   8917:     $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
                   8918:     my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
                   8919:     $result.=$table;
                   8920:     $result.='<br /><table width="100%" border="0"><tr><td bgcolor="#777777">'."\n";
                   8921:     $result.='<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>'."\n";
1.538     schulted 8922:     $result.='&nbsp;<b>'.&mt('Specify a file containing the clicker information for this resource.').
                   8923:         '</b></td></tr>'."\n";
1.400     www      8924:     $result.='<tr bgcolor=#ffffe6><td>'."\n";
1.413     www      8925: # Attempt to restore parameters from last session, set defaults if not present
                   8926:     my %Saveable_Parameters=&clicker_grading_parameters();
                   8927:     &Apache::loncommon::restore_course_settings('grades_clicker',
                   8928:                                                  \%Saveable_Parameters);
                   8929:     if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; }
                   8930:     if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; }
                   8931:     if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; }
                   8932:     if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
                   8933: 
                   8934:     my %checked;
1.521     www      8935:     foreach my $gradingmechanism ('attendance','personnel','specific','given') {
1.413     www      8936:        if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
1.569     bisitz   8937:           $checked{$gradingmechanism}=' checked="checked"';
1.413     www      8938:        }
                   8939:     }
                   8940: 
1.400     www      8941:     my $upload=&mt("Upload File");
                   8942:     my $type=&mt("Type");
1.402     www      8943:     my $attendance=&mt("Award points just for participation");
                   8944:     my $personnel=&mt("Correctness determined from response by course personnel");
1.414     www      8945:     my $specific=&mt("Correctness determined from response with clicker ID(s)"); 
1.521     www      8946:     my $given=&mt("Correctness determined from given list of answers").' '.
                   8947:               '<font size="-2"><tt>('.&mt("Provide comma-separated list. Use '*' for any answer correct, '-' for skip").')</tt></font>';
1.402     www      8948:     my $pcorrect=&mt("Percentage points for correct solution");
                   8949:     my $pincorrect=&mt("Percentage points for incorrect solution");
1.413     www      8950:     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
1.596.2.1! raeburn  8951:                                                    {'iclicker' => 'i>clicker',
        !          8952:                                                     'interwrite' => 'interwrite PRS'});
1.418     albertel 8953:     $symb = &Apache::lonenc::check_encrypt($symb);
1.400     www      8954:     $result.=<<ENDUPFORM;
1.402     www      8955: <script type="text/javascript">
                   8956: function sanitycheck() {
                   8957: // Accept only integer percentages
                   8958:    document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value);
                   8959:    document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value);
                   8960: // Find out grading choice
                   8961:    for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) {
                   8962:       if (document.forms.gradesupload.gradingmechanism[i].checked) {
                   8963:          gradingchoice=document.forms.gradesupload.gradingmechanism[i].value;
                   8964:       }
                   8965:    }
                   8966: // By default, new choice equals user selection
                   8967:    newgradingchoice=gradingchoice;
                   8968: // Not good to give more points for false answers than correct ones
                   8969:    if (Math.round(document.forms.gradesupload.pcorrect.value)<Math.round(document.forms.gradesupload.pincorrect.value)) {
                   8970:       document.forms.gradesupload.pcorrect.value=document.forms.gradesupload.pincorrect.value;
                   8971:    }
                   8972: // If new choice is attendance only, and old choice was correctness-based, restore defaults
                   8973:    if ((gradingchoice=='attendance') && (document.forms.gradesupload.waschecked.value!='attendance')) {
                   8974:       document.forms.gradesupload.pcorrect.value=100;
                   8975:       document.forms.gradesupload.pincorrect.value=100;
                   8976:    }
                   8977: // If the values are different, cannot be attendance only
                   8978:    if ((Math.round(document.forms.gradesupload.pcorrect.value)!=Math.round(document.forms.gradesupload.pincorrect.value)) &&
                   8979:        (gradingchoice=='attendance')) {
                   8980:        newgradingchoice='personnel';
                   8981:    }
                   8982: // Change grading choice to new one
                   8983:    for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) {
                   8984:       if (document.forms.gradesupload.gradingmechanism[i].value==newgradingchoice) {
                   8985:          document.forms.gradesupload.gradingmechanism[i].checked=true;
                   8986:       } else {
                   8987:          document.forms.gradesupload.gradingmechanism[i].checked=false;
                   8988:       }
                   8989:    }
                   8990: // Remember the old state
                   8991:    document.forms.gradesupload.waschecked.value=newgradingchoice;
                   8992: }
                   8993: </script>
1.400     www      8994: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
                   8995: <input type="hidden" name="symb" value="$symb" />
                   8996: <input type="hidden" name="command" value="processclickerfile" />
                   8997: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   8998: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
                   8999: <input type="file" name="upfile" size="50" />
                   9000: <br /><label>$type: $selectform</label>
1.589     bisitz   9001: <br /><label><input type="radio" name="gradingmechanism" value="attendance"$checked{'attendance'} onclick="sanitycheck()" />$attendance </label>
                   9002: <br /><label><input type="radio" name="gradingmechanism" value="personnel"$checked{'personnel'} onclick="sanitycheck()" />$personnel</label>
                   9003: <br /><label><input type="radio" name="gradingmechanism" value="specific"$checked{'specific'} onclick="sanitycheck()" />$specific </label>
1.414     www      9004: <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" />
1.589     bisitz   9005: <br /><label><input type="radio" name="gradingmechanism" value="given"$checked{'given'} onclick="sanitycheck()" />$given </label>
1.521     www      9006: <br />&nbsp;&nbsp;&nbsp;
                   9007: <input type="text" name="givenanswer" size="50" />
1.413     www      9008: <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" />
1.589     bisitz   9009: <br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onchange="sanitycheck()" /></label>
                   9010: <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onchange="sanitycheck()" /></label>
                   9011: <br /><input type="button" onclick="javascript:checkUpload(this.form);" value="$upload" />
1.400     www      9012: </form>
                   9013: ENDUPFORM
                   9014:     $result.='</td></tr></table>'."\n".
                   9015:              '</td></tr></table><br /><br />'."\n";
                   9016:     $result.=&show_grading_menu_form($symb);
                   9017:     return $result;
                   9018: }
                   9019: 
                   9020: sub process_clicker_file {
                   9021:     my ($r)=@_;
                   9022:     my ($symb)=&get_symb($r);
                   9023:     if (!$symb) {return '';}
1.413     www      9024: 
                   9025:     my %Saveable_Parameters=&clicker_grading_parameters();
                   9026:     &Apache::loncommon::store_course_settings('grades_clicker',
                   9027:                                               \%Saveable_Parameters);
                   9028: 
1.400     www      9029:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.404     www      9030:     if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) {
1.408     albertel 9031: 	$result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';
                   9032: 	return $result.&show_grading_menu_form($symb);
1.404     www      9033:     }
1.522     www      9034:     if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\S/)) {
1.521     www      9035:         $result.='<span class="LC_error">'.&mt('You need to specify the correct answer').'</span>';
                   9036:         return $result.&show_grading_menu_form($symb);
                   9037:     }
1.522     www      9038:     my $foundgiven=0;
1.521     www      9039:     if ($env{'form.gradingmechanism'} eq 'given') {
                   9040:         $env{'form.givenanswer'}=~s/^\s*//gs;
                   9041:         $env{'form.givenanswer'}=~s/\s*$//gs;
                   9042:         $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-]+/\,/g;
                   9043:         $env{'form.givenanswer'}=uc($env{'form.givenanswer'});
1.522     www      9044:         my @answers=split(/\,/,$env{'form.givenanswer'});
                   9045:         $foundgiven=$#answers+1;
1.521     www      9046:     }
1.407     albertel 9047:     my %clicker_ids=&gather_clicker_ids();
1.408     albertel 9048:     my %correct_ids;
1.404     www      9049:     if ($env{'form.gradingmechanism'} eq 'personnel') {
1.408     albertel 9050: 	%correct_ids=&gather_adv_clicker_ids();
1.404     www      9051:     }
                   9052:     if ($env{'form.gradingmechanism'} eq 'specific') {
1.414     www      9053: 	foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {;
                   9054: 	   $correct_id=~tr/a-z/A-Z/;
                   9055: 	   $correct_id=~s/\s//gs;
                   9056: 	   $correct_id=~s/^[\#0]+//;
1.421     www      9057:            $correct_id=~s/[\-\:]//g;
1.414     www      9058:            if ($correct_id) {
                   9059: 	      $correct_ids{$correct_id}='specified';
                   9060:            }
                   9061:         }
1.400     www      9062:     }
1.404     www      9063:     if ($env{'form.gradingmechanism'} eq 'attendance') {
1.408     albertel 9064: 	$result.=&mt('Score based on attendance only');
1.521     www      9065:     } elsif ($env{'form.gradingmechanism'} eq 'given') {
1.522     www      9066:         $result.=&mt('Score based on [_1] ([_2] answers)','<tt>'.$env{'form.givenanswer'}.'</tt>',$foundgiven);
1.404     www      9067:     } else {
1.408     albertel 9068: 	my $number=0;
1.411     www      9069: 	$result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>';
1.408     albertel 9070: 	foreach my $id (sort(keys(%correct_ids))) {
1.411     www      9071: 	    $result.='<br /><tt>'.$id.'</tt> - ';
1.408     albertel 9072: 	    if ($correct_ids{$id} eq 'specified') {
                   9073: 		$result.=&mt('specified');
                   9074: 	    } else {
                   9075: 		my ($uname,$udom)=split(/\:/,$correct_ids{$id});
                   9076: 		$result.=&Apache::loncommon::plainname($uname,$udom);
                   9077: 	    }
                   9078: 	    $number++;
                   9079: 	}
1.411     www      9080:         $result.="</p>\n";
1.408     albertel 9081: 	if ($number==0) {
                   9082: 	    $result.='<span class="LC_error">'.&mt('No IDs found to determine correct answer').'</span>';
                   9083: 	    return $result.&show_grading_menu_form($symb);
                   9084: 	}
1.404     www      9085:     }
1.405     www      9086:     if (length($env{'form.upfile'}) < 2) {
1.407     albertel 9087:         $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.',
                   9088: 		     '<span class="LC_error">',
                   9089: 		     '</span>',
                   9090: 		     '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>');
1.405     www      9091:         return $result.&show_grading_menu_form($symb);
                   9092:     }
1.410     www      9093: 
                   9094: # Were able to get all the info needed, now analyze the file
                   9095: 
1.411     www      9096:     $result.=&Apache::loncommon::studentbrowser_javascript();
1.418     albertel 9097:     $symb = &Apache::lonenc::check_encrypt($symb);
1.410     www      9098:     my $heading=&mt('Scanning clicker file');
                   9099:     $result.=(<<ENDHEADER);
                   9100: <br /><table width="100%" border="0"><tr><td bgcolor="#777777">
                   9101: <table width="100%" border="0"><tr bgcolor="#e6ffff"><td>
                   9102: <b>$heading</b></td></tr><tr bgcolor=#ffffe6><td>
                   9103: <form method="post" action="/adm/grades" name="clickeranalysis">
                   9104: <input type="hidden" name="symb" value="$symb" />
                   9105: <input type="hidden" name="command" value="assignclickergrades" />
                   9106: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   9107: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
1.411     www      9108: <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" />
                   9109: <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" />
                   9110: <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" />
1.410     www      9111: ENDHEADER
1.522     www      9112:     if ($env{'form.gradingmechanism'} eq 'given') {
                   9113:        $result.='<input type="hidden" name="correct:given" value="'.$env{'form.givenanswer'}.'" />';
                   9114:     } 
1.408     albertel 9115:     my %responses;
                   9116:     my @questiontitles;
1.405     www      9117:     my $errormsg='';
                   9118:     my $number=0;
                   9119:     if ($env{'form.upfiletype'} eq 'iclicker') {
1.408     albertel 9120: 	($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
1.406     www      9121:     }
1.419     www      9122:     if ($env{'form.upfiletype'} eq 'interwrite') {
                   9123:         ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
                   9124:     }
1.411     www      9125:     $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.
                   9126:              '<input type="hidden" name="number" value="'.$number.'" />'.
                   9127:              &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
                   9128:                  $env{'form.pcorrect'},$env{'form.pincorrect'}).
                   9129:              '<br />';
1.522     www      9130:     if (($env{'form.gradingmechanism'} eq 'given') && ($number!=$foundgiven)) {
                   9131:        $result.='<span class="LC_error">'.&mt('Number of given answers does not agree with number of questions in file.').'</span>';
                   9132:        return $result.&show_grading_menu_form($symb);
                   9133:     } 
1.414     www      9134: # Remember Question Titles
                   9135: # FIXME: Possibly need delimiter other than ":"
                   9136:     for (my $i=0;$i<$number;$i++) {
                   9137:         $result.='<input type="hidden" name="question:'.$i.'" value="'.
                   9138:                  &HTML::Entities::encode($questiontitles[$i],'"&<>').'" />';
                   9139:     }
1.411     www      9140:     my $correct_count=0;
                   9141:     my $student_count=0;
                   9142:     my $unknown_count=0;
1.414     www      9143: # Match answers with usernames
                   9144: # FIXME: Possibly need delimiter other than ":"
1.409     albertel 9145:     foreach my $id (keys(%responses)) {
1.410     www      9146:        if ($correct_ids{$id}) {
1.414     www      9147:           $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />';
1.411     www      9148:           $correct_count++;
1.410     www      9149:        } elsif ($clicker_ids{$id}) {
1.437     www      9150:           if ($clicker_ids{$id}=~/\,/) {
                   9151: # More than one user with the same clicker!
                   9152:              $result.="\n<hr />".&mt('Clicker registered more than once').": <tt>".$id."</tt><br />";
                   9153:              $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
                   9154:                            "<select name='multi".$id."'>";
                   9155:              foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) {
                   9156:                  $result.="<option value='".$reguser."'>".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.')</option>';
                   9157:              }
                   9158:              $result.='</select>';
                   9159:              $unknown_count++;
                   9160:           } else {
                   9161: # Good: found one and only one user with the right clicker
                   9162:              $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />';
                   9163:              $student_count++;
                   9164:           }
1.410     www      9165:        } else {
1.411     www      9166:           $result.="\n<hr />".&mt('Unregistered Clicker')." <tt>".$id."</tt><br />";
                   9167:           $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
                   9168:                    "\n".&mt("Username").": <input type='text' name='uname".$id."' />&nbsp;".
                   9169:                    "\n".&mt("Domain").": ".
                   9170:                    &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).'&nbsp;'.
                   9171:                    &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id);
                   9172:           $unknown_count++;
1.410     www      9173:        }
1.405     www      9174:     }
1.412     www      9175:     $result.='<hr />'.
                   9176:              &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
1.521     www      9177:     if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) {
1.412     www      9178:        if ($correct_count==0) {
                   9179:           $errormsg.="Found no correct answers answers for grading!";
                   9180:        } elsif ($correct_count>1) {
1.414     www      9181:           $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>';
1.412     www      9182:        }
                   9183:     }
1.428     www      9184:     if ($number<1) {
                   9185:        $errormsg.="Found no questions.";
                   9186:     }
1.412     www      9187:     if ($errormsg) {
                   9188:        $result.='<br /><span class="LC_error">'.&mt($errormsg).'</span>';
                   9189:     } else {
                   9190:        $result.='<br /><input type="submit" name="finalize" value="'.&mt('Finalize Grading').'" />';
                   9191:     }
                   9192:     $result.='</form></td></tr></table>'."\n".
1.410     www      9193:              '</td></tr></table><br /><br />'."\n";
1.404     www      9194:     return $result.&show_grading_menu_form($symb);
1.400     www      9195: }
                   9196: 
1.405     www      9197: sub iclicker_eval {
1.406     www      9198:     my ($questiontitles,$responses)=@_;
1.405     www      9199:     my $number=0;
                   9200:     my $errormsg='';
                   9201:     foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
1.410     www      9202:         my %components=&Apache::loncommon::record_sep($line);
                   9203:         my @entries=map {$components{$_}} (sort(keys(%components)));
1.408     albertel 9204: 	if ($entries[0] eq 'Question') {
                   9205: 	    for (my $i=3;$i<$#entries;$i+=6) {
                   9206: 		$$questiontitles[$number]=$entries[$i];
                   9207: 		$number++;
                   9208: 	    }
                   9209: 	}
                   9210: 	if ($entries[0]=~/^\#/) {
                   9211: 	    my $id=$entries[0];
                   9212: 	    my @idresponses;
                   9213: 	    $id=~s/^[\#0]+//;
                   9214: 	    for (my $i=0;$i<$number;$i++) {
                   9215: 		my $idx=3+$i*6;
                   9216: 		push(@idresponses,$entries[$idx]);
                   9217: 	    }
                   9218: 	    $$responses{$id}=join(',',@idresponses);
                   9219: 	}
1.405     www      9220:     }
                   9221:     return ($errormsg,$number);
                   9222: }
                   9223: 
1.419     www      9224: sub interwrite_eval {
                   9225:     my ($questiontitles,$responses)=@_;
                   9226:     my $number=0;
                   9227:     my $errormsg='';
1.420     www      9228:     my $skipline=1;
                   9229:     my $questionnumber=0;
                   9230:     my %idresponses=();
1.419     www      9231:     foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
                   9232:         my %components=&Apache::loncommon::record_sep($line);
                   9233:         my @entries=map {$components{$_}} (sort(keys(%components)));
1.420     www      9234:         if ($entries[1] eq 'Time') { $skipline=0; next; }
                   9235:         if ($entries[1] eq 'Response') { $skipline=1; }
                   9236:         next if $skipline;
                   9237:         if ($entries[0]!=$questionnumber) {
                   9238:            $questionnumber=$entries[0];
                   9239:            $$questiontitles[$number]=&mt('Question [_1]',$questionnumber);
                   9240:            $number++;
1.419     www      9241:         }
1.420     www      9242:         my $id=$entries[4];
                   9243:         $id=~s/^[\#0]+//;
1.421     www      9244:         $id=~s/^v\d*\://i;
                   9245:         $id=~s/[\-\:]//g;
1.420     www      9246:         $idresponses{$id}[$number]=$entries[6];
                   9247:     }
1.524     raeburn  9248:     foreach my $id (keys(%idresponses)) {
1.420     www      9249:        $$responses{$id}=join(',',@{$idresponses{$id}});
                   9250:        $$responses{$id}=~s/^\s*\,//;
1.419     www      9251:     }
                   9252:     return ($errormsg,$number);
                   9253: }
                   9254: 
1.414     www      9255: sub assign_clicker_grades {
                   9256:     my ($r)=@_;
                   9257:     my ($symb)=&get_symb($r);
                   9258:     if (!$symb) {return '';}
1.416     www      9259: # See which part we are saving to
1.582     raeburn  9260:     my $res_error;
                   9261:     my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error);
                   9262:     if ($res_error) {
                   9263:         return &navmap_errormsg();
                   9264:     }
1.416     www      9265: # FIXME: This should probably look for the first handgradeable part
                   9266:     my $part=$$partlist[0];
                   9267: # Start screen output
1.414     www      9268:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.416     www      9269: 
1.414     www      9270:     my $heading=&mt('Assigning grades based on clicker file');
                   9271:     $result.=(<<ENDHEADER);
                   9272: <br /><table width="100%" border="0"><tr><td bgcolor="#777777">
                   9273: <table width="100%" border="0"><tr bgcolor="#e6ffff"><td>
                   9274: <b>$heading</b></td></tr><tr bgcolor=#ffffe6><td>
                   9275: ENDHEADER
                   9276: # Get correct result
                   9277: # FIXME: Possibly need delimiter other than ":"
                   9278:     my @correct=();
1.415     www      9279:     my $gradingmechanism=$env{'form.gradingmechanism'};
                   9280:     my $number=$env{'form.number'};
                   9281:     if ($gradingmechanism ne 'attendance') {
1.414     www      9282:        foreach my $key (keys(%env)) {
                   9283:           if ($key=~/^form\.correct\:/) {
                   9284:              my @input=split(/\,/,$env{$key});
                   9285:              for (my $i=0;$i<=$#input;$i++) {
                   9286:                  if (($correct[$i]) && ($input[$i]) &&
                   9287:                      ($correct[$i] ne $input[$i])) {
                   9288:                     $result.='<br /><span class="LC_warning">'.
                   9289:                              &mt('More than one correct result given for question "[_1]": [_2] versus [_3].',
                   9290:                                  $env{'form.question:'.$i},$correct[$i],$input[$i]).'</span>';
                   9291:                  } elsif ($input[$i]) {
                   9292:                     $correct[$i]=$input[$i];
                   9293:                  }
                   9294:              }
                   9295:           }
                   9296:        }
1.415     www      9297:        for (my $i=0;$i<$number;$i++) {
1.414     www      9298:           if (!$correct[$i]) {
                   9299:              $result.='<br /><span class="LC_error">'.
                   9300:                       &mt('No correct result given for question "[_1]"!',
                   9301:                           $env{'form.question:'.$i}).'</span>';
                   9302:           }
                   9303:        }
                   9304:        $result.='<br />'.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct));
                   9305:     }
                   9306: # Start grading
1.415     www      9307:     my $pcorrect=$env{'form.pcorrect'};
                   9308:     my $pincorrect=$env{'form.pincorrect'};
1.416     www      9309:     my $storecount=0;
1.415     www      9310:     foreach my $key (keys(%env)) {
1.420     www      9311:        my $user='';
1.415     www      9312:        if ($key=~/^form\.student\:(.*)$/) {
1.420     www      9313:           $user=$1;
                   9314:        }
                   9315:        if ($key=~/^form\.unknown\:(.*)$/) {
                   9316:           my $id=$1;
                   9317:           if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {
                   9318:              $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};
1.437     www      9319:           } elsif ($env{'form.multi'.$id}) {
                   9320:              $user=$env{'form.multi'.$id};
1.420     www      9321:           }
                   9322:        }
                   9323:        if ($user) { 
1.415     www      9324:           my @answer=split(/\,/,$env{$key});
                   9325:           my $sum=0;
1.522     www      9326:           my $realnumber=$number;
1.415     www      9327:           for (my $i=0;$i<$number;$i++) {
1.576     www      9328:              if  ($correct[$i] eq '-') {
                   9329:                 $realnumber--;
                   9330:              } elsif ($answer[$i]) {
1.415     www      9331:                 if ($gradingmechanism eq 'attendance') {
                   9332:                    $sum+=$pcorrect;
1.576     www      9333:                 } elsif ($correct[$i] eq '*') {
1.522     www      9334:                    $sum+=$pcorrect;
1.415     www      9335:                 } else {
                   9336:                    if ($answer[$i] eq $correct[$i]) {
                   9337:                       $sum+=$pcorrect;
                   9338:                    } else {
                   9339:                       $sum+=$pincorrect;
                   9340:                    }
                   9341:                 }
                   9342:              }
                   9343:           }
1.522     www      9344:           my $ave=$sum/(100*$realnumber);
1.416     www      9345: # Store
                   9346:           my ($username,$domain)=split(/\:/,$user);
                   9347:           my %grades=();
                   9348:           $grades{"resource.$part.solved"}='correct_by_override';
                   9349:           $grades{"resource.$part.awarded"}=$ave;
                   9350:           $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
                   9351:           my $returncode=&Apache::lonnet::cstore(\%grades,$symb,
                   9352:                                                  $env{'request.course.id'},
                   9353:                                                  $domain,$username);
                   9354:           if ($returncode ne 'ok') {
                   9355:              $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>";
                   9356:           } else {
                   9357:              $storecount++;
                   9358:           }
1.415     www      9359:        }
                   9360:     }
                   9361: # We are done
1.549     hauer    9362:     $result.='<br />'.&mt('Successfully stored grades for [quant,_1,student].',$storecount).
1.416     www      9363:              '</td></tr></table>'."\n".
1.414     www      9364:              '</td></tr></table><br /><br />'."\n";
                   9365:     return $result.&show_grading_menu_form($symb);
                   9366: }
                   9367: 
1.582     raeburn  9368: sub navmap_errormsg {
                   9369:     return '<div class="LC_error">'.
                   9370:            &mt('An error occurred retrieving information about resources in the course.').'<br />'.
1.595     raeburn  9371:            &mt('It is recommended that you [_1]re-initialize the course[_2] and then return to this grading page.','<a href="/adm/roles?selectrole=1&newrole='.$env{'request.role'}.'">','</a>').
1.582     raeburn  9372:            '</div>';
                   9373: }
                   9374: 
1.1       albertel 9375: sub handler {
1.41      ng       9376:     my $request=$_[0];
1.434     albertel 9377:     &reset_caches();
1.257     albertel 9378:     if ($env{'browser.mathml'}) {
1.141     www      9379: 	&Apache::loncommon::content_type($request,'text/xml');
1.41      ng       9380:     } else {
1.141     www      9381: 	&Apache::loncommon::content_type($request,'text/html');
1.41      ng       9382:     }
                   9383:     $request->send_http_header;
1.44      ng       9384:     return '' if $request->header_only;
1.41      ng       9385:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.324     albertel 9386:     my $symb=&get_symb($request,1);
1.160     albertel 9387:     my @commands=&Apache::loncommon::get_env_multiple('form.command');
                   9388:     my $command=$commands[0];
1.447     foxr     9389: 
1.160     albertel 9390:     if ($#commands > 0) {
                   9391: 	&Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
                   9392:     }
1.447     foxr     9393: 
1.513     foxr     9394:     $ssi_error = 0;
1.535     raeburn  9395:     my $brcrum = [{href=>"/adm/grades",text=>"Grading"}];
                   9396:     $request->print(&Apache::loncommon::start_page('Grading',undef,
                   9397:                                           {'bread_crumbs' => $brcrum}));
1.324     albertel 9398:     if ($symb eq '' && $command eq '') {
1.257     albertel 9399: 	if ($env{'user.adv'}) {
                   9400: 	    if (($env{'form.codeone'}) && ($env{'form.codetwo'}) &&
                   9401: 		($env{'form.codethree'})) {
                   9402: 		my $token=$env{'form.codeone'}.'*'.$env{'form.codetwo'}.'*'.
                   9403: 		    $env{'form.codethree'};
1.41      ng       9404: 		my ($tsymb,$tuname,$tudom,$tcrsid)=
                   9405: 		    &Apache::lonnet::checkin($token);
                   9406: 		if ($tsymb) {
1.137     albertel 9407: 		    my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);
1.41      ng       9408: 		    if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
1.513     foxr     9409: 			$request->print(&ssi_with_retries('/res/'.$url, $ssi_retries,
1.99      albertel 9410: 					  ('grade_username' => $tuname,
                   9411: 					   'grade_domain' => $tudom,
                   9412: 					   'grade_courseid' => $tcrsid,
                   9413: 					   'grade_symb' => $tsymb)));
1.41      ng       9414: 		    } else {
1.45      ng       9415: 			$request->print('<h3>Not authorized: '.$token.'</h3>');
1.99      albertel 9416: 		    }
1.41      ng       9417: 		} else {
1.45      ng       9418: 		    $request->print('<h3>Not a valid DocID: '.$token.'</h3>');
1.41      ng       9419: 		}
1.14      www      9420: 	    } else {
1.41      ng       9421: 		$request->print(&Apache::lonxml::tokeninputfield());
                   9422: 	    }
                   9423: 	}
                   9424:     } else {
1.285     albertel 9425: 	&init_perm();
1.104     albertel 9426: 	if ($command eq 'submission' && $perm{'vgr'}) {
1.257     albertel 9427: 	    ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
1.103     albertel 9428: 	} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
1.68      ng       9429: 	    &pickStudentPage($request);
1.103     albertel 9430: 	} elsif ($command eq 'displayPage' && $perm{'vgr'}) {
1.68      ng       9431: 	    &displayPage($request);
1.104     albertel 9432: 	} elsif ($command eq 'gradeByPage' && $perm{'mgr'}) {
1.71      ng       9433: 	    &updateGradeByPage($request);
1.104     albertel 9434: 	} elsif ($command eq 'processGroup' && $perm{'vgr'}) {
1.41      ng       9435: 	    &processGroup($request);
1.104     albertel 9436: 	} elsif ($command eq 'gradingmenu' && $perm{'vgr'}) {
1.443     banghart 9437: 	    $request->print(&grading_menu($request));
                   9438: 	} elsif ($command eq 'submit_options' && $perm{'vgr'}) {
                   9439: 	    $request->print(&submit_options($request));
1.104     albertel 9440: 	} elsif ($command eq 'viewgrades' && $perm{'vgr'}) {
1.41      ng       9441: 	    $request->print(&viewgrades($request));
1.104     albertel 9442: 	} elsif ($command eq 'handgrade' && $perm{'mgr'}) {
1.41      ng       9443: 	    $request->print(&processHandGrade($request));
1.106     albertel 9444: 	} elsif ($command eq 'editgrades' && $perm{'mgr'}) {
1.41      ng       9445: 	    $request->print(&editgrades($request));
1.106     albertel 9446: 	} elsif ($command eq 'verify' && $perm{'vgr'}) {
1.41      ng       9447: 	    $request->print(&verifyreceipt($request));
1.400     www      9448:         } elsif ($command eq 'processclicker' && $perm{'mgr'}) {
                   9449:             $request->print(&process_clicker($request));
                   9450:         } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) {
                   9451:             $request->print(&process_clicker_file($request));
1.414     www      9452:         } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) {
                   9453:             $request->print(&assign_clicker_grades($request));
1.106     albertel 9454: 	} elsif ($command eq 'csvform' && $perm{'mgr'}) {
1.72      ng       9455: 	    $request->print(&upcsvScores_form($request));
1.106     albertel 9456: 	} elsif ($command eq 'csvupload' && $perm{'mgr'}) {
1.41      ng       9457: 	    $request->print(&csvupload($request));
1.106     albertel 9458: 	} elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {
1.41      ng       9459: 	    $request->print(&csvuploadmap($request));
1.246     albertel 9460: 	} elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) {
1.257     albertel 9461: 	    if ($env{'form.associate'} ne 'Reverse Association') {
1.246     albertel 9462: 		$request->print(&csvuploadoptions($request));
1.41      ng       9463: 	    } else {
1.257     albertel 9464: 		if ( $env{'form.upfile_associate'} ne 'reverse' ) {
                   9465: 		    $env{'form.upfile_associate'} = 'reverse';
1.41      ng       9466: 		} else {
1.257     albertel 9467: 		    $env{'form.upfile_associate'} = 'forward';
1.41      ng       9468: 		}
                   9469: 		$request->print(&csvuploadmap($request));
                   9470: 	    }
1.246     albertel 9471: 	} elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
                   9472: 	    $request->print(&csvuploadassign($request));
1.106     albertel 9473: 	} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
1.75      albertel 9474: 	    $request->print(&scantron_selectphase($request));
1.203     albertel 9475:  	} elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
                   9476:  	    $request->print(&scantron_do_warning($request));
1.142     albertel 9477: 	} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {
                   9478: 	    $request->print(&scantron_validate_file($request));
1.106     albertel 9479: 	} elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
1.82      albertel 9480: 	    $request->print(&scantron_process_students($request));
1.157     albertel 9481:  	} elsif ($command eq 'scantronupload' && 
1.257     albertel 9482:  		 (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
                   9483: 		  &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
1.162     albertel 9484:  	    $request->print(&scantron_upload_scantron_data($request)); 
1.157     albertel 9485:  	} elsif ($command eq 'scantronupload_save' &&
1.257     albertel 9486:  		 (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
                   9487: 		  &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
1.157     albertel 9488:  	    $request->print(&scantron_upload_scantron_data_save($request));
1.202     albertel 9489:  	} elsif ($command eq 'scantron_download' &&
1.257     albertel 9490: 		 &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
1.162     albertel 9491:  	    $request->print(&scantron_download_scantron_data($request));
1.523     raeburn  9492:         } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) {
                   9493:             $request->print(&checkscantron_results($request));     
1.106     albertel 9494: 	} elsif ($command) {
1.562     bisitz   9495: 	    $request->print('<p class="LC_error">'.&mt('Access Denied ([_1])',$command).'</p>');
1.26      albertel 9496: 	}
1.2       albertel 9497:     }
1.513     foxr     9498:     if ($ssi_error) {
                   9499: 	&ssi_print_error($request);
                   9500:     }
1.353     albertel 9501:     $request->print(&Apache::loncommon::end_page());
1.434     albertel 9502:     &reset_caches();
1.44      ng       9503:     return '';
                   9504: }
                   9505: 
1.1       albertel 9506: 1;
                   9507: 
1.13      albertel 9508: __END__;
1.531     jms      9509: 
                   9510: 
                   9511: =head1 NAME
                   9512: 
                   9513: Apache::grades
                   9514: 
                   9515: =head1 SYNOPSIS
                   9516: 
                   9517: Handles the viewing of grades.
                   9518: 
                   9519: This is part of the LearningOnline Network with CAPA project
                   9520: described at http://www.lon-capa.org.
                   9521: 
                   9522: =head1 OVERVIEW
                   9523: 
                   9524: Do an ssi with retries:
                   9525: While I'd love to factor out this with the vesrion in lonprintout,
                   9526: 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
                   9527: I'm not quite ready to invent (e.g. an ssi_with_retry object).
                   9528: 
                   9529: At least the logic that drives this has been pulled out into loncommon.
                   9530: 
                   9531: 
                   9532: 
                   9533: ssi_with_retries - Does the server side include of a resource.
                   9534:                      if the ssi call returns an error we'll retry it up to
                   9535:                      the number of times requested by the caller.
                   9536:                      If we still have a proble, no text is appended to the
                   9537:                      output and we set some global variables.
                   9538:                      to indicate to the caller an SSI error occurred.  
                   9539:                      All of this is supposed to deal with the issues described
                   9540:                      in LonCAPA BZ 5631 see:
                   9541:                      http://bugs.lon-capa.org/show_bug.cgi?id=5631
                   9542:                      by informing the user that this happened.
                   9543: 
                   9544: Parameters:
                   9545:   resource   - The resource to include.  This is passed directly, without
                   9546:                interpretation to lonnet::ssi.
                   9547:   form       - The form hash parameters that guide the interpretation of the resource
                   9548:                
                   9549:   retries    - Number of retries allowed before giving up completely.
                   9550: Returns:
                   9551:   On success, returns the rendered resource identified by the resource parameter.
                   9552: Side Effects:
                   9553:   The following global variables can be set:
                   9554:    ssi_error                - If an unrecoverable error occurred this becomes true.
                   9555:                               It is up to the caller to initialize this to false
                   9556:                               if desired.
                   9557:    ssi_error_resource  - If an unrecoverable error occurred, this is the value
                   9558:                               of the resource that could not be rendered by the ssi
                   9559:                               call.
                   9560:    ssi_error_message   - The error string fetched from the ssi response
                   9561:                               in the event of an error.
                   9562: 
                   9563: 
                   9564: =head1 HANDLER SUBROUTINE
                   9565: 
                   9566: ssi_with_retries()
                   9567: 
                   9568: =head1 SUBROUTINES
                   9569: 
                   9570: =over
                   9571: 
                   9572: =item scantron_get_correction() : 
                   9573: 
                   9574:    Builds the interface screen to interact with the operator to fix a
                   9575:    specific error condition in a specific scanline
                   9576: 
                   9577:  Arguments:
                   9578:     $r           - Apache request object
                   9579:     $i           - number of the current scanline
                   9580:     $scan_record - hash ref as returned from &scantron_parse_scanline()
                   9581:     $scan_config - hash ref as returned from &get_scantron_config()
                   9582:     $line        - full contents of the current scanline
                   9583:     $error       - error condition, valid values are
                   9584:                    'incorrectCODE', 'duplicateCODE',
                   9585:                    'doublebubble', 'missingbubble',
                   9586:                    'duplicateID', 'incorrectID'
                   9587:     $arg         - extra information needed
                   9588:        For errors:
                   9589:          - duplicateID   - paper number that this studentID was seen before on
                   9590:          - duplicateCODE - array ref of the paper numbers this CODE was
                   9591:                            seen on before
                   9592:          - incorrectCODE - current incorrect CODE 
                   9593:          - doublebubble  - array ref of the bubble lines that have double
                   9594:                            bubble errors
                   9595:          - missingbubble - array ref of the bubble lines that have missing
                   9596:                            bubble errors
                   9597: 
                   9598: =item  scantron_get_maxbubble() : 
                   9599: 
1.582     raeburn  9600:    Arguments:
                   9601:        $nav_error  - Reference to scalar which is a flag to indicate a
                   9602:                       failure to retrieve a navmap object.
                   9603:        if $nav_error is set to 1 by scantron_get_maxbubble(), the 
                   9604:        calling routine should trap the error condition and display the warning
                   9605:        found in &navmap_errormsg().
                   9606: 
1.531     jms      9607:    Returns the maximum number of bubble lines that are expected to
                   9608:    occur. Does this by walking the selected sequence rendering the
                   9609:    resource and then checking &Apache::lonxml::get_problem_counter()
                   9610:    for what the current value of the problem counter is.
                   9611: 
                   9612:    Caches the results to $env{'form.scantron_maxbubble'},
                   9613:    $env{'form.scantron.bubble_lines.n'}, 
                   9614:    $env{'form.scantron.first_bubble_line.n'} and
                   9615:    $env{"form.scantron.sub_bubblelines.n"}
                   9616:    which are the total number of bubble, lines, the number of bubble
                   9617:    lines for response n and number of the first bubble line for response n,
                   9618:    and a comma separated list of numbers of bubble lines for sub-questions
                   9619:    (for optionresponse, matchresponse, and rankresponse items), for response n.  
                   9620: 
                   9621: 
                   9622: =item  scantron_validate_missingbubbles() : 
                   9623: 
                   9624:    Validates all scanlines in the selected file to not have any
                   9625:     answers that don't have bubbles that have not been verified
                   9626:     to be bubble free.
                   9627: 
                   9628: =item  scantron_process_students() : 
                   9629: 
                   9630:    Routine that does the actual grading of the bubble sheet information.
                   9631: 
                   9632:    The parsed scanline hash is added to %env 
                   9633: 
                   9634:    Then foreach unskipped scanline it does an &Apache::lonnet::ssi()
                   9635:    foreach resource , with the form data of
                   9636: 
                   9637: 	'submitted'     =>'scantron' 
                   9638: 	'grade_target'  =>'grade',
                   9639: 	'grade_username'=> username of student
                   9640: 	'grade_domain'  => domain of student
                   9641: 	'grade_courseid'=> of course
                   9642: 	'grade_symb'    => symb of resource to grade
                   9643: 
                   9644:     This triggers a grading pass. The problem grading code takes care
                   9645:     of converting the bubbled letter information (now in %env) into a
                   9646:     valid submission.
                   9647: 
                   9648: =item  scantron_upload_scantron_data() :
                   9649: 
                   9650:     Creates the screen for adding a new bubble sheet data file to a course.
                   9651: 
                   9652: =item  scantron_upload_scantron_data_save() : 
                   9653: 
                   9654:    Adds a provided bubble information data file to the course if user
                   9655:    has the correct privileges to do so. 
                   9656: 
                   9657: =item  valid_file() :
                   9658: 
                   9659:    Validates that the requested bubble data file exists in the course.
                   9660: 
                   9661: =item  scantron_download_scantron_data() : 
                   9662: 
                   9663:    Shows a list of the three internal files (original, corrected,
                   9664:    skipped) for a specific bubble sheet data file that exists in the
                   9665:    course.
                   9666: 
                   9667: =item  scantron_validate_ID() : 
                   9668: 
                   9669:    Validates all scanlines in the selected file to not have any
1.556     weissno  9670:    invalid or underspecified student/employee IDs
1.531     jms      9671: 
1.582     raeburn  9672: =item navmap_errormsg() :
                   9673: 
                   9674:    Returns HTML mark-up inside a <div></div> with a link to re-initialize the course.
                   9675:    Should be called whenever the request to instantiate a navmap object fails.  
                   9676: 
1.531     jms      9677: =back
                   9678: 
                   9679: =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.