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

1.1       albertel    1: # The LearningOnline Network with CAPA 
                      2: # definition of tags that give a structure to a document
                      3: #
1.232   ! albertel    4: # $Id: bridgetask.pm,v 1.231 2007/04/07 00:12:43 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.16      albertel 1562:     my $regexp="^$symb\0";
1.30      albertel 1563:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.31      albertel 1564:     my ($tmp)=%queue;
                   1565:     if ($tmp=~/^error: 2 /) {
1.159     albertel 1566: 	return "\n<h3>Current Queue - $queue</h3>".
                   1567: 	    &Apache::loncommon::start_data_table().
                   1568: 	    &Apache::loncommon::start_data_table_row().
                   1569: 	    '<td>'.&mt('Empty').'</td>'.
                   1570: 	    &Apache::loncommon::end_data_table_row().
                   1571: 	    &Apache::loncommon::end_data_table();
1.31      albertel 1572:     }
1.103     albertel 1573:     my $title=&Apache::lonnet::gettitle($symb);
1.159     albertel 1574:     $result.="\n<h3>Current Queue - $title $queue </h3>".
                   1575: 	&Apache::loncommon::start_data_table().
                   1576: 	&Apache::loncommon::start_data_table_header_row();
1.103     albertel 1577:     if ($with_selects) { $result.="<th>Status</th><th></th>"; }
1.159     albertel 1578:     $result.="<th>user</th><th>data</th>".
                   1579: 	&Apache::loncommon::end_data_table_header_row();
1.14      albertel 1580:     foreach my $key (sort(keys(%queue))) {
1.59      albertel 1581: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
                   1582: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
1.156     albertel 1583: 	
                   1584: 	my $section = $classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_SECTION()];
                   1585: 
                   1586: 	my $can_view=1;
                   1587: 	if (!$view
                   1588: 	    || ($view_section && !$section)
                   1589: 	    || ($view_section && $section && ($view_section ne $section))) {
                   1590: 	    $can_view=0;
                   1591: 	}
                   1592: 
1.32      albertel 1593: 	if ($key=~/locked$/ && !$with_selects) {
1.159     albertel 1594: 	    $result.= &Apache::loncommon::start_data_table_row().
                   1595: 		"<td>$uname</td>";
1.103     albertel 1596: 	    $result.='<td>'.$queue{$key}.'</td></tr>';
1.32      albertel 1597: 	} elsif ($key=~/timestamp$/ && !$with_selects) {
1.159     albertel 1598: 	    $result.=&Apache::loncommon::start_data_table_row()."<td></td>";
1.103     albertel 1599: 	    $result.='<td>'.
1.16      albertel 1600: 		&Apache::lonlocal::locallocaltime($queue{$key})."</td></tr>";
1.32      albertel 1601: 	} elsif ($key!~/(timestamp|locked)$/) {
1.159     albertel 1602: 	    $result.= &Apache::loncommon::start_data_table_row();
1.148     albertel 1603: 	    my ($end_time,$slot_text);
                   1604: 	    if (my $slot=&slotted_access($queue{$key})) {
                   1605: 		my %slot_data=&Apache::lonnet::get_slot($slot);
                   1606: 		$end_time = $slot_data{'endtime'};
                   1607: 		$slot_text = &mt('Slot: [_1]',$slot);
                   1608: 	    } else {
                   1609: 		$end_time = &Apache::lonhomework::due_date('0',$symb);
                   1610: 		$slot_text = '';
                   1611: 	    }
1.32      albertel 1612: 	    if ($with_selects) {
1.158     www      1613: 		my $ekey=&escape($key);
1.103     albertel 1614: 		my ($action,$description,$status)=('select',&mt('Select'));
1.32      albertel 1615: 		if (exists($queue{"$key\0locked"})) {
1.217     albertel 1616: 		    my ($locker,$time) = 
                   1617: 			&get_lock_info($queue{"$key\0locked"});
                   1618: 		    if ($time) {
1.214     albertel 1619: 			$time = 
                   1620: 			    &Apache::lonnavmaps::timeToHumanString($time,
                   1621: 								   'start');
                   1622: 		    }
1.138     albertel 1623: 		    my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.214     albertel 1624: 		    $status=&mt('Locked by <tt>[_1]</tt> [_2]',$locker,$time);
1.217     albertel 1625: 		    if ($me eq $locker) {
1.32      albertel 1626: 			($action,$description)=('resume',&mt('Resume'));
                   1627: 		    } else {
                   1628: 			($action,$description)=('unlock',&mt('Unlock'));
                   1629: 		    }
                   1630: 		}
1.62      albertel 1631: 		my $seclist;
                   1632: 		foreach my $sec (@chosen_sections) {
                   1633: 		    $seclist.='<input type="hidden" name="chosensections" 
                   1634:                                value="'.$sec.'" />';
                   1635: 		}
1.156     albertel 1636: 		if ($can_view && ($end_time ne '' && time > $end_time)) {
1.35      albertel 1637: 		    $result.=(<<FORM);
1.103     albertel 1638: <td>$status</td>
1.32      albertel 1639: <td>
1.115     albertel 1640: <form style="display: inline" method="post">
1.32      albertel 1641:  <input type="hidden" name="gradingkey" value="$ekey" />
                   1642:  <input type="hidden" name="queue" value="$queue" />
                   1643:  <input type="hidden" name="gradingaction" value="$action" />
                   1644:  <input type="hidden" name="webgrade" value="no" />
1.33      albertel 1645:  <input type="hidden" name="queuemode" value="selected" />
1.32      albertel 1646:  <input type="submit" name="submit" value="$description" />
1.62      albertel 1647:  $seclist
1.32      albertel 1648: </form>
                   1649: </td>
                   1650: FORM
1.156     albertel 1651:                 } elsif (!$can_view && ($end_time ne '' && time > $end_time)) {
                   1652: 		    $result.='<td>'.&mt("Not gradable").'</td><td>&nbsp;</td>'
1.35      albertel 1653:                 } else {
1.148     albertel 1654: 		    $result.='<td>'.&mt("In Progress").'</td><td>&nbsp;</td>'
1.35      albertel 1655: 		}
1.32      albertel 1656: 	    }
1.156     albertel 1657: 	    $result.= "<td>".$classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_FULLNAME()].
1.138     albertel 1658: 		" <tt>($uname:$udom)</tt> </td>";
1.148     albertel 1659: 	    $result.='<td>'.$slot_text.' End time: '.
                   1660: 		&Apache::lonlocal::locallocaltime($end_time).
1.159     albertel 1661: 		"</td>".&Apache::loncommon::end_data_table_row();
1.16      albertel 1662: 	}
1.14      albertel 1663:     }
1.159     albertel 1664:     $result.= &Apache::loncommon::end_data_table()."<hr />\n";
1.14      albertel 1665:     return $result;
                   1666: }
                   1667: 
1.34      albertel 1668: sub get_queue_counts {
                   1669:     my ($queue)=@_;
                   1670:     my $result;
1.185     albertel 1671:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.34      albertel 1672:     my $cnum=$env{'course.'.$cid.'.num'};
                   1673:     my $cdom=$env{'course.'.$cid.'.domain'};
1.156     albertel 1674: 
1.157     albertel 1675:     my $classlist=&get_limited_classlist();
1.156     albertel 1676: 
1.34      albertel 1677:     my $regexp="^$symb\0";
                   1678:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
                   1679:     my ($tmp)=%queue;
                   1680:     if ($tmp=~/^error: 2 /) {
                   1681: 	return (0,0,0);
                   1682:     }
                   1683:     my ($entries,$ready_to_grade,$locks)=(0,0,0);
1.96      albertel 1684:     my %slot_cache;
1.34      albertel 1685:     foreach my $key (sort(keys(%queue))) {
1.156     albertel 1686: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
                   1687: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
1.34      albertel 1688: 	if ($key=~/locked$/) {
                   1689: 	    $locks++;
                   1690: 	} elsif ($key=~/timestamp$/) {
                   1691: 	    #ignore
                   1692: 	} elsif ($key!~/(timestamp|locked)$/) {
                   1693: 	    $entries++;
1.148     albertel 1694: 	    if (my $slot=&slotted_access($queue{$key})) {
                   1695: 		if (!exists($slot_cache{$slot})) {
                   1696: 		    my %slot_data=&Apache::lonnet::get_slot($slot);
                   1697: 		    $slot_cache{$slot} = \%slot_data;
                   1698: 		}
                   1699: 		if (time > $slot_cache{$slot}{'endtime'}) {
                   1700: 		    $ready_to_grade++;
                   1701: 		}
                   1702: 	    } else {
                   1703: 		my $due_date = &Apache::lonhomework::due_date('0',$symb);
                   1704: 		if ($due_date ne '' && time > $due_date) {
                   1705: 		    $ready_to_grade++;
                   1706: 		}
1.34      albertel 1707: 	    }
                   1708: 	}
                   1709:     }
                   1710:     return ($entries,$ready_to_grade,$locks);
                   1711: }
                   1712: 
1.49      albertel 1713: sub encode_queue_key {
                   1714:     my ($symb,$udom,$uname)=@_;
1.138     albertel 1715:     return "$symb\0queue\0$uname:$udom";
1.49      albertel 1716: }
                   1717: 
1.14      albertel 1718: sub decode_queue_key {
                   1719:     my ($key)=@_;
                   1720:     my ($symb,undef,$user) = split("\0",$key);
1.138     albertel 1721:     my ($uname,$udom) = split(':',$user);
1.14      albertel 1722:     return ($symb,$uname,$udom);
                   1723: }
                   1724: 
                   1725: sub queue_key_locked {
1.30      albertel 1726:     my ($queue,$key,$cdom,$cnum)=@_;
1.33      albertel 1727:     if (!defined($cdom) || !defined($cnum)) {
1.185     albertel 1728: 	my (undef,$cid)=&Apache::lonnet::whichuser();
1.33      albertel 1729: 	$cnum=$env{'course.'.$cid.'.num'};
                   1730: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1731:     }
1.14      albertel 1732:     my ($key_locked,$value)=
1.30      albertel 1733: 	&Apache::lonnet::get($queue,["$key\0locked"],$cdom,$cnum);
1.14      albertel 1734:     if ($key_locked eq "$key\0locked") {
1.217     albertel 1735: 	return &get_lock_info($value);
1.14      albertel 1736:     }
                   1737:     return undef;
                   1738: }
                   1739: 
