Annotation of loncom/homework/bridgetask.pm, revision 1.234

1.1       albertel    1: # The LearningOnline Network with CAPA 
                      2: # definition of tags that give a structure to a document
                      3: #
1.234   ! albertel    4: # $Id: bridgetask.pm,v 1.233 2007/05/03 16:51:47 albertel Exp $
1.1       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: #
                     28: ###
                     29: 
                     30: 
                     31: package Apache::bridgetask; 
                     32: 
                     33: use strict;
                     34: use Apache::lonnet;
                     35: use Apache::File();
                     36: use Apache::lonmenu;
                     37: use Apache::lonlocal;
                     38: use Apache::lonxml;
1.37      albertel   39: use Apache::slotrequest();
1.1       albertel   40: use Time::HiRes qw( gettimeofday tv_interval );
1.158     www        41: use LONCAPA;
                     42:  
1.9       albertel   43: 
1.1       albertel   44: BEGIN {
1.225     albertel   45:     &Apache::lonxml::register('Apache::bridgetask',('Task','IntroParagraph','Dimension','Question','QuestionText','Setup','Instance','InstanceText','Criteria','CriteriaText','GraderNote','ClosingParagraph'));
1.1       albertel   46: }
                     47: 
1.169     albertel   48: my %dimension;
1.194     albertel   49: my $top = 'top';
                     50: 
1.9       albertel   51: sub initialize_bridgetask {
                     52:     # id of current Dimension, 0 means that no dimension is current 
                     53:     # (inside <Task> only)
1.178     albertel   54:     @Apache::bridgetask::dimension=();
1.9       albertel   55:     # list of all current Instance ids
1.168     albertel   56:     %Apache::bridgetask::instance=();
1.9       albertel   57:     # list of all Instance ids seen in this problem
                     58:     @Apache::bridgetask::instancelist=();
1.15      albertel   59:     # key of queud user data that we are currently grading
                     60:     $Apache::bridgetask::queue_key='';
1.169     albertel   61:     undef(%dimension);
1.9       albertel   62: }
                     63: 
1.4       albertel   64: sub proctor_check_auth {
1.81      albertel   65:     my ($slot_name,$slot,$type)=@_;
1.11      albertel   66:     my $user=$env{'form.proctorname'};
                     67:     my $domain=$env{'form.proctordomain'};
1.4       albertel   68:     
                     69:     my @allowed=split(",",$slot->{'proctor'});
                     70:     foreach my $possible (@allowed) {
1.138     albertel   71: 	my ($puser,$pdom)=(split(':',$possible));
1.4       albertel   72: 	if ($puser eq $user && $pdom eq $domain) {
1.72      albertel   73: 	    my $authenticated=0;
                     74: 	    if ( $slot->{'secret'} =~ /\S/ &&
                     75: 		 $env{'form.proctorpassword'} eq $slot->{'secret'} ) {
                     76: 		$authenticated=1;
                     77: 	    } else {
                     78: 		
                     79: 		my $authhost=&Apache::lonnet::authenticate($puser,$env{'form.proctorpassword'},$pdom);
                     80: 		if ($authhost ne 'no_host') {
                     81: 		    $authenticated=1;
                     82: 		}
                     83: 	    }
1.150     albertel   84: 	    if ($authenticated) {
1.176     albertel   85: 		&check_in($type,$user,$domain,$slot_name);
1.4       albertel   86: 		return 1;
                     87: 	    }
                     88: 	}
                     89:     }
                     90:     return 0;
                     91: }
                     92: 
1.174     albertel   93: sub check_in {
                     94:     my ($type,$user,$domain,$slot_name) = @_;
                     95:     my $useslots = &Apache::lonnet::EXT("resource.0.useslots");
                     96:     if ( $useslots eq 'map_map') {
                     97: 	&check_in_sequence($user,$domain,$slot_name);
                     98:     } else {
                     99: 	&create_new_version($type,$user,$domain,$slot_name);
1.217     albertel  100: 	&Apache::structuretags::finalize_storage();
1.174     albertel  101:     }
                    102:     return 1;
                    103: }
                    104: 
                    105: sub check_in_sequence {
                    106:     my ($user,$domain,$slot_name) = @_;
                    107:     my $navmap = Apache::lonnavmaps::navmap->new();
1.185     albertel  108:     my ($symb) = &Apache::lonnet::whichuser();
1.174     albertel  109:     my ($map)  = &Apache::lonnet::decode_symb($symb);
1.175     albertel  110:     my @resources = 
                    111: 	$navmap->retrieveResources($map, sub { $_[0]->is_problem() },0,0);
1.174     albertel  112:     my %old_history = %Apache::lonhomework::history;
                    113:     my %old_results = %Apache::lonhomework::results;
                    114: 
                    115:     foreach my $res (@resources) {
                    116: 	&Apache::lonxml::debug("doing ".$res->src);
                    117: 	&Apache::structuretags::initialize_storage($res->symb);
                    118: 	my $type = ($res->is_task()) ? 'Task' : 'problem';
                    119: 	&create_new_version($type,$user,$domain,$slot_name);
                    120: 	&Apache::structuretags::finalize_storage($res->symb);
                    121:     }
                    122:     
                    123:     %Apache::lonhomework::history = %old_history;
                    124:     %Apache::lonhomework::results = %old_results;
                    125: }
                    126: 
1.150     albertel  127: sub create_new_version {
                    128:     my ($type,$user,$domain,$slot_name) = @_;
1.174     albertel  129:     
                    130:     my $id = '0';
1.150     albertel  131:     if ($type eq 'Task') {
                    132: 	# increment version
                    133: 	my $version=
                    134: 	    $Apache::lonhomework::history{'resource.0.version'};
                    135: 	$version++;
1.152     albertel  136: 	&Apache::lonxml::debug("Making version $version");
1.150     albertel  137: 	#clean out all current results
                    138: 	foreach my $key (keys(%Apache::lonhomework::history)) {
                    139: 	    if ($key=~/^resource\.0\./) {
                    140: 		$Apache::lonhomework::results{$key}='';
                    141: 	    }
                    142: 	}
                    143: 	
                    144: 	#setup new version and who did it
1.174     albertel  145:        	$Apache::lonhomework::results{'resource.0.version'}=$version;
                    146: 	$id = "$version.0";
1.178     albertel  147: 	if (!defined($user) || !defined($domain)) {
1.174     albertel  148: 	    $user = $env{'user.name'};
                    149: 	    $domain = $env{'user.domain'};
1.150     albertel  150: 	}
1.174     albertel  151: 	
1.150     albertel  152:     } elsif ($type eq 'problem') {
                    153: 	&Apache::lonxml::debug("authed $slot_name");
1.174     albertel  154:     }
1.181     albertel  155:     if (!defined($user) || !defined($domain)) {
                    156: 	$user = $env{'user.name'};
                    157: 	$domain = $env{'user.domain'};
                    158:     }
                    159: 
                    160:     $Apache::lonhomework::results{"resource.$id.checkedin"}=
                    161: 	$user.':'.$domain;
1.174     albertel  162: 
                    163:     if (defined($slot_name)) {
                    164: 	$Apache::lonhomework::results{"resource.$id.checkedin.slot"}=
                    165: 	    $slot_name;
1.150     albertel  166:     }
                    167: }
                    168: 
1.25      albertel  169: sub get_version {
1.29      albertel  170:     my ($version,$previous);
1.25      albertel  171:     if ($env{'form.previousversion'} && 
1.36      albertel  172: 	$env{'form.previousversion'} ne 'current' &&
1.89      albertel  173: 	defined($Apache::lonhomework::history{'resource.'.$env{'form.previousversion'}.'.0.status'})) {
1.29      albertel  174: 	$version=$env{'form.previousversion'};
                    175: 	$previous=1;
                    176:     } else {
1.150     albertel  177: 	if (defined($Apache::lonhomework::results{'resource.0.version'})) {
                    178: 	    $version=$Apache::lonhomework::results{'resource.0.version'};
                    179: 	} elsif (defined($Apache::lonhomework::history{'resource.0.version'})) {
                    180: 	    $version=$Apache::lonhomework::history{'resource.0.version'};
                    181: 	}
1.29      albertel  182: 	$previous=0;
                    183:     }
                    184:     if (wantarray) {
                    185: 	return ($version,$previous);
1.25      albertel  186:     }
1.29      albertel  187:     return $version;
1.25      albertel  188: }
                    189: 
1.8       albertel  190: sub add_previous_version_button {
1.25      albertel  191:     my ($status)=@_;
1.8       albertel  192:     my $result;
1.89      albertel  193:     if ($Apache::lonhomework::history{'resource.0.version'} eq '') {
1.25      albertel  194: 	return '';
                    195:     }
1.89      albertel  196:     if ($Apache::lonhomework::history{'resource.0.version'} < 2 &&
1.29      albertel  197: 	$status ne 'NEEDS_CHECKIN') {
1.25      albertel  198: 	return '';
                    199:     }
1.29      albertel  200:     my $version=&get_version();
                    201:     if ($env{'form.previousversion'} ne '' &&
                    202: 	$env{'form.previousversion'} eq $version) {
                    203: 	$result.="<h3>".&mt("Showing previous version [_1]",$version).
                    204: 	    "</h3>\n";
                    205:     }
                    206:     my @to_show;
1.89      albertel  207:     foreach my $test_version (1..$Apache::lonhomework::history{'resource.0.version'}) {
                    208: 	if (defined($Apache::lonhomework::history{'resource.'.$test_version.'.0.status'})) {
1.29      albertel  209: 	    push(@to_show,$test_version);
                    210: 	}
                    211:     }
                    212:     my $list='<option>'.
                    213: 	join("</option>\n<option>",@to_show).
                    214: 	     "</option>\n";
1.36      albertel  215:     $list.='<option value="current">'.&mt('Current').'</option>';
1.115     albertel  216:     $result.='<form name="getprevious" method="post" action="';
1.29      albertel  217:     my $uri=$env{'request.uri'};
                    218:     if ($env{'request.enc'}) { $uri=&Apache::lonenc::encrypted($uri); }
                    219:     $result.=$uri.'">'.
                    220: 	&mt(' Show a previously done version: [_1]','<select onchange="this.form.submit()" name="previousversion">
                    221: <option>'.&mt('Pick one').'</option>
                    222: '.$list.'
                    223: </select>')."</form>";
1.8       albertel  224:     return $result;
                    225: }
                    226: 
1.13      albertel  227: sub add_grading_button {
1.185     albertel  228:     my (undef,$cid)=&Apache::lonnet::whichuser();
1.59      albertel  229:     my $cnum=$env{'course.'.$cid.'.num'};
                    230:     my $cdom=$env{'course.'.$cid.'.domain'};
1.144     albertel  231:     my %sections = &Apache::loncommon::get_sections($cdom,$cnum);
                    232: 
1.59      albertel  233:     my $size=5;
                    234:     if (scalar(keys(%sections)) < 3) {
                    235: 	$size=scalar(keys(%sections))+2;
                    236:     }
1.200     albertel  237:     my $sec_select = "\n".'<select multiple="multiple" name="chosensections" size="'.$size.'">'."\n";
                    238:     $sec_select .= "\t<option value='all' selected='selected'>all</option>\n";
1.59      albertel  239:     foreach my $sec (sort {lc($a) cmp lc($b)} (keys(%sections))) {
1.200     albertel  240: 	$sec_select .= "\t<option value=\"$sec\">$sec</option>\n";
1.59      albertel  241:     }
1.200     albertel  242:     $sec_select .= "\t<option value='none'>none</option>\n</select>\n";
1.59      albertel  243:     
1.200     albertel  244:     my $result="\n\t".'<input type="submit" name="gradeasubmission" value="'.
1.13      albertel  245: 	&mt("Get a submission to grade").'" />';
1.200     albertel  246:     $result.="\n\t".'<input type="hidden" name="grade_target" value="webgrade" />';
1.40      albertel  247:     if (&Apache::lonnet::allowed('mgq',$env{'request.course.id'})) {
1.34      albertel  248: 	my ($entries,$ready,$locks)=&get_queue_counts('gradingqueue');
1.200     albertel  249: 	$result.="\n\t".'<table>'."\n\t\t".'<tr>';
                    250: 	$result.="\n\t\t\t".'<td rowspan="4">Specify a section: </td>'.
                    251: 	    "\n\t\t\t".'<td rowspan="4">'.$sec_select."\n\t\t\t".'</td>';
                    252: 	$result.="\n\t\t\t".'<td>'.'<input type="submit" name="reviewagrading" value="'.
1.106     albertel  253: 	    &mt("Select an entry from the grading queue:").'" /> ';
1.34      albertel  254: 
1.200     albertel  255: 	$result.= "\n\t\t\t\t".&mt("[_1] entries, [_2] ready, [_3] being graded",$entries,$ready,$locks).'</td>'."\n\t\t".'</tr>'."\n";
1.34      albertel  256: 
                    257: 	($entries,$ready,$locks)=&get_queue_counts('reviewqueue');
1.200     albertel  258: 	$result.="\n\t\t".'<tr>'.
                    259: 	    "\n\t\t\t".'<td>'.
                    260: 	    "\n\t\t\t\t".'<input type="submit" name="reviewasubmission" value="'.
1.106     albertel  261: 	    &mt("Select an entry from the review queue:").'" /> ';
                    262: 	$result.=&mt("[_1] entries, [_2] ready, [_3] being graded",
1.200     albertel  263: 		     $entries,$ready,$locks).'</td>'."\n\t\t".'</tr>'."\n";
                    264: 	$result.="\n\t\t".'<tr>'.
                    265: 	    "\n\t\t\t".'<td>'.
                    266: 	    "\n\t\t\t\t".'<input type="submit" name="regradeasubmission" value="'.
                    267: 	    &mt("List of user's grade status").'" /> </td>'
                    268: 	    ."\n\t\t".'</tr>'
                    269: 	    ."\n\t".'</table>'."\n";
                    270: 	$result.="\n\t".'<p>'.
                    271: 	    "\n\t\t".'<input type="submit" name="regradeaspecificsubmission" value="'.
                    272: 	    &mt("Regrade specific user:").'" />';
                    273: 	$result.= "\n\t\t".'<input type="text" size="12" name="gradinguser" />';
1.105     albertel  274: 	$result.=&Apache::loncommon::select_dom_form($env{'user.domain'},
                    275: 						     'gradingdomain');
                    276: 	$result.=' '.
                    277: 	    &Apache::loncommon::selectstudent_link('gradesubmission',
                    278: 						   'gradinguser',
                    279: 						   'gradingdomain');
                    280: 	$result.=&Apache::loncommon::studentbrowser_javascript();
1.200     albertel  281: 	$result.= '</p>'."\n";
1.144     albertel  282:     }
1.13      albertel  283:     return $result;
                    284: }
                    285: 
1.22      albertel  286: sub add_request_another_attempt_button {
1.38      albertel  287:     my ($text)=@_;
                    288:     if (!$text) { $text="Request another attempt"; }
1.25      albertel  289:     my $result;
1.36      albertel  290:     my $symb=&Apache::lonnet::symbread();
1.149     albertel  291:     # not a slot access based resource
                    292:     my $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb);
                    293:     if ($useslots =~ /^\s*no\s*$/i) {
                    294: 	return '';
                    295:     }
                    296: 
1.37      albertel  297:     my ($slot_name,$slot)=&Apache::slotrequest::check_for_reservation($symb);
1.38      albertel  298:     my $action='get_reservation';
1.37      albertel  299:     if ($slot_name) {
1.38      albertel  300: 	$text="Change reservation.";
                    301: 	$action='change_reservation';
1.37      albertel  302: 	my $description=&Apache::slotrequest::get_description($slot_name,
                    303: 							      $slot);
                    304: 	$result.=(<<STUFF);
1.200     albertel  305:     <p> Will be next available: $description </p>
1.37      albertel  306: STUFF
                    307:     }
1.38      albertel  308:     
                    309:     if ($env{'request.enc'}) { $symb=&Apache::lonenc::encrypted($symb); }
1.158     www       310:     $symb=&escape($symb);
1.200     albertel  311:     $result.=
                    312:         "\n\t".'<form method="post" action="/adm/slotrequest">'."\n\t\t".
                    313: 	'<input type="hidden" name="symb" value="'.$symb.'" />'."\n\t\t".
                    314: 	'<input type="hidden" name="command" value="'.$action.'" />'."\n\t\t".
1.38      albertel  315: 	'<input type="submit" name="requestattempt" value="'.
1.200     albertel  316: 	&mt($text).'" />'."\n\t".
                    317: 	'</form>'."\n";
1.25      albertel  318:     return $result;
1.22      albertel  319: }
                    320: 
1.30      albertel  321: sub preserve_grade_info {
                    322:     my $result;
                    323:     # if we are viewing someone else preserve that info
                    324:     if (defined $env{'form.grade_symb'}) {
                    325: 	foreach my $field ('symb','courseid','domain','username') {
                    326: 	    $result .= '<input type="hidden" name="grade_'.$field.
                    327: 		'" value="'.$env{"form.grade_$field"}.'" />'."\n";
                    328: 	}
                    329:     }
                    330:     return $result;
                    331: }
                    332: 
1.53      albertel  333: sub style {
1.125     albertel  334:     my ($target) = @_;
                    335:     if ($target eq 'web'
                    336: 	|| $target eq 'webgrade') {
1.192     albertel  337: 	my $style = (<<STYLE);
1.126     albertel  338: <link rel="stylesheet" type="text/css" href="/res/adm/includes/task.css" />
1.53      albertel  339: STYLE
1.192     albertel  340:         if ($env{'browser.type'} eq 'explorer'
                    341: 	    && $env{'browser.os'} eq 'win' ) {
                    342: 	    if ($env{'browser.version'} < 7) {
                    343: 		$style .= (<<STYLE);
                    344: <link rel="stylesheet" type="text/css" href="/res/adm/includes/task_ie.css" />
                    345: STYLE
                    346:             } else {
                    347: 		$style .= (<<STYLE);
                    348: <link rel="stylesheet" type="text/css" href="/res/adm/includes/task_ie7.css" />
                    349: STYLE
                    350: 	    }
                    351: 	}
1.193     albertel  352: 	return $style;
1.125     albertel  353:     }
                    354:     return;
1.53      albertel  355: }
                    356: 
1.54      albertel  357: sub show_task {
                    358:     my ($status,$previous)=@_;
                    359:     if (!$previous && (
                    360: 		       ( $status eq 'CLOSED' ) ||
                    361: 		       ( $status eq 'BANNED') ||
                    362: 		       ( $status eq 'UNAVAILABLE') ||
                    363: 		       ( $status eq 'NOT_IN_A_SLOT') ||
                    364: 		       ( $status eq 'NEEDS_CHECKIN') ||
                    365: 		       ( $status eq 'WAITING_FOR_GRADE') ||
1.150     albertel  366: 		       ( $status eq 'INVALID_ACCESS') ||
                    367: 		       ( &get_version() eq ''))) {
1.54      albertel  368: 	return 0;
                    369:     }
1.64      albertel  370:     if ($env{'form.donescreen'}) { return 0; }
1.54      albertel  371:     return 1;
                    372: }
                    373: 
1.173     albertel  374: my @delay;
                    375: sub nest { 
                    376:     if (@delay) {
                    377: 	return $delay[-1];
                    378:     } else {
                    379: 	return;
                    380:     }
                    381: }
                    382: 
1.208     albertel  383: sub start_delay {
                    384:     push(@delay,1);
                    385: }
                    386: sub end_delay {
                    387:     pop(@delay);
                    388: }
                    389: 
1.173     albertel  390: sub nested_parse {
                    391:     my ($str,$env,$args) = @_;
                    392:     my @old_env = @Apache::scripttag::parser_env;
                    393:     @Apache::scripttag::parser_env = @$env;
                    394:     if (exists($args->{'set_dim_id'})) {
                    395: 	&enable_dimension_parsing($args->{'set_dim_id'});
                    396:     }
                    397:     push(@delay,(($args->{'delayed_dim_results'})? 1 : 0));
                    398:     my $result = &Apache::scripttag::xmlparse($$str);
                    399:     pop(@delay);
                    400:     if (exists($args->{'set_dim_id'})) {
                    401: 	&disable_dimension_parsing();
                    402:     }
                    403:     @Apache::scripttag::parser_env = @old_env;
                    404:     if ($args->{'delayed_dim_results'}) {
                    405: 	my $dim = &get_dim_id();
1.180     albertel  406: 	&Apache::lonxml::debug(" tossing out $result ");
                    407: 	&Apache::lonxml::debug(" usining out $dim 's  ". $dimension{$dim}{'result'});
1.173     albertel  408: 	return $dimension{$dim}{'result'};
                    409:     }
                    410:     return $result;
                    411: }
                    412: 
1.54      albertel  413: sub internal_location {
                    414:     my ($id)=@_;
                    415:     return '<!-- LONCAPA_INTERNAL_ADD_TASK_STATUS'.$id.' -->';
                    416: }
                    417: 
