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

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

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