1.148     albertel 1740: sub slotted_access {
                   1741:     my ($queue_entry) = @_;
                   1742:     if (ref($queue_entry) eq 'ARRAY') {
                   1743: 	if (defined($queue_entry->[0])) {
                   1744: 	    return $queue_entry->[0];
                   1745: 	}
                   1746: 	return undef;
                   1747:     } elsif (ref($queue_entry) eq 'HASH') {
                   1748: 	if (defined($queue_entry->{'slot'})) {
                   1749: 	    return $queue_entry->{'slot'};
                   1750: 	}
                   1751: 	return undef;
                   1752:     }
                   1753:     return undef;
                   1754: }
                   1755: 
1.14      albertel 1756: sub pick_from_queue_data {
1.156     albertel 1757:     my ($queue,$check_section,$queuedata,$cdom,$cnum,$classlist)=@_;
1.98      albertel 1758:     my @possible; # will hold queue entries that are valid to be selected
1.30      albertel 1759:     foreach my $key (keys(%$queuedata)) {
1.68      albertel 1760: 	if ($key =~ /\0locked$/) { next; }
                   1761: 	if ($key =~ /\0timestamp$/) { next; }
1.156     albertel 1762: 
1.14      albertel 1763: 	my ($symb,$uname,$udom)=&decode_queue_key($key);
1.156     albertel 1764: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
                   1765: 
1.14      albertel 1766: 	if ($check_section) {
1.156     albertel 1767: 	    my $section =
                   1768: 		$classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_SECTION()];
1.17      albertel 1769: 	    if ($section eq $check_section) {
1.33      albertel 1770: 		&Apache::lonxml::debug("my sec");
1.15      albertel 1771: 		next;
                   1772: 	    }
1.14      albertel 1773: 	}
1.148     albertel 1774: 	my $end_time;
                   1775: 	if (my $slot=&slotted_access($queuedata->{$key})) {
1.154     albertel 1776: 	    &Apache::lonxml::debug("looking at slot $slot");
1.148     albertel 1777: 	    my %slot_data=&Apache::lonnet::get_slot($slot);
                   1778: 	    if ($slot_data{'endtime'} < time) { 
                   1779: 		$end_time = $slot_data{'endtime'};
1.154     albertel 1780: 	    } else {
                   1781: 		&Apache::lonxml::debug("not time ".$slot_data{'endtime'});
                   1782: 		next;
1.148     albertel 1783: 	    }
                   1784: 	} else {
                   1785: 	    my $due_date = &Apache::lonhomework::due_date('0',$symb);
1.154     albertel 1786: 	    if ($due_date < time) {
1.148     albertel 1787: 		$end_time = $due_date;
1.154     albertel 1788: 	    } else {
                   1789: 		&Apache::lonxml::debug("not time $due_date");
                   1790: 		next;
1.148     albertel 1791: 	    }
                   1792: 	}
                   1793: 	
1.98      albertel 1794: 	if (exists($queuedata->{"$key\0locked"})) {
1.33      albertel 1795: 	    &Apache::lonxml::debug("someone already has um.");
1.15      albertel 1796: 	    next;
                   1797: 	}
1.148     albertel 1798: 	push(@possible,[$key,$end_time]);
1.98      albertel 1799:     }
                   1800:     if (@possible) {
                   1801:         # sort entries in order by slot end time
                   1802: 	@possible = sort { $a->[1] <=> $b->[1] } @possible;
1.137     albertel 1803: 	# pick one of the entries in the top 10% in small queues and one
                   1804: 	# of the first ten entries in large queues
1.139     albertel 1805: 	#my $ten_percent = int($#possible * 0.1);
                   1806: 	#if ($ten_percent < 1 ) { $ten_percent = 1;  }
                   1807: 	#if ($ten_percent > 10) { $ten_percent = 10; }
                   1808: 	#my $max=($#possible < $ten_percent) ? $#possible : $ten_percent;
1.137     albertel 1809: 	
1.139     albertel 1810: 	#return $possible[int(rand($max))][0];
                   1811: 	return $possible[0][0];
1.14      albertel 1812:     }
                   1813:     return undef;
                   1814: }
                   1815: 
1.217     albertel 1816: sub get_lock_info {
                   1817:     my ($lock_info) = @_;
                   1818:     if (wantarray) {
                   1819: 	if (ref($lock_info) eq 'ARRAY') {
                   1820: 	    return @{$lock_info};
                   1821: 	} else {
                   1822: 	    return ($lock_info);
                   1823: 	}
                   1824:     } else {
                   1825: 	if (ref($lock_info) eq 'ARRAY') {
                   1826: 	    return $lock_info->[0];
                   1827: 	} else {
                   1828: 	    return $lock_info;
                   1829: 	}
                   1830:     }
                   1831:     return;
                   1832: }
                   1833: 
1.15      albertel 1834: sub find_mid_grade {
1.30      albertel 1835:     my ($queue,$symb,$cdom,$cnum)=@_;
1.158     www      1836:     my $todo=&unescape($env{'form.gradingkey'});
1.138     albertel 1837:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.15      albertel 1838:     if ($todo) {
1.30      albertel 1839: 	my $who=&queue_key_locked($queue,$todo,$cdom,$cnum);
1.15      albertel 1840: 	if ($who eq $me) { return $todo; }
                   1841:     }
                   1842:     my $regexp="^$symb\0.*\0locked\$";
1.30      albertel 1843:     my %locks=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.15      albertel 1844:     foreach my $key (keys(%locks)) {
1.217     albertel 1845: 	my $who= &get_lock_info($locks{$key});
1.15      albertel 1846: 	if ($who eq $me) {
                   1847: 	    $todo=$key;
                   1848: 	    $todo=~s/\0locked$//;
                   1849: 	    return $todo;
                   1850: 	}
                   1851:     }
                   1852:     return undef;
                   1853: }
                   1854: 
1.32      albertel 1855: sub lock_key {
                   1856:     my ($queue,$todo)=@_;
1.138     albertel 1857:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.185     albertel 1858:     my (undef,$cid)=&Apache::lonnet::whichuser();
1.32      albertel 1859:     my $cnum=$env{'course.'.$cid.'.num'};
                   1860:     my $cdom=$env{'course.'.$cid.'.domain'};
1.214     albertel 1861:     my $success=&Apache::lonnet::newput($queue,{"$todo\0locked"=> [$me,time]},
1.32      albertel 1862: 					$cdom,$cnum);
1.33      albertel 1863:     &Apache::lonxml::debug("success $success $todo");
1.32      albertel 1864:     if ($success eq 'ok') {
                   1865: 	return 1;
                   1866:     }
                   1867:     return 0;
                   1868: }
                   1869: 
1.86      albertel 1870: sub get_queue_symb_status {
1.85      albertel 1871:     my ($queue,$symb,$cdom,$cnum) = @_;
                   1872:     if (!defined($cdom) || !defined($cnum)) {
1.185     albertel 1873: 	my (undef,$cid)=&Apache::lonnet::whichuser();
1.85      albertel 1874: 	$cnum=$env{'course.'.$cid.'.num'};
                   1875: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1876:     }
1.157     albertel 1877:     my $classlist=&get_limited_classlist();
1.156     albertel 1878: 
1.85      albertel 1879:     my $regexp="^$symb\0";
                   1880:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
                   1881:     my ($tmp)=%queue;
                   1882:     if ($tmp=~/^error: 2 /) { return; }
                   1883:     my @users;
                   1884:     foreach my $key (sort(keys(%queue))) {
                   1885: 	next if ($key=~/locked$/);
                   1886: 	next if ($key=~/timestamp$/);
                   1887: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
1.156     albertel 1888: 	next if (!defined($classlist->{$uname.':'.$udom}));
1.85      albertel 1889: 	push(@users,"$uname:$udom");
                   1890:     }
                   1891:     return @users;
                   1892: }
                   1893: 
1.14      albertel 1894: sub get_from_queue {
1.30      albertel 1895:     my ($queue)=@_;
1.14      albertel 1896:     my $result;
1.185     albertel 1897:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.14      albertel 1898:     my $cnum=$env{'course.'.$cid.'.num'};
                   1899:     my $cdom=$env{'course.'.$cid.'.domain'};
1.32      albertel 1900:     my $todo=&find_mid_grade($queue,$symb,$cdom,$cnum);
1.33      albertel 1901:     &Apache::lonxml::debug("found ".join(':',&decode_queue_key($todo)));
1.16      albertel 1902:     if ($todo) { return $todo; }
1.95      albertel 1903:     my $attempts=0;
1.156     albertel 1904: 
1.157     albertel 1905:     my $classlist=&get_limited_classlist();
1.156     albertel 1906: 
1.14      albertel 1907:     while (1) {
1.95      albertel 1908: 	if ($attempts > 2) {
                   1909: 	    # tried twice to get a queue entry, giving up
                   1910: 	    return (undef,'unable');
                   1911: 	}
1.14      albertel 1912: 	my $starttime=time;
1.83      albertel 1913: 	&Apache::lonnet::cput($queue,{"$symb\0timestamp"=>$starttime},
                   1914: 			      $cdom,$cnum);
1.33      albertel 1915: 	&Apache::lonxml::debug("$starttime");
1.14      albertel 1916: 	my $regexp="^$symb\0queue\0";
1.156     albertel 1917: 	#my $range= ($attempts < 1 ) ? '0-100' : '0-400';
1.97      albertel 1918: 
1.98      albertel 1919: 	my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.33      albertel 1920: 	#make a pass looking for a user _not_ in my section
1.14      albertel 1921: 	if ($env{'request.course.sec'}) {
1.33      albertel 1922: 	    &Apache::lonxml::debug("sce");
1.30      albertel 1923: 	    $todo=&pick_from_queue_data($queue,$env{'request.course.sec'},
1.156     albertel 1924: 					\%queue,$cdom,$cnum,$classlist);
1.33      albertel 1925: 	    &Apache::lonxml::debug("sce $todo");
1.14      albertel 1926: 	}
1.33      albertel 1927: 	# no one _not_ in our section so look for any user that is
                   1928: 	# ready for grading
1.14      albertel 1929: 	if (!$todo) {
1.33      albertel 1930: 	    &Apache::lonxml::debug("no sce");
1.156     albertel 1931: 	    $todo=&pick_from_queue_data($queue,undef,\%queue,$cdom,$cnum,
                   1932: 					$classlist);
1.33      albertel 1933: 	    &Apache::lonxml::debug("no sce $todo");
1.14      albertel 1934: 	}
                   1935: 	# no user to grade 
                   1936: 	if (!$todo) { last; }
1.33      albertel 1937: 	&Apache::lonxml::debug("got $todo");
1.14      albertel 1938: 	# otherwise found someone so lets try to lock them
1.32      albertel 1939: 	# unless someone else already picked them
1.95      albertel 1940: 	if (!&lock_key($queue,$todo)) {
                   1941: 	    $attempts++;
                   1942: 	    next;
                   1943: 	}
1.14      albertel 1944: 	my (undef,$endtime)=
1.30      albertel 1945: 	    &Apache::lonnet::get($queue,["$symb\0timestamp"],
1.14      albertel 1946: 				 $cdom,$cnum);
1.33      albertel 1947: 	&Apache::lonxml::debug("emd  $endtime");
1.14      albertel 1948: 	# someone else already modified the queue, 
                   1949: 	# perhaps our picked user wass already fully graded between
                   1950: 	# when we picked him and when we locked his record? so lets
                   1951: 	# double check.
                   1952: 	if ($endtime != $starttime) {
                   1953: 	    my ($key,$value)=
1.30      albertel 1954: 		&Apache::lonnet::get($queue,["$todo"],
1.14      albertel 1955: 				     $cdom,$cnum);
1.33      albertel 1956: 	    &Apache::lonxml::debug("check  $key .. $value");
1.14      albertel 1957: 	    if ($key eq $todo && ref($value)) {
                   1958: 	    } else {
1.30      albertel 1959: 		&Apache::lonnet::del($queue,["$todo\0locked"],
1.14      albertel 1960: 				     $cdom,$cnum);
1.33      albertel 1961: 		&Apache::lonxml::debug("del");
1.95      albertel 1962: 		$attempts++;
1.14      albertel 1963: 		next;
                   1964: 	    }
                   1965: 	}
1.33      albertel 1966: 	&Apache::lonxml::debug("last $todo");
1.14      albertel 1967: 	last;
                   1968:     }
                   1969:     return $todo;
                   1970: }
                   1971: 