1.60      albertel  418: sub submission_time_stamp {
1.185     albertel  419:     my ($symb,$courseid,$udom,$uname)=&Apache::lonnet::whichuser();
1.60      albertel  420:     my $submissiontime;
1.89      albertel  421:     my $version=$Apache::lonhomework::history{'resource.0.version'};
1.60      albertel  422:     for (my $v=$Apache::lonhomework::history{'version'};$v>0;$v--) {
1.183     albertel  423: 	if (defined($Apache::lonhomework::history{$v.':resource.'.$version.'.0.bridgetask.portfiles'})
                    424: 	    && defined($Apache::lonhomework::history{$v.':resource.'.$version.'.0.tries'})) {
1.60      albertel  425: 	    $submissiontime=$Apache::lonhomework::history{$v.':timestamp'};
1.182     albertel  426: 	    last;
1.60      albertel  427: 	}
                    428:     }
                    429:     my $result;
                    430:     if ($submissiontime) {
1.89      albertel  431: 	my $slot_name=$Apache::lonhomework::history{'resource.'.$version.'.0.checkedin.slot'};
1.60      albertel  432: 	my %slot=&Apache::lonnet::get_slot($slot_name);
                    433: 	my $diff = $slot{'endtime'} - $submissiontime;
1.71      albertel  434: 	my ($color,$when)=('#FF6666','after');
                    435: 	if ($diff > 0) { ($color,$when)=('#336600','before'); }
1.60      albertel  436: 	my $info;
1.182     albertel  437: 	$diff = abs($diff);
1.60      albertel  438: 	if ($diff%60) { $info=($diff%60).' seconds'; }
                    439: 	$diff=int($diff/60);
                    440: 	if ($diff%60) { $info=($diff%60).' minutes '.$info; }
                    441: 	$diff=int($diff/60);
                    442: 	if ($diff) {    $info=$diff.' hours '.$info; }
                    443: 	$result='<p><font color="'.$color.'">'.
1.182     albertel  444: 	    &mt('Student submitted [_1] [_2] the deadline. '.
                    445: 		'(Submission was at [_3], end of period was [_4].)',
                    446: 		$info,$when,
                    447: 		&Apache::lonlocal::locallocaltime($submissiontime),
                    448: 		&Apache::lonlocal::locallocaltime($slot{'endtime'})).
1.60      albertel  449: 		'</font></p>';
                    450:     }
                    451:     return $result;
                    452: }
                    453: 
1.119     albertel  454: sub file_list {
                    455:     my ($files,$uname,$udom) = @_;
                    456:     if (!defined($uname) || !defined($udom)) {
1.185     albertel  457: 	(undef,undef,$udom,$uname) = &Apache::lonnet::whichuser();
1.119     albertel  458:     }
1.70      albertel  459:     my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio/';
1.119     albertel  460: 
1.120     albertel  461:     my $file_list="<ul class=\"LC_GRADING_handininfo\">\n";
1.119     albertel  462:     foreach my $partial_file (split(',',$files)) {
1.70      albertel  463: 	my $file=$file_url.$partial_file;
                    464: 	$file=~s|/+|/|g;
                    465: 	&Apache::lonnet::allowuploaded('/adm/bridgetask',$file);
1.161     albertel  466: 	$file_list.='<li><span style="white-space: nowrap;"><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.
                    467: 	    &Apache::loncommon::icon($file).'" alt="file icon" border="0" /> '.$file.
                    468: 	    '</a></span></li>'."\n";
1.70      albertel  469:     }
                    470:     $file_list.="</ul>\n";
1.119     albertel  471:     return $file_list;
                    472: }
                    473: 
1.163     albertel  474: sub grade_mode {
                    475:     if ($env{'form.regrade'} || $env{'form.regradeaspecificsubmission'}) {
                    476: 	return 'regrade';
                    477:     }
                    478:     return 'queue_grade';
                    479: }
                    480: 
1.119     albertel  481: sub webgrade_standard_info {
                    482:     my ($version)=&get_version();
                    483: 
                    484:     my $file_list = &file_list($Apache::lonhomework::history{"resource.$version.0.bridgetask.portfiles"});
1.70      albertel  485: 
1.163     albertel  486:     my %lt=('done'   => 'Next Item',
                    487: 	    'stop'   => 'Quit Grading',
                    488: 	    'fail'   => 'Fail Rest',
                    489: 	    'cancel' => 'Cancel',
1.231     albertel  490: 	    'submit' => 'Submit Grades',
1.163     albertel  491: 	    );
1.170     albertel  492:     %lt=&Apache::lonlocal::texthash(%lt);
1.163     albertel  493: 
1.70      albertel  494:     my $result=<<INFO;
1.120     albertel  495:   <div class="LC_GRADING_maincontrols">
1.163     albertel  496: INFO
                    497: 
1.231     albertel  498:     if ($env{'request.state'} eq 'construct') {
1.163     albertel  499: 	$result.=<<INFO;
1.231     albertel  500:     <input type="submit" name="next" value="$lt{'submit'}" />
                    501: INFO
                    502:     } else {
                    503: 	if (&grade_mode() eq 'regrade' && $env{'request.state'} ne 'construct') {
                    504: 	    $result.=<<INFO;
1.163     albertel  505:     <input type="submit" name="cancel" value="$lt{'cancel'}" />
                    506: INFO
1.231     albertel  507:         }
1.163     albertel  508: 
1.231     albertel  509: 	$result.=<<INFO;
1.111     albertel  510:     <input type="submit" name="next" value="$lt{'done'}" />
                    511:     <input type="submit" name="stop" value="$lt{'stop'}" />
1.231     albertel  512: INFO
                    513:     }
                    514:     $result.=<<INFO;
1.143     albertel  515:     <input type="button" name="fail" value="$lt{'fail'}" 
                    516:            onclick="javascript:onFailRest()" />
1.111     albertel  517:   </div>
1.70      albertel  518:   $file_list
                    519: INFO
                    520:     return $result;
1.231     albertel  521: 
1.70      albertel  522: }
                    523: 
1.166     albertel  524: sub done_screen {
                    525:     my ($version) = @_;
1.231     albertel  526:     my $title=&Apache::lonnet::gettitle($env{'request.uri'});
1.166     albertel  527:     my @files=split(',',$Apache::lonhomework::history{'resource.'.$version.'.0.bridgetask.portfiles'});
1.185     albertel  528:     my (undef,undef,$domain,$user)= &Apache::lonnet::whichuser();
1.166     albertel  529:     my $files = '<ul>';
1.167     albertel  530:     my $msg;
1.166     albertel  531:     foreach my $file (@files) {
                    532: 	my $url="/uploaded/$domain/$user/portfolio$file";
                    533: 	if (! &Apache::lonnet::stat_file($url)) {
                    534: 	    $file = &mt('<span class="LC_error"> Nonexistent file:</span> '.
                    535: 			'<span class="LC_filename">[_1]</span>',$file);
1.167     albertel  536: 	    $msg .= "<p>Submitted non-existant file $file</p>\n";
1.166     albertel  537: 	} else {
                    538: 	    $file = '<span class="LC_filename">'.$file.'</span>';
1.167     albertel  539: 	    $msg .= "<p>Submitted file $file</p>\n";
1.166     albertel  540: 	}
                    541: 	$files .= '<li>'.$file.'</li>';
                    542:     }
                    543:     $files.='</ul>';
1.167     albertel  544:     my $subject = "Submission message for $title";
                    545:     my ($message_status,$comment_status);
                    546:     my $setting = $env{'course.'.$env{'request.course.id'}.'.task_messages'};
                    547:     $setting =~ s/^\s*(\S*)\s*$/$1/;
                    548:     $setting = lc($setting);
                    549:     if ($setting eq 'only_student'
                    550: 	|| $setting eq 'student_and_user_notes_screen') {
                    551: 	$message_status =
                    552: 	    &Apache::lonmsg::user_normal_msg($user,$domain,$subject,$msg);
                    553: 	$message_status = '<p>'.&mt('Message sent to user: [_1]',
                    554: 				    $message_status).' </p>';
                    555:     }
                    556:     if ($setting eq 'student_and_user_notes_screen') {
                    557: 	$comment_status = 
                    558: 	    &Apache::lonmsg::store_instructor_comment($subject.'<br />'.
                    559: 						      $msg,$user,$domain);
                    560: 	$comment_status = '<p>'.&mt('Message sent to instructor: [_1]',
                    561: 				    $comment_status).' </p>';
                    562:     }
1.166     albertel  563:     return <<DONESCREEN;
                    564: <h2>$title</h2>
                    565: <p> Files submitted: $files </p>
                    566: <p> You are now done with this Bridge Task </p>
                    567: <hr />
                    568: <p> <a href="/adm/logout">Logout</a> </p>
                    569: <p> <a href="/adm/roles">Change to a different course</a> </p>
1.167     albertel  570: $message_status
                    571: $comment_status
1.166     albertel  572: DONESCREEN
                    573: 
                    574: }
                    575: 
1.1       albertel  576: sub start_Task {
1.87      albertel  577:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel  578: 
1.4       albertel  579:     my ($status,$accessmsg,$slot);
1.179     albertel  580:     &Apache::structuretags::init_problem_globals('Task');
1.16      albertel  581:     if ($target ne 'webgrade') {
                    582: 	&Apache::structuretags::initialize_storage();
                    583: 	&Apache::lonhomework::showhash(%Apache::lonhomework::history);
1.74      albertel  584: 	if ($env{'request.state'} eq 'construct') {
                    585: 	    &Apache::structuretags::setup_rndseed($safeeval);
                    586: 	}
1.16      albertel  587:     } 
                    588: 
1.4       albertel  589:     $Apache::lonhomework::parsing_a_task=1;
1.141     albertel  590: 
                    591:     my $name;
                    592:     if ($target eq 'web' || $target eq 'webgrade') {
                    593: 	$name = &Apache::structuretags::get_resource_name($parstack,$safeeval);
                    594:     }
                    595: 
1.145     albertel  596:     my ($result,$form_tag_start);
                    597:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'tex'
                    598: 	|| $target eq 'edit') {
                    599: 	($result,$form_tag_start) =
                    600: 	    &Apache::structuretags::page_start($target,$token,$tagstack,
                    601: 					       $parstack,$parser,$safeeval,
1.146     albertel  602: 					       $name,&style($target));
1.145     albertel  603:     }
1.123     albertel  604: 
1.74      albertel  605:     if ($target eq 'web' && $env{'request.state'} ne 'construct') {
1.147     albertel  606: 	if ($Apache::lonhomework::queuegrade
                    607: 	    || $Apache::lonhomework::modifygrades) {
1.141     albertel  608: 	    $result.='<form name="gradesubmission" method="post" action="';
1.13      albertel  609: 	    my $uri=$env{'request.uri'};
                    610: 	    if ($env{'request.enc'}) { $uri=&Apache::lonenc::encrypted($uri); }
1.200     albertel  611: 	    $result.=$uri.'">'.&add_grading_button()."</form>\n";
1.38      albertel  612: 	    my $symb=&Apache::lonnet::symbread();
1.40      albertel  613: 	    if (&Apache::lonnet::allowed('mgq',$env{'request.course.id'})) {
1.141     albertel  614: 		$result.='<form method="post" name="slotrequest" action="/adm/slotrequest">'.
1.40      albertel  615: 		    '<input type="hidden" name="symb" value="'.$symb.'" />'.
                    616: 		    '<input type="hidden" name="command" value="showslots" />'.
                    617: 		    '<input type="submit" name="requestattempt" value="'.
                    618: 		    &mt('Show Slot list').'" />'.
                    619: 		    '</form>';
1.108     albertel  620: 		my $target_id = 
                    621: 		    &Apache::lonstathelpers::make_target_id({symb => $symb,
                    622: 							     part => '0'});
1.141     albertel  623: 		$result.='<form method="post" name="gradingstatus" action="/adm/statistics">'.
1.108     albertel  624: 		    '<input type="hidden" name="problemchoice" value="'.$target_id.'" />'.
                    625: 		    '<input type="hidden" name="reportSelected" value="grading_analysis" />'.
                    626: 		    '<input type="submit" name="grading" value="'.
                    627: 		    &mt('Show Grading Status').'" />'.
                    628: 		    '</form>';
1.40      albertel  629: 	    }
1.13      albertel  630: 	}
1.8       albertel  631:     }
1.231     albertel  632:     if ($target =~/(web|webgrade)/ && $env{'request.state'} eq 'construct') {
1.74      albertel  633: 	$form_tag_start.=&Apache::structuretags::problem_web_to_edit_header($env{'form.rndseed'});
                    634:     }
1.163     albertel  635:     if ($target eq 'web' 
                    636: 	|| ($target eq 'grade' && !$env{'form.webgrade'}) 
                    637: 	|| $target eq 'answer' 
                    638: 	|| $target eq 'tex') {
1.29      albertel  639: 	my ($version,$previous)=&get_version();
1.14      albertel  640: 	($status,$accessmsg,my $slot_name,$slot) = 
1.81      albertel  641: 	    &Apache::lonhomework::check_slot_access('0','Task');
1.152     albertel  642: 	if ($status eq 'CAN_ANSWER' && $version eq '') {
1.177     albertel  643: 	    # CAN_ANSWER mode, and no current version, unproctored access
1.174     albertel  644: 	    # thus self-checkedin
1.177     albertel  645: 	    &check_in('Task',undef,undef,$slot_name);
1.152     albertel  646: 	    &add_to_queue('gradingqueue',{'type' => 'Task',
                    647: 					  'time' => time,
                    648: 					  'slot' => $slot_name});
1.150     albertel  649: 	    ($version,$previous)=&get_version();
                    650: 	}
1.218     albertel  651: 	
                    652: 	my $status_id = 
                    653: 	    ($previous || $status eq 'SHOW_ANSWER') ? 'LC_task_feedback'
                    654: 	                                            : 'LC_task_take';
                    655: 	$result .= '<div class="LC_task" id="'.$status_id.'">'."\n";
1.150     albertel  656: 
1.9       albertel  657: 	push(@Apache::inputtags::status,$status);
1.14      albertel  658: 	$Apache::inputtags::slot_name=$slot_name;
1.1       albertel  659: 	my $expression='$external::datestatus="'.$status.'";';
1.89      albertel  660: 	$expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.$version.0.solved"}.'";';
1.1       albertel  661: 	&Apache::run::run($expression,$safeeval);
                    662: 	&Apache::lonxml::debug("Got $status");
1.141     albertel  663: 	$result.=&add_previous_version_button($status);
1.54      albertel  664: 	if (!&show_task($status,$previous)) {
1.87      albertel  665: 	    my $bodytext=&Apache::lonxml::get_all_text("/task",$parser,$style);
1.1       albertel  666: 	    if ( $target eq "web" ) {
1.74      albertel  667: 		if ($env{'request.state'} eq 'construct') {
                    668: 		    $result.=$form_tag_start;
                    669: 		}
1.4       albertel  670: 		my $msg;
1.1       albertel  671: 		if ($status eq 'UNAVAILABLE') {
                    672: 		    $msg.='<h1>'.&mt('Unable to determine if this resource is open due to network problems. Please try again later.').'</h1>';
1.3       albertel  673: 		} elsif ($status eq 'NOT_IN_A_SLOT') {
                    674: 		    $msg.='<h1>'.&mt('You are not currently signed up to work at this time and/or place.').'</h1>';
1.38      albertel  675: 		    $msg.=&add_request_another_attempt_button("Sign up for time to work.");
1.4       albertel  676: 		} elsif ($status eq 'NEEDS_CHECKIN') {
                    677: 		    $msg.='<h1>'.&mt('You need the Proctor to validate you.').
                    678: 			'</h1>'.&proctor_validation_screen($slot);
1.22      albertel  679: 		} elsif ($status eq 'WAITING_FOR_GRADE') {
                    680: 		    $msg.='<h1>'.&mt('Your submission is in the grading queue.').'</h1>';
1.64      albertel  681: 		} elsif ($env{'form.donescreen'}) {
1.167     albertel  682: 		    $result .= &done_screen($version);
1.1       albertel  683: 		} elsif ($status ne 'NOT_YET_VIEWED') {
                    684: 		    $msg.='<h1>'.&mt('Not open to be viewed').'</h1>';
                    685: 		}
                    686: 		if ($status eq 'CLOSED' || $status eq 'INVALID_ACCESS') {
                    687: 		    $msg.='The problem '.$accessmsg;
                    688: 		}
                    689: 		$result.=$msg.'<br />';
                    690: 	    } elsif ($target eq 'tex') {
                    691: 		$result.='\begin{document}\noindent \vskip 1 mm  \begin{minipage}{\textwidth}\vskip 0 mm';
                    692: 		if ($status eq 'UNAVAILABLE') {
                    693: 		    $result.=&mt('Unable to determine if this resource is open due to network problems. Please try again later.').'\vskip 0 mm ';
                    694: 		} else {
                    695: 		    $result.=&mt('Problem is not open to be viewed. It')." $accessmsg \\vskip 0 mm ";
                    696: 		}
1.22      albertel  697: 	    } elsif ($target eq 'grade' && !$env{'form.webgrade'}) {
1.4       albertel  698: 		if ($status eq 'NEEDS_CHECKIN') {
1.83      albertel  699: 		    if(&proctor_check_auth($slot_name,$slot,'Task')
                    700: 		       && defined($Apache::inputtags::slot_name)) {
1.148     albertel  701: 			my $result=
                    702: 			    &add_to_queue('gradingqueue',
1.152     albertel  703: 					  {'type' => 'Task',
1.148     albertel  704: 					   'time' => time,
                    705: 					   'slot' => 
                    706: 					       $Apache::inputtags::slot_name});
1.77      albertel  707: 			&Apache::lonxml::debug("add_to_queue said $result");
                    708: 		    }
1.4       albertel  709: 		}
1.1       albertel  710: 	    }
                    711: 	} elsif ($target eq 'web') {
1.141     albertel  712: 
1.57      albertel  713: 	    $result.=&preserve_grade_info();
1.194     albertel  714: 	    $result.=&internal_location(); 
1.200     albertel  715: 	    $result.=$form_tag_start."\t".
1.36      albertel  716: 		'<input type="hidden" name="submitted" value="yes" />';
1.54      albertel  717: 	    &Apache::lonxml::startredirection();
1.1       albertel  718: 	}
1.21      albertel  719:     } elsif ( ($target eq 'grade' && $env{'form.webgrade'}) ||
                    720: 	      $target eq 'webgrade') {
1.32      albertel  721: 	my $webgrade='yes';
1.21      albertel  722: 	if ($target eq 'webgrade') {
1.218     albertel  723: 	    $result .= '<div class="LC_task">'."\n";
1.141     albertel  724: 	    $result.= "\n".'<div class="LC_GRADING_task">'."\n".
1.124     albertel  725: 		'<script type="text/javascript" 
1.126     albertel  726:                          src="/res/adm/includes/task_grading.js"></script>';
1.49      albertel  727: 	    #$result.='<br />Review'.&show_queue('reviewqueue');
                    728: 	    #$result.='<br />Grade'.&show_queue('gradingqueue');
1.30      albertel  729: 	}
1.194     albertel  730: 
1.105     albertel  731: 	my ($todo,$status_code,$msg)=&get_key_todo($target);
1.33      albertel  732: 
                    733: 	if ($todo) {
                    734: 	    &setup_env_for_other_user($todo,$safeeval);
                    735: 	    my ($symb,$uname,$udom)=&decode_queue_key($todo);
1.231     albertel  736: 	    if ($env{'request.state'} eq 'construct') {
                    737: 		$symb = $env{'request.uri'};
                    738: 	    }
                    739: 	    $result.="\n".'<p>'.
                    740: 		&mt('Grading [_1] for [_2] at [_3]',
                    741: 		    &Apache::lonnet::gettitle($symb),$uname,$udom).'</p>';
1.33      albertel  742: 	    $form_tag_start.=
                    743: 		'<input type="hidden" name="gradingkey" value="'.
1.158     www       744: 		&escape($todo).'" />';
1.33      albertel  745: 	    $Apache::bridgetask::queue_key=$todo;
                    746: 	    &Apache::structuretags::initialize_storage();
                    747: 	    &Apache::lonhomework::showhash(%Apache::lonhomework::history);
1.110     albertel  748: 	    if ($target eq 'webgrade' && $status_code eq 'selected') {
                    749: 		$form_tag_start.=
                    750: 		    '<input type="hidden" name="queuemode" value="selected" />';
1.33      albertel  751: 	    }
1.15      albertel  752: 	} else {
1.33      albertel  753: 	    if ($target eq 'webgrade') {
                    754: 		$result.="\n";
1.81      albertel  755: 		my $back='<p><a href="/adm/flip?postdata=return:">'.
                    756: 		    &mt('Return to resource').'</a></p>';
1.33      albertel  757: 		if      ($status_code eq 'stop') {
1.81      albertel  758: 		    $result.='<b>'.&mt("Stopped grading.").'</b>'.$back;
1.163     albertel  759: 		} elsif ($status_code eq 'cancel') {
                    760: 		    $result.='<b>'.&mt("Cancelled grading.").'</b>'.$back;
1.164     albertel  761: 		} elsif ($status_code eq 'never_versioned') {
                    762: 		    $result.='<b>'.
                    763: 			&mt("Requested user has never accessed the task.").
                    764: 			'</b>'.$back;
1.165     albertel  765: 		} elsif ($status_code =~ /still_open:(.*)/) {
                    766: 		    my $date = &Apache::lonlocal::locallocaltime($1);
                    767: 		    $result.='<b>'.
                    768: 			&mt("Task is still open, will close at [_1].",$date).
                    769: 			'</b>'.$back;
1.33      albertel  770: 		} elsif ($status_code eq 'lock_failed') {
1.105     albertel  771: 		    $result.='<b>'.&mt("Failed to lock the requested record.")
1.81      albertel  772: 			.'</b>'.$back;
1.33      albertel  773: 		} elsif ($status_code eq 'unlock') {
1.81      albertel  774: 		    $result.='<b>'.&mt("Unlocked the requested record.")
                    775: 			.'</b>'.$back;
1.33      albertel  776: 		    $result.=&show_queue($env{'form.queue'},1);
                    777: 		} elsif ($status_code eq 'show_list') {
                    778: 		    $result.=&show_queue($env{'form.queue'},1);
1.49      albertel  779: 		} elsif ($status_code eq 'select_user') {
                    780: 		    $result.=&select_user();
1.95      albertel  781: 		} elsif ($status_code eq 'unable') {
                    782: 		    $result.='<b>'.&mt("Unable to aqcuire a user to grade.").'</b>'.$back;
1.105     albertel  783: 		} elsif ($status_code eq 'not_allowed') {
                    784: 		    $result.='<b>'.&mt('Not allowed to grade the requested user.').' '.$msg.'</b>'.$back;
1.33      albertel  785: 		} else {
1.81      albertel  786: 		    $result.='<b>'.&mt("No user to be graded.").'</b>'.$back;
1.32      albertel  787: 		}
1.21      albertel  788: 	    }
1.33      albertel  789: 	    $webgrade='no';
1.163     albertel  790: 	}
                    791: 	if (!$todo || $env{'form.cancel'}) {
1.87      albertel  792: 	    my $bodytext=&Apache::lonxml::get_all_text("/task",$parser,$style);
1.32      albertel  793: 	}
                    794: 	if ($target eq 'webgrade' && defined($env{'form.queue'})) {
1.61      albertel  795: 	    if ($webgrade eq 'yes') {
                    796: 		$result.=&submission_time_stamp();
                    797: 	    }
1.32      albertel  798: 	    $result.=$form_tag_start;
                    799: 	    $result.='<input type="hidden" name="webgrade" value="'.
                    800: 		$webgrade.'" />';
                    801: 	    $result.='<input type="hidden" name="queue" value="'.
                    802: 		$env{'form.queue'}.'" />';
1.52      albertel  803: 	    if ($env{'form.regrade'}) {
                    804: 		$result.='<input type="hidden" name="regrade" value="'.
                    805: 		    $env{'form.regrade'}.'" />';
                    806: 	    }
1.62      albertel  807: 	    if ($env{'form.chosensections'}) {
                    808: 		my @chosen_sections=
                    809: 		    &Apache::loncommon::get_env_multiple('form.chosensections');
                    810: 		foreach my $sec (@chosen_sections) {
                    811: 		    $result.='<input type="hidden" name="chosensections" 
                    812:                                value="'.$sec.'" />';
                    813: 		}
                    814: 	    }
1.70      albertel  815: 	    if ($webgrade eq 'yes') { $result.=&webgrade_standard_info(); }
1.231     albertel  816: 	} elsif ($target eq 'webgrade' 
                    817: 		 && $env{'request.state'} eq 'construct') {
                    818: 	    $result.=$form_tag_start;
                    819: 	    $result.='<input type="hidden" name="webgrade" value="'.
                    820: 		$webgrade.'" />';
                    821: 	    $result.=&webgrade_standard_info();
1.15      albertel  822: 	}
1.110     albertel  823: 	if ($target eq 'webgrade') {
1.120     albertel  824: 	    $result.="\n".'<div id="LC_GRADING_criterialist">';
1.194     albertel  825: 	    &Apache::lonxml::startredirection();
1.208     albertel  826: 	    &start_delay();
                    827: 	    $dimension{$top}{'result'}=$result;
                    828: 	    undef($result);
1.110     albertel  829: 	}
1.74      albertel  830:     } elsif ($target eq 'edit') {
1.141     albertel  831: 	$result.=$form_tag_start.
1.74      albertel  832: 	    &Apache::structuretags::problem_edit_header();
                    833: 	$Apache::lonxml::warnings_error_header=
                    834: 	    &mt("Editor Errors - these errors might not effect the running of the problem, but they will likely cause problems with further use of the Edit mode. Please use the EditXML mode to fix these errors.")."<br />";
1.225     albertel  835: 	$result.= &Apache::edit::text_arg('Required number of passed optional elements to pass the Task:','OptionalRequired',$token,10)." <br />\n";
                    836: 	$result.= &Apache::edit::insertlist($target,$token);
                    837:     } elsif ($target eq 'modified') {
                    838: 	my $constructtag=
                    839: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,
                    840: 					'OptionalRequired');
                    841: 	if ($constructtag) {
                    842: 	    $result = &Apache::edit::rebuild_tag($token);
                    843: 	}
