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

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

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