1.49      albertel 1972: sub select_user {
1.185     albertel 1973:     my ($symb,$cid)=&Apache::lonnet::whichuser();
1.49      albertel 1974: 
1.59      albertel 1975:     my @chosen_sections=
                   1976: 	&Apache::loncommon::get_env_multiple('form.chosensections');
1.156     albertel 1977: 
                   1978:     my $classlist = &get_limited_classlist(\@chosen_sections);
1.63      albertel 1979:     
                   1980:     my $result;
                   1981:     if (!(grep(/^all$/,@chosen_sections))) {
                   1982: 	$result.='<p> Showing only sections <tt>'.join(', ',@chosen_sections).
                   1983: 	    '</tt>.</p> '."\n";
                   1984:     }
1.159     albertel 1985:     $result.=&Apache::loncommon::start_data_table();
1.49      albertel 1986: 
1.156     albertel 1987:     foreach my $student (sort {lc($classlist->{$a}[&Apache::loncoursedata::CL_FULLNAME()]) cmp lc($classlist->{$b}[&Apache::loncoursedata::CL_FULLNAME()]) } (keys(%$classlist))) {
1.49      albertel 1988: 	my ($uname,$udom) = split(/:/,$student);
1.59      albertel 1989: 	
1.84      albertel 1990: 	my $cnum=$env{'course.'.$cid.'.num'};
                   1991: 	my $cdom=$env{'course.'.$cid.'.domain'};
1.88      albertel 1992: 	my %status = &get_student_status($symb,$cdom,$cnum,$udom,$uname,
                   1993: 					 'Task');
1.49      albertel 1994: 	my $queue = 'none';
1.58      albertel 1995: 	my $cannot_grade;
                   1996: 	if ($status{'reviewqueue'} =~ /^(in_progress|enqueue)$/) {
1.49      albertel 1997: 	    $queue = 'reviewqueue';
1.58      albertel 1998: 	    if ($status{'reviewqueue'} eq 'in_progress') {
                   1999: 		$cannot_grade=1;
                   2000: 	    }
                   2001: 	} elsif ($status{'gradingqueue'} =~ /^(in_progress|enqueue)$/) {
1.49      albertel 2002: 	    $queue = 'gradingqueue';
1.58      albertel 2003: 	    if ($status{'gradingqueue'} eq 'in_progress') {
                   2004: 		$cannot_grade=1;
                   2005: 	    }
1.49      albertel 2006: 	}
                   2007: 	my $todo = 
1.158     www      2008: 	    &escape(&encode_queue_key($symb,$udom,$uname));
1.58      albertel 2009: 	if ($cannot_grade) {
1.159     albertel 2010: 	    $result.=&Apache::loncommon::start_data_table_row().
                   2011: 		'<td>&nbsp;</td><td>'.$classlist->{$student}[&Apache::loncoursedata::CL_FULLNAME()].
1.58      albertel 2012: 		'</td><td>';
                   2013: 	} else {
1.62      albertel 2014: 	    my $seclist;
                   2015: 	    foreach my $sec (@chosen_sections) {
                   2016: 		$seclist.='<input type="hidden" name="chosensections" 
                   2017:                                value="'.$sec.'" />';
                   2018: 	    }
1.159     albertel 2019: 	    $result.=&Apache::loncommon::start_data_table_row();
1.58      albertel 2020: 	    $result.=<<RESULT;
1.49      albertel 2021:   <td>
1.115     albertel 2022:     <form style="display: inline" method="post">
1.49      albertel 2023:       <input type="hidden" name="gradingkey" value="$todo" />
                   2024:       <input type="hidden" name="queue" value="$queue" />
                   2025:       <input type="hidden" name="webgrade" value="no" />
1.52      albertel 2026:       <input type="hidden" name="regrade" value="yes" />
1.62      albertel 2027:       <input type="submit" name="submit" value="Regrade" />
                   2028:       $seclist
1.49      albertel 2029:     </form>
1.155     albertel 2030:   <td>$classlist->{$student}[&Apache::loncoursedata::CL_FULLNAME()] <tt>($student)</tt></td>
1.49      albertel 2031:   <td>
                   2032: RESULT
1.58      albertel 2033:         }
1.49      albertel 2034:         if ($status{'status'} eq 'pass') {
                   2035: 	    $result .= '<font color="green">'.&mt('Passed').'</font>';
                   2036: 	} elsif ($status{'status'} eq 'fail') {
                   2037: 	    $result .= '<font color="red">'.&mt('Failed').'</font>';
                   2038: 	} elsif ($status{'status'} eq 'review') {
                   2039: 	    $result .= '<font color="blue">'.&mt('Under Review').'</font>';
                   2040: 	} elsif ($status{'status'} eq 'ungraded') {
                   2041: 	    $result .= &mt('Ungraded');
                   2042: 	} elsif ($status{'status'} ne '') {
                   2043: 	    $result .= '<font color="orange">'.&mt('Unknown Status').'</font>';
                   2044: 	} else {
                   2045: 	    $result.="&nbsp;";
                   2046: 	}
                   2047: 	if ($status{'version'}) {
                   2048: 	    $result .= ' '.&mt('Version').' '.$status{'version'};
                   2049: 	}
1.101     albertel 2050: 	if ($status{'grader'}) {
                   2051: 	    $result .= ' '.&mt('(Graded by [_1])',$status{'grader'}).' ';
                   2052: 	}
1.49      albertel 2053: 	$result.= '</td><td>';
                   2054: 	if ($status{'reviewqueue'} eq 'enqueued') {
                   2055: 	    $result .= &mt('Awaiting Review');
                   2056: 	} elsif ($status{'reviewqueue'} eq 'locked') {
                   2057: 	    $result .= &mt('Under Review');
1.58      albertel 2058: 	} elsif ($status{'reviewqueue'} eq 'in_progress') {
                   2059: 	    $result .= &mt('Still being worked on.');
1.49      albertel 2060: 	} elsif ($status{'gradingqueue'} eq 'enqueued') {
                   2061: 	    $result .= &mt('Awaiting Grading');
                   2062: 	} elsif ($status{'gradingqueue'} eq 'locked') {
                   2063: 	    $result .= &mt('Being Graded');
1.58      albertel 2064: 	} elsif ($status{'gradingqueue'} eq 'in_progress') {
                   2065: 	    $result .= &mt('Still being worked on.');
1.49      albertel 2066: 	} else {
                   2067: 	    $result.="&nbsp;";
                   2068: 	}
1.159     albertel 2069: 	$result.= '</td>'.&Apache::loncommon::end_data_table_row();
1.49      albertel 2070:     }
1.159     albertel 2071:     $result.=&Apache::loncommon::end_data_table();
1.49      albertel 2072:     return $result;
                   2073: }
                   2074: 
                   2075: sub get_student_status {
1.86      albertel 2076:     my ($symb,$cdom,$cnum,$udom,$uname,$type)=@_;
                   2077: 
                   2078:     my %status;
                   2079: 
                   2080:     if ($type eq 'Task') {
                   2081: 	my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
1.49      albertel 2082: 					  $udom,$uname);
1.89      albertel 2083: 	$status{'status'}=$record{'resource.0.status'};
                   2084: 	$status{'version'}=$record{'resource.0.version'};
                   2085: 	$status{'grader'}=$record{'resource.0.regrader'};
1.86      albertel 2086:     }
                   2087:     $status{'reviewqueue'}=
                   2088: 	&check_queue_for_key($cdom,$cnum,'reviewqueue',
                   2089: 			     &encode_queue_key($symb,$udom,$uname));
                   2090:     $status{'gradingqueue'}=
                   2091: 	&check_queue_for_key($cdom,$cnum,'gradingqueue',
                   2092: 			     &encode_queue_key($symb,$udom,$uname));
1.49      albertel 2093:     return %status;
                   2094: }
                   2095: 
1.1       albertel 2096: sub start_ClosingParagraph {
                   2097:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   2098:     my $result;
                   2099:     if ($target eq 'web') {
1.13      albertel 2100:     } elsif ($target eq 'webgrade') {
                   2101: 	&Apache::lonxml::startredirection();
1.225     albertel 2102:     } elsif ($target eq 'edit') {
                   2103: 	$result = &Apache::edit::tag_start($target,$token);
                   2104:     } elsif ($target eq 'modified') {
1.1       albertel 2105:     }
                   2106:     return $result;
                   2107: }
                   2108: 
                   2109: sub end_ClosingParagraph {
                   2110:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   2111:     my $result;
                   2112:     if ($target eq 'web') {
1.13      albertel 2113:     } elsif ($target eq 'webgrade') {
                   2114: 	&Apache::lonxml::endredirection();
1.1       albertel 2115:     }
                   2116:     return $result;
                   2117: }
                   2118: 