1.1       albertel  844:     } else {
                    845: 	# page_start returned a starting result, delete it if we don't need it
                    846: 	$result = '';
                    847:     }
                    848:     return $result;
                    849: }
                    850: 
1.165     albertel  851: sub get_task_end_time {
                    852:     my ($queue_entry,$symb,$udom,$uname) = @_;
                    853: 
                    854:     my $end_time;
                    855:     if (my $slot = &slotted_access($queue_entry)) {
                    856: 	my %slot_data=&Apache::lonnet::get_slot($slot);
                    857: 	$end_time = $slot_data{'endtime'};
                    858:     } else {
                    859: 	$end_time = &Apache::lonhomework::due_date('0',$symb,
                    860: 						   $udom,$uname);
                    861:     }
                    862:     return $end_time;
                    863: }
                    864: 
1.32      albertel  865: sub get_key_todo {
                    866:     my ($target)=@_;
                    867:     my $todo;
1.33      albertel  868: 
1.231     albertel  869:     if ($env{'request.state'} eq 'construct') {
                    870: 	my ($symb,$cid,$udom,$uname) = &Apache::lonnet::whichuser();
                    871: 	my $gradingkey=&encode_queue_key($symb,$udom,$uname);
                    872: 	return ($gradingkey);
                    873:     }
                    874: 
1.33      albertel  875:     if (defined($env{'form.reviewasubmission'})) {
1.54      albertel  876: 	&Apache::lonxml::debug("review a submission....");
1.33      albertel  877: 	$env{'form.queue'}='reviewqueue';
                    878: 	return (undef,'show_list');
                    879:     }
                    880: 
                    881:     if (defined($env{'form.reviewagrading'})) {
                    882: 	&Apache::lonxml::debug("review a grading....");
                    883: 	$env{'form.queue'}='gradingqueue';
                    884: 	return (undef,'show_list');
                    885:     }
                    886: 
1.49      albertel  887:     if (defined($env{'form.regradeasubmission'})) {
                    888: 	&Apache::lonxml::debug("regrade a grading....");
                    889: 	$env{'form.queue'}='none';
                    890: 	return (undef,'select_user');
                    891:     }
                    892: 
1.105     albertel  893: 
1.138     albertel  894:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.105     albertel  895: 
                    896:     #need to try both queues..
                    897:     if (defined($env{'form.regradeaspecificsubmission'}) &&
                    898: 	defined($env{'form.gradinguser'})               &&
                    899: 	defined($env{'form.gradingdomain'})               ) {
1.185     albertel  900: 	my ($symb,$cid)=&Apache::lonnet::whichuser();
1.105     albertel  901: 	my $cnum  = $env{'course.'.$cid.'.num'};
                    902: 	my $cdom  = $env{'course.'.$cid.'.domain'};
1.224     albertel  903: 	my $uname = &LONCAPA::clean_username($env{'form.gradinguser'});
                    904: 	my $udom  = &LONCAPA::clean_domain($env{'form.gradingdomain'});
1.105     albertel  905: 
                    906: 	my $gradingkey=&encode_queue_key($symb,$udom,$uname);
                    907: 
                    908: 	my $queue;
                    909: 
                    910: 	if      (&in_queue('gradingqueue',$symb,$cdom,$cnum,$udom,$uname)) {
                    911: 	    $env{'form.queue'} = $queue = 'gradingqueue';
                    912: 	} elsif (&in_queue('reviewqueue' ,$symb,$cdom,$cnum,$udom,$uname)) {
                    913: 	    $env{'form.queue'} = $queue = 'reviewqueue';
                    914: 	}
                    915: 	
                    916: 	if (!$queue) {
                    917: 	    $env{'form.queue'} = $queue = 'none';
                    918: 	    #not queued so doing either a re or pre grade
1.164     albertel  919: 	    my %status = &Apache::lonnet::restore($symb,$cid,$udom,$uname);
                    920: 	    if ($status{'resource.0.version'} < 1) {
                    921: 		return (undef,'never_versioned');
                    922: 	    }
1.105     albertel  923: 	    return ($gradingkey);
                    924: 	}
                    925: 
1.165     albertel  926: 	if ($queue) {
                    927: 	    my $queue_entry = &get_queue_data($queue,$udom,$uname);
                    928: 	
                    929: 	    my $end_time = &get_task_end_time($queue_entry,$symb,
                    930: 					      $udom,$uname);
                    931: 	    if ($end_time > time) {
                    932: 		return (undef,"still_open:$end_time");
                    933: 	    }
                    934: 	}
                    935: 
1.105     albertel  936: 	my $who=&queue_key_locked($queue,$gradingkey);
                    937: 	if ($who eq $me) {
                    938: 	    #already have the lock
1.158     www       939: 	    $env{'form.gradingkey'}=&escape($gradingkey);
1.163     albertel  940: 	    &Apache::lonxml::debug("already locked");
1.105     albertel  941: 	    return ($gradingkey);
                    942: 	}
                    943: 	
                    944: 	if (!defined($who)) {
                    945: 	    if (&lock_key($queue,$gradingkey)) {
1.163     albertel  946: 		&Apache::lonxml::debug("newly locked");
1.105     albertel  947: 		return ($gradingkey);
                    948: 	    } else {
                    949: 		return (undef,'lock_failed');
                    950: 	    }
                    951: 	}
                    952: 
                    953: 	#otherwise (defined($who) && $who ne $me) some else has it...
                    954: 	return (undef,'not_allowed',
                    955: 		&mt('Another user ([_1]) currently has the record for [_2] locked.',
1.138     albertel  956: 		    $who,$env{'form.gradinguser'}.':'.$env{'form.gradingdomain'}));
1.105     albertel  957:     }
                    958: 
                    959: 
1.32      albertel  960:     my $queue=$env{'form.queue'};
1.33      albertel  961: 
1.32      albertel  962:     if (!defined($queue)) {
                    963: 	$env{'form.queue'}=$queue='gradingqueue';
                    964:     }
1.33      albertel  965: 
1.158     www       966:     my $gradingkey=&unescape($env{'form.gradingkey'});
1.33      albertel  967: 
1.49      albertel  968:     if ($env{'form.queue'} eq 'none') {
                    969: 	if (defined($env{'form.gradingkey'})) {
                    970: 	    if ($target eq 'webgrade') {
                    971: 		if ($env{'form.stop'}) {
                    972: 		    return (undef,'stop');
1.163     albertel  973: 		} elsif ($env{'form.cancel'}) {
                    974: 		    return (undef,'cancel');
1.49      albertel  975: 		} elsif ($env{'form.next'}) {
1.59      albertel  976: 		    return (undef,'select_user');
1.49      albertel  977: 		}
                    978: 	    }
                    979: 	    return ($gradingkey,'selected');
                    980: 	} else {
1.59      albertel  981: 	    return (undef,'select_user');
1.49      albertel  982: 	}
                    983:     }
1.32      albertel  984:     if (defined($env{'form.queue'}) && defined($env{'form.gradingkey'})
1.33      albertel  985: 	&& !defined($env{'form.gradingaction'}) 
                    986: 	&& $env{'form.queuemode'} eq 'selected') {
                    987: 	
                    988: 	my $who=&queue_key_locked($queue,$gradingkey);
                    989: 	if ($who eq $me) {
                    990: 	    &Apache::lonxml::debug("Found a key was given to me");
                    991: 	    return ($gradingkey,'selected');
                    992: 	} else {
                    993: 	    return (undef,'show_list');
                    994: 	}
                    995: 
                    996:     }
                    997: 
                    998:     if ($target eq 'webgrade' && $env{'form.queuemode'} eq 'selected') {
                    999: 	if ($env{'form.gradingaction'} eq 'resume') {
                   1000: 	    delete($env{'form.gradingaction'});
                   1001: 	    &Apache::lonxml::debug("Resuming a key");
1.32      albertel 1002: 	    return ($gradingkey);
1.33      albertel 1003: 	} elsif ($env{'form.gradingaction'} eq 'unlock') {
                   1004: 	    &Apache::lonxml::debug("Unlocking a key ".
                   1005: 				     &check_queue_unlock($queue,$gradingkey,1));
                   1006: 	    return (undef,'unlock');
                   1007: 	} elsif ($env{'form.gradingaction'} eq 'select') {
                   1008: 	    &Apache::lonxml::debug("Locking a key");
                   1009: 	    if (&lock_key($queue,$gradingkey)) {
                   1010: 		&Apache::lonxml::debug("Success $queue");
                   1011: 		return ($gradingkey);
                   1012: 	    }
                   1013: 	    &Apache::lonxml::debug("Failed $queue");
                   1014: 	    return (undef,'lock_failed');
1.32      albertel 1015: 	}
                   1016:     }
1.33      albertel 1017: 
                   1018:     if ($env{'form.queuemode'} ne 'selected') {
                   1019: 	# don't get something new from the queue if they hit the stop button
1.163     albertel 1020:     	if (!(($env{'form.cancel'} || $env{'form.stop'}) 
                   1021: 	      && $target eq 'webgrade') 
1.33      albertel 1022: 	    && !$env{'form.gradingaction'}) {
                   1023: 	    &Apache::lonxml::debug("Getting anew $queue");
                   1024: 	    return (&get_from_queue($queue));
                   1025: 	} else {
                   1026: 	    return (undef,'stop');
                   1027: 	}
1.32      albertel 1028:     }
1.33      albertel 1029:     return (undef,undef)
1.32      albertel 1030: }
1.94      albertel 1031: 
                   1032: sub minimize_storage {
                   1033:     foreach my $key (keys(%Apache::lonhomework::results)) {
                   1034: 	if ($key =~ /regrader$/) { next; }
                   1035: 	if ($Apache::lonhomework::results{$key} eq
                   1036: 	    $Apache::lonhomework::history{$key}) {
                   1037: 	    delete($Apache::lonhomework::results{$key});
                   1038: 	}
                   1039:     }
                   1040: }
                   1041: 
