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

1.17      albertel    1: # The LearningOnline Network with CAPA
1.13      albertel    2: # The LON-CAPA Grading handler
1.17      albertel    3: #
1.513   ! foxr        4: # $Id: grades.pm,v 1.512 2008/03/03 23:36:30 www 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: 
                     29: package Apache::grades;
                     30: use strict;
                     31: use Apache::style;
                     32: use Apache::lonxml;
                     33: use Apache::lonnet;
1.3       albertel   34: use Apache::loncommon;
1.112     ng         35: use Apache::lonhtmlcommon;
1.68      ng         36: use Apache::lonnavmaps;
1.1       albertel   37: use Apache::lonhomework;
1.456     banghart   38: use Apache::lonpickcode;
1.55      matthew    39: use Apache::loncoursedata;
1.362     albertel   40: use Apache::lonmsg();
1.1       albertel   41: use Apache::Constants qw(:common);
1.167     sakharuk   42: use Apache::lonlocal;
1.386     raeburn    43: use Apache::lonenc;
1.170     albertel   44: use String::Similarity;
1.359     www        45: use LONCAPA;
                     46: 
1.315     bowersj2   47: use POSIX qw(floor);
1.87      www        48: 
1.435     foxr       49: 
1.513   ! foxr       50: 
1.435     foxr       51: my %perm=();
1.447     foxr       52: 
1.513   ! foxr       53: #  These variables are used to recover from ssi errors
        !            54: 
        !            55: my $ssi_retries = 5;
        !            56: my $ssi_error;
        !            57: my $ssi_error_resource;
        !            58: my $ssi_error_message;
        !            59: 
        !            60: 
        !            61: #  Do an ssi with retries:
        !            62: #  While I'd love to factor out this with the vesrion in lonprintout,
        !            63: #  that would either require a data coupling between modules, which I refuse to perpetuate
        !            64: #  (there's quite enough of that already), or would require the invention of another infrastructure
        !            65: #  I'm not quite ready to invent (e.g. an ssi_with_retry object).
        !            66: #
        !            67: # At least the logic that drives this has been pulled out into loncommon.
        !            68: 
        !            69: 
        !            70: #
        !            71: #   ssi_with_retries - Does the server side include of a resource.
        !            72: #                      if the ssi call returns an error we'll retry it up to
        !            73: #                      the number of times requested by the caller.
        !            74: #                      If we still have a proble, no text is appended to the
        !            75: #                      output and we set some global variables.
        !            76: #                      to indicate to the caller an SSI error occured.  
        !            77: #                      All of this is supposed to deal with the issues described
        !            78: #                      in LonCAPA BZ 5631 see:
        !            79: #                      http://bugs.lon-capa.org/show_bug.cgi?id=5631
        !            80: #                      by informing the user that this happened.
        !            81: #
        !            82: # Parameters:
        !            83: #   resource   - The resource to include.  This is passed directly, without
        !            84: #                interpretation to lonnet::ssi.
        !            85: #   form       - The form hash parameters that guide the interpretation of the resource
        !            86: #                
        !            87: #   retries    - Number of retries allowed before giving up completely.
        !            88: # Returns:
        !            89: #   On success, returns the rendered resource identified by the resource parameter.
        !            90: # Side Effects:
        !            91: #   The following global variables can be set:
        !            92: #    ssi_error                - If an unrecoverable error occured this becomes true.
        !            93: #                               It is up to the caller to initialize this to false
        !            94: #                               if desired.
        !            95: #    ssi_last_error_resource  - If an unrecoverable error occured, this is the value
        !            96: #                               of the resource that could not be rendered by the ssi
        !            97: #                               call.
        !            98: #    ssi_last_error           - The error string fetched from the ssi response
        !            99: #                               in the event of an error.
        !           100: #
        !           101: sub ssi_with_retries {
        !           102:     my ($resource, $retries, %form) = @_;
        !           103:     my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form);
        !           104:     if ($response->is_error) {
        !           105: 	$ssi_error          = 1;
        !           106: 	$ssi_error_resource = $resource;
        !           107: 	$ssi_error_message  = $response->code . " " . $response->message;
        !           108:     }
        !           109: 
        !           110:     return $content;
        !           111: 
        !           112: }
        !           113: #
        !           114: #  Prodcuces an ssi retry failure error message to the user:
        !           115: #
        !           116: 
        !           117: sub ssi_print_error {
        !           118:     my ($r) = @_;
        !           119:     $r->print('<h2>Unrecoverable network error</h2>');
        !           120:     $r->print('<p>Unable to perform a resource fetch from a server: <br />');
        !           121:     $r->print("Resource: $ssi_error_resource <br />");
        !           122:     $r->print("Error: $ssi_error_message <br /> Try again later.");
        !           123:     $r->print('If errors persist, contact LonCAPA support for assistance</p>');
        !           124: }
        !           125: 
1.44      ng        126: #
1.146     albertel  127: # --- Retrieve the parts from the metadata file.---
1.44      ng        128: sub getpartlist {
1.324     albertel  129:     my ($symb) = @_;
1.439     albertel  130: 
                    131:     my $navmap   = Apache::lonnavmaps::navmap->new();
                    132:     my $res      = $navmap->getBySymb($symb);
                    133:     my $partlist = $res->parts();
                    134:     my $url      = $res->src();
                    135:     my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys'));
                    136: 
1.146     albertel  137:     my @stores;
1.439     albertel  138:     foreach my $part (@{ $partlist }) {
1.146     albertel  139: 	foreach my $key (@metakeys) {
                    140: 	    if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
                    141: 	}
                    142:     }
                    143:     return @stores;
1.2       albertel  144: }
                    145: 
1.44      ng        146: # --- Get the symbolic name of a problem and the url
1.324     albertel  147: sub get_symb {
1.173     albertel  148:     my ($request,$silent) = @_;
1.257     albertel  149:     (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                    150:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
1.173     albertel  151:     if ($symb eq '') { 
                    152: 	if (!$silent) {
                    153: 	    $request->print("Unable to handle ambiguous references:$url:.");
                    154: 	    return ();
                    155: 	}
                    156:     }
1.418     albertel  157:     &Apache::lonenc::check_decrypt(\$symb);
1.324     albertel  158:     return ($symb);
1.32      ng        159: }
                    160: 
1.129     ng        161: #--- Format fullname, username:domain if different for display
                    162: #--- Use anywhere where the student names are listed
                    163: sub nameUserString {
                    164:     my ($type,$fullname,$uname,$udom) = @_;
                    165:     if ($type eq 'header') {
1.485     albertel  166: 	return '<b>&nbsp;'.&mt('Fullname').'&nbsp;</b><span class="LC_internal_info">('.&mt('Username').')</span>';
1.129     ng        167:     } else {
1.398     albertel  168: 	return '&nbsp;'.$fullname.'<span class="LC_internal_info">&nbsp;('.$uname.
                    169: 	    ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')</span>';
1.129     ng        170:     }
                    171: }
                    172: 
1.44      ng        173: #--- Get the partlist and the response type for a given problem. ---
                    174: #--- Indicate if a response type is coded handgraded or not. ---
1.39      ng        175: sub response_type {
1.324     albertel  176:     my ($symb) = shift;
1.377     albertel  177: 
                    178:     my $navmap = Apache::lonnavmaps::navmap->new();
                    179:     my $res = $navmap->getBySymb($symb);
                    180:     my $partlist = $res->parts();
1.392     albertel  181:     my %vPart = 
                    182: 	map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart'));
1.377     albertel  183:     my (%response_types,%handgrade);
                    184:     foreach my $part (@{ $partlist }) {
1.392     albertel  185: 	next if (%vPart && !exists($vPart{$part}));
                    186: 
1.377     albertel  187: 	my @types = $res->responseType($part);
                    188: 	my @ids = $res->responseIds($part);
                    189: 	for (my $i=0; $i < scalar(@ids); $i++) {
                    190: 	    $response_types{$part}{$ids[$i]} = $types[$i];
                    191: 	    $handgrade{$part.'_'.$ids[$i]} = 
                    192: 		&Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i].
                    193: 				     '.handgrade',$symb);
1.41      ng        194: 	}
                    195:     }
1.377     albertel  196:     return ($partlist,\%handgrade,\%response_types);
1.39      ng        197: }
                    198: 
1.375     albertel  199: sub flatten_responseType {
                    200:     my ($responseType) = @_;
                    201:     my @part_response_id =
                    202: 	map { 
                    203: 	    my $part = $_;
                    204: 	    map {
                    205: 		[$part,$_]
                    206: 		} sort(keys(%{ $responseType->{$part} }));
                    207: 	} sort(keys(%$responseType));
                    208:     return @part_response_id;
                    209: }
                    210: 
1.207     albertel  211: sub get_display_part {
1.324     albertel  212:     my ($partID,$symb)=@_;
1.207     albertel  213:     my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb);
                    214:     if (defined($display) and $display ne '') {
1.398     albertel  215: 	$display.= " (<span class=\"LC_internal_info\">id $partID</span>)";
1.207     albertel  216:     } else {
                    217: 	$display=$partID;
                    218:     }
                    219:     return $display;
                    220: }
1.269     raeburn   221: 
1.118     ng        222: #--- Show resource title
                    223: #--- and parts and response type
                    224: sub showResourceInfo {
1.324     albertel  225:     my ($symb,$probTitle,$checkboxes) = @_;
1.154     albertel  226:     my $col=3;
                    227:     if ($checkboxes) { $col=4; }
1.398     albertel  228:     my $result = '<h3>'.&mt('Current Resource').': '.$probTitle.'</h3>'."\n";
                    229:     $result .='<table border="0">';
1.324     albertel  230:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.126     ng        231:     my %resptype = ();
1.122     ng        232:     my $hdgrade='no';
1.154     albertel  233:     my %partsseen;
1.375     albertel  234:     foreach my $partID (sort keys(%$responseType)) {
                    235: 	foreach my $resID (sort keys(%{ $responseType->{$partID} })) {
                    236: 	    my $handgrade=$$handgrade{$partID.'_'.$resID};
                    237: 	    my $responsetype = $responseType->{$partID}->{$resID};
                    238: 	    $hdgrade = $handgrade if ($handgrade eq 'yes');
                    239: 	    $result.='<tr>';
                    240: 	    if ($checkboxes) {
                    241: 		if (exists($partsseen{$partID})) {
                    242: 		    $result.="<td>&nbsp;</td>";
                    243: 		} else {
1.401     albertel  244: 		    $result.="<td><input type='checkbox' name='vPart' value='$partID' checked='checked' /></td>";
1.375     albertel  245: 		}
                    246: 		$partsseen{$partID}=1;
1.154     albertel  247: 	    }
1.375     albertel  248: 	    my $display_part=&get_display_part($partID,$symb);
1.485     albertel  249: 	    $result.='<td>'.&mt('<b>Part: </b>[_1]',$display_part).' <span class="LC_internal_info">'.
1.398     albertel  250: 		$resID.'</span></td>'.
1.485     albertel  251: 		'<td>'.&mt('<b>Type: </b>[_1]',$responsetype).'</td></tr>';
                    252: #	    '<td>'.&mt('<b>Handgrade: </b>[_1]',$handgrade).'</td></tr>';
1.154     albertel  253: 	}
1.118     ng        254:     }
                    255:     $result.='</table>'."\n";
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.148     albertel  266: 
1.434     albertel  267:     sub reset_analyze_cache {
                    268: 	undef(%analyze_cache);
                    269:     }
                    270: 
                    271:     sub get_analyze {
                    272: 	my ($symb,$uname,$udom)=@_;
                    273: 	my $key = "$symb\0$uname\0$udom";
                    274: 	return $analyze_cache{$key} if (exists($analyze_cache{$key}));
                    275: 
                    276: 	my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
                    277: 	$url=&Apache::lonnet::clutter($url);
1.513   ! foxr      278: 	my $subresult=&ssi_with_retries($url, $ssi_retries,
1.434     albertel  279: 					   ('grade_target' => 'analyze'),
                    280: 					   ('grade_domain' => $udom),
                    281: 					   ('grade_symb' => $symb),
                    282: 					   ('grade_courseid' => 
                    283: 					    $env{'request.course.id'}),
                    284: 					   ('grade_username' => $uname));
                    285: 	(undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
                    286: 	my %analyze=&Apache::lonnet::str2hash($subresult);
                    287: 	return $analyze_cache{$key} = \%analyze;
                    288:     }
                    289: 
                    290:     sub get_order {
                    291: 	my ($partid,$respid,$symb,$uname,$udom)=@_;
                    292: 	my $analyze = &get_analyze($symb,$uname,$udom);
                    293: 	return $analyze->{"$partid.$respid.shown"};
                    294:     }
                    295: 
                    296:     sub get_radiobutton_correct_foil {
                    297: 	my ($partid,$respid,$symb,$uname,$udom)=@_;
                    298: 	my $analyze = &get_analyze($symb,$uname,$udom);
                    299: 	foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) {
                    300: 	    if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
                    301: 		return $foil;
                    302: 	    }
                    303: 	}
                    304:     }
1.148     albertel  305: }
1.434     albertel  306: 
1.118     ng        307: #--- Clean response type for display
1.335     albertel  308: #--- Currently filters option/rank/radiobutton/match/essay/Task
                    309: #        response types only.
1.118     ng        310: sub cleanRecord {
1.336     albertel  311:     my ($answer,$response,$symb,$partid,$respid,$record,$order,$version,
                    312: 	$uname,$udom) = @_;
1.398     albertel  313:     my $grayFont = '<span class="LC_internal_info">';
1.148     albertel  314:     if ($response =~ /^(option|rank)$/) {
                    315: 	my %answer=&Apache::lonnet::str2hash($answer);
                    316: 	my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
                    317: 	my ($toprow,$bottomrow);
                    318: 	foreach my $foil (@$order) {
                    319: 	    if ($grading{$foil} == 1) {
                    320: 		$toprow.='<td><b>'.$answer{$foil}.'&nbsp;</b></td>';
                    321: 	    } else {
                    322: 		$toprow.='<td><i>'.$answer{$foil}.'&nbsp;</i></td>';
                    323: 	    }
1.398     albertel  324: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.148     albertel  325: 	}
                    326: 	return '<blockquote><table border="1">'.
1.466     albertel  327: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    328: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.148     albertel  329: 	    $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
                    330:     } elsif ($response eq 'match') {
                    331: 	my %answer=&Apache::lonnet::str2hash($answer);
                    332: 	my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
                    333: 	my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"});
                    334: 	my ($toprow,$middlerow,$bottomrow);
                    335: 	foreach my $foil (@$order) {
                    336: 	    my $item=shift(@items);
                    337: 	    if ($grading{$foil} == 1) {
                    338: 		$toprow.='<td><b>'.$item.'&nbsp;</b></td>';
1.398     albertel  339: 		$middlerow.='<td><b>'.$grayFont.$answer{$foil}.'&nbsp;</span></b></td>';
1.148     albertel  340: 	    } else {
                    341: 		$toprow.='<td><i>'.$item.'&nbsp;</i></td>';
1.398     albertel  342: 		$middlerow.='<td><i>'.$grayFont.$answer{$foil}.'&nbsp;</span></i></td>';
1.148     albertel  343: 	    }
1.398     albertel  344: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.118     ng        345: 	}
1.126     ng        346: 	return '<blockquote><table border="1">'.
1.466     albertel  347: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    348: 	    '<tr valign="top"><td>'.$grayFont.&mt('Item ID').'</span></td>'.
1.148     albertel  349: 	    $middlerow.'</tr>'.
1.466     albertel  350: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.148     albertel  351: 	    $bottomrow.'</tr>'.'</table></blockquote>';
                    352:     } elsif ($response eq 'radiobutton') {
                    353: 	my %answer=&Apache::lonnet::str2hash($answer);
                    354: 	my ($toprow,$bottomrow);
1.434     albertel  355: 	my $correct = 
                    356: 	    &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom);
                    357: 	foreach my $foil (@$order) {
1.148     albertel  358: 	    if (exists($answer{$foil})) {
1.434     albertel  359: 		if ($foil eq $correct) {
1.466     albertel  360: 		    $toprow.='<td><b>'.&mt('true').'</b></td>';
1.148     albertel  361: 		} else {
1.466     albertel  362: 		    $toprow.='<td><i>'.&mt('true').'</i></td>';
1.148     albertel  363: 		}
                    364: 	    } else {
1.466     albertel  365: 		$toprow.='<td>'.&mt('false').'</td>';
1.148     albertel  366: 	    }
1.398     albertel  367: 	    $bottomrow.='<td>'.$grayFont.$foil.'</span>&nbsp;</td>';
1.148     albertel  368: 	}
                    369: 	return '<blockquote><table border="1">'.
1.466     albertel  370: 	    '<tr valign="top"><td>'.&mt('Answer').'</td>'.$toprow.'</tr>'.
                    371: 	    '<tr valign="top"><td>'.$grayFont.&mt('Option ID').'</span></td>'.
1.148     albertel  372: 	    $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
                    373:     } elsif ($response eq 'essay') {
1.257     albertel  374: 	if (! exists ($env{'form.'.$symb})) {
1.122     ng        375: 	    my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',
1.257     albertel  376: 						  $env{'course.'.$env{'request.course.id'}.'.domain'},
                    377: 						  $env{'course.'.$env{'request.course.id'}.'.num'});
1.122     ng        378: 
1.257     albertel  379: 	    my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
                    380: 	    $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : '';
                    381: 	    $env{'form.kwclr'}    = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red';
                    382: 	    $env{'form.kwsize'}   = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0';
                    383: 	    $env{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
                    384: 	    $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        385: 	}
1.166     albertel  386: 	$answer =~ s-\n-<br />-g;
                    387: 	return '<br /><br /><blockquote><tt>'.&keywords_highlight($answer).'</tt></blockquote>';
1.268     albertel  388:     } elsif ( $response eq 'organic') {
                    389: 	my $result='Smile representation: "<tt>'.$answer.'</tt>"';
                    390: 	my $jme=$record->{$version."resource.$partid.$respid.molecule"};
                    391: 	$result.=&Apache::chemresponse::jme_img($jme,$answer,400);
                    392: 	return $result;
1.335     albertel  393:     } elsif ( $response eq 'Task') {
                    394: 	if ( $answer eq 'SUBMITTED') {
                    395: 	    my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"};
1.336     albertel  396: 	    my $result = &Apache::bridgetask::file_list($files,$uname,$udom);
1.335     albertel  397: 	    return $result;
                    398: 	} elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) {
                    399: 	    my @matches = grep(/^\Q$version\E.*?\.instance$/,
                    400: 			       keys(%{$record}));
                    401: 	    return join('<br />',($version,@matches));
                    402: 			       
                    403: 			       
                    404: 	} else {
                    405: 	    my $result =
                    406: 		'<p>'
                    407: 		.&mt('Overall result: [_1]',
                    408: 		     $record->{$version."resource.$respid.$partid.status"})
                    409: 		.'</p>';
                    410: 	    
                    411: 	    $result .= '<ul>';
                    412: 	    my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/,
                    413: 			     keys(%{$record}));
                    414: 	    foreach my $grade (sort(@grade)) {
                    415: 		my ($dim) = ($grade =~/[.]([^.]+)[.]status$/);
                    416: 		$result.= '<li>'.&mt("Dimension: [_1], status [_2] ",
                    417: 				     $dim, $record->{$grade}).
                    418: 			  '</li>';
                    419: 	    }
                    420: 	    $result.='</ul>';
                    421: 	    return $result;
                    422: 	}
1.440     albertel  423:     } elsif ( $response =~ m/(?:numerical|formula)/) {
                    424: 	$answer = 
                    425: 	    &Apache::loncommon::format_previous_attempt_value('submission',
                    426: 							      $answer);
1.122     ng        427:     }
1.118     ng        428:     return $answer;
                    429: }
                    430: 
                    431: #-- A couple of common js functions
                    432: sub commonJSfunctions {
                    433:     my $request = shift;
                    434:     $request->print(<<COMMONJSFUNCTIONS);
                    435: <script type="text/javascript" language="javascript">
                    436:     function radioSelection(radioButton) {
                    437: 	var selection=null;
                    438: 	if (radioButton.length > 1) {
                    439: 	    for (var i=0; i<radioButton.length; i++) {
                    440: 		if (radioButton[i].checked) {
                    441: 		    return radioButton[i].value;
                    442: 		}
                    443: 	    }
                    444: 	} else {
                    445: 	    if (radioButton.checked) return radioButton.value;
                    446: 	}
                    447: 	return selection;
                    448:     }
                    449: 
                    450:     function pullDownSelection(selectOne) {
                    451: 	var selection="";
                    452: 	if (selectOne.length > 1) {
                    453: 	    for (var i=0; i<selectOne.length; i++) {
                    454: 		if (selectOne[i].selected) {
                    455: 		    return selectOne[i].value;
                    456: 		}
                    457: 	    }
                    458: 	} else {
1.138     albertel  459:             // only one value it must be the selected one
                    460: 	    return selectOne.value;
1.118     ng        461: 	}
                    462:     }
                    463: </script>
                    464: COMMONJSFUNCTIONS
                    465: }
                    466: 
1.44      ng        467: #--- Dumps the class list with usernames,list of sections,
                    468: #--- section, ids and fullnames for each user.
                    469: sub getclasslist {
1.449     banghart  470:     my ($getsec,$filterlist,$getgroup) = @_;
1.291     albertel  471:     my @getsec;
1.450     banghart  472:     my @getgroup;
1.442     banghart  473:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.291     albertel  474:     if (!ref($getsec)) {
                    475: 	if ($getsec ne '' && $getsec ne 'all') {
                    476: 	    @getsec=($getsec);
                    477: 	}
                    478:     } else {
                    479: 	@getsec=@{$getsec};
                    480:     }
                    481:     if (grep(/^all$/,@getsec)) { undef(@getsec); }
1.450     banghart  482:     if (!ref($getgroup)) {
                    483: 	if ($getgroup ne '' && $getgroup ne 'all') {
                    484: 	    @getgroup=($getgroup);
                    485: 	}
                    486:     } else {
                    487: 	@getgroup=@{$getgroup};
                    488:     }
                    489:     if (grep(/^all$/,@getgroup)) { undef(@getgroup); }
1.291     albertel  490: 
1.449     banghart  491:     my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
1.49      albertel  492:     # Bail out if we were unable to get the classlist
1.56      matthew   493:     return if (! defined($classlist));
1.449     banghart  494:     &Apache::loncoursedata::get_group_memberships($classlist,$keylist);
1.56      matthew   495:     #
                    496:     my %sections;
                    497:     my %fullnames;
1.205     matthew   498:     foreach my $student (keys(%$classlist)) {
                    499:         my $end      = 
                    500:             $classlist->{$student}->[&Apache::loncoursedata::CL_END()];
                    501:         my $start    = 
                    502:             $classlist->{$student}->[&Apache::loncoursedata::CL_START()];
                    503:         my $id       = 
                    504:             $classlist->{$student}->[&Apache::loncoursedata::CL_ID()];
                    505:         my $section  = 
                    506:             $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
                    507:         my $fullname = 
                    508:             $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()];
                    509:         my $status   = 
                    510:             $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()];
1.449     banghart  511:         my $group   = 
                    512:             $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
1.76      ng        513: 	# filter students according to status selected
1.442     banghart  514: 	if ($filterlist && (!($stu_status =~ /Any/))) {
                    515: 	    if (!($stu_status =~ $status)) {
1.450     banghart  516: 		delete($classlist->{$student});
1.76      ng        517: 		next;
                    518: 	    }
                    519: 	}
1.450     banghart  520: 	# filter students according to groups selected
1.453     banghart  521: 	my @stu_groups = split(/,/,$group);
1.450     banghart  522: 	if (@getgroup) {
                    523: 	    my $exclude = 1;
1.454     banghart  524: 	    foreach my $grp (@getgroup) {
                    525: 	        foreach my $stu_group (@stu_groups) {
1.453     banghart  526: 	            if ($stu_group eq $grp) {
                    527: 	                $exclude = 0;
                    528:     	            } 
1.450     banghart  529: 	        }
1.453     banghart  530:     	        if (($grp eq 'none') && !$group) {
                    531:         	        $exclude = 0;
                    532:         	}
1.450     banghart  533: 	    }
                    534: 	    if ($exclude) {
                    535: 	        delete($classlist->{$student});
                    536: 	    }
                    537: 	}
1.205     matthew   538: 	$section = ($section ne '' ? $section : 'none');
1.106     albertel  539: 	if (&canview($section)) {
1.291     albertel  540: 	    if (!@getsec || grep(/^\Q$section\E$/,@getsec)) {
1.103     albertel  541: 		$sections{$section}++;
1.450     banghart  542: 		if ($classlist->{$student}) {
                    543: 		    $fullnames{$student}=$fullname;
                    544: 		}
1.103     albertel  545: 	    } else {
1.205     matthew   546: 		delete($classlist->{$student});
1.103     albertel  547: 	    }
                    548: 	} else {
1.205     matthew   549: 	    delete($classlist->{$student});
1.103     albertel  550: 	}
1.44      ng        551:     }
                    552:     my %seen = ();
1.56      matthew   553:     my @sections = sort(keys(%sections));
                    554:     return ($classlist,\@sections,\%fullnames);
1.44      ng        555: }
                    556: 
1.103     albertel  557: sub canmodify {
                    558:     my ($sec)=@_;
                    559:     if ($perm{'mgr'}) {
                    560: 	if (!defined($perm{'mgr_section'})) {
                    561: 	    # can modify whole class
                    562: 	    return 1;
                    563: 	} else {
                    564: 	    if ($sec eq $perm{'mgr_section'}) {
                    565: 		#can modify the requested section
                    566: 		return 1;
                    567: 	    } else {
                    568: 		# can't modify the request section
                    569: 		return 0;
                    570: 	    }
                    571: 	}
                    572:     }
                    573:     #can't modify
                    574:     return 0;
                    575: }
                    576: 
                    577: sub canview {
                    578:     my ($sec)=@_;
                    579:     if ($perm{'vgr'}) {
                    580: 	if (!defined($perm{'vgr_section'})) {
                    581: 	    # can modify whole class
                    582: 	    return 1;
                    583: 	} else {
                    584: 	    if ($sec eq $perm{'vgr_section'}) {
                    585: 		#can modify the requested section
                    586: 		return 1;
                    587: 	    } else {
                    588: 		# can't modify the request section
                    589: 		return 0;
                    590: 	    }
                    591: 	}
                    592:     }
                    593:     #can't modify
                    594:     return 0;
                    595: }
                    596: 
1.44      ng        597: #--- Retrieve the grade status of a student for all the parts
                    598: sub student_gradeStatus {
1.324     albertel  599:     my ($symb,$udom,$uname,$partlist) = @_;
1.257     albertel  600:     my %record     = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.44      ng        601:     my %partstatus = ();
                    602:     foreach (@$partlist) {
1.128     ng        603: 	my ($status,undef)   = split(/_/,$record{"resource.$_.solved"},2);
1.44      ng        604: 	$status              = 'nothing' if ($status eq '');
                    605: 	$partstatus{$_}      = $status;
                    606: 	my $subkey           = "resource.$_.submitted_by";
                    607: 	$partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne '');
                    608:     }
                    609:     return %partstatus;
                    610: }
                    611: 
1.45      ng        612: # hidden form and javascript that calls the form
                    613: # Use by verifyscript and viewgrades
                    614: # Shows a student's view of problem and submission
                    615: sub jscriptNform {
1.324     albertel  616:     my ($symb) = @_;
1.442     banghart  617:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.45      ng        618:     my $jscript='<script type="text/javascript" language="javascript">'."\n".
                    619: 	'    function viewOneStudent(user,domain) {'."\n".
                    620: 	'	document.onestudent.student.value = user;'."\n".
                    621: 	'	document.onestudent.userdom.value = domain;'."\n".
                    622: 	'	document.onestudent.submit();'."\n".
                    623: 	'    }'."\n".
                    624: 	'</script>'."\n";
                    625:     $jscript.= '<form action="/adm/grades" method="post" name="onestudent">'."\n".
1.418     albertel  626: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel  627: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
                    628: 	'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n".
1.442     banghart  629: 	'<input type="hidden" name="Status"  value="'.$stu_status.'" />'."\n".
1.45      ng        630: 	'<input type="hidden" name="command" value="submission" />'."\n".
                    631: 	'<input type="hidden" name="student" value="" />'."\n".
                    632: 	'<input type="hidden" name="userdom" value="" />'."\n".
                    633: 	'</form>'."\n";
                    634:     return $jscript;
                    635: }
1.39      ng        636: 
1.447     foxr      637: 
                    638: 
1.315     bowersj2  639: # Given the score (as a number [0-1] and the weight) what is the final
                    640: # point value? This function will round to the nearest tenth, third,
                    641: # or quarter if one of those is within the tolerance of .00001.
1.316     albertel  642: sub compute_points {
1.315     bowersj2  643:     my ($score, $weight) = @_;
                    644:     
                    645:     my $tolerance = .00001;
                    646:     my $points = $score * $weight;
                    647: 
                    648:     # Check for nearness to 1/x.
                    649:     my $check_for_nearness = sub {
                    650:         my ($factor) = @_;
                    651:         my $num = ($points * $factor) + $tolerance;
                    652:         my $floored_num = floor($num);
1.316     albertel  653:         if ($num - $floored_num < 2 * $tolerance * $factor) {
1.315     bowersj2  654:             return $floored_num / $factor;
                    655:         }
                    656:         return $points;
                    657:     };
                    658: 
                    659:     $points = $check_for_nearness->(10);
                    660:     $points = $check_for_nearness->(3);
                    661:     $points = $check_for_nearness->(4);
                    662:     
                    663:     return $points;
                    664: }
                    665: 
1.44      ng        666: #------------------ End of general use routines --------------------
1.87      www       667: 
                    668: #
                    669: # Find most similar essay
                    670: #
                    671: 
                    672: sub most_similar {
1.426     albertel  673:     my ($uname,$udom,$uessay,$old_essays)=@_;
1.87      www       674: 
                    675: # ignore spaces and punctuation
                    676: 
                    677:     $uessay=~s/\W+/ /gs;
                    678: 
1.282     www       679: # ignore empty submissions (occuring when only files are sent)
                    680: 
                    681:     unless ($uessay=~/\w+/) { return ''; }
                    682: 
1.87      www       683: # these will be returned. Do not care if not at least 50 percent similar
1.88      www       684:     my $limit=0.6;
1.87      www       685:     my $sname='';
                    686:     my $sdom='';
                    687:     my $scrsid='';
                    688:     my $sessay='';
                    689: # go through all essays ...
1.426     albertel  690:     foreach my $tkey (keys(%$old_essays)) {
                    691: 	my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));
1.87      www       692: # ... except the same student
1.426     albertel  693:         next if (($tname eq $uname) && ($tdom eq $udom));
                    694: 	my $tessay=$old_essays->{$tkey};
                    695: 	$tessay=~s/\W+/ /gs;
1.87      www       696: # String similarity gives up if not even limit
1.426     albertel  697: 	my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
1.87      www       698: # Found one
1.426     albertel  699: 	if ($tsimilar>$limit) {
                    700: 	    $limit=$tsimilar;
                    701: 	    $sname=$tname;
                    702: 	    $sdom=$tdom;
                    703: 	    $scrsid=$tcrsid;
                    704: 	    $sessay=$old_essays->{$tkey};
                    705: 	}
1.87      www       706:     }
1.88      www       707:     if ($limit>0.6) {
1.87      www       708:        return ($sname,$sdom,$scrsid,$sessay,$limit);
                    709:     } else {
                    710:        return ('','','','',0);
                    711:     }
                    712: }
                    713: 
1.44      ng        714: #-------------------------------------------------------------------
                    715: 
                    716: #------------------------------------ Receipt Verification Routines
1.45      ng        717: #
1.44      ng        718: #--- Check whether a receipt number is valid.---
                    719: sub verifyreceipt {
                    720:     my $request  = shift;
                    721: 
1.257     albertel  722:     my $courseid = $env{'request.course.id'};
1.184     www       723:     my $receipt  = &Apache::lonnet::recprefix($courseid).'-'.
1.257     albertel  724: 	$env{'form.receipt'};
1.44      ng        725:     $receipt     =~ s/[^\-\d]//g;
1.378     albertel  726:     my ($symb)   = &get_symb($request);
1.44      ng        727: 
1.487     albertel  728:     my $title.=
                    729: 	'<h3><span class="LC_info">'.
                    730: 	&mt('Verifying Submission Receipt [_1]',$receipt).
                    731: 	'</span></h3>'."\n".
                    732: 	'<h4>'.&mt('<b>Resource: </b>[_1]',$env{'form.probTitle'}).
                    733: 	'</h4>'."\n";
1.44      ng        734: 
                    735:     my ($string,$contents,$matches) = ('','',0);
1.56      matthew   736:     my (undef,undef,$fullname) = &getclasslist('all','0');
1.177     albertel  737:     
                    738:     my $receiptparts=0;
1.390     albertel  739:     if ($env{"course.$courseid.receiptalg"} eq 'receipt2' ||
                    740: 	$env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; }
1.177     albertel  741:     my $parts=['0'];
1.324     albertel  742:     if ($receiptparts) { ($parts)=&response_type($symb); }
1.486     albertel  743:     
                    744:     my $header = 
                    745: 	&Apache::loncommon::start_data_table().
                    746: 	&Apache::loncommon::start_data_table_header_row().
1.487     albertel  747: 	'<th>&nbsp;'.&mt('Fullname').'&nbsp;</th>'."\n".
                    748: 	'<th>&nbsp;'.&mt('Username').'&nbsp;</th>'."\n".
                    749: 	'<th>&nbsp;'.&mt('Domain').'&nbsp;</th>';
1.486     albertel  750:     if ($receiptparts) {
1.487     albertel  751: 	$header.='<th>&nbsp;'.&mt('Problem Part').'&nbsp;</th>';
1.486     albertel  752:     }
                    753:     $header.=
                    754: 	&Apache::loncommon::end_data_table_header_row();
                    755: 
1.294     albertel  756:     foreach (sort 
                    757: 	     {
                    758: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                    759: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                    760: 		 }
                    761: 		 return $a cmp $b;
                    762: 	     } (keys(%$fullname))) {
1.44      ng        763: 	my ($uname,$udom)=split(/\:/);
1.177     albertel  764: 	foreach my $part (@$parts) {
                    765: 	    if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) {
1.486     albertel  766: 		$contents.=
                    767: 		    &Apache::loncommon::start_data_table_row().
                    768: 		    '<td>&nbsp;'."\n".
1.177     albertel  769: 		    '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
1.417     albertel  770: 		    '\');" target="_self">'.$$fullname{$_}.'</a>&nbsp;</td>'."\n".
1.177     albertel  771: 		    '<td>&nbsp;'.$uname.'&nbsp;</td>'.
                    772: 		    '<td>&nbsp;'.$udom.'&nbsp;</td>';
                    773: 		if ($receiptparts) {
                    774: 		    $contents.='<td>&nbsp;'.$part.'&nbsp;</td>';
                    775: 		}
1.486     albertel  776: 		$contents.= 
                    777: 		    &Apache::loncommon::end_data_table_row()."\n";
1.177     albertel  778: 		
                    779: 		$matches++;
                    780: 	    }
1.44      ng        781: 	}
                    782:     }
                    783:     if ($matches == 0) {
1.487     albertel  784: 	$string = $title.&mt('No match found for the above receipt.');
1.44      ng        785:     } else {
1.324     albertel  786: 	$string = &jscriptNform($symb).$title.
1.487     albertel  787: 	    '<p>'.
                    788: 	    &mt('The above receipt matches the following [numerate,_1,student].',$matches).
                    789: 	    '</p>'.
1.486     albertel  790: 	    $header.
                    791: 	    $contents.
                    792: 	    &Apache::loncommon::end_data_table()."\n";
1.44      ng        793:     }
1.324     albertel  794:     return $string.&show_grading_menu_form($symb);
1.44      ng        795: }
                    796: 
                    797: #--- This is called by a number of programs.
                    798: #--- Called from the Grading Menu - View/Grade an individual student
                    799: #--- Also called directly when one clicks on the subm button 
                    800: #    on the problem page.
1.30      ng        801: sub listStudents {
1.41      ng        802:     my ($request) = shift;
1.49      albertel  803: 
1.324     albertel  804:     my ($symb) = &get_symb($request);
1.257     albertel  805:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                    806:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                    807:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
1.449     banghart  808:     my $getgroup  = $env{'form.group'} eq '' ? 'all' : $env{'form.group'};
1.257     albertel  809:     my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};
                    810:     my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View';
                    811:     $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 
                    812: 	&Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
1.49      albertel  813: 
1.485     albertel  814:     my $result='<h3><span class="LC_info">&nbsp;'.
                    815: 	&mt($viewgrade.' Submissions for a Student or a Group of Students')
                    816: 	.'</span></h3>';
1.118     ng        817: 
1.324     albertel  818:     my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes'));
1.49      albertel  819: 
1.485     albertel  820:     my %lt = ( 'multiple' =>
                    821: 	       "Please select a student or group of students before clicking on the Next button.",
                    822: 	       'single'   =>
                    823: 	       "Please select the student before clicking on the Next button.",
                    824: 	       );
                    825:     %lt = &Apache::lonlocal::texthash(%lt);
1.45      ng        826:     $request->print(<<LISTJAVASCRIPT);
                    827: <script type="text/javascript" language="javascript">
1.110     ng        828:     function checkSelect(checkBox) {
                    829: 	var ctr=0;
                    830: 	var sense="";
                    831: 	if (checkBox.length > 1) {
                    832: 	    for (var i=0; i<checkBox.length; i++) {
                    833: 		if (checkBox[i].checked) {
                    834: 		    ctr++;
                    835: 		}
                    836: 	    }
1.485     albertel  837: 	    sense = '$lt{'multiple'}';
1.110     ng        838: 	} else {
                    839: 	    if (checkBox.checked) {
                    840: 		ctr = 1;
                    841: 	    }
1.485     albertel  842: 	    sense = '$lt{'single'}';
1.110     ng        843: 	}
                    844: 	if (ctr == 0) {
1.485     albertel  845: 	    alert(sense);
1.110     ng        846: 	    return false;
                    847: 	}
                    848: 	document.gradesub.submit();
                    849:     }
                    850: 
                    851:     function reLoadList(formname) {
1.112     ng        852: 	if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;}
1.110     ng        853: 	formname.command.value = 'submission';
                    854: 	formname.submit();
                    855:     }
1.45      ng        856: </script>
                    857: LISTJAVASCRIPT
                    858: 
1.118     ng        859:     &commonJSfunctions($request);
1.41      ng        860:     $request->print($result);
1.39      ng        861: 
1.401     albertel  862:     my $checkhdgrade = ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked="checked"' : '';
                    863:     my $checklastsub = $checkhdgrade eq '' ? 'checked="checked"' : '';
1.154     albertel  864:     my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'.
1.485     albertel  865: 	"\n".$table;
                    866: 	
                    867:     $gradeTable .= 
                    868: 	'&nbsp;'.
                    869: 	&mt('<b>View Problem Text: </b>[_1]',
                    870: 	    '<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n".
                    871: 	    '<label><input type="radio" name="vProb" value="yes" /> '.&mt('one student').' </label>'."\n".
                    872: 	    '<label><input type="radio" name="vProb" value="all" /> '.&mt('all students').' </label>').'<br />'."\n";
                    873:     $gradeTable .= 
                    874: 	'&nbsp;'.
                    875: 	&mt('<b>View Answer: </b>[_1]',
                    876: 	    '<label><input type="radio" name="vAns" value="no"  /> '.&mt('no').' </label>'."\n".
                    877: 	    '<label><input type="radio" name="vAns" value="yes" /> '.&mt('one student').' </label>'."\n".
                    878: 	    '<label><input type="radio" name="vAns" value="all" checked="checked" /> '.&mt('all students').' </label>').'<br />'."\n";
                    879: 
                    880:     my $submission_options;
1.257     albertel  881:     if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {
1.485     albertel  882: 	$submission_options.=
                    883: 	    '<label><input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> '.&mt('essay part only').' </label>'."\n";
1.49      albertel  884:     }
1.442     banghart  885:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
                    886:     my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status;
1.257     albertel  887:     $env{'form.Status'} = $saveStatus;
1.485     albertel  888:     $submission_options.=
                    889: 	'<label><input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> '.&mt('last submission only').' </label>'."\n".
                    890: 	'<label><input type="radio" name="lastSub" value="last" /> '.&mt('last submission &amp; parts info').' </label>'."\n".
                    891: 	'<label><input type="radio" name="lastSub" value="datesub" /> '.&mt('by dates and submissions').' </label>'."\n".
                    892: 	'<label><input type="radio" name="lastSub" value="all" /> '.&mt('all details').'</label>';
                    893:     $gradeTable .= 
                    894: 	'&nbsp;'.
                    895: 	&mt('<b>Submissions: </b>[_1]',$submission_options).'<br />'."\n";
                    896: 
                    897:     $gradeTable .= 
                    898:         '&nbsp;'.
                    899: 	&mt('<b>Grading Increments:</b> [_1]',
                    900: 	    '<select name="increment">'.
                    901: 	    '<option value="1">'.&mt('Whole Points').'</option>'.
                    902: 	    '<option value=".5">'.&mt('Half Points').'</option>'.
                    903: 	    '<option value=".25">'.&mt('Quarter Points').'</option>'.
                    904: 	    '<option value=".1">'.&mt('Tenths of a Point').'</option>'.
                    905: 	    '</select>');
                    906:     
                    907:     $gradeTable .= 
1.432     banghart  908:         &build_section_inputs().
1.45      ng        909: 	'<input type="hidden" name="submitonly"  value="'.$submitonly.'" />'."\n".
1.257     albertel  910: 	'<input type="hidden" name="handgrade"   value="'.$env{'form.handgrade'}.'" /><br />'."\n".
                    911: 	'<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" /><br />'."\n".
                    912: 	'<input type="hidden" name="saveState"   value="'.$env{'form.saveState'}.'" />'."\n".
                    913: 	'<input type="hidden" name="probTitle"   value="'.$env{'form.probTitle'}.'" />'."\n".
1.418     albertel  914: 	'<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.110     ng        915: 	'<input type="hidden" name="saveStatusOld" value="'.$saveStatus.'" />'."\n";
                    916: 
1.257     albertel  917:     if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) {
1.442     banghart  918: 	$gradeTable.='<input type="hidden" name="Status"   value="'.$stu_status.'" />'."\n";
1.124     ng        919:     } else {
1.485     albertel  920: 	$gradeTable.=&mt('<b>Student Status:</b> [_1]',
                    921: 			 &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);')).'<br />';
1.124     ng        922:     }
1.112     ng        923: 
1.485     albertel  924:     $gradeTable.=&mt('To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '.
                    925: 	'next to the student\'s name(s). Then click on the Next button.').'<br />'."\n".
1.110     ng        926: 	'<input type="hidden" name="command" value="processGroup" />'."\n";
1.249     albertel  927: 
                    928: # checkall buttons
                    929:     $gradeTable.=&check_script('gradesub', 'stuinfo');
1.110     ng        930:     $gradeTable.='<input type="button" '."\n".
1.45      ng        931: 	'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".
1.485     albertel  932: 	'value="'.&mt('Next-&gt;').'" /> <br />'."\n";
1.249     albertel  933:     $gradeTable.=&check_buttons();
1.485     albertel  934:     $gradeTable.='<label><input type="checkbox" name="checkPlag" checked="checked" />'.&mt('Check For Plagiarism').'</label>';
1.450     banghart  935:     my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup);
1.474     albertel  936:     $gradeTable.= &Apache::loncommon::start_data_table().
                    937: 	&Apache::loncommon::start_data_table_header_row();
1.110     ng        938:     my $loop = 0;
                    939:     while ($loop < 2) {
1.485     albertel  940: 	$gradeTable.='<th>'.&mt('No.').'</th><th>'.&mt('Select').'</th>'.
                    941: 	    '<th>'.&nameUserString('header').'&nbsp;'.&mt('Section/Group').'</th>';
1.301     albertel  942: 	if ($env{'form.showgrading'} eq 'yes' 
                    943: 	    && $submitonly ne 'queued'
                    944: 	    && $submitonly ne 'all') {
1.485     albertel  945: 	    foreach my $part (sort(@$partlist)) {
                    946: 		my $display_part=
                    947: 		    &get_display_part((split(/_/,$part))[0],$symb);
                    948: 		$gradeTable.=
                    949: 		    '<th>'.&mt('Part: [_1] Status',$display_part).'</th>';
1.110     ng        950: 	    }
1.301     albertel  951: 	} elsif ($submitonly eq 'queued') {
1.474     albertel  952: 	    $gradeTable.='<th>'.&mt('Queue Status').'&nbsp;</th>';
1.110     ng        953: 	}
                    954: 	$loop++;
1.126     ng        955: #	$gradeTable.='<td></td>' if ($loop%2 ==1);
1.41      ng        956:     }
1.474     albertel  957:     $gradeTable.=&Apache::loncommon::end_data_table_header_row()."\n";
1.41      ng        958: 
1.45      ng        959:     my $ctr = 0;
1.294     albertel  960:     foreach my $student (sort 
                    961: 			 {
                    962: 			     if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                    963: 				 return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                    964: 			     }
                    965: 			     return $a cmp $b;
                    966: 			 }
                    967: 			 (keys(%$fullname))) {
1.41      ng        968: 	my ($uname,$udom) = split(/:/,$student);
1.301     albertel  969: 
1.110     ng        970: 	my %status = ();
1.301     albertel  971: 
                    972: 	if ($submitonly eq 'queued') {
                    973: 	    my %queue_status = 
                    974: 		&Apache::bridgetask::get_student_status($symb,$cdom,$cnum,
                    975: 							$udom,$uname);
                    976: 	    next if (!defined($queue_status{'gradingqueue'}));
                    977: 	    $status{'gradingqueue'} = $queue_status{'gradingqueue'};
                    978: 	}
                    979: 
                    980: 	if ($env{'form.showgrading'} eq 'yes' 
                    981: 	    && $submitonly ne 'queued'
                    982: 	    && $submitonly ne 'all') {
1.324     albertel  983: 	    (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist);
1.145     albertel  984: 	    my $submitted = 0;
1.164     albertel  985: 	    my $graded = 0;
1.248     albertel  986: 	    my $incorrect = 0;
1.110     ng        987: 	    foreach (keys(%status)) {
1.145     albertel  988: 		$submitted = 1 if ($status{$_} ne 'nothing');
1.248     albertel  989: 		$graded = 1 if ($status{$_} =~ /^ungraded/);
                    990: 		$incorrect = 1 if ($status{$_} =~ /^incorrect/);
                    991: 		
1.110     ng        992: 		my ($foo,$partid,$foo1) = split(/\./,$_);
                    993: 		if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
1.145     albertel  994: 		    $submitted = 0;
1.150     albertel  995: 		    my ($part)=split(/\./,$partid);
1.110     ng        996: 		    $gradeTable.='<input type="hidden" name="'.
1.150     albertel  997: 			$student.':'.$part.':submitted_by" value="'.
1.110     ng        998: 			$status{'resource.'.$partid.'.submitted_by'}.'" />';
                    999: 		}
1.41      ng       1000: 	    }
1.248     albertel 1001: 	    
1.156     albertel 1002: 	    next if (!$submitted && ($submitonly eq 'yes' ||
                   1003: 				     $submitonly eq 'incorrect' ||
                   1004: 				     $submitonly eq 'graded'));
1.248     albertel 1005: 	    next if (!$graded && ($submitonly eq 'graded'));
                   1006: 	    next if (!$incorrect && $submitonly eq 'incorrect');
1.41      ng       1007: 	}
1.34      ng       1008: 
1.45      ng       1009: 	$ctr++;
1.249     albertel 1010: 	my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
1.452     banghart 1011:         my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
1.104     albertel 1012: 	if ( $perm{'vgr'} eq 'F' ) {
1.474     albertel 1013: 	    if ($ctr%2 ==1) {
                   1014: 		$gradeTable.= &Apache::loncommon::start_data_table_row();
                   1015: 	    }
1.126     ng       1016: 	    $gradeTable.='<td align="right">'.$ctr.'&nbsp;</td>'.
1.249     albertel 1017:                '<td align="center"><label><input type=checkbox name="stuinfo" value="'.
                   1018:                $student.':'.$$fullname{$student}.':::SECTION'.$section.
                   1019: 	       ')&nbsp;" />&nbsp;&nbsp;</label></td>'."\n".'<td>'.
                   1020: 	       &nameUserString(undef,$$fullname{$student},$uname,$udom).
1.474     albertel 1021: 	       '&nbsp;'.$section.($group ne '' ?'/'.$group:'').'</td>'."\n";
1.110     ng       1022: 
1.257     albertel 1023: 	    if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
1.110     ng       1024: 		foreach (sort keys(%status)) {
1.485     albertel 1025: 		    next if ($_ =~ /^resource.*?submitted_by$/);
                   1026: 		    $gradeTable.='<td align="center">&nbsp;'.&mt($status{$_}).'&nbsp;</td>'."\n";
1.110     ng       1027: 		}
1.41      ng       1028: 	    }
1.126     ng       1029: #	    $gradeTable.='<td></td>' if ($ctr%2 ==1);
1.474     albertel 1030: 	    if ($ctr%2 ==0) {
                   1031: 		$gradeTable.=&Apache::loncommon::end_data_table_row()."\n";
                   1032: 	    }
1.41      ng       1033: 	}
                   1034:     }
1.110     ng       1035:     if ($ctr%2 ==1) {
1.126     ng       1036: 	$gradeTable.='<td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td>';
1.301     albertel 1037: 	    if ($env{'form.showgrading'} eq 'yes' 
                   1038: 		&& $submitonly ne 'queued'
                   1039: 		&& $submitonly ne 'all') {
1.110     ng       1040: 		foreach (@$partlist) {
                   1041: 		    $gradeTable.='<td>&nbsp;</td>';
                   1042: 		}
1.301     albertel 1043: 	    } elsif ($submitonly eq 'queued') {
                   1044: 		$gradeTable.='<td>&nbsp;</td>';
1.110     ng       1045: 	    }
1.474     albertel 1046: 	$gradeTable.=&Apache::loncommon::end_data_table_row();
1.110     ng       1047:     }
                   1048: 
1.474     albertel 1049:     $gradeTable.=&Apache::loncommon::end_data_table()."\n".
1.45      ng       1050: 	'<input type="button" '.
                   1051: 	'onClick="javascript:checkSelect(this.form.stuinfo);" '.
1.485     albertel 1052: 	'value="'.&mt('Next-&gt;').'" /></form>'."\n";
1.45      ng       1053:     if ($ctr == 0) {
1.96      albertel 1054: 	my $num_students=(scalar(keys(%$fullname)));
                   1055: 	if ($num_students eq 0) {
1.485     albertel 1056: 	    $gradeTable='<br />&nbsp;<span class="LC_warning">'.&mt('There are no students currently enrolled.').'</span>';
1.96      albertel 1057: 	} else {
1.171     albertel 1058: 	    my $submissions='submissions';
                   1059: 	    if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; }
                   1060: 	    if ($submitonly eq 'graded'   ) { $submissions = 'ungraded submissions'; }
1.301     albertel 1061: 	    if ($submitonly eq 'queued'   ) { $submissions = 'queued submissions'; }
1.398     albertel 1062: 	    $gradeTable='<br />&nbsp;<span class="LC_warning">'.
1.485     albertel 1063: 		&mt('No '.$submissions.' found for this resource for any students. ([_1] students checked for '.$submissions.')',
                   1064: 		    $num_students).
                   1065: 		'</span><br />';
1.96      albertel 1066: 	}
1.46      ng       1067:     } elsif ($ctr == 1) {
1.474     albertel 1068: 	$gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/;
1.45      ng       1069:     }
1.324     albertel 1070:     $gradeTable.=&show_grading_menu_form($symb);
1.45      ng       1071:     $request->print($gradeTable);
1.44      ng       1072:     return '';
1.10      ng       1073: }
                   1074: 
1.44      ng       1075: #---- Called from the listStudents routine
1.249     albertel 1076: 
                   1077: sub check_script {
                   1078:     my ($form, $type)=@_;
                   1079:     my $chkallscript='<script type="text/javascript">
                   1080:     function checkall() {
                   1081:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1082:             ele = document.forms.'.$form.'.elements[i];
                   1083:             if (ele.name == "'.$type.'") {
                   1084:             document.forms.'.$form.'.elements[i].checked=true;
                   1085:                                        }
                   1086:         }
                   1087:     }
                   1088: 
                   1089:     function checksec() {
                   1090:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1091:             ele = document.forms.'.$form.'.elements[i];
                   1092:            string = document.forms.'.$form.'.chksec.value;
                   1093:            if
                   1094:           (ele.value.indexOf(":::SECTION"+string)>0) {
                   1095:               document.forms.'.$form.'.elements[i].checked=true;
                   1096:             }
                   1097:         }
                   1098:     }
                   1099: 
                   1100: 
                   1101:     function uncheckall() {
                   1102:         for (i=0; i<document.forms.'.$form.'.elements.length; i++) {
                   1103:             ele = document.forms.'.$form.'.elements[i];
                   1104:             if (ele.name == "'.$type.'") {
                   1105:             document.forms.'.$form.'.elements[i].checked=false;
                   1106:                                        }
                   1107:         }
                   1108:     }
                   1109: 
                   1110: </script>'."\n";
                   1111:     return $chkallscript;
                   1112: }
                   1113: 
                   1114: sub check_buttons {
1.485     albertel 1115:     my $buttons.='<input type="button" onclick="checkall()" value="'.&mt('Check All').'" />';
                   1116:     $buttons.='<input type="button" onclick="uncheckall()" value="'.&mt('Uncheck All').'" />&nbsp;';
                   1117:     $buttons.='<input type="button" onclick="checksec()" value="'.&mt('Check Section/Group').'" />';
1.249     albertel 1118:     $buttons.='<input type="text" size="5" name="chksec" />&nbsp;';
                   1119:     return $buttons;
                   1120: }
                   1121: 
1.44      ng       1122: #     Displays the submissions for one student or a group of students
1.34      ng       1123: sub processGroup {
1.41      ng       1124:     my ($request)  = shift;
                   1125:     my $ctr        = 0;
1.155     albertel 1126:     my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo');
1.41      ng       1127:     my $total      = scalar(@stuchecked)-1;
1.45      ng       1128: 
1.396     banghart 1129:     foreach my $student (@stuchecked) {
                   1130: 	my ($uname,$udom,$fullname) = split(/:/,$student);
1.257     albertel 1131: 	$env{'form.student'}        = $uname;
                   1132: 	$env{'form.userdom'}        = $udom;
                   1133: 	$env{'form.fullname'}       = $fullname;
1.41      ng       1134: 	&submission($request,$ctr,$total);
                   1135: 	$ctr++;
                   1136:     }
                   1137:     return '';
1.35      ng       1138: }
1.34      ng       1139: 
1.44      ng       1140: #------------------------------------------------------------------------------------
                   1141: #
                   1142: #-------------------------- Next few routines handles grading by student, essentially
                   1143: #                           handles essay response type problem/part
                   1144: #
                   1145: #--- Javascript to handle the submission page functionality ---
                   1146: sub sub_page_js {
                   1147:     my $request = shift;
                   1148:     $request->print(<<SUBJAVASCRIPT);
                   1149: <script type="text/javascript" language="javascript">
1.71      ng       1150:     function updateRadio(formname,id,weight) {
1.125     ng       1151: 	var gradeBox = formname["GD_BOX"+id];
                   1152: 	var radioButton = formname["RADVAL"+id];
                   1153: 	var oldpts = formname["oldpts"+id].value;
1.72      ng       1154: 	var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts;
1.71      ng       1155: 	gradeBox.value = pts;
                   1156: 	var resetbox = false;
                   1157: 	if (isNaN(pts) || pts < 0) {
                   1158: 	    alert("A number equal or greater than 0 is expected. Entered value = "+pts);
                   1159: 	    for (var i=0; i<radioButton.length; i++) {
                   1160: 		if (radioButton[i].checked) {
                   1161: 		    gradeBox.value = i;
                   1162: 		    resetbox = true;
                   1163: 		}
                   1164: 	    }
                   1165: 	    if (!resetbox) {
                   1166: 		formtextbox.value = "";
                   1167: 	    }
                   1168: 	    return;
1.44      ng       1169: 	}
1.71      ng       1170: 
                   1171: 	if (pts > weight) {
                   1172: 	    var resp = confirm("You entered a value ("+pts+
                   1173: 			       ") greater than the weight for the part. Accept?");
                   1174: 	    if (resp == false) {
1.125     ng       1175: 		gradeBox.value = oldpts;
1.71      ng       1176: 		return;
                   1177: 	    }
1.44      ng       1178: 	}
1.13      albertel 1179: 
1.71      ng       1180: 	for (var i=0; i<radioButton.length; i++) {
                   1181: 	    radioButton[i].checked=false;
                   1182: 	    if (pts == i && pts != "") {
                   1183: 		radioButton[i].checked=true;
                   1184: 	    }
                   1185: 	}
                   1186: 	updateSelect(formname,id);
1.125     ng       1187: 	formname["stores"+id].value = "0";
1.41      ng       1188:     }
1.5       albertel 1189: 
1.72      ng       1190:     function writeBox(formname,id,pts) {
1.125     ng       1191: 	var gradeBox = formname["GD_BOX"+id];
1.71      ng       1192: 	if (checkSolved(formname,id) == 'update') {
                   1193: 	    gradeBox.value = pts;
                   1194: 	} else {
1.125     ng       1195: 	    var oldpts = formname["oldpts"+id].value;
1.72      ng       1196: 	    gradeBox.value = oldpts;
1.125     ng       1197: 	    var radioButton = formname["RADVAL"+id];
1.71      ng       1198: 	    for (var i=0; i<radioButton.length; i++) {
                   1199: 		radioButton[i].checked=false;
1.72      ng       1200: 		if (i == oldpts) {
1.71      ng       1201: 		    radioButton[i].checked=true;
                   1202: 		}
                   1203: 	    }
1.41      ng       1204: 	}
1.125     ng       1205: 	formname["stores"+id].value = "0";
1.71      ng       1206: 	updateSelect(formname,id);
                   1207: 	return;
1.41      ng       1208:     }
1.44      ng       1209: 
1.71      ng       1210:     function clearRadBox(formname,id) {
                   1211: 	if (checkSolved(formname,id) == 'noupdate') {
                   1212: 	    updateSelect(formname,id);
                   1213: 	    return;
                   1214: 	}
1.125     ng       1215: 	gradeSelect = formname["GD_SEL"+id];
1.71      ng       1216: 	for (var i=0; i<gradeSelect.length; i++) {
                   1217: 	    if (gradeSelect[i].selected) {
                   1218: 		var selectx=i;
                   1219: 	    }
                   1220: 	}
1.125     ng       1221: 	var stores = formname["stores"+id];
1.71      ng       1222: 	if (selectx == stores.value) { return };
1.125     ng       1223: 	var gradeBox = formname["GD_BOX"+id];
1.71      ng       1224: 	gradeBox.value = "";
1.125     ng       1225: 	var radioButton = formname["RADVAL"+id];
1.71      ng       1226: 	for (var i=0; i<radioButton.length; i++) {
                   1227: 	    radioButton[i].checked=false;
                   1228: 	}
                   1229: 	stores.value = selectx;
                   1230:     }
1.5       albertel 1231: 
1.71      ng       1232:     function checkSolved(formname,id) {
1.125     ng       1233: 	if (formname["solved"+id].value == "correct_by_student" && formname.overRideScore.value == 'no') {
1.118     ng       1234: 	    var reply = confirm("This problem has been graded correct by the computer. Do you want to change the score?");
                   1235: 	    if (!reply) {return "noupdate";}
1.120     ng       1236: 	    formname.overRideScore.value = 'yes';
1.41      ng       1237: 	}
1.71      ng       1238: 	return "update";
1.13      albertel 1239:     }
1.71      ng       1240: 
                   1241:     function updateSelect(formname,id) {
1.125     ng       1242: 	formname["GD_SEL"+id][0].selected = true;
1.71      ng       1243: 	return;
1.41      ng       1244:     }
1.33      ng       1245: 
1.121     ng       1246: //=========== Check that a point is assigned for all the parts  ============
1.71      ng       1247:     function checksubmit(formname,val,total,parttot) {
1.121     ng       1248: 	formname.gradeOpt.value = val;
1.71      ng       1249: 	if (val == "Save & Next") {
                   1250: 	    for (i=0;i<=total;i++) {
                   1251: 		for (j=0;j<parttot;j++) {
1.125     ng       1252: 		    var partid = formname["partid"+i+"_"+j].value;
1.127     ng       1253: 		    if (formname["GD_SEL"+i+"_"+partid][0].selected) {
1.125     ng       1254: 			var points = formname["GD_BOX"+i+"_"+partid].value;
1.71      ng       1255: 			if (points == "") {
1.125     ng       1256: 			    var name = formname["name"+i].value;
1.129     ng       1257: 			    var studentID = (name != '' ? name : formname["unamedom"+i].value);
                   1258: 			    var resp = confirm("You did not assign a score for "+studentID+
                   1259: 					       ", part "+partid+". Continue?");
1.71      ng       1260: 			    if (resp == false) {
1.125     ng       1261: 				formname["GD_BOX"+i+"_"+partid].focus();
1.71      ng       1262: 				return false;
                   1263: 			    }
                   1264: 			}
                   1265: 		    }
                   1266: 		    
                   1267: 		}
                   1268: 	    }
                   1269: 	    
                   1270: 	}
1.121     ng       1271: 	if (val == "Grade Student") {
                   1272: 	    formname.showgrading.value = "yes";
                   1273: 	    if (formname.Status.value == "") {
                   1274: 		formname.Status.value = "Active";
                   1275: 	    }
                   1276: 	    formname.studentNo.value = total;
                   1277: 	}
1.120     ng       1278: 	formname.submit();
                   1279:     }
                   1280: 
1.71      ng       1281: //======= Check that a score is assigned for all the problems (page/sequence grading only) =========
                   1282:     function checkSubmitPage(formname,total) {
                   1283: 	noscore = new Array(100);
                   1284: 	var ptr = 0;
                   1285: 	for (i=1;i<total;i++) {
1.125     ng       1286: 	    var partid = formname["q_"+i].value;
1.127     ng       1287: 	    if (formname["GD_SEL"+i+"_"+partid][0].selected) {
1.125     ng       1288: 		var points = formname["GD_BOX"+i+"_"+partid].value;
                   1289: 		var status = formname["solved"+i+"_"+partid].value;
1.71      ng       1290: 		if (points == "" && status != "correct_by_student") {
                   1291: 		    noscore[ptr] = i;
                   1292: 		    ptr++;
                   1293: 		}
                   1294: 	    }
                   1295: 	}
                   1296: 	if (ptr != 0) {
                   1297: 	    var sense = ptr == 1 ? ": " : "s: ";
                   1298: 	    var prolist = "";
                   1299: 	    if (ptr == 1) {
                   1300: 		prolist = noscore[0];
                   1301: 	    } else {
                   1302: 		var i = 0;
                   1303: 		while (i < ptr-1) {
                   1304: 		    prolist += noscore[i]+", ";
                   1305: 		    i++;
                   1306: 		}
                   1307: 		prolist += "and "+noscore[i];
                   1308: 	    }
                   1309: 	    var resp = confirm("You did not assign any score for the following problem"+sense+prolist+". Continue?");
                   1310: 	    if (resp == false) {
                   1311: 		return false;
                   1312: 	    }
                   1313: 	}
1.45      ng       1314: 
1.71      ng       1315: 	formname.submit();
                   1316:     }
                   1317: </script>
                   1318: SUBJAVASCRIPT
                   1319: }
1.45      ng       1320: 
1.71      ng       1321: #--- javascript for essay type problem --
                   1322: sub sub_page_kw_js {
                   1323:     my $request = shift;
1.80      ng       1324:     my $iconpath = $request->dir_config('lonIconsURL');
1.118     ng       1325:     &commonJSfunctions($request);
1.350     albertel 1326: 
1.351     albertel 1327:     my $inner_js_msg_central=<<INNERJS;
1.350     albertel 1328:     <script text="text/javascript">
                   1329:     function checkInput() {
                   1330:       opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value);
                   1331:       var nmsg   = opener.document.SCORE.savemsgN.value;
                   1332:       var usrctr = document.msgcenter.usrctr.value;
                   1333:       var newval = opener.document.SCORE["newmsg"+usrctr];
                   1334:       newval.value = opener.checkEntities(document.msgcenter.newmsg.value);
                   1335: 
                   1336:       var msgchk = "";
                   1337:       if (document.msgcenter.subchk.checked) {
                   1338:          msgchk = "msgsub,";
                   1339:       }
                   1340:       var includemsg = 0;
                   1341:       for (var i=1; i<=nmsg; i++) {
                   1342:           var opnmsg = opener.document.SCORE["savemsg"+i];
                   1343:           var frmmsg = document.msgcenter["msg"+i];
                   1344:           opnmsg.value = opener.checkEntities(frmmsg.value);
                   1345:           var showflg = opener.document.SCORE["shownOnce"+i];
                   1346:           showflg.value = "1";
                   1347:           var chkbox = document.msgcenter["msgn"+i];
                   1348:           if (chkbox.checked) {
                   1349:              msgchk += "savemsg"+i+",";
                   1350:              includemsg = 1;
                   1351:           }
                   1352:       }
                   1353:       if (document.msgcenter.newmsgchk.checked) {
                   1354:          msgchk += "newmsg"+usrctr;
                   1355:          includemsg = 1;
                   1356:       }
                   1357:       imgformname = opener.document.SCORE["mailicon"+usrctr];
                   1358:       imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif");
                   1359:       var includemsg = opener.document.SCORE["includemsg"+usrctr];
                   1360:       includemsg.value = msgchk;
                   1361: 
                   1362:       self.close()
                   1363: 
                   1364:     }
                   1365:     </script>
                   1366: INNERJS
                   1367: 
1.351     albertel 1368:     my $inner_js_highlight_central=<<INNERJS;
                   1369:  <script type="text/javascript">
                   1370:     function updateChoice(flag) {
                   1371:       opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr);
                   1372:       opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize);
                   1373:       opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle);
                   1374:       opener.document.SCORE.refresh.value = "on";
                   1375:       if (opener.document.SCORE.keywords.value!=""){
                   1376:          opener.document.SCORE.submit();
                   1377:       }
                   1378:       self.close()
                   1379:     }
                   1380: </script>
                   1381: INNERJS
                   1382: 
                   1383:     my $start_page_msg_central = 
                   1384:         &Apache::loncommon::start_page('Message Central',$inner_js_msg_central,
                   1385: 				       {'js_ready'  => 1,
                   1386: 					'only_body' => 1,
                   1387: 					'bgcolor'   =>'#FFFFFF',});
                   1388:     my $end_page_msg_central = 
                   1389: 	&Apache::loncommon::end_page({'js_ready' => 1});
                   1390: 
                   1391: 
                   1392:     my $start_page_highlight_central = 
                   1393:         &Apache::loncommon::start_page('Highlight Central',
                   1394: 				       $inner_js_highlight_central,
1.350     albertel 1395: 				       {'js_ready'  => 1,
                   1396: 					'only_body' => 1,
                   1397: 					'bgcolor'   =>'#FFFFFF',});
1.351     albertel 1398:     my $end_page_highlight_central = 
1.350     albertel 1399: 	&Apache::loncommon::end_page({'js_ready' => 1});
                   1400: 
1.219     www      1401:     my $docopen=&Apache::lonhtmlcommon::javascript_docopen();
1.236     albertel 1402:     $docopen=~s/^document\.//;
1.71      ng       1403:     $request->print(<<SUBJAVASCRIPT);
                   1404: <script type="text/javascript" language="javascript">
1.45      ng       1405: 
1.44      ng       1406: //===================== Show list of keywords ====================
1.122     ng       1407:   function keywords(formname) {
                   1408:     var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",formname.keywords.value);
1.44      ng       1409:     if (nret==null) return;
1.122     ng       1410:     formname.keywords.value = nret;
1.44      ng       1411: 
1.122     ng       1412:     if (formname.keywords.value != "") {
1.128     ng       1413: 	formname.refresh.value = "on";
1.122     ng       1414: 	formname.submit();
1.44      ng       1415:     }
                   1416:     return;
                   1417:   }
                   1418: 
                   1419: //===================== Script to view submitted by ==================
                   1420:   function viewSubmitter(submitter) {
                   1421:     document.SCORE.refresh.value = "on";
                   1422:     document.SCORE.NCT.value = "1";
                   1423:     document.SCORE.unamedom0.value = submitter;
                   1424:     document.SCORE.submit();
                   1425:     return;
                   1426:   }
                   1427: 
                   1428: //===================== Script to add keyword(s) ==================
                   1429:   function getSel() {
                   1430:     if (document.getSelection) txt = document.getSelection();
                   1431:     else if (document.selection) txt = document.selection.createRange().text;
                   1432:     else return;
                   1433:     var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," ");
                   1434:     if (cleantxt=="") {
1.46      ng       1435: 	alert("Please select a word or group of words from document and then click this link.");
1.44      ng       1436: 	return;
                   1437:     }
                   1438:     var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt);
                   1439:     if (nret==null) return;
1.127     ng       1440:     document.SCORE.keywords.value = document.SCORE.keywords.value+" "+nret;
1.44      ng       1441:     if (document.SCORE.keywords.value != "") {
1.127     ng       1442: 	document.SCORE.refresh.value = "on";
1.44      ng       1443: 	document.SCORE.submit();
                   1444:     }
                   1445:     return;
                   1446:   }
                   1447: 
                   1448: //====================== Script for composing message ==============
1.80      ng       1449:    // preload images
                   1450:    img1 = new Image();
                   1451:    img1.src = "$iconpath/mailbkgrd.gif";
                   1452:    img2 = new Image();
                   1453:    img2.src = "$iconpath/mailto.gif";
                   1454: 
1.44      ng       1455:   function msgCenter(msgform,usrctr,fullname) {
                   1456:     var Nmsg  = msgform.savemsgN.value;
                   1457:     savedMsgHeader(Nmsg,usrctr,fullname);
                   1458:     var subject = msgform.msgsub.value;
1.127     ng       1459:     var msgchk = document.SCORE["includemsg"+usrctr].value;
1.44      ng       1460:     re = /msgsub/;
                   1461:     var shwsel = "";
                   1462:     if (re.test(msgchk)) { shwsel = "checked" }
1.123     ng       1463:     subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject);
                   1464:     displaySubject(checkEntities(subject),shwsel);
1.44      ng       1465:     for (var i=1; i<=Nmsg; i++) {
1.123     ng       1466: 	var testmsg = "savemsg"+i+",";
                   1467: 	re = new RegExp(testmsg,"g");
1.44      ng       1468: 	shwsel = "";
                   1469: 	if (re.test(msgchk)) { shwsel = "checked" }
1.125     ng       1470: 	var message = document.SCORE["savemsg"+i].value;
1.126     ng       1471: 	message = (document.SCORE["shownOnce"+i].value == 0 ? checkEntities(message) : message);
1.123     ng       1472: 	displaySavedMsg(i,message,shwsel); //I do not get it. w/o checkEntities on saved messages,
                   1473: 	                                   //any &lt; is already converted to <, etc. However, only once!!
1.44      ng       1474:     }
1.125     ng       1475:     newmsg = document.SCORE["newmsg"+usrctr].value;
1.44      ng       1476:     shwsel = "";
                   1477:     re = /newmsg/;
                   1478:     if (re.test(msgchk)) { shwsel = "checked" }
                   1479:     newMsg(newmsg,shwsel);
                   1480:     msgTail(); 
                   1481:     return;
                   1482:   }
                   1483: 
1.123     ng       1484:   function checkEntities(strx) {
                   1485:     if (strx.length == 0) return strx;
                   1486:     var orgStr = ["&", "<", ">", '"']; 
                   1487:     var newStr = ["&amp;", "&lt;", "&gt;", "&quot;"];
                   1488:     var counter = 0;
                   1489:     while (counter < 4) {
                   1490: 	strx = strReplace(strx,orgStr[counter],newStr[counter]);
                   1491: 	counter++;
                   1492:     }
                   1493:     return strx;
                   1494:   }
                   1495: 
                   1496:   function strReplace(strx, orgStr, newStr) {
                   1497:     return strx.split(orgStr).join(newStr);
                   1498:   }
                   1499: 
1.44      ng       1500:   function savedMsgHeader(Nmsg,usrctr,fullname) {
1.76      ng       1501:     var height = 70*Nmsg+250;
1.44      ng       1502:     var scrollbar = "no";
                   1503:     if (height > 600) {
                   1504: 	height = 600;
                   1505: 	scrollbar = "yes";
                   1506:     }
1.118     ng       1507:     var xpos = (screen.width-600)/2;
                   1508:     xpos = (xpos < 0) ? '0' : xpos;
                   1509:     var ypos = (screen.height-height)/2-30;
                   1510:     ypos = (ypos < 0) ? '0' : ypos;
                   1511: 
1.206     albertel 1512:     pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height);
1.76      ng       1513:     pWin.focus();
                   1514:     pDoc = pWin.document;
1.219     www      1515:     pDoc.$docopen;
1.351     albertel 1516:     pDoc.write('$start_page_msg_central');
1.76      ng       1517: 
                   1518:     pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">");
                   1519:     pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">");
1.465     albertel 1520:     pDoc.write("<h3><span class=\\"LC_info\\">&nbsp;Compose Message for \"+fullname+\"<\\/span><\\/h3><br /><br />");
1.76      ng       1521: 
                   1522:     pDoc.write("<table border=0 width=100%><tr><td bgcolor=\\"#777777\\">");
                   1523:     pDoc.write("<table border=0 width=100%><tr bgcolor=\\"#ddffff\\">");
1.465     albertel 1524:     pDoc.write("<td><b>Type<\\/b><\\/td><td><b>Include<\\/b><\\/td><td><b>Message<\\/td><\\/tr>");
1.44      ng       1525: }
                   1526:     function displaySubject(msg,shwsel) {
1.76      ng       1527:     pDoc = pWin.document;
                   1528:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1529:     pDoc.write("<td>Subject<\\/td>");
                   1530:     pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1531:     pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"60\\" maxlength=\\"80\\"><\\/td><\\/tr>");
1.44      ng       1532: }
                   1533: 
1.72      ng       1534:   function displaySavedMsg(ctr,msg,shwsel) {
1.76      ng       1535:     pDoc = pWin.document;
                   1536:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1537:     pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>");
                   1538:     pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1539:     pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>");
1.44      ng       1540: }
                   1541: 
                   1542:   function newMsg(newmsg,shwsel) {
1.76      ng       1543:     pDoc = pWin.document;
                   1544:     pDoc.write("<tr bgcolor=\\"#ffffdd\\">");
1.465     albertel 1545:     pDoc.write("<td align=\\"center\\">New<\\/td>");
                   1546:     pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>");
                   1547:     pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>");
1.44      ng       1548: }
                   1549: 
                   1550:   function msgTail() {
1.76      ng       1551:     pDoc = pWin.document;
1.465     albertel 1552:     pDoc.write("<\\/table>");
                   1553:     pDoc.write("<\\/td><\\/tr><\\/table>&nbsp;");
1.76      ng       1554:     pDoc.write("<input type=\\"button\\" value=\\"Save\\" onClick=\\"javascript:checkInput()\\">&nbsp;&nbsp;");
1.326     albertel 1555:     pDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onClick=\\"self.close()\\"><br /><br />");
1.465     albertel 1556:     pDoc.write("<\\/form>");
1.351     albertel 1557:     pDoc.write('$end_page_msg_central');
1.128     ng       1558:     pDoc.close();
1.44      ng       1559: }
                   1560: 
                   1561: //====================== Script for keyword highlight options ==============
                   1562:   function kwhighlight() {
                   1563:     var kwclr    = document.SCORE.kwclr.value;
                   1564:     var kwsize   = document.SCORE.kwsize.value;
                   1565:     var kwstyle  = document.SCORE.kwstyle.value;
                   1566:     var redsel = "";
                   1567:     var grnsel = "";
                   1568:     var blusel = "";
                   1569:     if (kwclr=="red")   {var redsel="checked"};
                   1570:     if (kwclr=="green") {var grnsel="checked"};
                   1571:     if (kwclr=="blue")  {var blusel="checked"};
                   1572:     var sznsel = "";
                   1573:     var sz1sel = "";
                   1574:     var sz2sel = "";
                   1575:     if (kwsize=="0")  {var sznsel="checked"};
                   1576:     if (kwsize=="+1") {var sz1sel="checked"};
                   1577:     if (kwsize=="+2") {var sz2sel="checked"};
                   1578:     var synsel = "";
                   1579:     var syisel = "";
                   1580:     var sybsel = "";
                   1581:     if (kwstyle=="")    {var synsel="checked"};
                   1582:     if (kwstyle=="<i>") {var syisel="checked"};
                   1583:     if (kwstyle=="<b>") {var sybsel="checked"};
                   1584:     highlightCentral();
                   1585:     highlightbody('red','red',redsel,'0','normal',sznsel,'','normal',synsel);
                   1586:     highlightbody('green','green',grnsel,'+1','+1',sz1sel,'<i>','italic',syisel);
                   1587:     highlightbody('blue','blue',blusel,'+2','+2',sz2sel,'<b>','bold',sybsel);
                   1588:     highlightend();
                   1589:     return;
                   1590:   }
                   1591: 
                   1592:   function highlightCentral() {
1.76      ng       1593: //    if (window.hwdWin) window.hwdWin.close();
1.118     ng       1594:     var xpos = (screen.width-400)/2;
                   1595:     xpos = (xpos < 0) ? '0' : xpos;
                   1596:     var ypos = (screen.height-330)/2-30;
                   1597:     ypos = (ypos < 0) ? '0' : ypos;
                   1598: 
1.206     albertel 1599:     hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos);
1.76      ng       1600:     hwdWin.focus();
                   1601:     var hDoc = hwdWin.document;
1.219     www      1602:     hDoc.$docopen;
1.351     albertel 1603:     hDoc.write('$start_page_highlight_central');
1.76      ng       1604:     hDoc.write("<form action=\\"inactive\\" name=\\"hlCenter\\">");
1.465     albertel 1605:     hDoc.write("<h3><span class=\\"LC_info\\">&nbsp;Keyword Highlight Options<\\/span><\\/h3><br /><br />");
1.76      ng       1606: 
                   1607:     hDoc.write("<table border=0 width=100%><tr><td bgcolor=\\"#777777\\">");
                   1608:     hDoc.write("<table border=0 width=100%><tr bgcolor=\\"#ddffff\\">");
1.465     albertel 1609:     hDoc.write("<td><b>Text Color<\\/b><\\/td><td><b>Font Size<\\/b><\\/td><td><b>Font Style<\\/td><\\/tr>");
1.44      ng       1610:   }
                   1611: 
                   1612:   function highlightbody(clrval,clrtxt,clrsel,szval,sztxt,szsel,syval,sytxt,sysel) { 
1.76      ng       1613:     var hDoc = hwdWin.document;
                   1614:     hDoc.write("<tr bgcolor=\\"#ffffdd\\">");
                   1615:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1616:     hDoc.write("<input name=\\"kwdclr\\" type=\\"radio\\" value=\\""+clrval+"\\" "+clrsel+">&nbsp;"+clrtxt+"<\\/td>");
1.76      ng       1617:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1618:     hDoc.write("<input name=\\"kwdsize\\" type=\\"radio\\" value=\\""+szval+"\\" "+szsel+">&nbsp;"+sztxt+"<\\/td>");
1.76      ng       1619:     hDoc.write("<td align=\\"left\\">");
1.465     albertel 1620:     hDoc.write("<input name=\\"kwdstyle\\" type=\\"radio\\" value=\\""+syval+"\\" "+sysel+">&nbsp;"+sytxt+"<\\/td>");
                   1621:     hDoc.write("<\\/tr>");
1.44      ng       1622:   }
                   1623: 
                   1624:   function highlightend() { 
1.76      ng       1625:     var hDoc = hwdWin.document;
1.465     albertel 1626:     hDoc.write("<\\/table>");
                   1627:     hDoc.write("<\\/td><\\/tr><\\/table>&nbsp;");
1.76      ng       1628:     hDoc.write("<input type=\\"button\\" value=\\"Save\\" onClick=\\"javascript:updateChoice(1)\\">&nbsp;&nbsp;");
1.326     albertel 1629:     hDoc.write("<input type=\\"button\\" value=\\"Cancel\\" onClick=\\"self.close()\\"><br /><br />");
1.465     albertel 1630:     hDoc.write("<\\/form>");
1.351     albertel 1631:     hDoc.write('$end_page_highlight_central');
1.128     ng       1632:     hDoc.close();
1.44      ng       1633:   }
                   1634: 
                   1635: </script>
                   1636: SUBJAVASCRIPT
                   1637: }
                   1638: 
1.349     albertel 1639: sub get_increment {
1.348     bowersj2 1640:     my $increment = $env{'form.increment'};
                   1641:     if ($increment != 1 && $increment != .5 && $increment != .25 &&
                   1642:         $increment != .1) {
                   1643:         $increment = 1;
                   1644:     }
                   1645:     return $increment;
                   1646: }
                   1647: 
1.71      ng       1648: #--- displays the grading box, used in essay type problem and grading by page/sequence
                   1649: sub gradeBox {
1.322     albertel 1650:     my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_;
1.381     albertel 1651:     my $checkIcon = '<img alt="'.&mt('Check Mark').
1.485     albertel 1652: 	'" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />';
1.71      ng       1653:     my $wgt    = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
1.466     albertel 1654:     my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)') 
                   1655:                            : '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>';
1.71      ng       1656:     $wgt       = ($wgt > 0 ? $wgt : '1');
                   1657:     my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
1.320     albertel 1658: 		  '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
1.71      ng       1659:     my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
1.466     albertel 1660:     my $display_part= &get_display_part($partid,$symb);
1.270     albertel 1661:     my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
                   1662: 				       [$partid]);
                   1663:     my $aggtries = $$record{'resource.'.$partid.'.tries'};
1.269     raeburn  1664:     if ($last_resets{$partid}) {
                   1665:         $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
                   1666:     }
1.485     albertel 1667:     $result.='<table border="0"><tr>';
1.71      ng       1668:     my $ctr = 0;
1.348     bowersj2 1669:     my $thisweight = 0;
1.349     albertel 1670:     my $increment = &get_increment();
1.485     albertel 1671: 
                   1672:     my $radio.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across
1.348     bowersj2 1673:     while ($thisweight<=$wgt) {
1.485     albertel 1674: 	$radio.= '<td><span style="white-space: nowrap;"><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.
1.71      ng       1675: 	    'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.
1.348     bowersj2 1676: 	    $thisweight.')" value="'.$thisweight.'" '.
1.401     albertel 1677: 	    ($score eq $thisweight ? 'checked="checked"':'').' /> '.$thisweight."</label></span></td>\n";
1.485     albertel 1678: 	$radio.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');
1.348     bowersj2 1679:         $thisweight += $increment;
1.71      ng       1680: 	$ctr++;
                   1681:     }
1.485     albertel 1682:     $radio.='</tr></table>';
                   1683: 
                   1684:     my $line.='<input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'.
1.71      ng       1685: 	($score ne ''? ' value = "'.$score.'"':'').' size="4" '.
                   1686: 	'onChange="javascript:updateRadio(this.form,\''.$counter.'_'.$partid.'\','.
                   1687: 	$wgt.')" /></td>'."\n";
1.485     albertel 1688:     $line.='<td>/'.$wgt.' '.$wgtmsg.
1.71      ng       1689: 	($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? '&nbsp;'.$checkIcon : '').
                   1690: 	' </td><td>'."\n";
1.485     albertel 1691:     $line.='<select name="GD_SEL'.$counter.'_'.$partid.'" '.
1.71      ng       1692: 	'onChange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n";
                   1693:     if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {
1.485     albertel 1694: 	$line.='<option></option>'.
                   1695: 	    '<option value="excused" selected="selected">'.&mt('excused').'</option>';
1.71      ng       1696:     } else {
1.485     albertel 1697: 	$line.='<option selected="selected"></option>'.
                   1698: 	    '<option value="excused" >'.&mt('excused').'</option>';
1.71      ng       1699:     }
1.485     albertel 1700:     $line.='<option value="reset status">'.&mt('reset status').'</option></select>'."\n";
                   1701: 
                   1702: 
                   1703:     $result .= 
                   1704: 	&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);
                   1705: 
                   1706:     
                   1707:     $result.='</tr></table>'."\n";
1.71      ng       1708:     $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".
                   1709: 	'<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n".
                   1710: 	'<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'.
1.269     raeburn  1711: 	$$record{'resource.'.$partid.'.solved'}.'" />'."\n".
                   1712:         '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'.
                   1713:         $$record{'resource.'.$partid.'.tries'}.'" />'."\n".
                   1714:         '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'.
                   1715:         $aggtries.'" />'."\n";
1.323     banghart 1716:     $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record);
1.318     banghart 1717:     return $result;
                   1718: }
1.322     albertel 1719: 
                   1720: sub handback_box {
1.323     banghart 1721:     my ($symb,$uname,$udom,$counter,$partid,$record) = @_;
1.324     albertel 1722:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.323     banghart 1723:     my (@respids);
1.375     albertel 1724:      my @part_response_id = &flatten_responseType($responseType);
                   1725:     foreach my $part_response_id (@part_response_id) {
                   1726:     	my ($part,$resp) = @{ $part_response_id };
1.323     banghart 1727:         if ($part eq $partid) {
1.375     albertel 1728:             push(@respids,$resp);
1.323     banghart 1729:         }
                   1730:     }
1.318     banghart 1731:     my $result;
1.323     banghart 1732:     foreach my $respid (@respids) {
1.322     albertel 1733: 	my $prefix = $counter.'_'.$partid.'_'.$respid.'_';
                   1734: 	my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record);
                   1735: 	next if (!@$files);
                   1736: 	my $file_counter = 1;
1.313     banghart 1737: 	foreach my $file (@$files) {
1.368     banghart 1738: 	    if ($file =~ /\/portfolio\//) {
                   1739:     	        my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|);
                   1740:     	        my ($name,$version,$ext) = &file_name_version_ext($file_disp);
                   1741:     	        $file_disp = "$name.$ext";
                   1742:     	        $file = $file_path.$file_disp;
                   1743:     	        $result.=&mt('Return commented version of [_1] to student.',
                   1744:     			 '<span class="LC_filename">'.$file_disp.'</span>');
                   1745:     	        $result.='<input type="file"   name="'.$prefix.'returndoc'.$file_counter.'" />'."\n";
                   1746:     	        $result.='<input type="hidden" name="'.$prefix.'origdoc'.$file_counter.'" value="'.$file.'" /><br />';
1.485     albertel 1747:     	        $result.='('.&mt('File will be uploaded when you click on Save &amp; Next below.').')<br />';
1.368     banghart 1748:     	        $file_counter++;
                   1749: 	    }
1.322     albertel 1750: 	}
1.313     banghart 1751:     }
1.318     banghart 1752:     return $result;    
1.71      ng       1753: }
1.44      ng       1754: 
1.58      albertel 1755: sub show_problem {
1.382     albertel 1756:     my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_;
1.144     albertel 1757:     my $rendered;
1.382     albertel 1758:     my %form = ((ref($form) eq 'HASH')? %{$form} : ());
1.329     albertel 1759:     &Apache::lonxml::remember_problem_counter();
1.144     albertel 1760:     if ($mode eq 'both' or $mode eq 'text') {
                   1761: 	$rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
1.382     albertel 1762: 						       $env{'request.course.id'},
                   1763: 						       undef,\%form);
1.144     albertel 1764:     }
1.58      albertel 1765:     if ($removeform) {
                   1766: 	$rendered=~s|<form(.*?)>||g;
                   1767: 	$rendered=~s|</form>||g;
1.374     albertel 1768: 	$rendered=~s|(<input[^>]*name\s*=\s*"?)(\w+)("?)|$1would_have_been_$2$3|g;
1.58      albertel 1769:     }
1.144     albertel 1770:     my $companswer;
                   1771:     if ($mode eq 'both' or $mode eq 'answer') {
1.329     albertel 1772: 	&Apache::lonxml::restore_problem_counter();
1.382     albertel 1773: 	$companswer=
                   1774: 	    &Apache::loncommon::get_student_answers($symb,$uname,$udom,
                   1775: 						    $env{'request.course.id'},
                   1776: 						    %form);
1.144     albertel 1777:     }
1.58      albertel 1778:     if ($removeform) {
                   1779: 	$companswer=~s|<form(.*?)>||g;
                   1780: 	$companswer=~s|</form>||g;
1.144     albertel 1781: 	$companswer=~s|name="submit"|name="would_have_been_submit"|g;
1.58      albertel 1782:     }
1.468     albertel 1783:     $rendered=
                   1784: 	'<div class="LC_grade_show_problem_header">'.
                   1785: 	&mt('View of the problem').
                   1786: 	'</div><div class="LC_grade_show_problem_problem">'.
                   1787: 	$rendered.
                   1788: 	'</div>';
                   1789:     $companswer=
                   1790: 	'<div class="LC_grade_show_problem_header">'.
                   1791: 	&mt('Correct answer').
                   1792: 	'</div><div class="LC_grade_show_problem_problem">'.
                   1793: 	$companswer.
                   1794: 	'</div>';
                   1795:     my $result;
1.144     albertel 1796:     if ($mode eq 'both') {
1.468     albertel 1797: 	$result=$rendered.$companswer;
1.144     albertel 1798:     } elsif ($mode eq 'text') {
1.468     albertel 1799: 	$result=$rendered;
1.144     albertel 1800:     } elsif ($mode eq 'answer') {
1.468     albertel 1801: 	$result=$companswer;
1.144     albertel 1802:     }
1.468     albertel 1803:     $result='<div class="LC_grade_show_problem">'.$result.'</div>';
1.71      ng       1804:     return $result;
1.58      albertel 1805: }
1.397     albertel 1806: 
1.396     banghart 1807: sub files_exist {
                   1808:     my ($r, $symb) = @_;
                   1809:     my @students = &Apache::loncommon::get_env_multiple('form.stuinfo');
1.397     albertel 1810: 
1.396     banghart 1811:     foreach my $student (@students) {
                   1812:         my ($uname,$udom,$fullname) = split(/:/,$student);
1.397     albertel 1813:         my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
                   1814: 					      $udom,$uname);
1.396     banghart 1815:         my ($string,$timestamp)= &get_last_submission(\%record);
1.397     albertel 1816:         foreach my $submission (@$string) {
                   1817:             my ($partid,$respid) =
                   1818: 		($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
                   1819:             my $files=&get_submitted_files($udom,$uname,$partid,$respid,
                   1820: 					   \%record);
                   1821:             return 1 if (@$files);
1.396     banghart 1822:         }
                   1823:     }
1.397     albertel 1824:     return 0;
1.396     banghart 1825: }
1.397     albertel 1826: 
1.394     banghart 1827: sub download_all_link {
                   1828:     my ($r,$symb) = @_;
1.395     albertel 1829:     my $all_students = 
                   1830: 	join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo'));
                   1831: 
                   1832:     my $parts =
                   1833: 	join("\n",&Apache::loncommon::get_env_multiple('form.vPart'));
                   1834: 
1.394     banghart 1835:     my $identifier = &Apache::loncommon::get_cgi_id();
                   1836:     &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students,
                   1837:                             'cgi.'.$identifier.'.symb' => $symb,
1.395     albertel 1838:                             'cgi.'.$identifier.'.parts' => $parts,);
                   1839:     $r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'.
                   1840: 	      &mt('Download All Submitted Documents').'</a>');
1.394     banghart 1841:     return
                   1842: }
1.395     albertel 1843: 
1.432     banghart 1844: sub build_section_inputs {
                   1845:     my $section_inputs;
                   1846:     if ($env{'form.section'} eq '') {
                   1847:         $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n";
                   1848:     } else {
                   1849:         my @sections = &Apache::loncommon::get_env_multiple('form.section');
1.434     albertel 1850:         foreach my $section (@sections) {
1.432     banghart 1851:             $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n";
                   1852:         }
                   1853:     }
                   1854:     return $section_inputs;
                   1855: }
                   1856: 
1.44      ng       1857: # --------------------------- show submissions of a student, option to grade 
                   1858: sub submission {
                   1859:     my ($request,$counter,$total) = @_;
1.257     albertel 1860:     my ($uname,$udom)     = ($env{'form.student'},$env{'form.userdom'});
                   1861:     $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student?
                   1862:     my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
                   1863:     $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';
1.324     albertel 1864:     my $symb = &get_symb($request); 
                   1865:     if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
1.104     albertel 1866: 
                   1867:     if (!&canview($usec)) {
1.398     albertel 1868: 	$request->print('<span class="LC_warning">Unable to view requested student.('.
                   1869: 			$uname.':'.$udom.' in section '.$usec.' in course id '.
                   1870: 			$env{'request.course.id'}.')</span>');
1.324     albertel 1871: 	$request->print(&show_grading_menu_form($symb));
1.104     albertel 1872: 	return;
                   1873:     }
                   1874: 
1.257     albertel 1875:     if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; }
                   1876:     if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; }
                   1877:     if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; }
                   1878:     my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
1.381     albertel 1879:     my $checkIcon = '<img alt="'.&mt('Check Mark').
                   1880: 	'" src="'.$request->dir_config('lonIconsURL').
1.122     ng       1881: 	'/check.gif" height="16" border="0" />';
1.41      ng       1882: 
1.426     albertel 1883:     my %old_essays;
1.41      ng       1884:     # header info
                   1885:     if ($counter == 0) {
                   1886: 	&sub_page_js($request);
1.257     albertel 1887: 	&sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes');
                   1888: 	$env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? 
                   1889: 	    &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
1.397     albertel 1890: 	if ($env{'form.handgrade'} eq 'yes' && &files_exist($request, $symb)) {
1.396     banghart 1891: 	    &download_all_link($request, $symb);
                   1892: 	}
1.485     albertel 1893: 	$request->print('<h3>&nbsp;<span class="LC_info">'.&mt('Submission Record').'</span></h3>'."\n".
                   1894: 			'<h4>&nbsp;'.&mt('<b>Resource: </b> [_1]',$env{'form.probTitle'}).'</h4>'."\n");
1.118     ng       1895: 
1.44      ng       1896: 	# option to display problem, only once else it cause problems 
                   1897:         # with the form later since the problem has a form.
1.257     albertel 1898: 	if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') {
1.144     albertel 1899: 	    my $mode;
1.257     albertel 1900: 	    if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') {
1.144     albertel 1901: 		$mode='both';
1.257     albertel 1902: 	    } elsif ($env{'form.vProb'} eq 'yes') {
1.144     albertel 1903: 		$mode='text';
1.257     albertel 1904: 	    } elsif ($env{'form.vAns'} eq 'yes') {
1.144     albertel 1905: 		$mode='answer';
                   1906: 	    }
1.329     albertel 1907: 	    &Apache::lonxml::clear_problem_counter();
1.144     albertel 1908: 	    $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));
1.41      ng       1909: 	}
1.441     www      1910: 
1.44      ng       1911: 	# kwclr is the only variable that is guaranteed to be non blank 
                   1912:         # if this subroutine has been called once.
1.41      ng       1913: 	my %keyhash = ();
1.257     albertel 1914: 	if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') {
1.41      ng       1915: 	    %keyhash = &Apache::lonnet::dump('nohist_handgrade',
1.257     albertel 1916: 					     $env{'course.'.$env{'request.course.id'}.'.domain'},
                   1917: 					     $env{'course.'.$env{'request.course.id'}.'.num'});
1.41      ng       1918: 
1.257     albertel 1919: 	    my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
                   1920: 	    $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : '';
                   1921: 	    $env{'form.kwclr'}    = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red';
                   1922: 	    $env{'form.kwsize'}   = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0';
                   1923: 	    $env{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
                   1924: 	    $env{'form.msgsub'}   = $keyhash{$symb.'_subject'} ne '' ? 
                   1925: 		$keyhash{$symb.'_subject'} : $env{'form.probTitle'};
                   1926: 	    $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0';
1.41      ng       1927: 	}
1.257     albertel 1928: 	my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'};
1.442     banghart 1929: 	my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.303     banghart 1930: 	$request->print('<form action="/adm/grades" method="post" name="SCORE" enctype="multipart/form-data">'."\n".
1.41      ng       1931: 			'<input type="hidden" name="command"    value="handgrade" />'."\n".
1.257     albertel 1932: 			'<input type="hidden" name="saveState"  value="'.$env{'form.saveState'}.'" />'."\n".
1.442     banghart 1933: 			'<input type="hidden" name="Status"     value="'.$stu_status.'" />'."\n".
1.120     ng       1934: 			'<input type="hidden" name="overRideScore" value="'.$overRideScore.'" />'."\n".
1.257     albertel 1935: 			'<input type="hidden" name="probTitle"  value="'.$env{'form.probTitle'}.'" />'."\n".
1.41      ng       1936: 			'<input type="hidden" name="refresh"    value="off" />'."\n".
1.120     ng       1937: 			'<input type="hidden" name="studentNo"  value="" />'."\n".
                   1938: 			'<input type="hidden" name="gradeOpt"   value="" />'."\n".
1.418     albertel 1939: 			'<input type="hidden" name="symb"       value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 1940: 			'<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" />'."\n".
                   1941: 			'<input type="hidden" name="vProb"      value="'.$env{'form.vProb'}.'" />'."\n".
                   1942: 			'<input type="hidden" name="vAns"       value="'.$env{'form.vAns'}.'" />'."\n".
                   1943: 			'<input type="hidden" name="lastSub"    value="'.$env{'form.lastSub'}.'" />'."\n".
1.432     banghart 1944: 			&build_section_inputs().
1.326     albertel 1945: 			'<input type="hidden" name="submitonly" value="'.$env{'form.submitonly'}.'" />'."\n".
                   1946: 			'<input type="hidden" name="handgrade"  value="'.$env{'form.handgrade'}.'" />'."\n".
1.41      ng       1947: 			'<input type="hidden" name="NCT"'.
1.257     albertel 1948: 			' value="'.($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : $total+1).'" />'."\n");
                   1949: 	if ($env{'form.handgrade'} eq 'yes') {
                   1950: 	    $request->print('<input type="hidden" name="keywords" value="'.$env{'form.keywords'}.'" />'."\n".
                   1951: 			    '<input type="hidden" name="kwclr"    value="'.$env{'form.kwclr'}.'" />'."\n".
                   1952: 			    '<input type="hidden" name="kwsize"   value="'.$env{'form.kwsize'}.'" />'."\n".
                   1953: 			    '<input type="hidden" name="kwstyle"  value="'.$env{'form.kwstyle'}.'" />'."\n".
                   1954: 			    '<input type="hidden" name="msgsub"   value="'.$env{'form.msgsub'}.'" />'."\n".
1.123     ng       1955: 			    '<input type="hidden" name="shownSub" value="0" />'."\n".
1.257     albertel 1956: 			    '<input type="hidden" name="savemsgN" value="'.$env{'form.savemsgN'}.'" />'."\n");
1.154     albertel 1957: 	    foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) {
                   1958: 		$request->print('<input type="hidden" name="vPart" value="'.$partid.'" />'."\n");
                   1959: 	    }
1.123     ng       1960: 	}
1.41      ng       1961: 	
                   1962: 	my ($cts,$prnmsg) = (1,'');
1.257     albertel 1963: 	while ($cts <= $env{'form.savemsgN'}) {
1.41      ng       1964: 	    $prnmsg.='<input type="hidden" name="savemsg'.$cts.'" value="'.
1.123     ng       1965: 		(!exists($keyhash{$symb.'_savemsg'.$cts}) ? 
1.257     albertel 1966: 		 &Apache::lonfeedback::clear_out_html($env{'form.savemsg'.$cts}) :
1.80      ng       1967: 		 &Apache::lonfeedback::clear_out_html($keyhash{$symb.'_savemsg'.$cts})).
1.123     ng       1968: 		'" />'."\n".
                   1969: 		'<input type="hidden" name="shownOnce'.$cts.'" value="0" />'."\n";
1.41      ng       1970: 	    $cts++;
                   1971: 	}
                   1972: 	$request->print($prnmsg);
1.32      ng       1973: 
1.257     albertel 1974: 	if ($env{'form.handgrade'} eq 'yes' && $env{'form.showgrading'} eq 'yes') {
1.88      www      1975: #
                   1976: # Print out the keyword options line
                   1977: #
1.41      ng       1978: 	    $request->print(<<KEYWORDS);
1.38      ng       1979: &nbsp;<b>Keyword Options:</b>&nbsp;
1.417     albertel 1980: <a href="javascript:keywords(document.SCORE);" target="_self">List</a>&nbsp; &nbsp;
1.38      ng       1981: <a href="#" onMouseDown="javascript:getSel(); return false"
                   1982:  CLASS="page">Paste Selection to List</a>&nbsp; &nbsp;
1.417     albertel 1983: <a href="javascript:kwhighlight();" target="_self">Highlight Attribute</a><br /><br />
1.38      ng       1984: KEYWORDS
1.88      www      1985: #
                   1986: # Load the other essays for similarity check
                   1987: #
1.324     albertel 1988:             my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb);
1.384     albertel 1989: 	    my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
1.359     www      1990: 	    $apath=&escape($apath);
1.88      www      1991: 	    $apath=~s/\W/\_/gs;
1.426     albertel 1992: 	    %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);
1.41      ng       1993:         }
                   1994:     }
1.44      ng       1995: 
1.441     www      1996: # This is where output for one specific student would start
1.468     albertel 1997:     my $add_class = ($counter%2) ? 'LC_grade_show_user_odd_row' : '';
1.441     www      1998:     $request->print("\n\n".
1.468     albertel 1999:                     '<div class="LC_grade_show_user '.$add_class.'">'.
                   2000: 		    '<div class="LC_grade_user_name">'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).'</div>'.
                   2001: 		    '<div class="LC_grade_show_user_body">'."\n");
1.441     www      2002: 
1.257     albertel 2003:     if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') {
1.144     albertel 2004: 	my $mode;
1.257     albertel 2005: 	if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') {
1.144     albertel 2006: 	    $mode='both';
1.257     albertel 2007: 	} elsif ($env{'form.vProb'} eq 'all' ) {
1.144     albertel 2008: 	    $mode='text';
1.257     albertel 2009: 	} elsif ($env{'form.vAns'} eq 'all') {
1.144     albertel 2010: 	    $mode='answer';
                   2011: 	}
1.329     albertel 2012: 	&Apache::lonxml::clear_problem_counter();
1.475     albertel 2013: 	$request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode,{'request.prefix' => 'ctr'.$counter}));
1.58      albertel 2014:     }
1.144     albertel 2015: 
1.257     albertel 2016:     my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.324     albertel 2017:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.41      ng       2018: 
1.44      ng       2019:     # Display student info
1.41      ng       2020:     $request->print(($counter == 0 ? '' : '<br />'));
1.468     albertel 2021:     my $result='<div class="LC_grade_submissions">';
                   2022:     
                   2023:     $result.='<div class="LC_grade_submissions_header">';
                   2024:     $result.= &mt('Submissions');
1.45      ng       2025:     $result.='<input type="hidden" name="name'.$counter.
1.257     albertel 2026: 	'" value="'.$env{'form.fullname'}.'" />'."\n";
1.469     albertel 2027:     if ($env{'form.handgrade'} eq 'no') {
                   2028: 	$result.='<span class="LC_grade_check_note">'.
                   2029: 	    &mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon)."</span>\n";
                   2030: 
                   2031:     }
                   2032: 
                   2033: 
1.41      ng       2034: 
1.118     ng       2035:     # If any part of the problem is an essay-response (handgraded), then check for collaborators
1.464     albertel 2036:     my $fullname;
                   2037:     my $col_fullnames = [];
1.257     albertel 2038:     if ($env{'form.handgrade'} eq 'yes') {
1.464     albertel 2039: 	(my $sub_result,$fullname,$col_fullnames)=
                   2040: 	    &check_collaborators($symb,$uname,$udom,\%record,$handgrade,
                   2041: 				 $counter);
                   2042: 	$result.=$sub_result;
1.41      ng       2043:     }
1.44      ng       2044:     $request->print($result."\n");
1.468     albertel 2045:     $request->print('</div>'."\n");
1.44      ng       2046:     # print student answer/submission
                   2047:     # Options are (1) Handgaded submission only
                   2048:     #             (2) Last submission, includes submission that is not handgraded 
                   2049:     #                  (for multi-response type part)
                   2050:     #             (3) Last submission plus the parts info
                   2051:     #             (4) The whole record for this student
1.257     albertel 2052:     if ($env{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) {
1.151     albertel 2053: 	my ($string,$timestamp)= &get_last_submission(\%record);
1.468     albertel 2054: 	
                   2055: 	my $lastsubonly;
                   2056: 
1.151     albertel 2057: 	if ($$timestamp eq '') {
1.468     albertel 2058: 	    $lastsubonly.='<div class="LC_grade_submissions_body">'.$$string[0].'</div>'; 
1.151     albertel 2059: 	} else {
1.468     albertel 2060: 	    $lastsubonly = '<div class="LC_grade_submissions_body"> <b>Date Submitted:</b> '.$$timestamp."\n";
                   2061: 
1.151     albertel 2062: 	    my %seenparts;
1.375     albertel 2063: 	    my @part_response_id = &flatten_responseType($responseType);
                   2064: 	    foreach my $part (@part_response_id) {
1.393     albertel 2065: 		next if ($env{'form.lastSub'} eq 'hdgrade' 
                   2066: 			 && $$handgrade{$$part[0].'_'.$$part[1]} ne 'yes');
                   2067: 
1.375     albertel 2068: 		my ($partid,$respid) = @{ $part };
1.324     albertel 2069: 		my $display_part=&get_display_part($partid,$symb);
1.257     albertel 2070: 		if ($env{"form.$uname:$udom:$partid:submitted_by"}) {
1.151     albertel 2071: 		    if (exists($seenparts{$partid})) { next; }
                   2072: 		    $seenparts{$partid}=1;
1.207     albertel 2073: 		    my $submitby='<b>Part:</b> '.$display_part.
                   2074: 			' <b>Collaborative submission by:</b> '.
1.151     albertel 2075: 			'<a href="javascript:viewSubmitter(\''.
1.257     albertel 2076: 			$env{"form.$uname:$udom:$partid:submitted_by"}.
1.417     albertel 2077: 			'\');" target="_self">'.
1.257     albertel 2078: 			$$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />';
1.151     albertel 2079: 		    $request->print($submitby);
                   2080: 		    next;
                   2081: 		}
                   2082: 		my $responsetype = $responseType->{$partid}->{$respid};
                   2083: 		if (!exists($record{"resource.$partid.$respid.submission"})) {
1.468     albertel 2084: 		    $lastsubonly.="\n".'<div class="LC_grade_submission_part"><b>Part:</b> '.
1.398     albertel 2085: 			$display_part.' <span class="LC_internal_info">( ID '.$respid.
                   2086: 			' )</span>&nbsp; &nbsp;'.
1.468     albertel 2087: 			'<span class="LC_warning">'.&mt('Nothing submitted - no attempts').'</span><br /><br /></div>';
1.151     albertel 2088: 		    next;
                   2089: 		}
1.468     albertel 2090: 		foreach my $submission (@$string) {
                   2091: 		    my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
1.375     albertel 2092: 		    if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; }
1.468     albertel 2093: 		    my ($ressub,$subval) = split(/:/,$submission,2);
1.151     albertel 2094: 		    # Similarity check
                   2095: 		    my $similar='';
1.257     albertel 2096: 		    if($env{'form.checkPlag'}){
1.151     albertel 2097: 			my ($oname,$odom,$ocrsid,$oessay,$osim)=
1.426     albertel 2098: 			    &most_similar($uname,$udom,$subval,\%old_essays);
1.151     albertel 2099: 			if ($osim) {
                   2100: 			    $osim=int($osim*100.0);
1.426     albertel 2101: 			    my %old_course_desc = 
                   2102: 				&Apache::lonnet::coursedescription($ocrsid,
                   2103: 								   {'one_time' => 1});
                   2104: 
                   2105: 			    $similar="<hr /><h3><span class=\"LC_warning\">".
1.427     albertel 2106: 				&mt('Essay is [_1]% similar to an essay by [_2] ([_3]:[_4]) in course [_5] (course id [_6]:[_7])',
1.426     albertel 2107: 				    $osim,
                   2108: 				    &Apache::loncommon::plainname($oname,$odom),
1.427     albertel 2109: 				    $oname,$odom,
1.426     albertel 2110: 				    $old_course_desc{'description'},
1.427     albertel 2111: 				    $old_course_desc{'num'},
1.426     albertel 2112: 				    $old_course_desc{'domain'}).
1.398     albertel 2113: 				'</span></h3><blockquote><i>'.
1.151     albertel 2114: 				&keywords_highlight($oessay).
                   2115: 				'</i></blockquote><hr />';
                   2116: 			}
1.150     albertel 2117: 		    }
1.151     albertel 2118: 		    my $order=&get_order($partid,$respid,$symb,$uname,$udom);
1.257     albertel 2119: 		    if ($env{'form.lastSub'} eq 'lastonly' || 
                   2120: 			($env{'form.lastSub'} eq 'hdgrade' && 
1.377     albertel 2121: 			 $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) {
1.324     albertel 2122: 			my $display_part=&get_display_part($partid,$symb);
1.468     albertel 2123: 			$lastsubonly.='<div class="LC_grade_submission_part"><b>Part:</b> '.
1.403     albertel 2124: 			    $display_part.' <span class="LC_internal_info">( ID '.$respid.
1.398     albertel 2125: 			    ' )</span>&nbsp; &nbsp;';
1.313     banghart 2126: 			my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);
                   2127: 			if (@$files) {
1.468     albertel 2128: 			    $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain virusses').'</span><br />';
1.303     banghart 2129: 			    my $file_counter = 0;
1.313     banghart 2130: 			    foreach my $file (@$files) {
1.468     albertel 2131: 			        $file_counter++;
1.232     albertel 2132: 				&Apache::lonnet::allowuploaded('/adm/grades',$file);
1.335     albertel 2133: 				$lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border=0"> '.$file.'</a>';
1.232     albertel 2134: 			    }
1.236     albertel 2135: 			    $lastsubonly.='<br />';
1.41      ng       2136: 			}
1.468     albertel 2137: 			$lastsubonly.='<b>'.&mt('Submitted Answer:').' </b>'.
1.151     albertel 2138: 			    &cleanRecord($subval,$responsetype,$symb,$partid,
                   2139: 					 $respid,\%record,$order);
                   2140: 			if ($similar) {$lastsubonly.="<br /><br />$similar\n";}
1.468     albertel 2141: 			$lastsubonly.='</div>';
1.41      ng       2142: 		    }
                   2143: 		}
                   2144: 	    }
1.468     albertel 2145: 	    $lastsubonly.='</div>'."\n";
1.151     albertel 2146: 	}
                   2147: 	$request->print($lastsubonly);
1.468     albertel 2148:    } elsif ($env{'form.lastSub'} eq 'datesub') {
1.324     albertel 2149: 	my (undef,$responseType,undef,$parts) = &showResourceInfo($symb);
1.148     albertel 2150: 	$request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom));
1.257     albertel 2151:     } elsif ($env{'form.lastSub'} =~ /^(last|all)$/) {
1.41      ng       2152: 	$request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
1.257     albertel 2153: 								 $env{'request.course.id'},
1.44      ng       2154: 								 $last,'.submission',
                   2155: 								 'Apache::grades::keywords_highlight'));
1.41      ng       2156:     }
1.120     ng       2157: 
1.121     ng       2158:     $request->print('<input type="hidden" name="unamedom'.$counter.'" value="'.$uname.':'
                   2159: 	.$udom.'" />'."\n");
1.44      ng       2160:     # return if view submission with no grading option
1.257     albertel 2161:     if ($env{'form.showgrading'} eq '' || (!&canmodify($usec))) {
1.120     ng       2162: 	my $toGrade.='<input type="button" value="Grade Student" '.
1.121     ng       2163: 	    'onClick="javascript:checksubmit(this.form,\'Grade Student\',\''
1.417     albertel 2164: 	    .$counter.'\');" target="_self" /> &nbsp;'."\n" if (&canmodify($usec));
1.468     albertel 2165: 	$toGrade.='</div>'."\n";
1.257     albertel 2166: 	if (($env{'form.command'} eq 'submission') || 
                   2167: 	    ($env{'form.command'} eq 'processGroup' && $counter == $total)) {
1.324     albertel 2168: 	    $toGrade.='</form>'.&show_grading_menu_form($symb); 
1.169     albertel 2169: 	}
1.180     albertel 2170: 	$request->print($toGrade);
1.41      ng       2171: 	return;
1.180     albertel 2172:     } else {
1.468     albertel 2173: 	$request->print('</div>'."\n");
1.41      ng       2174:     }
1.33      ng       2175: 
1.121     ng       2176:     # essay grading message center
1.257     albertel 2177:     if ($env{'form.handgrade'} eq 'yes') {
1.468     albertel 2178: 	my $result='<div class="LC_grade_message_center">';
                   2179:     
                   2180: 	$result.='<div class="LC_grade_message_center_header">'.
                   2181: 	    &mt('Send Message').'</div><div class="LC_grade_message_center_body">';
1.257     albertel 2182: 	my ($lastname,$givenn) = split(/,/,$env{'form.fullname'});
1.118     ng       2183: 	my $msgfor = $givenn.' '.$lastname;
1.464     albertel 2184: 	if (scalar(@$col_fullnames) > 0) {
                   2185: 	    my $lastone = pop(@$col_fullnames);
                   2186: 	    $msgfor .= ', '.(join ', ',@$col_fullnames).' and '.$lastone.'.';
1.118     ng       2187: 	}
                   2188: 	$msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript
1.468     albertel 2189: 	$result.='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n".
1.121     ng       2190: 	    '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n";
                   2191: 	$result.='&nbsp;<a href="javascript:msgCenter(document.SCORE,'.$counter.
1.417     albertel 2192: 	    ',\''.$msgfor.'\');" target="_self">'.
1.464     albertel 2193: 	    &mt('Compose message to student').(scalar(@$col_fullnames) >= 1 ? 's' : '').'</a><label> ('.
1.350     albertel 2194: 	    &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'.
1.118     ng       2195: 	    '<img src="'.$request->dir_config('lonIconsURL').
                   2196: 	    '/mailbkgrd.gif" width="14" height="10" name="mailicon'.$counter.'" />'."\n".
1.298     www      2197: 	    '<br />&nbsp;('.
1.468     albertel 2198: 	    &mt('Message will be sent when you click on Save &amp; Next below.').")\n";
                   2199: 	$result.='</div></div>';
1.121     ng       2200: 	$request->print($result);
1.118     ng       2201:     }
1.41      ng       2202: 
                   2203:     my %seen = ();
                   2204:     my @partlist;
1.129     ng       2205:     my @gradePartRespid;
1.375     albertel 2206:     my @part_response_id = &flatten_responseType($responseType);
1.468     albertel 2207:     $request->print('<div class="LC_grade_assign">'.
                   2208: 		    
                   2209: 		    '<div class="LC_grade_assign_header">'.
                   2210: 		    &mt('Assign Grades').'</div>'.
                   2211: 		    '<div class="LC_grade_assign_body">');
1.375     albertel 2212:     foreach my $part_response_id (@part_response_id) {
                   2213:     	my ($partid,$respid) = @{ $part_response_id };
                   2214: 	my $part_resp = join('_',@{ $part_response_id });
1.322     albertel 2215: 	next if ($seen{$partid} > 0);
1.41      ng       2216: 	$seen{$partid}++;
1.393     albertel 2217: 	next if ($$handgrade{$part_resp} ne 'yes' 
                   2218: 		 && $env{'form.lastSub'} eq 'hdgrade');
1.41      ng       2219: 	push @partlist,$partid;
1.129     ng       2220: 	push @gradePartRespid,$partid.'.'.$respid;
1.322     albertel 2221: 	$request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
1.41      ng       2222:     }
1.468     albertel 2223:     $request->print('</div></div>');
                   2224: 
                   2225:     $request->print('<div class="LC_grade_info_links">');
                   2226:     if ($perm{'vgr'}) {
                   2227: 	$request->print(
                   2228: 	    &Apache::loncommon::track_student_link(&mt('View recent activity'),
                   2229: 						   $uname,$udom,'check'));
                   2230:     }
                   2231:     if ($perm{'opa'}) {
                   2232: 	$request->print(
                   2233: 	    &Apache::loncommon::pprmlink(&mt('Set/Change parameters'),
                   2234: 					 $uname,$udom,$symb,'check'));
                   2235:     }
                   2236:     $request->print('</div>');
                   2237: 
1.45      ng       2238:     $result='<input type="hidden" name="partlist'.$counter.
                   2239: 	'" value="'.(join ":",@partlist).'" />'."\n";
1.129     ng       2240:     $result.='<input type="hidden" name="gradePartRespid'.
                   2241: 	'" value="'.(join ":",@gradePartRespid).'" />'."\n" if ($counter == 0);
1.45      ng       2242:     my $ctr = 0;
                   2243:     while ($ctr < scalar(@partlist)) {
                   2244: 	$result.='<input type="hidden" name="partid'.$counter.'_'.$ctr.'" value="'.
                   2245: 	    $partlist[$ctr].'" />'."\n";
                   2246: 	$ctr++;
                   2247:     }
1.468     albertel 2248:     $request->print($result.''."\n");
1.41      ng       2249: 
1.441     www      2250: # Done with printing info for one student
                   2251: 
1.468     albertel 2252:     $request->print('</div>');#LC_grade_show_user_body
                   2253:     $request->print('</div>');#LC_grade_show_user
1.441     www      2254: 
                   2255: 
1.41      ng       2256:     # print end of form
                   2257:     if ($counter == $total) {
1.297     www      2258: 	my $endform='<table border="0"><tr><td>'."\n";
1.485     albertel 2259: 	$endform.='<input type="button" value="'.&mt('Save &amp; Next').'" '.
1.119     ng       2260: 	    'onClick="javascript:checksubmit(this.form,\'Save & Next\','.
1.417     albertel 2261: 	    $total.','.scalar(@partlist).');" target="_self" /> &nbsp;'."\n";
1.119     ng       2262: 	my $ntstu ='<select name="NTSTU">'.
                   2263: 	    '<option>1</option><option>2</option>'.
                   2264: 	    '<option>3</option><option>5</option>'.
                   2265: 	    '<option>7</option><option>10</option></select>'."\n";
1.257     albertel 2266: 	my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1');
1.401     albertel 2267: 	$ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</;
1.485     albertel 2268: 	$endform.=&mt('[_1]student(s)',$ntstu);
                   2269: 	$endform.='&nbsp;&nbsp;<input type="button" value="'.&mt('Previous').'" '.
1.417     albertel 2270: 	    'onClick="javascript:checksubmit(this.form,\'Previous\');" target="_self" /> &nbsp;'."\n".
1.485     albertel 2271: 	    '<input type="button" value="'.&mt('Next').'" '.
1.417     albertel 2272: 	    'onClick="javascript:checksubmit(this.form,\'Next\');" target="_self" /> &nbsp;';
1.485     albertel 2273: 	$endform.=&mt('(Next and Previous (student) do not save the scores.)')."\n" ;
1.349     albertel 2274:         $endform.="<input type='hidden' value='".&get_increment().
1.348     bowersj2 2275:             "' name='increment' />";
1.485     albertel 2276: 	$endform.='</td></tr></table></form>';
1.324     albertel 2277: 	$endform.=&show_grading_menu_form($symb);
1.41      ng       2278: 	$request->print($endform);
                   2279:     }
                   2280:     return '';
1.38      ng       2281: }
                   2282: 
1.464     albertel 2283: sub check_collaborators {
                   2284:     my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_;
                   2285:     my ($result,@col_fullnames);
                   2286:     my ($classlist,undef,$fullname) = &getclasslist('all','0');
                   2287:     foreach my $part (keys(%$handgrade)) {
                   2288: 	my $ncol = &Apache::lonnet::EXT('resource.'.$part.
                   2289: 					'.maxcollaborators',
                   2290: 					$symb,$udom,$uname);
                   2291: 	next if ($ncol <= 0);
                   2292: 	$part =~ s/\_/\./g;
                   2293: 	next if ($record->{'resource.'.$part.'.collaborators'} eq '');
                   2294: 	my (@good_collaborators, @bad_collaborators);
                   2295: 	foreach my $possible_collaborator
                   2296: 	    (split(/,?\s+/,$record->{'resource.'.$part.'.collaborators'})) { 
                   2297: 	    $possible_collaborator =~ s/[\$\^\(\)]//g;
                   2298: 	    next if ($possible_collaborator eq '');
                   2299: 	    my ($co_name,$co_dom) = split(/\@|:/,$possible_collaborator);
                   2300: 	    $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i);
                   2301: 	    next if ($co_name eq $uname && $co_dom eq $udom);
                   2302: 	    # Doing this grep allows 'fuzzy' specification
                   2303: 	    my @matches = grep(/^\Q$co_name\E:\Q$co_dom\E$/i, 
                   2304: 			       keys(%$classlist));
                   2305: 	    if (! scalar(@matches)) {
                   2306: 		push(@bad_collaborators, $possible_collaborator);
                   2307: 	    } else {
                   2308: 		push(@good_collaborators, @matches);
                   2309: 	    }
                   2310: 	}
                   2311: 	if (scalar(@good_collaborators) != 0) {
1.466     albertel 2312: 	    $result.='<br />'.&mt('Collaborators: ');
1.464     albertel 2313: 	    foreach my $name (@good_collaborators) {
                   2314: 		my ($lastname,$givenn) = split(/,/,$$fullname{$name});
                   2315: 		push(@col_fullnames, $givenn.' '.$lastname);
                   2316: 		$result.=$fullname->{$name}.'&nbsp; &nbsp; &nbsp;';
                   2317: 	    }
                   2318: 	    $result.='<br />'."\n";
1.466     albertel 2319: 	    my ($part)=split(/\./,$part);
1.464     albertel 2320: 	    $result.='<input type="hidden" name="collaborator'.$counter.
                   2321: 		'" value="'.$part.':'.(join ':',@good_collaborators).'" />'.
                   2322: 		"\n";
                   2323: 	}
                   2324: 	if (scalar(@bad_collaborators) > 0) {
1.466     albertel 2325: 	    $result.='<div class="LC_warning">';
1.464     albertel 2326: 	    $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators));
                   2327: 	    $result .= '</div>';
                   2328: 	}         
                   2329: 	if (scalar(@bad_collaborators > $ncol)) {
1.466     albertel 2330: 	    $result .= '<div class="LC_warning">';
1.464     albertel 2331: 	    $result .= &mt('This student has submitted too many '.
                   2332: 		'collaborators.  Maximum is [_1].',$ncol);
                   2333: 	    $result .= '</div>';
                   2334: 	}
                   2335:     }
                   2336:     return ($result,$fullname,\@col_fullnames);
                   2337: }
                   2338: 
1.44      ng       2339: #--- Retrieve the last submission for all the parts
1.38      ng       2340: sub get_last_submission {
1.119     ng       2341:     my ($returnhash)=@_;
1.46      ng       2342:     my (@string,$timestamp);
1.119     ng       2343:     if ($$returnhash{'version'}) {
1.46      ng       2344: 	my %lasthash=();
                   2345: 	my ($version);
1.119     ng       2346: 	for ($version=1;$version<=$$returnhash{'version'};$version++) {
1.397     albertel 2347: 	    foreach my $key (sort(split(/\:/,
                   2348: 					$$returnhash{$version.':keys'}))) {
                   2349: 		$lasthash{$key}=$$returnhash{$version.':'.$key};
                   2350: 		$timestamp = 
                   2351: 		    scalar(localtime($$returnhash{$version.':timestamp'}));
1.46      ng       2352: 	    }
                   2353: 	}
1.397     albertel 2354: 	foreach my $key (keys(%lasthash)) {
                   2355: 	    next if ($key !~ /\.submission$/);
                   2356: 
                   2357: 	    my ($partid,$foo) = split(/submission$/,$key);
                   2358: 	    my $draft  = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?
1.398     albertel 2359: 		'<span class="LC_warning">Draft Copy</span> ' : '';
1.397     albertel 2360: 	    push(@string, join(':', $key, $draft.$lasthash{$key}));
1.41      ng       2361: 	}
                   2362:     }
1.397     albertel 2363:     if (!@string) {
                   2364: 	$string[0] =
1.398     albertel 2365: 	    '<span class="LC_warning">Nothing submitted - no attempts.</span>';
1.397     albertel 2366:     }
                   2367:     return (\@string,\$timestamp);
1.38      ng       2368: }
1.35      ng       2369: 
1.44      ng       2370: #--- High light keywords, with style choosen by user.
1.38      ng       2371: sub keywords_highlight {
1.44      ng       2372:     my $string    = shift;
1.257     albertel 2373:     my $size      = $env{'form.kwsize'} eq '0' ? '' : 'size='.$env{'form.kwsize'};
                   2374:     my $styleon   = $env{'form.kwstyle'} eq ''  ? '' : $env{'form.kwstyle'};
1.41      ng       2375:     (my $styleoff = $styleon) =~ s/\</\<\//;
1.257     albertel 2376:     my @keylist   = split(/[,\s+]/,$env{'form.keywords'});
1.398     albertel 2377:     foreach my $keyword (@keylist) {
                   2378: 	$string =~ s/\b\Q$keyword\E(\b|\.)/<font color\=$env{'form.kwclr'} $size\>$styleon$keyword$styleoff<\/font>/gi;
1.41      ng       2379:     }
                   2380:     return $string;
1.38      ng       2381: }
1.36      ng       2382: 
1.44      ng       2383: #--- Called from submission routine
1.38      ng       2384: sub processHandGrade {
1.41      ng       2385:     my ($request) = shift;
1.324     albertel 2386:     my $symb   = &get_symb($request);
                   2387:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.257     albertel 2388:     my $button = $env{'form.gradeOpt'};
                   2389:     my $ngrade = $env{'form.NCT'};
                   2390:     my $ntstu  = $env{'form.NTSTU'};
1.301     albertel 2391:     my $cdom   = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2392:     my $cnum   = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2393: 
1.44      ng       2394:     if ($button eq 'Save & Next') {
                   2395: 	my $ctr = 0;
                   2396: 	while ($ctr < $ngrade) {
1.257     albertel 2397: 	    my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr});
1.324     albertel 2398: 	    my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$symb,$uname,$udom,$ctr);
1.71      ng       2399: 	    if ($errorflag eq 'no_score') {
                   2400: 		$ctr++;
                   2401: 		next;
                   2402: 	    }
1.104     albertel 2403: 	    if ($errorflag eq 'not_allowed') {
1.398     albertel 2404: 		$request->print("<span class=\"LC_warning\">Not allowed to modify grades for $uname:$udom</span>");
1.104     albertel 2405: 		$ctr++;
                   2406: 		next;
                   2407: 	    }
1.257     albertel 2408: 	    my $includemsg = $env{'form.includemsg'.$ctr};
1.44      ng       2409: 	    my ($subject,$message,$msgstatus) = ('','','');
1.418     albertel 2410: 	    my $restitle = &Apache::lonnet::gettitle($symb);
                   2411:             my ($feedurl,$showsymb) =
                   2412: 		&get_feedurl_and_symb($symb,$uname,$udom);
                   2413: 	    my $messagetail;
1.62      albertel 2414: 	    if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
1.298     www      2415: 		$subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/);
1.295     www      2416: 		unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); }
1.386     raeburn  2417: 		$subject.=' ['.$restitle.']';
1.44      ng       2418: 		my (@msgnum) = split(/,/,$includemsg);
                   2419: 		foreach (@msgnum) {
1.257     albertel 2420: 		    $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne '');
1.44      ng       2421: 		}
1.80      ng       2422: 		$message =&Apache::lonfeedback::clear_out_html($message);
1.298     www      2423: 		if ($env{'form.withgrades'.$ctr}) {
                   2424: 		    $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt;
1.386     raeburn  2425: 		    $messagetail = " for <a href=\"".
1.418     albertel 2426: 		                   $feedurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
1.386     raeburn  2427: 		}
                   2428: 		$msgstatus = 
                   2429:                     &Apache::lonmsg::user_normal_msg($uname,$udom,$subject,
                   2430: 						     $message.$messagetail,
1.418     albertel 2431:                                                      undef,$feedurl,undef,
1.386     raeburn  2432:                                                      undef,undef,$showsymb,
                   2433:                                                      $restitle);
                   2434: 		$request->print('<br />'.&mt('Sending message to [_1]:[_2]',$uname,$udom).': '.
1.296     www      2435: 				$msgstatus);
1.44      ng       2436: 	    }
1.257     albertel 2437: 	    if ($env{'form.collaborator'.$ctr}) {
1.155     albertel 2438: 		my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr");
1.150     albertel 2439: 		foreach my $collabstr (@collabstrs) {
                   2440: 		    my ($part,@collaborators) = split(/:/,$collabstr);
1.310     banghart 2441: 		    foreach my $collaborator (@collaborators) {
1.150     albertel 2442: 			my ($errorflag,$pts,$wgt) = 
1.324     albertel 2443: 			    &saveHandGrade($request,$symb,$collaborator,$udom,$ctr,
1.257     albertel 2444: 					   $env{'form.unamedom'.$ctr},$part);
1.150     albertel 2445: 			if ($errorflag eq 'not_allowed') {
1.362     albertel 2446: 			    $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>");
1.150     albertel 2447: 			    next;
1.418     albertel 2448: 			} elsif ($message ne '') {
                   2449: 			    my ($baseurl,$showsymb) = 
                   2450: 				&get_feedurl_and_symb($symb,$collaborator,
                   2451: 						      $udom);
                   2452: 			    if ($env{'form.withgrades'.$ctr}) {
                   2453: 				$messagetail = " for <a href=\"".
1.386     raeburn  2454:                                     $baseurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
1.150     albertel 2455: 			    }
1.418     albertel 2456: 			    $msgstatus = 
                   2457: 				&Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle);
1.104     albertel 2458: 			}
1.44      ng       2459: 		    }
                   2460: 		}
                   2461: 	    }
                   2462: 	    $ctr++;
                   2463: 	}
                   2464:     }
                   2465: 
1.257     albertel 2466:     if ($env{'form.handgrade'} eq 'yes') {
1.119     ng       2467: 	# Keywords sorted in alphabatical order
1.257     albertel 2468: 	my $loginuser = $env{'user.name'}.':'.$env{'user.domain'};
1.119     ng       2469: 	my %keyhash = ();
1.257     albertel 2470: 	$env{'form.keywords'}           =~ s/,\s{0,}|\s+/ /g;
                   2471: 	$env{'form.keywords'}           =~ s/^\s+|\s+$//;
                   2472: 	my (@keywords) = sort(split(/\s+/,$env{'form.keywords'}));
                   2473: 	$env{'form.keywords'} = join(' ',@keywords);
                   2474: 	$keyhash{$symb.'_keywords'}     = $env{'form.keywords'};
                   2475: 	$keyhash{$symb.'_subject'}      = $env{'form.msgsub'};
                   2476: 	$keyhash{$loginuser.'_kwclr'}   = $env{'form.kwclr'};
                   2477: 	$keyhash{$loginuser.'_kwsize'}  = $env{'form.kwsize'};
                   2478: 	$keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'};
1.119     ng       2479: 
                   2480: 	# message center - Order of message gets changed. Blank line is eliminated.
1.257     albertel 2481: 	# New messages are saved in env for the next student.
1.119     ng       2482: 	# All messages are saved in nohist_handgrade.db
                   2483: 	my ($ctr,$idx) = (1,1);
1.257     albertel 2484: 	while ($ctr <= $env{'form.savemsgN'}) {
                   2485: 	    if ($env{'form.savemsg'.$ctr} ne '') {
                   2486: 		$keyhash{$symb.'_savemsg'.$idx} = $env{'form.savemsg'.$ctr};
1.119     ng       2487: 		$idx++;
                   2488: 	    }
                   2489: 	    $ctr++;
1.41      ng       2490: 	}
1.119     ng       2491: 	$ctr = 0;
                   2492: 	while ($ctr < $ngrade) {
1.257     albertel 2493: 	    if ($env{'form.newmsg'.$ctr} ne '') {
                   2494: 		$keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr};
                   2495: 		$env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr};
1.119     ng       2496: 		$idx++;
                   2497: 	    }
                   2498: 	    $ctr++;
1.41      ng       2499: 	}
1.257     albertel 2500: 	$env{'form.savemsgN'} = --$idx;
                   2501: 	$keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'};
1.119     ng       2502: 	my $putresult = &Apache::lonnet::put
1.301     albertel 2503: 	    ('nohist_handgrade',\%keyhash,$cdom,$cnum);
1.41      ng       2504:     }
1.44      ng       2505:     # Called by Save & Refresh from Highlight Attribute Window
1.257     albertel 2506:     my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');
                   2507:     if ($env{'form.refresh'} eq 'on') {
1.86      ng       2508: 	my ($ctr,$total) = (0,0);
                   2509: 	while ($ctr < $ngrade) {
1.257     albertel 2510: 	    $total++ if  $env{'form.unamedom'.$ctr} ne '';
1.86      ng       2511: 	    $ctr++;
                   2512: 	}
1.257     albertel 2513: 	$env{'form.NTSTU'}=$ngrade;
1.86      ng       2514: 	$ctr = 0;
                   2515: 	while ($ctr < $total) {
1.257     albertel 2516: 	    my $processUser = $env{'form.unamedom'.$ctr};
                   2517: 	    ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser);
                   2518: 	    $env{'form.fullname'} = $$fullname{$processUser};
1.86      ng       2519: 	    &submission($request,$ctr,$total-1);
1.41      ng       2520: 	    $ctr++;
                   2521: 	}
                   2522: 	return '';
                   2523:     }
1.36      ng       2524: 
1.121     ng       2525: # Go directly to grade student - from submission or link from chart page
1.120     ng       2526:     if ($button eq 'Grade Student') {
1.324     albertel 2527: 	(undef,undef,$env{'form.handgrade'},undef,undef) = &showResourceInfo($symb);
1.257     albertel 2528: 	my $processUser = $env{'form.unamedom'.$env{'form.studentNo'}};
                   2529: 	($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser);
                   2530: 	$env{'form.fullname'} = $$fullname{$processUser};
1.120     ng       2531: 	&submission($request,0,0);
                   2532: 	return '';
                   2533:     }
                   2534: 
1.44      ng       2535:     # Get the next/previous one or group of students
1.257     albertel 2536:     my $firststu = $env{'form.unamedom0'};
                   2537:     my $laststu = $env{'form.unamedom'.($ngrade-1)};
1.119     ng       2538:     my $ctr = 2;
1.41      ng       2539:     while ($laststu eq '') {
1.257     albertel 2540: 	$laststu  = $env{'form.unamedom'.($ngrade-$ctr)};
1.41      ng       2541: 	$ctr++;
                   2542: 	$laststu = $firststu if ($ctr > $ngrade);
                   2543:     }
1.44      ng       2544: 
1.41      ng       2545:     my (@parsedlist,@nextlist);
                   2546:     my ($nextflg) = 0;
1.294     albertel 2547:     foreach (sort 
                   2548: 	     {
                   2549: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   2550: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   2551: 		 }
                   2552: 		 return $a cmp $b;
                   2553: 	     } (keys(%$fullname))) {
1.41      ng       2554: 	if ($nextflg == 1 && $button =~ /Next$/) {
                   2555: 	    push @parsedlist,$_;
                   2556: 	}
                   2557: 	$nextflg = 1 if ($_ eq $laststu);
                   2558: 	if ($button eq 'Previous') {
                   2559: 	    last if ($_ eq $firststu);
                   2560: 	    push @parsedlist,$_;
                   2561: 	}
                   2562:     }
                   2563:     $ctr = 0;
                   2564:     @parsedlist = reverse @parsedlist if ($button eq 'Previous');
1.324     albertel 2565:     my ($partlist) = &response_type($symb);
1.41      ng       2566:     foreach my $student (@parsedlist) {
1.257     albertel 2567: 	my $submitonly=$env{'form.submitonly'};
1.41      ng       2568: 	my ($uname,$udom) = split(/:/,$student);
1.301     albertel 2569: 	
                   2570: 	if ($submitonly eq 'queued') {
                   2571: 	    my %queue_status = 
                   2572: 		&Apache::bridgetask::get_student_status($symb,$cdom,$cnum,
                   2573: 							$udom,$uname);
                   2574: 	    next if (!defined($queue_status{'gradingqueue'}));
                   2575: 	}
                   2576: 
1.156     albertel 2577: 	if ($submitonly =~ /^(yes|graded|incorrect)$/) {
1.257     albertel 2578: #	    my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
1.324     albertel 2579: 	    my %status=&student_gradeStatus($symb,$udom,$uname,$partlist);
1.145     albertel 2580: 	    my $submitted = 0;
1.248     albertel 2581: 	    my $ungraded = 0;
                   2582: 	    my $incorrect = 0;
1.145     albertel 2583: 	    foreach (keys(%status)) {
                   2584: 		$submitted = 1 if ($status{$_} ne 'nothing');
1.248     albertel 2585: 		$ungraded = 1 if ($status{$_} =~ /^ungraded/);
                   2586: 		$incorrect = 1 if ($status{$_} =~ /^incorrect/);
1.145     albertel 2587: 		my ($foo,$partid,$foo1) = split(/\./,$_);
                   2588: 		if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
                   2589: 		    $submitted = 0;
                   2590: 		}
1.41      ng       2591: 	    }
1.156     albertel 2592: 	    next if (!$submitted && ($submitonly eq 'yes' ||
                   2593: 				     $submitonly eq 'incorrect' ||
                   2594: 				     $submitonly eq 'graded'));
1.248     albertel 2595: 	    next if (!$ungraded && ($submitonly eq 'graded'));
                   2596: 	    next if (!$incorrect && $submitonly eq 'incorrect');
1.41      ng       2597: 	}
                   2598: 	push @nextlist,$student if ($ctr < $ntstu);
1.129     ng       2599: 	last if ($ctr == $ntstu);
1.41      ng       2600: 	$ctr++;
                   2601:     }
1.36      ng       2602: 
1.41      ng       2603:     $ctr = 0;
                   2604:     my $total = scalar(@nextlist)-1;
1.39      ng       2605: 
1.41      ng       2606:     foreach (sort @nextlist) {
                   2607: 	my ($uname,$udom,$submitter) = split(/:/);
1.257     albertel 2608: 	$env{'form.student'}  = $uname;
                   2609: 	$env{'form.userdom'}  = $udom;
                   2610: 	$env{'form.fullname'} = $$fullname{$_};
1.41      ng       2611: 	&submission($request,$ctr,$total);
                   2612: 	$ctr++;
                   2613:     }
                   2614:     if ($total < 0) {
1.485     albertel 2615: 	my $the_end = '<h3><span class="LC_info">'.&mt('LON-CAPA User Message').'</span></h3><br />'."\n";
                   2616: 	$the_end.=&mt('<b>Message: </b> No more students for this section or class.').'<br /><br />'."\n";
                   2617: 	$the_end.=&mt('Click on the button below to return to the grading menu.').'<br /><br />'."\n";
1.324     albertel 2618: 	$the_end.=&show_grading_menu_form($symb);
1.41      ng       2619: 	$request->print($the_end);
                   2620:     }
                   2621:     return '';
1.38      ng       2622: }
1.36      ng       2623: 
1.44      ng       2624: #---- Save the score and award for each student, if changed
1.38      ng       2625: sub saveHandGrade {
1.324     albertel 2626:     my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_;
1.342     banghart 2627:     my @version_parts;
1.104     albertel 2628:     my $usec = &Apache::lonnet::getsection($domain,$stuname,
1.257     albertel 2629: 					   $env{'request.course.id'});
1.104     albertel 2630:     if (!&canmodify($usec)) { return('not_allowed'); }
1.337     banghart 2631:     my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);
1.251     banghart 2632:     my @parts_graded;
1.77      ng       2633:     my %newrecord  = ();
                   2634:     my ($pts,$wgt) = ('','');
1.269     raeburn  2635:     my %aggregate = ();
                   2636:     my $aggregateflag = 0;
1.301     albertel 2637:     my @parts = split(/:/,$env{'form.partlist'.$newflg});
                   2638:     foreach my $new_part (@parts) {
1.337     banghart 2639: 	#collaborator ($submi may vary for different parts
1.259     banghart 2640: 	if ($submitter && $new_part ne $part) { next; }
                   2641: 	my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};
1.125     ng       2642: 	if ($dropMenu eq 'excused') {
1.259     banghart 2643: 	    if ($record{'resource.'.$new_part.'.solved'} ne 'excused') {
                   2644: 		$newrecord{'resource.'.$new_part.'.solved'} = 'excused';
                   2645: 		if (exists($record{'resource.'.$new_part.'.awarded'})) {
                   2646: 		    $newrecord{'resource.'.$new_part.'.awarded'} = '';
1.58      albertel 2647: 		}
1.364     banghart 2648: 	        $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
1.58      albertel 2649: 	    }
1.125     ng       2650: 	} elsif ($dropMenu eq 'reset status'
1.259     banghart 2651: 		 && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts
1.197     albertel 2652: 	    foreach my $key (keys (%record)) {
1.259     banghart 2653: 		if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; }
1.197     albertel 2654: 	    }
1.259     banghart 2655: 	    $newrecord{'resource.'.$new_part.'.regrader'}=
1.257     albertel 2656: 		"$env{'user.name'}:$env{'user.domain'}";
1.270     albertel 2657:             my $totaltries = $record{'resource.'.$part.'.tries'};
                   2658: 
                   2659:             my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
                   2660: 					       [$new_part]);
                   2661:             my $aggtries =$totaltries;
1.269     raeburn  2662:             if ($last_resets{$new_part}) {
1.270     albertel 2663:                 $aggtries = &get_num_tries(\%record,$last_resets{$new_part},
                   2664: 					   $new_part);
1.269     raeburn  2665:             }
1.270     albertel 2666: 
                   2667:             my $solvedstatus = $record{'resource.'.$new_part.'.solved'};
1.269     raeburn  2668:             if ($aggtries > 0) {
1.327     albertel 2669:                 &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus);
1.269     raeburn  2670:                 $aggregateflag = 1;
                   2671:             }
1.125     ng       2672: 	} elsif ($dropMenu eq '') {
1.259     banghart 2673: 	    $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 
                   2674: 		    $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 
                   2675: 		    $env{'form.RADVAL'.$newflg.'_'.$new_part});
                   2676: 	    if ($pts eq '' && $env{'form.GD_SEL'.$newflg.'_'.$new_part} eq '') {
1.153     albertel 2677: 		next;
                   2678: 	    }
1.259     banghart 2679: 	    $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : 
                   2680: 		$env{'form.WGT'.$newflg.'_'.$new_part};
1.41      ng       2681: 	    my $partial= $pts/$wgt;
1.259     banghart 2682: 	    if ($partial eq $record{'resource.'.$new_part.'.awarded'}) {
1.153     albertel 2683: 		#do not update score for part if not changed.
1.346     banghart 2684:                 &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
1.153     albertel 2685: 		next;
1.251     banghart 2686: 	    } else {
1.259     banghart 2687: 	        push @parts_graded, $new_part;
1.153     albertel 2688: 	    }
1.259     banghart 2689: 	    if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {
                   2690: 		$newrecord{'resource.'.$new_part.'.awarded'}  = $partial;
1.153     albertel 2691: 	    }
1.259     banghart 2692: 	    my $reckey = 'resource.'.$new_part.'.solved';
1.41      ng       2693: 	    if ($partial == 0) {
1.153     albertel 2694: 		if ($record{$reckey} ne 'incorrect_by_override') {
                   2695: 		    $newrecord{$reckey} = 'incorrect_by_override';
                   2696: 		}
1.41      ng       2697: 	    } else {
1.153     albertel 2698: 		if ($record{$reckey} ne 'correct_by_override') {
                   2699: 		    $newrecord{$reckey} = 'correct_by_override';
                   2700: 		}
                   2701: 	    }	    
                   2702: 	    if ($submitter && 
1.259     banghart 2703: 		($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) {
                   2704: 		$newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter;
1.41      ng       2705: 	    }
1.259     banghart 2706: 	    $newrecord{'resource.'.$new_part.'.regrader'}=
1.257     albertel 2707: 		"$env{'user.name'}:$env{'user.domain'}";
1.41      ng       2708: 	}
1.259     banghart 2709: 	# unless problem has been graded, set flag to version the submitted files
1.305     banghart 2710: 	unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/  || 
                   2711: 	        $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||
                   2712: 	        $dropMenu eq 'reset status')
                   2713: 	   {
1.342     banghart 2714: 	    push (@version_parts,$new_part);
1.259     banghart 2715: 	}
1.41      ng       2716:     }
1.301     albertel 2717:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2718:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2719: 
1.344     albertel 2720:     if (%newrecord) {
                   2721:         if (@version_parts) {
1.364     banghart 2722:             my @changed_keys = &version_portfiles(\%record, \@parts_graded, 
                   2723:                                 $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts);
1.344     albertel 2724: 	    @newrecord{@changed_keys} = @record{@changed_keys};
1.367     albertel 2725: 	    foreach my $new_part (@version_parts) {
                   2726: 		&handback_files($request,$symb,$stuname,$domain,$newflg,
                   2727: 				$new_part,\%newrecord);
                   2728: 	    }
1.259     banghart 2729:         }
1.44      ng       2730: 	&Apache::lonnet::cstore(\%newrecord,$symb,
1.257     albertel 2731: 				$env{'request.course.id'},$domain,$stuname);
1.380     albertel 2732: 	&check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb,
                   2733: 				     $cdom,$cnum,$domain,$stuname);
1.41      ng       2734:     }
1.269     raeburn  2735:     if ($aggregateflag) {
                   2736:         &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
1.301     albertel 2737: 			      $cdom,$cnum);
1.269     raeburn  2738:     }
1.301     albertel 2739:     return ('',$pts,$wgt);
1.36      ng       2740: }
1.322     albertel 2741: 
1.380     albertel 2742: sub check_and_remove_from_queue {
                   2743:     my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_;
                   2744:     my @ungraded_parts;
                   2745:     foreach my $part (@{$parts}) {
                   2746: 	if (    $record->{   'resource.'.$part.'.awarded'} eq ''
                   2747: 	     && $record->{   'resource.'.$part.'.solved' } ne 'excused'
                   2748: 	     && $newrecord->{'resource.'.$part.'.awarded'} eq ''
                   2749: 	     && $newrecord->{'resource.'.$part.'.solved' } ne 'excused'
                   2750: 		) {
                   2751: 	    push(@ungraded_parts, $part);
                   2752: 	}
                   2753:     }
                   2754:     if ( !@ungraded_parts ) {
                   2755: 	&Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,
                   2756: 					       $cnum,$domain,$stuname);
                   2757:     }
                   2758: }
                   2759: 
1.337     banghart 2760: sub handback_files {
                   2761:     my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
1.359     www      2762:     my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio';
                   2763:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.375     albertel 2764: 
                   2765:     my @part_response_id = &flatten_responseType($responseType);
                   2766:     foreach my $part_response_id (@part_response_id) {
                   2767:     	my ($part_id,$resp_id) = @{ $part_response_id };
                   2768: 	my $part_resp = join('_',@{ $part_response_id });
1.337     banghart 2769:             if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) {
                   2770:                 # if multiple files are uploaded names will be 'returndoc2','returndoc3'
                   2771:                 my $file_counter = 1;
1.367     albertel 2772: 		my $file_msg;
1.337     banghart 2773:                 while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {
                   2774:                     my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};
1.338     banghart 2775:                     my ($directory,$answer_file) = 
                   2776:                         ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/);
                   2777:                     my ($answer_name,$answer_ver,$answer_ext) =
                   2778: 		        &file_name_version_ext($answer_file);
1.355     banghart 2779: 		    my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
1.341     banghart 2780: 		    my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root);
1.338     banghart 2781: 		    my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
1.355     banghart 2782:                     # fix file name
                   2783:                     my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
                   2784:                     my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,
                   2785:             	                                $newflg.'_'.$part_resp.'_returndoc'.$file_counter,
                   2786:             	                                $save_file_name);
1.337     banghart 2787:                     if ($result !~ m|^/uploaded/|) {
1.401     albertel 2788:                         $request->print('<span class="LC_error">An error occurred ('.$result.
1.398     albertel 2789:                         ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'</span><br />');
1.356     banghart 2790:                     } else {
1.360     banghart 2791:                         # mark the file as read only
                   2792:                         my @files = ($save_file_name);
1.372     albertel 2793:                         my @what = ($symb,$env{'request.course.id'},'handback');
1.360     banghart 2794:                         &Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what);
1.367     albertel 2795: 			if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) {
                   2796: 			    $$newrecord{"resource.$new_part.$resp_id.handback"}.=',';
                   2797: 			}
                   2798:                         $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name;
                   2799: 			$file_msg.= "\n".'<br /><span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span><br />";
                   2800: 
1.337     banghart 2801:                     }
                   2802:                     $request->print("<br />".$fname." will be the uploaded file name");
1.354     albertel 2803:                     $request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter});
1.337     banghart 2804:                     $file_counter++;
                   2805:                 }
1.367     albertel 2806: 		my $subject = "File Handed Back by Instructor ";
                   2807: 		my $message = "A file has been returned that was originally submitted in reponse to: <br />";
                   2808: 		$message .= "<strong>".&Apache::lonnet::gettitle($symb)."</strong><br />";
                   2809: 		$message .= ' The returned file(s) are named: '. $file_msg;
                   2810: 		$message .= " and can be found in your portfolio space.";
1.418     albertel 2811: 		my ($feedurl,$showsymb) = 
                   2812: 		    &get_feedurl_and_symb($symb,$domain,$stuname);
1.386     raeburn  2813:                 my $restitle = &Apache::lonnet::gettitle($symb);
                   2814: 		my $msgstatus = 
                   2815:                    &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject.
                   2816: 			 ' (File Returned) ['.$restitle.']',$message,undef,
1.418     albertel 2817:                          $feedurl,undef,undef,undef,$showsymb,$restitle);
1.337     banghart 2818:             }
                   2819:         }
1.338     banghart 2820:     return;
1.337     banghart 2821: }
                   2822: 
1.418     albertel 2823: sub get_feedurl_and_symb {
                   2824:     my ($symb,$uname,$udom) = @_;
                   2825:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
                   2826:     $url = &Apache::lonnet::clutter($url);
                   2827:     my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl',
                   2828: 					$symb,$udom,$uname);
                   2829:     if ($encrypturl =~ /^yes$/i) {
                   2830: 	&Apache::lonenc::encrypted(\$url,1);
                   2831: 	&Apache::lonenc::encrypted(\$symb,1);
                   2832:     }
                   2833:     return ($url,$symb);
                   2834: }
                   2835: 
1.313     banghart 2836: sub get_submitted_files {
                   2837:     my ($udom,$uname,$partid,$respid,$record) = @_;
                   2838:     my @files;
                   2839:     if ($$record{"resource.$partid.$respid.portfiles"}) {
                   2840:         my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio';
                   2841:         foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) {
                   2842:     	    push(@files,$file_url.$file);
                   2843:         }
                   2844:     }
                   2845:     if ($$record{"resource.$partid.$respid.uploadedurl"}) {
                   2846:         push(@files,$$record{"resource.$partid.$respid.uploadedurl"});
                   2847:     }
                   2848:     return (\@files);
                   2849: }
1.322     albertel 2850: 
1.269     raeburn  2851: # ----------- Provides number of tries since last reset.
                   2852: sub get_num_tries {
                   2853:     my ($record,$last_reset,$part) = @_;
                   2854:     my $timestamp = '';
                   2855:     my $num_tries = 0;
                   2856:     if ($$record{'version'}) {
                   2857:         for (my $version=$$record{'version'};$version>=1;$version--) {
                   2858:             if (exists($$record{$version.':resource.'.$part.'.solved'})) {
                   2859:                 $timestamp = $$record{$version.':timestamp'};
                   2860:                 if ($timestamp > $last_reset) {
                   2861:                     $num_tries ++;
                   2862:                 } else {
                   2863:                     last;
                   2864:                 }
                   2865:             }
                   2866:         }
                   2867:     }
                   2868:     return $num_tries;
                   2869: }
                   2870: 
                   2871: # ----------- Determine decrements required in aggregate totals 
                   2872: sub decrement_aggs {
                   2873:     my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_;
                   2874:     my %decrement = (
                   2875:                         attempts => 0,
                   2876:                         users => 0,
                   2877:                         correct => 0
                   2878:                     );
                   2879:     $decrement{'attempts'} = $aggtries;
                   2880:     if ($solvedstatus =~ /^correct/) {
                   2881:         $decrement{'correct'} = 1;
                   2882:     }
                   2883:     if ($aggtries == $totaltries) {
                   2884:         $decrement{'users'} = 1;
                   2885:     }
                   2886:     foreach my $type (keys (%decrement)) {
                   2887:         $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type};
                   2888:     }
                   2889:     return;
                   2890: }
                   2891: 
                   2892: # ----------- Determine timestamps for last reset of aggregate totals for parts  
                   2893: sub get_last_resets {
1.270     albertel 2894:     my ($symb,$courseid,$partids) =@_;
                   2895:     my %last_resets;
1.269     raeburn  2896:     my $cdom = $env{'course.'.$courseid.'.domain'};
                   2897:     my $cname = $env{'course.'.$courseid.'.num'};
1.271     albertel 2898:     my @keys;
                   2899:     foreach my $part (@{$partids}) {
                   2900: 	push(@keys,"$symb\0$part\0resettime");
                   2901:     }
                   2902:     my %results=&Apache::lonnet::get('nohist_resourcetracker',\@keys,
                   2903: 				     $cdom,$cname);
                   2904:     foreach my $part (@{$partids}) {
                   2905: 	$last_resets{$part}=$results{"$symb\0$part\0resettime"};
1.269     raeburn  2906:     }
1.270     albertel 2907:     return %last_resets;
1.269     raeburn  2908: }
                   2909: 
1.251     banghart 2910: # ----------- Handles creating versions for portfolio files as answers
                   2911: sub version_portfiles {
1.343     banghart 2912:     my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_;
1.263     banghart 2913:     my $version_parts = join('|',@$v_flag);
1.343     banghart 2914:     my @returned_keys;
1.255     banghart 2915:     my $parts = join('|', @$parts_graded);
1.359     www      2916:     my $portfolio_root = &propath($domain,$stu_name).
                   2917: 	'/userfiles/portfolio';
1.277     albertel 2918:     foreach my $key (keys(%$record)) {
1.259     banghart 2919:         my $new_portfiles;
1.263     banghart 2920:         if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {
1.342     banghart 2921:             my @versioned_portfiles;
1.367     albertel 2922:             my @portfiles = split(/\s*,\s*/,$$record{$key});
1.252     banghart 2923:             foreach my $file (@portfiles) {
1.306     banghart 2924:                 &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file);
1.304     albertel 2925:                 my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
                   2926: 		my ($answer_name,$answer_ver,$answer_ext) =
                   2927: 		    &file_name_version_ext($answer_file);
1.306     banghart 2928:                 my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root);
1.342     banghart 2929:                 my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
1.306     banghart 2930:                 my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
                   2931:                 if ($new_answer ne 'problem getting file') {
1.342     banghart 2932:                     push(@versioned_portfiles, $directory.$new_answer);
1.306     banghart 2933:                     &Apache::lonnet::mark_as_readonly($domain,$stu_name,
1.367     albertel 2934:                         [$directory.$new_answer],
1.306     banghart 2935:                         [$symb,$env{'request.course.id'},'graded']);
1.259     banghart 2936:                 }
1.252     banghart 2937:             }
1.343     banghart 2938:             $$record{$key} = join(',',@versioned_portfiles);
                   2939:             push(@returned_keys,$key);
1.251     banghart 2940:         }
                   2941:     } 
1.343     banghart 2942:     return (@returned_keys);   
1.305     banghart 2943: }
                   2944: 
1.307     banghart 2945: sub get_next_version {
1.341     banghart 2946:     my ($answer_name, $answer_ext, $dir_list) = @_;
1.307     banghart 2947:     my $version;
                   2948:     foreach my $row (@$dir_list) {
                   2949:         my ($file) = split(/\&/,$row,2);
                   2950:         my ($file_name,$file_version,$file_ext) =
                   2951: 	    &file_name_version_ext($file);
                   2952:         if (($file_name eq $answer_name) && 
                   2953: 	    ($file_ext eq $answer_ext)) {
                   2954:                 # gets here if filename and extension match, regardless of version
                   2955:                 if ($file_version ne '') {
                   2956:                 # a versioned file is found  so save it for later
                   2957:                 if ($file_version > $version) {
                   2958: 		    $version = $file_version;
                   2959: 	        }
                   2960:             }
                   2961:         }
                   2962:     } 
                   2963:     $version ++;
                   2964:     return($version);
                   2965: }
                   2966: 
1.305     banghart 2967: sub version_selected_portfile {
1.306     banghart 2968:     my ($domain,$stu_name,$directory,$file_name,$version) = @_;
                   2969:     my ($answer_name,$answer_ver,$answer_ext) =
                   2970:         &file_name_version_ext($file_name);
                   2971:     my $new_answer;
                   2972:     $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name");
                   2973:     if($env{'form.copy'} eq '-1') {
                   2974:         $new_answer = 'problem getting file';
                   2975:     } else {
                   2976:         $new_answer = $answer_name.'.'.$version.'.'.$answer_ext;
                   2977:         my $copy_result = &Apache::lonnet::finishuserfileupload(
                   2978:                             $stu_name,$domain,'copy',
                   2979: 		        '/portfolio'.$directory.$new_answer);
                   2980:     }    
                   2981:     return ($new_answer);
1.251     banghart 2982: }
                   2983: 
1.304     albertel 2984: sub file_name_version_ext {
                   2985:     my ($file)=@_;
                   2986:     my @file_parts = split(/\./, $file);
                   2987:     my ($name,$version,$ext);
                   2988:     if (@file_parts > 1) {
                   2989: 	$ext=pop(@file_parts);
                   2990: 	if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) {
                   2991: 	    $version=pop(@file_parts);
                   2992: 	}
                   2993: 	$name=join('.',@file_parts);
                   2994:     } else {
                   2995: 	$name=join('.',@file_parts);
                   2996:     }
                   2997:     return($name,$version,$ext);
                   2998: }
                   2999: 
1.44      ng       3000: #--------------------------------------------------------------------------------------
                   3001: #
                   3002: #-------------------------- Next few routines handles grading by section or whole class
                   3003: #
                   3004: #--- Javascript to handle grading by section or whole class
1.42      ng       3005: sub viewgrades_js {
                   3006:     my ($request) = shift;
                   3007: 
1.41      ng       3008:     $request->print(<<VIEWJAVASCRIPT);
                   3009: <script type="text/javascript" language="javascript">
1.45      ng       3010:    function writePoint(partid,weight,point) {
1.125     ng       3011: 	var radioButton = document.classgrade["RADVAL_"+partid];
                   3012: 	var textbox = document.classgrade["TEXTVAL_"+partid];
1.42      ng       3013: 	if (point == "textval") {
1.125     ng       3014: 	    point = document.classgrade["TEXTVAL_"+partid].value;
1.109     matthew  3015: 	    if (isNaN(point) || parseFloat(point) < 0) {
                   3016: 		alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point));
1.42      ng       3017: 		var resetbox = false;
                   3018: 		for (var i=0; i<radioButton.length; i++) {
                   3019: 		    if (radioButton[i].checked) {
                   3020: 			textbox.value = i;
                   3021: 			resetbox = true;
                   3022: 		    }
                   3023: 		}
                   3024: 		if (!resetbox) {
                   3025: 		    textbox.value = "";
                   3026: 		}
                   3027: 		return;
                   3028: 	    }
1.109     matthew  3029: 	    if (parseFloat(point) > parseFloat(weight)) {
                   3030: 		var resp = confirm("You entered a value ("+parseFloat(point)+
1.44      ng       3031: 				   ") greater than the weight for the part. Accept?");
                   3032: 		if (resp == false) {
                   3033: 		    textbox.value = "";
                   3034: 		    return;
                   3035: 		}
                   3036: 	    }
1.42      ng       3037: 	    for (var i=0; i<radioButton.length; i++) {
                   3038: 		radioButton[i].checked=false;
1.109     matthew  3039: 		if (parseFloat(point) == i) {
1.42      ng       3040: 		    radioButton[i].checked=true;
                   3041: 		}
                   3042: 	    }
1.41      ng       3043: 
1.42      ng       3044: 	} else {
1.125     ng       3045: 	    textbox.value = parseFloat(point);
1.42      ng       3046: 	}
1.41      ng       3047: 	for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3048: 	    var user = document.classgrade["ctr"+i].value;
1.289     albertel 3049: 	    user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3050: 	    var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3051: 	    var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3052: 	    var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.42      ng       3053: 	    if (saveval != "correct") {
                   3054: 		scorename.value = point;
1.43      ng       3055: 		if (selname[0].selected != true) {
                   3056: 		    selname[0].selected = true;
                   3057: 		}
1.42      ng       3058: 	    }
                   3059: 	}
1.125     ng       3060: 	document.classgrade["SELVAL_"+partid][0].selected = true;
1.42      ng       3061:     }
                   3062: 
                   3063:     function writeRadText(partid,weight) {
1.125     ng       3064: 	var selval   = document.classgrade["SELVAL_"+partid];
                   3065: 	var radioButton = document.classgrade["RADVAL_"+partid];
1.265     www      3066:         var override = document.classgrade["FORCE_"+partid].checked;
1.125     ng       3067: 	var textbox = document.classgrade["TEXTVAL_"+partid];
                   3068: 	if (selval[1].selected || selval[2].selected) {
1.42      ng       3069: 	    for (var i=0; i<radioButton.length; i++) {
                   3070: 		radioButton[i].checked=false;
                   3071: 
                   3072: 	    }
                   3073: 	    textbox.value = "";
                   3074: 
                   3075: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3076: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3077: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3078: 		var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3079: 		var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3080: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.265     www      3081: 		if ((saveval != "correct") || override) {
1.42      ng       3082: 		    scorename.value = "";
1.125     ng       3083: 		    if (selval[1].selected) {
                   3084: 			selname[1].selected = true;
                   3085: 		    } else {
                   3086: 			selname[2].selected = true;
                   3087: 			if (Number(document.classgrade["GD_"+user+"_"+partid+"_tries"].value)) 
                   3088: 			{document.classgrade["GD_"+user+"_"+partid+"_tries"].value = '0';}
                   3089: 		    }
1.42      ng       3090: 		}
                   3091: 	    }
1.43      ng       3092: 	} else {
                   3093: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3094: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3095: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3096: 		var scorename = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3097: 		var saveval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3098: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.265     www      3099: 		if ((saveval != "correct") || override) {
1.125     ng       3100: 		    scorename.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value;
1.43      ng       3101: 		    selname[0].selected = true;
                   3102: 		}
                   3103: 	    }
                   3104: 	}	    
1.42      ng       3105:     }
                   3106: 
                   3107:     function changeSelect(partid,user) {
1.125     ng       3108: 	var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"];
                   3109: 	var textbox = document.classgrade["GD_"+user+'_'+partid+"_awarded"];
1.44      ng       3110: 	var point  = textbox.value;
1.125     ng       3111: 	var weight = document.classgrade["weight_"+partid].value;
1.44      ng       3112: 
1.109     matthew  3113: 	if (isNaN(point) || parseFloat(point) < 0) {
                   3114: 	    alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point));
1.44      ng       3115: 	    textbox.value = "";
                   3116: 	    return;
                   3117: 	}
1.109     matthew  3118: 	if (parseFloat(point) > parseFloat(weight)) {
                   3119: 	    var resp = confirm("You entered a value ("+parseFloat(point)+
1.44      ng       3120: 			       ") greater than the weight of the part. Accept?");
                   3121: 	    if (resp == false) {
                   3122: 		textbox.value = "";
                   3123: 		return;
                   3124: 	    }
                   3125: 	}
1.42      ng       3126: 	selval[0].selected = true;
                   3127:     }
                   3128: 
                   3129:     function changeOneScore(partid,user) {
1.125     ng       3130: 	var selval = document.classgrade["GD_"+user+'_'+partid+"_solved"];
                   3131: 	if (selval[1].selected || selval[2].selected) {
                   3132: 	    document.classgrade["GD_"+user+'_'+partid+"_awarded"].value = "";
                   3133: 	    if (selval[2].selected) {
                   3134: 		document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0";
                   3135: 	    }
1.269     raeburn  3136:         }
1.42      ng       3137:     }
                   3138: 
                   3139:     function resetEntry(numpart) {
                   3140: 	for (ctpart=0;ctpart<numpart;ctpart++) {
1.125     ng       3141: 	    var partid = document.classgrade["partid_"+ctpart].value;
                   3142: 	    var radioButton = document.classgrade["RADVAL_"+partid];
                   3143: 	    var textbox = document.classgrade["TEXTVAL_"+partid];
                   3144: 	    var selval  = document.classgrade["SELVAL_"+partid];
1.42      ng       3145: 	    for (var i=0; i<radioButton.length; i++) {
                   3146: 		radioButton[i].checked=false;
                   3147: 
                   3148: 	    }
                   3149: 	    textbox.value = "";
                   3150: 	    selval[0].selected = true;
                   3151: 
                   3152: 	    for (i=0;i<document.classgrade.total.value;i++) {
1.125     ng       3153: 		var user = document.classgrade["ctr"+i].value;
1.289     albertel 3154: 		user = user.replace(new RegExp(':', 'g'),"_");
1.125     ng       3155: 		var resetscore = document.classgrade["GD_"+user+"_"+partid+"_awarded"];
                   3156: 		resetscore.value = document.classgrade["GD_"+user+"_"+partid+"_awarded_s"].value;
                   3157: 		var resettries = document.classgrade["GD_"+user+"_"+partid+"_tries"];
                   3158: 		resettries.value = document.classgrade["GD_"+user+"_"+partid+"_tries_s"].value;
                   3159: 		var saveselval   = document.classgrade["GD_"+user+"_"+partid+"_solved_s"].value;
                   3160: 		var selname   = document.classgrade["GD_"+user+"_"+partid+"_solved"];
1.42      ng       3161: 		if (saveselval == "excused") {
1.43      ng       3162: 		    if (selname[1].selected == false) { selname[1].selected = true;}
1.42      ng       3163: 		} else {
1.43      ng       3164: 		    if (selname[0].selected == false) {selname[0].selected = true};
1.42      ng       3165: 		}
                   3166: 	    }
1.41      ng       3167: 	}
1.42      ng       3168:     }
                   3169: 
1.41      ng       3170: </script>
                   3171: VIEWJAVASCRIPT
1.42      ng       3172: }
                   3173: 
1.44      ng       3174: #--- show scores for a section or whole class w/ option to change/update a score
1.42      ng       3175: sub viewgrades {
                   3176:     my ($request) = shift;
                   3177:     &viewgrades_js($request);
1.41      ng       3178: 
1.324     albertel 3179:     my ($symb) = &get_symb($request);
1.168     albertel 3180:     #need to make sure we have the correct data for later EXT calls, 
                   3181:     #thus invalidate the cache
                   3182:     &Apache::lonnet::devalidatecourseresdata(
1.257     albertel 3183:                  $env{'course.'.$env{'request.course.id'}.'.num'},
                   3184:                  $env{'course.'.$env{'request.course.id'}.'.domain'});
1.168     albertel 3185:     &Apache::lonnet::clear_EXT_cache_status();
                   3186: 
1.398     albertel 3187:     my $result='<h3><span class="LC_info">'.&mt('Manual Grading').'</span></h3>';
1.485     albertel 3188:     $result.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4>'."\n";
1.41      ng       3189: 
                   3190:     #view individual student submission form - called using Javascript viewOneStudent
1.324     albertel 3191:     $result.=&jscriptNform($symb);
1.41      ng       3192: 
1.44      ng       3193:     #beginning of class grading form
1.442     banghart 3194:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
1.41      ng       3195:     $result.= '<form action="/adm/grades" method="post" name="classgrade">'."\n".
1.418     albertel 3196: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.38      ng       3197: 	'<input type="hidden" name="command" value="editgrades" />'."\n".
1.432     banghart 3198: 	&build_section_inputs().
1.257     albertel 3199: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
1.442     banghart 3200: 	'<input type="hidden" name="Status" value="'.$env{'stu_status'}.'" />'."\n".
1.257     albertel 3201: 	'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
1.72      ng       3202: 
1.126     ng       3203:     my $sectionClass;
1.430     banghart 3204:     my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
1.257     albertel 3205:     if ($env{'form.section'} eq 'all') {
1.485     albertel 3206: 	$sectionClass='Class';
1.257     albertel 3207:     } elsif ($env{'form.section'} eq 'none') {
1.485     albertel 3208: 	$sectionClass='Students in no Section';
1.52      albertel 3209:     } else {
1.485     albertel 3210: 	$sectionClass='Students in Section(s) [_1]';
1.52      albertel 3211:     }
1.485     albertel 3212:     $result.=
                   3213: 	'<h3>'.
                   3214: 	&mt("Assign Common Grade To $sectionClass",$section_display).'</h3>';
1.474     albertel 3215:     $result.= &Apache::loncommon::start_data_table();
1.44      ng       3216:     #radio buttons/text box for assigning points for a section or class.
                   3217:     #handles different parts of a problem
1.375     albertel 3218:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
1.42      ng       3219:     my %weight = ();
                   3220:     my $ctsparts = 0;
1.45      ng       3221:     my %seen = ();
1.375     albertel 3222:     my @part_response_id = &flatten_responseType($responseType);
                   3223:     foreach my $part_response_id (@part_response_id) {
                   3224:     	my ($partid,$respid) = @{ $part_response_id };
                   3225: 	my $part_resp = join('_',@{ $part_response_id });
1.45      ng       3226: 	next if $seen{$partid};
                   3227: 	$seen{$partid}++;
1.375     albertel 3228: 	my $handgrade=$$handgrade{$part_resp};
1.42      ng       3229: 	my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);
                   3230: 	$weight{$partid} = $wgt eq '' ? '1' : $wgt;
                   3231: 
1.324     albertel 3232: 	my $display_part=&get_display_part($partid,$symb);
1.485     albertel 3233: 	my $radio.='<table border="0"><tr>';  
1.41      ng       3234: 	my $ctr = 0;
1.42      ng       3235: 	while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across
1.485     albertel 3236: 	    $radio.= '<td><label><input type="radio" name="RADVAL_'.$partid.'" '.
1.54      albertel 3237: 		'onclick="javascript:writePoint(\''.$partid.'\','.$weight{$partid}.
1.288     albertel 3238: 		','.$ctr.')" />'.$ctr."</label></td>\n";
1.41      ng       3239: 	    $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');
                   3240: 	    $ctr++;
                   3241: 	}
1.485     albertel 3242: 	$radio.='</tr></table>';
                   3243: 	my $line = '<input type="text" name="TEXTVAL_'.
1.54      albertel 3244: 	    $partid.'" size="4" '.'onChange="javascript:writePoint(\''.
                   3245: 		$partid.'\','.$weight{$partid}.',\'textval\')" /> /'.
1.42      ng       3246: 	    $weight{$partid}.' (problem weight)</td>'."\n";
1.485     albertel 3247: 	$line.= '<td><select name="SELVAL_'.$partid.'"'.
1.54      albertel 3248: 	    'onChange="javascript:writeRadText(\''.$partid.'\','.
1.59      albertel 3249: 		$weight{$partid}.')"> '.
1.401     albertel 3250: 	    '<option selected="selected"> </option>'.
1.485     albertel 3251: 	    '<option value="excused">'.&mt('excused').'</option>'.
                   3252: 	    '<option value="reset status">'.&mt('reset status').'</option>'.
                   3253: 	    '</select></td>'.
                   3254:             '<td><label><input type="checkbox" name="FORCE_'.$partid.'" />'.&mt('Override "Correct"').'</label>';
                   3255: 	$line.='<input type="hidden" name="partid_'.
                   3256: 	    $ctsparts.'" value="'.$partid.'" />'."\n";
                   3257: 	$line.='<input type="hidden" name="weight_'.
                   3258: 	    $partid.'" value="'.$weight{$partid}.'" />'."\n";
                   3259: 
                   3260: 	$result.=
                   3261: 	    &Apache::loncommon::start_data_table_row()."\n".
                   3262: 	    &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).
                   3263: 	    &Apache::loncommon::end_data_table_row()."\n";
1.42      ng       3264: 	$ctsparts++;
1.41      ng       3265:     }
1.474     albertel 3266:     $result.=&Apache::loncommon::end_data_table()."\n".
1.52      albertel 3267: 	'<input type="hidden" name="totalparts" value="'.$ctsparts.'" />';
1.485     albertel 3268:     $result.='<input type="button" value="'.&mt('Revert to Default').'" '.
1.474     albertel 3269: 	'onClick="javascript:resetEntry('.$ctsparts.');" />';
1.41      ng       3270: 
1.44      ng       3271:     #table listing all the students in a section/class
                   3272:     #header of table
1.485     albertel 3273:     $result.= '<h3>'.&mt('Assign Grade to Specific Students in '.$sectionClass,
                   3274: 			 $section_display).'</h3>';
1.474     albertel 3275:     $result.= &Apache::loncommon::start_data_table().
                   3276: 	&Apache::loncommon::start_data_table_header_row().
1.485     albertel 3277: 	'<th>'.&mt('No.').'</th>'.
1.474     albertel 3278: 	'<th>'.&nameUserString('header')."</th>\n";
1.324     albertel 3279:     my (@parts) = sort(&getpartlist($symb));
                   3280:     my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
1.269     raeburn  3281:     my @partids = ();
1.41      ng       3282:     foreach my $part (@parts) {
                   3283: 	my $display=&Apache::lonnet::metadata($url,$part.'.display');
1.126     ng       3284: 	$display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower
1.41      ng       3285: 	if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
1.207     albertel 3286: 	my ($partid) = &split_part_type($part);
1.269     raeburn  3287:         push(@partids, $partid);
1.324     albertel 3288: 	my $display_part=&get_display_part($partid,$symb);
1.41      ng       3289: 	if ($display =~ /^Partial Credit Factor/) {
1.485     albertel 3290: 	    $result.='<th>'.
                   3291: 		&mt('Score Part: [_1]<br /> (weight = [_2])',
                   3292: 		    $display_part,$weight{$partid}).'</th>'."\n";
1.41      ng       3293: 	    next;
1.485     albertel 3294: 	    
1.207     albertel 3295: 	} else {
1.485     albertel 3296: 	    if ($display =~ /Problem Status/) {
                   3297: 		my $grade_status_mt = &mt('Grade Status');
                   3298: 		$display =~ s{Problem Status}{$grade_status_mt<br />};
                   3299: 	    }
                   3300: 	    my $part_mt = &mt('Part:');
                   3301: 	    $display =~s{\[Part: \Q$partid\E\]}{$part_mt $display_part};
1.41      ng       3302: 	}
1.485     albertel 3303: 
1.474     albertel 3304: 	$result.='<th>'.$display.'</th>'."\n";
1.41      ng       3305:     }
1.474     albertel 3306:     $result.=&Apache::loncommon::end_data_table_header_row();
1.44      ng       3307: 
1.270     albertel 3308:     my %last_resets = 
                   3309: 	&get_last_resets($symb,$env{'request.course.id'},\@partids);
1.269     raeburn  3310: 
1.41      ng       3311:     #get info for each student
1.44      ng       3312:     #list all the students - with points and grade status
1.257     albertel 3313:     my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');
1.41      ng       3314:     my $ctr = 0;
1.294     albertel 3315:     foreach (sort 
                   3316: 	     {
                   3317: 		 if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   3318: 		     return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   3319: 		 }
                   3320: 		 return $a cmp $b;
                   3321: 	     } (keys(%$fullname))) {
1.126     ng       3322: 	$ctr++;
1.324     albertel 3323: 	$result.=&viewstudentgrade($symb,$env{'request.course.id'},
1.269     raeburn  3324: 				   $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets);
1.41      ng       3325:     }
1.474     albertel 3326:     $result.=&Apache::loncommon::end_data_table();
1.41      ng       3327:     $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n";
1.485     albertel 3328:     $result.='<input type="button" value="'.&mt('Save').'" '.
1.417     albertel 3329: 	'onClick="javascript:submit();" target="_self" /></form>'."\n";
1.96      albertel 3330:     if (scalar(%$fullname) eq 0) {
                   3331: 	my $colspan=3+scalar(@parts);
1.433     banghart 3332: 	my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
1.442     banghart 3333:         my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status'));
1.433     banghart 3334: 	$result='<span class="LC_warning">'.
1.485     albertel 3335: 	    &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.',
1.442     banghart 3336: 	        $section_display, $stu_status).
1.433     banghart 3337: 	    '</span>';
1.96      albertel 3338:     }
1.324     albertel 3339:     $result.=&show_grading_menu_form($symb);
1.41      ng       3340:     return $result;
                   3341: }
                   3342: 
1.44      ng       3343: #--- call by previous routine to display each student
1.41      ng       3344: sub viewstudentgrade {
1.324     albertel 3345:     my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_;
1.44      ng       3346:     my ($uname,$udom) = split(/:/,$student);
                   3347:     my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
1.269     raeburn  3348:     my %aggregates = (); 
1.474     albertel 3349:     my $result=&Apache::loncommon::start_data_table_row().'<td align="right">'.
1.233     albertel 3350: 	'<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.
                   3351: 	"\n".$ctr.'&nbsp;</td><td>&nbsp;'.
1.44      ng       3352: 	'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
1.417     albertel 3353: 	'\');" target="_self">'.$fullname.'</a> '.
1.398     albertel 3354: 	'<span class="LC_internal_info">('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')</span></td>'."\n";
1.281     albertel 3355:     $student=~s/:/_/; # colon doen't work in javascript for names
1.63      albertel 3356:     foreach my $apart (@$parts) {
                   3357: 	my ($part,$type) = &split_part_type($apart);
1.41      ng       3358: 	my $score=$record{"resource.$part.$type"};
1.276     albertel 3359:         $result.='<td align="center">';
1.269     raeburn  3360:         my ($aggtries,$totaltries);
                   3361:         unless (exists($aggregates{$part})) {
1.270     albertel 3362: 	    $totaltries = $record{'resource.'.$part.'.tries'};
                   3363: 
                   3364: 	    $aggtries = $totaltries;
1.269     raeburn  3365:             if ($$last_resets{$part}) {  
1.270     albertel 3366:                 $aggtries = &get_num_tries(\%record,$$last_resets{$part},
                   3367: 					   $part);
                   3368:             }
1.269     raeburn  3369:             $result.='<input type="hidden" name="'.
                   3370:                 'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n";
                   3371:             $result.='<input type="hidden" name="'.
                   3372:                 'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n";
                   3373:             $aggregates{$part} = 1;
                   3374:         }
1.41      ng       3375: 	if ($type eq 'awarded') {
1.320     albertel 3376: 	    my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part});
1.42      ng       3377: 	    $result.='<input type="hidden" name="'.
1.89      albertel 3378: 		'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
1.233     albertel 3379: 	    $result.='<input type="text" name="'.
1.89      albertel 3380: 		'GD_'.$student.'_'.$part.'_awarded" '.
                   3381: 		'onChange="javascript:changeSelect(\''.$part.'\',\''.$student.
1.44      ng       3382: 		'\')" value="'.$pts.'" size="4" /></td>'."\n";
1.41      ng       3383: 	} elsif ($type eq 'solved') {
                   3384: 	    my ($status,$foo)=split(/_/,$score,2);
                   3385: 	    $status = 'nothing' if ($status eq '');
1.89      albertel 3386: 	    $result.='<input type="hidden" name="'.'GD_'.$student.'_'.
1.54      albertel 3387: 		$part.'_solved_s" value="'.$status.'" />'."\n";
1.233     albertel 3388: 	    $result.='&nbsp;<select name="'.
1.89      albertel 3389: 		'GD_'.$student.'_'.$part.'_solved" '.
                   3390: 		'onChange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n";
1.485     albertel 3391: 	    $result.= (($status eq 'excused') ? '<option> </option><option selected="selected" value="excused">'.&mt('excused').'</option>' 
                   3392: 		: '<option selected="selected"> </option><option value="excused">'.&mt('excused').'</option>')."\n";
                   3393: 	    $result.='<option value="reset status">'.&mt('reset status').'</option>';
1.126     ng       3394: 	    $result.="</select>&nbsp;</td>\n";
1.122     ng       3395: 	} else {
                   3396: 	    $result.='<input type="hidden" name="'.
                   3397: 		'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.
                   3398: 		    "\n";
1.233     albertel 3399: 	    $result.='<input type="text" name="'.
1.122     ng       3400: 		'GD_'.$student.'_'.$part.'_'.$type.'" '.
                   3401: 		'value="'.$score.'" size="4" /></td>'."\n";
1.41      ng       3402: 	}
                   3403:     }
1.474     albertel 3404:     $result.=&Apache::loncommon::end_data_table_row();
1.41      ng       3405:     return $result;
1.38      ng       3406: }
                   3407: 
1.44      ng       3408: #--- change scores for all the students in a section/class
                   3409: #    record does not get update if unchanged
1.38      ng       3410: sub editgrades {
1.41      ng       3411:     my ($request) = @_;
                   3412: 
1.324     albertel 3413:     my $symb=&get_symb($request);
1.433     banghart 3414:     my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
1.477     albertel 3415:     my $title='<h2>'.&mt('Current Grade Status').'</h2>';
                   3416:     $title.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4>'."\n";
1.433     banghart 3417:     $title.='<h4>'.&mt('<b>Section: </b>[_1]',$section_display).'</h4>'."\n";
1.126     ng       3418: 
1.477     albertel 3419:     my $result= &Apache::loncommon::start_data_table().
                   3420: 	&Apache::loncommon::start_data_table_header_row().
                   3421: 	'<th rowspan="2" valign="middle">'.&mt('No.').'</th>'.
                   3422: 	'<th rowspan="2" valign="middle">'.&nameUserString('header')."</th>\n";
1.43      ng       3423:     my %scoreptr = (
                   3424: 		    'correct'  =>'correct_by_override',
                   3425: 		    'incorrect'=>'incorrect_by_override',
                   3426: 		    'excused'  =>'excused',
                   3427: 		    'ungraded' =>'ungraded_attempted',
                   3428: 		    'nothing'  => '',
                   3429: 		    );
1.257     albertel 3430:     my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0');
1.34      ng       3431: 
1.44      ng       3432:     my (@partid);
                   3433:     my %weight = ();
1.54      albertel 3434:     my %columns = ();
1.44      ng       3435:     my ($i,$ctr,$count,$rec_update) = (0,0,0,0);
1.54      albertel 3436: 
1.324     albertel 3437:     my (@parts) = sort(&getpartlist($symb));
1.54      albertel 3438:     my $header;
1.257     albertel 3439:     while ($ctr < $env{'form.totalparts'}) {
                   3440: 	my $partid = $env{'form.partid_'.$ctr};
1.44      ng       3441: 	push @partid,$partid;
1.257     albertel 3442: 	$weight{$partid} = $env{'form.weight_'.$partid};
1.44      ng       3443: 	$ctr++;
1.54      albertel 3444:     }
1.324     albertel 3445:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.54      albertel 3446:     foreach my $partid (@partid) {
1.478     albertel 3447: 	$header .= '<th align="center">'.&mt('Old Score').'</th>'.
                   3448: 	    '<th align="center">'.&mt('New Score').'</th>';
1.54      albertel 3449: 	$columns{$partid}=2;
                   3450: 	foreach my $stores (@parts) {
                   3451: 	    my ($part,$type) = &split_part_type($stores);
                   3452: 	    if ($part !~ m/^\Q$partid\E/) { next;}
                   3453: 	    if ($type eq 'awarded' || $type eq 'solved') { next; }
                   3454: 	    my $display=&Apache::lonnet::metadata($url,$stores.'.display');
                   3455: 	    $display =~ s/\[Part: (\w)+\]//;
1.125     ng       3456: 	    $display =~ s/Number of Attempts/Tries/;
1.478     albertel 3457: 	    $header .= '<th align="center">'.&mt('Old '.$display).'</th>'.
                   3458: 		'<th align="center">'.&mt('New '.$display).'</th>';
1.54      albertel 3459: 	    $columns{$partid}+=2;
                   3460: 	}
                   3461:     }
                   3462:     foreach my $partid (@partid) {
1.324     albertel 3463: 	my $display_part=&get_display_part($partid,$symb);
1.478     albertel 3464: 	$result .= '<th colspan="'.$columns{$partid}.'" align="center">'.
                   3465: 	    &mt('Part: [_1] (Weight = [_2])',$display_part,$weight{$partid}).
                   3466: 	    '</th>';
1.54      albertel 3467: 
1.44      ng       3468:     }
1.477     albertel 3469:     $result .= &Apache::loncommon::end_data_table_header_row().
                   3470: 	&Apache::loncommon::start_data_table_header_row().
                   3471: 	$header.
                   3472: 	&Apache::loncommon::end_data_table_header_row();
                   3473:     my @noupdate;
1.126     ng       3474:     my ($updateCtr,$noupdateCtr) = (1,1);
1.257     albertel 3475:     for ($i=0; $i<$env{'form.total'}; $i++) {
1.93      albertel 3476: 	my $line;
1.257     albertel 3477: 	my $user = $env{'form.ctr'.$i};
1.281     albertel 3478: 	my ($uname,$udom)=split(/:/,$user);
1.44      ng       3479: 	my %newrecord;
                   3480: 	my $updateflag = 0;
1.281     albertel 3481: 	$line .= '<td>'.&nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>';
1.108     albertel 3482: 	my $usec=$classlist->{"$uname:$udom"}[5];
1.105     albertel 3483: 	if (!&canmodify($usec)) {
1.126     ng       3484: 	    my $numcols=scalar(@partid)*4+2;
1.477     albertel 3485: 	    push(@noupdate,
1.478     albertel 3486: 		 $line."<td colspan=\"$numcols\"><span class=\"LC_warning\">".
                   3487: 		 &mt('Not allowed to modify student')."</span></td></tr>");
1.105     albertel 3488: 	    next;
                   3489: 	}
1.269     raeburn  3490:         my %aggregate = ();
                   3491:         my $aggregateflag = 0;
1.281     albertel 3492: 	$user=~s/:/_/; # colon doen't work in javascript for names
1.44      ng       3493: 	foreach (@partid) {
1.257     albertel 3494: 	    my $old_aw    = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
1.54      albertel 3495: 	    my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
                   3496: 	    my $old_part  = $old_aw eq '' ? '' : $old_part_pcr;
1.257     albertel 3497: 	    my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
                   3498: 	    my $awarded   = $env{'form.GD_'.$user.'_'.$_.'_awarded'};
1.54      albertel 3499: 	    my $pcr       = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
                   3500: 	    my $partial   = $awarded eq '' ? '' : $pcr;
1.44      ng       3501: 	    my $score;
                   3502: 	    if ($partial eq '') {
1.257     albertel 3503: 		$score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
1.44      ng       3504: 	    } elsif ($partial > 0) {
                   3505: 		$score = 'correct_by_override';
                   3506: 	    } elsif ($partial == 0) {
                   3507: 		$score = 'incorrect_by_override';
                   3508: 	    }
1.257     albertel 3509: 	    my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'};
1.125     ng       3510: 	    $score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused'));
                   3511: 
1.292     albertel 3512: 	    $newrecord{'resource.'.$_.'.regrader'}=
                   3513: 		"$env{'user.name'}:$env{'user.domain'}";
1.125     ng       3514: 	    if ($dropMenu eq 'reset status' &&
                   3515: 		$old_score ne '') { # ignore if no previous attempts => nothing to reset
1.299     albertel 3516: 		$newrecord{'resource.'.$_.'.tries'} = '';
1.125     ng       3517: 		$newrecord{'resource.'.$_.'.solved'} = '';
                   3518: 		$newrecord{'resource.'.$_.'.award'} = '';
1.299     albertel 3519: 		$newrecord{'resource.'.$_.'.awarded'} = '';
1.125     ng       3520: 		$updateflag = 1;
1.269     raeburn  3521:                 if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) {
                   3522:                     my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'};
                   3523:                     my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'};
                   3524:                     my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'};
                   3525:                     &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                   3526:                     $aggregateflag = 1;
                   3527:                 }
1.139     albertel 3528: 	    } elsif (!($old_part eq $partial && $old_score eq $score)) {
                   3529: 		$updateflag = 1;
                   3530: 		$newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';
                   3531: 		$newrecord{'resource.'.$_.'.solved'}   = $score;
                   3532: 		$rec_update++;
1.125     ng       3533: 	    }
                   3534: 
1.93      albertel 3535: 	    $line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.
1.44      ng       3536: 		'<td align="center">'.$awarded.
                   3537: 		($score eq 'excused' ? $score : '').'&nbsp;</td>';
1.5       albertel 3538: 
1.54      albertel 3539: 
                   3540: 	    my $partid=$_;
                   3541: 	    foreach my $stores (@parts) {
                   3542: 		my ($part,$type) = &split_part_type($stores);
                   3543: 		if ($part !~ m/^\Q$partid\E/) { next;}
                   3544: 		if ($type eq 'awarded' || $type eq 'solved') { next; }
1.257     albertel 3545: 		my $old_aw    = $env{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'};
                   3546: 		my $awarded   = $env{'form.GD_'.$user.'_'.$part.'_'.$type};
1.54      albertel 3547: 		if ($awarded ne '' && $awarded ne $old_aw) {
                   3548: 		    $newrecord{'resource.'.$part.'.'.$type}= $awarded;
1.257     albertel 3549: 		    $newrecord{'resource.'.$part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
1.54      albertel 3550: 		    $updateflag=1;
                   3551: 		}
1.93      albertel 3552: 		$line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.
1.54      albertel 3553: 		    '<td align="center">'.$awarded.'&nbsp;</td>';
                   3554: 	    }
1.44      ng       3555: 	}
1.477     albertel 3556: 	$line.="\n";
1.301     albertel 3557: 
                   3558: 	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3559: 	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3560: 
1.44      ng       3561: 	if ($updateflag) {
                   3562: 	    $count++;
1.257     albertel 3563: 	    &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'},
1.89      albertel 3564: 				    $udom,$uname);
1.301     albertel 3565: 
                   3566: 	    if (&Apache::bridgetask::in_queue('gradingqueue',$symb,$cdom,
                   3567: 					      $cnum,$udom,$uname)) {
                   3568: 		# need to figure out if should be in queue.
                   3569: 		my %record =  
                   3570: 		    &Apache::lonnet::restore($symb,$env{'request.course.id'},
                   3571: 					     $udom,$uname);
                   3572: 		my $all_graded = 1;
                   3573: 		my $none_graded = 1;
                   3574: 		foreach my $part (@parts) {
                   3575: 		    if ( $record{'resource.'.$part.'.awarded'} eq '' ) {
                   3576: 			$all_graded = 0;
                   3577: 		    } else {
                   3578: 			$none_graded = 0;
                   3579: 		    }
                   3580: 		}
                   3581: 
                   3582: 		if ($all_graded || $none_graded) {
                   3583: 		    &Apache::bridgetask::remove_from_queue('gradingqueue',
                   3584: 							   $symb,$cdom,$cnum,
                   3585: 							   $udom,$uname);
                   3586: 		}
                   3587: 	    }
                   3588: 
1.477     albertel 3589: 	    $result.=&Apache::loncommon::start_data_table_row().
                   3590: 		'<td align="right">&nbsp;'.$updateCtr.'&nbsp;</td>'.$line.
                   3591: 		&Apache::loncommon::end_data_table_row();
1.126     ng       3592: 	    $updateCtr++;
1.93      albertel 3593: 	} else {
1.477     albertel 3594: 	    push(@noupdate,
                   3595: 		 '<td align="right">&nbsp;'.$noupdateCtr.'&nbsp;</td>'.$line);
1.126     ng       3596: 	    $noupdateCtr++;
1.44      ng       3597: 	}
1.269     raeburn  3598:         if ($aggregateflag) {
                   3599:             &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
1.301     albertel 3600: 				  $cdom,$cnum);
1.269     raeburn  3601:         }
1.93      albertel 3602:     }
1.477     albertel 3603:     if (@noupdate) {
1.126     ng       3604: #	my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
                   3605: 	my $numcols=scalar(@partid)*4+2;
1.477     albertel 3606: 	$result .= &Apache::loncommon::start_data_table_row('LC_empty_row').
1.478     albertel 3607: 	    '<td align="center" colspan="'.$numcols.'">'.
                   3608: 	    &mt('No Changes Occurred For the Students Below').
                   3609: 	    '</td>'.
1.477     albertel 3610: 	    &Apache::loncommon::end_data_table_row();
                   3611: 	foreach my $line (@noupdate) {
                   3612: 	    $result.=
                   3613: 		&Apache::loncommon::start_data_table_row().
                   3614: 		$line.
                   3615: 		&Apache::loncommon::end_data_table_row();
                   3616: 	}
1.44      ng       3617:     }
1.477     albertel 3618:     $result .= &Apache::loncommon::end_data_table().
                   3619: 	&show_grading_menu_form($symb);
1.478     albertel 3620:     my $msg = '<p><b>'.
                   3621: 	&mt('Number of records updated = [_1] for [quant,_2,student].',
                   3622: 	    $rec_update,$count).'</b><br />'.
                   3623: 	'<b>'.&mt('Total number of students = [_1]',$env{'form.total'}).
                   3624: 	'</b></p>';
1.44      ng       3625:     return $title.$msg.$result;
1.5       albertel 3626: }
1.54      albertel 3627: 
                   3628: sub split_part_type {
                   3629:     my ($partstr) = @_;
                   3630:     my ($temp,@allparts)=split(/_/,$partstr);
                   3631:     my $type=pop(@allparts);
1.439     albertel 3632:     my $part=join('_',@allparts);
1.54      albertel 3633:     return ($part,$type);
                   3634: }
                   3635: 
1.44      ng       3636: #------------- end of section for handling grading by section/class ---------
                   3637: #
                   3638: #----------------------------------------------------------------------------
                   3639: 
1.5       albertel 3640: 
1.44      ng       3641: #----------------------------------------------------------------------------
                   3642: #
                   3643: #-------------------------- Next few routines handles grading by csv upload
                   3644: #
                   3645: #--- Javascript to handle csv upload
1.27      albertel 3646: sub csvupload_javascript_reverse_associate {
1.246     albertel 3647:     my $error1=&mt('You need to specify the username or ID');
                   3648:     my $error2=&mt('You need to specify at least one grading field');
1.27      albertel 3649:   return(<<ENDPICK);
                   3650:   function verify(vf) {
                   3651:     var foundsomething=0;
                   3652:     var founduname=0;
1.243     albertel 3653:     var foundID=0;
1.27      albertel 3654:     for (i=0;i<=vf.nfields.value;i++) {
                   3655:       tw=eval('vf.f'+i+'.selectedIndex');
1.243     albertel 3656:       if (i==0 && tw!=0) { foundID=1; }
                   3657:       if (i==1 && tw!=0) { founduname=1; }
                   3658:       if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; }
1.27      albertel 3659:     }
1.246     albertel 3660:     if (founduname==0 && foundID==0) {
                   3661: 	alert('$error1');
                   3662: 	return;
1.27      albertel 3663:     }
                   3664:     if (foundsomething==0) {
1.246     albertel 3665: 	alert('$error2');
                   3666: 	return;
1.27      albertel 3667:     }
                   3668:     vf.submit();
                   3669:   }
                   3670:   function flip(vf,tf) {
                   3671:     var nw=eval('vf.f'+tf+'.selectedIndex');
                   3672:     var i;
                   3673:     for (i=0;i<=vf.nfields.value;i++) {
                   3674:       //can not pick the same destination field for both name and domain
                   3675:       if (((i ==0)||(i ==1)) && 
                   3676:           ((tf==0)||(tf==1)) && 
                   3677:           (i!=tf) &&
                   3678:           (eval('vf.f'+i+'.selectedIndex')==nw)) {
                   3679:         eval('vf.f'+i+'.selectedIndex=0;')
                   3680:       }
                   3681:     }
                   3682:   }
                   3683: ENDPICK
                   3684: }
                   3685: 
                   3686: sub csvupload_javascript_forward_associate {
1.246     albertel 3687:     my $error1=&mt('You need to specify the username or ID');
                   3688:     my $error2=&mt('You need to specify at least one grading field');
1.27      albertel 3689:   return(<<ENDPICK);
                   3690:   function verify(vf) {
                   3691:     var foundsomething=0;
                   3692:     var founduname=0;
1.243     albertel 3693:     var foundID=0;
1.27      albertel 3694:     for (i=0;i<=vf.nfields.value;i++) {
                   3695:       tw=eval('vf.f'+i+'.selectedIndex');
1.243     albertel 3696:       if (tw==1) { foundID=1; }
                   3697:       if (tw==2) { founduname=1; }
                   3698:       if (tw>3) { foundsomething=1; }
1.27      albertel 3699:     }
1.246     albertel 3700:     if (founduname==0 && foundID==0) {
                   3701: 	alert('$error1');
                   3702: 	return;
1.27      albertel 3703:     }
                   3704:     if (foundsomething==0) {
1.246     albertel 3705: 	alert('$error2');
                   3706: 	return;
1.27      albertel 3707:     }
                   3708:     vf.submit();
                   3709:   }
                   3710:   function flip(vf,tf) {
                   3711:     var nw=eval('vf.f'+tf+'.selectedIndex');
                   3712:     var i;
                   3713:     //can not pick the same destination field twice
                   3714:     for (i=0;i<=vf.nfields.value;i++) {
                   3715:       if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) {
                   3716:         eval('vf.f'+i+'.selectedIndex=0;')
                   3717:       }
                   3718:     }
                   3719:   }
                   3720: ENDPICK
                   3721: }
                   3722: 
1.26      albertel 3723: sub csvuploadmap_header {
1.324     albertel 3724:     my ($request,$symb,$datatoken,$distotal)= @_;
1.41      ng       3725:     my $javascript;
1.257     albertel 3726:     if ($env{'form.upfile_associate'} eq 'reverse') {
1.41      ng       3727: 	$javascript=&csvupload_javascript_reverse_associate();
                   3728:     } else {
                   3729: 	$javascript=&csvupload_javascript_forward_associate();
                   3730:     }
1.45      ng       3731: 
1.324     albertel 3732:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.257     albertel 3733:     my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
1.245     albertel 3734:     my $ignore=&mt('Ignore First Line');
1.418     albertel 3735:     $symb = &Apache::lonenc::check_encrypt($symb);
1.41      ng       3736:     $request->print(<<ENDPICK);
1.26      albertel 3737: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.398     albertel 3738: <h3><span class="LC_info">Uploading Class Grades</span></h3>
1.45      ng       3739: $result
1.326     albertel 3740: <hr />
1.26      albertel 3741: <h3>Identify fields</h3>
                   3742: Total number of records found in file: $distotal <hr />
                   3743: Enter as many fields as you can. The system will inform you and bring you back
                   3744: to this page if the data selected is insufficient to run your class.<hr />
                   3745: <input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />
1.245     albertel 3746: <label><input type="checkbox" name="noFirstLine" $checked />$ignore</label>
1.26      albertel 3747: <input type="hidden" name="associate"  value="" />
                   3748: <input type="hidden" name="phase"      value="three" />
                   3749: <input type="hidden" name="datatoken"  value="$datatoken" />
1.257     albertel 3750: <input type="hidden" name="fileupload" value="$env{'form.fileupload'}" />
                   3751: <input type="hidden" name="upfiletype" value="$env{'form.upfiletype'}" />
1.26      albertel 3752: <input type="hidden" name="upfile_associate" 
1.257     albertel 3753:                                        value="$env{'form.upfile_associate'}" />
1.26      albertel 3754: <input type="hidden" name="symb"       value="$symb" />
1.257     albertel 3755: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
                   3756: <input type="hidden" name="probTitle"  value="$env{'form.probTitle'}" />
1.246     albertel 3757: <input type="hidden" name="command"    value="csvuploadoptions" />
1.26      albertel 3758: <hr />
                   3759: <script type="text/javascript" language="Javascript">
                   3760: $javascript
                   3761: </script>
                   3762: ENDPICK
1.118     ng       3763:     return '';
1.26      albertel 3764: 
                   3765: }
                   3766: 
                   3767: sub csvupload_fields {
1.324     albertel 3768:     my ($symb) = @_;
                   3769:     my (@parts) = &getpartlist($symb);
1.243     albertel 3770:     my @fields=(['ID','Student ID'],
                   3771: 		['username','Student Username'],
                   3772: 		['domain','Student Domain']);
1.324     albertel 3773:     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
1.41      ng       3774:     foreach my $part (sort(@parts)) {
                   3775: 	my @datum;
                   3776: 	my $display=&Apache::lonnet::metadata($url,$part.'.display');
                   3777: 	my $name=$part;
                   3778: 	if  (!$display) { $display = $name; }
                   3779: 	@datum=($name,$display);
1.244     albertel 3780: 	if ($name=~/^stores_(.*)_awarded/) {
                   3781: 	    push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]);
                   3782: 	}
1.41      ng       3783: 	push(@fields,\@datum);
                   3784:     }
                   3785:     return (@fields);
1.26      albertel 3786: }
                   3787: 
                   3788: sub csvuploadmap_footer {
1.41      ng       3789:     my ($request,$i,$keyfields) =@_;
                   3790:     $request->print(<<ENDPICK);
1.26      albertel 3791: </table>
                   3792: <input type="hidden" name="nfields" value="$i" />
                   3793: <input type="hidden" name="keyfields" value="$keyfields" />
                   3794: <input type="button" onClick="javascript:verify(this.form)" value="Assign Grades" /><br />
                   3795: </form>
                   3796: ENDPICK
                   3797: }
                   3798: 
1.283     albertel 3799: sub checkforfile_js {
1.86      ng       3800:     my $result =<<CSVFORMJS;
                   3801: <script type="text/javascript" language="javascript">
                   3802:     function checkUpload(formname) {
                   3803: 	if (formname.upfile.value == "") {
                   3804: 	    alert("Please use the browse button to select a file from your local directory.");
                   3805: 	    return false;
                   3806: 	}
                   3807: 	formname.submit();
                   3808:     }
                   3809:     </script>
                   3810: CSVFORMJS
1.283     albertel 3811:     return $result;
                   3812: }
                   3813: 
                   3814: sub upcsvScores_form {
                   3815:     my ($request) = shift;
1.324     albertel 3816:     my ($symb)=&get_symb($request);
1.283     albertel 3817:     if (!$symb) {return '';}
                   3818:     my $result=&checkforfile_js();
1.257     albertel 3819:     $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
1.324     albertel 3820:     my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
1.118     ng       3821:     $result.=$table;
1.326     albertel 3822:     $result.='<br /><table width="100%" border="0"><tr><td bgcolor="#777777">'."\n";
                   3823:     $result.='<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>'."\n";
1.370     www      3824:     $result.='&nbsp;<b>'.&mt('Specify a file containing the class scores for current resource').
1.86      ng       3825: 	'.</b></td></tr>'."\n";
                   3826:     $result.='<tr bgcolor=#ffffe6><td>'."\n";
1.370     www      3827:     my $upload=&mt("Upload Scores");
1.86      ng       3828:     my $upfile_select=&Apache::loncommon::upfile_select_html();
1.245     albertel 3829:     my $ignore=&mt('Ignore First Line');
1.418     albertel 3830:     $symb = &Apache::lonenc::check_encrypt($symb);
1.86      ng       3831:     $result.=<<ENDUPFORM;
1.106     albertel 3832: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.86      ng       3833: <input type="hidden" name="symb" value="$symb" />
                   3834: <input type="hidden" name="command" value="csvuploadmap" />
1.257     albertel 3835: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   3836: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
1.86      ng       3837: $upfile_select
1.370     www      3838: <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="$upload" />
1.283     albertel 3839: <label><input type="checkbox" name="noFirstLine" />$ignore</label>
1.86      ng       3840: </form>
                   3841: ENDUPFORM
1.370     www      3842:     $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV",
                   3843:                            &mt("How do I create a CSV file from a spreadsheet"))
                   3844:     .'</td></tr></table>'."\n";
1.86      ng       3845:     $result.='</td></tr></table><br /><br />'."\n";
1.324     albertel 3846:     $result.=&show_grading_menu_form($symb);
1.86      ng       3847:     return $result;
                   3848: }
                   3849: 
                   3850: 
1.26      albertel 3851: sub csvuploadmap {
1.41      ng       3852:     my ($request)= @_;
1.324     albertel 3853:     my ($symb)=&get_symb($request);
1.41      ng       3854:     if (!$symb) {return '';}
1.72      ng       3855: 
1.41      ng       3856:     my $datatoken;
1.257     albertel 3857:     if (!$env{'form.datatoken'}) {
1.41      ng       3858: 	$datatoken=&Apache::loncommon::upfile_store($request);
1.26      albertel 3859:     } else {
1.257     albertel 3860: 	$datatoken=$env{'form.datatoken'};
1.41      ng       3861: 	&Apache::loncommon::load_tmp_file($request);
1.26      albertel 3862:     }
1.41      ng       3863:     my @records=&Apache::loncommon::upfile_record_sep();
1.257     albertel 3864:     if ($env{'form.noFirstLine'}) { shift(@records); }
1.324     albertel 3865:     &csvuploadmap_header($request,$symb,$datatoken,$#records+1);
1.41      ng       3866:     my ($i,$keyfields);
                   3867:     if (@records) {
1.324     albertel 3868: 	my @fields=&csvupload_fields($symb);
1.45      ng       3869: 
1.257     albertel 3870: 	if ($env{'form.upfile_associate'} eq 'reverse') {	
1.41      ng       3871: 	    &Apache::loncommon::csv_print_samples($request,\@records);
                   3872: 	    $i=&Apache::loncommon::csv_print_select_table($request,\@records,
                   3873: 							  \@fields);
                   3874: 	    foreach (@fields) { $keyfields.=$_->[0].','; }
                   3875: 	    chop($keyfields);
                   3876: 	} else {
                   3877: 	    unshift(@fields,['none','']);
                   3878: 	    $i=&Apache::loncommon::csv_samples_select_table($request,\@records,
                   3879: 							    \@fields);
1.311     banghart 3880:             foreach my $rec (@records) {
                   3881:                 my %temp = &Apache::loncommon::record_sep($rec);
                   3882:                 if (%temp) {
                   3883:                     $keyfields=join(',',sort(keys(%temp)));
                   3884:                     last;
                   3885:                 }
                   3886:             }
1.41      ng       3887: 	}
                   3888:     }
                   3889:     &csvuploadmap_footer($request,$i,$keyfields);
1.324     albertel 3890:     $request->print(&show_grading_menu_form($symb));
1.72      ng       3891: 
1.41      ng       3892:     return '';
1.27      albertel 3893: }
                   3894: 
1.246     albertel 3895: sub csvuploadoptions {
1.41      ng       3896:     my ($request)= @_;
1.324     albertel 3897:     my ($symb)=&get_symb($request);
1.257     albertel 3898:     my $checked=(($env{'form.noFirstLine'})?'1':'0');
1.246     albertel 3899:     my $ignore=&mt('Ignore First Line');
                   3900:     $request->print(<<ENDPICK);
                   3901: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
1.398     albertel 3902: <h3><span class="LC_info">Uploading Class Grade Options</span></h3>
1.246     albertel 3903: <input type="hidden" name="command"    value="csvuploadassign" />
1.302     albertel 3904: <!--
1.246     albertel 3905: <p>
                   3906: <label>
                   3907:    <input type="checkbox" name="show_full_results" />
                   3908:    Show a table of all changes
                   3909: </label>
                   3910: </p>
1.302     albertel 3911: -->
1.246     albertel 3912: <p>
                   3913: <label>
                   3914:    <input type="checkbox" name="overwite_scores" checked="checked" />
                   3915:    Overwrite any existing score
                   3916: </label>
                   3917: </p>
                   3918: ENDPICK
                   3919:     my %fields=&get_fields();
                   3920:     if (!defined($fields{'domain'})) {
1.257     albertel 3921: 	my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain');
1.246     albertel 3922: 	$request->print("\n<p> Users are in domain: ".$domform."</p>\n");
                   3923:     }
1.257     albertel 3924:     foreach my $key (sort(keys(%env))) {
1.246     albertel 3925: 	if ($key !~ /^form\.(.*)$/) { next; }
                   3926: 	my $cleankey=$1;
                   3927: 	if ($cleankey eq 'command') { next; }
                   3928: 	$request->print('<input type="hidden" name="'.$cleankey.
1.257     albertel 3929: 			'"  value="'.$env{$key}.'" />'."\n");
1.246     albertel 3930:     }
                   3931:     # FIXME do a check for any duplicated user ids...
                   3932:     # FIXME do a check for any invalid user ids?...
1.290     albertel 3933:     $request->print('<input type="submit" value="Assign Grades" /><br />
                   3934: <hr /></form>'."\n");
1.324     albertel 3935:     $request->print(&show_grading_menu_form($symb));
1.246     albertel 3936:     return '';
                   3937: }
                   3938: 
                   3939: sub get_fields {
                   3940:     my %fields;
1.257     albertel 3941:     my @keyfields = split(/\,/,$env{'form.keyfields'});
                   3942:     for (my $i=0; $i<=$env{'form.nfields'}; $i++) {
                   3943: 	if ($env{'form.upfile_associate'} eq 'reverse') {
                   3944: 	    if ($env{'form.f'.$i} ne 'none') {
                   3945: 		$fields{$keyfields[$i]}=$env{'form.f'.$i};
1.41      ng       3946: 	    }
                   3947: 	} else {
1.257     albertel 3948: 	    if ($env{'form.f'.$i} ne 'none') {
                   3949: 		$fields{$env{'form.f'.$i}}=$keyfields[$i];
1.41      ng       3950: 	    }
                   3951: 	}
1.27      albertel 3952:     }
1.246     albertel 3953:     return %fields;
                   3954: }
                   3955: 
                   3956: sub csvuploadassign {
                   3957:     my ($request)= @_;
1.324     albertel 3958:     my ($symb)=&get_symb($request);
1.246     albertel 3959:     if (!$symb) {return '';}
1.345     bowersj2 3960:     my $error_msg = '';
1.246     albertel 3961:     &Apache::loncommon::load_tmp_file($request);
                   3962:     my @gradedata = &Apache::loncommon::upfile_record_sep();
1.257     albertel 3963:     if ($env{'form.noFirstLine'}) { shift(@gradedata); }
1.246     albertel 3964:     my %fields=&get_fields();
1.41      ng       3965:     $request->print('<h3>Assigning Grades</h3>');
1.257     albertel 3966:     my $courseid=$env{'request.course.id'};
1.97      albertel 3967:     my ($classlist) = &getclasslist('all',0);
1.106     albertel 3968:     my @notallowed;
1.41      ng       3969:     my @skipped;
                   3970:     my $countdone=0;
                   3971:     foreach my $grade (@gradedata) {
                   3972: 	my %entries=&Apache::loncommon::record_sep($grade);
1.246     albertel 3973: 	my $domain;
                   3974: 	if ($entries{$fields{'domain'}}) {
                   3975: 	    $domain=$entries{$fields{'domain'}};
                   3976: 	} else {
1.257     albertel 3977: 	    $domain=$env{'form.default_domain'};
1.246     albertel 3978: 	}
1.243     albertel 3979: 	$domain=~s/\s//g;
1.41      ng       3980: 	my $username=$entries{$fields{'username'}};
1.160     albertel 3981: 	$username=~s/\s//g;
1.243     albertel 3982: 	if (!$username) {
                   3983: 	    my $id=$entries{$fields{'ID'}};
1.247     albertel 3984: 	    $id=~s/\s//g;
1.243     albertel 3985: 	    my %ids=&Apache::lonnet::idget($domain,$id);
                   3986: 	    $username=$ids{$id};
                   3987: 	}
1.41      ng       3988: 	if (!exists($$classlist{"$username:$domain"})) {
1.247     albertel 3989: 	    my $id=$entries{$fields{'ID'}};
                   3990: 	    $id=~s/\s//g;
                   3991: 	    if ($id) {
                   3992: 		push(@skipped,"$id:$domain");
                   3993: 	    } else {
                   3994: 		push(@skipped,"$username:$domain");
                   3995: 	    }
1.41      ng       3996: 	    next;
                   3997: 	}
1.108     albertel 3998: 	my $usec=$classlist->{"$username:$domain"}[5];
1.106     albertel 3999: 	if (!&canmodify($usec)) {
                   4000: 	    push(@notallowed,"$username:$domain");
                   4001: 	    next;
                   4002: 	}
1.244     albertel 4003: 	my %points;
1.41      ng       4004: 	my %grades;
                   4005: 	foreach my $dest (keys(%fields)) {
1.244     albertel 4006: 	    if ($dest eq 'ID' || $dest eq 'username' ||
                   4007: 		$dest eq 'domain') { next; }
                   4008: 	    if ($entries{$fields{$dest}} =~ /^\s*$/) { next; }
                   4009: 	    if ($dest=~/stores_(.*)_points/) {
                   4010: 		my $part=$1;
                   4011: 		my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',
                   4012: 					      $symb,$domain,$username);
1.345     bowersj2 4013:                 if ($wgt) {
                   4014:                     $entries{$fields{$dest}}=~s/\s//g;
                   4015:                     my $pcr=$entries{$fields{$dest}} / $wgt;
1.463     albertel 4016:                     my $award=($pcr == 0) ? 'incorrect_by_override'
                   4017:                                           : 'correct_by_override';
1.345     bowersj2 4018:                     $grades{"resource.$part.awarded"}=$pcr;
                   4019:                     $grades{"resource.$part.solved"}=$award;
                   4020:                     $points{$part}=1;
                   4021:                 } else {
                   4022:                     $error_msg = "<br />" .
                   4023:                         &mt("Some point values were assigned"
                   4024:                             ." for problems with a weight "
                   4025:                             ."of zero. These values were "
                   4026:                             ."ignored.");
                   4027:                 }
1.244     albertel 4028: 	    } else {
                   4029: 		if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }
                   4030: 		if ($dest=~/stores_(.*)_solved/)  { if ($points{$1}) {next;} }
                   4031: 		my $store_key=$dest;
                   4032: 		$store_key=~s/^stores/resource/;
                   4033: 		$store_key=~s/_/\./g;
                   4034: 		$grades{$store_key}=$entries{$fields{$dest}};
                   4035: 	    }
1.41      ng       4036: 	}
1.508     www      4037: 	if (! %grades) { 
                   4038:            push(@skipped,&mt("[_1]: no data to save","$username:$domain")); 
                   4039:         } else {
                   4040: 	   $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
                   4041: 	   my $result=&Apache::lonnet::cstore(\%grades,$symb,
1.302     albertel 4042: 					   $env{'request.course.id'},
                   4043: 					   $domain,$username);
1.508     www      4044: 	   if ($result eq 'ok') {
                   4045: 	      $request->print('.');
                   4046: 	   } else {
                   4047: 	      $request->print("<p><span class=\"LC_error\">".
                   4048:                               &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]",
                   4049:                                   "$username:$domain",$result)."</span></p>");
                   4050: 	   }
                   4051: 	   $request->rflush();
                   4052: 	   $countdone++;
                   4053:         }
1.41      ng       4054:     }
1.508     www      4055:     $request->print('<br /><span class="LC_info">'.&mt("Saved [_1] students",$countdone)."</span>\n");
1.41      ng       4056:     if (@skipped) {
1.508     www      4057: 	$request->print('<p><span class="LC_warning">'.&mt('Skipped Students').'</span></p>');
1.106     albertel 4058: 	foreach my $student (@skipped) { $request->print("$student<br />\n"); }
                   4059:     }
                   4060:     if (@notallowed) {
1.508     www      4061: 	$request->print('<p><span class="LC_error">'.&mt('Students Not Allowed to Modify').'</span></p>');
1.106     albertel 4062: 	foreach my $student (@notallowed) { $request->print("$student<br />\n"); }
1.41      ng       4063:     }
1.106     albertel 4064:     $request->print("<br />\n");
1.324     albertel 4065:     $request->print(&show_grading_menu_form($symb));
1.345     bowersj2 4066:     return $error_msg;
1.26      albertel 4067: }
1.44      ng       4068: #------------- end of section for handling csv file upload ---------
                   4069: #
                   4070: #-------------------------------------------------------------------
                   4071: #
1.122     ng       4072: #-------------- Next few routines handle grading by page/sequence
1.72      ng       4073: #
                   4074: #--- Select a page/sequence and a student to grade
1.68      ng       4075: sub pickStudentPage {
                   4076:     my ($request) = shift;
                   4077: 
                   4078:     $request->print(<<LISTJAVASCRIPT);
                   4079: <script type="text/javascript" language="javascript">
                   4080: 
                   4081: function checkPickOne(formname) {
1.76      ng       4082:     if (radioSelection(formname.student) == null) {
1.68      ng       4083: 	alert("Please select the student you wish to grade.");
                   4084: 	return;
                   4085:     }
1.125     ng       4086:     ptr = pullDownSelection(formname.selectpage);
                   4087:     formname.page.value = formname["page"+ptr].value;
                   4088:     formname.title.value = formname["title"+ptr].value;
1.68      ng       4089:     formname.submit();
                   4090: }
                   4091: 
                   4092: </script>
                   4093: LISTJAVASCRIPT
1.118     ng       4094:     &commonJSfunctions($request);
1.324     albertel 4095:     my ($symb) = &get_symb($request);
1.257     albertel 4096:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4097:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4098:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
1.68      ng       4099: 
1.398     albertel 4100:     my $result='<h3><span class="LC_info">&nbsp;'.
1.485     albertel 4101: 	&mt('Manual Grading by Page or Sequence').'</span></h3>';
1.68      ng       4102: 
1.80      ng       4103:     $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";
1.423     albertel 4104:     my ($titles,$symbx) = &getSymbMap();
1.137     albertel 4105:     my ($curpage) =&Apache::lonnet::decode_symb($symb); 
                   4106: #    my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 
                   4107: #    my $type=($curpage =~ /\.(page|sequence)/);
1.485     albertel 4108:     my $select = '<select name="selectpage">'."\n";
1.70      ng       4109:     my $ctr=0;
1.68      ng       4110:     foreach (@$titles) {
                   4111: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
1.485     albertel 4112: 	$select.='<option value="'.$ctr.'" '.
1.401     albertel 4113: 	    ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : '').
1.71      ng       4114: 	    '>'.$showtitle.'</option>'."\n";
1.70      ng       4115: 	$ctr++;
1.68      ng       4116:     }
1.485     albertel 4117:     $select.= '</select>';
                   4118:     $result.=&mt('&nbsp;<b>Problems from:</b> [_1]',$select)."<br />\n";
                   4119: 
1.70      ng       4120:     $ctr=0;
                   4121:     foreach (@$titles) {
                   4122: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
                   4123: 	$result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n";
                   4124: 	$result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n";
                   4125: 	$ctr++;
                   4126:     }
1.72      ng       4127:     $result.='<input type="hidden" name="page" />'."\n".
                   4128: 	'<input type="hidden" name="title" />'."\n";
1.68      ng       4129: 
1.485     albertel 4130:     my $options =
                   4131: 	'<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n".
                   4132: 	'<label><input type="radio" name="vProb" value="yes" /> '.&mt('yes').' </label>'."<br />\n";
                   4133:     $result.='&nbsp;'.&mt('<b>View Problems Text: </b> [_1]',$options);
                   4134: 
                   4135:     $options =
                   4136: 	'<label><input type="radio" name="lastSub" value="none" /> '.&mt('none').' </label>'."\n".
                   4137: 	'<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '.&mt('by dates and submissions').'</label>'."\n".
                   4138: 	'<label><input type="radio" name="lastSub" value="all" /> '.&mt('all details').' </label>'."\n";
                   4139:     $result.='&nbsp;'.&mt('<b>Submission Details: </b>[_1]',$options);
1.432     banghart 4140:     
                   4141:     $result.=&build_section_inputs();
1.442     banghart 4142:     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
                   4143:     $result.='<input type="hidden" name="Status"  value="'.$stu_status.'" />'."\n".
1.72      ng       4144: 	'<input type="hidden" name="command" value="displayPage" />'."\n".
1.418     albertel 4145: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 4146: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."<br />\n";
1.72      ng       4147: 
1.485     albertel 4148:     $result.='&nbsp;'.&mt('<b>Use CODE: [_1] </b>',
                   4149: 			  '<input type="text" name="CODE" value="" />').
                   4150: 			      '<br />'."\n";
1.382     albertel 4151: 
1.80      ng       4152:     $result.='&nbsp;<input type="button" '.
1.485     albertel 4153: 	'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next-&gt;').'" /><br />'."\n";
1.72      ng       4154: 
1.68      ng       4155:     $request->print($result);
                   4156: 
1.485     albertel 4157:     my $studentTable.='&nbsp;<b>'.&mt('Select a student you wish to grade and then click on the Next button.').'</b><br />'.
1.484     albertel 4158: 	&Apache::loncommon::start_data_table().
                   4159: 	&Apache::loncommon::start_data_table_header_row().
1.485     albertel 4160: 	'<th align="right">&nbsp;'.&mt('No.').'</th>'.
1.484     albertel 4161: 	'<th>'.&nameUserString('header').'</th>'.
1.485     albertel 4162: 	'<th align="right">&nbsp;'.&mt('No.').'</th>'.
1.484     albertel 4163: 	'<th>'.&nameUserString('header').'</th>'.
                   4164: 	&Apache::loncommon::end_data_table_header_row();
1.68      ng       4165:  
1.76      ng       4166:     my (undef,undef,$fullname) = &getclasslist($getsec,'1');
1.68      ng       4167:     my $ptr = 1;
1.294     albertel 4168:     foreach my $student (sort 
                   4169: 			 {
                   4170: 			     if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                   4171: 				 return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                   4172: 			     }
                   4173: 			     return $a cmp $b;
                   4174: 			 } (keys(%$fullname))) {
1.68      ng       4175: 	my ($uname,$udom) = split(/:/,$student);
1.484     albertel 4176: 	$studentTable.=($ptr%2==1 ? &Apache::loncommon::start_data_table_row()
                   4177:                                   : '</td>');
1.126     ng       4178: 	$studentTable.='<td align="right">'.$ptr.'&nbsp;</td>';
1.288     albertel 4179: 	$studentTable.='<td>&nbsp;<label><input type="radio" name="student" value="'.$student.'" /> '
                   4180: 	    .&nameUserString(undef,$$fullname{$student},$uname,$udom)."</label>\n";
1.484     albertel 4181: 	$studentTable.=
                   4182: 	    ($ptr%2 == 0 ? '</td>'.&Apache::loncommon::end_data_table_row() 
                   4183:                          : '');
1.68      ng       4184: 	$ptr++;
                   4185:     }
1.484     albertel 4186:     if ($ptr%2 == 0) {
                   4187: 	$studentTable.='</td><td>&nbsp;</td><td>&nbsp;</td>'.
                   4188: 	    &Apache::loncommon::end_data_table_row();
                   4189:     }
                   4190:     $studentTable.=&Apache::loncommon::end_data_table()."\n";
1.126     ng       4191:     $studentTable.='<input type="button" '.
1.485     albertel 4192: 	'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next-&gt;').'" /></form>'."\n";
1.68      ng       4193: 
1.324     albertel 4194:     $studentTable.=&show_grading_menu_form($symb);
1.68      ng       4195:     $request->print($studentTable);
                   4196: 
                   4197:     return '';
                   4198: }
                   4199: 
                   4200: sub getSymbMap {
1.132     bowersj2 4201:     my $navmap = Apache::lonnavmaps::navmap->new();
1.68      ng       4202: 
                   4203:     my %symbx = ();
                   4204:     my @titles = ();
1.117     bowersj2 4205:     my $minder = 0;
                   4206: 
                   4207:     # Gather every sequence that has problems.
1.240     albertel 4208:     my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); },
                   4209: 					       1,0,1);
1.117     bowersj2 4210:     for my $sequence ($navmap->getById('0.0'), @sequences) {
1.241     albertel 4211: 	if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {
1.381     albertel 4212: 	    my $title = $minder.'.'.
                   4213: 		&HTML::Entities::encode($sequence->compTitle(),'"\'&');
                   4214: 	    push(@titles, $title); # minder in case two titles are identical
                   4215: 	    $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&');
1.117     bowersj2 4216: 	    $minder++;
1.241     albertel 4217: 	}
1.68      ng       4218:     }
                   4219:     return \@titles,\%symbx;
                   4220: }
                   4221: 
1.72      ng       4222: #
                   4223: #--- Displays a page/sequence w/wo problems, w/wo submissions
1.68      ng       4224: sub displayPage {
                   4225:     my ($request) = shift;
                   4226: 
1.324     albertel 4227:     my ($symb) = &get_symb($request);
1.257     albertel 4228:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4229:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4230:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
                   4231:     my $pageTitle = $env{'form.page'};
1.103     albertel 4232:     my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
1.257     albertel 4233:     my ($uname,$udom) = split(/:/,$env{'form.student'});
                   4234:     my $usec=$classlist->{$env{'form.student'}}[5];
1.168     albertel 4235: 
                   4236:     #need to make sure we have the correct data for later EXT calls, 
                   4237:     #thus invalidate the cache
                   4238:     &Apache::lonnet::devalidatecourseresdata(
1.257     albertel 4239:                  $env{'course.'.$env{'request.course.id'}.'.num'},
                   4240:                  $env{'course.'.$env{'request.course.id'}.'.domain'});
1.168     albertel 4241:     &Apache::lonnet::clear_EXT_cache_status();
                   4242: 
1.103     albertel 4243:     if (!&canview($usec)) {
1.485     albertel 4244: 	$request->print('<span class="LC_warning">'.&mt('Unable to view requested student. ([_1])',$env{'form.student'}).'</span>');
1.324     albertel 4245: 	$request->print(&show_grading_menu_form($symb));
1.103     albertel 4246: 	return;
                   4247:     }
1.398     albertel 4248:     my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';
1.485     albertel 4249:     $result.='<h3>&nbsp;'.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)).
1.129     ng       4250: 	'</h3>'."\n";
1.500     albertel 4251:     $env{'form.CODE'} = uc($env{'form.CODE'});
1.501     foxr     4252:     if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) {
1.485     albertel 4253: 	$result.='<h3>&nbsp;'.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n";
1.382     albertel 4254:     } else {
                   4255: 	delete($env{'form.CODE'});
                   4256:     }
1.71      ng       4257:     &sub_page_js($request);
                   4258:     $request->print($result);
                   4259: 
1.132     bowersj2 4260:     my $navmap = Apache::lonnavmaps::navmap->new();
1.257     albertel 4261:     my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'});
1.68      ng       4262:     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
1.288     albertel 4263:     if (!$map) {
1.485     albertel 4264: 	$request->print('<span class="LC_warning">'.&mt('Unable to view requested sequence. ([_1])',$resUrl).'</span>');
1.324     albertel 4265: 	$request->print(&show_grading_menu_form($symb));
1.288     albertel 4266: 	return; 
                   4267:     }
1.68      ng       4268:     my $iterator = $navmap->getIterator($map->map_start(),
                   4269: 					$map->map_finish());
                   4270: 
1.71      ng       4271:     my $studentTable='<form action="/adm/grades" method="post" name="gradePage">'."\n".
1.72      ng       4272: 	'<input type="hidden" name="command" value="gradeByPage" />'."\n".
1.257     albertel 4273: 	'<input type="hidden" name="fullname" value="'.$$fullname{$env{'form.student'}}.'" />'."\n".
                   4274: 	'<input type="hidden" name="student" value="'.$env{'form.student'}.'" />'."\n".
1.72      ng       4275: 	'<input type="hidden" name="page"    value="'.$pageTitle.'" />'."\n".
1.257     albertel 4276: 	'<input type="hidden" name="title"   value="'.$env{'form.title'}.'" />'."\n".
1.418     albertel 4277: 	'<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.125     ng       4278: 	'<input type="hidden" name="overRideScore" value="no" />'."\n".
1.257     albertel 4279: 	'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n";
1.71      ng       4280: 
1.382     albertel 4281:     if (defined($env{'form.CODE'})) {
                   4282: 	$studentTable.=
                   4283: 	    '<input type="hidden" name="CODE" value="'.$env{'form.CODE'}.'" />'."\n";
                   4284:     }
1.381     albertel 4285:     my $checkIcon = '<img alt="'.&mt('Check Mark').
1.485     albertel 4286: 	'" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />';
1.71      ng       4287: 
1.485     albertel 4288:     $studentTable.='&nbsp;'.&mt('<b>Note:</b> Problems graded correct by the computer are marked with a [_1] symbol.',$checkIcon)."\n".
1.484     albertel 4289: 	&Apache::loncommon::start_data_table().
                   4290: 	&Apache::loncommon::start_data_table_header_row().
                   4291: 	'<th align="center">&nbsp;Prob.&nbsp;</th>'.
1.485     albertel 4292: 	'<th>&nbsp;'.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').'</th>'.
1.484     albertel 4293: 	&Apache::loncommon::end_data_table_header_row();
1.71      ng       4294: 
1.329     albertel 4295:     &Apache::lonxml::clear_problem_counter();
1.196     albertel 4296:     my ($depth,$question,$prob) = (1,1,1);
1.68      ng       4297:     $iterator->next(); # skip the first BEGIN_MAP
                   4298:     my $curRes = $iterator->next(); # for "current resource"
1.101     albertel 4299:     while ($depth > 0) {
1.68      ng       4300:         if($curRes == $iterator->BEGIN_MAP) { $depth++; }
1.100     bowersj2 4301:         if($curRes == $iterator->END_MAP) { $depth--; }
1.68      ng       4302: 
1.385     albertel 4303:         if (ref($curRes) && $curRes->is_problem()) {
1.91      albertel 4304: 	    my $parts = $curRes->parts();
1.68      ng       4305:             my $title = $curRes->compTitle();
1.71      ng       4306: 	    my $symbx = $curRes->symb();
1.484     albertel 4307: 	    $studentTable.=
                   4308: 		&Apache::loncommon::start_data_table_row().
                   4309: 		'<td align="center" valign="top" >'.$prob.
1.485     albertel 4310: 		(scalar(@{$parts}) == 1 ? '' 
                   4311: 		                        : '<br />('.&mt('[_1]&nbsp;parts)',
                   4312: 							scalar(@{$parts}))
                   4313: 		 ).
                   4314: 		 '</td>';
1.71      ng       4315: 	    $studentTable.='<td valign="top">';
1.382     albertel 4316: 	    my %form = ('CODE' => $env{'form.CODE'},);
1.257     albertel 4317: 	    if ($env{'form.vProb'} eq 'yes' ) {
1.144     albertel 4318: 		$studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
1.383     albertel 4319: 					     undef,'both',\%form);
1.71      ng       4320: 	    } else {
1.382     albertel 4321: 		my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form);
1.80      ng       4322: 		$companswer =~ s|<form(.*?)>||g;
                   4323: 		$companswer =~ s|</form>||g;
1.71      ng       4324: #		while ($companswer =~ /(<a href\=\"javascript:newWindow.*?Script Vars<\/a>)/s) { #<a href="javascript:newWindow</a>
1.116     ng       4325: #		    $companswer =~ s/$1/ /ms;
1.326     albertel 4326: #		    $request->print('match='.$1."<br />\n");
1.71      ng       4327: #		}
1.116     ng       4328: #		$companswer =~ s|<table border=\"1\">|<table border=\"0\">|g;
1.485     albertel 4329: 		$studentTable.='&nbsp;<b>'.$title.'</b>&nbsp;<br />&nbsp;'.&mt('<b>Correct answer:</b><br />[_1]',$companswer);
1.71      ng       4330: 	    }
                   4331: 
1.257     albertel 4332: 	    my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);
1.125     ng       4333: 
1.257     albertel 4334: 	    if ($env{'form.lastSub'} eq 'datesub') {
1.71      ng       4335: 		if ($record{'version'} eq '') {
1.485     albertel 4336: 		    $studentTable.='<br />&nbsp;<span class="LC_warning">'.&mt('No recorded submission for this problem.').'</span><br />';
1.71      ng       4337: 		} else {
1.116     ng       4338: 		    my %responseType = ();
                   4339: 		    foreach my $partid (@{$parts}) {
1.147     albertel 4340: 			my @responseIds =$curRes->responseIds($partid);
                   4341: 			my @responseType =$curRes->responseType($partid);
                   4342: 			my %responseIds;
                   4343: 			for (my $i=0;$i<=$#responseIds;$i++) {
                   4344: 			    $responseIds{$responseIds[$i]}=$responseType[$i];
                   4345: 			}
                   4346: 			$responseType{$partid} = \%responseIds;
1.116     ng       4347: 		    }
1.148     albertel 4348: 		    $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom);
1.147     albertel 4349: 
1.71      ng       4350: 		}
1.257     albertel 4351: 	    } elsif ($env{'form.lastSub'} eq 'all') {
                   4352: 		my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
1.71      ng       4353: 		$studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom,
1.257     albertel 4354: 									$env{'request.course.id'},
1.71      ng       4355: 									'','.submission');
                   4356:  
                   4357: 	    }
1.103     albertel 4358: 	    if (&canmodify($usec)) {
                   4359: 		foreach my $partid (@{$parts}) {
                   4360: 		    $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record);
                   4361: 		    $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n";
                   4362: 		    $question++;
                   4363: 		}
1.196     albertel 4364: 		$prob++;
1.71      ng       4365: 	    }
                   4366: 	    $studentTable.='</td></tr>';
1.68      ng       4367: 
1.103     albertel 4368: 	}
1.68      ng       4369:         $curRes = $iterator->next();
                   4370:     }
                   4371: 
1.485     albertel 4372:     $studentTable.='</table>'."\n".
                   4373: 	'<input type="button" value="'.&mt('Save').'" '.
1.381     albertel 4374: 	'onClick="javascript:checkSubmitPage(this.form,'.$question.');" />'.
1.71      ng       4375: 	'</form>'."\n";
1.324     albertel 4376:     $studentTable.=&show_grading_menu_form($symb);
1.71      ng       4377:     $request->print($studentTable);
                   4378: 
                   4379:     return '';
1.119     ng       4380: }
                   4381: 
                   4382: sub displaySubByDates {
1.148     albertel 4383:     my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
1.224     albertel 4384:     my $isCODE=0;
1.335     albertel 4385:     my $isTask = ($symb =~/\.task$/);
1.224     albertel 4386:     if (exists($record->{'resource.CODE'})) { $isCODE=1; }
1.467     albertel 4387:     my $studentTable=&Apache::loncommon::start_data_table().
                   4388: 	&Apache::loncommon::start_data_table_header_row().
                   4389: 	'<th>'.&mt('Date/Time').'</th>'.
                   4390: 	($isCODE?'<th>'.&mt('CODE').'</th>':'').
                   4391: 	'<th>'.&mt('Submission').'</th>'.
                   4392: 	'<th>'.&mt('Status').'</th>'.
                   4393: 	&Apache::loncommon::end_data_table_header_row();
1.119     ng       4394:     my ($version);
                   4395:     my %mark;
1.148     albertel 4396:     my %orders;
1.119     ng       4397:     $mark{'correct_by_student'} = $checkIcon;
1.147     albertel 4398:     if (!exists($$record{'1:timestamp'})) {
1.467     albertel 4399: 	return '<br />&nbsp;<span class="LC_warning">'.&mt('Nothing submitted - no attempts').'</span><br />';
1.147     albertel 4400:     }
1.335     albertel 4401: 
                   4402:     my $interaction;
1.119     ng       4403:     for ($version=1;$version<=$$record{'version'};$version++) {
1.467     albertel 4404: 	my $timestamp = 
                   4405: 	    &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'});
1.335     albertel 4406: 	if (exists($$record{$version.':resource.0.version'})) {
                   4407: 	    $interaction = $$record{$version.':resource.0.version'};
                   4408: 	}
                   4409: 
                   4410: 	my $where = ($isTask ? "$version:resource.$interaction"
                   4411: 		             : "$version:resource");
1.467     albertel 4412: 	$studentTable.=&Apache::loncommon::start_data_table_row().
                   4413: 	    '<td>'.$timestamp.'</td>';
1.224     albertel 4414: 	if ($isCODE) {
                   4415: 	    $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';
                   4416: 	}
1.119     ng       4417: 	my @versionKeys = split(/\:/,$$record{$version.':keys'});
                   4418: 	my @displaySub = ();
                   4419: 	foreach my $partid (@{$parts}) {
1.335     albertel 4420: 	    my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)
                   4421: 			            : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
                   4422: 	    
                   4423: 
1.122     ng       4424: #	    next if ($$record{"$version:resource.$partid.solved"} eq '');
1.324     albertel 4425: 	    my $display_part=&get_display_part($partid,$symb);
1.147     albertel 4426: 	    foreach my $matchKey (@matchKey) {
1.198     albertel 4427: 		if (exists($$record{$version.':'.$matchKey}) &&
                   4428: 		    $$record{$version.':'.$matchKey} ne '') {
1.335     albertel 4429: 
                   4430: 		    my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
                   4431: 				               : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
1.467     albertel 4432: 		    $displaySub[0].='<b>'.&mt('Part:').'</b>&nbsp;'.$display_part.'&nbsp;';
                   4433: 		    $displaySub[0].='<span class="LC_internal_info">('.&mt('ID').'&nbsp;'.
1.398     albertel 4434: 			$responseId.')</span>&nbsp;<b>';
1.335     albertel 4435: 		    if ($$record{"$where.$partid.tries"} eq '') {
1.467     albertel 4436: 			$displaySub[0].=&mt('Trial&nbsp;not&nbsp;counted');
1.147     albertel 4437: 		    } else {
1.467     albertel 4438: 			$displaySub[0].=&mt('Trial&nbsp;[_1]',
                   4439: 					    $$record{"$where.$partid.tries"});
1.147     albertel 4440: 		    }
1.335     albertel 4441: 		    my $responseType=($isTask ? 'Task'
                   4442:                                               : $responseType->{$partid}->{$responseId});
1.148     albertel 4443: 		    if (!exists($orders{$partid})) { $orders{$partid}={}; }
                   4444: 		    if (!exists($orders{$partid}->{$responseId})) {
                   4445: 			$orders{$partid}->{$responseId}=
                   4446: 			    &get_order($partid,$responseId,$symb,$uname,$udom);
                   4447: 		    }
1.147     albertel 4448: 		    $displaySub[0].='</b>&nbsp; '.
1.336     albertel 4449: 			&cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'<br />';
1.147     albertel 4450: 		}
                   4451: 	    }
1.335     albertel 4452: 	    if (exists($$record{"$where.$partid.checkedin"})) {
1.485     albertel 4453: 		$displaySub[1].=&mt('Checked in by [_1] into slot [_2]',
                   4454: 				    $$record{"$where.$partid.checkedin"},
                   4455: 				    $$record{"$where.$partid.checkedin.slot"}).
                   4456: 					'<br />';
1.335     albertel 4457: 	    }
                   4458: 	    if (exists $$record{"$where.$partid.award"}) {
1.485     albertel 4459: 		$displaySub[1].='<b>'.&mt('Part:').'</b>&nbsp;'.$display_part.' &nbsp;'.
1.335     albertel 4460: 		    lc($$record{"$where.$partid.award"}).' '.
                   4461: 		    $mark{$$record{"$where.$partid.solved"}}.
1.147     albertel 4462: 		    '<br />';
                   4463: 	    }
1.335     albertel 4464: 	    if (exists $$record{"$where.$partid.regrader"}) {
                   4465: 		$displaySub[2].=$$record{"$where.$partid.regrader"}.
                   4466: 		    ' (<b>'.&mt('Part').':</b> '.$display_part.')';
                   4467: 	    } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) {
                   4468: 		$displaySub[2].=
                   4469: 		    $$record{"$version:resource.$partid.regrader"}.
1.207     albertel 4470: 		    ' (<b>'.&mt('Part').':</b> '.$display_part.')';
1.147     albertel 4471: 	    }
                   4472: 	}
                   4473: 	# needed because old essay regrader has not parts info
                   4474: 	if (exists $$record{"$version:resource.regrader"}) {
                   4475: 	    $displaySub[2].=$$record{"$version:resource.regrader"};
                   4476: 	}
                   4477: 	$studentTable.='<td>'.$displaySub[0].'&nbsp;</td><td>'.$displaySub[1];
                   4478: 	if ($displaySub[2]) {
1.467     albertel 4479: 	    $studentTable.=&mt('Manually graded by [_1]',$displaySub[2]);
1.147     albertel 4480: 	}
1.467     albertel 4481: 	$studentTable.='&nbsp;</td>'.
                   4482: 	    &Apache::loncommon::end_data_table_row();
1.119     ng       4483:     }
1.467     albertel 4484:     $studentTable.=&Apache::loncommon::end_data_table();
1.119     ng       4485:     return $studentTable;
1.71      ng       4486: }
                   4487: 
                   4488: sub updateGradeByPage {
                   4489:     my ($request) = shift;
                   4490: 
1.257     albertel 4491:     my $cdom      = $env{"course.$env{'request.course.id'}.domain"};
                   4492:     my $cnum      = $env{"course.$env{'request.course.id'}.num"};
                   4493:     my $getsec    = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
                   4494:     my $pageTitle = $env{'form.page'};
1.103     albertel 4495:     my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
1.257     albertel 4496:     my ($uname,$udom) = split(/:/,$env{'form.student'});
                   4497:     my $usec=$classlist->{$env{'form.student'}}[5];
1.103     albertel 4498:     if (!&canmodify($usec)) {
1.398     albertel 4499: 	$request->print('<span class="LC_warning">Unable to modify requested student.('.$env{'form.student'}.'</span>');
1.324     albertel 4500: 	$request->print(&show_grading_menu_form($env{'form.symb'}));
1.103     albertel 4501: 	return;
                   4502:     }
1.398     albertel 4503:     my $result='<h3><span class="LC_info">&nbsp;'.$env{'form.title'}.'</span></h3>';
1.257     albertel 4504:     $result.='<h3>&nbsp;Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
1.129     ng       4505: 	'</h3>'."\n";
1.70      ng       4506: 
1.68      ng       4507:     $request->print($result);
                   4508: 
1.132     bowersj2 4509:     my $navmap = Apache::lonnavmaps::navmap->new();
1.257     albertel 4510:     my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'});
1.71      ng       4511:     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
1.288     albertel 4512:     if (!$map) {
1.398     albertel 4513: 	$request->print('<span class="LC_warning">Unable to grade requested sequence. ('.$resUrl.')</span>');
1.324     albertel 4514: 	my ($symb)=&get_symb($request);
                   4515: 	$request->print(&show_grading_menu_form($symb));
1.288     albertel 4516: 	return; 
                   4517:     }
1.71      ng       4518:     my $iterator = $navmap->getIterator($map->map_start(),
                   4519: 					$map->map_finish());
1.70      ng       4520: 
1.484     albertel 4521:     my $studentTable=
                   4522: 	&Apache::loncommon::start_data_table().
                   4523: 	&Apache::loncommon::start_data_table_header_row().
1.485     albertel 4524: 	'<th align="center">&nbsp;'.&mt('Prob.').'&nbsp;</th>'.
                   4525: 	'<th>&nbsp;'.&mt('Title').'&nbsp;</th>'.
                   4526: 	'<th>&nbsp;'.&mt('Previous Score').'&nbsp;</th>'.
                   4527: 	'<th>&nbsp;'.&mt('New Score').'&nbsp;</th>'.
1.484     albertel 4528: 	&Apache::loncommon::end_data_table_header_row();
1.71      ng       4529: 
                   4530:     $iterator->next(); # skip the first BEGIN_MAP
                   4531:     my $curRes = $iterator->next(); # for "current resource"
1.196     albertel 4532:     my ($depth,$question,$prob,$changeflag)= (1,1,1,0);
1.101     albertel 4533:     while ($depth > 0) {
1.71      ng       4534:         if($curRes == $iterator->BEGIN_MAP) { $depth++; }
1.100     bowersj2 4535:         if($curRes == $iterator->END_MAP) { $depth--; }
1.71      ng       4536: 
1.385     albertel 4537:         if (ref($curRes) && $curRes->is_problem()) {
1.91      albertel 4538: 	    my $parts = $curRes->parts();
1.71      ng       4539:             my $title = $curRes->compTitle();
                   4540: 	    my $symbx = $curRes->symb();
1.484     albertel 4541: 	    $studentTable.=
                   4542: 		&Apache::loncommon::start_data_table_row().
                   4543: 		'<td align="center" valign="top" >'.$prob.
1.485     albertel 4544: 		(scalar(@{$parts}) == 1 ? '' 
                   4545:                                         : '<br />('.&mt('[quant,_1,&nbsp;parts]',scalar(@{$parts}))
                   4546: 		 ).')</td>';
1.71      ng       4547: 	    $studentTable.='<td valign="top">&nbsp;<b>'.$title.'</b>&nbsp;</td>';
                   4548: 
                   4549: 	    my %newrecord=();
                   4550: 	    my @displayPts=();
1.269     raeburn  4551:             my %aggregate = ();
                   4552:             my $aggregateflag = 0;
1.71      ng       4553: 	    foreach my $partid (@{$parts}) {
1.257     albertel 4554: 		my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};
                   4555: 		my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};
1.71      ng       4556: 
1.257     albertel 4557: 		my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? 
                   4558: 		    $env{'form.WGT'.$question.'_'.$partid} : 1;
1.71      ng       4559: 		my $partial = $newpts/$wgt;
                   4560: 		my $score;
                   4561: 		if ($partial > 0) {
                   4562: 		    $score = 'correct_by_override';
1.125     ng       4563: 		} elsif ($newpts ne '') { #empty is taken as 0
1.71      ng       4564: 		    $score = 'incorrect_by_override';
                   4565: 		}
1.257     albertel 4566: 		my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid};
1.125     ng       4567: 		if ($dropMenu eq 'excused') {
1.71      ng       4568: 		    $partial = '';
                   4569: 		    $score = 'excused';
1.125     ng       4570: 		} elsif ($dropMenu eq 'reset status'
1.257     albertel 4571: 			 && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists
1.125     ng       4572: 		    $newrecord{'resource.'.$partid.'.tries'} = 0;
                   4573: 		    $newrecord{'resource.'.$partid.'.solved'} = '';
                   4574: 		    $newrecord{'resource.'.$partid.'.award'} = '';
                   4575: 		    $newrecord{'resource.'.$partid.'.awarded'} = 0;
1.257     albertel 4576: 		    $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}";
1.125     ng       4577: 		    $changeflag++;
                   4578: 		    $newpts = '';
1.269     raeburn  4579:                     
                   4580:                     my $aggtries =  $env{'form.aggtries'.$question.'_'.$partid};
                   4581:                     my $totaltries = $env{'form.totaltries'.$question.'_'.$partid};
                   4582:                     my $solvedstatus = $env{'form.solved'.$question.'_'.$partid};
                   4583:                     if ($aggtries > 0) {
                   4584:                         &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                   4585:                         $aggregateflag = 1;
                   4586:                     }
1.71      ng       4587: 		}
1.324     albertel 4588: 		my $display_part=&get_display_part($partid,$curRes->symb());
1.257     albertel 4589: 		my $oldstatus = $env{'form.solved'.$question.'_'.$partid};
1.207     albertel 4590: 		$displayPts[0].='&nbsp;<b>Part:</b> '.$display_part.' = '.
1.71      ng       4591: 		    (($oldstatus eq 'excused') ? 'excused' : $oldpts).
1.326     albertel 4592: 		    '&nbsp;<br />';
1.207     albertel 4593: 		$displayPts[1].='&nbsp;<b>Part:</b> '.$display_part.' = '.
1.125     ng       4594: 		     (($score eq 'excused') ? 'excused' : $newpts).
1.326     albertel 4595: 		    '&nbsp;<br />';
1.71      ng       4596: 		$question++;
1.380     albertel 4597: 		next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused'));
1.125     ng       4598: 
1.71      ng       4599: 		$newrecord{'resource.'.$partid.'.awarded'}  = $partial if $partial ne '';
1.125     ng       4600: 		$newrecord{'resource.'.$partid.'.solved'}   = $score if $score ne '';
1.257     albertel 4601: 		$newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"
1.125     ng       4602: 		    if (scalar(keys(%newrecord)) > 0);
1.71      ng       4603: 
                   4604: 		$changeflag++;
                   4605: 	    }
                   4606: 	    if (scalar(keys(%newrecord)) > 0) {
1.382     albertel 4607: 		my %record = 
                   4608: 		    &Apache::lonnet::restore($symbx,$env{'request.course.id'},
                   4609: 					     $udom,$uname);
                   4610: 
                   4611: 		if (&Apache::lonnet::validCODE($env{'form.CODE'})) {
                   4612: 		    $newrecord{'resource.CODE'} = $env{'form.CODE'};
                   4613: 		} elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) {
                   4614: 		    $newrecord{'resource.CODE'} = '';
                   4615: 		}
1.257     albertel 4616: 		&Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'},
1.71      ng       4617: 					$udom,$uname);
1.382     albertel 4618: 		%record = &Apache::lonnet::restore($symbx,
                   4619: 						   $env{'request.course.id'},
                   4620: 						   $udom,$uname);
1.380     albertel 4621: 		&check_and_remove_from_queue($parts,\%record,undef,$symbx,
                   4622: 					     $cdom,$cnum,$udom,$uname);
1.71      ng       4623: 	    }
1.380     albertel 4624: 	    
1.269     raeburn  4625:             if ($aggregateflag) {
                   4626:                 &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
                   4627:                       $env{'course.'.$env{'request.course.id'}.'.domain'},
                   4628:                       $env{'course.'.$env{'request.course.id'}.'.num'});
                   4629:             }
1.125     ng       4630: 
1.71      ng       4631: 	    $studentTable.='<td valign="top">'.$displayPts[0].'</td>'.
                   4632: 		'<td valign="top">'.$displayPts[1].'</td>'.
1.484     albertel 4633: 		&Apache::loncommon::end_data_table_row();
1.68      ng       4634: 
1.196     albertel 4635: 	    $prob++;
1.68      ng       4636: 	}
1.71      ng       4637:         $curRes = $iterator->next();
1.68      ng       4638:     }
1.98      albertel 4639: 
1.484     albertel 4640:     $studentTable.=&Apache::loncommon::end_data_table();
1.324     albertel 4641:     $studentTable.=&show_grading_menu_form($env{'form.symb'});
1.76      ng       4642:     my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' :
                   4643: 		  'The scores were changed for '.
                   4644: 		  $changeflag.' problem'.($changeflag == 1 ? '.' : 's.'));
                   4645:     $request->print($grademsg.$studentTable);
1.68      ng       4646: 
1.70      ng       4647:     return '';
                   4648: }
                   4649: 
1.72      ng       4650: #-------- end of section for handling grading by page/sequence ---------
                   4651: #
                   4652: #-------------------------------------------------------------------
                   4653: 
1.75      albertel 4654: #--------------------Scantron Grading-----------------------------------
                   4655: #
                   4656: #------ start of section for handling grading by page/sequence ---------
                   4657: 
1.423     albertel 4658: =pod
                   4659: 
                   4660: =head1 Bubble sheet grading routines
                   4661: 
1.424     albertel 4662:   For this documentation:
                   4663: 
                   4664:    'scanline' refers to the full line of characters
                   4665:    from the file that we are parsing that represents one entire sheet
                   4666: 
                   4667:    'bubble line' refers to the data
                   4668:    representing the line of bubbles that are on the physical bubble sheet
                   4669: 
                   4670: 
                   4671: The overall process is that a scanned in bubble sheet data is uploaded
                   4672: into a course. When a user wants to grade, they select a
                   4673: sequence/folder of resources, a file of bubble sheet info, and pick
                   4674: one of the predefined configurations for what each scanline looks
                   4675: like.
                   4676: 
                   4677: Next each scanline is checked for any errors of either 'missing
1.435     foxr     4678: bubbles' (it's an error because it may have been mis-scanned
1.424     albertel 4679: because too light bubbling), 'double bubble' (each bubble line should
                   4680: have no more that one letter picked), invalid or duplicated CODE,
                   4681: invalid student ID
                   4682: 
                   4683: If the CODE option is used that determines the randomization of the
                   4684: homework problems, either way the student ID is looked up into a
                   4685: username:domain.
                   4686: 
                   4687: During the validation phase the instructor can choose to skip scanlines. 
                   4688: 
1.435     foxr     4689: After the validation phase, there are now 3 bubble sheet files
1.424     albertel 4690: 
                   4691:   scantron_original_filename (unmodified original file)
                   4692:   scantron_corrected_filename (file where the corrected information has replaced the original information)
                   4693:   scantron_skipped_filename (contains the exact text of scanlines that where skipped)
                   4694: 
                   4695: Also there is a separate hash nohist_scantrondata that contains extra
                   4696: correction information that isn't representable in the bubble sheet
                   4697: file (see &scantron_getfile() for more information)
                   4698: 
                   4699: After all scanlines are either valid, marked as valid or skipped, then
                   4700: foreach line foreach problem in the picked sequence, an ssi request is
                   4701: made that simulates a user submitting their selected letter(s) against
                   4702: the homework problem.
1.423     albertel 4703: 
                   4704: =over 4
                   4705: 
                   4706: 
                   4707: 
                   4708: =item defaultFormData
                   4709: 
                   4710:   Returns html hidden inputs used to hold context/default values.
                   4711: 
                   4712:  Arguments:
                   4713:   $symb - $symb of the current resource 
                   4714: 
                   4715: =cut
1.422     foxr     4716: 
1.81      albertel 4717: sub defaultFormData {
1.324     albertel 4718:     my ($symb)=@_;
1.447     foxr     4719:     return '<input type="hidden" name="symb"    value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 4720:      '<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
                   4721:      '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
1.81      albertel 4722: }
                   4723: 
1.447     foxr     4724: 
1.423     albertel 4725: =pod 
                   4726: 
                   4727: =item getSequenceDropDown
                   4728: 
                   4729:    Return html dropdown of possible sequences to grade
                   4730:  
                   4731:  Arguments:
                   4732:    $symb - $symb of the current resource 
                   4733: 
                   4734: =cut
1.422     foxr     4735: 
1.75      albertel 4736: sub getSequenceDropDown {
1.423     albertel 4737:     my ($symb)=@_;
1.75      albertel 4738:     my $result='<select name="selectpage">'."\n";
1.423     albertel 4739:     my ($titles,$symbx) = &getSymbMap();
1.137     albertel 4740:     my ($curpage)=&Apache::lonnet::decode_symb($symb); 
1.75      albertel 4741:     my $ctr=0;
                   4742:     foreach (@$titles) {
                   4743: 	my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
                   4744: 	$result.='<option value="'.$$symbx{$_}.'" '.
1.401     albertel 4745: 	    ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : '').
1.75      albertel 4746: 	    '>'.$showtitle.'</option>'."\n";
                   4747: 	$ctr++;
                   4748:     }
                   4749:     $result.= '</select>';
                   4750:     return $result;
                   4751: }
                   4752: 
1.495     albertel 4753: my %bubble_lines_per_response;     # no. bubble lines for each response.
                   4754:                                    # index is "symb.part_id"
                   4755: 
                   4756: my %first_bubble_line;             # First bubble line no. for each bubble.
                   4757: 
1.509     raeburn  4758: my %subdivided_bubble_lines;       # no. bubble lines for optionresponse, 
                   4759:                                    # matchresponse or rankresponse, where 
                   4760:                                    # an individual response can have multiple 
                   4761:                                    # lines
1.503     raeburn  4762: 
                   4763: my %responsetype_per_response;     # responsetype for each response
                   4764: 
1.495     albertel 4765: # Save and restore the bubble lines array to the form env.
                   4766: 
                   4767: 
                   4768: sub save_bubble_lines {
                   4769:     foreach my $line (keys(%bubble_lines_per_response)) {
                   4770: 	$env{"form.scantron.bubblelines.$line"}  = $bubble_lines_per_response{$line};
                   4771: 	$env{"form.scantron.first_bubble_line.$line"} =
                   4772: 	    $first_bubble_line{$line};
1.503     raeburn  4773:         $env{"form.scantron.sub_bubblelines.$line"} = 
                   4774:             $subdivided_bubble_lines{$line};
                   4775:         $env{"form.scantron.responsetype.$line"} =
                   4776:             $responsetype_per_response{$line};
1.495     albertel 4777:     }
                   4778: }
                   4779: 
                   4780: 
                   4781: sub restore_bubble_lines {
                   4782:     my $line = 0;
                   4783:     %bubble_lines_per_response = ();
                   4784:     while ($env{"form.scantron.bubblelines.$line"}) {
                   4785: 	my $value = $env{"form.scantron.bubblelines.$line"};
                   4786: 	$bubble_lines_per_response{$line} = $value;
                   4787: 	$first_bubble_line{$line}  =
                   4788: 	    $env{"form.scantron.first_bubble_line.$line"};
1.503     raeburn  4789:         $subdivided_bubble_lines{$line} =
                   4790:             $env{"form.scantron.sub_bubblelines.$line"};
                   4791:         $responsetype_per_response{$line} =
                   4792:             $env{"form.scantron.responsetype.$line"};
1.495     albertel 4793: 	$line++;
                   4794:     }
                   4795: 
                   4796: }
                   4797: 
                   4798: #  Given the parsed scanline, get the response for 
                   4799: #  'answer' number n:
                   4800: 
                   4801: sub get_response_bubbles {
                   4802:     my ($parsed_line, $response)  = @_;
                   4803: 
                   4804: 
                   4805:     my $bubble_line = $first_bubble_line{$response-1} +1;
                   4806:     my $bubble_lines= $bubble_lines_per_response{$response-1};
                   4807:     
                   4808:     my $selected = "";
                   4809: 
                   4810:     for (my $bline = 0; $bline < $bubble_lines; $bline++) {
                   4811: 	$selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":";
                   4812: 	$bubble_line++;
                   4813:     }
                   4814:     return $selected;
                   4815: }
1.423     albertel 4816: 
                   4817: =pod 
                   4818: 
                   4819: =item scantron_filenames
                   4820: 
                   4821:    Returns a list of the scantron files in the current course 
                   4822: 
                   4823: =cut
1.422     foxr     4824: 
1.202     albertel 4825: sub scantron_filenames {
1.257     albertel 4826:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   4827:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
1.157     albertel 4828:     my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
1.359     www      4829: 				    &propath($cdom,$cname));
1.202     albertel 4830:     my @possiblenames;
1.201     albertel 4831:     foreach my $filename (sort(@files)) {
1.157     albertel 4832: 	($filename)=split(/&/,$filename);
                   4833: 	if ($filename!~/^scantron_orig_/) { next ; }
                   4834: 	$filename=~s/^scantron_orig_//;
1.202     albertel 4835: 	push(@possiblenames,$filename);
                   4836:     }
                   4837:     return @possiblenames;
                   4838: }
                   4839: 
1.423     albertel 4840: =pod 
                   4841: 
                   4842: =item scantron_uploads
                   4843: 
                   4844:    Returns  html drop-down list of scantron files in current course.
                   4845: 
                   4846:  Arguments:
                   4847:    $file2grade - filename to set as selected in the dropdown
                   4848: 
                   4849: =cut
1.422     foxr     4850: 
1.202     albertel 4851: sub scantron_uploads {
1.209     ng       4852:     my ($file2grade) = @_;
1.202     albertel 4853:     my $result=	'<select name="scantron_selectfile">';
                   4854:     $result.="<option></option>";
                   4855:     foreach my $filename (sort(&scantron_filenames())) {
1.401     albertel 4856: 	$result.="<option".($filename eq $file2grade ? ' selected="selected"':'').">$filename</option>\n";
1.81      albertel 4857:     }
                   4858:     $result.="</select>";
                   4859:     return $result;
                   4860: }
                   4861: 
1.423     albertel 4862: =pod 
                   4863: 
                   4864: =item scantron_scantab
                   4865: 
                   4866:   Returns html drop down of the scantron formats in the scantronformat.tab
                   4867:   file.
                   4868: 
                   4869: =cut
1.422     foxr     4870: 
1.82      albertel 4871: sub scantron_scantab {
                   4872:     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
                   4873:     my $result='<select name="scantron_format">'."\n";
1.191     albertel 4874:     $result.='<option></option>'."\n";
1.82      albertel 4875:     foreach my $line (<$fh>) {
                   4876: 	my ($name,$descrip)=split(/:/,$line);
                   4877: 	if ($name =~ /^\#/) { next; }
                   4878: 	$result.='<option value="'.$name.'">'.$descrip.'</option>'."\n";
                   4879:     }
                   4880:     $result.='</select>'."\n";
                   4881: 
                   4882:     return $result;
                   4883: }
                   4884: 
1.423     albertel 4885: =pod 
                   4886: 
                   4887: =item scantron_CODElist
                   4888: 
                   4889:   Returns html drop down of the saved CODE lists from current course,
                   4890:   generated from earlier printings.
                   4891: 
                   4892: =cut
1.422     foxr     4893: 
1.186     albertel 4894: sub scantron_CODElist {
1.257     albertel 4895:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4896:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.186     albertel 4897:     my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum);
                   4898:     my $namechoice='<option></option>';
1.225     albertel 4899:     foreach my $name (sort {uc($a) cmp uc($b)} @names) {
1.191     albertel 4900: 	if ($name =~ /^error: 2 /) { next; }
1.278     albertel 4901: 	if ($name =~ /^type\0/) { next; }
1.186     albertel 4902: 	$namechoice.='<option value="'.$name.'">'.$name.'</option>';
                   4903:     }
                   4904:     $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>';
                   4905:     return $namechoice;
                   4906: }
                   4907: 
1.423     albertel 4908: =pod 
                   4909: 
                   4910: =item scantron_CODEunique
                   4911: 
                   4912:   Returns the html for "Each CODE to be used once" radio.
                   4913: 
                   4914: =cut
1.422     foxr     4915: 
1.186     albertel 4916: sub scantron_CODEunique {
1.381     albertel 4917:     my $result='<span style="white-space: nowrap;">
1.272     albertel 4918:                  <label><input type="radio" name="scantron_CODEunique"
1.423     albertel 4919:                         value="yes" checked="checked" />'.&mt('Yes').' </label>
1.381     albertel 4920:                 </span>
                   4921:                 <span style="white-space: nowrap;">
1.272     albertel 4922:                  <label><input type="radio" name="scantron_CODEunique"
1.423     albertel 4923:                         value="no" />'.&mt('No').' </label>
1.381     albertel 4924:                 </span>';
1.186     albertel 4925:     return $result;
                   4926: }
1.423     albertel 4927: 
                   4928: =pod 
                   4929: 
                   4930: =item scantron_selectphase
                   4931: 
                   4932:   Generates the initial screen to start the bubble sheet process.
                   4933:   Allows for - starting a grading run.
1.424     albertel 4934:              - downloading existing scan data (original, corrected
1.423     albertel 4935:                                                 or skipped info)
                   4936: 
                   4937:              - uploading new scan data
                   4938: 
                   4939:  Arguments:
                   4940:   $r          - The Apache request object
                   4941:   $file2grade - name of the file that contain the scanned data to score
                   4942: 
                   4943: =cut
1.186     albertel 4944: 
1.75      albertel 4945: sub scantron_selectphase {
1.209     ng       4946:     my ($r,$file2grade) = @_;
1.324     albertel 4947:     my ($symb)=&get_symb($r);
1.75      albertel 4948:     if (!$symb) {return '';}
1.423     albertel 4949:     my $sequence_selector=&getSequenceDropDown($symb);
1.324     albertel 4950:     my $default_form_data=&defaultFormData($symb);
                   4951:     my $grading_menu_button=&show_grading_menu_form($symb);
1.209     ng       4952:     my $file_selector=&scantron_uploads($file2grade);
1.82      albertel 4953:     my $format_selector=&scantron_scantab();
1.186     albertel 4954:     my $CODE_selector=&scantron_CODElist();
                   4955:     my $CODE_unique=&scantron_CODEunique();
1.75      albertel 4956:     my $result;
1.422     foxr     4957: 
1.513   ! foxr     4958:     $ssi_error = 0;
        !          4959: 
1.422     foxr     4960:     # Chunk of form to prompt for a file to grade and how:
                   4961: 
1.489     albertel 4962:     $result.= '
                   4963:     <br />
                   4964:     <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process">
                   4965:     <input type="hidden" name="command" value="scantron_warning" />
                   4966:     '.$default_form_data.'
                   4967:     '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   4968:        '.&Apache::loncommon::start_data_table_header_row().'
                   4969:             <th colspan="2">
1.492     albertel 4970:               &nbsp;'.&mt('Specify file and which Folder/Sequence to grade').'
1.489     albertel 4971:             </th>
                   4972:        '.&Apache::loncommon::end_data_table_header_row().'
                   4973:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 4974:             <td> '.&mt('Sequence to grade:').' </td><td> '.$sequence_selector.' </td>
1.489     albertel 4975:        '.&Apache::loncommon::end_data_table_row().'
                   4976:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 4977:             <td> '.&mt('Filename of scoring office file:').' </td><td> '.$file_selector.' </td>
1.489     albertel 4978:        '.&Apache::loncommon::end_data_table_row().'
                   4979:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 4980:             <td> '.&mt('Format of data file:').' </td><td> '.$format_selector.' </td>
1.489     albertel 4981:        '.&Apache::loncommon::end_data_table_row().'
                   4982:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 4983:             <td> '.&mt('Saved CODEs to validate against:').' </td><td> '.$CODE_selector.' </td>
1.489     albertel 4984:        '.&Apache::loncommon::end_data_table_row().'
                   4985:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 4986:             <td> '.&mt('Each CODE is only to be used once:').'</td><td> '.$CODE_unique.' </td>
1.489     albertel 4987:        '.&Apache::loncommon::end_data_table_row().'
                   4988:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 4989: 	    <td> '.&mt('Options:').' </td>
1.187     albertel 4990:             <td>
1.492     albertel 4991: 	       <label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> '.&mt('Do only previously skipped records').'</label> <br />
                   4992:                <label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> '.&mt('Remove all existing corrections').'</label> <br />
                   4993:                <label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources when grading').'</label>
1.187     albertel 4994: 	    </td>
1.489     albertel 4995:        '.&Apache::loncommon::end_data_table_row().'
                   4996:        '.&Apache::loncommon::start_data_table_row().'
1.174     albertel 4997:             <td colspan="2">
1.492     albertel 4998:               <input type="submit" value="'.&mt('Grading: Validate Scantron Records').'" />
1.162     albertel 4999:             </td>
1.489     albertel 5000:        '.&Apache::loncommon::end_data_table_row().'
                   5001:     '.&Apache::loncommon::end_data_table().'
                   5002:     </form>
                   5003: ';
1.162     albertel 5004:    
                   5005:     $r->print($result);
                   5006: 
1.257     albertel 5007:     if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||
                   5008:         &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
1.162     albertel 5009: 
1.422     foxr     5010: 	# Chunk of form to prompt for a scantron file upload.
                   5011: 
1.489     albertel 5012:         $r->print('
                   5013:     <br />
                   5014:     '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   5015:        '.&Apache::loncommon::start_data_table_header_row().'
                   5016:             <th>
1.492     albertel 5017:               &nbsp;'.&mt('Specify a Scantron data file to upload.').'
1.489     albertel 5018:             </th>
                   5019:        '.&Apache::loncommon::end_data_table_header_row().'
                   5020:        '.&Apache::loncommon::start_data_table_row().'
1.162     albertel 5021:             <td>
1.489     albertel 5022: ');
1.324     albertel 5023:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.257     albertel 5024:     my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5025:     my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'};
1.492     albertel 5026:     $r->print('
1.174     albertel 5027:               <script type="text/javascript" language="javascript">
                   5028:     function checkUpload(formname) {
                   5029: 	if (formname.upfile.value == "") {
1.492     albertel 5030: 	    alert("'.&mt('Please use the browse button to select a file from your local directory.').'");
1.174     albertel 5031: 	    return false;
                   5032: 	}
                   5033: 	formname.submit();
                   5034:     }
                   5035:               </script>
                   5036: 
1.492     albertel 5037:               <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post">
                   5038:                 '.$default_form_data.'
                   5039:                 <input name="courseid" type="hidden" value="'.$cnum.'" />
                   5040:                 <input name="domainid" type="hidden" value="'.$cdom.'" />
                   5041:                 <input name="command" value="scantronupload_save" type="hidden" />
                   5042:                 '.&mt('File to upload: [_1]','<input type="file" name="upfile" size="50" />').'
1.174     albertel 5043:                 <br />
1.492     albertel 5044:                 <input type="button" onClick="javascript:checkUpload(this.form);" value="'.&mt('Upload Scantron Data').'" />
1.174     albertel 5045:               </form>
1.492     albertel 5046: ');
1.162     albertel 5047: 
1.489     albertel 5048:         $r->print('
1.162     albertel 5049:             </td>
1.489     albertel 5050:        '.&Apache::loncommon::end_data_table_row().'
                   5051:        '.&Apache::loncommon::end_data_table().'
                   5052: ');
1.162     albertel 5053:     }
1.422     foxr     5054: 
                   5055:     # Chunk of the form that prompts to view a scoring office file,
                   5056:     # corrected file, skipped records in a file.
                   5057: 
1.489     albertel 5058:     $r->print('
                   5059:    <br />
                   5060:    <form action="/adm/grades" name="scantron_download">
                   5061:      '.$default_form_data.'
                   5062:      <input type="hidden" name="command" value="scantron_download" />
                   5063:      '.&Apache::loncommon::start_data_table('LC_scantron_action').'
                   5064:        '.&Apache::loncommon::start_data_table_header_row().'
                   5065:               <th>
1.492     albertel 5066:                 &nbsp;'.&mt('Download a scoring office file').'
1.489     albertel 5067:               </th>
                   5068:        '.&Apache::loncommon::end_data_table_header_row().'
                   5069:        '.&Apache::loncommon::start_data_table_row().'
1.492     albertel 5070:               <td> '.&mt('Filename of scoring office file: [_1]',$file_selector).' 
1.489     albertel 5071:                 <br />
1.492     albertel 5072:                 <input type="submit" value="'.&mt('Download: Show List of Associated Files').'" />
1.489     albertel 5073:        '.&Apache::loncommon::end_data_table_row().'
                   5074:      '.&Apache::loncommon::end_data_table().'
                   5075:    </form>
                   5076:    <br />
                   5077: ');
1.162     albertel 5078: 
1.457     banghart 5079:     &Apache::lonpickcode::code_list($r,2);
                   5080:     $r->print($grading_menu_button);
1.162     albertel 5081:     return
1.75      albertel 5082: }
                   5083: 
1.423     albertel 5084: =pod
                   5085: 
                   5086: =item get_scantron_config
                   5087: 
                   5088:    Parse and return the scantron configuration line selected as a
                   5089:    hash of configuration file fields.
                   5090: 
                   5091:  Arguments:
                   5092:     which - the name of the configuration to parse from the file.
                   5093: 
                   5094: 
                   5095:  Returns:
                   5096:             If the named configuration is not in the file, an empty
                   5097:             hash is returned.
                   5098:     a hash with the fields
                   5099:       name         - internal name for the this configuration setup
                   5100:       description  - text to display to operator that describes this config
                   5101:       CODElocation - if 0 or the string 'none'
                   5102:                           - no CODE exists for this config
                   5103:                      if -1 || the string 'letter'
                   5104:                           - a CODE exists for this config and is
                   5105:                             a string of letters
                   5106:                      Unsupported value (but planned for future support)
                   5107:                           if a positive integer
                   5108:                                - The CODE exists as the first n items from
                   5109:                                  the question section of the form
                   5110:                           if the string 'number'
                   5111:                                - The CODE exists for this config and is
                   5112:                                  a string of numbers
                   5113:       CODEstart   - (only matter if a CODE exists) column in the line where
                   5114:                      the CODE starts
                   5115:       CODElength  - length of the CODE
                   5116:       IDstart     - column where the student ID number starts
                   5117:       IDlength    - length of the student ID info
                   5118:       Qstart      - column where the information from the bubbled
                   5119:                     'questions' start
                   5120:       Qlength     - number of columns comprising a single bubble line from
                   5121:                     the sheet. (usually either 1 or 10)
1.424     albertel 5122:       Qon         - either a single character representing the character used
1.423     albertel 5123:                     to signal a bubble was chosen in the positional setup, or
                   5124:                     the string 'letter' if the letter of the chosen bubble is
                   5125:                     in the final, or 'number' if a number representing the
                   5126:                     chosen bubble is in the file (1->A 0->J)
1.424     albertel 5127:       Qoff        - the character used to represent that a bubble was
                   5128:                     left blank
1.423     albertel 5129:       PaperID     - if the scanning process generates a unique number for each
                   5130:                     sheet scanned the column that this ID number starts in
                   5131:       PaperIDlength - number of columns that comprise the unique ID number
                   5132:                       for the sheet of paper
1.424     albertel 5133:       FirstName   - column that the first name starts in
1.423     albertel 5134:       FirstNameLength - number of columns that the first name spans
                   5135:  
                   5136:       LastName    - column that the last name starts in
                   5137:       LastNameLength - number of columns that the last name spans
                   5138: 
                   5139: =cut
1.422     foxr     5140: 
1.82      albertel 5141: sub get_scantron_config {
                   5142:     my ($which) = @_;
                   5143:     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
                   5144:     my %config;
1.157     albertel 5145:     #FIXME probably should move to XML it has already gotten a bit much now
1.82      albertel 5146:     foreach my $line (<$fh>) {
                   5147: 	my ($name,$descrip)=split(/:/,$line);
                   5148: 	if ($name ne $which ) { next; }
                   5149: 	chomp($line);
                   5150: 	my @config=split(/:/,$line);
                   5151: 	$config{'name'}=$config[0];
                   5152: 	$config{'description'}=$config[1];
                   5153: 	$config{'CODElocation'}=$config[2];
                   5154: 	$config{'CODEstart'}=$config[3];
                   5155: 	$config{'CODElength'}=$config[4];
                   5156: 	$config{'IDstart'}=$config[5];
                   5157: 	$config{'IDlength'}=$config[6];
                   5158: 	$config{'Qstart'}=$config[7];
1.497     foxr     5159:  	$config{'Qlength'}=$config[8];
1.82      albertel 5160: 	$config{'Qoff'}=$config[9];
                   5161: 	$config{'Qon'}=$config[10];
1.157     albertel 5162: 	$config{'PaperID'}=$config[11];
                   5163: 	$config{'PaperIDlength'}=$config[12];
                   5164: 	$config{'FirstName'}=$config[13];
                   5165: 	$config{'FirstNamelength'}=$config[14];
                   5166: 	$config{'LastName'}=$config[15];
                   5167: 	$config{'LastNamelength'}=$config[16];
1.82      albertel 5168: 	last;
                   5169:     }
                   5170:     return %config;
                   5171: }
                   5172: 
1.423     albertel 5173: =pod 
                   5174: 
                   5175: =item username_to_idmap
                   5176: 
                   5177:     creates a hash keyed by student id with values of the corresponding
                   5178:     student username:domain.
                   5179: 
                   5180:   Arguments:
                   5181: 
                   5182:     $classlist - reference to the class list hash. This is a hash
                   5183:                  keyed by student name:domain  whose elements are references
1.424     albertel 5184:                  to arrays containing various chunks of information
1.423     albertel 5185:                  about the student. (See loncoursedata for more info).
                   5186: 
                   5187:   Returns
                   5188:     %idmap - the constructed hash
                   5189: 
                   5190: =cut
                   5191: 
1.82      albertel 5192: sub username_to_idmap {
                   5193:     my ($classlist)= @_;
                   5194:     my %idmap;
                   5195:     foreach my $student (keys(%$classlist)) {
                   5196: 	$idmap{$classlist->{$student}->[&Apache::loncoursedata::CL_ID]}=
                   5197: 	    $student;
                   5198:     }
                   5199:     return %idmap;
                   5200: }
1.423     albertel 5201: 
                   5202: =pod
                   5203: 
1.424     albertel 5204: =item scantron_fixup_scanline
1.423     albertel 5205: 
                   5206:    Process a requested correction to a scanline.
                   5207: 
                   5208:   Arguments:
                   5209:     $scantron_config   - hash from &get_scantron_config()
                   5210:     $scan_data         - hash of correction information 
                   5211:                           (see &scantron_getfile())
                   5212:     $line              - existing scanline
                   5213:     $whichline         - line number of the passed in scanline
                   5214:     $field             - type of change to process 
                   5215:                          (either 
                   5216:                           'ID'     -> correct the student ID number
                   5217:                           'CODE'   -> correct the CODE
                   5218:                           'answer' -> fixup the submitted answers)
                   5219:     
                   5220:    $args               - hash of additional info,
                   5221:                           - 'ID' 
                   5222:                                'newid' -> studentID to use in replacement
1.424     albertel 5223:                                           of existing one
1.423     albertel 5224:                           - 'CODE' 
                   5225:                                'CODE_ignore_dup' - set to true if duplicates
                   5226:                                                    should be ignored.
                   5227: 	                       'CODE' - is new code or 'use_unfound'
1.424     albertel 5228:                                         if the existing unfound code should
1.423     albertel 5229:                                         be used as is
                   5230:                           - 'answer'
                   5231:                                'response' - new answer or 'none' if blank
                   5232:                                'question' - the bubble line to change
1.503     raeburn  5233:                                'questionnum' - the question identifier,
                   5234:                                                may include subquestion. 
1.423     albertel 5235: 
                   5236:   Returns:
                   5237:     $line - the modified scanline
                   5238: 
                   5239:   Side effects: 
                   5240:     $scan_data - may be updated
                   5241: 
                   5242: =cut
                   5243: 
1.82      albertel 5244: 
1.157     albertel 5245: sub scantron_fixup_scanline {
                   5246:     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
                   5247:     if ($field eq 'ID') {
                   5248: 	if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
1.186     albertel 5249: 	    return ($line,1,'New value too large');
1.157     albertel 5250: 	}
                   5251: 	if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {
                   5252: 	    $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
                   5253: 				     $args->{'newid'});
                   5254: 	}
                   5255: 	substr($line,$$scantron_config{'IDstart'}-1,
                   5256: 	       $$scantron_config{'IDlength'})=$args->{'newid'};
                   5257: 	if ($args->{'newid'}=~/^\s*$/) {
                   5258: 	    &scan_data($scan_data,"$whichline.user",
                   5259: 		       $args->{'username'}.':'.$args->{'domain'});
                   5260: 	}
1.186     albertel 5261:     } elsif ($field eq 'CODE') {
1.192     albertel 5262: 	if ($args->{'CODE_ignore_dup'}) {
                   5263: 	    &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');
                   5264: 	}
                   5265: 	&scan_data($scan_data,"$whichline.useCODE",'1');
                   5266: 	if ($args->{'CODE'} ne 'use_unfound') {
1.191     albertel 5267: 	    if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) {
                   5268: 		return ($line,1,'New CODE value too large');
                   5269: 	    }
                   5270: 	    if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) {
                   5271: 		$args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'});
                   5272: 	    }
                   5273: 	    substr($line,$$scantron_config{'CODEstart'}-1,
                   5274: 		   $$scantron_config{'CODElength'})=$args->{'CODE'};
1.186     albertel 5275: 	}
1.157     albertel 5276:     } elsif ($field eq 'answer') {
1.497     foxr     5277: 	my $length=$scantron_config->{'Qlength'};
1.157     albertel 5278: 	my $off=$scantron_config->{'Qoff'};
                   5279: 	my $on=$scantron_config->{'Qon'};
1.497     foxr     5280: 	my $answer=${off}x$length;
                   5281: 	if ($args->{'response'} eq 'none') {
                   5282: 	    &scan_data($scan_data,
1.503     raeburn  5283: 		       "$whichline.no_bubble.".$args->{'questionnum'},'1');
1.497     foxr     5284: 	} else {
                   5285: 	    if ($on eq 'letter') {
                   5286: 		my @alphabet=('A'..'Z');
                   5287: 		$answer=$alphabet[$args->{'response'}];
                   5288: 	    } elsif ($on eq 'number') {
                   5289: 		$answer=$args->{'response'}+1;
                   5290: 		if ($answer == 10) { $answer = '0'; }
1.274     albertel 5291: 	    } else {
1.497     foxr     5292: 		substr($answer,$args->{'response'},1)=$on;
1.274     albertel 5293: 	    }
1.497     foxr     5294: 	    &scan_data($scan_data,
1.503     raeburn  5295: 		       "$whichline.no_bubble.".$args->{'questionnum'},undef,'1');
1.157     albertel 5296: 	}
1.497     foxr     5297: 	my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
                   5298: 	substr($line,$where-1,$length)=$answer;
1.157     albertel 5299:     }
                   5300:     return $line;
                   5301: }
1.423     albertel 5302: 
                   5303: =pod
                   5304: 
                   5305: =item scan_data
                   5306: 
                   5307:     Edit or look up  an item in the scan_data hash.
                   5308: 
                   5309:   Arguments:
                   5310:     $scan_data  - The hash (see scantron_getfile)
                   5311:     $key        - shorthand of the key to edit (actual key is
1.424     albertel 5312:                   scantronfilename_key).
1.423     albertel 5313:     $data        - New value of the hash entry.
                   5314:     $delete      - If true, the entry is removed from the hash.
                   5315: 
                   5316:   Returns:
                   5317:     The new value of the hash table field (undefined if deleted).
                   5318: 
                   5319: =cut
                   5320: 
                   5321: 
1.157     albertel 5322: sub scan_data {
                   5323:     my ($scan_data,$key,$value,$delete)=@_;
1.257     albertel 5324:     my $filename=$env{'form.scantron_selectfile'};
1.157     albertel 5325:     if (defined($value)) {
                   5326: 	$scan_data->{$filename.'_'.$key} = $value;
                   5327:     }
                   5328:     if ($delete) { delete($scan_data->{$filename.'_'.$key}); }
                   5329:     return $scan_data->{$filename.'_'.$key};
                   5330: }
1.423     albertel 5331: 
1.495     albertel 5332: # ----- These first few routines are general use routines.----
                   5333: 
                   5334: # Return the number of occurences of a pattern in a string.
                   5335: 
                   5336: sub occurence_count {
                   5337:     my ($string, $pattern) = @_;
                   5338: 
                   5339:     my @matches = ($string =~ /$pattern/g);
                   5340: 
                   5341:     return scalar(@matches);
                   5342: }
                   5343: 
                   5344: 
                   5345: # Take a string known to have digits and convert all the
                   5346: # digits into letters in the range J,A..I.
                   5347: 
                   5348: sub digits_to_letters {
                   5349:     my ($input) = @_;
                   5350: 
                   5351:     my @alphabet = ('J', 'A'..'I');
                   5352: 
                   5353:     my @input    = split(//, $input);
                   5354:     my $output ='';
                   5355:     for (my $i = 0; $i < scalar(@input); $i++) {
                   5356: 	if ($input[$i] =~ /\d/) {
                   5357: 	    $output .= $alphabet[$input[$i]];
                   5358: 	} else {
                   5359: 	    $output .= $input[$i];
                   5360: 	}
                   5361:     }
                   5362:     return $output;
                   5363: }
                   5364: 
1.423     albertel 5365: =pod 
                   5366: 
                   5367: =item scantron_parse_scanline
                   5368: 
                   5369:   Decodes a scanline from the selected scantron file
                   5370: 
                   5371:  Arguments:
                   5372:     line             - The text of the scantron file line to process
                   5373:     whichline        - Line number
                   5374:     scantron_config  - Hash describing the format of the scantron lines.
                   5375:     scan_data        - Hash of extra information about the scanline
                   5376:                        (see scantron_getfile for more information)
                   5377:     just_header      - True if should not process question answers but only
                   5378:                        the stuff to the left of the answers.
                   5379:  Returns:
                   5380:    Hash containing the result of parsing the scanline
                   5381: 
                   5382:    Keys are all proceeded by the string 'scantron.'
                   5383: 
                   5384:        CODE    - the CODE in use for this scanline
                   5385:        useCODE - 1 if the CODE is invalid but it usage has been forced
                   5386:                  by the operator
                   5387:        CODE_ignore_dup - 1 if the CODE is a duplicated use when unique
                   5388:                             CODEs were selected, but the usage has been
                   5389:                             forced by the operator
                   5390:        ID  - student ID
                   5391:        PaperID - if used, the ID number printed on the sheet when the 
                   5392:                  paper was scanned
                   5393:        FirstName - first name from the sheet
                   5394:        LastName  - last name from the sheet
                   5395: 
                   5396:      if just_header was not true these key may also exist
                   5397: 
1.447     foxr     5398:        missingerror - a list of bubble ranges that are considered to be answers
                   5399:                       to a single question that don't have any bubbles filled in.
                   5400:                       Of the form questionnumber:firstbubblenumber:count.
                   5401:        doubleerror  - a list of bubble ranges that are considered to be answers
                   5402:                       to a single question that have more than one bubble filled in.
                   5403:                       Of the form questionnumber::firstbubblenumber:count
                   5404:    
                   5405:                 In the above, count is the number of bubble responses in the
                   5406:                 input line needed to represent the possible answers to the question.
                   5407:                 e.g. a radioresponse with 15 choices in an answer sheet with 10 choices
                   5408:                 per line would have count = 2.
                   5409: 
1.423     albertel 5410:        maxquest     - the number of the last bubble line that was parsed
                   5411: 
                   5412:        (<number> starts at 1)
                   5413:        <number>.answer - zero or more letters representing the selected
                   5414:                          letters from the scanline for the bubble line 
                   5415:                          <number>.
                   5416:                          if blank there was either no bubble or there where
                   5417:                          multiple bubbles, (consult the keys missingerror and
                   5418:                          doubleerror if this is an error condition)
                   5419: 
                   5420: =cut
                   5421: 
1.82      albertel 5422: sub scantron_parse_scanline {
1.423     albertel 5423:     my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;
1.470     foxr     5424: 
1.82      albertel 5425:     my %record;
1.422     foxr     5426:     my $questions=substr($line,$$scantron_config{'Qstart'}-1);  # Answers
                   5427:     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff
1.278     albertel 5428:     if (!($$scantron_config{'CODElocation'} eq 0 ||
                   5429: 	  $$scantron_config{'CODElocation'} eq 'none')) {
                   5430: 	if ($$scantron_config{'CODElocation'} < 0 ||
                   5431: 	    $$scantron_config{'CODElocation'} eq 'letter' ||
                   5432: 	    $$scantron_config{'CODElocation'} eq 'number') {
1.191     albertel 5433: 	    $record{'scantron.CODE'}=substr($data,
                   5434: 					    $$scantron_config{'CODEstart'}-1,
1.83      albertel 5435: 					    $$scantron_config{'CODElength'});
1.191     albertel 5436: 	    if (&scan_data($scan_data,"$whichline.useCODE")) {
                   5437: 		$record{'scantron.useCODE'}=1;
                   5438: 	    }
1.192     albertel 5439: 	    if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) {
                   5440: 		$record{'scantron.CODE_ignore_dup'}=1;
                   5441: 	    }
1.82      albertel 5442: 	} else {
                   5443: 	    #FIXME interpret first N questions
                   5444: 	}
                   5445:     }
1.83      albertel 5446:     $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
                   5447: 				  $$scantron_config{'IDlength'});
1.157     albertel 5448:     $record{'scantron.PaperID'}=
                   5449: 	substr($data,$$scantron_config{'PaperID'}-1,
                   5450: 	       $$scantron_config{'PaperIDlength'});
                   5451:     $record{'scantron.FirstName'}=
                   5452: 	substr($data,$$scantron_config{'FirstName'}-1,
                   5453: 	       $$scantron_config{'FirstNamelength'});
                   5454:     $record{'scantron.LastName'}=
                   5455: 	substr($data,$$scantron_config{'LastName'}-1,
                   5456: 	       $$scantron_config{'LastNamelength'});
1.423     albertel 5457:     if ($just_header) { return \%record; }
1.194     albertel 5458: 
1.82      albertel 5459:     my @alphabet=('A'..'Z');
                   5460:     my $questnum=0;
1.447     foxr     5461:     my $ansnum  =1;		# Multiple 'answer lines'/question.
                   5462: 
1.470     foxr     5463:     chomp($questions);		# Get rid of any trailing \n.
                   5464:     $questions =~ s/\r$//;      # Get rid of trailing \r too (MAC or Win uploads).
                   5465:     while (length($questions)) {
1.447     foxr     5466: 	my $answers_needed = $bubble_lines_per_response{$questnum};
1.503     raeburn  5467:         my $answer_length  = ($$scantron_config{'Qlength'} * $answers_needed)
                   5468:                              || 1;
                   5469:         $questnum++;
                   5470:         my $quest_id = $questnum;
                   5471:         my $currentquest = substr($questions,0,$answer_length);
                   5472:         $questions       = substr($questions,$answer_length);
                   5473:         if (length($currentquest) < $answer_length) { next; }
                   5474: 
                   5475:         if ($subdivided_bubble_lines{$questnum-1} =~ /,/) {
                   5476:             my $subquestnum = 1;
                   5477:             my $subquestions = $currentquest;
                   5478:             my @subanswers_needed = 
                   5479:                 split(/,/,$subdivided_bubble_lines{$questnum-1});  
                   5480:             foreach my $subans (@subanswers_needed) {
                   5481:                 my $subans_length =
                   5482:                     ($$scantron_config{'Qlength'} * $subans)  || 1;
                   5483:                 my $currsubquest = substr($subquestions,0,$subans_length);
                   5484:                 $subquestions   = substr($subquestions,$subans_length);
                   5485:                 $quest_id = "$questnum.$subquestnum";
                   5486:                 if (($$scantron_config{'Qon'} eq 'letter') ||
                   5487:                     ($$scantron_config{'Qon'} eq 'number')) {
                   5488:                     $ansnum = &scantron_validator_lettnum($ansnum, 
                   5489:                         $questnum,$quest_id,$subans,$currsubquest,$whichline,
                   5490:                         \@alphabet,\%record,$scantron_config,$scan_data);
                   5491:                 } else {
                   5492:                     $ansnum = &scantron_validator_positional($ansnum,
                   5493:                         $questnum,$quest_id,$subans,$currsubquest,$whichline,                        \@alphabet,\%record,$scantron_config,$scan_data);
                   5494:                 }
                   5495:                 $subquestnum ++;
                   5496:             }
                   5497:         } else {
                   5498:             if (($$scantron_config{'Qon'} eq 'letter') ||
                   5499:                 ($$scantron_config{'Qon'} eq 'number')) {
                   5500:                 $ansnum = &scantron_validator_lettnum($ansnum,$questnum,
                   5501:                     $quest_id,$answers_needed,$currentquest,$whichline,
                   5502:                     \@alphabet,\%record,$scantron_config,$scan_data);
                   5503:             } else {
                   5504:                 $ansnum = &scantron_validator_positional($ansnum,$questnum,
                   5505:                     $quest_id,$answers_needed,$currentquest,$whichline,
                   5506:                     \@alphabet,\%record,$scantron_config,$scan_data);
                   5507:             }
                   5508:         }
                   5509:     }
                   5510:     $record{'scantron.maxquest'}=$questnum;
                   5511:     return \%record;
                   5512: }
1.447     foxr     5513: 
1.503     raeburn  5514: sub scantron_validator_lettnum {
                   5515:     my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline,
                   5516:         $alphabet,$record,$scantron_config,$scan_data) = @_;
                   5517: 
                   5518:     # Qon 'letter' implies for each slot in currquest we have:
                   5519:     #    ? or * for doubles, a letter in A-Z for a bubble, and
                   5520:     #    about anything else (esp. a value of Qoff) for missing
                   5521:     #    bubbles.
                   5522:     #
                   5523:     # Qon 'number' implies each slot gives a digit that indexes the
                   5524:     #    bubbles filled, or Qoff, or a non-number for unbubbled lines,
                   5525:     #    and * or ? for double bubbles on a single line.
                   5526:     #
1.447     foxr     5527: 
1.503     raeburn  5528:     my $matchon;
                   5529:     if ($$scantron_config{'Qon'} eq 'letter') {
                   5530:         $matchon = '[A-Z]';
                   5531:     } elsif ($$scantron_config{'Qon'} eq 'number') {
                   5532:         $matchon = '\d';
                   5533:     }
                   5534:     my $occurrences = 0;
                   5535:     if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
                   5536:         ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
1.510     raeburn  5537:         ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
                   5538:         ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
                   5539:         ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
                   5540:         ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
1.503     raeburn  5541:         my @singlelines = split('',$currquest);
                   5542:         foreach my $entry (@singlelines) {
                   5543:             $occurrences = &occurence_count($entry,$matchon);
                   5544:             if ($occurrences > 1) {
                   5545:                 last;
                   5546:             }
                   5547:         } 
                   5548:     } else {
                   5549:         $occurrences = &occurence_count($currquest,$matchon); 
                   5550:     }
                   5551:     if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) {
                   5552:         push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5553:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5554:             my $bubble = substr($currquest,$ans,1);
                   5555:             if ($bubble =~ /$matchon/ ) {
                   5556:                 if ($$scantron_config{'Qon'} eq 'number') {
                   5557:                     if ($bubble == 0) {
                   5558:                         $bubble = 10; 
                   5559:                     }
                   5560:                     $record->{"scantron.$ansnum.answer"} = 
                   5561:                         $alphabet->[$bubble-1];
                   5562:                 } else {
                   5563:                     $record->{"scantron.$ansnum.answer"} = $bubble;
                   5564:                 }
                   5565:             } else {
                   5566:                 $record->{"scantron.$ansnum.answer"}='';
                   5567:             }
                   5568:             $ansnum++;
                   5569:         }
                   5570:     } elsif (!defined($currquest)
                   5571:             || (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest))
                   5572:             || (&occurence_count($currquest,$matchon) == 0)) {
                   5573:         for (my $ans=0; $ans<$answers_needed; $ans++ ) {
                   5574:             $record->{"scantron.$ansnum.answer"}='';
                   5575:             $ansnum++;
                   5576:         }
                   5577:         if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) {
                   5578:             push(@{$record->{'scantron.missingerror'}},$quest_id);
                   5579:         }
                   5580:     } else {
                   5581:         if ($$scantron_config{'Qon'} eq 'number') {
                   5582:             $currquest = &digits_to_letters($currquest);            
                   5583:         }
                   5584:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5585:             my $bubble = substr($currquest,$ans,1);
                   5586:             $record->{"scantron.$ansnum.answer"} = $bubble;
                   5587:             $ansnum++;
                   5588:         }
                   5589:     }
                   5590:     return $ansnum;
                   5591: }
1.447     foxr     5592: 
1.503     raeburn  5593: sub scantron_validator_positional {
                   5594:     my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,
                   5595:         $whichline,$alphabet,$record,$scantron_config,$scan_data) = @_;
1.447     foxr     5596: 
1.503     raeburn  5597:     # Otherwise there's a positional notation;
                   5598:     # each bubble line requires Qlength items, and there are filled in
                   5599:     # bubbles for each case where there 'Qon' characters.
                   5600:     #
1.447     foxr     5601: 
1.503     raeburn  5602:     my @array=split($$scantron_config{'Qon'},$currquest,-1);
1.447     foxr     5603: 
1.503     raeburn  5604:     # If the split only gives us one element.. the full length of the
                   5605:     # answer string, no bubbles are filled in:
1.447     foxr     5606: 
1.507     raeburn  5607:     if ($answers_needed eq '') {
                   5608:         return;
                   5609:     }
                   5610: 
1.503     raeburn  5611:     if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) {
                   5612:         for (my $ans=0; $ans<$answers_needed; $ans++ ) {
                   5613:             $record->{"scantron.$ansnum.answer"}='';
                   5614:             $ansnum++;
                   5615:         }
                   5616:         if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) {
                   5617:             push(@{$record->{"scantron.missingerror"}},$quest_id);
                   5618:         }
                   5619:     } elsif (scalar(@array) == 2) {
                   5620:         my $location = length($array[0]);
                   5621:         my $line_num = int($location / $$scantron_config{'Qlength'});
                   5622:         my $bubble   = $alphabet->[$location % $$scantron_config{'Qlength'}];
                   5623:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5624:             if ($ans eq $line_num) {
                   5625:                 $record->{"scantron.$ansnum.answer"} = $bubble;
                   5626:             } else {
                   5627:                 $record->{"scantron.$ansnum.answer"} = ' ';
                   5628:             }
                   5629:             $ansnum++;
                   5630:          }
                   5631:     } else {
                   5632:         #  If there's more than one instance of a bubble character
                   5633:         #  That's a double bubble; with positional notation we can
                   5634:         #  record all the bubbles filled in as well as the
                   5635:         #  fact this response consists of multiple bubbles.
                   5636:         #
                   5637:         if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
                   5638:             ($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
1.510     raeburn  5639:             ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
                   5640:             ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
                   5641:             ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
                   5642:             ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
1.503     raeburn  5643:             my $doubleerror = 0;
                   5644:             while (($currquest >= $$scantron_config{'Qlength'}) && 
                   5645:                    (!$doubleerror)) {
                   5646:                my $currline = substr($currquest,0,$$scantron_config{'Qlength'});
                   5647:                $currquest = substr($currquest,$$scantron_config{'Qlength'});
                   5648:                my @currarray = split($$scantron_config{'Qon'},$currline,-1);
                   5649:                if (length(@currarray) > 2) {
                   5650:                    $doubleerror = 1;
                   5651:                } 
                   5652:             }
                   5653:             if ($doubleerror) {
                   5654:                 push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5655:             }
                   5656:         } else {
                   5657:             push(@{$record->{'scantron.doubleerror'}},$quest_id);
                   5658:         }
                   5659:         my $item = $ansnum;
                   5660:         for (my $ans=0; $ans<$answers_needed; $ans++) {
                   5661:             $record->{"scantron.$item.answer"} = '';
                   5662:             $item ++;
                   5663:         }
1.447     foxr     5664: 
1.503     raeburn  5665:         my @ans=@array;
                   5666:         my $i=0;
                   5667:         my $increment = 0;
                   5668:         while ($#ans) {
                   5669:             $i+=length($ans[0]) + $increment;
                   5670:             my $line   = int($i/$$scantron_config{'Qlength'} + $ansnum);
                   5671:             my $bubble = $i%$$scantron_config{'Qlength'};
                   5672:             $record->{"scantron.$line.answer"}.=$alphabet->[$bubble];
                   5673:             shift(@ans);
                   5674:             $increment = 1;
                   5675:         }
                   5676:         $ansnum += $answers_needed;
1.82      albertel 5677:     }
1.503     raeburn  5678:     return $ansnum;
1.82      albertel 5679: }
                   5680: 
1.423     albertel 5681: =pod
                   5682: 
                   5683: =item scantron_add_delay
                   5684: 
                   5685:    Adds an error message that occurred during the grading phase to a
                   5686:    queue of messages to be shown after grading pass is complete
                   5687: 
                   5688:  Arguments:
1.424     albertel 5689:    $delayqueue  - arrary ref of hash ref of error messages
1.423     albertel 5690:    $scanline    - the scanline that caused the error
                   5691:    $errormesage - the error message
                   5692:    $errorcode   - a numeric code for the error
                   5693: 
                   5694:  Side Effects:
1.424     albertel 5695:    updates the $delayqueue to have a new hash ref of the error
1.423     albertel 5696: 
                   5697: =cut
                   5698: 
1.82      albertel 5699: sub scantron_add_delay {
1.140     albertel 5700:     my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;
                   5701:     push(@$delayqueue,
                   5702: 	 {'line' => $scanline, 'emsg' => $errormessage,
                   5703: 	  'ecode' => $errorcode }
                   5704: 	 );
1.82      albertel 5705: }
                   5706: 
1.423     albertel 5707: =pod
                   5708: 
                   5709: =item scantron_find_student
                   5710: 
1.424     albertel 5711:    Finds the username for the current scanline
                   5712: 
                   5713:   Arguments:
                   5714:    $scantron_record - hash result from scantron_parse_scanline
                   5715:    $scan_data       - hash of correction information 
                   5716:                       (see &scantron_getfile() form more information)
                   5717:    $idmap           - hash from &username_to_idmap()
                   5718:    $line            - number of current scanline
                   5719:  
                   5720:   Returns:
                   5721:    Either 'username:domain' or undef if unknown
                   5722: 
1.423     albertel 5723: =cut
                   5724: 
1.82      albertel 5725: sub scantron_find_student {
1.157     albertel 5726:     my ($scantron_record,$scan_data,$idmap,$line)=@_;
1.83      albertel 5727:     my $scanID=$$scantron_record{'scantron.ID'};
1.157     albertel 5728:     if ($scanID =~ /^\s*$/) {
                   5729:  	return &scan_data($scan_data,"$line.user");
                   5730:     }
1.83      albertel 5731:     foreach my $id (keys(%$idmap)) {
1.157     albertel 5732:  	if (lc($id) eq lc($scanID)) {
                   5733:  	    return $$idmap{$id};
                   5734:  	}
1.83      albertel 5735:     }
                   5736:     return undef;
                   5737: }
                   5738: 
1.423     albertel 5739: =pod
                   5740: 
                   5741: =item scantron_filter
                   5742: 
1.424     albertel 5743:    Filter sub for lonnavmaps, filters out hidden resources if ignore
                   5744:    hidden resources was selected
                   5745: 
1.423     albertel 5746: =cut
                   5747: 
1.83      albertel 5748: sub scantron_filter {
                   5749:     my ($curres)=@_;
1.331     albertel 5750: 
                   5751:     if (ref($curres) && $curres->is_problem()) {
                   5752: 	# if the user has asked to not have either hidden
                   5753: 	# or 'randomout' controlled resources to be graded
                   5754: 	# don't include them
                   5755: 	if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
                   5756: 	    && $curres->randomout) {
                   5757: 	    return 0;
                   5758: 	}
1.83      albertel 5759: 	return 1;
                   5760:     }
                   5761:     return 0;
1.82      albertel 5762: }
                   5763: 
1.423     albertel 5764: =pod
                   5765: 
                   5766: =item scantron_process_corrections
                   5767: 
1.424     albertel 5768:    Gets correction information out of submitted form data and corrects
                   5769:    the scanline
                   5770: 
1.423     albertel 5771: =cut
                   5772: 
1.157     albertel 5773: sub scantron_process_corrections {
                   5774:     my ($r) = @_;
1.257     albertel 5775:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 5776:     my ($scanlines,$scan_data)=&scantron_getfile();
                   5777:     my $classlist=&Apache::loncoursedata::get_classlist();
1.257     albertel 5778:     my $which=$env{'form.scantron_line'};
1.200     albertel 5779:     my $line=&scantron_get_line($scanlines,$scan_data,$which);
1.157     albertel 5780:     my ($skip,$err,$errmsg);
1.257     albertel 5781:     if ($env{'form.scantron_skip_record'}) {
1.157     albertel 5782: 	$skip=1;
1.257     albertel 5783:     } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
                   5784: 	my $newstudent=$env{'form.scantron_username'}.':'.
                   5785: 	    $env{'form.scantron_domain'};
1.157     albertel 5786: 	my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
                   5787: 	($line,$err,$errmsg)=
                   5788: 	    &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
                   5789: 				     'ID',{'newid'=>$newid,
1.257     albertel 5790: 				    'username'=>$env{'form.scantron_username'},
                   5791: 				    'domain'=>$env{'form.scantron_domain'}});
                   5792:     } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) {
                   5793: 	my $resolution=$env{'form.scantron_CODE_resolution'};
1.190     albertel 5794: 	my $newCODE;
1.192     albertel 5795: 	my %args;
1.190     albertel 5796: 	if      ($resolution eq 'use_unfound') {
1.191     albertel 5797: 	    $newCODE='use_unfound';
1.190     albertel 5798: 	} elsif ($resolution eq 'use_found') {
1.257     albertel 5799: 	    $newCODE=$env{'form.scantron_CODE_selectedvalue'};
1.190     albertel 5800: 	} elsif ($resolution eq 'use_typed') {
1.257     albertel 5801: 	    $newCODE=$env{'form.scantron_CODE_newvalue'};
1.194     albertel 5802: 	} elsif ($resolution =~ /^use_closest_(\d+)/) {
1.257     albertel 5803: 	    $newCODE=$env{"form.scantron_CODE_closest_$1"};
1.190     albertel 5804: 	}
1.257     albertel 5805: 	if ($env{'form.scantron_corrections'} eq 'duplicateCODE') {
1.192     albertel 5806: 	    $args{'CODE_ignore_dup'}=1;
                   5807: 	}
                   5808: 	$args{'CODE'}=$newCODE;
1.186     albertel 5809: 	($line,$err,$errmsg)=
                   5810: 	    &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
1.192     albertel 5811: 				     'CODE',\%args);
1.257     albertel 5812:     } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
                   5813: 	foreach my $question (split(',',$env{'form.scantron_questions'})) {
1.157     albertel 5814: 	    ($line,$err,$errmsg)=
                   5815: 		&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
                   5816: 					 $which,'answer',
                   5817: 					 { 'question'=>$question,
1.503     raeburn  5818: 		      		   'response'=>$env{"form.scantron_correct_Q_$question"},
                   5819:                                    'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}});
1.157     albertel 5820: 	    if ($err) { last; }
                   5821: 	}
                   5822:     }
                   5823:     if ($err) {
1.398     albertel 5824: 	$r->print("<span class=\"LC_warning\">Unable to accept last correction, an error occurred :$errmsg:</span>");
1.157     albertel 5825:     } else {
1.200     albertel 5826: 	&scantron_put_line($scanlines,$scan_data,$which,$line,$skip);
1.157     albertel 5827: 	&scantron_putfile($scanlines,$scan_data);
                   5828:     }
                   5829: }
                   5830: 
1.423     albertel 5831: =pod
                   5832: 
                   5833: =item reset_skipping_status
                   5834: 
1.424     albertel 5835:    Forgets the current set of remember skipped scanlines (and thus
                   5836:    reverts back to considering all lines in the
                   5837:    scantron_skipped_<filename> file)
                   5838: 
1.423     albertel 5839: =cut
                   5840: 
1.200     albertel 5841: sub reset_skipping_status {
                   5842:     my ($scanlines,$scan_data)=&scantron_getfile();
                   5843:     &scan_data($scan_data,'remember_skipping',undef,1);
                   5844:     &scantron_putfile(undef,$scan_data);
                   5845: }
                   5846: 
1.423     albertel 5847: =pod
                   5848: 
                   5849: =item start_skipping
                   5850: 
1.424     albertel 5851:    Marks a scanline to be skipped. 
                   5852: 
1.423     albertel 5853: =cut
                   5854: 
1.376     albertel 5855: sub start_skipping {
1.200     albertel 5856:     my ($scan_data,$i)=@_;
                   5857:     my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
1.376     albertel 5858:     if ($env{'form.scantron_options_redo'} =~ /^redo_/) {
                   5859: 	$remembered{$i}=2;
                   5860:     } else {
                   5861: 	$remembered{$i}=1;
                   5862:     }
1.200     albertel 5863:     &scan_data($scan_data,'remember_skipping',join(':',%remembered));
                   5864: }
                   5865: 
1.423     albertel 5866: =pod
                   5867: 
                   5868: =item should_be_skipped
                   5869: 
1.424     albertel 5870:    Checks whether a scanline should be skipped.
                   5871: 
1.423     albertel 5872: =cut
                   5873: 
1.200     albertel 5874: sub should_be_skipped {
1.376     albertel 5875:     my ($scanlines,$scan_data,$i)=@_;
1.257     albertel 5876:     if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
1.200     albertel 5877: 	# not redoing old skips
1.376     albertel 5878: 	if ($scanlines->{'skipped'}[$i]) { return 1; }
1.200     albertel 5879: 	return 0;
                   5880:     }
                   5881:     my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
1.376     albertel 5882: 
                   5883:     if (exists($remembered{$i}) && $remembered{$i} != 2 ) {
                   5884: 	return 0;
                   5885:     }
1.200     albertel 5886:     return 1;
                   5887: }
                   5888: 
1.423     albertel 5889: =pod
                   5890: 
                   5891: =item remember_current_skipped
                   5892: 
1.424     albertel 5893:    Discovers what scanlines are in the scantron_skipped_<filename>
                   5894:    file and remembers them into scan_data for later use.
                   5895: 
1.423     albertel 5896: =cut
                   5897: 
1.200     albertel 5898: sub remember_current_skipped {
                   5899:     my ($scanlines,$scan_data)=&scantron_getfile();
                   5900:     my %to_remember;
                   5901:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
                   5902: 	if ($scanlines->{'skipped'}[$i]) {
                   5903: 	    $to_remember{$i}=1;
                   5904: 	}
                   5905:     }
1.376     albertel 5906: 
1.200     albertel 5907:     &scan_data($scan_data,'remember_skipping',join(':',%to_remember));
                   5908:     &scantron_putfile(undef,$scan_data);
                   5909: }
                   5910: 
1.423     albertel 5911: =pod
                   5912: 
                   5913: =item check_for_error
                   5914: 
1.424     albertel 5915:     Checks if there was an error when attempting to remove a specific
                   5916:     scantron_.. bubble sheet data file. Prints out an error if
                   5917:     something went wrong.
                   5918: 
1.423     albertel 5919: =cut
                   5920: 
1.200     albertel 5921: sub check_for_error {
                   5922:     my ($r,$result)=@_;
                   5923:     if ($result ne 'ok' && $result ne 'not_found' ) {
1.492     albertel 5924: 	$r->print(&mt("An error occurred ([_1]) when trying to remove the existing corrections.",$result));
1.200     albertel 5925:     }
                   5926: }
1.157     albertel 5927: 
1.423     albertel 5928: =pod
                   5929: 
                   5930: =item scantron_warning_screen
                   5931: 
1.424     albertel 5932:    Interstitial screen to make sure the operator has selected the
                   5933:    correct options before we start the validation phase.
                   5934: 
1.423     albertel 5935: =cut
                   5936: 
1.203     albertel 5937: sub scantron_warning_screen {
                   5938:     my ($button_text)=@_;
1.257     albertel 5939:     my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});
1.284     albertel 5940:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.373     albertel 5941:     my $CODElist;
1.284     albertel 5942:     if ($scantron_config{'CODElocation'} &&
                   5943: 	$scantron_config{'CODEstart'} &&
                   5944: 	$scantron_config{'CODElength'}) {
                   5945: 	$CODElist=$env{'form.scantron_CODElist'};
1.398     albertel 5946: 	if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">None</span>'; }
1.284     albertel 5947: 	$CODElist=
1.492     albertel 5948: 	    '<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.
1.373     albertel 5949: 	    $env{'form.scantron_CODElist'}.'</tt></td></tr>';
1.284     albertel 5950:     }
1.492     albertel 5951:     return ('
1.203     albertel 5952: <p>
1.492     albertel 5953: <span class="LC_warning">
                   5954: '.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).'</span>
1.203     albertel 5955: </p>
                   5956: <table>
1.492     albertel 5957: <tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>
                   5958: <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>
                   5959: '.$CODElist.'
1.203     albertel 5960: </table>
                   5961: <br />
1.492     albertel 5962: <p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p>
                   5963: <p> '.&mt('If something is incorrect, please click the \'Grading Menu\' button to start over.').'</p>
1.203     albertel 5964: 
                   5965: <br />
1.492     albertel 5966: ');
1.203     albertel 5967: }
                   5968: 
1.423     albertel 5969: =pod
                   5970: 
                   5971: =item scantron_do_warning
                   5972: 
1.424     albertel 5973:    Check if the operator has picked something for all required
                   5974:    fields. Error out if something is missing.
                   5975: 
1.423     albertel 5976: =cut
                   5977: 
1.203     albertel 5978: sub scantron_do_warning {
                   5979:     my ($r)=@_;
1.324     albertel 5980:     my ($symb)=&get_symb($r);
1.203     albertel 5981:     if (!$symb) {return '';}
1.324     albertel 5982:     my $default_form_data=&defaultFormData($symb);
1.203     albertel 5983:     $r->print(&scantron_form_start().$default_form_data);
1.257     albertel 5984:     if ( $env{'form.selectpage'} eq '' ||
                   5985: 	 $env{'form.scantron_selectfile'} eq '' ||
                   5986: 	 $env{'form.scantron_format'} eq '' ) {
1.492     albertel 5987: 	$r->print("<p>".&mt('You have forgetten to specify some information. Please go Back and try again.')."</p>");
1.257     albertel 5988: 	if ( $env{'form.selectpage'} eq '') {
1.492     albertel 5989: 	    $r->print('<p><span class="LC_error">'.&mt('You have not selected a Sequence to grade').'</span></p>');
1.237     albertel 5990: 	} 
1.257     albertel 5991: 	if ( $env{'form.scantron_selectfile'} eq '') {
1.492     albertel 5992: 	    $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 5993: 	} 
1.257     albertel 5994: 	if ( $env{'form.scantron_format'} eq '') {
1.492     albertel 5995: 	    $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 5996: 	} 
                   5997:     } else {
1.265     www      5998: 	my $warning=&scantron_warning_screen('Grading: Validate Records');
1.492     albertel 5999: 	$r->print('
                   6000: '.$warning.'
                   6001: <input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />
1.203     albertel 6002: <input type="hidden" name="command" value="scantron_validate" />
1.492     albertel 6003: ');
1.237     albertel 6004:     }
1.352     albertel 6005:     $r->print("</form><br />".&show_grading_menu_form($symb));
1.203     albertel 6006:     return '';
                   6007: }
                   6008: 
1.423     albertel 6009: =pod
                   6010: 
                   6011: =item scantron_form_start
                   6012: 
1.424     albertel 6013:     html hidden input for remembering all selected grading options
                   6014: 
1.423     albertel 6015: =cut
                   6016: 
1.203     albertel 6017: sub scantron_form_start {
                   6018:     my ($max_bubble)=@_;
                   6019:     my $result= <<SCANTRONFORM;
                   6020: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
1.257     albertel 6021:   <input type="hidden" name="selectpage" value="$env{'form.selectpage'}" />
                   6022:   <input type="hidden" name="scantron_format" value="$env{'form.scantron_format'}" />
                   6023:   <input type="hidden" name="scantron_selectfile" value="$env{'form.scantron_selectfile'}" />
1.218     albertel 6024:   <input type="hidden" name="scantron_maxbubble" value="$max_bubble" />
1.257     albertel 6025:   <input type="hidden" name="scantron_CODElist" value="$env{'form.scantron_CODElist'}" />
                   6026:   <input type="hidden" name="scantron_CODEunique" value="$env{'form.scantron_CODEunique'}" />
                   6027:   <input type="hidden" name="scantron_options_redo" value="$env{'form.scantron_options_redo'}" />
                   6028:   <input type="hidden" name="scantron_options_ignore" value="$env{'form.scantron_options_ignore'}" />
1.331     albertel 6029:   <input type="hidden" name="scantron_options_hidden" value="$env{'form.scantron_options_hidden'}" />
1.203     albertel 6030: SCANTRONFORM
1.447     foxr     6031: 
                   6032:   my $line = 0;
                   6033:     while (defined($env{"form.scantron.bubblelines.$line"})) {
                   6034:        my $chunk =
                   6035: 	   '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n";
1.448     foxr     6036:        $chunk .=
                   6037: 	   '<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n";
1.503     raeburn  6038:        $chunk .= 
                   6039:            '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n";
1.504     raeburn  6040:        $chunk .=
                   6041:            '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n";
1.447     foxr     6042:        $result .= $chunk;
                   6043:        $line++;
                   6044:    }
1.203     albertel 6045:     return $result;
                   6046: }
                   6047: 
1.423     albertel 6048: =pod
                   6049: 
                   6050: =item scantron_validate_file
                   6051: 
1.424     albertel 6052:     Dispatch routine for doing validation of a bubble sheet data file.
                   6053: 
                   6054:     Also processes any necessary information resets that need to
                   6055:     occur before validation begins (ignore previous corrections,
                   6056:     restarting the skipped records processing)
                   6057: 
1.423     albertel 6058: =cut
                   6059: 
1.157     albertel 6060: sub scantron_validate_file {
                   6061:     my ($r) = @_;
1.324     albertel 6062:     my ($symb)=&get_symb($r);
1.157     albertel 6063:     if (!$symb) {return '';}
1.324     albertel 6064:     my $default_form_data=&defaultFormData($symb);
1.200     albertel 6065:     
                   6066:     # do the detection of only doing skipped records first befroe we delete
1.424     albertel 6067:     # them when doing the corrections reset
1.257     albertel 6068:     if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') {
1.200     albertel 6069: 	&reset_skipping_status();
                   6070:     }
1.257     albertel 6071:     if ($env{'form.scantron_options_redo'} eq 'redo_skipped') {
1.200     albertel 6072: 	&remember_current_skipped();
1.257     albertel 6073: 	$env{'form.scantron_options_redo'}='redo_skipped_ready';
1.200     albertel 6074:     }
                   6075: 
1.257     albertel 6076:     if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') {
1.200     albertel 6077: 	&check_for_error($r,&scantron_remove_file('corrected'));
                   6078: 	&check_for_error($r,&scantron_remove_file('skipped'));
                   6079: 	&check_for_error($r,&scantron_remove_scan_data());
1.257     albertel 6080: 	$env{'form.scantron_options_ignore'}='done';
1.192     albertel 6081:     }
1.200     albertel 6082: 
1.257     albertel 6083:     if ($env{'form.scantron_corrections'}) {
1.157     albertel 6084: 	&scantron_process_corrections($r);
                   6085:     }
1.503     raeburn  6086:     $r->print('<p>'.&mt('Gathering necessary information.').'</p>');$r->rflush();
1.157     albertel 6087:     #get the student pick code ready
                   6088:     $r->print(&Apache::loncommon::studentbrowser_javascript());
1.330     albertel 6089:     my $max_bubble=&scantron_get_maxbubble();
1.203     albertel 6090:     my $result=&scantron_form_start($max_bubble).$default_form_data;
1.157     albertel 6091:     $r->print($result);
                   6092:     
1.334     albertel 6093:     my @validate_phases=( 'sequence',
                   6094: 			  'ID',
1.157     albertel 6095: 			  'CODE',
                   6096: 			  'doublebubble',
                   6097: 			  'missingbubbles');
1.257     albertel 6098:     if (!$env{'form.validatepass'}) {
                   6099: 	$env{'form.validatepass'} = 0;
1.157     albertel 6100:     }
1.257     albertel 6101:     my $currentphase=$env{'form.validatepass'};
1.157     albertel 6102: 
1.448     foxr     6103: 
1.157     albertel 6104:     my $stop=0;
                   6105:     while (!$stop && $currentphase < scalar(@validate_phases)) {
1.503     raeburn  6106: 	$r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />');
1.157     albertel 6107: 	$r->rflush();
                   6108: 	my $which="scantron_validate_".$validate_phases[$currentphase];
                   6109: 	{
                   6110: 	    no strict 'refs';
                   6111: 	    ($stop,$currentphase)=&$which($r,$currentphase);
                   6112: 	}
                   6113:     }
                   6114:     if (!$stop) {
1.203     albertel 6115: 	my $warning=&scantron_warning_screen('Start Grading');
1.512     www      6116: 	$r->print(&mt('Validation process complete.').'<br />
1.492     albertel 6117: '.$warning.'
                   6118: <input type="submit" name="submit" value="'.&mt('Start Grading').'" />
1.203     albertel 6119: <input type="hidden" name="command" value="scantron_process" />
1.492     albertel 6120: ');
1.203     albertel 6121: 
1.157     albertel 6122:     } else {
                   6123: 	$r->print('<input type="hidden" name="command" value="scantron_validate" />');
                   6124: 	$r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
                   6125:     }
                   6126:     if ($stop) {
1.334     albertel 6127: 	if ($validate_phases[$currentphase] eq 'sequence') {
1.492     albertel 6128: 	    $r->print('<input type="submit" name="submit" value="'.&mt('Ignore -&gt;').' " />');
                   6129: 	    $r->print(' '.&mt('this error').' <br />');
1.334     albertel 6130: 
1.492     albertel 6131: 	    $r->print(" <p>".&mt("Or click the 'Grading Menu' button to start over.")."</p>");
1.334     albertel 6132: 	} else {
1.503     raeburn  6133:             if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') {
                   6134: 	        $r->print('<input type="button" name="submitbutton" value="'.&mt('Continue -&gt;').'" onclick="javascript:verify_bubble_radio(this.form)" />');
                   6135:             } else {
                   6136:                 $r->print('<input type="submit" name="submit" value="'.&mt('Continue -&gt;').'" />');
                   6137:             }
1.492     albertel 6138: 	    $r->print(' '.&mt('using corrected info').' <br />');
                   6139: 	    $r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />");
                   6140: 	    $r->print(" ".&mt("this scanline saving it for later."));
1.334     albertel 6141: 	}
1.157     albertel 6142:     }
1.352     albertel 6143:     $r->print(" </form><br />".&show_grading_menu_form($symb));
1.157     albertel 6144:     return '';
                   6145: }
                   6146: 
1.423     albertel 6147: 
                   6148: =pod
                   6149: 
                   6150: =item scantron_remove_file
                   6151: 
1.424     albertel 6152:    Removes the requested bubble sheet data file, makes sure that
                   6153:    scantron_original_<filename> is never removed
                   6154: 
                   6155: 
1.423     albertel 6156: =cut
                   6157: 
1.200     albertel 6158: sub scantron_remove_file {
1.192     albertel 6159:     my ($which)=@_;
1.257     albertel 6160:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6161:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.192     albertel 6162:     my $file='scantron_';
1.200     albertel 6163:     if ($which eq 'corrected' || $which eq 'skipped') {
                   6164: 	$file.=$which.'_';
1.192     albertel 6165:     } else {
                   6166: 	return 'refused';
                   6167:     }
1.257     albertel 6168:     $file.=$env{'form.scantron_selectfile'};
1.200     albertel 6169:     return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
                   6170: }
                   6171: 
1.423     albertel 6172: 
                   6173: =pod
                   6174: 
                   6175: =item scantron_remove_scan_data
                   6176: 
1.424     albertel 6177:    Removes all scan_data correction for the requested bubble sheet
                   6178:    data file.  (In the case that both the are doing skipped records we need
                   6179:    to remember the old skipped lines for the time being so that element
                   6180:    persists for a while.)
                   6181: 
1.423     albertel 6182: =cut
                   6183: 
1.200     albertel 6184: sub scantron_remove_scan_data {
1.257     albertel 6185:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6186:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.192     albertel 6187:     my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname);
                   6188:     my @todelete;
1.257     albertel 6189:     my $filename=$env{'form.scantron_selectfile'};
1.192     albertel 6190:     foreach my $key (@keys) {
                   6191: 	if ($key=~/^\Q$filename\E_/) {
1.257     albertel 6192: 	    if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' &&
1.200     albertel 6193: 		$key=~/remember_skipping/) {
                   6194: 		next;
                   6195: 	    }
1.192     albertel 6196: 	    push(@todelete,$key);
                   6197: 	}
                   6198:     }
1.200     albertel 6199:     my $result;
1.192     albertel 6200:     if (@todelete) {
1.491     albertel 6201: 	$result = &Apache::lonnet::del('nohist_scantrondata',
                   6202: 				       \@todelete,$cdom,$cname);
                   6203:     } else {
                   6204: 	$result = 'ok';
1.192     albertel 6205:     }
                   6206:     return $result;
                   6207: }
                   6208: 
1.423     albertel 6209: 
                   6210: =pod
                   6211: 
                   6212: =item scantron_getfile
                   6213: 
1.424     albertel 6214:     Fetches the requested bubble sheet data file (all 3 versions), and
                   6215:     the scan_data hash
                   6216:   
                   6217:   Arguments:
                   6218:     None
                   6219: 
                   6220:   Returns:
                   6221:     2 hash references
                   6222: 
                   6223:      - first one has 
                   6224:          orig      -
                   6225:          corrected -
                   6226:          skipped   -  each of which points to an array ref of the specified
                   6227:                       file broken up into individual lines
                   6228:          count     - number of scanlines
                   6229:  
                   6230:      - second is the scan_data hash possible keys are
1.425     albertel 6231:        ($number refers to scanline numbered $number and thus the key affects
                   6232:         only that scanline
                   6233:         $bubline refers to the specific bubble line element and the aspects
                   6234:         refers to that specific bubble line element)
                   6235: 
                   6236:        $number.user - username:domain to use
                   6237:        $number.CODE_ignore_dup 
                   6238:                     - ignore the duplicate CODE error 
                   6239:        $number.useCODE
                   6240:                     - use the CODE in the scanline as is
                   6241:        $number.no_bubble.$bubline
                   6242:                     - it is valid that there is no bubbled in bubble
                   6243:                       at $number $bubline
                   6244:        remember_skipping
                   6245:                     - a frozen hash containing keys of $number and values
                   6246:                       of either 
                   6247:                         1 - we are on a 'do skipped records pass' and plan
                   6248:                             on processing this line
                   6249:                         2 - we are on a 'do skipped records pass' and this
                   6250:                             scanline has been marked to skip yet again
1.424     albertel 6251: 
1.423     albertel 6252: =cut
                   6253: 
1.157     albertel 6254: sub scantron_getfile {
1.200     albertel 6255:     #FIXME really would prefer a scantron directory
1.257     albertel 6256:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6257:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.157     albertel 6258:     my $lines;
                   6259:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6260: 		       'scantron_orig_'.$env{'form.scantron_selectfile'});
1.157     albertel 6261:     my %scanlines;
                   6262:     $scanlines{'orig'}=[(split("\n",$lines,-1))];
                   6263:     my $temp=$scanlines{'orig'};
                   6264:     $scanlines{'count'}=$#$temp;
                   6265: 
                   6266:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6267: 		       'scantron_corrected_'.$env{'form.scantron_selectfile'});
1.157     albertel 6268:     if ($lines eq '-1') {
                   6269: 	$scanlines{'corrected'}=[];
                   6270:     } else {
                   6271: 	$scanlines{'corrected'}=[(split("\n",$lines,-1))];
                   6272:     }
                   6273:     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
1.257     albertel 6274: 		       'scantron_skipped_'.$env{'form.scantron_selectfile'});
1.157     albertel 6275:     if ($lines eq '-1') {
                   6276: 	$scanlines{'skipped'}=[];
                   6277:     } else {
                   6278: 	$scanlines{'skipped'}=[(split("\n",$lines,-1))];
                   6279:     }
1.175     albertel 6280:     my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname);
1.157     albertel 6281:     if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
                   6282:     my %scan_data = @tmp;
                   6283:     return (\%scanlines,\%scan_data);
                   6284: }
                   6285: 
1.423     albertel 6286: =pod
                   6287: 
                   6288: =item lonnet_putfile
                   6289: 
1.424     albertel 6290:    Wrapper routine to call &Apache::lonnet::finishuserfileupload
                   6291: 
                   6292:  Arguments:
                   6293:    $contents - data to store
                   6294:    $filename - filename to store $contents into
                   6295: 
                   6296:  Returns:
                   6297:    result value from &Apache::lonnet::finishuserfileupload
                   6298: 
1.423     albertel 6299: =cut
                   6300: 
1.157     albertel 6301: sub lonnet_putfile {
                   6302:     my ($contents,$filename)=@_;
1.257     albertel 6303:     my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6304:     my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   6305:     $env{'form.sillywaytopassafilearound'}=$contents;
1.275     albertel 6306:     &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename);
1.157     albertel 6307: 
                   6308: }
                   6309: 
1.423     albertel 6310: =pod
                   6311: 
                   6312: =item scantron_putfile
                   6313: 
1.424     albertel 6314:     Stores the current version of the bubble sheet data files, and the
                   6315:     scan_data hash. (Does not modify the original version only the
                   6316:     corrected and skipped versions.
                   6317: 
                   6318:  Arguments:
                   6319:     $scanlines - hash ref that looks like the first return value from
                   6320:                  &scantron_getfile()
                   6321:     $scan_data - hash ref that looks like the second return value from
                   6322:                  &scantron_getfile()
                   6323: 
1.423     albertel 6324: =cut
                   6325: 
1.157     albertel 6326: sub scantron_putfile {
                   6327:     my ($scanlines,$scan_data) = @_;
1.200     albertel 6328:     #FIXME really would prefer a scantron directory
1.257     albertel 6329:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   6330:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.200     albertel 6331:     if ($scanlines) {
                   6332: 	my $prefix='scantron_';
1.157     albertel 6333: # no need to update orig, shouldn't change
                   6334: #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
1.257     albertel 6335: #		    $env{'form.scantron_selectfile'});
1.200     albertel 6336: 	&lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
                   6337: 			$prefix.'corrected_'.
1.257     albertel 6338: 			$env{'form.scantron_selectfile'});
1.200     albertel 6339: 	&lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
                   6340: 			$prefix.'skipped_'.
1.257     albertel 6341: 			$env{'form.scantron_selectfile'});
1.200     albertel 6342:     }
1.175     albertel 6343:     &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
1.157     albertel 6344: }
                   6345: 
1.423     albertel 6346: =pod
                   6347: 
                   6348: =item scantron_get_line
                   6349: 
1.424     albertel 6350:    Returns the correct version of the scanline
                   6351: 
                   6352:  Arguments:
                   6353:     $scanlines - hash ref that looks like the first return value from
                   6354:                  &scantron_getfile()
                   6355:     $scan_data - hash ref that looks like the second return value from
                   6356:                  &scantron_getfile()
                   6357:     $i         - number of the requested line (starts at 0)
                   6358: 
                   6359:  Returns:
                   6360:    A scanline, (either the original or the corrected one if it
                   6361:    exists), or undef if the requested scanline should be
                   6362:    skipped. (Either because it's an skipped scanline, or it's an
                   6363:    unskipped scanline and we are not doing a 'do skipped scanlines'
                   6364:    pass.
                   6365: 
1.423     albertel 6366: =cut
                   6367: 
1.157     albertel 6368: sub scantron_get_line {
1.200     albertel 6369:     my ($scanlines,$scan_data,$i)=@_;
1.376     albertel 6370:     if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; }
                   6371:     #if ($scanlines->{'skipped'}[$i]) { return undef; }
1.157     albertel 6372:     if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
                   6373:     return $scanlines->{'orig'}[$i]; 
                   6374: }
                   6375: 
1.423     albertel 6376: =pod
                   6377: 
                   6378: =item scantron_todo_count
                   6379: 
1.424     albertel 6380:     Counts the number of scanlines that need processing.
                   6381: 
                   6382:  Arguments:
                   6383:     $scanlines - hash ref that looks like the first return value from
                   6384:                  &scantron_getfile()
                   6385:     $scan_data - hash ref that looks like the second return value from
                   6386:                  &scantron_getfile()
                   6387: 
                   6388:  Returns:
                   6389:     $count - number of scanlines to process
                   6390: 
1.423     albertel 6391: =cut
                   6392: 
1.200     albertel 6393: sub get_todo_count {
                   6394:     my ($scanlines,$scan_data)=@_;
                   6395:     my $count=0;
                   6396:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
                   6397: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
                   6398: 	if ($line=~/^[\s\cz]*$/) { next; }
                   6399: 	$count++;
                   6400:     }
                   6401:     return $count;
                   6402: }
                   6403: 
1.423     albertel 6404: =pod
                   6405: 
                   6406: =item scantron_put_line
                   6407: 
1.424     albertel 6408:     Updates the 'corrected' or 'skipped' versions of the bubble sheet
                   6409:     data file.
                   6410: 
                   6411:  Arguments:
                   6412:     $scanlines - hash ref that looks like the first return value from
                   6413:                  &scantron_getfile()
                   6414:     $scan_data - hash ref that looks like the second return value from
                   6415:                  &scantron_getfile()
                   6416:     $i         - line number to update
                   6417:     $newline   - contents of the updated scanline
                   6418:     $skip      - if true make the line for skipping and update the
                   6419:                  'skipped' file
                   6420: 
1.423     albertel 6421: =cut
                   6422: 
1.157     albertel 6423: sub scantron_put_line {
1.200     albertel 6424:     my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
1.157     albertel 6425:     if ($skip) {
                   6426: 	$scanlines->{'skipped'}[$i]=$newline;
1.376     albertel 6427: 	&start_skipping($scan_data,$i);
1.157     albertel 6428: 	return;
                   6429:     }
                   6430:     $scanlines->{'corrected'}[$i]=$newline;
                   6431: }
                   6432: 
1.423     albertel 6433: =pod
                   6434: 
                   6435: =item scantron_clear_skip
                   6436: 
1.424     albertel 6437:    Remove a line from the 'skipped' file
                   6438: 
                   6439:  Arguments:
                   6440:     $scanlines - hash ref that looks like the first return value from
                   6441:                  &scantron_getfile()
                   6442:     $scan_data - hash ref that looks like the second return value from
                   6443:                  &scantron_getfile()
                   6444:     $i         - line number to update
                   6445: 
1.423     albertel 6446: =cut
                   6447: 
1.376     albertel 6448: sub scantron_clear_skip {
                   6449:     my ($scanlines,$scan_data,$i)=@_;
                   6450:     if (exists($scanlines->{'skipped'}[$i])) {
                   6451: 	undef($scanlines->{'skipped'}[$i]);
                   6452: 	return 1;
                   6453:     }
                   6454:     return 0;
                   6455: }
                   6456: 
1.423     albertel 6457: =pod
                   6458: 
                   6459: =item scantron_filter_not_exam
                   6460: 
1.424     albertel 6461:    Filter routine used by &Apache::lonnavmaps::retrieveResources(), to
                   6462:    filter out resources that are not marked as 'exam' mode
                   6463: 
1.423     albertel 6464: =cut
                   6465: 
1.334     albertel 6466: sub scantron_filter_not_exam {
                   6467:     my ($curres)=@_;
                   6468:     
                   6469:     if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) {
                   6470: 	# if the user has asked to not have either hidden
                   6471: 	# or 'randomout' controlled resources to be graded
                   6472: 	# don't include them
                   6473: 	if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
                   6474: 	    && $curres->randomout) {
                   6475: 	    return 0;
                   6476: 	}
                   6477: 	return 1;
                   6478:     }
                   6479:     return 0;
                   6480: }
                   6481: 
1.423     albertel 6482: =pod
                   6483: 
                   6484: =item scantron_validate_sequence
                   6485: 
1.424     albertel 6486:     Validates the selected sequence, checking for resource that are
                   6487:     not set to exam mode.
                   6488: 
1.423     albertel 6489: =cut
                   6490: 
1.334     albertel 6491: sub scantron_validate_sequence {
                   6492:     my ($r,$currentphase) = @_;
                   6493: 
                   6494:     my $navmap=Apache::lonnavmaps::navmap->new();
                   6495:     my (undef,undef,$sequence)=
                   6496: 	&Apache::lonnet::decode_symb($env{'form.selectpage'});
                   6497: 
                   6498:     my $map=$navmap->getResourceByUrl($sequence);
                   6499: 
                   6500:     $r->print('<input type="hidden" name="validate_sequence_exam"
                   6501:                                     value="ignore" />');
                   6502:     if ($env{'form.validate_sequence_exam'} ne 'ignore') {
                   6503: 	my @resources=
                   6504: 	    $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
                   6505: 	if (@resources) {
1.357     banghart 6506: 	    $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 6507: 	    return (1,$currentphase);
                   6508: 	}
                   6509:     }
                   6510: 
                   6511:     return (0,$currentphase+1);
                   6512: }
                   6513: 
1.423     albertel 6514: =pod
                   6515: 
                   6516: =item scantron_validate_ID
                   6517: 
1.424     albertel 6518:    Validates all scanlines in the selected file to not have any
                   6519:    invalid or underspecified student IDs
                   6520: 
1.423     albertel 6521: =cut
                   6522: 
1.157     albertel 6523: sub scantron_validate_ID {
                   6524:     my ($r,$currentphase) = @_;
                   6525:     
                   6526:     #get student info
                   6527:     my $classlist=&Apache::loncoursedata::get_classlist();
                   6528:     my %idmap=&username_to_idmap($classlist);
                   6529: 
                   6530:     #get scantron line setup
1.257     albertel 6531:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 6532:     my ($scanlines,$scan_data)=&scantron_getfile();
1.447     foxr     6533:     
                   6534:     &scantron_get_maxbubble();	# parse needs the bubble_lines.. array.
1.157     albertel 6535: 
                   6536:     my %found=('ids'=>{},'usernames'=>{});
                   6537:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 6538: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 6539: 	if ($line=~/^[\s\cz]*$/) { next; }
                   6540: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   6541: 						 $scan_data);
                   6542: 	my $id=$$scan_record{'scantron.ID'};
                   6543: 	my $found;
                   6544: 	foreach my $checkid (keys(%idmap)) {
                   6545: 	    if (lc($checkid) eq lc($id)) { $found=$checkid;last; }
                   6546: 	}
                   6547: 	if ($found) {
                   6548: 	    my $username=$idmap{$found};
                   6549: 	    if ($found{'ids'}{$found}) {
                   6550: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6551: 					 $line,'duplicateID',$found);
1.194     albertel 6552: 		return(1,$currentphase);
1.157     albertel 6553: 	    } elsif ($found{'usernames'}{$username}) {
                   6554: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6555: 					 $line,'duplicateID',$username);
1.194     albertel 6556: 		return(1,$currentphase);
1.157     albertel 6557: 	    }
1.186     albertel 6558: 	    #FIXME store away line we previously saw the ID on to use above
1.157     albertel 6559: 	    $found{'ids'}{$found}++;
                   6560: 	    $found{'usernames'}{$username}++;
                   6561: 	} else {
                   6562: 	    if ($id =~ /^\s*$/) {
1.158     albertel 6563: 		my $username=&scan_data($scan_data,"$i.user");
1.157     albertel 6564: 		if (defined($username) && $found{'usernames'}{$username}) {
                   6565: 		    &scantron_get_correction($r,$i,$scan_record,
                   6566: 					     \%scantron_config,
                   6567: 					     $line,'duplicateID',$username);
1.194     albertel 6568: 		    return(1,$currentphase);
1.157     albertel 6569: 		} elsif (!defined($username)) {
                   6570: 		    &scantron_get_correction($r,$i,$scan_record,
                   6571: 					     \%scantron_config,
                   6572: 					     $line,'incorrectID');
1.194     albertel 6573: 		    return(1,$currentphase);
1.157     albertel 6574: 		}
                   6575: 		$found{'usernames'}{$username}++;
                   6576: 	    } else {
                   6577: 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   6578: 					 $line,'incorrectID');
1.194     albertel 6579: 		return(1,$currentphase);
1.157     albertel 6580: 	    }
                   6581: 	}
                   6582:     }
                   6583: 
                   6584:     return (0,$currentphase+1);
                   6585: }
                   6586: 
1.423     albertel 6587: =pod
                   6588: 
                   6589: =item scantron_get_correction
                   6590: 
1.424     albertel 6591:    Builds the interface screen to interact with the operator to fix a
                   6592:    specific error condition in a specific scanline
                   6593: 
                   6594:  Arguments:
                   6595:     $r           - Apache request object
                   6596:     $i           - number of the current scanline
                   6597:     $scan_record - hash ref as returned from &scantron_parse_scanline()
                   6598:     $scan_config - hash ref as returned from &get_scantron_config()
                   6599:     $line        - full contents of the current scanline
                   6600:     $error       - error condition, valid values are
                   6601:                    'incorrectCODE', 'duplicateCODE',
                   6602:                    'doublebubble', 'missingbubble',
                   6603:                    'duplicateID', 'incorrectID'
                   6604:     $arg         - extra information needed
                   6605:        For errors:
                   6606:          - duplicateID   - paper number that this studentID was seen before on
                   6607:          - duplicateCODE - array ref of the paper numbers this CODE was
                   6608:                            seen on before
                   6609:          - incorrectCODE - current incorrect CODE 
                   6610:          - doublebubble  - array ref of the bubble lines that have double
                   6611:                            bubble errors
                   6612:          - missingbubble - array ref of the bubble lines that have missing
                   6613:                            bubble errors
                   6614: 
1.423     albertel 6615: =cut
                   6616: 
1.157     albertel 6617: sub scantron_get_correction {
                   6618:     my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;
1.454     banghart 6619: #FIXME in the case of a duplicated ID the previous line, probably need
1.157     albertel 6620: #to show both the current line and the previous one and allow skipping
                   6621: #the previous one or the current one
                   6622: 
1.333     albertel 6623:     if ( $$scan_record{'scantron.PaperID'} =~ /\S/) {
1.492     albertel 6624: 	$r->print("<p>".&mt("<b>An error was detected ($error)</b>".
                   6625: 			    " for PaperID <tt>[_1]</tt>",
                   6626: 			    $$scan_record{'scantron.PaperID'})."</p> \n");
1.157     albertel 6627:     } else {
1.492     albertel 6628: 	$r->print("<p>".&mt("<b>An error was detected ($error)</b>".
                   6629: 			    " in scanline [_1] <pre>[_2]</pre>",
                   6630: 			    $i,$line)."</p> \n");
                   6631:     }
                   6632:     my $message="<p>".&mt("The ID on the form is  <tt>[_1]</tt><br />".
                   6633: 			  "The name on the paper is [_2],[_3]",
                   6634: 			  $$scan_record{'scantron.ID'},
                   6635: 			  $$scan_record{'scantron.LastName'},
                   6636: 			  $$scan_record{'scantron.FirstName'})."</p>";
1.242     albertel 6637: 
1.157     albertel 6638:     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
                   6639:     $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
1.503     raeburn  6640:                            # Array populated for doublebubble or
                   6641:     my @lines_to_correct;  # missingbubble errors to build javascript
                   6642:                            # to validate radio button checking   
                   6643: 
1.157     albertel 6644:     if ($error =~ /ID$/) {
1.186     albertel 6645: 	if ($error eq 'incorrectID') {
1.492     albertel 6646: 	    $r->print("<p>".&mt("The encoded ID is not in the classlist").
                   6647: 		      "</p>\n");
1.157     albertel 6648: 	} elsif ($error eq 'duplicateID') {
1.492     albertel 6649: 	    $r->print("<p>".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n");
1.157     albertel 6650: 	}
1.242     albertel 6651: 	$r->print($message);
1.492     albertel 6652: 	$r->print("<p>".&mt("How should I handle this?")." <br /> \n");
1.157     albertel 6653: 	$r->print("\n<ul><li> ");
                   6654: 	#FIXME it would be nice if this sent back the user ID and
                   6655: 	#could do partial userID matches
                   6656: 	$r->print(&Apache::loncommon::selectstudent_link('scantronupload',
                   6657: 				       'scantron_username','scantron_domain'));
                   6658: 	$r->print(": <input type='text' name='scantron_username' value='' />");
                   6659: 	$r->print("\n@".
1.257     albertel 6660: 		 &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));
1.157     albertel 6661: 
                   6662: 	$r->print('</li>');
1.186     albertel 6663:     } elsif ($error =~ /CODE$/) {
                   6664: 	if ($error eq 'incorrectCODE') {
1.492     albertel 6665: 	    $r->print("<p>".&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n");
1.186     albertel 6666: 	} elsif ($error eq 'duplicateCODE') {
1.492     albertel 6667: 	    $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 6668: 	}
1.492     albertel 6669: 	$r->print("<p>".&mt("The CODE on the form is  <tt>'[_1]'</tt>",
                   6670: 			    $$scan_record{'scantron.CODE'})."<br />\n");
1.242     albertel 6671: 	$r->print($message);
1.492     albertel 6672: 	$r->print("<p>".&mt("How should I handle this?")." <br /> \n");
1.187     albertel 6673: 	$r->print("\n<br /> ");
1.194     albertel 6674: 	my $i=0;
1.273     albertel 6675: 	if ($error eq 'incorrectCODE' 
                   6676: 	    && $$scan_record{'scantron.CODE'}=~/\S/ ) {
1.194     albertel 6677: 	    my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'});
1.278     albertel 6678: 	    if ($closest > 0) {
                   6679: 		foreach my $testcode (@{$closest}) {
                   6680: 		    my $checked='';
1.401     albertel 6681: 		    if (!$i) { $checked=' checked="checked" '; }
1.492     albertel 6682: 		    $r->print("
                   6683:    <label>
                   6684:        <input type='radio' name='scantron_CODE_resolution' value='use_closest_$i' $checked />
                   6685:        ".&mt("Use the similar CODE [_1] instead.",
                   6686: 	    "<b><tt>".$testcode."</tt></b>")."
                   6687:     </label>
                   6688:     <input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />");
1.278     albertel 6689: 		    $r->print("\n<br />");
                   6690: 		    $i++;
                   6691: 		}
1.194     albertel 6692: 	    }
                   6693: 	}
1.273     albertel 6694: 	if ($$scan_record{'scantron.CODE'}=~/\S/ ) {
1.401     albertel 6695: 	    my $checked; if (!$i) { $checked=' checked="checked" '; }
1.492     albertel 6696: 	    $r->print("
                   6697:     <label>
                   6698:         <input type='radio' name='scantron_CODE_resolution' value='use_unfound' $checked />
                   6699:        ".&mt("Use the CODE [_1] that is was on the paper, ignoring the error.",
                   6700: 	     "<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")."
                   6701:     </label>");
1.273     albertel 6702: 	    $r->print("\n<br />");
                   6703: 	}
1.194     albertel 6704: 
1.188     albertel 6705: 	$r->print(<<ENDSCRIPT);
                   6706: <script type="text/javascript">
                   6707: function change_radio(field) {
1.190     albertel 6708:     var slct=document.scantronupload.scantron_CODE_resolution;
1.188     albertel 6709:     var i;
                   6710:     for (i=0;i<slct.length;i++) {
                   6711:         if (slct[i].value==field) { slct[i].checked=true; }
                   6712:     }
                   6713: }
                   6714: </script>
                   6715: ENDSCRIPT
1.187     albertel 6716: 	my $href="/adm/pickcode?".
1.359     www      6717: 	   "form=".&escape("scantronupload").
                   6718: 	   "&scantron_format=".&escape($env{'form.scantron_format'}).
                   6719: 	   "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}).
                   6720: 	   "&curCODE=".&escape($$scan_record{'scantron.CODE'}).
                   6721: 	   "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'});
1.332     albertel 6722: 	if ($env{'form.scantron_CODElist'} =~ /\S/) { 
1.492     albertel 6723: 	    $r->print("
                   6724:     <label>
                   6725:        <input type='radio' name='scantron_CODE_resolution' value='use_found' />
                   6726:        ".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.",
                   6727: 	     "<a target='_blank' href='$href'>","</a>")."
                   6728:     </label> 
                   6729:     ".&mt("Selected CODE is [_1]","<input readonly='true' type='text' size='8' name='scantron_CODE_selectedvalue' onfocus=\"javascript:change_radio('use_found')\" onchange=\"javascript:change_radio('use_found')\" />"));
1.332     albertel 6730: 	    $r->print("\n<br />");
                   6731: 	}
1.492     albertel 6732: 	$r->print("
                   6733:     <label>
                   6734:        <input type='radio' name='scantron_CODE_resolution' value='use_typed' />
                   6735:        ".&mt("Use [_1] as the CODE.",
                   6736: 	     "</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 6737: 	$r->print("\n<br /><br />");
1.157     albertel 6738:     } elsif ($error eq 'doublebubble') {
1.503     raeburn  6739: 	$r->print("<p>".&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n");
1.497     foxr     6740: 
                   6741: 	# The form field scantron_questions is acutally a list of line numbers.
                   6742: 	# represented by this form so:
                   6743: 
                   6744: 	my $line_list = &questions_to_line_list($arg);
                   6745: 
1.157     albertel 6746: 	$r->print('<input type="hidden" name="scantron_questions" value="'.
1.497     foxr     6747: 		  $line_list.'" />');
1.242     albertel 6748: 	$r->print($message);
1.492     albertel 6749: 	$r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>");
1.157     albertel 6750: 	foreach my $question (@{$arg}) {
1.503     raeburn  6751: 	    my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                   6752:                                                    $scan_record, $error);
                   6753:             push (@lines_to_correct,@linenums);
1.157     albertel 6754: 	}
1.503     raeburn  6755:         $r->print(&verify_bubbles_checked(@lines_to_correct));
1.157     albertel 6756:     } elsif ($error eq 'missingbubble') {
1.492     albertel 6757: 	$r->print("<p>".&mt("There have been <b>no</b> bubbles scanned for some question(s)")."</p>\n");
1.242     albertel 6758: 	$r->print($message);
1.492     albertel 6759: 	$r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>");
1.503     raeburn  6760: 	$r->print(&mt("Some questions have no scanned bubbles.")."\n");
1.497     foxr     6761: 
1.503     raeburn  6762: 	# The form field scantron_questions is actually a list of line numbers not
1.497     foxr     6763: 	# a list of question numbers. Therefore:
                   6764: 	#
                   6765: 	
                   6766: 	my $line_list = &questions_to_line_list($arg);
                   6767: 
1.157     albertel 6768: 	$r->print('<input type="hidden" name="scantron_questions" value="'.
1.497     foxr     6769: 		  $line_list.'" />');
1.157     albertel 6770: 	foreach my $question (@{$arg}) {
1.503     raeburn  6771: 	    my @linenums = &prompt_for_corrections($r,$question,$scan_config,
                   6772:                                                    $scan_record, $error);
                   6773:             push (@lines_to_correct,@linenums);
1.157     albertel 6774: 	}
1.503     raeburn  6775:         $r->print(&verify_bubbles_checked(@lines_to_correct));
1.157     albertel 6776:     } else {
                   6777: 	$r->print("\n<ul>");
                   6778:     }
                   6779:     $r->print("\n</li></ul>");
1.497     foxr     6780: }
                   6781: 
1.503     raeburn  6782: sub verify_bubbles_checked {
                   6783:     my (@ansnums) = @_;
                   6784:     my $ansnumstr = join('","',@ansnums);
                   6785:     my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines.");
                   6786:     my $output = (<<ENDSCRIPT);
                   6787: <script type="text/javascript">
                   6788: function verify_bubble_radio(form) {
                   6789:     var ansnumArray = new Array ("$ansnumstr");
                   6790:     var need_bubble_count = 0;
                   6791:     for (var i=0; i<ansnumArray.length; i++) {
                   6792:         if (form.elements["scantron_correct_Q_"+ansnumArray[i]].length > 1) {
                   6793:             var bubble_picked = 0; 
                   6794:             for (var j=0; j<form.elements["scantron_correct_Q_"+ansnumArray[i]].length; j++) {
                   6795:                 if (form.elements["scantron_correct_Q_"+ansnumArray[i]][j].checked == true) {
                   6796:                     bubble_picked = 1;
                   6797:                 }
                   6798:             }
                   6799:             if (bubble_picked == 0) {
                   6800:                 need_bubble_count ++;
                   6801:             }
                   6802:         }
                   6803:     }
                   6804:     if (need_bubble_count) {
                   6805:         alert("$warning");
                   6806:         return;
                   6807:     }
                   6808:     form.submit(); 
                   6809: }
                   6810: </script>
                   6811: ENDSCRIPT
                   6812:     return $output;
                   6813: }
                   6814: 
1.497     foxr     6815: =pod
                   6816: 
                   6817: =item  questions_to_line_list
1.157     albertel 6818: 
1.497     foxr     6819: Converts a list of questions into a string of comma separated
                   6820: line numbers in the answer sheet used by the questions.  This is
                   6821: used to fill in the scantron_questions form field.
                   6822: 
                   6823:   Arguments:
                   6824:      questions    - Reference to an array of questions.
                   6825: 
                   6826: =cut
                   6827: 
                   6828: 
                   6829: sub questions_to_line_list {
                   6830:     my ($questions) = @_;
                   6831:     my @lines;
                   6832: 
1.503     raeburn  6833:     foreach my $item (@{$questions}) {
                   6834:         my $question = $item;
                   6835:         my ($first,$count,$last);
                   6836:         if ($item =~ /^(\d+)\.(\d+)$/) {
                   6837:             $question = $1;
                   6838:             my $subquestion = $2;
                   6839:             $first = $first_bubble_line{$question-1} + 1;
                   6840:             my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   6841:             my $subcount = 1;
                   6842:             while ($subcount<$subquestion) {
                   6843:                 $first += $subans[$subcount-1];
                   6844:                 $subcount ++;
                   6845:             }
                   6846:             $count = $subans[$subquestion-1];
                   6847:         } else {
                   6848: 	    $first   = $first_bubble_line{$question-1} + 1;
                   6849: 	    $count   = $bubble_lines_per_response{$question-1};
                   6850:         }
1.506     raeburn  6851:         $last = $first+$count-1;
1.503     raeburn  6852:         push(@lines, ($first..$last));
1.497     foxr     6853:     }
                   6854:     return join(',', @lines);
                   6855: }
                   6856: 
                   6857: =pod 
                   6858: 
                   6859: =item prompt_for_corrections
                   6860: 
                   6861: Prompts for a potentially multiline correction to the
                   6862: user's bubbling (factors out common code from scantron_get_correction
                   6863: for multi and missing bubble cases).
                   6864: 
                   6865:  Arguments:
                   6866:    $r           - Apache request object.
                   6867:    $question    - The question number to prompt for.
                   6868:    $scan_config - The scantron file configuration hash.
                   6869:    $scan_record - Reference to the hash that has the the parsed scanlines.
1.503     raeburn  6870:    $error       - Type of error
1.497     foxr     6871: 
                   6872:  Implicit inputs:
                   6873:    %bubble_lines_per_response   - Starting line numbers for each question.
                   6874:                                   Numbered from 0 (but question numbers are from
                   6875:                                   1.
                   6876:    %first_bubble_line           - Starting bubble line for each question.
1.509     raeburn  6877:    %subdivided_bubble_lines     - optionresponse, matchresponse and rankresponse 
                   6878:                                   type problems render as separate sub-questions, 
1.503     raeburn  6879:                                   in exam mode. This hash contains a 
                   6880:                                   comma-separated list of the lines per 
                   6881:                                   sub-question.
1.510     raeburn  6882:    %responsetype_per_response   - essayresponse, formularesponse,
                   6883:                                   stringresponse, imageresponse, reactionresponse,
                   6884:                                   and organicresponse type problem parts can have
1.503     raeburn  6885:                                   multiple lines per response if the weight
                   6886:                                   assigned exceeds 10.  In this case, only
                   6887:                                   one bubble per line is permitted, but more 
                   6888:                                   than one line might contain bubbles, e.g.
                   6889:                                   bubbling of: line 1 - J, line 2 - J, 
                   6890:                                   line 3 - B would assign 22 points.  
1.497     foxr     6891: 
                   6892: =cut
                   6893: 
                   6894: sub prompt_for_corrections {
1.503     raeburn  6895:     my ($r, $question, $scan_config, $scan_record, $error) = @_;
                   6896:     my ($current_line,$lines);
                   6897:     my @linenums;
                   6898:     my $questionnum = $question;
                   6899:     if ($question =~ /^(\d+)\.(\d+)$/) {
                   6900:         $question = $1;
                   6901:         $current_line = $first_bubble_line{$question-1} + 1 ;
                   6902:         my $subquestion = $2;
                   6903:         my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   6904:         my $subcount = 1;
                   6905:         while ($subcount<$subquestion) {
                   6906:             $current_line += $subans[$subcount-1];
                   6907:             $subcount ++;
                   6908:         }
                   6909:         $lines = $subans[$subquestion-1];
                   6910:     } else {
                   6911:         $current_line = $first_bubble_line{$question-1} + 1 ;
                   6912:         $lines        = $bubble_lines_per_response{$question-1};
                   6913:     }
1.497     foxr     6914:     if ($lines > 1) {
1.503     raeburn  6915:         $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />');
                   6916:         if (($responsetype_per_response{$question-1} eq 'essayresponse') ||
                   6917:             ($responsetype_per_response{$question-1} eq 'formularesponse') ||
1.510     raeburn  6918:             ($responsetype_per_response{$question-1} eq 'stringresponse') ||
                   6919:             ($responsetype_per_response{$question-1} eq 'imageresponse') ||
                   6920:             ($responsetype_per_response{$question-1} eq 'reactionresponse') ||
                   6921:             ($responsetype_per_response{$question-1} eq 'organicresponse')) {
1.503     raeburn  6922:             $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their scantron sheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during scantron grading by selecting a bubble in at least one line.').'<br />'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'<br />'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'<br /><br />');
                   6923:         } else {
                   6924:             $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />");
                   6925:         }
1.497     foxr     6926:     }
                   6927:     for (my $i =0; $i < $lines; $i++) {
1.503     raeburn  6928:         my $selected = $$scan_record{"scantron.$current_line.answer"};
                   6929: 	&scantron_bubble_selector($r,$scan_config,$current_line, 
                   6930: 	        		  $questionnum,$error,split('', $selected));
                   6931:         push (@linenums,$current_line);
1.497     foxr     6932: 	$current_line++;
                   6933:     }
                   6934:     if ($lines > 1) {
                   6935: 	$r->print("<hr /><br />");
                   6936:     }
1.503     raeburn  6937:     return @linenums;
1.157     albertel 6938: }
1.423     albertel 6939: 
                   6940: =pod
                   6941: 
                   6942: =item scantron_bubble_selector
                   6943:   
                   6944:    Generates the html radiobuttons to correct a single bubble line
1.424     albertel 6945:    possibly showing the existing the selected bubbles if known
1.423     albertel 6946: 
                   6947:  Arguments:
                   6948:     $r           - Apache request object
                   6949:     $scan_config - hash from &get_scantron_config()
1.497     foxr     6950:     $line        - Number of the line being displayed.
1.503     raeburn  6951:     $questionnum - Question number (may include subquestion)
                   6952:     $error       - Type of error.
1.497     foxr     6953:     @selected    - Array of bubbles picked on this line.
1.423     albertel 6954: 
                   6955: =cut
                   6956: 
1.157     albertel 6957: sub scantron_bubble_selector {
1.503     raeburn  6958:     my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_;
1.157     albertel 6959:     my $max=$$scan_config{'Qlength'};
1.274     albertel 6960: 
                   6961:     my $scmode=$$scan_config{'Qon'};
                   6962:     if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }	     
                   6963: 
1.157     albertel 6964:     my @alphabet=('A'..'Z');
1.503     raeburn  6965:     $r->print(&Apache::loncommon::start_data_table().
                   6966:               &Apache::loncommon::start_data_table_row());
                   6967:     $r->print('<td rowspan="2" class="LC_leftcol_header">'.$line.'</td>');
1.497     foxr     6968:     for (my $i=0;$i<$max+1;$i++) {
                   6969: 	$r->print("\n".'<td align="center">');
                   6970: 	if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
                   6971: 	else { $r->print('&nbsp;'); }
                   6972: 	$r->print('</td>');
                   6973:     }
1.503     raeburn  6974:     $r->print(&Apache::loncommon::end_data_table_row().
                   6975:               &Apache::loncommon::start_data_table_row());
1.497     foxr     6976:     for (my $i=0;$i<$max;$i++) {
                   6977: 	$r->print("\n".
                   6978: 		  '<td><label><input type="radio" name="scantron_correct_Q_'.
                   6979: 		  $line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
                   6980:     }
1.503     raeburn  6981:     my $nobub_checked = ' ';
                   6982:     if ($error eq 'missingbubble') {
                   6983:         $nobub_checked = ' checked = "checked" ';
                   6984:     }
                   6985:     $r->print("\n".'<td><label><input type="radio" name="scantron_correct_Q_'.
                   6986: 	      $line.'" value="none"'.$nobub_checked.'/>'.&mt('No bubble').
                   6987:               '</label>'."\n".'<input type="hidden" name="scantron_questionnum_Q_'.
                   6988:               $line.'" value="'.$questionnum.'" /></td>');
                   6989:     $r->print(&Apache::loncommon::end_data_table_row().
                   6990:               &Apache::loncommon::end_data_table());
1.157     albertel 6991: }
                   6992: 
1.423     albertel 6993: =pod
                   6994: 
                   6995: =item num_matches
                   6996: 
1.424     albertel 6997:    Counts the number of characters that are the same between the two arguments.
                   6998: 
                   6999:  Arguments:
                   7000:    $orig - CODE from the scanline
                   7001:    $code - CODE to match against
                   7002: 
                   7003:  Returns:
                   7004:    $count - integer count of the number of same characters between the
                   7005:             two arguments
                   7006: 
1.423     albertel 7007: =cut
                   7008: 
1.194     albertel 7009: sub num_matches {
                   7010:     my ($orig,$code) = @_;
                   7011:     my @code=split(//,$code);
                   7012:     my @orig=split(//,$orig);
                   7013:     my $same=0;
                   7014:     for (my $i=0;$i<scalar(@code);$i++) {
                   7015: 	if ($code[$i] eq $orig[$i]) { $same++; }
                   7016:     }
                   7017:     return $same;
                   7018: }
                   7019: 
1.423     albertel 7020: =pod
                   7021: 
                   7022: =item scantron_get_closely_matching_CODEs
                   7023: 
1.424     albertel 7024:    Cycles through all CODEs and finds the set that has the greatest
                   7025:    number of same characters as the provided CODE
                   7026: 
                   7027:  Arguments:
                   7028:    $allcodes - hash ref returned by &get_codes()
                   7029:    $CODE     - CODE from the current scanline
                   7030: 
                   7031:  Returns:
                   7032:    2 element list
                   7033:     - first elements is number of how closely matching the best fit is 
                   7034:       (5 means best set has 5 matching characters)
                   7035:     - second element is an arrary ref containing the set of valid CODEs
                   7036:       that best fit the passed in CODE
                   7037: 
1.423     albertel 7038: =cut
                   7039: 
1.194     albertel 7040: sub scantron_get_closely_matching_CODEs {
                   7041:     my ($allcodes,$CODE)=@_;
                   7042:     my @CODEs;
                   7043:     foreach my $testcode (sort(keys(%{$allcodes}))) {
                   7044: 	push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode);
                   7045:     }
                   7046: 
                   7047:     return ($#CODEs,$CODEs[-1]);
                   7048: }
                   7049: 
1.423     albertel 7050: =pod
                   7051: 
                   7052: =item get_codes
                   7053: 
1.424     albertel 7054:    Builds a hash which has keys of all of the valid CODEs from the selected
                   7055:    set of remembered CODEs.
                   7056: 
                   7057:  Arguments:
                   7058:   $old_name - name of the set of remembered CODEs
                   7059:   $cdom     - domain of the course
                   7060:   $cnum     - internal course name
                   7061: 
                   7062:  Returns:
                   7063:   %allcodes - keys are the valid CODEs, values are all 1
                   7064: 
1.423     albertel 7065: =cut
                   7066: 
1.194     albertel 7067: sub get_codes {
1.280     foxr     7068:     my ($old_name, $cdom, $cnum) = @_;
                   7069:     if (!$old_name) {
                   7070: 	$old_name=$env{'form.scantron_CODElist'};
                   7071:     }
                   7072:     if (!$cdom) {
                   7073: 	$cdom =$env{'course.'.$env{'request.course.id'}.'.domain'};
                   7074:     }
                   7075:     if (!$cnum) {
                   7076: 	$cnum =$env{'course.'.$env{'request.course.id'}.'.num'};
                   7077:     }
1.278     albertel 7078:     my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"],
                   7079: 				    $cdom,$cnum);
                   7080:     my %allcodes;
                   7081:     if ($result{"type\0$old_name"} eq 'number') {
                   7082: 	%allcodes=map {($_,1)} split(',',$result{$old_name});
                   7083:     } else {
                   7084: 	%allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name});
                   7085:     }
1.194     albertel 7086:     return %allcodes;
                   7087: }
                   7088: 
1.423     albertel 7089: =pod
                   7090: 
                   7091: =item scantron_validate_CODE
                   7092: 
1.424     albertel 7093:    Validates all scanlines in the selected file to not have any
                   7094:    invalid or underspecified CODEs and that none of the codes are
                   7095:    duplicated if this was requested.
                   7096: 
1.423     albertel 7097: =cut
                   7098: 
1.157     albertel 7099: sub scantron_validate_CODE {
                   7100:     my ($r,$currentphase) = @_;
1.257     albertel 7101:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.186     albertel 7102:     if ($scantron_config{'CODElocation'} &&
                   7103: 	$scantron_config{'CODEstart'} &&
                   7104: 	$scantron_config{'CODElength'}) {
1.257     albertel 7105: 	if (!defined($env{'form.scantron_CODElist'})) {
1.186     albertel 7106: 	    &FIXME_blow_up()
                   7107: 	}
                   7108:     } else {
                   7109: 	return (0,$currentphase+1);
                   7110:     }
                   7111:     
                   7112:     my %usedCODEs;
                   7113: 
1.194     albertel 7114:     my %allcodes=&get_codes();
1.186     albertel 7115: 
1.447     foxr     7116:     &scantron_get_maxbubble();	# parse needs the lines per response array.
                   7117: 
1.186     albertel 7118:     my ($scanlines,$scan_data)=&scantron_getfile();
                   7119:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7120: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.186     albertel 7121: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7122: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7123: 						 $scan_data);
                   7124: 	my $CODE=$$scan_record{'scantron.CODE'};
                   7125: 	my $error=0;
1.224     albertel 7126: 	if (!&Apache::lonnet::validCODE($CODE)) {
                   7127: 	    &scantron_get_correction($r,$i,$scan_record,
                   7128: 				     \%scantron_config,
                   7129: 				     $line,'incorrectCODE',\%allcodes);
                   7130: 	    return(1,$currentphase);
                   7131: 	}
1.221     albertel 7132: 	if (%allcodes && !exists($allcodes{$CODE}) 
                   7133: 	    && !$$scan_record{'scantron.useCODE'}) {
1.186     albertel 7134: 	    &scantron_get_correction($r,$i,$scan_record,
                   7135: 				     \%scantron_config,
1.194     albertel 7136: 				     $line,'incorrectCODE',\%allcodes);
                   7137: 	    return(1,$currentphase);
1.186     albertel 7138: 	}
1.214     albertel 7139: 	if (exists($usedCODEs{$CODE}) 
1.257     albertel 7140: 	    && $env{'form.scantron_CODEunique'} eq 'yes'
1.192     albertel 7141: 	    && !$$scan_record{'scantron.CODE_ignore_dup'}) {
1.186     albertel 7142: 	    &scantron_get_correction($r,$i,$scan_record,
                   7143: 				     \%scantron_config,
1.194     albertel 7144: 				     $line,'duplicateCODE',$usedCODEs{$CODE});
                   7145: 	    return(1,$currentphase);
1.186     albertel 7146: 	}
1.194     albertel 7147: 	push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
1.186     albertel 7148:     }
1.157     albertel 7149:     return (0,$currentphase+1);
                   7150: }
                   7151: 
1.423     albertel 7152: =pod
                   7153: 
                   7154: =item scantron_validate_doublebubble
                   7155: 
1.424     albertel 7156:    Validates all scanlines in the selected file to not have any
                   7157:    bubble lines with multiple bubbles marked.
                   7158: 
1.423     albertel 7159: =cut
                   7160: 
1.157     albertel 7161: sub scantron_validate_doublebubble {
                   7162:     my ($r,$currentphase) = @_;
                   7163:     #get student info
                   7164:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7165:     my %idmap=&username_to_idmap($classlist);
                   7166: 
                   7167:     #get scantron line setup
1.257     albertel 7168:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7169:     my ($scanlines,$scan_data)=&scantron_getfile();
1.447     foxr     7170:     &scantron_get_maxbubble();	# parse needs the bubble line array.
                   7171: 
1.157     albertel 7172:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7173: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7174: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7175: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7176: 						 $scan_data);
                   7177: 	if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
                   7178: 	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,
                   7179: 				 'doublebubble',
                   7180: 				 $$scan_record{'scantron.doubleerror'});
                   7181:     	return (1,$currentphase);
                   7182:     }
                   7183:     return (0,$currentphase+1);
                   7184: }
                   7185: 
1.423     albertel 7186: =pod
                   7187: 
                   7188: =item scantron_get_maxbubble
                   7189: 
1.424     albertel 7190:    Returns the maximum number of bubble lines that are expected to
                   7191:    occur. Does this by walking the selected sequence rendering the
                   7192:    resource and then checking &Apache::lonxml::get_problem_counter()
                   7193:    for what the current value of the problem counter is.
                   7194: 
1.447     foxr     7195:    Caches the results to $env{'form.scantron_maxbubble'},
1.503     raeburn  7196:    $env{'form.scantron.bubble_lines.n'}, 
                   7197:    $env{'form.scantron.first_bubble_line.n'} and
                   7198:    $env{"form.scantron.sub_bubblelines.n"}
1.447     foxr     7199:    which are the total number of bubble, lines, the number of bubble
1.503     raeburn  7200:    lines for response n and number of the first bubble line for response n,
                   7201:    and a comma separated list of numbers of bubble lines for sub-questions
1.509     raeburn  7202:    (for optionresponse, matchresponse, and rankresponse items), for response n.  
1.424     albertel 7203: 
1.423     albertel 7204: =cut
                   7205: 
1.503     raeburn  7206: sub scantron_get_maxbubble {
1.257     albertel 7207:     if (defined($env{'form.scantron_maxbubble'}) &&
                   7208: 	$env{'form.scantron_maxbubble'}) {
1.447     foxr     7209: 	&restore_bubble_lines();
1.257     albertel 7210: 	return $env{'form.scantron_maxbubble'};
1.191     albertel 7211:     }
1.330     albertel 7212: 
1.447     foxr     7213:     my (undef, undef, $sequence) =
1.257     albertel 7214: 	&Apache::lonnet::decode_symb($env{'form.selectpage'});
1.330     albertel 7215: 
1.447     foxr     7216:     my $navmap=Apache::lonnavmaps::navmap->new();
1.191     albertel 7217:     my $map=$navmap->getResourceByUrl($sequence);
                   7218:     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
1.330     albertel 7219: 
                   7220:     &Apache::lonxml::clear_problem_counter();
                   7221: 
1.435     foxr     7222:     my $uname       = $env{'form.student'};
                   7223:     my $udom        = $env{'form.userdom'};
                   7224:     my $cid         = $env{'request.course.id'};
                   7225:     my $total_lines = 0;
                   7226:     %bubble_lines_per_response = ();
1.447     foxr     7227:     %first_bubble_line         = ();
1.503     raeburn  7228:     %subdivided_bubble_lines   = ();
                   7229:     %responsetype_per_response = ();
1.447     foxr     7230:   
                   7231:     my $response_number = 0;
                   7232:     my $bubble_line     = 0;
1.191     albertel 7233:     foreach my $resource (@resources) {
1.510     raeburn  7234:         # Need to retrieve part IDs and response IDs because essayresponse,
                   7235:         # reactionresponse and organicresponse items are not included in 
                   7236:         # $analysis{'parts'} from lonnet::ssi.  
1.503     raeburn  7237:         my %possible_part_ids; 
                   7238:         if (ref($resource->parts()) eq 'ARRAY') { 
                   7239:             foreach my $part (@{$resource->parts()}) {
                   7240:                 my @resp_ids = $resource->responseIds($part);
                   7241:                 foreach my $id (@resp_ids) {
                   7242:                     $possible_part_ids{$part.'.'.$id} = 1;
                   7243:                 }
                   7244:             }
                   7245:         }
1.513   ! foxr     7246: 	my $result=&ssi_with_retries($resource->src(), $ssi_retries,
1.435     foxr     7247: 					('symb' => $resource->symb()),
                   7248: 					('grade_target' => 'analyze'),
                   7249: 					('grade_courseid' => $cid),
                   7250: 					('grade_domain' => $udom),
                   7251: 					('grade_username' => $uname));
1.436     albertel 7252: 	my (undef, $an) =
1.435     foxr     7253: 	    split(/_HASH_REF__/,$result, 2);
                   7254: 
1.503     raeburn  7255:         my @parts;
                   7256: 
1.435     foxr     7257: 	my %analysis = &Apache::lonnet::str2hash($an);
                   7258: 
1.503     raeburn  7259:         if (ref($analysis{'parts'}) eq 'ARRAY') {
                   7260:             @parts = @{$analysis{'parts'}};
                   7261:         }
                   7262:         # Add part_ids for any essayresponse items. 
                   7263:         foreach my $part_id (keys(%possible_part_ids)) {
1.510     raeburn  7264:             if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
                   7265:                 ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
                   7266:                 ($analysis{$part_id.'.type'} eq 'organicresponse')) {
1.503     raeburn  7267:                 if (!grep(/^\Q$part_id\E$/,@parts)) {
                   7268:                     push (@parts,$part_id);
                   7269:                 }
                   7270:             }
                   7271:         }
1.435     foxr     7272: 
1.503     raeburn  7273: 	foreach my $part_id (@parts) {
                   7274:             my $lines = $analysis{"$part_id.bubble_lines"};
1.447     foxr     7275: 
                   7276: 	    # TODO - make this a persistent hash not an array.
                   7277: 
1.509     raeburn  7278:             # optionresponse, matchresponse and rankresponse type items 
                   7279:             # render as separate sub-questions in exam mode.
1.503     raeburn  7280:             if (($analysis{$part_id.'.type'} eq 'optionresponse') ||
1.509     raeburn  7281:                 ($analysis{$part_id.'.type'} eq 'matchresponse') ||
                   7282:                 ($analysis{$part_id.'.type'} eq 'rankresponse')) {
1.503     raeburn  7283:                 my ($numbub,$numshown);
                   7284:                 if ($analysis{$part_id.'.type'} eq 'optionresponse') {
                   7285:                     if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') {
                   7286:                         $numbub = scalar(@{$analysis{$part_id.'.options'}});
                   7287:                     }
                   7288:                 } elsif ($analysis{$part_id.'.type'} eq 'matchresponse') {
                   7289:                     if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') {
                   7290:                         $numbub = scalar(@{$analysis{$part_id.'.items'}});
                   7291:                     }
1.509     raeburn  7292:                 } elsif ($analysis{$part_id.'.type'} eq 'rankresponse') {
                   7293:                     if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') {
                   7294:                         $numbub = scalar(@{$analysis{$part_id.'.foils'}});
                   7295:                     }
1.503     raeburn  7296:                 }
                   7297:                 if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') {
                   7298:                     $numshown = scalar(@{$analysis{$part_id.'.shown'}});
                   7299:                 }
                   7300:                 my $bubbles_per_line = 10;
                   7301:                 my $inner_bubble_lines = int($numshown/$bubbles_per_line);
                   7302:                 if (($numshown % $bubbles_per_line) != 0) {
                   7303:                     $inner_bubble_lines++;
                   7304:                 }
                   7305:                 for (my $i=0; $i<$numshown; $i++) {
                   7306:                     $subdivided_bubble_lines{$response_number} .= 
                   7307:                         $inner_bubble_lines.',';
                   7308:                 }
                   7309:                 $subdivided_bubble_lines{$response_number} =~ s/,$//;
                   7310:             } 
1.447     foxr     7311: 
1.503     raeburn  7312:             $first_bubble_line{$response_number} = $bubble_line;
                   7313: 	    $bubble_lines_per_response{$response_number} = $lines;
                   7314:             $responsetype_per_response{$response_number} = 
                   7315:                 $analysis{$part_id.'.type'};
1.447     foxr     7316: 	    $response_number++;
                   7317: 
                   7318: 	    $bubble_line +=  $lines;
                   7319: 	    $total_lines +=  $lines;
1.435     foxr     7320: 	}
                   7321: 
1.191     albertel 7322:     }
                   7323:     &Apache::lonnet::delenv('scantron\.');
1.447     foxr     7324: 
                   7325:     &save_bubble_lines();
1.330     albertel 7326:     $env{'form.scantron_maxbubble'} =
1.435     foxr     7327: 	$total_lines;
1.257     albertel 7328:     return $env{'form.scantron_maxbubble'};
1.191     albertel 7329: }
                   7330: 
1.423     albertel 7331: =pod
                   7332: 
                   7333: =item scantron_validate_missingbubbles
                   7334: 
1.424     albertel 7335:    Validates all scanlines in the selected file to not have any
1.447     foxr     7336:     answers that don't have bubbles that have not been verified
                   7337:     to be bubble free.
1.424     albertel 7338: 
1.423     albertel 7339: =cut
                   7340: 
1.157     albertel 7341: sub scantron_validate_missingbubbles {
                   7342:     my ($r,$currentphase) = @_;
                   7343:     #get student info
                   7344:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7345:     my %idmap=&username_to_idmap($classlist);
                   7346: 
                   7347:     #get scantron line setup
1.257     albertel 7348:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7349:     my ($scanlines,$scan_data)=&scantron_getfile();
1.191     albertel 7350:     my $max_bubble=&scantron_get_maxbubble();
1.157     albertel 7351:     if (!$max_bubble) { $max_bubble=2**31; }
                   7352:     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
1.200     albertel 7353: 	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7354: 	if ($line=~/^[\s\cz]*$/) { next; }
                   7355: 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7356: 						 $scan_data);
                   7357: 	if (!defined($$scan_record{'scantron.missingerror'})) { next; }
                   7358: 	my @to_correct;
1.470     foxr     7359: 	
                   7360: 	# Probably here's where the error is...
                   7361: 
1.157     albertel 7362: 	foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
1.505     raeburn  7363:             my $lastbubble;
                   7364:             if ($missing =~ /^(\d+)\.(\d+)$/) {
                   7365:                my $question = $1;
                   7366:                my $subquestion = $2;
                   7367:                if (!defined($first_bubble_line{$question -1})) { next; }
                   7368:                my $first = $first_bubble_line{$question-1};
                   7369:                my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
                   7370:                my $subcount = 1;
                   7371:                while ($subcount<$subquestion) {
                   7372:                    $first += $subans[$subcount-1];
                   7373:                    $subcount ++;
                   7374:                }
                   7375:                my $count = $subans[$subquestion-1];
                   7376:                $lastbubble = $first + $count;
                   7377:             } else {
                   7378:                 if (!defined($first_bubble_line{$missing - 1})) { next; }
                   7379:                 $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1};
                   7380:             }
                   7381:             if ($lastbubble > $max_bubble) { next; }
1.157     albertel 7382: 	    push(@to_correct,$missing);
                   7383: 	}
                   7384: 	if (@to_correct) {
                   7385: 	    &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
                   7386: 				     $line,'missingbubble',\@to_correct);
                   7387: 	    return (1,$currentphase);
                   7388: 	}
                   7389: 
                   7390:     }
                   7391:     return (0,$currentphase+1);
                   7392: }
                   7393: 
1.423     albertel 7394: =pod
                   7395: 
                   7396: =item scantron_process_students
                   7397: 
                   7398:    Routine that does the actual grading of the bubble sheet information.
                   7399: 
                   7400:    The parsed scanline hash is added to %env 
                   7401: 
                   7402:    Then foreach unskipped scanline it does an &Apache::lonnet::ssi()
                   7403:    foreach resource , with the form data of
                   7404: 
                   7405: 	'submitted'     =>'scantron' 
                   7406: 	'grade_target'  =>'grade',
                   7407: 	'grade_username'=> username of student
                   7408: 	'grade_domain'  => domain of student
                   7409: 	'grade_courseid'=> of course
                   7410: 	'grade_symb'    => symb of resource to grade
                   7411: 
                   7412:     This triggers a grading pass. The problem grading code takes care
                   7413:     of converting the bubbled letter information (now in %env) into a
                   7414:     valid submission.
                   7415: 
                   7416: =cut
                   7417: 
1.82      albertel 7418: sub scantron_process_students {
1.75      albertel 7419:     my ($r) = @_;
1.513   ! foxr     7420: 
1.257     albertel 7421:     my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
1.324     albertel 7422:     my ($symb)=&get_symb($r);
1.513   ! foxr     7423:     if (!$symb) {
        !          7424: 	return '';
        !          7425:     }
1.324     albertel 7426:     my $default_form_data=&defaultFormData($symb);
1.82      albertel 7427: 
1.257     albertel 7428:     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
1.157     albertel 7429:     my ($scanlines,$scan_data)=&scantron_getfile();
1.82      albertel 7430:     my $classlist=&Apache::loncoursedata::get_classlist();
                   7431:     my %idmap=&username_to_idmap($classlist);
1.132     bowersj2 7432:     my $navmap=Apache::lonnavmaps::navmap->new();
1.83      albertel 7433:     my $map=$navmap->getResourceByUrl($sequence);
                   7434:     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
1.140     albertel 7435: #    $r->print("geto ".scalar(@resources)."<br />");
1.82      albertel 7436:     my $result= <<SCANTRONFORM;
1.81      albertel 7437: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
                   7438:   <input type="hidden" name="command" value="scantron_configphase" />
                   7439:   $default_form_data
                   7440: SCANTRONFORM
1.82      albertel 7441:     $r->print($result);
                   7442: 
                   7443:     my @delayqueue;
1.140     albertel 7444:     my %completedstudents;
                   7445:     
1.200     albertel 7446:     my $count=&get_todo_count($scanlines,$scan_data);
1.157     albertel 7447:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
1.200     albertel 7448:  				    'Scantron Progress',$count,
1.195     albertel 7449: 				    'inline',undef,'scantronupload');
1.140     albertel 7450:     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
                   7451: 					  'Processing first student');
                   7452:     my $start=&Time::HiRes::time();
1.158     albertel 7453:     my $i=-1;
1.200     albertel 7454:     my ($uname,$udom,$started);
1.447     foxr     7455: 
                   7456:     &scantron_get_maxbubble();	# Need the bubble lines array to parse.
1.513   ! foxr     7457:     
        !          7458: 
        !          7459:     # If an ssi failed in scantron_get_maxbubble, put an error message out to
        !          7460:     # the user and return.
        !          7461: 
        !          7462:     if ($ssi_error) {
        !          7463: 	$r->print("</form>");
        !          7464: 	&ssi_print_error($r);
        !          7465: 	$r->print(&show_grading_menu_form($symb));
        !          7466: 	return '';		# Dunno why the other returns return '' rather than just returning.
        !          7467:     }
1.447     foxr     7468: 
1.157     albertel 7469:     while ($i<$scanlines->{'count'}) {
                   7470:  	($uname,$udom)=('','');
                   7471:  	$i++;
1.200     albertel 7472:  	my $line=&scantron_get_line($scanlines,$scan_data,$i);
1.157     albertel 7473:  	if ($line=~/^[\s\cz]*$/) { next; }
1.200     albertel 7474: 	if ($started) {
                   7475: 	    &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   7476: 						     'last student');
                   7477: 	}
                   7478: 	$started=1;
1.157     albertel 7479:  	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
                   7480:  						 $scan_data);
                   7481:  	unless ($uname=&scantron_find_student($scan_record,$scan_data,
                   7482:  					      \%idmap,$i)) {
                   7483:   	    &scantron_add_delay(\@delayqueue,$line,
                   7484:  				'Unable to find a student that matches',1);
                   7485:  	    next;
                   7486:   	}
                   7487:  	if (exists $completedstudents{$uname}) {
                   7488:  	    &scantron_add_delay(\@delayqueue,$line,
                   7489:  				'Student '.$uname.' has multiple sheets',2);
                   7490:  	    next;
                   7491:  	}
                   7492:   	($uname,$udom)=split(/:/,$uname);
1.330     albertel 7493: 
                   7494: 	&Apache::lonxml::clear_problem_counter();
1.157     albertel 7495:   	&Apache::lonnet::appenv(%$scan_record);
1.376     albertel 7496: 
                   7497: 	if (&scantron_clear_skip($scanlines,$scan_data,$i)) {
                   7498: 	    &scantron_putfile($scanlines,$scan_data);
                   7499: 	}
1.161     albertel 7500: 	
                   7501: 	my $i=0;
1.83      albertel 7502: 	foreach my $resource (@resources) {
1.85      albertel 7503: 	    $i++;
1.193     albertel 7504: 	    my %form=('submitted'     =>'scantron',
                   7505: 		      'grade_target'  =>'grade',
                   7506: 		      'grade_username'=>$uname,
                   7507: 		      'grade_domain'  =>$udom,
1.257     albertel 7508: 		      'grade_courseid'=>$env{'request.course.id'},
1.193     albertel 7509: 		      'grade_symb'    =>$resource->symb());
1.383     albertel 7510: 	    if (exists($scan_record->{'scantron.CODE'})
                   7511: 		&& 
                   7512: 		&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) {
1.193     albertel 7513: 		$form{'CODE'}=$scan_record->{'scantron.CODE'};
1.224     albertel 7514: 	    } else {
                   7515: 		$form{'CODE'}='';
1.513   ! foxr     7516: 	    } 
        !          7517: 	    my $result=&ssi_with_retries($resource->src(), $ssi_retries, %form);
        !          7518: 	    if ($ssi_error) {
        !          7519: 		$ssi_error = 0;	# So end of handler error message does not trigger.
        !          7520: 		$r->print("</form>");
        !          7521: 		&ssi_print_error($r);
        !          7522: 		$r->print(&show_grading_menu_form($symb));
        !          7523: 		return '';	# Why return ''?  Beats me.
1.193     albertel 7524: 	    }
1.513   ! foxr     7525: 
1.213     albertel 7526: 	    if (&Apache::loncommon::connection_aborted($r)) { last; }
1.83      albertel 7527: 	}
1.140     albertel 7528: 	$completedstudents{$uname}={'line'=>$line};
1.213     albertel 7529: 	if (&Apache::loncommon::connection_aborted($r)) { last; }
1.140     albertel 7530:     } continue {
1.330     albertel 7531: 	&Apache::lonxml::clear_problem_counter();
1.83      albertel 7532: 	&Apache::lonnet::delenv('scantron\.');
1.82      albertel 7533:     }
1.140     albertel 7534:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
1.172     albertel 7535: #    my $lasttime = &Time::HiRes::time()-$start;
                   7536: #    $r->print("<p>took $lasttime</p>");
1.140     albertel 7537: 
1.200     albertel 7538:     $r->print("</form>");
1.324     albertel 7539:     $r->print(&show_grading_menu_form($symb));
1.157     albertel 7540:     return '';
1.75      albertel 7541: }
1.157     albertel 7542: 
1.423     albertel 7543: =pod
                   7544: 
                   7545: =item scantron_upload_scantron_data
                   7546: 
                   7547:     Creates the screen for adding a new bubble sheet data file to a course.
                   7548: 
                   7549: =cut
                   7550: 
1.157     albertel 7551: sub scantron_upload_scantron_data {
                   7552:     my ($r)=@_;
1.257     albertel 7553:     $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));
1.157     albertel 7554:     my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',
1.181     albertel 7555: 							  'domainid',
                   7556: 							  'coursename');
1.257     albertel 7557:     my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'},
1.157     albertel 7558: 						   'domainid');
1.324     albertel 7559:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.492     albertel 7560:     $r->print('
1.157     albertel 7561: <script type="text/javascript" language="javascript">
                   7562:     function checkUpload(formname) {
                   7563: 	if (formname.upfile.value == "") {
                   7564: 	    alert("Please use the browse button to select a file from your local directory.");
                   7565: 	    return false;
                   7566: 	}
                   7567: 	formname.submit();
                   7568:     }
                   7569: </script>
                   7570: 
1.492     albertel 7571: <form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post">
                   7572: '.$default_form_data.'
1.181     albertel 7573: <table>
1.492     albertel 7574: <tr><td>'.$select_link.'                             </td></tr>
                   7575: <tr><td>'.&mt('Course ID:').'     </td>
                   7576:     <td><input name="courseid"   type="text" />      </td></tr>
                   7577: <tr><td>'.&mt('Course Name:').'   </td>
                   7578:     <td><input name="coursename" type="text" />      </td></tr>
                   7579: <tr><td>'.&mt('Domain:').'        </td>
                   7580:     <td>'.$domsel.'                                  </td></tr>
                   7581: <tr><td>'.&mt('File to upload:').'</td>
                   7582:     <td><input type="file" name="upfile" size="50" /></td></tr>
1.181     albertel 7583: </table>
1.492     albertel 7584: <input name="command" value="scantronupload_save" type="hidden" />
                   7585: <input type="button" onClick="javascript:checkUpload(this.form);" value="'.&mt('Upload Scantron Data').'" />
1.157     albertel 7586: </form>
1.492     albertel 7587: ');
1.157     albertel 7588:     return '';
                   7589: }
                   7590: 
1.423     albertel 7591: =pod
                   7592: 
                   7593: =item scantron_upload_scantron_data_save
                   7594: 
                   7595:    Adds a provided bubble information data file to the course if user
                   7596:    has the correct privileges to do so.  
                   7597: 
                   7598: =cut
                   7599: 
1.157     albertel 7600: sub scantron_upload_scantron_data_save {
                   7601:     my($r)=@_;
1.324     albertel 7602:     my ($symb)=&get_symb($r,1);
1.182     albertel 7603:     my $doanotherupload=
                   7604: 	'<br /><form action="/adm/grades" method="post">'."\n".
                   7605: 	'<input type="hidden" name="command" value="scantronupload" />'."\n".
1.492     albertel 7606: 	'<input type="submit" name="submit" value="'.&mt('Do Another Upload').'" />'."\n".
1.182     albertel 7607: 	'</form>'."\n";
1.257     albertel 7608:     if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) &&
1.162     albertel 7609: 	!&Apache::lonnet::allowed('usc',
1.257     albertel 7610: 			    $env{'form.domainid'}.'_'.$env{'form.courseid'})) {
1.492     albertel 7611: 	$r->print(&mt("You are not allowed to upload Scantron data to the requested course.")."<br />");
1.182     albertel 7612: 	if ($symb) {
1.324     albertel 7613: 	    $r->print(&show_grading_menu_form($symb));
1.182     albertel 7614: 	} else {
                   7615: 	    $r->print($doanotherupload);
                   7616: 	}
1.162     albertel 7617: 	return '';
                   7618:     }
1.257     albertel 7619:     my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'});
1.492     albertel 7620:     $r->print(&mt("Doing upload to [_1]",$coursedata{'description'})." <br />");
1.257     albertel 7621:     my $fname=$env{'form.upfile.filename'};
1.157     albertel 7622:     #FIXME
                   7623:     #copied from lonnet::userfileupload()
                   7624:     #make that function able to target a specified course
                   7625:     # Replace Windows backslashes by forward slashes
                   7626:     $fname=~s/\\/\//g;
                   7627:     # Get rid of everything but the actual filename
                   7628:     $fname=~s/^.*\/([^\/]+)$/$1/;
                   7629:     # Replace spaces by underscores
                   7630:     $fname=~s/\s+/\_/g;
                   7631:     # Replace all other weird characters by nothing
                   7632:     $fname=~s/[^\w\.\-]//g;
                   7633:     # See if there is anything left
                   7634:     unless ($fname) { return 'error: no uploaded file'; }
1.209     ng       7635:     my $uploadedfile=$fname;
1.157     albertel 7636:     $fname='scantron_orig_'.$fname;
1.257     albertel 7637:     if (length($env{'form.upfile'}) < 2) {
1.492     albertel 7638: 	$r->print(&mt("<span class=\"LC_error\">Error:</span> The file you attempted to upload, [_1]  contained no information. Please check that you entered the correct filename.",'<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</span>"));
1.183     albertel 7639:     } else {
1.275     albertel 7640: 	my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname);
1.210     albertel 7641: 	if ($result =~ m|^/uploaded/|) {
1.492     albertel 7642: 	    $r->print(&mt("<span class=\"LC_success\">Success:</span> Successfully uploaded [_1] bytes of data into location [_2]",
                   7643: 			  (length($env{'form.upfile'})-1),
                   7644: 			  '<span class="LC_filename">'.$result."</span>"));
1.210     albertel 7645: 	} else {
1.492     albertel 7646: 	    $r->print(&mt("<span class=\"LC_error\">Error:</span> An error ([_1]) occurred when attempting to upload the file, [_2]",
                   7647: 			  $result,
                   7648: 			  '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</span>"));
                   7649: 
1.183     albertel 7650: 	}
                   7651:     }
1.174     albertel 7652:     if ($symb) {
1.209     ng       7653: 	$r->print(&scantron_selectphase($r,$uploadedfile));
1.174     albertel 7654:     } else {
1.182     albertel 7655: 	$r->print($doanotherupload);
1.174     albertel 7656:     }
1.157     albertel 7657:     return '';
                   7658: }
                   7659: 
1.423     albertel 7660: =pod
                   7661: 
                   7662: =item valid_file
                   7663: 
1.424     albertel 7664:    Validates that the requested bubble data file exists in the course.
1.423     albertel 7665: 
                   7666: =cut
                   7667: 
1.202     albertel 7668: sub valid_file {
                   7669:     my ($requested_file)=@_;
                   7670:     foreach my $filename (sort(&scantron_filenames())) {
                   7671: 	if ($requested_file eq $filename) { return 1; }
                   7672:     }
                   7673:     return 0;
                   7674: }
                   7675: 
1.423     albertel 7676: =pod
                   7677: 
                   7678: =item scantron_download_scantron_data
                   7679: 
                   7680:    Shows a list of the three internal files (original, corrected,
                   7681:    skipped) for a specific bubble sheet data file that exists in the
                   7682:    course.
                   7683: 
                   7684: =cut
                   7685: 
1.202     albertel 7686: sub scantron_download_scantron_data {
                   7687:     my ($r)=@_;
1.324     albertel 7688:     my $default_form_data=&defaultFormData(&get_symb($r,1));
1.257     albertel 7689:     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
                   7690:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   7691:     my $file=$env{'form.scantron_selectfile'};
1.202     albertel 7692:     if (! &valid_file($file)) {
1.492     albertel 7693: 	$r->print('
1.202     albertel 7694: 	<p>
1.492     albertel 7695: 	    '.&mt('The requested file name was invalid.').'
1.202     albertel 7696:         </p>
1.492     albertel 7697: ');
1.324     albertel 7698: 	$r->print(&show_grading_menu_form(&get_symb($r,1)));
1.202     albertel 7699: 	return;
                   7700:     }
                   7701:     my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file;
                   7702:     my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file;
                   7703:     my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file;
                   7704:     &Apache::lonnet::allowuploaded('/adm/grades',$orig);
                   7705:     &Apache::lonnet::allowuploaded('/adm/grades',$corrected);
                   7706:     &Apache::lonnet::allowuploaded('/adm/grades',$skipped);
1.492     albertel 7707:     $r->print('
1.202     albertel 7708:     <p>
1.492     albertel 7709: 	'.&mt('[_1]Original[_2] file as uploaded by the scantron office.',
                   7710: 	      '<a href="'.$orig.'">','</a>').'
1.202     albertel 7711:     </p>
                   7712:     <p>
1.492     albertel 7713: 	'.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.',
                   7714: 	      '<a href="'.$corrected.'">','</a>').'
1.202     albertel 7715:     </p>
                   7716:     <p>
1.492     albertel 7717: 	'.&mt('[_1]Skipped[_2], a file of records that were skipped.',
                   7718: 	      '<a href="'.$skipped.'">','</a>').'
1.202     albertel 7719:     </p>
1.492     albertel 7720: ');
1.324     albertel 7721:     $r->print(&show_grading_menu_form(&get_symb($r,1)));
1.202     albertel 7722:     return '';
                   7723: }
1.157     albertel 7724: 
1.423     albertel 7725: =pod
                   7726: 
                   7727: =back
                   7728: 
                   7729: =cut
                   7730: 
1.75      albertel 7731: #-------- end of section for handling grading scantron forms -------
                   7732: #
                   7733: #-------------------------------------------------------------------
                   7734: 
1.72      ng       7735: #-------------------------- Menu interface -------------------------
                   7736: #
                   7737: #--- Show a Grading Menu button - Calls the next routine ---
                   7738: sub show_grading_menu_form {
1.324     albertel 7739:     my ($symb)=@_;
1.125     ng       7740:     my $result.='<br /><form action="/adm/grades" method="post">'."\n".
1.418     albertel 7741: 	'<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.257     albertel 7742: 	'<input type="hidden" name="saveState"  value="'.$env{'form.saveState'}.'" />'."\n".
1.72      ng       7743: 	'<input type="hidden" name="command" value="gradingmenu" />'."\n".
1.478     albertel 7744: 	'<input type="submit" name="submit" value="'.&mt('Grading Menu').'" />'."\n".
1.72      ng       7745: 	'</form>'."\n";
                   7746:     return $result;
                   7747: }
                   7748: 
1.77      ng       7749: # -- Retrieve choices for grading form
                   7750: sub savedState {
                   7751:     my %savedState = ();
1.257     albertel 7752:     if ($env{'form.saveState'}) {
                   7753: 	foreach (split(/:/,$env{'form.saveState'})) {
1.77      ng       7754: 	    my ($key,$value) = split(/=/,$_,2);
                   7755: 	    $savedState{$key} = $value;
                   7756: 	}
                   7757:     }
                   7758:     return \%savedState;
                   7759: }
1.76      ng       7760: 
1.443     banghart 7761: sub grading_menu {
                   7762:     my ($request) = @_;
                   7763:     my ($symb)=&get_symb($request);
                   7764:     if (!$symb) {return '';}
                   7765:     my $probTitle = &Apache::lonnet::gettitle($symb);
                   7766:     my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
                   7767: 
1.444     banghart 7768:     $request->print($table);
1.443     banghart 7769:     my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb),
                   7770:                   'handgrade'=>$hdgrade,
                   7771:                   'probTitle'=>$probTitle,
                   7772:                   'command'=>'submit_options',
                   7773:                   'saveState'=>"",
                   7774:                   'gradingMenu'=>1,
                   7775:                   'showgrading'=>"yes");
                   7776:     my $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   7777:     my @menu = ({ url => $url,
                   7778:                      name => &mt('Manual Grading/View Submissions'),
                   7779:                      short_description => 
                   7780:     &mt('Start the process of hand grading submissions.'),
                   7781:                  });
                   7782:     $fields{'command'} = 'csvform';
                   7783:     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   7784:     push (@menu, { url => $url,
                   7785:                    name => &mt('Upload Scores'),
                   7786:                    short_description => 
                   7787:             &mt('Specify a file containing the class scores for current resource.')});
                   7788:     $fields{'command'} = 'processclicker';
                   7789:     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   7790:     push (@menu, { url => $url,
                   7791:                    name => &mt('Process Clicker'),
                   7792:                    short_description => 
                   7793:             &mt('Specify a file containing the clicker information for this resource.')});
                   7794:     $fields{'command'} = 'scantron_selectphase';
                   7795:     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
                   7796:     push (@menu, { url => $url,
1.454     banghart 7797:                    name => &mt('Grade/Manage Scantron Forms'),
                   7798:                    short_description => 
                   7799:             &mt('')});
1.443     banghart 7800:     $fields{'command'} = 'verify';
                   7801:     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
1.445     banghart 7802:     push (@menu, { url => "",
1.443     banghart 7803:                    name => &mt('Verify Receipt'),
                   7804:                    short_description => 
                   7805:             &mt('')});
                   7806:     #
                   7807:     # Create the menu
                   7808:     my $Str;
1.444     banghart 7809:     # $Str .= '<h2>'.&mt('Please select a grading task').'</h2>';
1.445     banghart 7810:     $Str .= '<form method="post" action="" name="gradingMenu">';
                   7811:     $Str .= '<input type="hidden" name="command" value="" />'.
                   7812:     	'<input type="hidden" name="symb"        value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
                   7813: 	'<input type="hidden" name="handgrade"   value="'.$hdgrade.'" />'."\n".
1.476     albertel 7814: 	'<input type="hidden" name="probTitle"   value="'.$probTitle.'" />'."\n".
1.445     banghart 7815: 	'<input type="hidden" name="saveState"   value="" />'."\n".
                   7816: 	'<input type="hidden" name="gradingMenu" value="1" />'."\n".
                   7817: 	'<input type="hidden" name="showgrading" value="yes" />'."\n";
                   7818: 
1.443     banghart 7819:     foreach my $menudata (@menu) {
1.445     banghart 7820:         if ($menudata->{'name'} ne &mt('Verify Receipt')) {
                   7821:             $Str .='    <h3><a '.
                   7822:                 $menudata->{'jscript'}.
                   7823:                 ' href="'.
                   7824:                 $menudata->{'url'}.'" >'.
                   7825:                 $menudata->{'name'}."</a></h3>\n";
                   7826:         } else {
1.511     www      7827:             $Str .='<hr /><input type="button" value="'.&mt('Verify Receipt').'" '.
1.445     banghart 7828:                 $menudata->{'jscript'}.
1.458     banghart 7829:                 ' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '.
1.511     www      7830:                 ' /> '.
                   7831: 		&Apache::lonnet::recprefix($env{'request.course.id'}).
                   7832:                     '-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')" />';
1.444     banghart 7833:         }
1.443     banghart 7834:         $Str .= '    '.('&nbsp;'x8).$menudata->{'short_description'}.
                   7835:             "\n";
                   7836:     }
1.444     banghart 7837:     $Str .="</form>\n";
1.443     banghart 7838:     $request->print(<<GRADINGMENUJS);
                   7839: <script type="text/javascript" language="javascript">
                   7840:     function checkChoice(formname,val,cmdx) {
                   7841: 	if (val <= 2) {
                   7842: 	    var cmd = radioSelection(formname.radioChoice);
                   7843: 	    var cmdsave = cmd;
                   7844: 	} else {
                   7845: 	    cmd = cmdx;
                   7846: 	    cmdsave = 'submission';
                   7847: 	}
                   7848: 	formname.command.value = cmd;
                   7849: 	if (val < 5) formname.submit();
                   7850: 	if (val == 5) {
1.458     banghart 7851: 	    if (!checkReceiptNo(formname,'notOK')) { 
                   7852: 	        return false;
                   7853: 	    } else {
                   7854: 	        formname.submit();
                   7855: 	    }
1.445     banghart 7856: 	}
                   7857:     }
1.443     banghart 7858: 
                   7859:     function checkReceiptNo(formname,nospace) {
                   7860: 	var receiptNo = formname.receipt.value;
                   7861: 	var checkOpt = false;
                   7862: 	if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;}
                   7863: 	if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;}
                   7864: 	if (checkOpt) {
                   7865: 	    alert("Please enter a receipt number given by a student in the receipt box.");
                   7866: 	    formname.receipt.value = "";
                   7867: 	    formname.receipt.focus();
                   7868: 	    return false;
                   7869: 	}
                   7870: 	return true;
                   7871:     }
                   7872: </script>
                   7873: GRADINGMENUJS
                   7874:     &commonJSfunctions($request);
                   7875:     return $Str;    
                   7876: }
                   7877: 
                   7878: 
                   7879: #--- Displays the submissions first page -------
                   7880: sub submit_options {
1.72      ng       7881:     my ($request) = @_;
1.324     albertel 7882:     my ($symb)=&get_symb($request);
1.72      ng       7883:     if (!$symb) {return '';}
1.76      ng       7884:     my $probTitle = &Apache::lonnet::gettitle($symb);
1.72      ng       7885: 
                   7886:     $request->print(<<GRADINGMENUJS);
                   7887: <script type="text/javascript" language="javascript">
1.116     ng       7888:     function checkChoice(formname,val,cmdx) {
                   7889: 	if (val <= 2) {
                   7890: 	    var cmd = radioSelection(formname.radioChoice);
1.118     ng       7891: 	    var cmdsave = cmd;
1.116     ng       7892: 	} else {
                   7893: 	    cmd = cmdx;
1.118     ng       7894: 	    cmdsave = 'submission';
1.116     ng       7895: 	}
                   7896: 	formname.command.value = cmd;
1.118     ng       7897: 	formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+
1.145     albertel 7898: 	    ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);
1.116     ng       7899: 	if (val < 5) formname.submit();
                   7900: 	if (val == 5) {
1.72      ng       7901: 	    if (!checkReceiptNo(formname,'notOK')) { return false;}
                   7902: 	    formname.submit();
                   7903: 	}
1.238     albertel 7904: 	if (val < 7) formname.submit();
1.72      ng       7905:     }
                   7906: 
                   7907:     function checkReceiptNo(formname,nospace) {
                   7908: 	var receiptNo = formname.receipt.value;
                   7909: 	var checkOpt = false;
                   7910: 	if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;}
                   7911: 	if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;}
                   7912: 	if (checkOpt) {
                   7913: 	    alert("Please enter a receipt number given by a student in the receipt box.");
                   7914: 	    formname.receipt.value = "";
                   7915: 	    formname.receipt.focus();
                   7916: 	    return false;
                   7917: 	}
                   7918: 	return true;
                   7919:     }
                   7920: </script>
                   7921: GRADINGMENUJS
1.118     ng       7922:     &commonJSfunctions($request);
1.324     albertel 7923:     my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
1.473     albertel 7924:     my $result;
1.76      ng       7925:     my (undef,$sections) = &getclasslist('all','0');
1.77      ng       7926:     my $savedState = &savedState();
1.118     ng       7927:     my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'});
1.77      ng       7928:     my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'});
1.118     ng       7929:     my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'});
1.77      ng       7930:     my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
1.72      ng       7931: 
                   7932:     $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n".
1.418     albertel 7933: 	'<input type="hidden" name="symb"        value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
1.72      ng       7934: 	'<input type="hidden" name="handgrade"   value="'.$hdgrade.'" />'."\n".
                   7935: 	'<input type="hidden" name="probTitle"   value="'.$probTitle.'" />'."\n".
1.116     ng       7936: 	'<input type="hidden" name="command"     value="" />'."\n".
1.77      ng       7937: 	'<input type="hidden" name="saveState"   value="" />'."\n".
1.124     ng       7938: 	'<input type="hidden" name="gradingMenu" value="1" />'."\n".
1.72      ng       7939: 	'<input type="hidden" name="showgrading" value="yes" />'."\n";
                   7940: 
1.472     albertel 7941:     $result.='
                   7942:     <div class="LC_grade_select_mode">
1.473     albertel 7943:       <div class="LC_grade_select_mode_current">
                   7944:         <h2>
                   7945:           '.&mt('Grade Current Resource').'
                   7946:         </h2>
                   7947:         <div class="LC_grade_select_mode_body">
                   7948:           <div class="LC_grades_resource_info">
                   7949:            '.$table.'
                   7950:           </div>
                   7951:           <div class="LC_grade_select_mode_selector">
                   7952:              <div class="LC_grade_select_mode_selector_header">
                   7953:                 '.&mt('Sections').'
                   7954:              </div>
                   7955:              <div class="LC_grade_select_mode_selector_body">
                   7956: 	       <select name="section" multiple="multiple" size="5">'."\n";
1.116     ng       7957:     if (ref($sections)) {
1.472     albertel 7958: 	foreach my $section (sort (@$sections)) {
                   7959: 	    $result.='<option value="'.$section.'" '.
                   7960: 		($saveSec eq $section ? 'selected="selected"':'').'>'.$section.'</option>'."\n";
1.155     albertel 7961: 	}
1.116     ng       7962:     }
1.401     albertel 7963:     $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="selected"' : ''). '>all</option></select> &nbsp; ';
1.472     albertel 7964:     $result.='
1.473     albertel 7965:              </div>
                   7966:           </div>
                   7967:           <div class="LC_grade_select_mode_selector">
                   7968:              <div class="LC_grade_select_mode_selector_header">
                   7969:                 '.&mt('Groups').'
                   7970:              </div>
                   7971:              <div class="LC_grade_select_mode_selector_body">
                   7972:                 '.&Apache::lonstatistics::GroupSelect('group','multiple',5).'
                   7973:              </div>
1.472     albertel 7974:           </div>
1.473     albertel 7975:           <div class="LC_grade_select_mode_selector">
                   7976:              <div class="LC_grade_select_mode_selector_header">
                   7977:                 '.&mt('Access Status').'
                   7978:              </div>
                   7979:              <div class="LC_grade_select_mode_selector_body">
                   7980:                 '.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,5,undef,'mult').'
                   7981:              </div>
1.472     albertel 7982:           </div>
1.473     albertel 7983:           <div class="LC_grade_select_mode_selector">
                   7984:              <div class="LC_grade_select_mode_selector_header">
                   7985:                 '.&mt('Submission Status').'
                   7986:              </div>
                   7987:              <div class="LC_grade_select_mode_selector_body">
                   7988:                <select name="submitonly" size="5">
                   7989: 	         <option value="yes" '.      ($saveSub eq 'yes'       ? 'selected="selected"' : '').'>'.&mt('with submissions').'</option>
                   7990: 	         <option value="queued" '.   ($saveSub eq 'queued'    ? 'selected="selected"' : '').'>'.&mt('in grading queue').'</option>
                   7991: 	         <option value="graded" '.   ($saveSub eq 'graded'    ? 'selected="selected"' : '').'>'.&mt('with ungraded submissions').'</option>
                   7992: 	         <option value="incorrect" '.($saveSub eq 'incorrect' ? 'selected="selected"' : '').'>'.&mt('with incorrect submissions').'</option>
                   7993:                  <option value="all" '.      ($saveSub eq 'all'       ? 'selected="selected"' : '').'>'.&mt('with any status').'</option>
                   7994:                </select>
                   7995:              </div>
1.472     albertel 7996:           </div>
1.473     albertel 7997:           <div class="LC_grade_select_mode_type_body">
                   7998:             <div class="LC_grade_select_mode_type">
                   7999:               <label>
                   8000:                 <input type="radio" name="radioChoice" value="submission" '.
                   8001:                   ($saveCmd eq 'submission' ? 'checked="checked"' : '').' /> '.
                   8002:              &mt('Select individual students to grade and view submissions.').'
                   8003: 	      </label> 
                   8004:             </div>
                   8005:             <div class="LC_grade_select_mode_type">
                   8006: 	      <label>
                   8007:                 <input type="radio" name="radioChoice" value="viewgrades" '.
                   8008:                   ($saveCmd eq 'viewgrades' ? 'checked="checked"' : '').' /> '.
                   8009:                     &mt('Grade all selected students in a grading table.').'
                   8010:               </label>
                   8011:             </div>
                   8012:             <div class="LC_grade_select_mode_type">
                   8013: 	      <input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next-&gt;').'" />
                   8014:             </div>
1.472     albertel 8015:           </div>
1.473     albertel 8016:         </div>
                   8017:       </div>
                   8018:       <div class="LC_grade_select_mode_page">
                   8019:         <h2>
                   8020:          '.&mt('Grade Complete Folder for One Student').'
                   8021:         </h2>
                   8022:         <div class="LC_grades_select_mode_body">
                   8023:           <div class="LC_grade_select_mode_type_body">
                   8024:             <div class="LC_grade_select_mode_type">
                   8025:               <label>
                   8026:                 <input type="radio" name="radioChoice" value="pickStudentPage" '.
                   8027: 	  ($saveCmd eq 'pickStudentPage' ? 'checked="checked"' : '').' /> '.
                   8028:   &mt('The <b>complete</b> page/sequence/folder: For one student').'
                   8029:               </label>
                   8030:             </div>
                   8031:             <div class="LC_grade_select_mode_type">
                   8032: 	      <input type="button" onClick="javascript:checkChoice(this.form,\'2\');" value="'.&mt('Next-&gt;').'" />
                   8033:             </div>
1.472     albertel 8034:           </div>
                   8035:         </div>
                   8036:       </div>
                   8037:     </div>
                   8038:   </form>';
1.499     albertel 8039:     $result .= &show_grading_menu_form($symb);
1.44      ng       8040:     return $result;
1.2       albertel 8041: }
                   8042: 
1.285     albertel 8043: sub reset_perm {
                   8044:     undef(%perm);
                   8045: }
                   8046: 
                   8047: sub init_perm {
                   8048:     &reset_perm();
1.300     albertel 8049:     foreach my $test_perm ('vgr','mgr','opa') {
                   8050: 
                   8051: 	my $scope = $env{'request.course.id'};
                   8052: 	if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) {
                   8053: 
                   8054: 	    $scope .= '/'.$env{'request.course.sec'};
                   8055: 	    if ( $perm{$test_perm}=
                   8056: 		 &Apache::lonnet::allowed($test_perm,$scope)) {
                   8057: 		$perm{$test_perm.'_section'}=$env{'request.course.sec'};
                   8058: 	    } else {
                   8059: 		delete($perm{$test_perm});
                   8060: 	    }
1.285     albertel 8061: 	}
                   8062:     }
                   8063: }
                   8064: 
1.400     www      8065: sub gather_clicker_ids {
1.408     albertel 8066:     my %clicker_ids;
1.400     www      8067: 
                   8068:     my $classlist = &Apache::loncoursedata::get_classlist();
                   8069: 
                   8070:     # Set up a couple variables.
1.407     albertel 8071:     my $username_idx = &Apache::loncoursedata::CL_SNAME();
                   8072:     my $domain_idx   = &Apache::loncoursedata::CL_SDOM();
1.438     www      8073:     my $status_idx   = &Apache::loncoursedata::CL_STATUS();
1.400     www      8074: 
1.407     albertel 8075:     foreach my $student (keys(%$classlist)) {
1.438     www      8076:         if ($classlist->{$student}->[$status_idx] ne 'Active') { next; }
1.407     albertel 8077:         my $username = $classlist->{$student}->[$username_idx];
                   8078:         my $domain   = $classlist->{$student}->[$domain_idx];
1.400     www      8079:         my $clickers =
1.408     albertel 8080: 	    (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1];
1.400     www      8081:         foreach my $id (split(/\,/,$clickers)) {
1.414     www      8082:             $id=~s/^[\#0]+//;
1.421     www      8083:             $id=~s/[\-\:]//g;
1.407     albertel 8084:             if (exists($clicker_ids{$id})) {
1.408     albertel 8085: 		$clicker_ids{$id}.=','.$username.':'.$domain;
1.400     www      8086:             } else {
1.408     albertel 8087: 		$clicker_ids{$id}=$username.':'.$domain;
1.400     www      8088:             }
                   8089:         }
                   8090:     }
1.407     albertel 8091:     return %clicker_ids;
1.400     www      8092: }
                   8093: 
1.402     www      8094: sub gather_adv_clicker_ids {
1.408     albertel 8095:     my %clicker_ids;
1.402     www      8096:     my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
                   8097:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
                   8098:     my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum);
1.409     albertel 8099:     foreach my $element (sort(keys(%coursepersonnel))) {
1.402     www      8100:         foreach my $person (split(/\,/,$coursepersonnel{$element})) {
                   8101:             my ($puname,$pudom)=split(/\:/,$person);
                   8102:             my $clickers =
1.408     albertel 8103: 		(&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
1.405     www      8104:             foreach my $id (split(/\,/,$clickers)) {
1.414     www      8105: 		$id=~s/^[\#0]+//;
1.421     www      8106:                 $id=~s/[\-\:]//g;
1.408     albertel 8107: 		if (exists($clicker_ids{$id})) {
                   8108: 		    $clicker_ids{$id}.=','.$puname.':'.$pudom;
                   8109: 		} else {
                   8110: 		    $clicker_ids{$id}=$puname.':'.$pudom;
                   8111: 		}
1.405     www      8112:             }
1.402     www      8113:         }
                   8114:     }
1.407     albertel 8115:     return %clicker_ids;
1.402     www      8116: }
                   8117: 
1.413     www      8118: sub clicker_grading_parameters {
                   8119:     return ('gradingmechanism' => 'scalar',
                   8120:             'upfiletype' => 'scalar',
                   8121:             'specificid' => 'scalar',
                   8122:             'pcorrect' => 'scalar',
                   8123:             'pincorrect' => 'scalar');
                   8124: }
                   8125: 
1.400     www      8126: sub process_clicker {
                   8127:     my ($r)=@_;
                   8128:     my ($symb)=&get_symb($r);
                   8129:     if (!$symb) {return '';}
                   8130:     my $result=&checkforfile_js();
                   8131:     $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
                   8132:     my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
                   8133:     $result.=$table;
                   8134:     $result.='<br /><table width="100%" border="0"><tr><td bgcolor="#777777">'."\n";
                   8135:     $result.='<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>'."\n";
                   8136:     $result.='&nbsp;<b>'.&mt('Specify a file containing the clicker information for this resource').
                   8137:         '.</b></td></tr>'."\n";
                   8138:     $result.='<tr bgcolor=#ffffe6><td>'."\n";
1.413     www      8139: # Attempt to restore parameters from last session, set defaults if not present
                   8140:     my %Saveable_Parameters=&clicker_grading_parameters();
                   8141:     &Apache::loncommon::restore_course_settings('grades_clicker',
                   8142:                                                  \%Saveable_Parameters);
                   8143:     if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; }
                   8144:     if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; }
                   8145:     if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; }
                   8146:     if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
                   8147: 
                   8148:     my %checked;
                   8149:     foreach my $gradingmechanism ('attendance','personnel','specific') {
                   8150:        if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
                   8151:           $checked{$gradingmechanism}="checked='checked'";
                   8152:        }
                   8153:     }
                   8154: 
1.400     www      8155:     my $upload=&mt("Upload File");
                   8156:     my $type=&mt("Type");
1.402     www      8157:     my $attendance=&mt("Award points just for participation");
                   8158:     my $personnel=&mt("Correctness determined from response by course personnel");
1.414     www      8159:     my $specific=&mt("Correctness determined from response with clicker ID(s)"); 
1.402     www      8160:     my $pcorrect=&mt("Percentage points for correct solution");
                   8161:     my $pincorrect=&mt("Percentage points for incorrect solution");
1.413     www      8162:     my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
1.419     www      8163: 						   ('iclicker' => 'i>clicker',
                   8164:                                                     'interwrite' => 'interwrite PRS'));
1.418     albertel 8165:     $symb = &Apache::lonenc::check_encrypt($symb);
1.400     www      8166:     $result.=<<ENDUPFORM;
1.402     www      8167: <script type="text/javascript">
                   8168: function sanitycheck() {
                   8169: // Accept only integer percentages
                   8170:    document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value);
                   8171:    document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value);
                   8172: // Find out grading choice
                   8173:    for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) {
                   8174:       if (document.forms.gradesupload.gradingmechanism[i].checked) {
                   8175:          gradingchoice=document.forms.gradesupload.gradingmechanism[i].value;
                   8176:       }
                   8177:    }
                   8178: // By default, new choice equals user selection
                   8179:    newgradingchoice=gradingchoice;
                   8180: // Not good to give more points for false answers than correct ones
                   8181:    if (Math.round(document.forms.gradesupload.pcorrect.value)<Math.round(document.forms.gradesupload.pincorrect.value)) {
                   8182:       document.forms.gradesupload.pcorrect.value=document.forms.gradesupload.pincorrect.value;
                   8183:    }
                   8184: // If new choice is attendance only, and old choice was correctness-based, restore defaults
                   8185:    if ((gradingchoice=='attendance') && (document.forms.gradesupload.waschecked.value!='attendance')) {
                   8186:       document.forms.gradesupload.pcorrect.value=100;
                   8187:       document.forms.gradesupload.pincorrect.value=100;
                   8188:    }
                   8189: // If the values are different, cannot be attendance only
                   8190:    if ((Math.round(document.forms.gradesupload.pcorrect.value)!=Math.round(document.forms.gradesupload.pincorrect.value)) &&
                   8191:        (gradingchoice=='attendance')) {
                   8192:        newgradingchoice='personnel';
                   8193:    }
                   8194: // Change grading choice to new one
                   8195:    for (i=0; i<document.forms.gradesupload.gradingmechanism.length; i++) {
                   8196:       if (document.forms.gradesupload.gradingmechanism[i].value==newgradingchoice) {
                   8197:          document.forms.gradesupload.gradingmechanism[i].checked=true;
                   8198:       } else {
                   8199:          document.forms.gradesupload.gradingmechanism[i].checked=false;
                   8200:       }
                   8201:    }
                   8202: // Remember the old state
                   8203:    document.forms.gradesupload.waschecked.value=newgradingchoice;
                   8204: }
                   8205: </script>
1.400     www      8206: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
                   8207: <input type="hidden" name="symb" value="$symb" />
                   8208: <input type="hidden" name="command" value="processclickerfile" />
                   8209: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   8210: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
                   8211: <input type="file" name="upfile" size="50" />
                   8212: <br /><label>$type: $selectform</label>
1.451     albertel 8213: <br /><label><input type="radio" name="gradingmechanism" value="attendance" $checked{'attendance'} onClick="sanitycheck()" />$attendance </label>
                   8214: <br /><label><input type="radio" name="gradingmechanism" value="personnel" $checked{'personnel'} onClick="sanitycheck()" />$personnel</label>
                   8215: <br /><label><input type="radio" name="gradingmechanism" value="specific" $checked{'specific'} onClick="sanitycheck()" />$specific </label>
1.414     www      8216: <input type="text" name="specificid" value="$env{'form.specificid'}" size="20" />
1.413     www      8217: <input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" />
                   8218: <br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onChange="sanitycheck()" /></label>
                   8219: <br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onChange="sanitycheck()" /></label>
1.400     www      8220: <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="$upload" />
                   8221: </form>
                   8222: ENDUPFORM
                   8223:     $result.='</td></tr></table>'."\n".
                   8224:              '</td></tr></table><br /><br />'."\n";
                   8225:     $result.=&show_grading_menu_form($symb);
                   8226:     return $result;
                   8227: }
                   8228: 
                   8229: sub process_clicker_file {
                   8230:     my ($r)=@_;
                   8231:     my ($symb)=&get_symb($r);
                   8232:     if (!$symb) {return '';}
1.413     www      8233: 
                   8234:     my %Saveable_Parameters=&clicker_grading_parameters();
                   8235:     &Apache::loncommon::store_course_settings('grades_clicker',
                   8236:                                               \%Saveable_Parameters);
                   8237: 
1.400     www      8238:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.404     www      8239:     if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) {
1.408     albertel 8240: 	$result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';
                   8241: 	return $result.&show_grading_menu_form($symb);
1.404     www      8242:     }
1.407     albertel 8243:     my %clicker_ids=&gather_clicker_ids();
1.408     albertel 8244:     my %correct_ids;
1.404     www      8245:     if ($env{'form.gradingmechanism'} eq 'personnel') {
1.408     albertel 8246: 	%correct_ids=&gather_adv_clicker_ids();
1.404     www      8247:     }
                   8248:     if ($env{'form.gradingmechanism'} eq 'specific') {
1.414     www      8249: 	foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {;
                   8250: 	   $correct_id=~tr/a-z/A-Z/;
                   8251: 	   $correct_id=~s/\s//gs;
                   8252: 	   $correct_id=~s/^[\#0]+//;
1.421     www      8253:            $correct_id=~s/[\-\:]//g;
1.414     www      8254:            if ($correct_id) {
                   8255: 	      $correct_ids{$correct_id}='specified';
                   8256:            }
                   8257:         }
1.400     www      8258:     }
1.404     www      8259:     if ($env{'form.gradingmechanism'} eq 'attendance') {
1.408     albertel 8260: 	$result.=&mt('Score based on attendance only');
1.404     www      8261:     } else {
1.408     albertel 8262: 	my $number=0;
1.411     www      8263: 	$result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>';
1.408     albertel 8264: 	foreach my $id (sort(keys(%correct_ids))) {
1.411     www      8265: 	    $result.='<br /><tt>'.$id.'</tt> - ';
1.408     albertel 8266: 	    if ($correct_ids{$id} eq 'specified') {
                   8267: 		$result.=&mt('specified');
                   8268: 	    } else {
                   8269: 		my ($uname,$udom)=split(/\:/,$correct_ids{$id});
                   8270: 		$result.=&Apache::loncommon::plainname($uname,$udom);
                   8271: 	    }
                   8272: 	    $number++;
                   8273: 	}
1.411     www      8274:         $result.="</p>\n";
1.408     albertel 8275: 	if ($number==0) {
                   8276: 	    $result.='<span class="LC_error">'.&mt('No IDs found to determine correct answer').'</span>';
                   8277: 	    return $result.&show_grading_menu_form($symb);
                   8278: 	}
1.404     www      8279:     }
1.405     www      8280:     if (length($env{'form.upfile'}) < 2) {
1.407     albertel 8281:         $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.',
                   8282: 		     '<span class="LC_error">',
                   8283: 		     '</span>',
                   8284: 		     '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>');
1.405     www      8285:         return $result.&show_grading_menu_form($symb);
                   8286:     }
1.410     www      8287: 
                   8288: # Were able to get all the info needed, now analyze the file
                   8289: 
1.411     www      8290:     $result.=&Apache::loncommon::studentbrowser_javascript();
1.418     albertel 8291:     $symb = &Apache::lonenc::check_encrypt($symb);
1.410     www      8292:     my $heading=&mt('Scanning clicker file');
                   8293:     $result.=(<<ENDHEADER);
                   8294: <br /><table width="100%" border="0"><tr><td bgcolor="#777777">
                   8295: <table width="100%" border="0"><tr bgcolor="#e6ffff"><td>
                   8296: <b>$heading</b></td></tr><tr bgcolor=#ffffe6><td>
                   8297: <form method="post" action="/adm/grades" name="clickeranalysis">
                   8298: <input type="hidden" name="symb" value="$symb" />
                   8299: <input type="hidden" name="command" value="assignclickergrades" />
                   8300: <input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
                   8301: <input type="hidden" name="saveState"  value="$env{'form.saveState'}" />
1.411     www      8302: <input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" />
                   8303: <input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" />
                   8304: <input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" />
1.410     www      8305: ENDHEADER
1.408     albertel 8306:     my %responses;
                   8307:     my @questiontitles;
1.405     www      8308:     my $errormsg='';
                   8309:     my $number=0;
                   8310:     if ($env{'form.upfiletype'} eq 'iclicker') {
1.408     albertel 8311: 	($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
1.406     www      8312:     }
1.419     www      8313:     if ($env{'form.upfiletype'} eq 'interwrite') {
                   8314:         ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
                   8315:     }
1.411     www      8316:     $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.
                   8317:              '<input type="hidden" name="number" value="'.$number.'" />'.
                   8318:              &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
                   8319:                  $env{'form.pcorrect'},$env{'form.pincorrect'}).
                   8320:              '<br />';
1.414     www      8321: # Remember Question Titles
                   8322: # FIXME: Possibly need delimiter other than ":"
                   8323:     for (my $i=0;$i<$number;$i++) {
                   8324:         $result.='<input type="hidden" name="question:'.$i.'" value="'.
                   8325:                  &HTML::Entities::encode($questiontitles[$i],'"&<>').'" />';
                   8326:     }
1.411     www      8327:     my $correct_count=0;
                   8328:     my $student_count=0;
                   8329:     my $unknown_count=0;
1.414     www      8330: # Match answers with usernames
                   8331: # FIXME: Possibly need delimiter other than ":"
1.409     albertel 8332:     foreach my $id (keys(%responses)) {
1.410     www      8333:        if ($correct_ids{$id}) {
1.414     www      8334:           $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />';
1.411     www      8335:           $correct_count++;
1.410     www      8336:        } elsif ($clicker_ids{$id}) {
1.437     www      8337:           if ($clicker_ids{$id}=~/\,/) {
                   8338: # More than one user with the same clicker!
                   8339:              $result.="\n<hr />".&mt('Clicker registered more than once').": <tt>".$id."</tt><br />";
                   8340:              $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
                   8341:                            "<select name='multi".$id."'>";
                   8342:              foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) {
                   8343:                  $result.="<option value='".$reguser."'>".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.')</option>';
                   8344:              }
                   8345:              $result.='</select>';
                   8346:              $unknown_count++;
                   8347:           } else {
                   8348: # Good: found one and only one user with the right clicker
                   8349:              $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />';
                   8350:              $student_count++;
                   8351:           }
1.410     www      8352:        } else {
1.411     www      8353:           $result.="\n<hr />".&mt('Unregistered Clicker')." <tt>".$id."</tt><br />";
                   8354:           $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
                   8355:                    "\n".&mt("Username").": <input type='text' name='uname".$id."' />&nbsp;".
                   8356:                    "\n".&mt("Domain").": ".
                   8357:                    &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).'&nbsp;'.
                   8358:                    &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id);
                   8359:           $unknown_count++;
1.410     www      8360:        }
1.405     www      8361:     }
1.412     www      8362:     $result.='<hr />'.
                   8363:              &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
                   8364:     if ($env{'form.gradingmechanism'} ne 'attendance') {
                   8365:        if ($correct_count==0) {
                   8366:           $errormsg.="Found no correct answers answers for grading!";
                   8367:        } elsif ($correct_count>1) {
1.414     www      8368:           $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>';
1.412     www      8369:        }
                   8370:     }
1.428     www      8371:     if ($number<1) {
                   8372:        $errormsg.="Found no questions.";
                   8373:     }
1.412     www      8374:     if ($errormsg) {
                   8375:        $result.='<br /><span class="LC_error">'.&mt($errormsg).'</span>';
                   8376:     } else {
                   8377:        $result.='<br /><input type="submit" name="finalize" value="'.&mt('Finalize Grading').'" />';
                   8378:     }
                   8379:     $result.='</form></td></tr></table>'."\n".
1.410     www      8380:              '</td></tr></table><br /><br />'."\n";
1.404     www      8381:     return $result.&show_grading_menu_form($symb);
1.400     www      8382: }
                   8383: 
1.405     www      8384: sub iclicker_eval {
1.406     www      8385:     my ($questiontitles,$responses)=@_;
1.405     www      8386:     my $number=0;
                   8387:     my $errormsg='';
                   8388:     foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
1.410     www      8389:         my %components=&Apache::loncommon::record_sep($line);
                   8390:         my @entries=map {$components{$_}} (sort(keys(%components)));
1.408     albertel 8391: 	if ($entries[0] eq 'Question') {
                   8392: 	    for (my $i=3;$i<$#entries;$i+=6) {
                   8393: 		$$questiontitles[$number]=$entries[$i];
                   8394: 		$number++;
                   8395: 	    }
                   8396: 	}
                   8397: 	if ($entries[0]=~/^\#/) {
                   8398: 	    my $id=$entries[0];
                   8399: 	    my @idresponses;
                   8400: 	    $id=~s/^[\#0]+//;
                   8401: 	    for (my $i=0;$i<$number;$i++) {
                   8402: 		my $idx=3+$i*6;
                   8403: 		push(@idresponses,$entries[$idx]);
                   8404: 	    }
                   8405: 	    $$responses{$id}=join(',',@idresponses);
                   8406: 	}
1.405     www      8407:     }
                   8408:     return ($errormsg,$number);
                   8409: }
                   8410: 
1.419     www      8411: sub interwrite_eval {
                   8412:     my ($questiontitles,$responses)=@_;
                   8413:     my $number=0;
                   8414:     my $errormsg='';
1.420     www      8415:     my $skipline=1;
                   8416:     my $questionnumber=0;
                   8417:     my %idresponses=();
1.419     www      8418:     foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
                   8419:         my %components=&Apache::loncommon::record_sep($line);
                   8420:         my @entries=map {$components{$_}} (sort(keys(%components)));
1.420     www      8421:         if ($entries[1] eq 'Time') { $skipline=0; next; }
                   8422:         if ($entries[1] eq 'Response') { $skipline=1; }
                   8423:         next if $skipline;
                   8424:         if ($entries[0]!=$questionnumber) {
                   8425:            $questionnumber=$entries[0];
                   8426:            $$questiontitles[$number]=&mt('Question [_1]',$questionnumber);
                   8427:            $number++;
1.419     www      8428:         }
1.420     www      8429:         my $id=$entries[4];
                   8430:         $id=~s/^[\#0]+//;
1.421     www      8431:         $id=~s/^v\d*\://i;
                   8432:         $id=~s/[\-\:]//g;
1.420     www      8433:         $idresponses{$id}[$number]=$entries[6];
                   8434:     }
                   8435:     foreach my $id (keys %idresponses) {
                   8436:        $$responses{$id}=join(',',@{$idresponses{$id}});
                   8437:        $$responses{$id}=~s/^\s*\,//;
1.419     www      8438:     }
                   8439:     return ($errormsg,$number);
                   8440: }
                   8441: 
1.414     www      8442: sub assign_clicker_grades {
                   8443:     my ($r)=@_;
                   8444:     my ($symb)=&get_symb($r);
                   8445:     if (!$symb) {return '';}
1.416     www      8446: # See which part we are saving to
                   8447:     my ($partlist,$handgrade,$responseType) = &response_type($symb);
                   8448: # FIXME: This should probably look for the first handgradeable part
                   8449:     my $part=$$partlist[0];
                   8450: # Start screen output
1.414     www      8451:     my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
1.416     www      8452: 
1.414     www      8453:     my $heading=&mt('Assigning grades based on clicker file');
                   8454:     $result.=(<<ENDHEADER);
                   8455: <br /><table width="100%" border="0"><tr><td bgcolor="#777777">
                   8456: <table width="100%" border="0"><tr bgcolor="#e6ffff"><td>
                   8457: <b>$heading</b></td></tr><tr bgcolor=#ffffe6><td>
                   8458: ENDHEADER
                   8459: # Get correct result
                   8460: # FIXME: Possibly need delimiter other than ":"
                   8461:     my @correct=();
1.415     www      8462:     my $gradingmechanism=$env{'form.gradingmechanism'};
                   8463:     my $number=$env{'form.number'};
                   8464:     if ($gradingmechanism ne 'attendance') {
1.414     www      8465:        foreach my $key (keys(%env)) {
                   8466:           if ($key=~/^form\.correct\:/) {
                   8467:              my @input=split(/\,/,$env{$key});
                   8468:              for (my $i=0;$i<=$#input;$i++) {
                   8469:                  if (($correct[$i]) && ($input[$i]) &&
                   8470:                      ($correct[$i] ne $input[$i])) {
                   8471:                     $result.='<br /><span class="LC_warning">'.
                   8472:                              &mt('More than one correct result given for question "[_1]": [_2] versus [_3].',
                   8473:                                  $env{'form.question:'.$i},$correct[$i],$input[$i]).'</span>';
                   8474:                  } elsif ($input[$i]) {
                   8475:                     $correct[$i]=$input[$i];
                   8476:                  }
                   8477:              }
                   8478:           }
                   8479:        }
1.415     www      8480:        for (my $i=0;$i<$number;$i++) {
1.414     www      8481:           if (!$correct[$i]) {
                   8482:              $result.='<br /><span class="LC_error">'.
                   8483:                       &mt('No correct result given for question "[_1]"!',
                   8484:                           $env{'form.question:'.$i}).'</span>';
                   8485:           }
                   8486:        }
                   8487:        $result.='<br />'.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct));
                   8488:     }
                   8489: # Start grading
1.415     www      8490:     my $pcorrect=$env{'form.pcorrect'};
                   8491:     my $pincorrect=$env{'form.pincorrect'};
1.416     www      8492:     my $storecount=0;
1.415     www      8493:     foreach my $key (keys(%env)) {
1.420     www      8494:        my $user='';
1.415     www      8495:        if ($key=~/^form\.student\:(.*)$/) {
1.420     www      8496:           $user=$1;
                   8497:        }
                   8498:        if ($key=~/^form\.unknown\:(.*)$/) {
                   8499:           my $id=$1;
                   8500:           if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {
                   8501:              $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};
1.437     www      8502:           } elsif ($env{'form.multi'.$id}) {
                   8503:              $user=$env{'form.multi'.$id};
1.420     www      8504:           }
                   8505:        }
                   8506:        if ($user) { 
1.415     www      8507:           my @answer=split(/\,/,$env{$key});
                   8508:           my $sum=0;
                   8509:           for (my $i=0;$i<$number;$i++) {
                   8510:              if ($answer[$i]) {
                   8511:                 if ($gradingmechanism eq 'attendance') {
                   8512:                    $sum+=$pcorrect;
                   8513:                 } else {
                   8514:                    if ($answer[$i] eq $correct[$i]) {
                   8515:                       $sum+=$pcorrect;
                   8516:                    } else {
                   8517:                       $sum+=$pincorrect;
                   8518:                    }
                   8519:                 }
                   8520:              }
                   8521:           }
1.416     www      8522:           my $ave=$sum/(100*$number);
                   8523: # Store
                   8524:           my ($username,$domain)=split(/\:/,$user);
                   8525:           my %grades=();
                   8526:           $grades{"resource.$part.solved"}='correct_by_override';
                   8527:           $grades{"resource.$part.awarded"}=$ave;
                   8528:           $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
                   8529:           my $returncode=&Apache::lonnet::cstore(\%grades,$symb,
                   8530:                                                  $env{'request.course.id'},
                   8531:                                                  $domain,$username);
                   8532:           if ($returncode ne 'ok') {
                   8533:              $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>";
                   8534:           } else {
                   8535:              $storecount++;
                   8536:           }
1.415     www      8537:        }
                   8538:     }
                   8539: # We are done
1.416     www      8540:     $result.='<br />'.&mt('Successfully stored grades for [_1] student(s).',$storecount).
                   8541:              '</td></tr></table>'."\n".
1.414     www      8542:              '</td></tr></table><br /><br />'."\n";
                   8543:     return $result.&show_grading_menu_form($symb);
                   8544: }
                   8545: 
1.1       albertel 8546: sub handler {
1.41      ng       8547:     my $request=$_[0];
1.434     albertel 8548:     &reset_caches();
1.257     albertel 8549:     if ($env{'browser.mathml'}) {
1.141     www      8550: 	&Apache::loncommon::content_type($request,'text/xml');
1.41      ng       8551:     } else {
1.141     www      8552: 	&Apache::loncommon::content_type($request,'text/html');
1.41      ng       8553:     }
                   8554:     $request->send_http_header;
1.44      ng       8555:     return '' if $request->header_only;
1.41      ng       8556:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.324     albertel 8557:     my $symb=&get_symb($request,1);
1.160     albertel 8558:     my @commands=&Apache::loncommon::get_env_multiple('form.command');
                   8559:     my $command=$commands[0];
1.447     foxr     8560: 
1.160     albertel 8561:     if ($#commands > 0) {
                   8562: 	&Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
                   8563:     }
1.447     foxr     8564: 
1.513   ! foxr     8565:     $ssi_error = 0;
1.353     albertel 8566:     $request->print(&Apache::loncommon::start_page('Grading'));
1.324     albertel 8567:     if ($symb eq '' && $command eq '') {
1.257     albertel 8568: 	if ($env{'user.adv'}) {
                   8569: 	    if (($env{'form.codeone'}) && ($env{'form.codetwo'}) &&
                   8570: 		($env{'form.codethree'})) {
                   8571: 		my $token=$env{'form.codeone'}.'*'.$env{'form.codetwo'}.'*'.
                   8572: 		    $env{'form.codethree'};
1.41      ng       8573: 		my ($tsymb,$tuname,$tudom,$tcrsid)=
                   8574: 		    &Apache::lonnet::checkin($token);
                   8575: 		if ($tsymb) {
1.137     albertel 8576: 		    my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);
1.41      ng       8577: 		    if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
1.513   ! foxr     8578: 			$request->print(&ssi_with_retries('/res/'.$url, $ssi_retries,
1.99      albertel 8579: 					  ('grade_username' => $tuname,
                   8580: 					   'grade_domain' => $tudom,
                   8581: 					   'grade_courseid' => $tcrsid,
                   8582: 					   'grade_symb' => $tsymb)));
1.41      ng       8583: 		    } else {
1.45      ng       8584: 			$request->print('<h3>Not authorized: '.$token.'</h3>');
1.99      albertel 8585: 		    }
1.41      ng       8586: 		} else {
1.45      ng       8587: 		    $request->print('<h3>Not a valid DocID: '.$token.'</h3>');
1.41      ng       8588: 		}
1.14      www      8589: 	    } else {
1.41      ng       8590: 		$request->print(&Apache::lonxml::tokeninputfield());
                   8591: 	    }
                   8592: 	}
                   8593:     } else {
1.285     albertel 8594: 	&init_perm();
1.104     albertel 8595: 	if ($command eq 'submission' && $perm{'vgr'}) {
1.257     albertel 8596: 	    ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
1.103     albertel 8597: 	} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
1.68      ng       8598: 	    &pickStudentPage($request);
1.103     albertel 8599: 	} elsif ($command eq 'displayPage' && $perm{'vgr'}) {
1.68      ng       8600: 	    &displayPage($request);
1.104     albertel 8601: 	} elsif ($command eq 'gradeByPage' && $perm{'mgr'}) {
1.71      ng       8602: 	    &updateGradeByPage($request);
1.104     albertel 8603: 	} elsif ($command eq 'processGroup' && $perm{'vgr'}) {
1.41      ng       8604: 	    &processGroup($request);
1.104     albertel 8605: 	} elsif ($command eq 'gradingmenu' && $perm{'vgr'}) {
1.443     banghart 8606: 	    $request->print(&grading_menu($request));
                   8607: 	} elsif ($command eq 'submit_options' && $perm{'vgr'}) {
                   8608: 	    $request->print(&submit_options($request));
1.104     albertel 8609: 	} elsif ($command eq 'viewgrades' && $perm{'vgr'}) {
1.41      ng       8610: 	    $request->print(&viewgrades($request));
1.104     albertel 8611: 	} elsif ($command eq 'handgrade' && $perm{'mgr'}) {
1.41      ng       8612: 	    $request->print(&processHandGrade($request));
1.106     albertel 8613: 	} elsif ($command eq 'editgrades' && $perm{'mgr'}) {
1.41      ng       8614: 	    $request->print(&editgrades($request));
1.106     albertel 8615: 	} elsif ($command eq 'verify' && $perm{'vgr'}) {
1.41      ng       8616: 	    $request->print(&verifyreceipt($request));
1.400     www      8617:         } elsif ($command eq 'processclicker' && $perm{'mgr'}) {
                   8618:             $request->print(&process_clicker($request));
                   8619:         } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) {
                   8620:             $request->print(&process_clicker_file($request));
1.414     www      8621:         } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) {
                   8622:             $request->print(&assign_clicker_grades($request));
1.106     albertel 8623: 	} elsif ($command eq 'csvform' && $perm{'mgr'}) {
1.72      ng       8624: 	    $request->print(&upcsvScores_form($request));
1.106     albertel 8625: 	} elsif ($command eq 'csvupload' && $perm{'mgr'}) {
1.41      ng       8626: 	    $request->print(&csvupload($request));
1.106     albertel 8627: 	} elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {
1.41      ng       8628: 	    $request->print(&csvuploadmap($request));
1.246     albertel 8629: 	} elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) {
1.257     albertel 8630: 	    if ($env{'form.associate'} ne 'Reverse Association') {
1.246     albertel 8631: 		$request->print(&csvuploadoptions($request));
1.41      ng       8632: 	    } else {
1.257     albertel 8633: 		if ( $env{'form.upfile_associate'} ne 'reverse' ) {
                   8634: 		    $env{'form.upfile_associate'} = 'reverse';
1.41      ng       8635: 		} else {
1.257     albertel 8636: 		    $env{'form.upfile_associate'} = 'forward';
1.41      ng       8637: 		}
                   8638: 		$request->print(&csvuploadmap($request));
                   8639: 	    }
1.246     albertel 8640: 	} elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
                   8641: 	    $request->print(&csvuploadassign($request));
1.106     albertel 8642: 	} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
1.75      albertel 8643: 	    $request->print(&scantron_selectphase($request));
1.203     albertel 8644:  	} elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
                   8645:  	    $request->print(&scantron_do_warning($request));
1.142     albertel 8646: 	} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {
                   8647: 	    $request->print(&scantron_validate_file($request));
1.106     albertel 8648: 	} elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
1.82      albertel 8649: 	    $request->print(&scantron_process_students($request));
1.157     albertel 8650:  	} elsif ($command eq 'scantronupload' && 
1.257     albertel 8651:  		 (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
                   8652: 		  &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
1.162     albertel 8653:  	    $request->print(&scantron_upload_scantron_data($request)); 
1.157     albertel 8654:  	} elsif ($command eq 'scantronupload_save' &&
1.257     albertel 8655:  		 (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
                   8656: 		  &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
1.157     albertel 8657:  	    $request->print(&scantron_upload_scantron_data_save($request));
1.202     albertel 8658:  	} elsif ($command eq 'scantron_download' &&
1.257     albertel 8659: 		 &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
1.162     albertel 8660:  	    $request->print(&scantron_download_scantron_data($request));
1.106     albertel 8661: 	} elsif ($command) {
1.157     albertel 8662: 	    $request->print("Access Denied ($command)");
1.26      albertel 8663: 	}
1.2       albertel 8664:     }
1.513   ! foxr     8665:     if ($ssi_error) {
        !          8666: 	&ssi_print_error($request);
        !          8667:     }
1.353     albertel 8668:     $request->print(&Apache::loncommon::end_page());
1.434     albertel 8669:     &reset_caches();
1.44      ng       8670:     return '';
                   8671: }
                   8672: 
1.1       albertel 8673: 1;
                   8674: 
1.13      albertel 8675: __END__;

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.