1.227     albertel 2119: sub insert_ClosingParagraph {
                   2120:     return '
                   2121: <ClosingParagraph>
                   2122:     <startouttext />
                   2123:     <endouttext />
                   2124: </ClosingParagraph>';
                   2125: }
                   2126: 
1.168     albertel 2127: sub get_dim_id {
1.194     albertel 2128:     if (@Apache::bridgetask::dimension) {
                   2129: 	return $Apache::bridgetask::dimension[-1];
                   2130:     } else {
                   2131: 	return $top;
                   2132:     }
1.168     albertel 2133: }
                   2134: 
1.19      albertel 2135: sub get_id {
                   2136:     my ($parstack,$safeeval)=@_;
                   2137:     my $id=&Apache::lonxml::get_param('id',$parstack,$safeeval);
                   2138:     if (!$id) { $id=$Apache::lonxml::curdepth; }
                   2139:     return $id;
                   2140: }
                   2141: 
1.162     albertel 2142: sub start_Setup {
                   2143:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.225     albertel 2144:     my $result;
1.168     albertel 2145:     my $dim = &get_id($parstack,$safeeval);
                   2146:     push(@Apache::bridgetask::dimension,$dim);
1.225     albertel 2147:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'grade') {
                   2148: 	&Apache::lonxml::startredirection();
                   2149:     } elsif ($target eq 'edit') {
                   2150: 	$result = &Apache::edit::tag_start($target,$token);
                   2151: 	$result.= &Apache::edit::text_arg('Id:','id',$token,10).
                   2152: 	    &Apache::edit::end_row().
                   2153: 	    &Apache::edit::start_spanning_row();
                   2154:     } elsif ($target eq 'modified') {
                   2155: 	my $constructtag=
                   2156: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,'id');
                   2157: 	if ($constructtag) {
                   2158: 	    $result = &Apache::edit::rebuild_tag($token);
                   2159: 	}
                   2160:     }
                   2161:     return $result;
1.162     albertel 2162: }
1.173     albertel 2163: 
                   2164: {
                   2165:     my @allowed;
                   2166:     sub enable_dimension_parsing {
                   2167: 	my ($id) = @_;
                   2168: 	push(@allowed,$id);
                   2169:     }
                   2170:     sub disable_dimension_parsing {
                   2171: 	pop(@allowed);
                   2172:     }
                   2173:     sub skip_dimension_parsing {
                   2174: 	my ($check) = @_;
                   2175: 	if (!@allowed) { return 0;}
                   2176: 	# if unspecified allow any id
                   2177: 	if ($allowed[-1] eq undef) { return 0;}
                   2178: 
                   2179: 	return ($check ne $allowed[-1]);
                   2180:     }
                   2181: }
                   2182: 
1.151     albertel 2183: sub start_Question { return &start_Dimension(@_); }
1.1       albertel 2184: sub start_Dimension {
1.173     albertel 2185:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.168     albertel 2186:     my $dim = &get_id($parstack,$safeeval);
                   2187:     my $previous_dim;
1.225     albertel 2188:     my $result;
                   2189:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2190: 	if (@Apache::bridgetask::dimension) {
                   2191: 	    $previous_dim = $Apache::bridgetask::dimension[-1];
                   2192: 	    push(@{$Apache::bridgetask::dimension{$previous_dim}{'contains'}},
                   2193: 		 $dim);
                   2194: 	    if(&skip_dimension_parsing($dim)) {
                   2195: 		$dimension{$previous_dim}{'criteria.'.$dim} =
                   2196: 		    $token->[4]
                   2197: 		    .&Apache::lonxml::get_all_text('/'.$tagstack->[-1],$parser,
                   2198: 						   $style)
                   2199: 		    .'</'.$tagstack->[-1].'>';
                   2200: 	    }
                   2201: 	    $dimension{$previous_dim}{'criteria.'.$dim.'.type'}='dimension';
                   2202: 	    $dimension{$previous_dim}{'criteria.'.$dim.'.mandatory'}=
                   2203: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
                   2204: 	    push(@{$dimension{$previous_dim}{'criterias'}},$dim);
                   2205: 	    $dimension{$dim}{'nested'}=$previous_dim;
                   2206: 	    $dimension{$dim}{'depth'} = 1 + $dimension{$previous_dim}{'depth'};
                   2207: 	    
                   2208: 	    &Apache::lonxml::debug("adding $dim as criteria to $previous_dim");
                   2209: 	} else {
                   2210: 	    $dimension{$top}{'depth'}=0;
                   2211: 	    $dimension{$top}{'criteria.'.$dim.'.type'}='dimension';
                   2212: 	    $dimension{$top}{'criteria.'.$dim.'.mandatory'}=
                   2213: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
                   2214: 	    push(@{$dimension{$top}{'criterias'}},$dim);
                   2215: 	    $dimension{$dim}{'nested'}=$top;
                   2216: 	}
                   2217:         push(@Apache::bridgetask::dimension,$dim);
                   2218: 	&Apache::lonxml::startredirection();
                   2219: 	if (!&skip_dimension_parsing($dim)) {
                   2220: 	    &enable_dimension_parsing($dim);
                   2221: 	}
                   2222:     } elsif ($target eq 'edit') {
                   2223:   	$result = &Apache::edit::tag_start($target,$token);
                   2224: 	$result.=  
                   2225: 	    &Apache::edit::text_arg('Id:','id',$token,10).' '.
                   2226: 	    &Apache::edit::select_arg('Passing is Mandatory:','Mandatory',
                   2227: 				      [['yes', 'Yes'],
                   2228: 				       ['no','No'],],
                   2229: 				      $token).' <br /> '.
                   2230: 	    &Apache::edit::text_arg('Required number of passed optional elements to pass the '.$token->[1].':',
                   2231: 				    'OptionalRequired',$token,4).
                   2232: 	    &Apache::edit::end_row().
                   2233: 	    &Apache::edit::start_spanning_row();
                   2234:     } elsif ($target eq 'modified') {
                   2235: 	my $constructtag=
                   2236: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,
                   2237: 					'id','Mandatory','OptionalRequired');
                   2238: 	if ($constructtag) {
                   2239: 	    $result = &Apache::edit::rebuild_tag($token);
                   2240: 	}
1.168     albertel 2241:     }
1.225     albertel 2242:     return $result;# &internal_location($dim);
1.1       albertel 2243: }
                   2244: 
1.160     albertel 2245: sub start_QuestionText {
                   2246:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.225     albertel 2247:     my $result;
                   2248:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2249: 	my $text=&Apache::lonxml::get_all_text('/questiontext',$parser,$style);
1.168     albertel 2250:     my $dim = &get_dim_id();
1.169     albertel 2251: 	$dimension{$dim}{'questiontext'}=$text;
1.225     albertel 2252:     } elsif ($target eq 'edit') {
                   2253: 	$result = &Apache::edit::tag_start($target,$token);
                   2254:     } elsif ($target eq 'modified') {
1.160     albertel 2255:     }
1.225     albertel 2256:     return $result;
1.160     albertel 2257: }
                   2258: 
                   2259: sub end_QuestionText {
                   2260:     return '';
                   2261: }
                   2262: 
1.227     albertel 2263: sub insert_QuestionText {
                   2264:     return '
                   2265: <QuestionText>
                   2266:     <startouttext />
                   2267:     <endouttext />
                   2268: </QuestionText>';
                   2269: }
                   2270: 
1.13      albertel 2271: sub get_instance {
1.75      albertel 2272:     my ($dim)=@_;
                   2273:     my $rand_alg=&Apache::lonnet::get_rand_alg();
                   2274:     if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' ||
                   2275: 	$rand_alg eq '64bit2' || $rand_alg eq '64bit3' ||
                   2276: 	$rand_alg eq '64bit4' ) {
                   2277: 	&Apache::response::pushrandomnumber();
1.169     albertel 2278: 	my @order=&Math::Random::random_permutation(@{$dimension{$dim}{'instances'}});
1.75      albertel 2279: 	my $num=@order;
                   2280: 	my $version=&get_version();
                   2281: 	my $which=($version-1)%$num;
                   2282: 	return $order[$which];
                   2283:     } else {
                   2284: 	my ($version,$previous) = &get_version();
                   2285: 	my $instance = 
                   2286: 	    $Apache::lonhomework::history{"resource.$version.0.$dim.instance"};
                   2287: 	if (defined($instance)) { return $instance; }
                   2288: 
                   2289: 	&Apache::response::pushrandomnumber();
1.173     albertel 2290: 	if (ref($dimension{$dim}{'instances'}) eq 'ARRAY') {
                   2291: 	    my @instances = @{$dimension{$dim}{'instances'}};
                   2292: 	    # remove disabled instances
                   2293: 	    for (my $i=0; $i < $#instances; $i++) {
                   2294: 		if ($dimension{$dim}{$instances[$i].'.disabled'}) {
                   2295: 		    splice(@instances,$i,1);
                   2296: 		    $i--;
                   2297: 		}
                   2298: 	    }
                   2299: 	    @instances = &Math::Random::random_permutation(@instances);
                   2300: 	    $instance  = $instances[($version-1)%scalar(@instances)];
                   2301: 	    if ($version =~ /^\d$/) {
                   2302: 		$Apache::lonhomework::results{"resource.$version.0.$dim.instance"} = 
                   2303: 		    $instance;
                   2304: 		$Apache::lonhomework::results{'INTERNAL_store'} = 1; 
1.75      albertel 2305: 	    }
                   2306: 	}
                   2307: 	&Apache::response::poprandomnumber();
                   2308: 	return $instance;
                   2309:     }
1.13      albertel 2310: }
                   2311: 
1.169     albertel 2312: sub get_criteria {
                   2313:     my ($what,$version,$dim,$id) = @_;
                   2314:     my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
1.194     albertel 2315:     my $prefix = ($type eq 'criteria' && $dim ne $top) ? "$dim.$id"
                   2316: 	                                               : "$id";
1.169     albertel 2317:     my $entry = "resource.$version.0.$prefix.$what";
                   2318:     if (exists($Apache::lonhomework::results{$entry})) {
                   2319: 	return $Apache::lonhomework::results{$entry};
                   2320:     }
                   2321:     return $Apache::lonhomework::history{$entry};
                   2322: }
                   2323: 