1.1       albertel 1042: sub end_Task {
                   1043:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   1044:     my $result='';
                   1045:     my $status=$Apache::inputtags::status['-1'];
1.29      albertel 1046:     my ($version,$previous)=&get_version();
1.1       albertel 1047:     if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' ||
1.15      albertel 1048: 	$target eq 'tex') {
1.69      albertel 1049: 	if ($target eq 'web' || $target eq 'answer' || $target eq 'tex') {
1.1       albertel 1050: 	    if ($target eq 'web') {
1.54      albertel 1051: 		if (&show_task($status,$previous)) {
                   1052: 		    $result.=&Apache::lonxml::endredirection();
                   1053: 		}
1.64      albertel 1054: 		if ($status eq 'CAN_ANSWER' && !$previous && 
                   1055: 		    !$env{'form.donescreen'}) {
1.15      albertel 1056: 		    $result.="\n".'<table border="1">'.
1.28      albertel 1057: 			&Apache::inputtags::file_selector("$version.0",
                   1058: 							  "bridgetask","*",
1.46      albertel 1059: 							  'portfolioonly',
                   1060: 							  '
                   1061: <h2>'.&mt('Submit Portfolio Files for Grading').'</h2>
                   1062: <p>'.&mt('Indicate the files from your portfolio to be evaluated in grading this task.').'</p>').
1.9       albertel 1063: 							  "</table>";
1.77      albertel 1064: 		}
1.78      albertel 1065: 		if (!$previous && $status ne 'SHOW_ANSWER' &&
                   1066: 		    &show_task($status,$previous)) {
1.232     albertel 1067: 		    $result.=&Apache::inputtags::gradestatus('0',$target,1);
1.199     albertel 1068: 		}
                   1069: 		
                   1070: 		$result.='</form>';
                   1071: 
                   1072: 		if (!$previous && $status ne 'SHOW_ANSWER' &&
                   1073: 		    &show_task($status,$previous)) {
1.116     albertel 1074: 		    my $action = &Apache::lonenc::check_encrypt($env{'request.uri'});
1.64      albertel 1075: 		    $result.=<<DONEBUTTON;
1.115     albertel 1076: <form name="done" method="post" action="$action">
1.64      albertel 1077:    <input type="hidden" name="donescreen" value="1" />
                   1078:    <input type="submit" value="Done" />
                   1079: </form>
                   1080: DONEBUTTON
1.77      albertel 1081:                 }
1.56      albertel 1082: 		if (&show_task($status,$previous) &&
1.89      albertel 1083: 		    $Apache::lonhomework::history{"resource.$version.0.status"} =~ /^(pass|fail)$/) {
                   1084: 		    my $bt_status=$Apache::lonhomework::history{"resource.$version.0.status"};
1.231     albertel 1085: 		    my $title=&Apache::lonnet::gettitle($env{'request.uri'});
1.149     albertel 1086: 		    my $start_time;
                   1087: 
1.80      albertel 1088: 		    my $slot_name=
1.89      albertel 1089: 			$Apache::lonhomework::history{"resource.$version.0.checkedin.slot"};
1.149     albertel 1090: 		    if ($slot_name) {
                   1091: 			my %slot=&Apache::lonnet::get_slot($slot_name);
                   1092: 
                   1093: 			$start_time=$slot{'starttime'}
                   1094: 		    } else {
                   1095: 			$start_time= 
                   1096: 			    &Apache::lonnet::EXT('resource.0.opendate');
                   1097: 		    }
                   1098: 		    $start_time=&Apache::lonlocal::locallocaltime($start_time);
1.54      albertel 1099: 
1.200     albertel 1100: 		    my $status = 
1.213     albertel 1101: 			"\n<div class='LC_$bt_status LC_criteria LC_task_overall_status'>\n\t";
1.54      albertel 1102: 		    
1.213     albertel 1103: 		    my $dim = $top;
                   1104: 		    my %counts = &get_counts($dim,undef,$parstack,
                   1105: 					     $safeeval);
                   1106: 		    my $question_status ="\n\t<p>".
                   1107: 			&question_status_message(\%counts,-1).
                   1108: 			"</p>\n";
                   1109: 
1.54      albertel 1110: 		    if ($bt_status eq 'pass')  {
                   1111: 			$status.='<h2>You passed the '.$title.' given on '.
1.80      albertel 1112: 			    $start_time.'</h2>';
1.213     albertel 1113: 			$status.=$question_status;
1.54      albertel 1114: 		    }
                   1115: 		    if ($bt_status eq 'fail')  {
                   1116: 			$status.='<h2>You did not pass the '.$title.' given on '.
1.80      albertel 1117: 			    $start_time.'</h2>';
1.213     albertel 1118: 			$status.=$question_status;
1.54      albertel 1119: 			if (!$previous) {
                   1120: 			    $status.=&add_request_another_attempt_button();
                   1121: 			}
                   1122: 		    }
1.213     albertel 1123: 		    
1.200     albertel 1124: 		    $status.="\n".'</div>'."\n";
1.194     albertel 1125: 
                   1126: 		    foreach my $id (@{$dimension{$dim}{'criterias'}}) {
                   1127: 			my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   1128: 			if ($type eq 'dimension') {
                   1129: 			    $result.=$dimension{$id}{'result'};
                   1130: 			    next;
                   1131: 			}
                   1132: 			my $criteria = 
                   1133: 			    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   1134: 					  [@_]);
                   1135: 			$status .= &layout_web_Criteria($dim,$id,$criteria);
                   1136: 		    }
1.54      albertel 1137: 
                   1138: 		    my $internal_location=&internal_location();
                   1139: 		    $result=~s/\Q$internal_location\E/$status/;
                   1140: 		}
1.142     albertel 1141: 		$result.="\n</div>\n".
                   1142: 		    &Apache::loncommon::end_page({'discussion' => 1});
1.1       albertel 1143: 	    }
                   1144: 	}
1.181     albertel 1145: 
                   1146: 	my $useslots = &Apache::lonnet::EXT("resource.0.useslots");
                   1147: 	my %queue_data = ('type' => 'Task',
                   1148: 			  'time' => time,);
                   1149: 	if (defined($Apache::inputtags::slot_name)) {
                   1150: 	    $queue_data{'slot'} = $Apache::inputtags::slot_name;
                   1151: 	} elsif (defined($Apache::lonhomework::history{"resource.$version.0.checkedin.slot"})) {
                   1152: 	    $queue_data{'slot'} = $Apache::lonhomework::history{"resource.$version.0.checkedin.slot"};
                   1153: 	}
                   1154: 	
                   1155: 
1.215     albertel 1156: 	if ($target eq 'grade' && !$env{'form.webgrade'} && !$previous
                   1157: 	    && $status eq 'CAN_ANSWER') {
1.12      albertel 1158: 	    my $award='SUBMITTED';
1.28      albertel 1159: 	    &Apache::essayresponse::file_submission("$version.0",'bridgetask',
1.20      albertel 1160: 						    'portfiles',\$award);
1.14      albertel 1161: 	    if ($award eq 'SUBMITTED' &&
1.28      albertel 1162: 		$Apache::lonhomework::results{"resource.$version.0.bridgetask.portfiles"}) {
                   1163: 		$Apache::lonhomework::results{"resource.0.tries"}=
                   1164: 		    $Apache::lonhomework::results{"resource.$version.0.tries"}=
                   1165: 		    1+$Apache::lonhomework::history{"resource.$version.0.tries"};
                   1166: 
                   1167: 		$Apache::lonhomework::results{"resource.0.award"}=
                   1168: 		    $Apache::lonhomework::results{"resource.$version.0.award"}=
                   1169: 		    $award;
1.51      albertel 1170: 		$Apache::lonhomework::results{"resource.0.submission"}=
                   1171: 		    $Apache::lonhomework::results{"resource.$version.0.submission"}='';
1.64      albertel 1172: 	    } else {
                   1173: 		delete($Apache::lonhomework::results{"resource.$version.0.bridgetask.portfiles"});
1.77      albertel 1174: 		$award = '';
1.10      albertel 1175: 	    }
1.4       albertel 1176: 	    &Apache::lonhomework::showhash(%Apache::lonhomework::results);
                   1177: 	    &Apache::structuretags::finalize_storage();
1.148     albertel 1178: 	    if ($award eq 'SUBMITTED') {
1.181     albertel 1179: 		&add_to_queue('gradingqueue',\%queue_data);
1.14      albertel 1180: 	    }
1.1       albertel 1181: 	}
1.163     albertel 1182: 	if ($target eq 'grade' && $env{'form.webgrade'} eq 'yes' 
                   1183: 	    && exists($env{'form.cancel'})) {
                   1184: 	    &check_queue_unlock($env{'form.queue'});
                   1185: 	    &Apache::lonxml::debug(" cancelled grading .".$env{'form.queue'});
                   1186: 	} elsif ($target eq 'grade' && $env{'form.webgrade'} eq 'yes' 
                   1187: 		 && !exists($env{'form.cancel'})) {
1.20      albertel 1188: 	    my $optional_required=
                   1189: 		&Apache::lonxml::get_param('OptionalRequired',$parstack,
                   1190: 					   $safeeval);
                   1191: 	    my $optional_passed=0;
                   1192: 	    my $mandatory_failed=0;
                   1193: 	    my $ungraded=0;
                   1194: 	    my $review=0;   
1.21      albertel 1195: 	    &Apache::lonhomework::showhash(%Apache::lonhomework::results);
1.194     albertel 1196: 	    my $dim = $top;
                   1197: 	    foreach my $id (@{$dimension{$dim}{'criterias'}}) {
                   1198: 		my $link=&link($id);
                   1199: 
                   1200: 		my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   1201: 
                   1202: 		if ($type eq 'criteria') {
                   1203: 		    # dimensional 'criteria' don't get assigned grades
                   1204: 		    $Apache::lonhomework::results{"resource.$version.0.$id.status"}=$env{'form.HWVAL_'.$link};
                   1205: 		    $Apache::lonhomework::results{"resource.$version.0.$id.comment"}=$env{'form.HWVAL_comment_'.$link};
                   1206: 		} 
1.20      albertel 1207: 		my $status=
1.194     albertel 1208: 		    $Apache::lonhomework::results{"resource.$version.0.$id.status"};
                   1209: 		my $mandatory=($dimension{$dim}{'criteria.'.$id.'.mandatory'} ne 'N');
                   1210: 
1.20      albertel 1211: 		if ($status eq 'pass') {
                   1212: 		    if (!$mandatory) { $optional_passed++; }
                   1213: 		} elsif ($status eq 'fail') {
                   1214: 		    if ($mandatory) { $mandatory_failed++; }
1.194     albertel 1215: 		} elsif ($status eq 'review') {
                   1216: 		    $review++;
1.20      albertel 1217: 		} elsif ($status eq 'ungraded') {
                   1218: 		    $ungraded++;
1.49      albertel 1219: 		} else {
                   1220: 		    $ungraded++;
                   1221: 		}
1.20      albertel 1222: 	    }
                   1223: 	    if ($optional_passed < $optional_required) {
                   1224: 		$mandatory_failed++;
                   1225: 	    }
1.194     albertel 1226: 	    &Apache::lonxml::debug(" task results -> m_f $mandatory_failed o_p $optional_passed u $ungraded r $review");
1.89      albertel 1227: 	    $Apache::lonhomework::results{'resource.0.regrader'}=
1.138     albertel 1228: 		$env{'user.name'}.':'.$env{'user.domain'};
1.20      albertel 1229: 	    if ($review) {
1.89      albertel 1230: 		$Apache::lonhomework::results{"resource.$version.0.status"}='review';
1.20      albertel 1231: 	    } elsif ($ungraded) {
1.89      albertel 1232: 		$Apache::lonhomework::results{"resource.$version.0.status"}='ungraded';
1.20      albertel 1233: 	    } elsif ($mandatory_failed) {
1.89      albertel 1234: 		$Apache::lonhomework::results{"resource.$version.0.status"}='fail';
1.25      albertel 1235: 		$Apache::lonhomework::results{"resource.$version.0.solved"}='incorrect_by_override';
                   1236: 		$Apache::lonhomework::results{"resource.$version.0.award"}='INCORRECT';
                   1237: 		$Apache::lonhomework::results{"resource.$version.0.awarded"}='0';
1.185     albertel 1238: 		my ($symb,$courseid,$udom,$uname)=&Apache::lonnet::whichuser();
1.52      albertel 1239: 		
                   1240: 		if ($env{'form.regrade'} ne 'yes') {
                   1241: 		    $Apache::lonhomework::results{"resource.$version.0.bridgetask.portfiles"}=
                   1242: 			$Apache::lonhomework::history{"resource.$version.0.bridgetask.portfiles"};
                   1243: 		    &Apache::grades::version_portfiles(
                   1244: 						       \%Apache::lonhomework::results,
                   1245: 						       ["$version.0.bridgetask"],$courseid,
                   1246: 						       $symb,$udom,$uname,
                   1247: 						       ["$version.0.bridgetask"]);
                   1248: 		}
1.20      albertel 1249: 	    } else {
1.89      albertel 1250: 		$Apache::lonhomework::results{"resource.$version.0.status"}='pass';
1.25      albertel 1251: 		$Apache::lonhomework::results{"resource.$version.0.solved"}='correct_by_override';
                   1252: 		$Apache::lonhomework::results{"resource.$version.0.award"}='EXACT_ANS';
                   1253: 		$Apache::lonhomework::results{"resource.$version.0.awarded"}='1';
1.185     albertel 1254: 		my ($symb,$courseid,$udom,$uname)=&Apache::lonnet::whichuser();
1.52      albertel 1255: 		if ($env{'form.regrade'} ne 'yes') {
                   1256: 		    $Apache::lonhomework::results{"resource.$version.0.bridgetask.portfiles"}=
                   1257: 			$Apache::lonhomework::history{"resource.$version.0.bridgetask.portfiles"};
                   1258: 		    &Apache::grades::version_portfiles(
                   1259: 						       \%Apache::lonhomework::results,
                   1260: 						       ["$version.0.bridgetask"],$courseid,
                   1261: 						       $symb,$udom,$uname,
                   1262: 						       ["$version.0.bridgetask"]);
                   1263: 		}
1.20      albertel 1264: 	    }
1.89      albertel 1265: 	    $Apache::lonhomework::results{"resource.0.status"}=
                   1266: 		$Apache::lonhomework::results{"resource.$version.0.status"};
1.28      albertel 1267: 	    if (defined($Apache::lonhomework::results{"resource.$version.0.awarded"})) {
1.26      albertel 1268: 		$Apache::lonhomework::results{"resource.0.award"}=
1.50      albertel 1269: 		    $Apache::lonhomework::results{"resource.$version.0.award"};
1.26      albertel 1270: 		$Apache::lonhomework::results{"resource.0.awarded"}=
1.50      albertel 1271: 		    $Apache::lonhomework::results{"resource.$version.0.awarded"};
1.26      albertel 1272: 		$Apache::lonhomework::results{"resource.0.solved"}=
1.50      albertel 1273: 		    $Apache::lonhomework::results{"resource.$version.0.solved"};
1.25      albertel 1274: 	    }
1.94      albertel 1275: 	    &minimize_storage();
1.21      albertel 1276: 	    &Apache::structuretags::finalize_storage();
1.188     albertel 1277: 	    
                   1278: 	    # data stored, now handle queue
                   1279: 	    if ($review) {
                   1280: 		if ($env{'form.queue'} eq 'reviewqueue') {
                   1281: 		    &check_queue_unlock($env{'form.queue'});
                   1282: 		    &Apache::lonxml::debug(" still needs review not changing status.");
                   1283: 		} else {
                   1284: 		    if ($env{'form.queue'} ne 'none') {
                   1285: 			&move_between_queues($env{'form.queue'},'reviewqueue');
                   1286: 		    } else {
                   1287: 			&add_to_queue('reviewqueue',\%queue_data);
                   1288: 		    }
                   1289: 		}
                   1290: 	    } elsif ($ungraded) {
                   1291: 		if ($env{'form.queue'} eq 'reviewqueue') {
                   1292: 		    &Apache::lonxml::debug("moving back.");
                   1293: 		    &move_between_queues($env{'form.queue'},
                   1294: 					 'gradingqueue');
                   1295: 		} elsif ($env{'form.queue'} eq 'none' ) {
                   1296: 		    &add_to_queue('gradingqueue',\%queue_data);	
                   1297: 		} else {
                   1298: 		    &check_queue_unlock($env{'form.queue'});
                   1299: 		}
                   1300: 	    } elsif ($mandatory_failed) {
                   1301: 		&remove_from_queue($env{'form.queue'}); 
                   1302: 	    } else {
                   1303: 		&remove_from_queue($env{'form.queue'});
                   1304: 	    }
1.20      albertel 1305: 	}
1.184     albertel 1306: 	if (exists($Apache::lonhomework::results{'INTERNAL_store'})) {
                   1307: 	    # instance generation occured and hasn't yet been stored
                   1308: 	    &Apache::structuretags::finalize_storage();
                   1309: 	}
1.15      albertel 1310:     } elsif ($target eq 'webgrade') {
1.208     albertel 1311: 	if (&nest()) {
                   1312: 	    &Apache::lonxml::endredirection();
                   1313: 	    &end_delay();
                   1314: 	    $result.=$dimension{$top}{'result'};
                   1315: 	} else {
                   1316: 	    $result.=&Apache::lonxml::endredirection();
                   1317: 	}
1.194     albertel 1318: 	my $dim = $top;
                   1319: 	foreach my $id (@{$dimension{$dim}{'criterias'}} ) {
                   1320: 	    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   1321: 	    if ($type eq 'dimension') {
                   1322: 		# dimensional 'criteria' don't get assigned grades
                   1323: 		next;
                   1324: 	    } else {
                   1325: 		my $criteria =&nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   1326: 					     [@_]);
                   1327: 		$criteria = &layout_webgrade_Criteria($dim,$id,$criteria);
                   1328: 		my $internal_location=&internal_location($id);
1.209     albertel 1329: 		if ($result =~ m/\Q$internal_location\E/) {
                   1330: 		    $result=~s/\Q$internal_location\E/$criteria/;
                   1331: 		} else {
                   1332: 		    $result.=$criteria;
                   1333: 		}
                   1334: 
1.194     albertel 1335: 	    }
                   1336: 	}
                   1337:         $result.="</div>";
1.20      albertel 1338: 	#$result.='<input type="submit" name="next" value="'.
                   1339: 	#    &mt('Save &amp; Next').'" /> ';
                   1340: 	#$result.='<input type="submit" name="end" value="'.
                   1341: 	#    &mt('Save &amp; Stop Grading').'" /> ';
                   1342: 	#$result.='<input type="submit" name="throwaway" value="'.
                   1343: 	#    &mt('Throw Away &amp; Stop Grading').'" /> ';
                   1344: 	#$result.='<input type="submit" name="save" value="'.
                   1345: 	#    &mt('Save Partial Grade and Continue Grading').'" /> ';
1.124     albertel 1346: 	$result.='</form>'."\n</div>\n</div>\n".
1.140     albertel 1347: 	    &Apache::loncommon::end_page();
1.1       albertel 1348:     } elsif ($target eq 'meta') {
1.70      albertel 1349: 	$result.=&Apache::response::meta_package_write('Task');
1.77      albertel 1350:         $result.=&Apache::response::meta_stores_write('solved','string',
                   1351: 						      'Problem Status');
                   1352: 	$result.=&Apache::response::meta_stores_write('tries','int_zeropos',
                   1353: 						      'Number of Attempts');
                   1354: 	$result.=&Apache::response::meta_stores_write('awarded','float',
                   1355: 						      'Partial Credit Factor');
                   1356: 	$result.=&Apache::response::meta_stores_write('status','string',
                   1357: 						      'Bridge Task Status');
1.182     albertel 1358:     } elsif ($target eq 'edit') {
1.227     albertel 1359: 	$result.= &Apache::structuretags::problem_edit_footer();
1.1       albertel 1360:     }
1.179     albertel 1361:     &Apache::structuretags::reset_problem_globals('Task');
1.4       albertel 1362:     undef($Apache::lonhomework::parsing_a_task);
1.1       albertel 1363:     return $result;
                   1364: }
                   1365: 
1.31      albertel 1366: sub move_between_queues {
                   1367:     my ($src_queue,$dest_queue)=@_;
1.49      albertel 1368:     my $cur_data;
                   1369:     if ($src_queue ne 'none') {
                   1370: 	$cur_data=&get_queue_data($src_queue);
                   1371: 	if (!$cur_data) { return 'not_exist'; }
                   1372:     } else {
                   1373: 	$cur_data = ['none'];
                   1374:     }
1.148     albertel 1375:     my $result=&add_to_queue($dest_queue,$cur_data);
1.31      albertel 1376:     if ($result ne 'ok') {
                   1377: 	return $result;
                   1378:     }
                   1379:     &check_queue_unlock($src_queue);
                   1380:     return &remove_from_queue($src_queue);
1.21      albertel 1381: }
                   1382: 
                   1383: sub check_queue_unlock {
1.32      albertel 1384:     my ($queue,$key,$allow_not_me)=@_;
1.49      albertel 1385:     if ($queue eq 'none') { return 'ok'; }
1.185     albertel 1386:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.32      albertel 1387:     if (!defined($key)) {
1.138     albertel 1388: 	$key="$symb\0queue\0$uname:$udom";
1.32      albertel 1389:     }
1.30      albertel 1390:     my $cnum=$env{'course.'.$cid.'.num'};
                   1391:     my $cdom=$env{'course.'.$cid.'.domain'};
1.138     albertel 1392:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.30      albertel 1393:     my $who=&queue_key_locked($queue,$key,$cdom,$cnum);
                   1394:     if  ($who eq $me) {
1.163     albertel 1395: 	&Apache::lonxml::debug("unlocking my own $who");
1.32      albertel 1396: 	return &Apache::lonnet::del($queue,["$key\0locked"],$cdom,$cnum);
                   1397:     } elsif ($allow_not_me) {
1.33      albertel 1398: 	&Apache::lonxml::debug("unlocking $who by $me");
1.32      albertel 1399: 	return &Apache::lonnet::del($queue,["$key\0locked"],$cdom,$cnum);
1.30      albertel 1400:     }
1.32      albertel 1401:     return 'not_owner';
1.21      albertel 1402: }
                   1403: 
