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

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

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