1.194     albertel 2324: sub link {
                   2325:     my ($id) = @_;
                   2326:     $id =~ s/\./_/g;
                   2327:     return 'LC_GRADING_criteria_'.$id;
                   2328: }
                   2329: sub end_Question { return &end_Dimension(@_); }
                   2330: sub end_Dimension {
                   2331:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.225     albertel 2332:     my $result;
1.194     albertel 2333:     my $dim=&get_id($parstack,$safeeval);
1.225     albertel 2334:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2335: 	$result=&Apache::lonxml::endredirection();
                   2336: 	if (&skip_dimension_parsing($dim)) {
                   2337: 	    pop(@Apache::bridgetask::dimension);
                   2338: 	    return;
                   2339: 	}
1.122     albertel 2340:     }
1.194     albertel 2341:     my $instance=&get_instance($dim);
                   2342:     my $version=&get_version();
                   2343:     if ($target eq 'web') {
                   2344: 	$result .= &nested_parse(\$dimension{$dim}{'intro'},[@_]);
                   2345: 	my @instances = $instance;
                   2346: 	if (&Apache::response::showallfoils()) {
                   2347: 	    @instances = @{$dimension{$dim}{'instances'}};
1.173     albertel 2348: 	}
1.194     albertel 2349: 	my $shown_question_text;
                   2350: 	foreach my $instance (@instances) {
                   2351: 	    $result .= &nested_parse(\$dimension{$dim}{$instance.'.text'},
                   2352: 				     [@_]);
                   2353: 	    $result .= &nested_parse(\$dimension{$dim}{'questiontext'},
                   2354: 				     [@_],{'set_dim_id' => undef});
                   2355: 	    my $task_status = 
                   2356: 		$Apache::lonhomework::history{"resource.$version.0.status"};
                   2357: 	    if ($task_status ne 'pass' && $task_status ne 'fail') {
                   2358: 		
                   2359: 		foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2360: 				@{$dimension{$dim}{'criterias'}}) {
                   2361: 		    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2362: 		    &Apache::lonxml::debug("$id is $type");
                   2363: 		    if ($type eq 'dimension') {
                   2364: 			$result.=
                   2365: 			    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2366: 					  [@_],{'set_dim_id' => $id});
1.173     albertel 2367: 		    }
1.194     albertel 2368: 		}
                   2369: 	    } else {
                   2370: 		my $dim_status=$Apache::lonhomework::history{"resource.$version.0.$dim.status"};
                   2371: 		my $mandatory='Mandatory';
                   2372: 		if (&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval) eq 'N') {
                   2373: 		    $mandatory='Optional';
                   2374: 		}
1.200     albertel 2375: 		my $dim_info=
                   2376: 		    "\n<div class='LC_$dim_status LC_question_grade'>\n\t";
1.212     albertel 2377: 		my $ucquestion = 
                   2378: 		    my $question = 
                   2379: 		    ('sub' x $dimension{$dim}{'depth'}).'question';
                   2380: 		$ucquestion =~ s/^(.)/uc($1)/e;
1.194     albertel 2381: 		if ($dim_status eq 'pass') {
1.222     albertel 2382: 		    $dim_info.='<h3>'.$ucquestion.' : you passed this '.$mandatory.' '.$question.'</h3>';
1.194     albertel 2383: 		}
                   2384: 		if ($dim_status eq 'fail') {
1.222     albertel 2385: 		    $dim_info.='<h3>'.$ucquestion.' : you did not pass this '.$mandatory.' '.$question.'</h3>';
1.194     albertel 2386: 		}
1.197     albertel 2387: 		my %counts = &get_counts($dim,$instance,$parstack,
                   2388: 					 $safeeval);
                   2389: 
1.200     albertel 2390: 		$dim_info.="\n\t<p>"
1.197     albertel 2391: 		    .&question_status_message(\%counts,
                   2392: 					      $dimension{$dim}{'depth'})
1.200     albertel 2393: 		    ."</p>\n</div>\n";
1.194     albertel 2394: 		
                   2395: 		foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2396: 				@{$dimension{$dim}{'criterias'}}) {
                   2397: 		    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2398: 		    if ($type eq 'dimension') {
1.205     albertel 2399: 			if (defined($dimension{$id}{'result'})) {
                   2400: 			    $result.=$dimension{$id}{'result'};
                   2401: 			    next;
                   2402: 			} else {
                   2403: 			    $dim_info .=
                   2404: 				&nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2405: 					      [@_],{'set_dim_id' => $id});
                   2406: 			}
                   2407: 		    } else {
                   2408: 			my $criteria =
                   2409: 			    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2410: 					  [@_]);
                   2411: 			$dim_info .= &layout_web_Criteria($dim,$id,$criteria);
1.194     albertel 2412: 		    }
1.169     albertel 2413: 		}
1.202     albertel 2414: 		# puts the results at the end of the dimension
1.226     albertel 2415: 		if ($result =~m{<QuestionGradeInfo\s*/>}) {
                   2416: 		    $result=~s{<QuestionGradeInfo\s*/>}{$dim_info};
                   2417: 		} else {
                   2418: 		    $result .= $dim_info;
                   2419: 		}
1.202     albertel 2420: 		# puts the results at the beginning of the dimension
                   2421: 		# my $internal_location=&internal_location($dim);
                   2422: 		# $result=~s/\Q$internal_location\E/$dim_info/;
1.19      albertel 2423: 	    }
1.194     albertel 2424: 	}
1.206     albertel 2425: 	if ($result !~ /^\s*$/s) {
1.209     albertel 2426: 	    # FIXME? this maybe unneccssary in the future, (CSE101 BT
                   2427: 	    # from Fall 2006 geenrate a div that attempts to hide some
                   2428: 	    # of the output in an odd way, this is a workaround so
                   2429: 	    # those old ones will continue to work.  # It puts the
                   2430: 	    # LC_question div to come after any starting closie div
                   2431: 	    # that the dimension produces
1.211     albertel 2432: 	    if ($result =~ m{^\s*</div>}) {
                   2433: 		$result =~ s{^(\s*</div>)}
1.210     albertel 2434: 		            {$1\n<div id="$dim" class="LC_question">};
1.209     albertel 2435: 	    } else {
1.210     albertel 2436: 		$result = "\n".'<div id="'.$dim.'" class="LC_question">'.
1.209     albertel 2437: 		    "\n".$result;
                   2438: 	    }
                   2439: 	    $result .= "\n</div>\n";
1.206     albertel 2440: 	}
1.194     albertel 2441:     } elsif ($target eq 'webgrade') {
                   2442: 	# in case of any side effects that we need
                   2443: 	&nested_parse(\$dimension{$dim}{'intro'},[@_]);
                   2444: 	&nested_parse(\$dimension{$dim}{$instance.'.text'},[@_]);
                   2445: 	$result.=
                   2446: 	    &nested_parse(\$dimension{$dim}{'questiontext'},[@_],
                   2447: 			  {'set_dim_id'          => undef,
1.195     albertel 2448: 			   'delayed_dim_results' => 1});
1.194     albertel 2449: 	foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2450: 			@{$dimension{$dim}{'criterias'}} ) {
                   2451: 	    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2452: 	    if ($type eq 'dimension') {
                   2453: 		# dimensional 'criteria' don't get assigned grades
                   2454: 		$result.=
                   2455: 		    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2456: 				  [@_],{'set_dim_id' => $id});
                   2457: 		next;
                   2458: 	    } else {
                   2459: 		my $criteria =&nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2460: 					     [@_]);
                   2461: 		$criteria = &layout_webgrade_Criteria($dim,$id,$criteria);
                   2462: 		my $internal_location=&internal_location($id);
1.209     albertel 2463: 		if ($result =~ m/\Q$internal_location\E/) {
                   2464: 		    $result =~ s/\Q$internal_location\E/$criteria/;
                   2465: 		} else {
                   2466: 		    $result.=$criteria ;
                   2467: 		}
1.151     albertel 2468: 	    }
1.194     albertel 2469: 	}
                   2470: 	if (&nest()) {
                   2471: 	    &Apache::lonxml::debug(" for $dim stashing results into ".$dimension{$dim}{'nested'});
                   2472: 	    $dimension{$dimension{$dim}{'nested'}}{'result'}.=$result;
                   2473: 	    undef($result);
                   2474: 	}
                   2475:     } elsif ($target eq 'grade' && $env{'form.webgrade'}) {
                   2476: 	my $optional_passed=0;
                   2477: 	my $mandatory_failed=0;
                   2478: 	my $ungraded=0;
                   2479: 	my $review=0;
                   2480: 	
                   2481: 	$result .= &nested_parse(\$dimension{$dim}{'intro'},[@_]);
                   2482: 	$result .= &nested_parse(\$dimension{$dim}{$instance.'.text'},
                   2483: 				 [@_]);
                   2484: 	$result .= &nested_parse(\$dimension{$dim}{'questiontext'},
                   2485: 				 [@_],{'set_dim_id' => undef});
                   2486: 	
                   2487: 	foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2488: 			@{$dimension{$dim}{'criterias'}}) {
                   2489: 	    my $link=&link($id);
                   2490: 	    
                   2491: 	    my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2492: 	    if ($type eq 'criteria') {
                   2493: 		# dimensional 'criteria' don't get assigned grades
                   2494: 		$Apache::lonhomework::results{"resource.$version.0.$dim.$id.status"}=$env{'form.HWVAL_'.$link};
                   2495: 		$Apache::lonhomework::results{"resource.$version.0.$dim.$id.comment"}=$env{'form.HWVAL_comment_'.$link};
                   2496: 	    } else {
                   2497: 		$result .=
                   2498: 		    &nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2499: 				  [@_],{'set_dim_id' => $id});
1.20      albertel 2500: 	    }
1.194     albertel 2501: 	    my $status= &get_criteria('status',$version,$dim,$id);
                   2502: 	    
                   2503: 	    my $mandatory=($dimension{$dim}{'criteria.'.$id.'.mandatory'} ne 'N');
                   2504: 	    if ($status eq 'pass') {
                   2505: 		if (!$mandatory) { $optional_passed++; }
                   2506: 	    } elsif ($status eq 'fail') {
                   2507: 		if ($mandatory) { $mandatory_failed++; }
                   2508: 	    } elsif ($status eq 'review') {
                   2509: 		$review++;
                   2510: 	    } elsif ($status eq 'ungraded') {
                   2511: 		$ungraded++;
1.20      albertel 2512: 	    } else {
1.194     albertel 2513: 		$ungraded++;
1.20      albertel 2514: 	    }
1.194     albertel 2515: 	}
                   2516: 
                   2517: 	my $opt_req=$dimension{$dim}{$instance.'.optionalrequired'};
                   2518: 	if ($opt_req !~ /\S/) {
                   2519: 	    $opt_req=
                   2520: 		&Apache::lonxml::get_param('OptionalRequired',
                   2521: 					   $parstack,$safeeval);
                   2522: 	    if ($opt_req !~ /\S/) { $opt_req = 0; }
                   2523: 	}
                   2524: 	if ($optional_passed < $opt_req) {
                   2525: 	    $mandatory_failed++;
                   2526: 	}
                   2527: 	&Apache::lonxml::debug("all instance ".join(':',@{$dimension{$dim}{$instance.'.criterias'}})." results -> m_f $mandatory_failed o_p $optional_passed u $ungraded r $review");
                   2528: 	if ($review) {
                   2529: 	    $Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
                   2530: 		'review';
                   2531: 	} elsif ($ungraded) {
                   2532: 	    $Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
                   2533: 		'ungraded';
                   2534: 	} elsif ($mandatory_failed) {
                   2535: 	    $Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
                   2536: 		'fail';
1.69      albertel 2537: 	} else {
1.194     albertel 2538: 	    $Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
                   2539: 		'pass';
1.13      albertel 2540: 	}
1.225     albertel 2541:     } elsif ($target eq 'edit') {
                   2542:     } elsif ($target eq 'modified') {
1.194     albertel 2543:     } else {
                   2544: 	# any other targets no output
                   2545: 	undef($result);
1.1       albertel 2546:     }
1.225     albertel 2547:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2548: 	&disable_dimension_parsing();
                   2549: 	pop(@Apache::bridgetask::dimension);
                   2550:     }