1.88      albertel 1404: sub in_queue {
                   1405:     my ($queue,$symb,$cdom,$cnum,$udom,$uname)=@_;
                   1406:     if ($queue eq 'none') { return 0; }
                   1407:     if (!defined($symb) || !defined($cdom) || !defined($cnum)
                   1408: 	|| !defined($udom) || !defined($uname)) {
1.185     albertel 1409: 	($symb,my $cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.88      albertel 1410: 	$cnum=$env{'course.'.$cid.'.num'};
                   1411: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1412:     }
                   1413: 
                   1414:     my $key=&encode_queue_key($symb,$udom,$uname);
                   1415:     my %results = &Apache::lonnet::get($queue,[$key],$cdom,$cnum);
                   1416: 
                   1417:     if (defined($results{$key})) {
                   1418: 	return 1;
                   1419:     }
                   1420:     return 0;
                   1421: }
                   1422: 
1.21      albertel 1423: sub remove_from_queue {
1.86      albertel 1424:     my ($queue,$symb,$cdom,$cnum,$udom,$uname)=@_;
1.49      albertel 1425:     if ($queue eq 'none') { return 'ok'; }
1.86      albertel 1426:     if (!defined($symb) || !defined($cdom) || !defined($cnum)
                   1427: 	|| !defined($udom) || !defined($uname)) {
1.185     albertel 1428: 	($symb,my $cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.86      albertel 1429: 	$cnum=$env{'course.'.$cid.'.num'};
                   1430: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1431:     }
1.88      albertel 1432:     if (!&in_queue($queue,$symb,$cdom,$cnum,$udom,$uname)) {
                   1433: 	return 'ok';
                   1434:     }
1.86      albertel 1435:     my $key=&encode_queue_key($symb,$udom,$uname);
1.27      albertel 1436:     my @keys=($key,"$key\0locked");
1.31      albertel 1437:     return &Apache::lonnet::del($queue,\@keys,$cdom,$cnum);
1.21      albertel 1438: }
                   1439: 
1.16      albertel 1440: sub setup_env_for_other_user {
                   1441:     my ($queue_key,$safeeval)=@_;
                   1442:     my ($symb,$uname,$udom)=&decode_queue_key($queue_key);
1.30      albertel 1443:     &Apache::lonxml::debug("setup_env for $queue_key");
1.16      albertel 1444:     $env{'form.grade_symb'}=$symb;
                   1445:     $env{'form.grade_domain'}=$udom;
                   1446:     $env{'form.grade_username'}=$uname;
                   1447:     $env{'form.grade_courseid'}=$env{'request.course.id'};
                   1448:     &Apache::lonxml::initialize_rndseed($safeeval);
                   1449: }
                   1450: 
1.31      albertel 1451: sub get_queue_data {
1.165     albertel 1452:     my ($queue,$udom,$uname)=@_;
1.185     albertel 1453:     my ($symb,$cid,$other_udom,$other_uname)=&Apache::lonnet::whichuser();
1.165     albertel 1454:     if (!$uname || !$udom) {
                   1455: 	$uname=$other_uname;
                   1456: 	$udom =$other_udom;
                   1457:     }
1.31      albertel 1458:     my $cnum=$env{'course.'.$cid.'.num'};
                   1459:     my $cdom=$env{'course.'.$cid.'.domain'};
1.138     albertel 1460:     my $todo="$symb\0queue\0$uname:$udom";
1.31      albertel 1461:     my ($key,$value)=&Apache::lonnet::get($queue,[$todo],$cdom,$cnum);
                   1462:     if ($key eq $todo && ref($value)) {
                   1463: 	return $value;
                   1464:     }
                   1465:     return undef;
                   1466: }
                   1467: 
1.84      albertel 1468: 
1.49      albertel 1469: sub check_queue_for_key {
1.84      albertel 1470:     my ($cdom,$cnum,$queue,$todo)=@_;
                   1471: 
1.49      albertel 1472:     my %results=
                   1473: 	&Apache::lonnet::get($queue,[$todo,"$todo\0locked"],$cdom,$cnum);
                   1474:     
                   1475:     if (exists($results{$todo}) && ref($results{$todo})) {
                   1476: 	if (defined($results{"$todo\0locked"})) {
                   1477: 	    return 'locked';
                   1478: 	}
1.148     albertel 1479: 	if (my $slot=&slotted_access($results{$todo})) {
1.86      albertel 1480: 	    my %slot_data=&Apache::lonnet::get_slot($slot);
                   1481: 	    if ($slot_data{'endtime'} > time) { 
                   1482: 		return 'in_progress';
                   1483: 	    }
1.148     albertel 1484: 	} else {
                   1485: 	    my ($symb) = &decode_queue_key($todo);
                   1486: 	    my $due_date = &Apache::lonhomework::due_date('0',$symb);
                   1487: 	    if ($due_date > time) {
                   1488: 		return 'in_progress';
                   1489: 	    }
1.58      albertel 1490: 	}
1.49      albertel 1491: 	return 'enqueued';
                   1492:     }
                   1493:     return undef;
                   1494: }
                   1495: 
1.14      albertel 1496: sub add_to_queue {
1.82      albertel 1497:     my ($queue,$user_data)=@_;
1.49      albertel 1498:     if ($queue eq 'none') { return 'ok'; }
1.185     albertel 1499:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.82      albertel 1500:     if (!$cid || $env{'request.state'} eq 'construct') {
                   1501: 	return 'no_queue';
                   1502:     }
1.14      albertel 1503:     my $cnum=$env{'course.'.$cid.'.num'};
                   1504:     my $cdom=$env{'course.'.$cid.'.domain'};
                   1505:     my %data;
1.138     albertel 1506:     $data{"$symb\0queue\0$uname:$udom"}=$user_data;
1.83      albertel 1507:     return &Apache::lonnet::cput($queue,\%data,$cdom,$cnum);
1.14      albertel 1508: }
                   1509: 
1.156     albertel 1510: sub get_limited_classlist {
                   1511:     my ($sections) = @_;
                   1512: 
                   1513:     my $classlist = &Apache::loncoursedata::get_classlist();
1.157     albertel 1514:     foreach my $student (keys(%$classlist)) {
                   1515: 	if ( $classlist->{$student}[&Apache::loncoursedata::CL_STATUS()]
                   1516: 	     ne 'Active') {
                   1517: 	    delete($classlist->{$student});
                   1518:        	}
                   1519:     }
1.156     albertel 1520: 
1.157     albertel 1521:     if (ref($sections) && !grep('all',@{ $sections })) {
1.156     albertel 1522: 	foreach my $student (keys(%$classlist)) {
                   1523: 	    my $section  = 
                   1524: 		$classlist->{$student}[&Apache::loncoursedata::CL_SECTION()];
                   1525: 	    if (! grep($section,@{ $sections })) {
                   1526: 		delete($classlist->{$student});
                   1527: 	    }
                   1528: 	}
                   1529:     }
                   1530:     return $classlist;
                   1531: }
                   1532: 
                   1533: 
1.14      albertel 1534: sub show_queue {
1.32      albertel 1535:     my ($queue,$with_selects)=@_;
1.14      albertel 1536:     my $result;
1.185     albertel 1537:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.14      albertel 1538:     my $cnum=$env{'course.'.$cid.'.num'};
                   1539:     my $cdom=$env{'course.'.$cid.'.domain'};
1.59      albertel 1540: 
                   1541:     my @chosen_sections=
                   1542: 	&Apache::loncommon::get_env_multiple('form.chosensections');
1.156     albertel 1543: 
                   1544:     my $classlist = &get_limited_classlist(\@chosen_sections);
                   1545: 
1.63      albertel 1546:     if (!(grep(/^all$/,@chosen_sections))) {
                   1547: 	$result.='<p> Showing only sections <tt>'.join(', ',@chosen_sections).
                   1548: 	    '</tt>.</p> '."\n";
                   1549:     }
1.59      albertel 1550: 
1.156     albertel 1551:     my ($view,$view_section);
                   1552:     my $scope = $env{'request.course.id'};
                   1553:     if (!($view=&Apache::lonnet::allowed('vgr',$scope))) {
                   1554: 	$scope .= '/'.$env{'request.course.sec'};
                   1555: 	if ( $view = &Apache::lonnet::allowed('vgr',$scope)) {
                   1556: 	    $view_section=$env{'request.course.sec'};
                   1557: 	} else {
                   1558: 	    undef($view);
                   1559: 	}
                   1560:     }
                   1561: 
1.234   ! albertel 1562:     $result .= 
        !          1563: 	'<p><a href="/adm/flip?postdata=return:">'.
        !          1564: 	&mt('Return to resource').'</a></p><hr />'.
        !          1565: 	"\n<h3>Current Queue - $queue</h3>";
1.16      albertel 1566:     my $regexp="^$symb\0";
1.30      albertel 1567:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.31      albertel 1568:     my ($tmp)=%queue;
                   1569:     if ($tmp=~/^error: 2 /) {
1.234   ! albertel 1570: 	$result.=
        !          1571: 	    
1.159     albertel 1572: 	    &Apache::loncommon::start_data_table().
                   1573: 	    &Apache::loncommon::start_data_table_row().
                   1574: 	    '<td>'.&mt('Empty').'</td>'.
                   1575: 	    &Apache::loncommon::end_data_table_row().
                   1576: 	    &Apache::loncommon::end_data_table();
1.234   ! albertel 1577: 	return $result;
1.31      albertel 1578:     }
1.103     albertel 1579:     my $title=&Apache::lonnet::gettitle($symb);
1.234   ! albertel 1580:     $result.=
1.159     albertel 1581: 	&Apache::loncommon::start_data_table().
                   1582: 	&Apache::loncommon::start_data_table_header_row();
1.103     albertel 1583:     if ($with_selects) { $result.="<th>Status</th><th></th>"; }
1.159     albertel 1584:     $result.="<th>user</th><th>data</th>".
                   1585: 	&Apache::loncommon::end_data_table_header_row();
1.14      albertel 1586:     foreach my $key (sort(keys(%queue))) {
1.59      albertel 1587: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
                   1588: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
1.156     albertel 1589: 	
                   1590: 	my $section = $classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_SECTION()];
                   1591: 
                   1592: 	my $can_view=1;
                   1593: 	if (!$view
                   1594: 	    || ($view_section && !$section)
                   1595: 	    || ($view_section && $section && ($view_section ne $section))) {
                   1596: 	    $can_view=0;
                   1597: 	}
                   1598: 
1.32      albertel 1599: 	if ($key=~/locked$/ && !$with_selects) {
1.159     albertel 1600: 	    $result.= &Apache::loncommon::start_data_table_row().
                   1601: 		"<td>$uname</td>";
1.103     albertel 1602: 	    $result.='<td>'.$queue{$key}.'</td></tr>';
1.32      albertel 1603: 	} elsif ($key=~/timestamp$/ && !$with_selects) {
1.159     albertel 1604: 	    $result.=&Apache::loncommon::start_data_table_row()."<td></td>";
1.103     albertel 1605: 	    $result.='<td>'.
1.16      albertel 1606: 		&Apache::lonlocal::locallocaltime($queue{$key})."</td></tr>";
1.32      albertel 1607: 	} elsif ($key!~/(timestamp|locked)$/) {
1.159     albertel 1608: 	    $result.= &Apache::loncommon::start_data_table_row();
1.148     albertel 1609: 	    my ($end_time,$slot_text);
                   1610: 	    if (my $slot=&slotted_access($queue{$key})) {
                   1611: 		my %slot_data=&Apache::lonnet::get_slot($slot);
                   1612: 		$end_time = $slot_data{'endtime'};
                   1613: 		$slot_text = &mt('Slot: [_1]',$slot);
                   1614: 	    } else {
                   1615: 		$end_time = &Apache::lonhomework::due_date('0',$symb);
                   1616: 		$slot_text = '';
                   1617: 	    }
1.32      albertel 1618: 	    if ($with_selects) {
1.158     www      1619: 		my $ekey=&escape($key);
1.103     albertel 1620: 		my ($action,$description,$status)=('select',&mt('Select'));
1.32      albertel 1621: 		if (exists($queue{"$key\0locked"})) {
1.217     albertel 1622: 		    my ($locker,$time) = 
                   1623: 			&get_lock_info($queue{"$key\0locked"});
                   1624: 		    if ($time) {
1.214     albertel 1625: 			$time = 
                   1626: 			    &Apache::lonnavmaps::timeToHumanString($time,
                   1627: 								   'start');
                   1628: 		    }
1.138     albertel 1629: 		    my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.214     albertel 1630: 		    $status=&mt('Locked by <tt>[_1]</tt> [_2]',$locker,$time);
1.217     albertel 1631: 		    if ($me eq $locker) {
1.32      albertel 1632: 			($action,$description)=('resume',&mt('Resume'));
                   1633: 		    } else {
                   1634: 			($action,$description)=('unlock',&mt('Unlock'));
                   1635: 		    }
                   1636: 		}
1.62      albertel 1637: 		my $seclist;
                   1638: 		foreach my $sec (@chosen_sections) {
                   1639: 		    $seclist.='<input type="hidden" name="chosensections" 
                   1640:                                value="'.$sec.'" />';
                   1641: 		}
1.156     albertel 1642: 		if ($can_view && ($end_time ne '' && time > $end_time)) {
1.35      albertel 1643: 		    $result.=(<<FORM);
1.103     albertel 1644: <td>$status</td>
1.32      albertel 1645: <td>
1.115     albertel 1646: <form style="display: inline" method="post">
1.32      albertel 1647:  <input type="hidden" name="gradingkey" value="$ekey" />
                   1648:  <input type="hidden" name="queue" value="$queue" />
                   1649:  <input type="hidden" name="gradingaction" value="$action" />
                   1650:  <input type="hidden" name="webgrade" value="no" />
1.33      albertel 1651:  <input type="hidden" name="queuemode" value="selected" />
1.32      albertel 1652:  <input type="submit" name="submit" value="$description" />
1.62      albertel 1653:  $seclist
1.32      albertel 1654: </form>
                   1655: </td>
                   1656: FORM
1.156     albertel 1657:                 } elsif (!$can_view && ($end_time ne '' && time > $end_time)) {
                   1658: 		    $result.='<td>'.&mt("Not gradable").'</td><td>&nbsp;</td>'
1.35      albertel 1659:                 } else {
1.148     albertel 1660: 		    $result.='<td>'.&mt("In Progress").'</td><td>&nbsp;</td>'
1.35      albertel 1661: 		}
1.32      albertel 1662: 	    }
1.156     albertel 1663: 	    $result.= "<td>".$classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_FULLNAME()].
1.138     albertel 1664: 		" <tt>($uname:$udom)</tt> </td>";
1.148     albertel 1665: 	    $result.='<td>'.$slot_text.' End time: '.
                   1666: 		&Apache::lonlocal::locallocaltime($end_time).
1.159     albertel 1667: 		"</td>".&Apache::loncommon::end_data_table_row();
1.16      albertel 1668: 	}
1.14      albertel 1669:     }
1.159     albertel 1670:     $result.= &Apache::loncommon::end_data_table()."<hr />\n";
1.14      albertel 1671:     return $result;
                   1672: }
                   1673: 
1.34      albertel 1674: sub get_queue_counts {
                   1675:     my ($queue)=@_;
                   1676:     my $result;
1.185     albertel 1677:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.34      albertel 1678:     my $cnum=$env{'course.'.$cid.'.num'};
                   1679:     my $cdom=$env{'course.'.$cid.'.domain'};
1.156     albertel 1680: 
1.157     albertel 1681:     my $classlist=&get_limited_classlist();
1.156     albertel 1682: 
1.34      albertel 1683:     my $regexp="^$symb\0";
                   1684:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
                   1685:     my ($tmp)=%queue;
                   1686:     if ($tmp=~/^error: 2 /) {
                   1687: 	return (0,0,0);
                   1688:     }
                   1689:     my ($entries,$ready_to_grade,$locks)=(0,0,0);
1.96      albertel 1690:     my %slot_cache;
1.34      albertel 1691:     foreach my $key (sort(keys(%queue))) {
1.156     albertel 1692: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
                   1693: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
1.34      albertel 1694: 	if ($key=~/locked$/) {
                   1695: 	    $locks++;
                   1696: 	} elsif ($key=~/timestamp$/) {
                   1697: 	    #ignore
                   1698: 	} elsif ($key!~/(timestamp|locked)$/) {
                   1699: 	    $entries++;
1.148     albertel 1700: 	    if (my $slot=&slotted_access($queue{$key})) {
                   1701: 		if (!exists($slot_cache{$slot})) {
                   1702: 		    my %slot_data=&Apache::lonnet::get_slot($slot);
                   1703: 		    $slot_cache{$slot} = \%slot_data;
                   1704: 		}
                   1705: 		if (time > $slot_cache{$slot}{'endtime'}) {
                   1706: 		    $ready_to_grade++;
                   1707: 		}
                   1708: 	    } else {
                   1709: 		my $due_date = &Apache::lonhomework::due_date('0',$symb);
                   1710: 		if ($due_date ne '' && time > $due_date) {
                   1711: 		    $ready_to_grade++;
                   1712: 		}
1.34      albertel 1713: 	    }
                   1714: 	}
                   1715:     }
                   1716:     return ($entries,$ready_to_grade,$locks);
                   1717: }
                   1718: 
1.49      albertel 1719: sub encode_queue_key {
                   1720:     my ($symb,$udom,$uname)=@_;
1.138     albertel 1721:     return "$symb\0queue\0$uname:$udom";
1.49      albertel 1722: }
                   1723: 
1.14      albertel 1724: sub decode_queue_key {
                   1725:     my ($key)=@_;
                   1726:     my ($symb,undef,$user) = split("\0",$key);
1.138     albertel 1727:     my ($uname,$udom) = split(':',$user);
1.14      albertel 1728:     return ($symb,$uname,$udom);
                   1729: }
                   1730: 
                   1731: sub queue_key_locked {
1.30      albertel 1732:     my ($queue,$key,$cdom,$cnum)=@_;
1.33      albertel 1733:     if (!defined($cdom) || !defined($cnum)) {
1.185     albertel 1734: 	my (undef,$cid)=&Apache::lonnet::whichuser();
1.33      albertel 1735: 	$cnum=$env{'course.'.$cid.'.num'};
                   1736: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1737:     }
1.14      albertel 1738:     my ($key_locked,$value)=
1.30      albertel 1739: 	&Apache::lonnet::get($queue,["$key\0locked"],$cdom,$cnum);
1.14      albertel 1740:     if ($key_locked eq "$key\0locked") {
1.217     albertel 1741: 	return &get_lock_info($value);
1.14      albertel 1742:     }
                   1743:     return undef;
                   1744: }
                   1745: 
1.148     albertel 1746: sub slotted_access {
                   1747:     my ($queue_entry) = @_;
                   1748:     if (ref($queue_entry) eq 'ARRAY') {
                   1749: 	if (defined($queue_entry->[0])) {
                   1750: 	    return $queue_entry->[0];
                   1751: 	}
                   1752: 	return undef;
                   1753:     } elsif (ref($queue_entry) eq 'HASH') {
                   1754: 	if (defined($queue_entry->{'slot'})) {
                   1755: 	    return $queue_entry->{'slot'};
                   1756: 	}
                   1757: 	return undef;
                   1758:     }
                   1759:     return undef;
                   1760: }
                   1761: 
1.14      albertel 1762: sub pick_from_queue_data {
1.156     albertel 1763:     my ($queue,$check_section,$queuedata,$cdom,$cnum,$classlist)=@_;
1.98      albertel 1764:     my @possible; # will hold queue entries that are valid to be selected
1.30      albertel 1765:     foreach my $key (keys(%$queuedata)) {
1.68      albertel 1766: 	if ($key =~ /\0locked$/) { next; }
                   1767: 	if ($key =~ /\0timestamp$/) { next; }
1.156     albertel 1768: 
1.14      albertel 1769: 	my ($symb,$uname,$udom)=&decode_queue_key($key);
1.156     albertel 1770: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
                   1771: 
1.14      albertel 1772: 	if ($check_section) {
1.156     albertel 1773: 	    my $section =
                   1774: 		$classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_SECTION()];
1.17      albertel 1775: 	    if ($section eq $check_section) {
1.33      albertel 1776: 		&Apache::lonxml::debug("my sec");
1.15      albertel 1777: 		next;
                   1778: 	    }
1.14      albertel 1779: 	}
1.148     albertel 1780: 	my $end_time;
                   1781: 	if (my $slot=&slotted_access($queuedata->{$key})) {
1.154     albertel 1782: 	    &Apache::lonxml::debug("looking at slot $slot");
1.148     albertel 1783: 	    my %slot_data=&Apache::lonnet::get_slot($slot);
                   1784: 	    if ($slot_data{'endtime'} < time) { 
                   1785: 		$end_time = $slot_data{'endtime'};
1.154     albertel 1786: 	    } else {
                   1787: 		&Apache::lonxml::debug("not time ".$slot_data{'endtime'});
                   1788: 		next;
1.148     albertel 1789: 	    }
                   1790: 	} else {
                   1791: 	    my $due_date = &Apache::lonhomework::due_date('0',$symb);
1.154     albertel 1792: 	    if ($due_date < time) {
1.148     albertel 1793: 		$end_time = $due_date;
1.154     albertel 1794: 	    } else {
                   1795: 		&Apache::lonxml::debug("not time $due_date");
                   1796: 		next;
1.148     albertel 1797: 	    }
                   1798: 	}
                   1799: 	
1.98      albertel 1800: 	if (exists($queuedata->{"$key\0locked"})) {
1.33      albertel 1801: 	    &Apache::lonxml::debug("someone already has um.");
1.15      albertel 1802: 	    next;
                   1803: 	}
1.148     albertel 1804: 	push(@possible,[$key,$end_time]);
1.98      albertel 1805:     }
                   1806:     if (@possible) {
                   1807:         # sort entries in order by slot end time
                   1808: 	@possible = sort { $a->[1] <=> $b->[1] } @possible;
1.137     albertel 1809: 	# pick one of the entries in the top 10% in small queues and one
                   1810: 	# of the first ten entries in large queues
1.139     albertel 1811: 	#my $ten_percent = int($#possible * 0.1);
                   1812: 	#if ($ten_percent < 1 ) { $ten_percent = 1;  }
                   1813: 	#if ($ten_percent > 10) { $ten_percent = 10; }
                   1814: 	#my $max=($#possible < $ten_percent) ? $#possible : $ten_percent;
1.137     albertel 1815: 	
1.139     albertel 1816: 	#return $possible[int(rand($max))][0];
                   1817: 	return $possible[0][0];
1.14      albertel 1818:     }
                   1819:     return undef;
                   1820: }
                   1821: 
1.217     albertel 1822: sub get_lock_info {
                   1823:     my ($lock_info) = @_;
                   1824:     if (wantarray) {
                   1825: 	if (ref($lock_info) eq 'ARRAY') {
                   1826: 	    return @{$lock_info};
                   1827: 	} else {
                   1828: 	    return ($lock_info);
                   1829: 	}
                   1830:     } else {
                   1831: 	if (ref($lock_info) eq 'ARRAY') {
                   1832: 	    return $lock_info->[0];
                   1833: 	} else {
                   1834: 	    return $lock_info;
                   1835: 	}
                   1836:     }
                   1837:     return;
                   1838: }
                   1839: 
1.15      albertel 1840: sub find_mid_grade {
1.30      albertel 1841:     my ($queue,$symb,$cdom,$cnum)=@_;
1.158     www      1842:     my $todo=&unescape($env{'form.gradingkey'});
1.138     albertel 1843:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.15      albertel 1844:     if ($todo) {
1.30      albertel 1845: 	my $who=&queue_key_locked($queue,$todo,$cdom,$cnum);
1.15      albertel 1846: 	if ($who eq $me) { return $todo; }
                   1847:     }
                   1848:     my $regexp="^$symb\0.*\0locked\$";
1.30      albertel 1849:     my %locks=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.15      albertel 1850:     foreach my $key (keys(%locks)) {
1.217     albertel 1851: 	my $who= &get_lock_info($locks{$key});
1.15      albertel 1852: 	if ($who eq $me) {
                   1853: 	    $todo=$key;
                   1854: 	    $todo=~s/\0locked$//;
                   1855: 	    return $todo;
                   1856: 	}
                   1857:     }
                   1858:     return undef;
                   1859: }
                   1860: 
1.32      albertel 1861: sub lock_key {
                   1862:     my ($queue,$todo)=@_;
1.138     albertel 1863:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.185     albertel 1864:     my (undef,$cid)=&Apache::lonnet::whichuser();
1.32      albertel 1865:     my $cnum=$env{'course.'.$cid.'.num'};
                   1866:     my $cdom=$env{'course.'.$cid.'.domain'};
1.214     albertel 1867:     my $success=&Apache::lonnet::newput($queue,{"$todo\0locked"=> [$me,time]},
1.32      albertel 1868: 					$cdom,$cnum);
1.33      albertel 1869:     &Apache::lonxml::debug("success $success $todo");
1.32      albertel 1870:     if ($success eq 'ok') {
                   1871: 	return 1;
                   1872:     }
                   1873:     return 0;
                   1874: }
                   1875: 
1.86      albertel 1876: sub get_queue_symb_status {
1.85      albertel 1877:     my ($queue,$symb,$cdom,$cnum) = @_;
                   1878:     if (!defined($cdom) || !defined($cnum)) {
1.185     albertel 1879: 	my (undef,$cid)=&Apache::lonnet::whichuser();
1.85      albertel 1880: 	$cnum=$env{'course.'.$cid.'.num'};
                   1881: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1882:     }
1.157     albertel 1883:     my $classlist=&get_limited_classlist();
1.156     albertel 1884: 
1.85      albertel 1885:     my $regexp="^$symb\0";
                   1886:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
                   1887:     my ($tmp)=%queue;
                   1888:     if ($tmp=~/^error: 2 /) { return; }
                   1889:     my @users;
                   1890:     foreach my $key (sort(keys(%queue))) {
                   1891: 	next if ($key=~/locked$/);
                   1892: 	next if ($key=~/timestamp$/);
                   1893: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
1.156     albertel 1894: 	next if (!defined($classlist->{$uname.':'.$udom}));
1.85      albertel 1895: 	push(@users,"$uname:$udom");
                   1896:     }
                   1897:     return @users;
                   1898: }
                   1899: 
