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

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

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