1.194     albertel 2551:     return $result;
                   2552: }
1.162     albertel 2553: 
1.198     albertel 2554: sub question_status_message {
1.197     albertel 2555:     my ($counts,$depth) = @_;
                   2556:     my %req  = ('man' => 'mandatory',
                   2557: 		'opt' => 'optional',);
                   2558:     my %type = ('cri' => 'criteria',
                   2559: 		'dim' => ('sub'x($depth+1)).'questions',);
                   2560:     my @sections;
                   2561:     foreach my $req ('man','opt') {
                   2562: 	foreach my $type ('cri','dim') {
                   2563: 	    if ($counts->{$req.'_'.$type}) {
                   2564: 		push(@sections,
1.213     albertel 2565: 		     $counts->{$req.'_'.$type.'_passed'}.' of the '.
1.197     albertel 2566: 		     $counts->{$req.'_'.$type}.' '.
                   2567: 		     $req{$req}.' '.$type{$type});
                   2568: 	    }
                   2569: 	}
                   2570:     }
                   2571: 
                   2572:     my $status = 'You passed ';
                   2573:     if (@sections == -1) {
                   2574:     } elsif (@sections == 1) {
                   2575: 	$status .= $sections[0];
                   2576:     } elsif (@sections == 2) {
                   2577: 	$status .= $sections[0].' and '.$sections[1];
                   2578:     } else {
                   2579: 	my $last = pop(@sections);
                   2580: 	$status .= join(', ',@sections).', and '.$last;
                   2581:     }
                   2582:     $status .= '.';
                   2583:     if ($counts->{'opt'}) {
                   2584: 	$status .= ' You were required to pass '.$counts->{'opt_req'}.
1.220     albertel 2585: 	    ' optional ';
1.219     albertel 2586: 	if ($counts->{'opt_dim'} + $counts->{'man_dim'} < 1) {
                   2587: 	    $status .=
1.220     albertel 2588: 		($counts->{'opt_req'} == 1?'criterion':'criteria');
1.219     albertel 2589: 	} else {
                   2590: 	    $status .=
1.220     albertel 2591: 		'component'.($counts->{'opt_req'} == 1?'':'s');
1.219     albertel 2592: 	}
                   2593: 	$status .= '.';
1.197     albertel 2594:     }
                   2595:     return $status;
                   2596: }
                   2597: 
                   2598: sub get_counts {
                   2599:     my ($dim,$instance,$parstack,$safeeval) = @_;
                   2600:     my %counts;
                   2601:     my @possible = ('man_cri','man_dim',
                   2602: 		    'opt_cri','opt_dim',
                   2603: 		    'man_cri_passed', 'man_dim_passed',
                   2604: 		    'opt_cri_passed', 'opt_dim_passed',
                   2605: 		    'man_passed',
                   2606: 		    'opt_passed',
                   2607: 		    'opt_req');
                   2608:     foreach my $which (@possible) { $counts{$which} = 0; }
                   2609: 
                   2610:     my $version = &get_version();
                   2611: 
                   2612:     foreach my $id ( @{$dimension{$dim}{$instance.'.criterias'}},
                   2613: 		     @{$dimension{$dim}{'criterias'}} ) {
                   2614: 	my $status = &get_criteria('status',$version,$dim,$id);
                   2615: 	my $which;
                   2616: 	if ($dimension{$dim}{'criteria.'.$id.'.mandatory'} 
                   2617: 	    eq 'N') {
                   2618: 	    $which = 'opt';
                   2619: 	} else {
                   2620: 	    $which = 'man';
                   2621: 	}
                   2622: 	$counts{$which}++;
                   2623: 	if ($status eq 'pass') { $counts{$which.'_passed'}++; }
                   2624: 	if ($dimension{$dim}{'criteria.'.$id.'.type'}
                   2625: 	    eq 'dimension') {
                   2626: 	    $which .= '_dim';
                   2627: 	} else {
                   2628: 	    $which .= '_cri';
                   2629: 	}
                   2630: 	$counts{$which}++;
                   2631: 	if ($status eq 'pass') { $counts{$which.'_passed'}++; }
                   2632: 
                   2633: 
                   2634:     }
                   2635:     if ($counts{'man_dim_passed'} eq $counts{'man_dim'}) {
                   2636: 	$counts{'man_dim_passed'}='all';
                   2637:     }
                   2638:     if ($counts{'man_cri_passed'} eq $counts{'man_cri'}) {
                   2639: 	$counts{'man_cri_passed'}='all';
                   2640:     }
                   2641:     
                   2642:     $counts{'opt_req'}=$dimension{$dim}{$instance.'.optionalrequired'};
                   2643:     if ($counts{'opt_req'} !~ /\S/) {
                   2644: 	$counts{'opt_req'}= &Apache::lonxml::get_param('OptionalRequired',
                   2645: 						       $parstack,$safeeval);
                   2646: 	if ($counts{'opt_req'} !~ /\S/) { $counts{'opt_req'} = 0; }
                   2647:     }
                   2648:     return %counts;
                   2649: }
                   2650: 
1.194     albertel 2651: sub end_Setup {
                   2652:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.225     albertel 2653:     my $result;
1.194     albertel 2654:     my $dim=&get_id($parstack,$safeeval);
                   2655:     my $instance=&get_instance($dim);
                   2656:     my $version=&get_version();
1.225     albertel 2657:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'grade') {
                   2658: 	$result=&Apache::lonxml::endredirection();
                   2659:     }
1.194     albertel 2660:     if ($target eq 'web') {
                   2661: 	@Apache::scripttag::parser_env = @_;
                   2662: 	$result.=&Apache::scripttag::xmlparse($dimension{$dim}{'intro'});
                   2663: 	my @instances = $instance;
                   2664: 	if (&Apache::response::showallfoils()) {
                   2665: 	    @instances = @{$dimension{$dim}{'instances'}};
                   2666: 	}
                   2667: 	foreach my $instance (@instances) {
1.162     albertel 2668: 	    @Apache::scripttag::parser_env = @_;
1.194     albertel 2669: 	    $result.=&Apache::scripttag::xmlparse($dimension{$dim}{$instance.'.text'});
1.162     albertel 2670: 	    @Apache::scripttag::parser_env = @_;
1.194     albertel 2671: 	    $result.=&Apache::scripttag::xmlparse($dimension{$dim}{'questiontext'});
1.162     albertel 2672: 	}
1.194     albertel 2673:     } elsif ($target eq 'webgrade' 
                   2674: 	     || $target eq 'grade' && $env{'form.webgrade'}) {
                   2675: 	# in case of any side effects that we need
                   2676: 	@Apache::scripttag::parser_env = @_;
                   2677: 	&Apache::scripttag::xmlparse($dimension{$dim}{'intro'});
                   2678: 	@Apache::scripttag::parser_env = @_;
                   2679: 	&Apache::scripttag::xmlparse($dimension{$dim}{$instance.'.text'});
                   2680: 	@Apache::scripttag::parser_env = @_;
                   2681: 	&Apache::scripttag::xmlparse($dimension{$dim}{'questiontext'});
                   2682:     } else {
                   2683: 	# any other targets no output
                   2684: 	undef($result);
1.162     albertel 2685:     }
1.194     albertel 2686:     pop(@Apache::bridgetask::dimension);
                   2687:     return $result;
1.1       albertel 2688: }
                   2689: 