1.14      albertel 1900: sub get_from_queue {
1.30      albertel 1901:     my ($queue)=@_;
1.14      albertel 1902:     my $result;
1.185     albertel 1903:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.14      albertel 1904:     my $cnum=$env{'course.'.$cid.'.num'};
                   1905:     my $cdom=$env{'course.'.$cid.'.domain'};
1.32      albertel 1906:     my $todo=&find_mid_grade($queue,$symb,$cdom,$cnum);
1.33      albertel 1907:     &Apache::lonxml::debug("found ".join(':',&decode_queue_key($todo)));
1.16      albertel 1908:     if ($todo) { return $todo; }
1.95      albertel 1909:     my $attempts=0;
1.156     albertel 1910: 
1.157     albertel 1911:     my $classlist=&get_limited_classlist();
1.156     albertel 1912: 
1.14      albertel 1913:     while (1) {
1.95      albertel 1914: 	if ($attempts > 2) {
                   1915: 	    # tried twice to get a queue entry, giving up
                   1916: 	    return (undef,'unable');
                   1917: 	}
1.14      albertel 1918: 	my $starttime=time;
1.83      albertel 1919: 	&Apache::lonnet::cput($queue,{"$symb\0timestamp"=>$starttime},
                   1920: 			      $cdom,$cnum);
1.33      albertel 1921: 	&Apache::lonxml::debug("$starttime");
1.14      albertel 1922: 	my $regexp="^$symb\0queue\0";
1.156     albertel 1923: 	#my $range= ($attempts < 1 ) ? '0-100' : '0-400';
1.97      albertel 1924: 
1.98      albertel 1925: 	my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.33      albertel 1926: 	#make a pass looking for a user _not_ in my section
1.14      albertel 1927: 	if ($env{'request.course.sec'}) {
1.33      albertel 1928: 	    &Apache::lonxml::debug("sce");
1.30      albertel 1929: 	    $todo=&pick_from_queue_data($queue,$env{'request.course.sec'},
1.156     albertel 1930: 					\%queue,$cdom,$cnum,$classlist);
1.33      albertel 1931: 	    &Apache::lonxml::debug("sce $todo");
1.14      albertel 1932: 	}
1.33      albertel 1933: 	# no one _not_ in our section so look for any user that is
                   1934: 	# ready for grading
1.14      albertel 1935: 	if (!$todo) {
1.33      albertel 1936: 	    &Apache::lonxml::debug("no sce");
1.156     albertel 1937: 	    $todo=&pick_from_queue_data($queue,undef,\%queue,$cdom,$cnum,
                   1938: 					$classlist);
1.33      albertel 1939: 	    &Apache::lonxml::debug("no sce $todo");
1.14      albertel 1940: 	}
                   1941: 	# no user to grade 
                   1942: 	if (!$todo) { last; }
1.33      albertel 1943: 	&Apache::lonxml::debug("got $todo");
1.14      albertel 1944: 	# otherwise found someone so lets try to lock them
1.32      albertel 1945: 	# unless someone else already picked them
1.95      albertel 1946: 	if (!&lock_key($queue,$todo)) {
                   1947: 	    $attempts++;
                   1948: 	    next;
                   1949: 	}
1.14      albertel 1950: 	my (undef,$endtime)=
1.30      albertel 1951: 	    &Apache::lonnet::get($queue,["$symb\0timestamp"],
1.14      albertel 1952: 				 $cdom,$cnum);
1.33      albertel 1953: 	&Apache::lonxml::debug("emd  $endtime");
1.14      albertel 1954: 	# someone else already modified the queue, 
                   1955: 	# perhaps our picked user wass already fully graded between
                   1956: 	# when we picked him and when we locked his record? so lets
                   1957: 	# double check.
                   1958: 	if ($endtime != $starttime) {
                   1959: 	    my ($key,$value)=
1.30      albertel 1960: 		&Apache::lonnet::get($queue,["$todo"],
1.14      albertel 1961: 				     $cdom,$cnum);
1.33      albertel 1962: 	    &Apache::lonxml::debug("check  $key .. $value");
1.14      albertel 1963: 	    if ($key eq $todo && ref($value)) {
                   1964: 	    } else {
1.30      albertel 1965: 		&Apache::lonnet::del($queue,["$todo\0locked"],
1.14      albertel 1966: 				     $cdom,$cnum);
1.33      albertel 1967: 		&Apache::lonxml::debug("del");
1.95      albertel 1968: 		$attempts++;
1.14      albertel 1969: 		next;
                   1970: 	    }
                   1971: 	}
1.33      albertel 1972: 	&Apache::lonxml::debug("last $todo");
1.14      albertel 1973: 	last;
                   1974:     }
                   1975:     return $todo;
                   1976: }
                   1977: 
1.49      albertel 1978: sub select_user {
1.185     albertel 1979:     my ($symb,$cid)=&Apache::lonnet::whichuser();
1.49      albertel 1980: 
1.59      albertel 1981:     my @chosen_sections=
                   1982: 	&Apache::loncommon::get_env_multiple('form.chosensections');
1.156     albertel 1983: 
                   1984:     my $classlist = &get_limited_classlist(\@chosen_sections);
1.63      albertel 1985:     
                   1986:     my $result;
                   1987:     if (!(grep(/^all$/,@chosen_sections))) {
                   1988: 	$result.='<p> Showing only sections <tt>'.join(', ',@chosen_sections).
                   1989: 	    '</tt>.</p> '."\n";
                   1990:     }
1.159     albertel 1991:     $result.=&Apache::loncommon::start_data_table();
1.49      albertel 1992: 
1.156     albertel 1993:     foreach my $student (sort {lc($classlist->{$a}[&Apache::loncoursedata::CL_FULLNAME()]) cmp lc($classlist->{$b}[&Apache::loncoursedata::CL_FULLNAME()]) } (keys(%$classlist))) {
1.49      albertel 1994: 	my ($uname,$udom) = split(/:/,$student);
1.59      albertel 1995: 	
1.84      albertel 1996: 	my $cnum=$env{'course.'.$cid.'.num'};
                   1997: 	my $cdom=$env{'course.'.$cid.'.domain'};
1.88      albertel 1998: 	my %status = &get_student_status($symb,$cdom,$cnum,$udom,$uname,
                   1999: 					 'Task');
1.49      albertel 2000: 	my $queue = 'none';
1.58      albertel 2001: 	my $cannot_grade;
                   2002: 	if ($status{'reviewqueue'} =~ /^(in_progress|enqueue)$/) {
1.49      albertel 2003: 	    $queue = 'reviewqueue';
1.58      albertel 2004: 	    if ($status{'reviewqueue'} eq 'in_progress') {
                   2005: 		$cannot_grade=1;
                   2006: 	    }
                   2007: 	} elsif ($status{'gradingqueue'} =~ /^(in_progress|enqueue)$/) {
1.49      albertel 2008: 	    $queue = 'gradingqueue';
1.58      albertel 2009: 	    if ($status{'gradingqueue'} eq 'in_progress') {
                   2010: 		$cannot_grade=1;
                   2011: 	    }
1.49      albertel 2012: 	}
                   2013: 	my $todo = 
1.158     www      2014: 	    &escape(&encode_queue_key($symb,$udom,$uname));
1.58      albertel 2015: 	if ($cannot_grade) {
1.159     albertel 2016: 	    $result.=&Apache::loncommon::start_data_table_row().
                   2017: 		'<td>&nbsp;</td><td>'.$classlist->{$student}[&Apache::loncoursedata::CL_FULLNAME()].
1.58      albertel 2018: 		'</td><td>';
                   2019: 	} else {
1.62      albertel 2020: 	    my $seclist;
                   2021: 	    foreach my $sec (@chosen_sections) {
                   2022: 		$seclist.='<input type="hidden" name="chosensections" 
                   2023:                                value="'.$sec.'" />';
                   2024: 	    }
1.159     albertel 2025: 	    $result.=&Apache::loncommon::start_data_table_row();
1.58      albertel 2026: 	    $result.=<<RESULT;
1.49      albertel 2027:   <td>
1.115     albertel 2028:     <form style="display: inline" method="post">
1.49      albertel 2029:       <input type="hidden" name="gradingkey" value="$todo" />
                   2030:       <input type="hidden" name="queue" value="$queue" />
                   2031:       <input type="hidden" name="webgrade" value="no" />
1.52      albertel 2032:       <input type="hidden" name="regrade" value="yes" />
1.62      albertel 2033:       <input type="submit" name="submit" value="Regrade" />
                   2034:       $seclist
1.49      albertel 2035:     </form>
1.155     albertel 2036:   <td>$classlist->{$student}[&Apache::loncoursedata::CL_FULLNAME()] <tt>($student)</tt></td>
1.49      albertel 2037:   <td>
                   2038: RESULT
1.58      albertel 2039:         }
1.49      albertel 2040:         if ($status{'status'} eq 'pass') {
                   2041: 	    $result .= '<font color="green">'.&mt('Passed').'</font>';
                   2042: 	} elsif ($status{'status'} eq 'fail') {
                   2043: 	    $result .= '<font color="red">'.&mt('Failed').'</font>';
                   2044: 	} elsif ($status{'status'} eq 'review') {
                   2045: 	    $result .= '<font color="blue">'.&mt('Under Review').'</font>';
                   2046: 	} elsif ($status{'status'} eq 'ungraded') {
                   2047: 	    $result .= &mt('Ungraded');
                   2048: 	} elsif ($status{'status'} ne '') {
                   2049: 	    $result .= '<font color="orange">'.&mt('Unknown Status').'</font>';
                   2050: 	} else {
                   2051: 	    $result.="&nbsp;";
                   2052: 	}
                   2053: 	if ($status{'version'}) {
                   2054: 	    $result .= ' '.&mt('Version').' '.$status{'version'};
                   2055: 	}
1.101     albertel 2056: 	if ($status{'grader'}) {
                   2057: 	    $result .= ' '.&mt('(Graded by [_1])',$status{'grader'}).' ';
                   2058: 	}
1.49      albertel 2059: 	$result.= '</td><td>';
                   2060: 	if ($status{'reviewqueue'} eq 'enqueued') {
                   2061: 	    $result .= &mt('Awaiting Review');
                   2062: 	} elsif ($status{'reviewqueue'} eq 'locked') {
                   2063: 	    $result .= &mt('Under Review');
1.58      albertel 2064: 	} elsif ($status{'reviewqueue'} eq 'in_progress') {
                   2065: 	    $result .= &mt('Still being worked on.');
1.49      albertel 2066: 	} elsif ($status{'gradingqueue'} eq 'enqueued') {
                   2067: 	    $result .= &mt('Awaiting Grading');
                   2068: 	} elsif ($status{'gradingqueue'} eq 'locked') {
                   2069: 	    $result .= &mt('Being Graded');
1.58      albertel 2070: 	} elsif ($status{'gradingqueue'} eq 'in_progress') {
                   2071: 	    $result .= &mt('Still being worked on.');
1.49      albertel 2072: 	} else {
                   2073: 	    $result.="&nbsp;";
                   2074: 	}
1.159     albertel 2075: 	$result.= '</td>'.&Apache::loncommon::end_data_table_row();
1.49      albertel 2076:     }
1.159     albertel 2077:     $result.=&Apache::loncommon::end_data_table();
1.49      albertel 2078:     return $result;
                   2079: }
                   2080: 
                   2081: sub get_student_status {
1.86      albertel 2082:     my ($symb,$cdom,$cnum,$udom,$uname,$type)=@_;
                   2083: 
                   2084:     my %status;
                   2085: 
                   2086:     if ($type eq 'Task') {
                   2087: 	my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
1.49      albertel 2088: 					  $udom,$uname);
1.89      albertel 2089: 	$status{'status'}=$record{'resource.0.status'};
                   2090: 	$status{'version'}=$record{'resource.0.version'};
                   2091: 	$status{'grader'}=$record{'resource.0.regrader'};
1.86      albertel 2092:     }
                   2093:     $status{'reviewqueue'}=
                   2094: 	&check_queue_for_key($cdom,$cnum,'reviewqueue',
                   2095: 			     &encode_queue_key($symb,$udom,$uname));
                   2096:     $status{'gradingqueue'}=
                   2097: 	&check_queue_for_key($cdom,$cnum,'gradingqueue',
                   2098: 			     &encode_queue_key($symb,$udom,$uname));
1.49      albertel 2099:     return %status;
                   2100: }
                   2101: 
1.1       albertel 2102: sub start_ClosingParagraph {
                   2103:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   2104:     my $result;
                   2105:     if ($target eq 'web') {
1.13      albertel 2106:     } elsif ($target eq 'webgrade') {
                   2107: 	&Apache::lonxml::startredirection();
1.225     albertel 2108:     } elsif ($target eq 'edit') {
                   2109: 	$result = &Apache::edit::tag_start($target,$token);
                   2110:     } elsif ($target eq 'modified') {
1.1       albertel 2111:     }
                   2112:     return $result;
                   2113: }
                   2114: 
                   2115: sub end_ClosingParagraph {
                   2116:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   2117:     my $result;
                   2118:     if ($target eq 'web') {
1.13      albertel 2119:     } elsif ($target eq 'webgrade') {
                   2120: 	&Apache::lonxml::endredirection();
1.1       albertel 2121:     }
                   2122:     return $result;
                   2123: }
                   2124: 
1.227     albertel 2125: sub insert_ClosingParagraph {
                   2126:     return '
                   2127: <ClosingParagraph>
                   2128:     <startouttext />
                   2129:     <endouttext />
                   2130: </ClosingParagraph>';
                   2131: }
                   2132: 
1.168     albertel 2133: sub get_dim_id {
1.194     albertel 2134:     if (@Apache::bridgetask::dimension) {
                   2135: 	return $Apache::bridgetask::dimension[-1];
                   2136:     } else {
                   2137: 	return $top;
                   2138:     }
1.168     albertel 2139: }
                   2140: 
1.19      albertel 2141: sub get_id {
                   2142:     my ($parstack,$safeeval)=@_;
                   2143:     my $id=&Apache::lonxml::get_param('id',$parstack,$safeeval);
                   2144:     if (!$id) { $id=$Apache::lonxml::curdepth; }
                   2145:     return $id;
                   2146: }
                   2147: 
1.162     albertel 2148: sub start_Setup {
                   2149:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.225     albertel 2150:     my $result;
1.168     albertel 2151:     my $dim = &get_id($parstack,$safeeval);
                   2152:     push(@Apache::bridgetask::dimension,$dim);
1.225     albertel 2153:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'grade') {
                   2154: 	&Apache::lonxml::startredirection();
                   2155:     } elsif ($target eq 'edit') {
                   2156: 	$result = &Apache::edit::tag_start($target,$token);
                   2157: 	$result.= &Apache::edit::text_arg('Id:','id',$token,10).
                   2158: 	    &Apache::edit::end_row().
                   2159: 	    &Apache::edit::start_spanning_row();
                   2160:     } elsif ($target eq 'modified') {
                   2161: 	my $constructtag=
                   2162: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,'id');
                   2163: 	if ($constructtag) {
                   2164: 	    $result = &Apache::edit::rebuild_tag($token);
                   2165: 	}
                   2166:     }
                   2167:     return $result;
1.162     albertel 2168: }
1.173     albertel 2169: 
                   2170: {
                   2171:     my @allowed;
                   2172:     sub enable_dimension_parsing {
                   2173: 	my ($id) = @_;
                   2174: 	push(@allowed,$id);
                   2175:     }
                   2176:     sub disable_dimension_parsing {
                   2177: 	pop(@allowed);
                   2178:     }
                   2179:     sub skip_dimension_parsing {
                   2180: 	my ($check) = @_;
                   2181: 	if (!@allowed) { return 0;}
                   2182: 	# if unspecified allow any id
                   2183: 	if ($allowed[-1] eq undef) { return 0;}
                   2184: 
                   2185: 	return ($check ne $allowed[-1]);
                   2186:     }
                   2187: }
                   2188: 
1.151     albertel 2189: sub start_Question { return &start_Dimension(@_); }
1.1       albertel 2190: sub start_Dimension {
1.173     albertel 2191:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.168     albertel 2192:     my $dim = &get_id($parstack,$safeeval);
                   2193:     my $previous_dim;
1.225     albertel 2194:     my $result;
                   2195:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2196: 	if (@Apache::bridgetask::dimension) {
                   2197: 	    $previous_dim = $Apache::bridgetask::dimension[-1];
                   2198: 	    push(@{$Apache::bridgetask::dimension{$previous_dim}{'contains'}},
                   2199: 		 $dim);
                   2200: 	    if(&skip_dimension_parsing($dim)) {
                   2201: 		$dimension{$previous_dim}{'criteria.'.$dim} =
                   2202: 		    $token->[4]
                   2203: 		    .&Apache::lonxml::get_all_text('/'.$tagstack->[-1],$parser,
                   2204: 						   $style)
                   2205: 		    .'</'.$tagstack->[-1].'>';
                   2206: 	    }
                   2207: 	    $dimension{$previous_dim}{'criteria.'.$dim.'.type'}='dimension';
                   2208: 	    $dimension{$previous_dim}{'criteria.'.$dim.'.mandatory'}=
                   2209: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
                   2210: 	    push(@{$dimension{$previous_dim}{'criterias'}},$dim);
                   2211: 	    $dimension{$dim}{'nested'}=$previous_dim;
                   2212: 	    $dimension{$dim}{'depth'} = 1 + $dimension{$previous_dim}{'depth'};
                   2213: 	    
                   2214: 	    &Apache::lonxml::debug("adding $dim as criteria to $previous_dim");
                   2215: 	} else {
                   2216: 	    $dimension{$top}{'depth'}=0;
                   2217: 	    $dimension{$top}{'criteria.'.$dim.'.type'}='dimension';
                   2218: 	    $dimension{$top}{'criteria.'.$dim.'.mandatory'}=
                   2219: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
                   2220: 	    push(@{$dimension{$top}{'criterias'}},$dim);
                   2221: 	    $dimension{$dim}{'nested'}=$top;
                   2222: 	}
                   2223:         push(@Apache::bridgetask::dimension,$dim);
                   2224: 	&Apache::lonxml::startredirection();
                   2225: 	if (!&skip_dimension_parsing($dim)) {
                   2226: 	    &enable_dimension_parsing($dim);
                   2227: 	}
                   2228:     } elsif ($target eq 'edit') {
                   2229:   	$result = &Apache::edit::tag_start($target,$token);
                   2230: 	$result.=  
                   2231: 	    &Apache::edit::text_arg('Id:','id',$token,10).' '.
                   2232: 	    &Apache::edit::select_arg('Passing is Mandatory:','Mandatory',
1.233     albertel 2233: 				      [['Y', 'Yes'],
                   2234: 				       ['N','No'],],
1.225     albertel 2235: 				      $token).' <br /> '.
                   2236: 	    &Apache::edit::text_arg('Required number of passed optional elements to pass the '.$token->[1].':',
                   2237: 				    'OptionalRequired',$token,4).
                   2238: 	    &Apache::edit::end_row().
                   2239: 	    &Apache::edit::start_spanning_row();
                   2240:     } elsif ($target eq 'modified') {
                   2241: 	my $constructtag=
                   2242: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,
                   2243: 					'id','Mandatory','OptionalRequired');
                   2244: 	if ($constructtag) {
                   2245: 	    $result = &Apache::edit::rebuild_tag($token);
                   2246: 	}
1.168     albertel 2247:     }
1.225     albertel 2248:     return $result;# &internal_location($dim);
1.1       albertel 2249: }
                   2250: 
1.160     albertel 2251: sub start_QuestionText {
                   2252:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.225     albertel 2253:     my $result;
                   2254:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2255: 	my $text=&Apache::lonxml::get_all_text('/questiontext',$parser,$style);
1.168     albertel 2256:     my $dim = &get_dim_id();
1.169     albertel 2257: 	$dimension{$dim}{'questiontext'}=$text;
1.225     albertel 2258:     } elsif ($target eq 'edit') {
                   2259: 	$result = &Apache::edit::tag_start($target,$token);
                   2260:     } elsif ($target eq 'modified') {
1.160     albertel 2261:     }
1.225     albertel 2262:     return $result;
1.160     albertel 2263: }
                   2264: 
                   2265: sub end_QuestionText {
                   2266:     return '';
                   2267: }
                   2268: 
1.227     albertel 2269: sub insert_QuestionText {
                   2270:     return '
                   2271: <QuestionText>
                   2272:     <startouttext />
                   2273:     <endouttext />
                   2274: </QuestionText>';
                   2275: }
                   2276: 
1.13      albertel 2277: sub get_instance {
1.75      albertel 2278:     my ($dim)=@_;
                   2279:     my $rand_alg=&Apache::lonnet::get_rand_alg();
                   2280:     if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' ||
                   2281: 	$rand_alg eq '64bit2' || $rand_alg eq '64bit3' ||
                   2282: 	$rand_alg eq '64bit4' ) {
                   2283: 	&Apache::response::pushrandomnumber();
1.169     albertel 2284: 	my @order=&Math::Random::random_permutation(@{$dimension{$dim}{'instances'}});
1.75      albertel 2285: 	my $num=@order;
                   2286: 	my $version=&get_version();
                   2287: 	my $which=($version-1)%$num;
                   2288: 	return $order[$which];
                   2289:     } else {
                   2290: 	my ($version,$previous) = &get_version();
                   2291: 	my $instance = 
                   2292: 	    $Apache::lonhomework::history{"resource.$version.0.$dim.instance"};
                   2293: 	if (defined($instance)) { return $instance; }
                   2294: 
                   2295: 	&Apache::response::pushrandomnumber();
1.173     albertel 2296: 	if (ref($dimension{$dim}{'instances'}) eq 'ARRAY') {
                   2297: 	    my @instances = @{$dimension{$dim}{'instances'}};
                   2298: 	    # remove disabled instances
                   2299: 	    for (my $i=0; $i < $#instances; $i++) {
                   2300: 		if ($dimension{$dim}{$instances[$i].'.disabled'}) {
                   2301: 		    splice(@instances,$i,1);
                   2302: 		    $i--;
                   2303: 		}
                   2304: 	    }
                   2305: 	    @instances = &Math::Random::random_permutation(@instances);
                   2306: 	    $instance  = $instances[($version-1)%scalar(@instances)];
                   2307: 	    if ($version =~ /^\d$/) {
                   2308: 		$Apache::lonhomework::results{"resource.$version.0.$dim.instance"} = 
                   2309: 		    $instance;
                   2310: 		$Apache::lonhomework::results{'INTERNAL_store'} = 1; 
1.75      albertel 2311: 	    }
                   2312: 	}
                   2313: 	&Apache::response::poprandomnumber();
                   2314: 	return $instance;
                   2315:     }
