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

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

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