1.113     albertel 2690: sub grading_history {
1.151     albertel 2691:     my ($version,$dim,$id) = @_;
1.113     albertel 2692:     if (!&Apache::lonnet::allowed('mgq',$env{'request.course.id'})) {
                   2693: 	return '';
                   2694:     }
                   2695:     my ($result,$grader);
1.194     albertel 2696:     my $scope="resource.$version.0.";
                   2697:     $scope .= ($dim ne $top) ? "$dim.$id"
                   2698: 	                     : "$id";
1.113     albertel 2699:     foreach my $t (1..$Apache::lonhomework::history{'version'}) {
                   2700: 	if (exists($Apache::lonhomework::history{$t.':resource.0.regrader'})) {
                   2701: 	    my ($gname,$gdom) = 
1.138     albertel 2702: 		split(':',$Apache::lonhomework::history{$t.':resource.0.regrader'});
1.113     albertel 2703: 	    my $fullname = &Apache::loncommon::plainname($gname,$gdom);
                   2704: 	    $grader = &Apache::loncommon::aboutmewrapper($fullname,
                   2705: 							 $gname,$gdom);
                   2706: 	}
                   2707: 	my $entry;
                   2708: 	if (exists($Apache::lonhomework::history{"$t:$scope.status"})) {
                   2709: 	    $entry.="<tt>".$Apache::lonhomework::history{"$t:$scope.status"}.'</tt>';
                   2710: 	}
                   2711: 	if (exists($Apache::lonhomework::history{"$t:$scope.comment"})) {
                   2712: 	    $entry.=' comment: "'.$Apache::lonhomework::history{"$t:$scope.comment"}.'"';
                   2713: 	}
                   2714: 	if ($entry) {
1.200     albertel 2715: 	    $result.= "\n\t\t<li>\n\t\t\t$grader :\n\t\t\t $entry \n\t\t</li>";
1.113     albertel 2716: 	}
                   2717:     }
                   2718:     if ($result) {
1.200     albertel 2719: 	return "\n\t".'<ul class="LC_GRADING_pastgrading">'.$result.
                   2720: 	    "\n\t".'</ul>'."\n";
1.113     albertel 2721:     }
                   2722:     return '';
                   2723: }
                   2724: 
1.1       albertel 2725: sub start_IntroParagraph {
1.87      albertel 2726:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel 2727:     my $result;
1.168     albertel 2728:     my $dim = &get_dim_id();
1.153     albertel 2729:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
1.151     albertel 2730: 	if ($tagstack->[-2] eq 'Dimension' || $tagstack->[-2] eq 'Question' ) {
1.169     albertel 2731: 	    $dimension{$dim}{'intro'}=
1.151     albertel 2732: 		&Apache::lonxml::get_all_text('/introparagraph',
                   2733: 					      $parser,$style);
                   2734:        	} elsif ($tagstack->[-2] eq 'Task' && $target eq 'webgrade') {
1.127     albertel 2735: 	    &Apache::lonxml::startredirection();
1.1       albertel 2736: 	}
1.47      albertel 2737: 	
1.225     albertel 2738:     } elsif ($target eq 'edit') {
                   2739: 	$result = &Apache::edit::tag_start($target,$token);
                   2740:     } elsif ($target eq 'modified') {
1.1       albertel 2741:     }
                   2742:     return $result;
                   2743: }
                   2744: 
                   2745: sub end_IntroParagraph {
1.127     albertel 2746:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.128     albertel 2747:     if ($tagstack->[-2] eq 'Task' && $target eq 'webgrade') {
1.127     albertel 2748: 	my $result = &Apache::lonxml::endredirection();
                   2749:     }
1.1       albertel 2750: }
                   2751: 
1.227     albertel 2752: sub insert_IntroParagraph {
                   2753:     return '
                   2754: <IntroParagraph>
                   2755:     <startouttext />
                   2756:     <endouttext />
                   2757: </IntroParagraph>';
                   2758: }
                   2759: 
1.1       albertel 2760: sub start_Instance {
                   2761:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.168     albertel 2762:     my $dim = &get_dim_id();
                   2763:     my $id  = &get_id($parstack,$safeeval);
1.169     albertel 2764:     push(@{$dimension{$dim}{'instances'}},$id);
1.168     albertel 2765:     push(@{$Apache::bridgetask::instance{$dim}},$id);
1.19      albertel 2766:     push(@Apache::bridgetask::instancelist,$id);
1.169     albertel 2767:     $dimension{$dim}{$id.'.optionalrequired'}=
1.19      albertel 2768: 	&Apache::lonxml::get_param('OptionalRequired',$parstack,$safeeval);
1.75      albertel 2769:     my $disabled = &Apache::lonxml::get_param('Disabled',$parstack,$safeeval);
                   2770:     if (lc($disabled) eq 'yes') {
1.169     albertel 2771: 	$dimension{$dim}{$id.'.disabled'}='1';
1.75      albertel 2772:     }
1.225     albertel 2773:     my $result;
                   2774:     if ($target eq 'edit') {
                   2775: 	$result = &Apache::edit::tag_start($target,$token);
                   2776: 	$result.=  
                   2777: 	    &Apache::edit::text_arg('Id:','id',$token,10).' '.
                   2778: 	    &Apache::edit::select_arg('Instance is Disabled:','Disabled',
                   2779: 				      [['no', 'No'],
                   2780: 				       ['yes','Yes'],],
                   2781: 				      $token)
                   2782: 	    .' <br /> '.
                   2783: 	    &Apache::edit::text_arg('Required number of passed optional elements to pass the Instance:',
                   2784: 				    'OptionalRequired',$token,4)
                   2785: 	    .&Apache::edit::end_row().
                   2786: 	    &Apache::edit::start_spanning_row();
                   2787:     } elsif ($target eq 'modified') {
                   2788: 	my $constructtag=
                   2789: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,
                   2790: 					'id','OptionalRequired','Disabled');
                   2791: 	if ($constructtag) {
                   2792: 	    $result = &Apache::edit::rebuild_tag($token);
                   2793: 	}
                   2794:     }
                   2795:     return $result;
1.1       albertel 2796: }
                   2797: 
                   2798: sub end_Instance {
1.225     albertel 2799:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   2800:     my $result;
                   2801:     if ($target eq 'edit') {
                   2802: 	$result = &Apache::edit::tag_end($target,$token);
                   2803:     }
                   2804:     return $result;
1.1       albertel 2805: }
                   2806: 
                   2807: sub start_InstanceText {
1.87      albertel 2808:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.225     albertel 2809:     my $result;
1.153     albertel 2810:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
1.225     albertel 2811: 	my $text=&Apache::lonxml::get_all_text('/instancetext',$parser,$style);
                   2812: 	my $dim = &get_dim_id();
                   2813: 	my $instance_id=$Apache::bridgetask::instance{$dim}[-1];
1.169     albertel 2814: 	$dimension{$dim}{$instance_id.'.text'}=$text;
1.225     albertel 2815:     } elsif ($target eq 'edit') {
                   2816: 	$result = &Apache::edit::tag_start($target,$token);
                   2817:     } elsif ($target eq 'modified') {
1.1       albertel 2818:     }
1.225     albertel 2819:     return $result;
1.1       albertel 2820: }
                   2821: 
                   2822: sub end_InstanceText {
                   2823:     return '';
                   2824: }
                   2825: 
1.227     albertel 2826: sub insert_InstanceText {
                   2827:     return '
                   2828: <InstanceText>
                   2829:     <startouttext />
                   2830:     <endouttext />
                   2831: </InstanceText>';
                   2832: }
                   2833: 
1.1       albertel 2834: sub start_Criteria {
1.87      albertel 2835:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.190     albertel 2836:     my $result = '';
1.21      albertel 2837:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'grade') {
1.225     albertel 2838: 	my $criteria=&Apache::lonxml::get_all_text('/criteria',$parser,$style);
1.168     albertel 2839: 	my $dim = &get_dim_id();
1.19      albertel 2840: 	my $id=&get_id($parstack,$safeeval);
1.194     albertel 2841: 	if ($target eq 'web' || $target eq 'webgrade') {
1.208     albertel 2842: 	    if ($target eq 'webgrade') {
1.195     albertel 2843: 		&Apache::lonxml::debug(" for $dim $id stashing results into $dim ");
                   2844: 		$dimension{$dim}{'result'} .= &internal_location($id);
                   2845: 	    } else {
                   2846: 		&Apache::lonxml::debug(" not stashing $dim $id");
1.206     albertel 2847: 		#$result .= &internal_location($id);
1.195     albertel 2848: 	    }
1.194     albertel 2849: 	}
1.169     albertel 2850: 	&Apache::lonxml::debug("Criteria $id with $dim");
1.151     albertel 2851: 	if (&Apache::londefdef::is_inside_of($tagstack,'Instance')) {
1.168     albertel 2852: 	    my $instance_id=$Apache::bridgetask::instance{$dim}[-1];
1.169     albertel 2853: 	    $dimension{$dim}{"criteria.$instance_id.$id"}=$criteria;
                   2854: 	    $dimension{$dim}{"criteria.$instance_id.$id.type"}='criteria';
                   2855: 	    $dimension{$dim}{"criteria.$instance_id.$id.mandatory"}=
1.151     albertel 2856: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
1.169     albertel 2857: 	    push(@{$dimension{$dim}{$instance_id.'.criterias'}},"$instance_id.$id");
1.151     albertel 2858: 	} else {
1.169     albertel 2859: 	    $dimension{$dim}{'criteria.'.$id}=$criteria;
                   2860: 	    $dimension{$dim}{'criteria.'.$id.'.type'}='criteria';
                   2861: 	    $dimension{$dim}{'criteria.'.$id.'.mandatory'}=
1.151     albertel 2862: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
1.169     albertel 2863: 	    push(@{$dimension{$dim}{'criterias'}},$id);
1.194     albertel 2864: 	}
1.225     albertel 2865:     } elsif ($target eq 'edit') {
                   2866: 	$result .=&Apache::edit::tag_start($target,$token);
                   2867: 	$result.=  
                   2868: 	    &Apache::edit::text_arg('Id:','id',$token,10).' '.
                   2869: 	    &Apache::edit::select_arg('Passing is Mandatory:','Mandatory',
                   2870: 				      [['yes', 'Yes'],
                   2871: 				       ['no','No'],],
                   2872: 				      $token)
                   2873: 	    .' <br /> '.&Apache::edit::end_row().
                   2874: 	    &Apache::edit::start_spanning_row();
                   2875:     } elsif ($target eq 'modified') {
                   2876: 	my $constructtag=
                   2877: 	    &Apache::edit::get_new_args($token,$parstack,$safeeval,
                   2878: 					'id','Mandatory');
                   2879: 	if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
1.194     albertel 2880:     }
                   2881:     return $result;
                   2882: }
                   2883: 
                   2884: sub layout_web_Criteria {
                   2885:     my ($dim,$id,$criteria) = @_;
1.190     albertel 2886: 
1.194     albertel 2887:     my $version = &get_version();
                   2888:     my $status= &get_criteria('status', $version,$dim,$id);
                   2889:     my $comment=&get_criteria('comment',$version,$dim,$id);
                   2890:     my $mandatory=($dimension{$dim}{'criteria.'.$id.'.mandatory'} ne 'N');
                   2891:     if ($mandatory) {
                   2892: 	$mandatory='Mandatory';
                   2893:     } else {
                   2894: 	$mandatory='Optional';
1.1       albertel 2895:     }
1.194     albertel 2896:     my $status_display=$status;
                   2897:     $status_display=~s/^([a-z])/uc($1)/e;
                   2898:     my $criteria_info.=
1.200     albertel 2899: 	'<div class="LC_'.$status.' LC_criteria">'."\n\t".'<h4>'
1.204     albertel 2900: 	.$mandatory.' Criteria</h4>'."\n\t".'<p class="LC_criteria_text">'
                   2901: 	."\n";
1.202     albertel 2902:     $criteria =~ s/^\s*//s;
                   2903:     $criteria =~ s/\s*$//s;
1.194     albertel 2904:     $criteria_info.= $criteria;
1.200     albertel 2905:     $criteria_info.="\n\t".'</p>'.
                   2906: 	"\n\t".'<p class="LC_grade">'.$status_display.'</p>';
1.194     albertel 2907:     if ($comment =~ /\w/) {
1.200     albertel 2908: 	$criteria_info.=
                   2909: 	    "\n\t".
                   2910: 	    '<p class="LC_comment">'.&mt('Comment: [_1]',$comment).'</p>';
1.194     albertel 2911:     }
1.200     albertel 2912:     $criteria_info.="\n".'</div>'."\n";
                   2913:     
1.194     albertel 2914:     return $criteria_info;
                   2915: }
                   2916: 
                   2917: sub layout_webgrade_Criteria {
                   2918:     my ($dim,$id,$criteria) = @_;
                   2919:     my $link=&link($id);
                   2920:     my $version = &get_version();
                   2921:     my $status  = &get_criteria('status',$version,$dim,$id);
1.200     albertel 2922:     my %lt = ( 'ungraded' => 'Ungraded',
                   2923: 	       'fail'     => 'Fail',
                   2924: 	       'pass'     => 'Pass',
                   2925: 	       'review'   => 'Review',
                   2926: 	       'comment'  => 'Additional Comment for Student',
                   2927: 	       );
                   2928:     %lt = &Apache::lonlocal::texthash(%lt);
                   2929:     my $comment = &get_criteria('comment',$version,$dim,$id);
                   2930:     $comment = &HTML::Entities::encode($comment,'<>"&');
                   2931:     my %checked;
                   2932:     foreach my $which ('ungraded','fail','pass','review') {
                   2933: 	if ($status eq $which) { $checked{$which} = 'checked="checked"'; }
                   2934:     }
                   2935:     if (!%checked) { $checked{'ungraded'} = 'checked="checked"'; }
1.201     albertel 2936:     my $buttons;
                   2937:     foreach my $which  ('ungraded','fail','pass','review') {
                   2938: 	$buttons .= <<END_BUTTON;
                   2939: 		<label class="LC_GRADING_$which">
                   2940: 			<input type="radio" name="HWVAL_$link" value="$which" $checked{$which} />
                   2941: 			$lt{$which}
                   2942: 		</label>
                   2943: END_BUTTON
                   2944:     }
1.202     albertel 2945:     $criteria =~ s/^\s*//s;
                   2946:     $criteria =~ s/\s*$//s;
1.200     albertel 2947:     my $result = <<END_CRITERIA;
1.201     albertel 2948: <div class="LC_GRADING_criteria">
                   2949: 	<div class="LC_GRADING_criteriatext">
                   2950: 		$criteria
                   2951: 	</div>
                   2952: 	<div class="LC_GRADING_grade">
                   2953: $buttons
                   2954: 	</div>
                   2955: 	<label class="LC_GRADING_comment">
                   2956: 		$lt{'comment'}
                   2957: 		<textarea class="LC_GRADING_comment_area" name="HWVAL_comment_$link">$comment</textarea>
                   2958: 	</label>
                   2959: </div>
1.200     albertel 2960: END_CRITERIA
                   2961:     $result .= &grading_history($version,$dim,$id);
1.190     albertel 2962:     return $result;
1.1       albertel 2963: }
                   2964: 