1.13      albertel 2316: }
                   2317: 
1.169     albertel 2318: sub get_criteria {
                   2319:     my ($what,$version,$dim,$id) = @_;
                   2320:     my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
1.194     albertel 2321:     my $prefix = ($type eq 'criteria' && $dim ne $top) ? "$dim.$id"
                   2322: 	                                               : "$id";
1.169     albertel 2323:     my $entry = "resource.$version.0.$prefix.$what";
                   2324:     if (exists($Apache::lonhomework::results{$entry})) {
                   2325: 	return $Apache::lonhomework::results{$entry};
                   2326:     }
                   2327:     return $Apache::lonhomework::history{$entry};
                   2328: }
                   2329: 
1.194     albertel 2330: sub link {
                   2331:     my ($id) = @_;
                   2332:     $id =~ s/\./_/g;
                   2333:     return 'LC_GRADING_criteria_'.$id;
                   2334: }
                   2335: sub end_Question { return &end_Dimension(@_); }
                   2336: sub end_Dimension {
                   2337:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.225     albertel 2338:     my $result;
1.194     albertel 2339:     my $dim=&get_id($parstack,$safeeval);
1.225     albertel 2340:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2341: 	$result=&Apache::lonxml::endredirection();
                   2342: 	if (&skip_dimension_parsing($dim)) {
                   2343: 	    pop(@Apache::bridgetask::dimension);
                   2344: 	    return;
                   2345: 	}
1.122     albertel 2346:     }
1.194     albertel 2347:     my $instance=&get_instance($dim);
                   2348:     my $version=&get_version();
                   2349:     if ($target eq 'web') {
                   2350: 	$result .= &nested_parse(\$dimension{$dim}{'intro'},[@_]);
                   2351: 	my @instances = $instance;
                   2352: 	if (&Apache::response::showallfoils()) {
                   2353: 	    @instances = @{$dimension{$dim}{'instances'}};
1.173     albertel 2354: 	}
1.194     albertel 2355: 	my $shown_question_text;
                   2356: 	foreach my $instance (@instances) {
                   2357: 	    $result .= &nested_parse(\$dimension{$dim}{$instance.'.text'},
                   2358: 				     [@_]);
                   2359: 	    $result .= &nested_parse(\$dimension{$dim}{'questiontext'},
                   2360: 				     [@_],{'set_dim_id' => undef});
                   2361: 	    my $task_status = 
                   2362: 		$Apache::lonhomework::history{"resource.$version.0.status"};
                   2363: 	    if ($task_status ne 'pass' && $task_status ne 'fail') {
                   2364: 		
                   2365: 		foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2366: 				@{$dimension{$dim}{'criterias'}}) {
                   2367: 		    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2368: 		    &Apache::lonxml::debug("$id is $type");
                   2369: 		    if ($type eq 'dimension') {
                   2370: 			$result.=
                   2371: 			    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2372: 					  [@_],{'set_dim_id' => $id});
1.173     albertel 2373: 		    }
1.194     albertel 2374: 		}
                   2375: 	    } else {
                   2376: 		my $dim_status=$Apache::lonhomework::history{"resource.$version.0.$dim.status"};
                   2377: 		my $mandatory='Mandatory';
                   2378: 		if (&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval) eq 'N') {
                   2379: 		    $mandatory='Optional';
                   2380: 		}
1.200     albertel 2381: 		my $dim_info=
                   2382: 		    "\n<div class='LC_$dim_status LC_question_grade'>\n\t";
1.212     albertel 2383: 		my $ucquestion = 
                   2384: 		    my $question = 
                   2385: 		    ('sub' x $dimension{$dim}{'depth'}).'question';
                   2386: 		$ucquestion =~ s/^(.)/uc($1)/e;
1.194     albertel 2387: 		if ($dim_status eq 'pass') {
1.222     albertel 2388: 		    $dim_info.='<h3>'.$ucquestion.' : you passed this '.$mandatory.' '.$question.'</h3>';
1.194     albertel 2389: 		}
                   2390: 		if ($dim_status eq 'fail') {
1.222     albertel 2391: 		    $dim_info.='<h3>'.$ucquestion.' : you did not pass this '.$mandatory.' '.$question.'</h3>';
1.194     albertel 2392: 		}
1.197     albertel 2393: 		my %counts = &get_counts($dim,$instance,$parstack,
                   2394: 					 $safeeval);
                   2395: 
1.200     albertel 2396: 		$dim_info.="\n\t<p>"
1.197     albertel 2397: 		    .&question_status_message(\%counts,
                   2398: 					      $dimension{$dim}{'depth'})
1.200     albertel 2399: 		    ."</p>\n</div>\n";
1.194     albertel 2400: 		
                   2401: 		foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2402: 				@{$dimension{$dim}{'criterias'}}) {
                   2403: 		    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2404: 		    if ($type eq 'dimension') {
1.205     albertel 2405: 			if (defined($dimension{$id}{'result'})) {
                   2406: 			    $result.=$dimension{$id}{'result'};
                   2407: 			    next;
                   2408: 			} else {
                   2409: 			    $dim_info .=
                   2410: 				&nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2411: 					      [@_],{'set_dim_id' => $id});
                   2412: 			}
                   2413: 		    } else {
                   2414: 			my $criteria =
                   2415: 			    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2416: 					  [@_]);
                   2417: 			$dim_info .= &layout_web_Criteria($dim,$id,$criteria);
1.194     albertel 2418: 		    }
1.169     albertel 2419: 		}
1.202     albertel 2420: 		# puts the results at the end of the dimension
1.226     albertel 2421: 		if ($result =~m{<QuestionGradeInfo\s*/>}) {
                   2422: 		    $result=~s{<QuestionGradeInfo\s*/>}{$dim_info};
                   2423: 		} else {
                   2424: 		    $result .= $dim_info;
                   2425: 		}
1.202     albertel 2426: 		# puts the results at the beginning of the dimension
                   2427: 		# my $internal_location=&internal_location($dim);
                   2428: 		# $result=~s/\Q$internal_location\E/$dim_info/;
1.19      albertel 2429: 	    }
1.194     albertel 2430: 	}
1.206     albertel 2431: 	if ($result !~ /^\s*$/s) {
1.209     albertel 2432: 	    # FIXME? this maybe unneccssary in the future, (CSE101 BT
                   2433: 	    # from Fall 2006 geenrate a div that attempts to hide some
                   2434: 	    # of the output in an odd way, this is a workaround so
                   2435: 	    # those old ones will continue to work.  # It puts the
                   2436: 	    # LC_question div to come after any starting closie div
                   2437: 	    # that the dimension produces
1.211     albertel 2438: 	    if ($result =~ m{^\s*</div>}) {
                   2439: 		$result =~ s{^(\s*</div>)}
1.210     albertel 2440: 		            {$1\n<div id="$dim" class="LC_question">};
1.209     albertel 2441: 	    } else {
1.210     albertel 2442: 		$result = "\n".'<div id="'.$dim.'" class="LC_question">'.
1.209     albertel 2443: 		    "\n".$result;
                   2444: 	    }
                   2445: 	    $result .= "\n</div>\n";
1.206     albertel 2446: 	}
1.194     albertel 2447:     } elsif ($target eq 'webgrade') {
                   2448: 	# in case of any side effects that we need
                   2449: 	&nested_parse(\$dimension{$dim}{'intro'},[@_]);
                   2450: 	&nested_parse(\$dimension{$dim}{$instance.'.text'},[@_]);
                   2451: 	$result.=
                   2452: 	    &nested_parse(\$dimension{$dim}{'questiontext'},[@_],
                   2453: 			  {'set_dim_id'          => undef,
1.195     albertel 2454: 			   'delayed_dim_results' => 1});
1.194     albertel 2455: 	foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2456: 			@{$dimension{$dim}{'criterias'}} ) {
                   2457: 	    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2458: 	    if ($type eq 'dimension') {
                   2459: 		# dimensional 'criteria' don't get assigned grades
                   2460: 		$result.=
                   2461: 		    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2462: 				  [@_],{'set_dim_id' => $id});
                   2463: 		next;
                   2464: 	    } else {
                   2465: 		my $criteria =&nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2466: 					     [@_]);
                   2467: 		$criteria = &layout_webgrade_Criteria($dim,$id,$criteria);
                   2468: 		my $internal_location=&internal_location($id);
1.209     albertel 2469: 		if ($result =~ m/\Q$internal_location\E/) {
                   2470: 		    $result =~ s/\Q$internal_location\E/$criteria/;
                   2471: 		} else {
                   2472: 		    $result.=$criteria ;
                   2473: 		}
1.151     albertel 2474: 	    }
1.194     albertel 2475: 	}
                   2476: 	if (&nest()) {
                   2477: 	    &Apache::lonxml::debug(" for $dim stashing results into ".$dimension{$dim}{'nested'});
                   2478: 	    $dimension{$dimension{$dim}{'nested'}}{'result'}.=$result;
                   2479: 	    undef($result);
                   2480: 	}
                   2481:     } elsif ($target eq 'grade' && $env{'form.webgrade'}) {
                   2482: 	my $optional_passed=0;
                   2483: 	my $mandatory_failed=0;
                   2484: 	my $ungraded=0;
                   2485: 	my $review=0;
                   2486: 	
                   2487: 	$result .= &nested_parse(\$dimension{$dim}{'intro'},[@_]);
                   2488: 	$result .= &nested_parse(\$dimension{$dim}{$instance.'.text'},
                   2489: 				 [@_]);
                   2490: 	$result .= &nested_parse(\$dimension{$dim}{'questiontext'},
                   2491: 				 [@_],{'set_dim_id' => undef});
                   2492: 	
                   2493: 	foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2494: 			@{$dimension{$dim}{'criterias'}}) {
                   2495: 	    my $link=&link($id);
                   2496: 	    
                   2497: 	    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2498: 	    if ($type eq 'criteria') {
                   2499: 		# dimensional 'criteria' don't get assigned grades
                   2500: 		$Apache::lonhomework::results{"resource.$version.0.$dim.$id.status"}=$env{'form.HWVAL_'.$link};
                   2501: 		$Apache::lonhomework::results{"resource.$version.0.$dim.$id.comment"}=$env{'form.HWVAL_comment_'.$link};
                   2502: 	    } else {
                   2503: 		$result .=
                   2504: 		    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2505: 				  [@_],{'set_dim_id' => $id});
1.20      albertel 2506: 	    }
1.194     albertel 2507: 	    my $status= &get_criteria('status',$version,$dim,$id);
                   2508: 	    
                   2509: 	    my $mandatory=($dimension{$dim}{'criteria.'.$id.'.mandatory'} ne 'N');
                   2510: 	    if ($status eq 'pass') {
                   2511: 		if (!$mandatory) { $optional_passed++; }
                   2512: 	    } elsif ($status eq 'fail') {
                   2513: 		if ($mandatory) { $mandatory_failed++; }
                   2514: 	    } elsif ($status eq 'review') {
                   2515: 		$review++;
                   2516: 	    } elsif ($status eq 'ungraded') {
                   2517: 		$ungraded++;
1.20      albertel 2518: 	    } else {
1.194     albertel 2519: 		$ungraded++;
1.20      albertel 2520: 	    }
1.194     albertel 2521: 	}
                   2522: 
                   2523: 	my $opt_req=$dimension{$dim}{$instance.'.optionalrequired'};
                   2524: 	if ($opt_req !~ /\S/) {
                   2525: 	    $opt_req=
                   2526: 		&Apache::lonxml::get_param('OptionalRequired',
                   2527: 					   $parstack,$safeeval);
                   2528: 	    if ($opt_req !~ /\S/) { $opt_req = 0; }
                   2529: 	}
                   2530: 	if ($optional_passed < $opt_req) {
                   2531: 	    $mandatory_failed++;
                   2532: 	}
                   2533: 	&Apache::lonxml::debug("all instance ".join(':',@{$dimension{$dim}{$instance.'.criterias'}})." results -> m_f $mandatory_failed o_p $optional_passed u $ungraded r $review");
                   2534: 	if ($review) {
                   2535: 	    $Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
                   2536: 		'review';
                   2537: 	} elsif ($ungraded) {
                   2538: 	    $Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
                   2539: 		'ungraded';
                   2540: 	} elsif ($mandatory_failed) {
                   2541: 	    $Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
                   2542: 		'fail';
1.69      albertel 2543: 	} else {
1.194     albertel 2544: 	    $Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
                   2545: 		'pass';
1.13      albertel 2546: 	}
1.225     albertel 2547:     } elsif ($target eq 'edit') {
                   2548:     } elsif ($target eq 'modified') {
1.194     albertel 2549:     } else {
                   2550: 	# any other targets no output
                   2551: 	undef($result);
1.1       albertel 2552:     }
1.225     albertel 2553:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2554: 	&disable_dimension_parsing();
                   2555: 	pop(@Apache::bridgetask::dimension);
                   2556:     }
1.194     albertel 2557:     return $result;
                   2558: }
1.162     albertel 2559: 
1.198     albertel 2560: sub question_status_message {
1.197     albertel 2561:     my ($counts,$depth) = @_;
                   2562:     my %req  = ('man' => 'mandatory',
                   2563: 		'opt' => 'optional',);
                   2564:     my %type = ('cri' => 'criteria',
                   2565: 		'dim' => ('sub'x($depth+1)).'questions',);
                   2566:     my @sections;
                   2567:     foreach my $req ('man','opt') {
                   2568: 	foreach my $type ('cri','dim') {
                   2569: 	    if ($counts->{$req.'_'.$type}) {
                   2570: 		push(@sections,
1.213     albertel 2571: 		     $counts->{$req.'_'.$type.'_passed'}.' of the '.
1.197     albertel 2572: 		     $counts->{$req.'_'.$type}.' '.
                   2573: 		     $req{$req}.' '.$type{$type});
                   2574: 	    }
                   2575: 	}
                   2576:     }
                   2577: 
                   2578:     my $status = 'You passed ';
                   2579:     if (@sections == -1) {
                   2580:     } elsif (@sections == 1) {
                   2581: 	$status .= $sections[0];
                   2582:     } elsif (@sections == 2) {
                   2583: 	$status .= $sections[0].' and '.$sections[1];
                   2584:     } else {
                   2585: 	my $last = pop(@sections);
                   2586: 	$status .= join(', ',@sections).', and '.$last;
                   2587:     }
                   2588:     $status .= '.';
                   2589:     if ($counts->{'opt'}) {
                   2590: 	$status .= ' You were required to pass '.$counts->{'opt_req'}.
1.220     albertel 2591: 	    ' optional ';
1.219     albertel 2592: 	if ($counts->{'opt_dim'} + $counts->{'man_dim'} < 1) {
                   2593: 	    $status .=
1.220     albertel 2594: 		($counts->{'opt_req'} == 1?'criterion':'criteria');
1.219     albertel 2595: 	} else {
                   2596: 	    $status .=
1.220     albertel 2597: 		'component'.($counts->{'opt_req'} == 1?'':'s');
1.219     albertel 2598: 	}
                   2599: 	$status .= '.';
1.197     albertel 2600:     }
                   2601:     return $status;
                   2602: }
                   2603: 
                   2604: sub get_counts {
                   2605:     my ($dim,$instance,$parstack,$safeeval) = @_;
                   2606:     my %counts;
                   2607:     my @possible = ('man_cri','man_dim',
                   2608: 		    'opt_cri','opt_dim',
                   2609: 		    'man_cri_passed', 'man_dim_passed',
                   2610: 		    'opt_cri_passed', 'opt_dim_passed',
                   2611: 		    'man_passed',
                   2612: 		    'opt_passed',
                   2613: 		    'opt_req');
                   2614:     foreach my $which (@possible) { $counts{$which} = 0; }
                   2615: 
                   2616:     my $version = &get_version();
                   2617: 
                   2618:     foreach my $id ( @{$dimension{$dim}{$instance.'.criterias'}},
                   2619: 		     @{$dimension{$dim}{'criterias'}} ) {
                   2620: 	my $status = &get_criteria('status',$version,$dim,$id);
                   2621: 	my $which;
                   2622: 	if ($dimension{$dim}{'criteria.'.$id.'.mandatory'} 
                   2623: 	    eq 'N') {
                   2624: 	    $which = 'opt';
                   2625: 	} else {
                   2626: 	    $which = 'man';
                   2627: 	}
                   2628: 	$counts{$which}++;
                   2629: 	if ($status eq 'pass') { $counts{$which.'_passed'}++; }
                   2630: 	if ($dimension{$dim}{'criteria.'.$id.'.type'}
                   2631: 	    eq 'dimension') {
                   2632: 	    $which .= '_dim';
                   2633: 	} else {
                   2634: 	    $which .= '_cri';
                   2635: 	}
                   2636: 	$counts{$which}++;
                   2637: 	if ($status eq 'pass') { $counts{$which.'_passed'}++; }
                   2638: 
                   2639: 
                   2640:     }
                   2641:     if ($counts{'man_dim_passed'} eq $counts{'man_dim'}) {
                   2642: 	$counts{'man_dim_passed'}='all';
                   2643:     }
                   2644:     if ($counts{'man_cri_passed'} eq $counts{'man_cri'}) {
                   2645: 	$counts{'man_cri_passed'}='all';
                   2646:     }
                   2647:     
                   2648:     $counts{'opt_req'}=$dimension{$dim}{$instance.'.optionalrequired'};
                   2649:     if ($counts{'opt_req'} !~ /\S/) {
                   2650: 	$counts{'opt_req'}= &Apache::lonxml::get_param('OptionalRequired',
                   2651: 						       $parstack,$safeeval);
                   2652: 	if ($counts{'opt_req'} !~ /\S/) { $counts{'opt_req'} = 0; }
                   2653:     }
                   2654:     return %counts;
                   2655: }
                   2656: 
1.194     albertel 2657: sub end_Setup {
                   2658:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.225     albertel 2659:     my $result;
1.194     albertel 2660:     my $dim=&get_id($parstack,$safeeval);
                   2661:     my $instance=&get_instance($dim);
                   2662:     my $version=&get_version();
1.225     albertel 2663:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'grade') {
                   2664: 	$result=&Apache::lonxml::endredirection();
                   2665:     }
1.194     albertel 2666:     if ($target eq 'web') {
                   2667: 	@Apache::scripttag::parser_env = @_;
                   2668: 	$result.=&Apache::scripttag::xmlparse($dimension{$dim}{'intro'});
                   2669: 	my @instances = $instance;
                   2670: 	if (&Apache::response::showallfoils()) {
                   2671: 	    @instances = @{$dimension{$dim}{'instances'}};
                   2672: 	}
                   2673: 	foreach my $instance (@instances) {
1.162     albertel 2674: 	    @Apache::scripttag::parser_env = @_;
1.194     albertel 2675: 	    $result.=&Apache::scripttag::xmlparse($dimension{$dim}{$instance.'.text'});
1.162     albertel 2676: 	    @Apache::scripttag::parser_env = @_;
1.194     albertel 2677: 	    $result.=&Apache::scripttag::xmlparse($dimension{$dim}{'questiontext'});
1.162     albertel 2678: 	}
1.194     albertel 2679:     } elsif ($target eq 'webgrade' 
                   2680: 	     || $target eq 'grade' && $env{'form.webgrade'}) {
                   2681: 	# in case of any side effects that we need
                   2682: 	@Apache::scripttag::parser_env = @_;
                   2683: 	&Apache::scripttag::xmlparse($dimension{$dim}{'intro'});
                   2684: 	@Apache::scripttag::parser_env = @_;
                   2685: 	&Apache::scripttag::xmlparse($dimension{$dim}{$instance.'.text'});
                   2686: 	@Apache::scripttag::parser_env = @_;
                   2687: 	&Apache::scripttag::xmlparse($dimension{$dim}{'questiontext'});
                   2688:     } else {
                   2689: 	# any other targets no output
                   2690: 	undef($result);
1.162     albertel 2691:     }
1.194     albertel 2692:     pop(@Apache::bridgetask::dimension);
                   2693:     return $result;
1.1       albertel 2694: }
                   2695: 