1.47      albertel 2965: sub end_Criteria {
1.225     albertel 2966:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   2967:     if ($target eq 'edit') {
                   2968:     } elsif ($target eq 'modified') {
                   2969:     }
                   2970: }
1.227     albertel 2971: sub insert_Criteria {
                   2972:     return '
                   2973: <Criteria>
                   2974:     <CriteriaText>
                   2975:         <startouttext />
                   2976:         <endouttext />
                   2977:     </CriteriaText>
                   2978: </Criteria>';
                   2979: }
1.225     albertel 2980: 
                   2981: sub start_CriteriaText {
                   2982:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   2983:     my $result;
                   2984:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
                   2985: 	
                   2986:     } elsif ($target eq 'edit') {
                   2987: 	$result = &Apache::edit::tag_start($target,$token);
                   2988:     } elsif ($target eq 'modified') {
                   2989:     }
                   2990:     return $result;
                   2991: }
                   2992: 
                   2993: sub end_CriteriaText {
                   2994:     return '';
1.47      albertel 2995: }
                   2996: 
1.227     albertel 2997: sub insert_CriteriaText {
                   2998:     return '
                   2999: <CriteriaText>
                   3000:     <startouttext />
                   3001:     <endouttext />
                   3002: </CriteriaText>';
                   3003: }
                   3004: 
1.186     albertel 3005: sub start_GraderNote {
                   3006:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.225     albertel 3007:     my $result;
1.186     albertel 3008:     if ($target eq 'webgrade') {
1.225     albertel 3009: 	$result = '<div class="LC_GRADING_gradernote"><b>'.
1.187     albertel 3010: 	    &mt('Note to graders:').'</b>';
1.225     albertel 3011:     } elsif ($target eq 'edit') {
                   3012: 	$result = &Apache::edit::tag_start($target,$token);
                   3013:     } elsif ($target eq 'modified') {
                   3014:     } elsif ($target eq 'web' || $target eq 'grade') {
                   3015: 	my $note=&Apache::lonxml::get_all_text('/gradernote',$parser,$style); 
1.186     albertel 3016:     }
1.225     albertel 3017:     return $result;
1.186     albertel 3018: }
                   3019: 
                   3020: sub end_GraderNote {
                   3021:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   3022: 
                   3023:     if ($target eq 'webgrade') {
                   3024: 	return '</div>';
                   3025:     }
                   3026:     return;
                   3027: }
                   3028: 
1.227     albertel 3029: sub insert_GraderNote {
                   3030:     return '
                   3031: <GraderNote>
                   3032:     <startouttext />
                   3033:     <endouttext />
                   3034: </GraderNote>';
                   3035: }
1.186     albertel 3036: 
                   3037: 
1.4       albertel 3038: sub proctor_validation_screen {
                   3039:     my ($slot) = @_;
1.185     albertel 3040:     my (undef,undef,$domain,$user) = &Apache::lonnet::whichuser();
1.5       albertel 3041:     my $url=&Apache::lonnet::studentphoto($domain,$user,'jpg');
1.230     albertel 3042:     if ($url ne '/adm/lonKaputt/lonlogo_broken.gif') {
                   3043: 	$url = "<tr><td colspan=\"2\"><img src=\"$url\" /></td></tr>";
                   3044:     } else {
                   3045: 	undef($url);
                   3046:     }
                   3047: 
1.44      albertel 3048:     my $name=&Apache::loncommon::plainname($user,$domain);
                   3049:     
1.4       albertel 3050:     my $msg;
1.11      albertel 3051:     if ($env{'form.proctorpassword'}) {
1.230     albertel 3052: 	$msg.='<p><span class="LC_warning">'
                   3053: 	    .&mt("Failed to authenticate the proctor.")
                   3054: 	    .'</span></p>';
1.4       albertel 3055:     }
1.230     albertel 3056: 
                   3057:     my $valid;
                   3058:     my @possible_proctors=split(",",$slot->{'proctor'});
                   3059:     foreach my $proctor (@possible_proctors) {
                   3060: 	if ($proctor =~ /$LONCAPA::username_re:$LONCAPA::domain_re/) {
                   3061: 	    $valid = 1;
                   3062: 	    last;
                   3063: 	}
                   3064:     }
                   3065:     if (!$valid) {
                   3066: 	$msg.='<p><span class="LC_error">'
                   3067: 	    .&mt("No valid poctors are defined.")
                   3068: 	    .'</span></p>';
                   3069:     }
                   3070:     
1.47      albertel 3071:     if (!$env{'form.proctordomain'}) { $env{'form.proctordomain'}=$domain; }
1.229     albertel 3072:     my $uri = &Apache::lonenc::check_encrypt($env{'request.uri'});
                   3073:     $uri = &HTML::Entities::encode($uri,'<>&"');
1.4       albertel 3074:     my $result= (<<ENDCHECKOUT);
                   3075: <h2>Proctor Validation</h2>
                   3076:     <p>Your room's proctor needs to validate your access to this resource.</p>
                   3077:     $msg
1.229     albertel 3078: <form name="checkout" method="post" action="$uri">
1.4       albertel 3079: <input type="hidden" name="validate" value="yes" />
                   3080: <input type="hidden" name="submitted" value="yes" />
                   3081: <table>
1.44      albertel 3082:   <tr><td>Proctor's Username:</td><td><input type="string" name="proctorname" value="$env{'form.proctorname'}" /></td></tr>
1.4       albertel 3083:   <tr><td>Password:</td><td><input type="password" name="proctorpassword" value="" /></td></tr>
1.46      albertel 3084:   <tr><td>Proctor's Domain:</td><td><input type="string" name="proctordomain" value="$env{'form.proctordomain'}" /></td></tr>
1.4       albertel 3085: </table>
                   3086: <input type="submit" name="checkoutbutton" value="Validate"  /><br />
1.44      albertel 3087: <table border="1">
                   3088:   <tr><td>
                   3089:     <table>
                   3090:       <tr><td colspan="2">Student who should be logged in is:</td></tr>
                   3091:       <tr><td>Name:</td><td>$name</td></tr>
1.45      albertel 3092:       <tr><td>Student ID:</td><td>$env{'environment.id'}</td></tr>
1.138     albertel 3093:       <tr><td>Usename</td><td>$user:$domain</td></tr>
1.230     albertel 3094:       $url
1.44      albertel 3095:     </table>
                   3096:   </tr></td>
                   3097: </table>
1.4       albertel 3098: </form>
                   3099: ENDCHECKOUT
                   3100:     return $result;
                   3101: }
                   3102: 
1.1       albertel 3103: 1;
                   3104: __END__

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