1.113     albertel 2696: sub grading_history {
1.151     albertel 2697:     my ($version,$dim,$id) = @_;
1.113     albertel 2698:     if (!&Apache::lonnet::allowed('mgq',$env{'request.course.id'})) {
                   2699: 	return '';
                   2700:     }
                   2701:     my ($result,$grader);
1.194     albertel 2702:     my $scope="resource.$version.0.";
                   2703:     $scope .= ($dim ne $top) ? "$dim.$id"
                   2704: 	                     : "$id";
1.113     albertel 2705:     foreach my $t (1..$Apache::lonhomework::history{'version'}) {
                   2706: 	if (exists($Apache::lonhomework::history{$t.':resource.0.regrader'})) {
                   2707: 	    my ($gname,$gdom) = 
1.138     albertel 2708: 		split(':',$Apache::lonhomework::history{$t.':resource.0.regrader'});
1.113     albertel 2709: 	    my $fullname = &Apache::loncommon::plainname($gname,$gdom);
                   2710: 	    $grader = &Apache::loncommon::aboutmewrapper($fullname,
                   2711: 							 $gname,$gdom);
                   2712: 	}
                   2713: 	my $entry;
                   2714: 	if (exists($Apache::lonhomework::history{"$t:$scope.status"})) {
                   2715: 	    $entry.="<tt>".$Apache::lonhomework::history{"$t:$scope.status"}.'</tt>';
                   2716: 	}
                   2717: 	if (exists($Apache::lonhomework::history{"$t:$scope.comment"})) {
                   2718: 	    $entry.=' comment: "'.$Apache::lonhomework::history{"$t:$scope.comment"}.'"';
                   2719: 	}
                   2720: 	if ($entry) {
1.200     albertel 2721: 	    $result.= "\n\t\t<li>\n\t\t\t$grader :\n\t\t\t $entry \n\t\t</li>";
1.113     albertel 2722: 	}
                   2723:     }
                   2724:     if ($result) {
1.200     albertel 2725: 	return "\n\t".'<ul class="LC_GRADING_pastgrading">'.$result.
                   2726: 	    "\n\t".'</ul>'."\n";
1.113     albertel 2727:     }
                   2728:     return '';
                   2729: }
                   2730: 
1.1       albertel 2731: sub start_IntroParagraph {
1.87      albertel 2732:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel 2733:     my $result;
1.168     albertel 2734:     my $dim = &get_dim_id();
1.153     albertel 2735:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
1.151     albertel 2736: 	if ($tagstack->[-2] eq 'Dimension' || $tagstack->[-2] eq 'Question' ) {
1.169     albertel 2737: 	    $dimension{$dim}{'intro'}=
1.151     albertel 2738: 		&Apache::lonxml::get_all_text('/introparagraph',
                   2739: 					      $parser,$style);
                   2740:        	} elsif ($tagstack->[-2] eq 'Task' && $target eq 'webgrade') {
1.127     albertel 2741: 	    &Apache::lonxml::startredirection();
1.1       albertel 2742: 	}
1.47      albertel 2743: 	
1.225     albertel 2744:     } elsif ($target eq 'edit') {
                   2745: 	$result = &Apache::edit::tag_start($target,$token);
                   2746:     } elsif ($target eq 'modified') {
1.1       albertel 2747:     }
                   2748:     return $result;
                   2749: }
                   2750: 
                   2751: sub end_IntroParagraph {
1.127     albertel 2752:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.128     albertel 2753:     if ($tagstack->[-2] eq 'Task' && $target eq 'webgrade') {
1.127     albertel 2754: 	my $result = &Apache::lonxml::endredirection();
                   2755:     }
1.1       albertel 2756: }
                   2757: 
1.227     albertel 2758: sub insert_IntroParagraph {
                   2759:     return '
                   2760: <IntroParagraph>
                   2761:     <startouttext />
                   2762:     <endouttext />
                   2763: </IntroParagraph>';
                   2764: }
                   2765: 
1.1       albertel 2766: sub start_Instance {
                   2767:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.168     albertel 2768:     my $dim = &get_dim_id();
                   2769:     my $id  = &get_id($parstack,$safeeval);
1.169     albertel 2770:     push(@{$dimension{$dim}{'instances'}},$id);
1.168     albertel 2771:     push(@{$Apache::bridgetask::instance{$dim}},$id);
1.19      albertel 2772:     push(@Apache::bridgetask::instancelist,$id);
1.169     albertel 2773:     $dimension{$dim}{$id.'.optionalrequired'}=
1.19      albertel 2774: 	&Apache::lonxml::get_param('OptionalRequired',$parstack,$safeeval);
1.75      albertel 2775:     my $disabled = &Apache::lonxml::get_param('Disabled',$parstack,$safeeval);
                   2776:     if (lc($disabled) eq 'yes') {
1.169     albertel 2777: 	$dimension{$dim}{$id.'.disabled'}='1';
1.75      albertel 2778:     }
1.225     albertel 2779:     my $result;
                   2780:     if ($target eq 'edit') {
                   2781: 	$result = &Apache::edit::tag_start($target,$token);
                   2782: 	$result.=  
                   2783: 	    &Apache::edit::text_arg('Id:','id',$token,10).' '.
                   2784: 	    &Apache::edit::select_arg('Instance is Disabled:','Disabled',
                   2785: 				      [['no', 'No'],
                   2786: 				       ['yes','Yes'],],
                   2787: 				      $token)
                   2788: 	    .' <br /> '.
                   2789: 	    &Apache::edit::text_arg('Required number of passed optional elements to pass the Instance:',
                   2790: 				    'OptionalRequired',$token,4)
                   2791: 	    .&Apache::edit::end_row().
                   2792: 	    &Apache::edit::start_spanning_row();
                   2793:     } elsif ($target eq 'modified') {
                   2794: 	my $constructtag=
                   2795: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,
                   2796: 					'id','OptionalRequired','Disabled');
                   2797: 	if ($constructtag) {
                   2798: 	    $result = &Apache::edit::rebuild_tag($token);
                   2799: 	}
                   2800:     }
                   2801:     return $result;
1.1       albertel 2802: }
                   2803: 
                   2804: sub end_Instance {
1.225     albertel 2805:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   2806:     my $result;
                   2807:     if ($target eq 'edit') {
                   2808: 	$result = &Apache::edit::tag_end($target,$token);
                   2809:     }
                   2810:     return $result;
1.1       albertel 2811: }
                   2812: 
                   2813: sub start_InstanceText {
1.87      albertel 2814:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.225     albertel 2815:     my $result;
1.153     albertel 2816:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
1.225     albertel 2817: 	my $text=&Apache::lonxml::get_all_text('/instancetext',$parser,$style);
                   2818: 	my $dim = &get_dim_id();
                   2819: 	my $instance_id=$Apache::bridgetask::instance{$dim}[-1];
1.169     albertel 2820: 	$dimension{$dim}{$instance_id.'.text'}=$text;
1.225     albertel 2821:     } elsif ($target eq 'edit') {
                   2822: 	$result = &Apache::edit::tag_start($target,$token);
                   2823:     } elsif ($target eq 'modified') {
1.1       albertel 2824:     }
1.225     albertel 2825:     return $result;
1.1       albertel 2826: }
                   2827: 
                   2828: sub end_InstanceText {
                   2829:     return '';
                   2830: }
                   2831: 
1.227     albertel 2832: sub insert_InstanceText {
                   2833:     return '
                   2834: <InstanceText>
                   2835:     <startouttext />
                   2836:     <endouttext />
                   2837: </InstanceText>';
                   2838: }
                   2839: 
1.1       albertel 2840: sub start_Criteria {
1.87      albertel 2841:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.190     albertel 2842:     my $result = '';
1.21      albertel 2843:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'grade') {
1.225     albertel 2844: 	my $criteria=&Apache::lonxml::get_all_text('/criteria',$parser,$style);
1.168     albertel 2845: 	my $dim = &get_dim_id();
1.19      albertel 2846: 	my $id=&get_id($parstack,$safeeval);
1.194     albertel 2847: 	if ($target eq 'web' || $target eq 'webgrade') {
1.208     albertel 2848: 	    if ($target eq 'webgrade') {
1.195     albertel 2849: 		&Apache::lonxml::debug(" for $dim $id stashing results into $dim ");
                   2850: 		$dimension{$dim}{'result'} .= &internal_location($id);
                   2851: 	    } else {
                   2852: 		&Apache::lonxml::debug(" not stashing $dim $id");
1.206     albertel 2853: 		#$result .= &internal_location($id);
1.195     albertel 2854: 	    }
1.194     albertel 2855: 	}
1.169     albertel 2856: 	&Apache::lonxml::debug("Criteria $id with $dim");
1.151     albertel 2857: 	if (&Apache::londefdef::is_inside_of($tagstack,'Instance')) {
1.168     albertel 2858: 	    my $instance_id=$Apache::bridgetask::instance{$dim}[-1];
1.169     albertel 2859: 	    $dimension{$dim}{"criteria.$instance_id.$id"}=$criteria;
                   2860: 	    $dimension{$dim}{"criteria.$instance_id.$id.type"}='criteria';
                   2861: 	    $dimension{$dim}{"criteria.$instance_id.$id.mandatory"}=
1.151     albertel 2862: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
1.169     albertel 2863: 	    push(@{$dimension{$dim}{$instance_id.'.criterias'}},"$instance_id.$id");
1.151     albertel 2864: 	} else {
1.169     albertel 2865: 	    $dimension{$dim}{'criteria.'.$id}=$criteria;
                   2866: 	    $dimension{$dim}{'criteria.'.$id.'.type'}='criteria';
                   2867: 	    $dimension{$dim}{'criteria.'.$id.'.mandatory'}=
1.151     albertel 2868: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
1.169     albertel 2869: 	    push(@{$dimension{$dim}{'criterias'}},$id);
1.194     albertel 2870: 	}
1.225     albertel 2871:     } elsif ($target eq 'edit') {
                   2872: 	$result .=&Apache::edit::tag_start($target,$token);
                   2873: 	$result.=  
                   2874: 	    &Apache::edit::text_arg('Id:','id',$token,10).' '.
                   2875: 	    &Apache::edit::select_arg('Passing is Mandatory:','Mandatory',
1.233     albertel 2876: 				      [['Y', 'Yes'],
                   2877: 				       ['N','No'],],
1.225     albertel 2878: 				      $token)
                   2879: 	    .' <br /> '.&Apache::edit::end_row().
                   2880: 	    &Apache::edit::start_spanning_row();
                   2881:     } elsif ($target eq 'modified') {
                   2882: 	my $constructtag=
                   2883: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,
                   2884: 					'id','Mandatory');
                   2885: 	if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
1.194     albertel 2886:     }
                   2887:     return $result;
                   2888: }
                   2889: 
                   2890: sub layout_web_Criteria {
                   2891:     my ($dim,$id,$criteria) = @_;
1.190     albertel 2892: 
1.194     albertel 2893:     my $version = &get_version();
                   2894:     my $status= &get_criteria('status', $version,$dim,$id);
                   2895:     my $comment=&get_criteria('comment',$version,$dim,$id);
                   2896:     my $mandatory=($dimension{$dim}{'criteria.'.$id.'.mandatory'} ne 'N');
                   2897:     if ($mandatory) {
                   2898: 	$mandatory='Mandatory';
                   2899:     } else {
                   2900: 	$mandatory='Optional';
1.1       albertel 2901:     }
1.194     albertel 2902:     my $status_display=$status;
                   2903:     $status_display=~s/^([a-z])/uc($1)/e;
                   2904:     my $criteria_info.=
1.200     albertel 2905: 	'<div class="LC_'.$status.' LC_criteria">'."\n\t".'<h4>'
1.204     albertel 2906: 	.$mandatory.' Criteria</h4>'."\n\t".'<p class="LC_criteria_text">'
                   2907: 	."\n";
1.202     albertel 2908:     $criteria =~ s/^\s*//s;
                   2909:     $criteria =~ s/\s*$//s;
1.194     albertel 2910:     $criteria_info.= $criteria;
1.200     albertel 2911:     $criteria_info.="\n\t".'</p>'.
                   2912: 	"\n\t".'<p class="LC_grade">'.$status_display.'</p>';
1.194     albertel 2913:     if ($comment =~ /\w/) {
1.200     albertel 2914: 	$criteria_info.=
                   2915: 	    "\n\t".
                   2916: 	    '<p class="LC_comment">'.&mt('Comment: [_1]',$comment).'</p>';
1.194     albertel 2917:     }
1.200     albertel 2918:     $criteria_info.="\n".'</div>'."\n";
                   2919:     
1.194     albertel 2920:     return $criteria_info;
                   2921: }
                   2922: 
                   2923: sub layout_webgrade_Criteria {
                   2924:     my ($dim,$id,$criteria) = @_;
                   2925:     my $link=&link($id);
                   2926:     my $version = &get_version();
                   2927:     my $status  = &get_criteria('status',$version,$dim,$id);
1.200     albertel 2928:     my %lt = ( 'ungraded' => 'Ungraded',
                   2929: 	       'fail'     => 'Fail',
                   2930: 	       'pass'     => 'Pass',
                   2931: 	       'review'   => 'Review',
                   2932: 	       'comment'  => 'Additional Comment for Student',
                   2933: 	       );
                   2934:     %lt = &Apache::lonlocal::texthash(%lt);
                   2935:     my $comment = &get_criteria('comment',$version,$dim,$id);
                   2936:     $comment = &HTML::Entities::encode($comment,'<>"&');
                   2937:     my %checked;
                   2938:     foreach my $which ('ungraded','fail','pass','review') {
                   2939: 	if ($status eq $which) { $checked{$which} = 'checked="checked"'; }
                   2940:     }
                   2941:     if (!%checked) { $checked{'ungraded'} = 'checked="checked"'; }
1.201     albertel 2942:     my $buttons;
                   2943:     foreach my $which  ('ungraded','fail','pass','review') {
                   2944: 	$buttons .= <<END_BUTTON;
                   2945: 		<label class="LC_GRADING_$which">
                   2946: 			<input type="radio" name="HWVAL_$link" value="$which" $checked{$which} />
                   2947: 			$lt{$which}
                   2948: 		</label>
                   2949: END_BUTTON
                   2950:     }
1.202     albertel 2951:     $criteria =~ s/^\s*//s;
                   2952:     $criteria =~ s/\s*$//s;
1.200     albertel 2953:     my $result = <<END_CRITERIA;
1.201     albertel 2954: <div class="LC_GRADING_criteria">
                   2955: 	<div class="LC_GRADING_criteriatext">
                   2956: 		$criteria
                   2957: 	</div>
                   2958: 	<div class="LC_GRADING_grade">
                   2959: $buttons
                   2960: 	</div>
                   2961: 	<label class="LC_GRADING_comment">
                   2962: 		$lt{'comment'}
                   2963: 		<textarea class="LC_GRADING_comment_area" name="HWVAL_comment_$link">$comment</textarea>
                   2964: 	</label>
                   2965: </div>
1.200     albertel 2966: END_CRITERIA
                   2967:     $result .= &grading_history($version,$dim,$id);
1.190     albertel 2968:     return $result;
1.1       albertel 2969: }
                   2970: 
1.47      albertel 2971: sub end_Criteria {
1.225     albertel 2972:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   2973:     if ($target eq 'edit') {
                   2974:     } elsif ($target eq 'modified') {
                   2975:     }
                   2976: }
1.227     albertel 2977: sub insert_Criteria {
                   2978:     return '
                   2979: <Criteria>
                   2980:     <CriteriaText>
                   2981:         <startouttext />
                   2982:         <endouttext />
                   2983:     </CriteriaText>
                   2984: </Criteria>';
                   2985: }
1.225     albertel 2986: 
                   2987: sub start_CriteriaText {
                   2988:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   2989:     my $result;
                   2990:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2991: 	
                   2992:     } elsif ($target eq 'edit') {
                   2993: 	$result = &Apache::edit::tag_start($target,$token);
                   2994:     } elsif ($target eq 'modified') {
                   2995:     }
                   2996:     return $result;
                   2997: }
                   2998: 
                   2999: sub end_CriteriaText {
                   3000:     return '';
1.47      albertel 3001: }
                   3002: 
1.227     albertel 3003: sub insert_CriteriaText {
                   3004:     return '
                   3005: <CriteriaText>
                   3006:     <startouttext />
                   3007:     <endouttext />
                   3008: </CriteriaText>';
                   3009: }
                   3010: 
1.186     albertel 3011: sub start_GraderNote {
                   3012:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.225     albertel 3013:     my $result;
1.186     albertel 3014:     if ($target eq 'webgrade') {
1.225     albertel 3015: 	$result = '<div class="LC_GRADING_gradernote"><b>'.
1.187     albertel 3016: 	    &mt('Note to graders:').'</b>';
1.225     albertel 3017:     } elsif ($target eq 'edit') {
                   3018: 	$result = &Apache::edit::tag_start($target,$token);
                   3019:     } elsif ($target eq 'modified') {
                   3020:     } elsif ($target eq 'web' || $target eq 'grade') {
                   3021: 	my $note=&Apache::lonxml::get_all_text('/gradernote',$parser,$style); 
1.186     albertel 3022:     }
1.225     albertel 3023:     return $result;
1.186     albertel 3024: }
                   3025: 
                   3026: sub end_GraderNote {
                   3027:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   3028: 
                   3029:     if ($target eq 'webgrade') {
                   3030: 	return '</div>';
                   3031:     }
                   3032:     return;
                   3033: }
                   3034: 
1.227     albertel 3035: sub insert_GraderNote {
                   3036:     return '
                   3037: <GraderNote>
                   3038:     <startouttext />
                   3039:     <endouttext />
                   3040: </GraderNote>';
                   3041: }
1.186     albertel 3042: 
                   3043: 
1.4       albertel 3044: sub proctor_validation_screen {
                   3045:     my ($slot) = @_;
1.185     albertel 3046:     my (undef,undef,$domain,$user) = &Apache::lonnet::whichuser();
1.5       albertel 3047:     my $url=&Apache::lonnet::studentphoto($domain,$user,'jpg');
1.230     albertel 3048:     if ($url ne '/adm/lonKaputt/lonlogo_broken.gif') {
                   3049: 	$url = "<tr><td colspan=\"2\"><img src=\"$url\" /></td></tr>";
                   3050:     } else {
                   3051: 	undef($url);
                   3052:     }
                   3053: 
1.44      albertel 3054:     my $name=&Apache::loncommon::plainname($user,$domain);
                   3055:     
1.4       albertel 3056:     my $msg;
1.11      albertel 3057:     if ($env{'form.proctorpassword'}) {
1.230     albertel 3058: 	$msg.='<p><span class="LC_warning">'
                   3059: 	    .&mt("Failed to authenticate the proctor.")
                   3060: 	    .'</span></p>';
1.4       albertel 3061:     }
1.230     albertel 3062: 
                   3063:     my $valid;
                   3064:     my @possible_proctors=split(",",$slot->{'proctor'});
                   3065:     foreach my $proctor (@possible_proctors) {
                   3066: 	if ($proctor =~ /$LONCAPA::username_re:$LONCAPA::domain_re/) {
                   3067: 	    $valid = 1;
                   3068: 	    last;
                   3069: 	}
                   3070:     }
                   3071:     if (!$valid) {
                   3072: 	$msg.='<p><span class="LC_error">'
                   3073: 	    .&mt("No valid poctors are defined.")
                   3074: 	    .'</span></p>';
                   3075:     }
                   3076:     
1.47      albertel 3077:     if (!$env{'form.proctordomain'}) { $env{'form.proctordomain'}=$domain; }
1.229     albertel 3078:     my $uri = &Apache::lonenc::check_encrypt($env{'request.uri'});
                   3079:     $uri = &HTML::Entities::encode($uri,'<>&"');
1.4       albertel 3080:     my $result= (<<ENDCHECKOUT);
                   3081: <h2>Proctor Validation</h2>
                   3082:     <p>Your room's proctor needs to validate your access to this resource.</p>
                   3083:     $msg
1.229     albertel 3084: <form name="checkout" method="post" action="$uri">
1.4       albertel 3085: <input type="hidden" name="validate" value="yes" />
                   3086: <input type="hidden" name="submitted" value="yes" />
                   3087: <table>
1.44      albertel 3088:   <tr><td>Proctor's Username:</td><td><input type="string" name="proctorname" value="$env{'form.proctorname'}" /></td></tr>
1.4       albertel 3089:   <tr><td>Password:</td><td><input type="password" name="proctorpassword" value="" /></td></tr>
1.46      albertel 3090:   <tr><td>Proctor's Domain:</td><td><input type="string" name="proctordomain" value="$env{'form.proctordomain'}" /></td></tr>
1.4       albertel 3091: </table>
                   3092: <input type="submit" name="checkoutbutton" value="Validate"  /><br />
1.44      albertel 3093: <table border="1">
                   3094:   <tr><td>
                   3095:     <table>
                   3096:       <tr><td colspan="2">Student who should be logged in is:</td></tr>
                   3097:       <tr><td>Name:</td><td>$name</td></tr>
1.45      albertel 3098:       <tr><td>Student ID:</td><td>$env{'environment.id'}</td></tr>
1.138     albertel 3099:       <tr><td>Usename</td><td>$user:$domain</td></tr>
1.230     albertel 3100:       $url
1.44      albertel 3101:     </table>
                   3102:   </tr></td>
                   3103: </table>
1.4       albertel 3104: </form>
                   3105: ENDCHECKOUT
                   3106:     return $result;
                   3107: }
                   3108: 
1.1       albertel 3109: 1;
                   3110: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>