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

1.1       albertel    1: # The LearningOnline Network with CAPA 
                      2: # definition of tags that give a structure to a document
                      3: #
1.193   ! albertel    4: # $Id: bridgetask.pm,v 1.192 2006/11/06 16:54:46 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 lib '/home/httpd/lib/perl/';
                     42: use LONCAPA;
                     43:  
1.9       albertel   44: 
1.1       albertel   45: BEGIN {
1.186     albertel   46:     &Apache::lonxml::register('Apache::bridgetask',('Task','IntroParagraph','Dimension','Question','QuestionText','Setup','Instance','InstanceText','Criteria','GraderNote','ClosingParagraph'));
1.1       albertel   47: }
                     48: 
1.169     albertel   49: my %dimension;
1.9       albertel   50: sub initialize_bridgetask {
                     51:     # id of current Dimension, 0 means that no dimension is current 
                     52:     # (inside <Task> only)
1.178     albertel   53:     @Apache::bridgetask::dimension=();
1.9       albertel   54:     # list of all Dimension ids seen
1.168     albertel   55:     %Apache::bridgetask::top_dimensionlist=();
1.9       albertel   56:     # list of all current Instance ids
1.168     albertel   57:     %Apache::bridgetask::instance=();
1.9       albertel   58:     # list of all Instance ids seen in this problem
                     59:     @Apache::bridgetask::instancelist=();
1.15      albertel   60:     # key of queud user data that we are currently grading
                     61:     $Apache::bridgetask::queue_key='';
1.169     albertel   62:     undef(%dimension);
1.9       albertel   63: }
                     64: 
1.4       albertel   65: sub proctor_check_auth {
1.81      albertel   66:     my ($slot_name,$slot,$type)=@_;
1.11      albertel   67:     my $user=$env{'form.proctorname'};
                     68:     my $domain=$env{'form.proctordomain'};
1.4       albertel   69:     
                     70:     my @allowed=split(",",$slot->{'proctor'});
                     71:     foreach my $possible (@allowed) {
1.138     albertel   72: 	my ($puser,$pdom)=(split(':',$possible));
1.4       albertel   73: 	if ($puser eq $user && $pdom eq $domain) {
1.72      albertel   74: 	    my $authenticated=0;
                     75: 	    if ( $slot->{'secret'} =~ /\S/ &&
                     76: 		 $env{'form.proctorpassword'} eq $slot->{'secret'} ) {
                     77: 		$authenticated=1;
                     78: 	    } else {
                     79: 		
                     80: 		my $authhost=&Apache::lonnet::authenticate($puser,$env{'form.proctorpassword'},$pdom);
                     81: 		if ($authhost ne 'no_host') {
                     82: 		    $authenticated=1;
                     83: 		}
                     84: 	    }
1.150     albertel   85: 	    if ($authenticated) {
1.176     albertel   86: 		&check_in($type,$user,$domain,$slot_name);
1.4       albertel   87: 		return 1;
                     88: 	    }
                     89: 	}
                     90:     }
                     91:     return 0;
                     92: }
                     93: 
1.174     albertel   94: sub check_in {
                     95:     my ($type,$user,$domain,$slot_name) = @_;
                     96:     my $useslots = &Apache::lonnet::EXT("resource.0.useslots");
                     97:     if ( $useslots eq 'map_map') {
                     98: 	&check_in_sequence($user,$domain,$slot_name);
                     99:     } else {
                    100: 	&create_new_version($type,$user,$domain,$slot_name);
                    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.122     albertel  237:     my $sec_select = '<select multiple="multiple" name="chosensections" size="'.$size.'">'."\n";
1.59      albertel  238:     $sec_select .= "<option value='all' selected='selected'>all</option>\n";
                    239:     foreach my $sec (sort {lc($a) cmp lc($b)} (keys(%sections))) {
1.122     albertel  240: 	$sec_select .= "<option value=\"$sec\">$sec</option>\n";
1.59      albertel  241:     }
                    242:     $sec_select .= "<option value='none'>none</option></select>\n";
                    243:     
1.29      albertel  244:     my $result=' <input type="submit" name="gradeasubmission" value="'.
1.13      albertel  245: 	&mt("Get a submission to grade").'" />';
                    246:     $result.='<input type="hidden" name="grade_target" value="webgrade" />';
1.40      albertel  247:     if (&Apache::lonnet::allowed('mgq',$env{'request.course.id'})) {
1.34      albertel  248: 	my ($entries,$ready,$locks)=&get_queue_counts('gradingqueue');
1.106     albertel  249: 	$result.='<table><tr>';
                    250: 	$result.='<td rowspan="4">Specify a section: </td><td rowspan="4">'.$sec_select.'</td>';
                    251: 	$result.='<td>'.' <input type="submit" name="reviewagrading" value="'.
                    252: 	    &mt("Select an entry from the grading queue:").'" /> ';
1.34      albertel  253: 
1.107     albertel  254: 	$result.= &mt("[_1] entries, [_2] ready, [_3] being graded",$entries,$ready,$locks).' </td></tr>'."\n";
1.34      albertel  255: 
                    256: 	($entries,$ready,$locks)=&get_queue_counts('reviewqueue');
1.106     albertel  257: 	$result.='<tr><td>'.
                    258: 	    ' <input type="submit" name="reviewasubmission" value="'.
                    259: 	    &mt("Select an entry from the review queue:").'" /> ';
                    260: 	$result.=&mt("[_1] entries, [_2] ready, [_3] being graded",
                    261: 		     $entries,$ready,$locks).'</td></tr>'."\n";
                    262: 	$result.='<tr><td> <input type="submit" name="regradeasubmission" value="'.
                    263: 	    &mt("List of user's grade status").'" /> </td></tr></table>'."\n";
1.105     albertel  264: 	$result.='<p> <input type="submit" name="regradeaspecificsubmission" value="'.
1.106     albertel  265: 	    &mt("Regrade specific user:").'" />'."\n";
1.105     albertel  266: 	$result.='<input type="text" size="12" name="gradinguser" />';
                    267: 	$result.=&Apache::loncommon::select_dom_form($env{'user.domain'},
                    268: 						     'gradingdomain');
                    269: 	$result.=' '.
                    270: 	    &Apache::loncommon::selectstudent_link('gradesubmission',
                    271: 						   'gradinguser',
                    272: 						   'gradingdomain');
                    273: 	$result.=&Apache::loncommon::studentbrowser_javascript();
1.123     albertel  274: 	$result.= '</p>';
1.144     albertel  275:     }
1.13      albertel  276:     return $result;
                    277: }
                    278: 
1.22      albertel  279: sub add_request_another_attempt_button {
1.38      albertel  280:     my ($text)=@_;
                    281:     if (!$text) { $text="Request another attempt"; }
1.25      albertel  282:     my $result;
1.36      albertel  283:     my $symb=&Apache::lonnet::symbread();
1.149     albertel  284:     # not a slot access based resource
                    285:     my $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb);
                    286:     if ($useslots =~ /^\s*no\s*$/i) {
                    287: 	return '';
                    288:     }
                    289: 
1.37      albertel  290:     my ($slot_name,$slot)=&Apache::slotrequest::check_for_reservation($symb);
1.38      albertel  291:     my $action='get_reservation';
1.37      albertel  292:     if ($slot_name) {
1.38      albertel  293: 	$text="Change reservation.";
                    294: 	$action='change_reservation';
1.37      albertel  295: 	my $description=&Apache::slotrequest::get_description($slot_name,
                    296: 							      $slot);
                    297: 	$result.=(<<STUFF);
                    298: <p> Will be next available: $description </p>
                    299: STUFF
                    300:     }
1.38      albertel  301:     
                    302:     if ($env{'request.enc'}) { $symb=&Apache::lonenc::encrypted($symb); }
1.158     www       303:     $symb=&escape($symb);
1.115     albertel  304:     $result.='<form method="post" action="/adm/slotrequest">'.
1.38      albertel  305: 	'<input type="hidden" name="symb" value="'.$symb.'" />'.
                    306: 	'<input type="hidden" name="command" value="'.$action.'" />'.
                    307: 	'<input type="submit" name="requestattempt" value="'.
                    308: 	&mt($text).'" />'.
                    309: 	'</form>';
1.25      albertel  310:     return $result;
1.22      albertel  311: }
                    312: 
1.30      albertel  313: sub preserve_grade_info {
                    314:     my $result;
                    315:     # if we are viewing someone else preserve that info
                    316:     if (defined $env{'form.grade_symb'}) {
                    317: 	foreach my $field ('symb','courseid','domain','username') {
                    318: 	    $result .= '<input type="hidden" name="grade_'.$field.
                    319: 		'" value="'.$env{"form.grade_$field"}.'" />'."\n";
                    320: 	}
                    321:     }
                    322:     return $result;
                    323: }
                    324: 
1.53      albertel  325: sub style {
1.125     albertel  326:     my ($target) = @_;
                    327:     if ($target eq 'web'
                    328: 	|| $target eq 'webgrade') {
1.192     albertel  329: 	my $style = (<<STYLE);
1.126     albertel  330: <link rel="stylesheet" type="text/css" href="/res/adm/includes/task.css" />
1.53      albertel  331: STYLE
1.192     albertel  332:         if ($env{'browser.type'} eq 'explorer'
                    333: 	    && $env{'browser.os'} eq 'win' ) {
                    334: 	    if ($env{'browser.version'} < 7) {
                    335: 		$style .= (<<STYLE);
                    336: <link rel="stylesheet" type="text/css" href="/res/adm/includes/task_ie.css" />
                    337: STYLE
                    338:             } else {
                    339: 		$style .= (<<STYLE);
                    340: <link rel="stylesheet" type="text/css" href="/res/adm/includes/task_ie7.css" />
                    341: STYLE
                    342: 	    }
                    343: 	}
1.193   ! albertel  344: 	return $style;
1.125     albertel  345:     }
                    346:     return;
1.53      albertel  347: }
                    348: 
1.54      albertel  349: sub show_task {
                    350:     my ($status,$previous)=@_;
                    351:     if (!$previous && (
                    352: 		       ( $status eq 'CLOSED' ) ||
                    353: 		       ( $status eq 'BANNED') ||
                    354: 		       ( $status eq 'UNAVAILABLE') ||
                    355: 		       ( $status eq 'NOT_IN_A_SLOT') ||
                    356: 		       ( $status eq 'NEEDS_CHECKIN') ||
                    357: 		       ( $status eq 'WAITING_FOR_GRADE') ||
1.150     albertel  358: 		       ( $status eq 'INVALID_ACCESS') ||
                    359: 		       ( &get_version() eq ''))) {
1.54      albertel  360: 	return 0;
                    361:     }
1.64      albertel  362:     if ($env{'form.donescreen'}) { return 0; }
1.54      albertel  363:     return 1;
                    364: }
                    365: 
1.173     albertel  366: my @delay;
                    367: sub nest { 
                    368:     if (@delay) {
                    369: 	return $delay[-1];
                    370:     } else {
                    371: 	return;
                    372:     }
                    373: }
                    374: 
                    375: sub nested_parse {
                    376:     my ($str,$env,$args) = @_;
                    377:     my @old_env = @Apache::scripttag::parser_env;
                    378:     @Apache::scripttag::parser_env = @$env;
                    379:     if (exists($args->{'set_dim_id'})) {
                    380: 	&enable_dimension_parsing($args->{'set_dim_id'});
                    381:     }
                    382:     push(@delay,(($args->{'delayed_dim_results'})? 1 : 0));
                    383:     my $result = &Apache::scripttag::xmlparse($$str);
                    384:     pop(@delay);
                    385:     if (exists($args->{'set_dim_id'})) {
                    386: 	&disable_dimension_parsing();
                    387:     }
                    388:     @Apache::scripttag::parser_env = @old_env;
                    389:     if ($args->{'delayed_dim_results'}) {
                    390: 	my $dim = &get_dim_id();
1.180     albertel  391: 	&Apache::lonxml::debug(" tossing out $result ");
                    392: 	&Apache::lonxml::debug(" usining out $dim 's  ". $dimension{$dim}{'result'});
1.173     albertel  393: 	return $dimension{$dim}{'result'};
                    394:     }
                    395:     return $result;
                    396: }
                    397: 
1.54      albertel  398: sub internal_location {
                    399:     my ($id)=@_;
                    400:     return '<!-- LONCAPA_INTERNAL_ADD_TASK_STATUS'.$id.' -->';
                    401: }
                    402: 
1.60      albertel  403: sub submission_time_stamp {
1.185     albertel  404:     my ($symb,$courseid,$udom,$uname)=&Apache::lonnet::whichuser();
1.60      albertel  405:     my $submissiontime;
1.89      albertel  406:     my $version=$Apache::lonhomework::history{'resource.0.version'};
1.60      albertel  407:     for (my $v=$Apache::lonhomework::history{'version'};$v>0;$v--) {
1.183     albertel  408: 	if (defined($Apache::lonhomework::history{$v.':resource.'.$version.'.0.bridgetask.portfiles'})
                    409: 	    && defined($Apache::lonhomework::history{$v.':resource.'.$version.'.0.tries'})) {
1.60      albertel  410: 	    $submissiontime=$Apache::lonhomework::history{$v.':timestamp'};
1.182     albertel  411: 	    last;
1.60      albertel  412: 	}
                    413:     }
                    414:     my $result;
                    415:     if ($submissiontime) {
1.89      albertel  416: 	my $slot_name=$Apache::lonhomework::history{'resource.'.$version.'.0.checkedin.slot'};
1.60      albertel  417: 	my %slot=&Apache::lonnet::get_slot($slot_name);
                    418: 	my $diff = $slot{'endtime'} - $submissiontime;
1.71      albertel  419: 	my ($color,$when)=('#FF6666','after');
                    420: 	if ($diff > 0) { ($color,$when)=('#336600','before'); }
1.60      albertel  421: 	my $info;
1.182     albertel  422: 	$diff = abs($diff);
1.60      albertel  423: 	if ($diff%60) { $info=($diff%60).' seconds'; }
                    424: 	$diff=int($diff/60);
                    425: 	if ($diff%60) { $info=($diff%60).' minutes '.$info; }
                    426: 	$diff=int($diff/60);
                    427: 	if ($diff) {    $info=$diff.' hours '.$info; }
                    428: 	$result='<p><font color="'.$color.'">'.
1.182     albertel  429: 	    &mt('Student submitted [_1] [_2] the deadline. '.
                    430: 		'(Submission was at [_3], end of period was [_4].)',
                    431: 		$info,$when,
                    432: 		&Apache::lonlocal::locallocaltime($submissiontime),
                    433: 		&Apache::lonlocal::locallocaltime($slot{'endtime'})).
1.60      albertel  434: 		'</font></p>';
                    435:     }
                    436:     return $result;
                    437: }
                    438: 
1.119     albertel  439: sub file_list {
                    440:     my ($files,$uname,$udom) = @_;
                    441:     if (!defined($uname) || !defined($udom)) {
1.185     albertel  442: 	(undef,undef,$udom,$uname) = &Apache::lonnet::whichuser();
1.119     albertel  443:     }
1.70      albertel  444:     my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio/';
1.119     albertel  445: 
1.120     albertel  446:     my $file_list="<ul class=\"LC_GRADING_handininfo\">\n";
1.119     albertel  447:     foreach my $partial_file (split(',',$files)) {
1.70      albertel  448: 	my $file=$file_url.$partial_file;
                    449: 	$file=~s|/+|/|g;
                    450: 	&Apache::lonnet::allowuploaded('/adm/bridgetask',$file);
1.161     albertel  451: 	$file_list.='<li><span style="white-space: nowrap;"><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.
                    452: 	    &Apache::loncommon::icon($file).'" alt="file icon" border="0" /> '.$file.
                    453: 	    '</a></span></li>'."\n";
1.70      albertel  454:     }
                    455:     $file_list.="</ul>\n";
1.119     albertel  456:     return $file_list;
                    457: }
                    458: 
1.163     albertel  459: sub grade_mode {
                    460:     if ($env{'form.regrade'} || $env{'form.regradeaspecificsubmission'}) {
                    461: 	return 'regrade';
                    462:     }
                    463:     return 'queue_grade';
                    464: }
                    465: 
1.119     albertel  466: sub webgrade_standard_info {
                    467:     my ($version)=&get_version();
                    468: 
                    469:     my $file_list = &file_list($Apache::lonhomework::history{"resource.$version.0.bridgetask.portfiles"});
1.70      albertel  470: 
1.163     albertel  471:     my %lt=('done'   => 'Next Item',
                    472: 	    'stop'   => 'Quit Grading',
                    473: 	    'fail'   => 'Fail Rest',
                    474: 	    'cancel' => 'Cancel',
                    475: 	    );
1.170     albertel  476:     %lt=&Apache::lonlocal::texthash(%lt);
1.163     albertel  477: 
1.70      albertel  478:     my $result=<<INFO;
1.120     albertel  479:   <div class="LC_GRADING_maincontrols">
1.163     albertel  480: INFO
                    481: 
                    482:     if (&grade_mode() eq 'regrade') {
                    483: 	$result.=<<INFO;
                    484:     <input type="submit" name="cancel" value="$lt{'cancel'}" />
                    485: INFO
                    486:     }
                    487: 
                    488:     $result.=<<INFO;
1.111     albertel  489:     <input type="submit" name="next" value="$lt{'done'}" />
                    490:     <input type="submit" name="stop" value="$lt{'stop'}" />
1.143     albertel  491:     <input type="button" name="fail" value="$lt{'fail'}" 
                    492:            onclick="javascript:onFailRest()" />
1.111     albertel  493:   </div>
1.70      albertel  494:   $file_list
                    495: INFO
                    496:     return $result;
                    497: }
                    498: 
1.166     albertel  499: sub done_screen {
                    500:     my ($version) = @_;
                    501:     my $title=&Apache::lonnet::gettitle();
                    502:     my @files=split(',',$Apache::lonhomework::history{'resource.'.$version.'.0.bridgetask.portfiles'});
1.185     albertel  503:     my (undef,undef,$domain,$user)= &Apache::lonnet::whichuser();
1.166     albertel  504:     my $files = '<ul>';
1.167     albertel  505:     my $msg;
1.166     albertel  506:     foreach my $file (@files) {
                    507: 	my $url="/uploaded/$domain/$user/portfolio$file";
                    508: 	if (! &Apache::lonnet::stat_file($url)) {
                    509: 	    $file = &mt('<span class="LC_error"> Nonexistent file:</span> '.
                    510: 			'<span class="LC_filename">[_1]</span>',$file);
1.167     albertel  511: 	    $msg .= "<p>Submitted non-existant file $file</p>\n";
1.166     albertel  512: 	} else {
                    513: 	    $file = '<span class="LC_filename">'.$file.'</span>';
1.167     albertel  514: 	    $msg .= "<p>Submitted file $file</p>\n";
1.166     albertel  515: 	}
                    516: 	$files .= '<li>'.$file.'</li>';
                    517:     }
                    518:     $files.='</ul>';
1.167     albertel  519:     my $subject = "Submission message for $title";
                    520:     my ($message_status,$comment_status);
                    521:     my $setting = $env{'course.'.$env{'request.course.id'}.'.task_messages'};
                    522:     $setting =~ s/^\s*(\S*)\s*$/$1/;
                    523:     $setting = lc($setting);
                    524:     if ($setting eq 'only_student'
                    525: 	|| $setting eq 'student_and_user_notes_screen') {
                    526: 	$message_status =
                    527: 	    &Apache::lonmsg::user_normal_msg($user,$domain,$subject,$msg);
                    528: 	$message_status = '<p>'.&mt('Message sent to user: [_1]',
                    529: 				    $message_status).' </p>';
                    530:     }
                    531:     if ($setting eq 'student_and_user_notes_screen') {
                    532: 	$comment_status = 
                    533: 	    &Apache::lonmsg::store_instructor_comment($subject.'<br />'.
                    534: 						      $msg,$user,$domain);
                    535: 	$comment_status = '<p>'.&mt('Message sent to instructor: [_1]',
                    536: 				    $comment_status).' </p>';
                    537:     }
1.166     albertel  538:     return <<DONESCREEN;
                    539: <h2>$title</h2>
                    540: <p> Files submitted: $files </p>
                    541: <p> You are now done with this Bridge Task </p>
                    542: <hr />
                    543: <p> <a href="/adm/logout">Logout</a> </p>
                    544: <p> <a href="/adm/roles">Change to a different course</a> </p>
1.167     albertel  545: $message_status
                    546: $comment_status
1.166     albertel  547: DONESCREEN
                    548: 
                    549: }
                    550: 
1.1       albertel  551: sub start_Task {
1.87      albertel  552:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel  553: 
1.4       albertel  554:     my ($status,$accessmsg,$slot);
1.179     albertel  555:     &Apache::structuretags::init_problem_globals('Task');
1.16      albertel  556:     if ($target ne 'webgrade') {
                    557: 	&Apache::structuretags::initialize_storage();
                    558: 	&Apache::lonhomework::showhash(%Apache::lonhomework::history);
1.74      albertel  559: 	if ($env{'request.state'} eq 'construct') {
                    560: 	    &Apache::structuretags::setup_rndseed($safeeval);
                    561: 	}
1.16      albertel  562:     } 
                    563: 
1.4       albertel  564:     $Apache::lonhomework::parsing_a_task=1;
1.141     albertel  565: 
                    566:     my $name;
                    567:     if ($target eq 'web' || $target eq 'webgrade') {
                    568: 	$name = &Apache::structuretags::get_resource_name($parstack,$safeeval);
                    569:     }
                    570: 
1.145     albertel  571:     my ($result,$form_tag_start);
                    572:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'tex'
                    573: 	|| $target eq 'edit') {
                    574: 	($result,$form_tag_start) =
                    575: 	    &Apache::structuretags::page_start($target,$token,$tagstack,
                    576: 					       $parstack,$parser,$safeeval,
1.146     albertel  577: 					       $name,&style($target));
1.145     albertel  578: 	$result .= '<div class="LC_task">'."\n";
                    579:     }
1.123     albertel  580: 
1.74      albertel  581:     if ($target eq 'web' && $env{'request.state'} ne 'construct') {
1.147     albertel  582: 	if ($Apache::lonhomework::queuegrade
                    583: 	    || $Apache::lonhomework::modifygrades) {
1.141     albertel  584: 	    $result.='<form name="gradesubmission" method="post" action="';
1.13      albertel  585: 	    my $uri=$env{'request.uri'};
                    586: 	    if ($env{'request.enc'}) { $uri=&Apache::lonenc::encrypted($uri); }
1.141     albertel  587: 	    $result.=$uri.'">'.&add_grading_button()."</form>";
1.38      albertel  588: 	    my $symb=&Apache::lonnet::symbread();
1.40      albertel  589: 	    if (&Apache::lonnet::allowed('mgq',$env{'request.course.id'})) {
1.141     albertel  590: 		$result.='<form method="post" name="slotrequest" action="/adm/slotrequest">'.
1.40      albertel  591: 		    '<input type="hidden" name="symb" value="'.$symb.'" />'.
                    592: 		    '<input type="hidden" name="command" value="showslots" />'.
                    593: 		    '<input type="submit" name="requestattempt" value="'.
                    594: 		    &mt('Show Slot list').'" />'.
                    595: 		    '</form>';
1.108     albertel  596: 		my $target_id = 
                    597: 		    &Apache::lonstathelpers::make_target_id({symb => $symb,
                    598: 							     part => '0'});
1.141     albertel  599: 		$result.='<form method="post" name="gradingstatus" action="/adm/statistics">'.
1.108     albertel  600: 		    '<input type="hidden" name="problemchoice" value="'.$target_id.'" />'.
                    601: 		    '<input type="hidden" name="reportSelected" value="grading_analysis" />'.
                    602: 		    '<input type="submit" name="grading" value="'.
                    603: 		    &mt('Show Grading Status').'" />'.
                    604: 		    '</form>';
1.40      albertel  605: 	    }
1.13      albertel  606: 	}
1.8       albertel  607:     }
1.74      albertel  608:     if ($target eq 'web' && $env{'request.state'} eq 'construct') {
                    609: 	$form_tag_start.=&Apache::structuretags::problem_web_to_edit_header($env{'form.rndseed'});
                    610:     }
1.163     albertel  611:     if ($target eq 'web' 
                    612: 	|| ($target eq 'grade' && !$env{'form.webgrade'}) 
                    613: 	|| $target eq 'answer' 
                    614: 	|| $target eq 'tex') {
1.29      albertel  615: 	my ($version,$previous)=&get_version();
1.14      albertel  616: 	($status,$accessmsg,my $slot_name,$slot) = 
1.81      albertel  617: 	    &Apache::lonhomework::check_slot_access('0','Task');
1.152     albertel  618: 	if ($status eq 'CAN_ANSWER' && $version eq '') {
1.177     albertel  619: 	    # CAN_ANSWER mode, and no current version, unproctored access
1.174     albertel  620: 	    # thus self-checkedin
1.177     albertel  621: 	    &check_in('Task',undef,undef,$slot_name);
1.152     albertel  622: 	    &add_to_queue('gradingqueue',{'type' => 'Task',
                    623: 					  'time' => time,
                    624: 					  'slot' => $slot_name});
1.150     albertel  625: 	    ($version,$previous)=&get_version();
                    626: 	}
                    627: 
1.9       albertel  628: 	push(@Apache::inputtags::status,$status);
1.14      albertel  629: 	$Apache::inputtags::slot_name=$slot_name;
1.1       albertel  630: 	my $expression='$external::datestatus="'.$status.'";';
1.89      albertel  631: 	$expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.$version.0.solved"}.'";';
1.1       albertel  632: 	&Apache::run::run($expression,$safeeval);
                    633: 	&Apache::lonxml::debug("Got $status");
1.141     albertel  634: 	$result.=&add_previous_version_button($status);
1.54      albertel  635: 	if (!&show_task($status,$previous)) {
1.87      albertel  636: 	    my $bodytext=&Apache::lonxml::get_all_text("/task",$parser,$style);
1.1       albertel  637: 	    if ( $target eq "web" ) {
1.74      albertel  638: 		if ($env{'request.state'} eq 'construct') {
                    639: 		    $result.=$form_tag_start;
                    640: 		}
1.4       albertel  641: 		my $msg;
1.1       albertel  642: 		if ($status eq 'UNAVAILABLE') {
                    643: 		    $msg.='<h1>'.&mt('Unable to determine if this resource is open due to network problems. Please try again later.').'</h1>';
1.3       albertel  644: 		} elsif ($status eq 'NOT_IN_A_SLOT') {
                    645: 		    $msg.='<h1>'.&mt('You are not currently signed up to work at this time and/or place.').'</h1>';
1.38      albertel  646: 		    $msg.=&add_request_another_attempt_button("Sign up for time to work.");
1.4       albertel  647: 		} elsif ($status eq 'NEEDS_CHECKIN') {
                    648: 		    $msg.='<h1>'.&mt('You need the Proctor to validate you.').
                    649: 			'</h1>'.&proctor_validation_screen($slot);
1.22      albertel  650: 		} elsif ($status eq 'WAITING_FOR_GRADE') {
                    651: 		    $msg.='<h1>'.&mt('Your submission is in the grading queue.').'</h1>';
1.64      albertel  652: 		} elsif ($env{'form.donescreen'}) {
1.167     albertel  653: 		    $result .= &done_screen($version);
1.1       albertel  654: 		} elsif ($status ne 'NOT_YET_VIEWED') {
                    655: 		    $msg.='<h1>'.&mt('Not open to be viewed').'</h1>';
                    656: 		}
                    657: 		if ($status eq 'CLOSED' || $status eq 'INVALID_ACCESS') {
                    658: 		    $msg.='The problem '.$accessmsg;
                    659: 		}
                    660: 		$result.=$msg.'<br />';
                    661: 	    } elsif ($target eq 'tex') {
                    662: 		$result.='\begin{document}\noindent \vskip 1 mm  \begin{minipage}{\textwidth}\vskip 0 mm';
                    663: 		if ($status eq 'UNAVAILABLE') {
                    664: 		    $result.=&mt('Unable to determine if this resource is open due to network problems. Please try again later.').'\vskip 0 mm ';
                    665: 		} else {
                    666: 		    $result.=&mt('Problem is not open to be viewed. It')." $accessmsg \\vskip 0 mm ";
                    667: 		}
1.22      albertel  668: 	    } elsif ($target eq 'grade' && !$env{'form.webgrade'}) {
1.4       albertel  669: 		if ($status eq 'NEEDS_CHECKIN') {
1.83      albertel  670: 		    if(&proctor_check_auth($slot_name,$slot,'Task')
                    671: 		       && defined($Apache::inputtags::slot_name)) {
1.148     albertel  672: 			my $result=
                    673: 			    &add_to_queue('gradingqueue',
1.152     albertel  674: 					  {'type' => 'Task',
1.148     albertel  675: 					   'time' => time,
                    676: 					   'slot' => 
                    677: 					       $Apache::inputtags::slot_name});
1.77      albertel  678: 			&Apache::lonxml::debug("add_to_queue said $result");
                    679: 		    }
1.4       albertel  680: 		}
1.1       albertel  681: 	    }
                    682: 	} elsif ($target eq 'web') {
1.141     albertel  683: 
1.57      albertel  684: 	    $result.=&preserve_grade_info();
                    685: 	    $result.=&internal_location();
1.36      albertel  686: 	    $result.=$form_tag_start.
                    687: 		'<input type="hidden" name="submitted" value="yes" />';
1.54      albertel  688: 	    &Apache::lonxml::startredirection();
1.1       albertel  689: 	}
1.21      albertel  690:     } elsif ( ($target eq 'grade' && $env{'form.webgrade'}) ||
                    691: 	      $target eq 'webgrade') {
1.32      albertel  692: 	my $webgrade='yes';
1.21      albertel  693: 	if ($target eq 'webgrade') {
1.141     albertel  694: 	    $result.= "\n".'<div class="LC_GRADING_task">'."\n".
1.124     albertel  695: 		'<script type="text/javascript" 
1.126     albertel  696:                          src="/res/adm/includes/task_grading.js"></script>';
1.49      albertel  697: 	    #$result.='<br />Review'.&show_queue('reviewqueue');
                    698: 	    #$result.='<br />Grade'.&show_queue('gradingqueue');
1.30      albertel  699: 	}
1.33      albertel  700: 	# FIXME Blast! still need to reorg this, need to reshow the
                    701:         #       queue being reviewed once done with the grade pass...
                    702:         #       Hrrm, vaildation pass should perhaps say 'not_locked'
                    703:         #       perhaps do a search if there is a key that is mine and if
                    704:         #       there isn't reshow the queue....
1.105     albertel  705: 	my ($todo,$status_code,$msg)=&get_key_todo($target);
1.33      albertel  706: 
                    707: 	if ($todo) {
                    708: 	    &setup_env_for_other_user($todo,$safeeval);
                    709: 	    my ($symb,$uname,$udom)=&decode_queue_key($todo);
                    710: 	    $result.="\n".'<table><tr><td>Found '.
                    711: 		&Apache::lonnet::gettitle($symb).' for '.$uname.' at '.$udom.'</td></tr></table>';
                    712: 	    $form_tag_start.=
                    713: 		'<input type="hidden" name="gradingkey" value="'.
1.158     www       714: 		&escape($todo).'" />';
1.33      albertel  715: 	    $Apache::bridgetask::queue_key=$todo;
                    716: 	    &Apache::structuretags::initialize_storage();
                    717: 	    &Apache::lonhomework::showhash(%Apache::lonhomework::history);
1.110     albertel  718: 	    if ($target eq 'webgrade' && $status_code eq 'selected') {
                    719: 		$form_tag_start.=
                    720: 		    '<input type="hidden" name="queuemode" value="selected" />';
1.33      albertel  721: 	    }
1.15      albertel  722: 	} else {
1.33      albertel  723: 	    if ($target eq 'webgrade') {
                    724: 		$result.="\n";
1.81      albertel  725: 		my $back='<p><a href="/adm/flip?postdata=return:">'.
                    726: 		    &mt('Return to resource').'</a></p>';
1.33      albertel  727: 		if      ($status_code eq 'stop') {
1.81      albertel  728: 		    $result.='<b>'.&mt("Stopped grading.").'</b>'.$back;
1.163     albertel  729: 		} elsif ($status_code eq 'cancel') {
                    730: 		    $result.='<b>'.&mt("Cancelled grading.").'</b>'.$back;
1.164     albertel  731: 		} elsif ($status_code eq 'never_versioned') {
                    732: 		    $result.='<b>'.
                    733: 			&mt("Requested user has never accessed the task.").
                    734: 			'</b>'.$back;
1.165     albertel  735: 		} elsif ($status_code =~ /still_open:(.*)/) {
                    736: 		    my $date = &Apache::lonlocal::locallocaltime($1);
                    737: 		    $result.='<b>'.
                    738: 			&mt("Task is still open, will close at [_1].",$date).
                    739: 			'</b>'.$back;
1.33      albertel  740: 		} elsif ($status_code eq 'lock_failed') {
1.105     albertel  741: 		    $result.='<b>'.&mt("Failed to lock the requested record.")
1.81      albertel  742: 			.'</b>'.$back;
1.33      albertel  743: 		} elsif ($status_code eq 'unlock') {
1.81      albertel  744: 		    $result.='<b>'.&mt("Unlocked the requested record.")
                    745: 			.'</b>'.$back;
1.33      albertel  746: 		    $result.=&show_queue($env{'form.queue'},1);
                    747: 		} elsif ($status_code eq 'show_list') {
                    748: 		    $result.=&show_queue($env{'form.queue'},1);
1.49      albertel  749: 		} elsif ($status_code eq 'select_user') {
                    750: 		    $result.=&select_user();
1.95      albertel  751: 		} elsif ($status_code eq 'unable') {
                    752: 		    $result.='<b>'.&mt("Unable to aqcuire a user to grade.").'</b>'.$back;
1.105     albertel  753: 		} elsif ($status_code eq 'not_allowed') {
                    754: 		    $result.='<b>'.&mt('Not allowed to grade the requested user.').' '.$msg.'</b>'.$back;
1.33      albertel  755: 		} else {
1.81      albertel  756: 		    $result.='<b>'.&mt("No user to be graded.").'</b>'.$back;
1.32      albertel  757: 		}
1.21      albertel  758: 	    }
1.33      albertel  759: 	    $webgrade='no';
1.163     albertel  760: 	}
                    761: 	if (!$todo || $env{'form.cancel'}) {
1.87      albertel  762: 	    my $bodytext=&Apache::lonxml::get_all_text("/task",$parser,$style);
1.32      albertel  763: 	}
                    764: 	if ($target eq 'webgrade' && defined($env{'form.queue'})) {
1.61      albertel  765: 	    if ($webgrade eq 'yes') {
                    766: 		$result.=&submission_time_stamp();
                    767: 	    }
1.32      albertel  768: 	    $result.=$form_tag_start;
                    769: 	    $result.='<input type="hidden" name="webgrade" value="'.
                    770: 		$webgrade.'" />';
                    771: 	    $result.='<input type="hidden" name="queue" value="'.
                    772: 		$env{'form.queue'}.'" />';
1.52      albertel  773: 	    if ($env{'form.regrade'}) {
                    774: 		$result.='<input type="hidden" name="regrade" value="'.
                    775: 		    $env{'form.regrade'}.'" />';
                    776: 	    }
1.62      albertel  777: 	    if ($env{'form.chosensections'}) {
                    778: 		my @chosen_sections=
                    779: 		    &Apache::loncommon::get_env_multiple('form.chosensections');
                    780: 		foreach my $sec (@chosen_sections) {
                    781: 		    $result.='<input type="hidden" name="chosensections" 
                    782:                                value="'.$sec.'" />';
                    783: 		}
                    784: 	    }
1.70      albertel  785: 	    if ($webgrade eq 'yes') { $result.=&webgrade_standard_info(); }
1.15      albertel  786: 	}
1.110     albertel  787: 	if ($target eq 'webgrade') {
1.120     albertel  788: 	    $result.="\n".'<div id="LC_GRADING_criterialist">';
1.110     albertel  789: 	}
1.74      albertel  790:     } elsif ($target eq 'edit') {
1.141     albertel  791: 	$result.=$form_tag_start.
1.74      albertel  792: 	    &Apache::structuretags::problem_edit_header();
                    793: 	$Apache::lonxml::warnings_error_header=
                    794: 	    &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 />";
                    795: 	my $temp=&Apache::edit::insertlist($target,$token);
                    796: 	$result.=$temp;
1.1       albertel  797:     } else {
                    798: 	# page_start returned a starting result, delete it if we don't need it
                    799: 	$result = '';
                    800:     }
                    801:     return $result;
                    802: }
                    803: 
1.165     albertel  804: sub get_task_end_time {
                    805:     my ($queue_entry,$symb,$udom,$uname) = @_;
                    806: 
                    807:     my $end_time;
                    808:     if (my $slot = &slotted_access($queue_entry)) {
                    809: 	my %slot_data=&Apache::lonnet::get_slot($slot);
                    810: 	$end_time = $slot_data{'endtime'};
                    811:     } else {
                    812: 	$end_time = &Apache::lonhomework::due_date('0',$symb,
                    813: 						   $udom,$uname);
                    814:     }
                    815:     return $end_time;
                    816: }
                    817: 
1.32      albertel  818: sub get_key_todo {
                    819:     my ($target)=@_;
                    820:     my $todo;
1.33      albertel  821: 
                    822:     if (defined($env{'form.reviewasubmission'})) {
1.54      albertel  823: 	&Apache::lonxml::debug("review a submission....");
1.33      albertel  824: 	$env{'form.queue'}='reviewqueue';
                    825: 	return (undef,'show_list');
                    826:     }
                    827: 
                    828:     if (defined($env{'form.reviewagrading'})) {
                    829: 	&Apache::lonxml::debug("review a grading....");
                    830: 	$env{'form.queue'}='gradingqueue';
                    831: 	return (undef,'show_list');
                    832:     }
                    833: 
1.49      albertel  834:     if (defined($env{'form.regradeasubmission'})) {
                    835: 	&Apache::lonxml::debug("regrade a grading....");
                    836: 	$env{'form.queue'}='none';
                    837: 	return (undef,'select_user');
                    838:     }
                    839: 
1.105     albertel  840: 
1.138     albertel  841:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.105     albertel  842: 
                    843:     #need to try both queues..
                    844:     if (defined($env{'form.regradeaspecificsubmission'}) &&
                    845: 	defined($env{'form.gradinguser'})               &&
                    846: 	defined($env{'form.gradingdomain'})               ) {
1.185     albertel  847: 	my ($symb,$cid)=&Apache::lonnet::whichuser();
1.105     albertel  848: 	my $cnum  = $env{'course.'.$cid.'.num'};
                    849: 	my $cdom  = $env{'course.'.$cid.'.domain'};
                    850: 	my $uname = $env{'form.gradinguser'};
                    851: 	my $udom  = $env{'form.gradingdomain'};
                    852: 
                    853: 	my $gradingkey=&encode_queue_key($symb,$udom,$uname);
                    854: 
                    855: 	my $queue;
                    856: 
                    857: 	if      (&in_queue('gradingqueue',$symb,$cdom,$cnum,$udom,$uname)) {
                    858: 	    $env{'form.queue'} = $queue = 'gradingqueue';
                    859: 	} elsif (&in_queue('reviewqueue' ,$symb,$cdom,$cnum,$udom,$uname)) {
                    860: 	    $env{'form.queue'} = $queue = 'reviewqueue';
                    861: 	}
                    862: 	
                    863: 	if (!$queue) {
                    864: 	    $env{'form.queue'} = $queue = 'none';
                    865: 	    #not queued so doing either a re or pre grade
1.164     albertel  866: 	    my %status = &Apache::lonnet::restore($symb,$cid,$udom,$uname);
                    867: 	    if ($status{'resource.0.version'} < 1) {
                    868: 		return (undef,'never_versioned');
                    869: 	    }
1.105     albertel  870: 	    return ($gradingkey);
                    871: 	}
                    872: 
1.165     albertel  873: 	if ($queue) {
                    874: 	    my $queue_entry = &get_queue_data($queue,$udom,$uname);
                    875: 	
                    876: 	    my $end_time = &get_task_end_time($queue_entry,$symb,
                    877: 					      $udom,$uname);
                    878: 	    if ($end_time > time) {
                    879: 		return (undef,"still_open:$end_time");
                    880: 	    }
                    881: 	}
                    882: 
1.105     albertel  883: 	my $who=&queue_key_locked($queue,$gradingkey);
                    884: 	if ($who eq $me) {
                    885: 	    #already have the lock
1.158     www       886: 	    $env{'form.gradingkey'}=&escape($gradingkey);
1.163     albertel  887: 	    &Apache::lonxml::debug("already locked");
1.105     albertel  888: 	    return ($gradingkey);
                    889: 	}
                    890: 	
                    891: 	if (!defined($who)) {
                    892: 	    if (&lock_key($queue,$gradingkey)) {
1.163     albertel  893: 		&Apache::lonxml::debug("newly locked");
1.105     albertel  894: 		return ($gradingkey);
                    895: 	    } else {
                    896: 		return (undef,'lock_failed');
                    897: 	    }
                    898: 	}
                    899: 
                    900: 	#otherwise (defined($who) && $who ne $me) some else has it...
                    901: 	return (undef,'not_allowed',
                    902: 		&mt('Another user ([_1]) currently has the record for [_2] locked.',
1.138     albertel  903: 		    $who,$env{'form.gradinguser'}.':'.$env{'form.gradingdomain'}));
1.105     albertel  904:     }
                    905: 
                    906: 
1.32      albertel  907:     my $queue=$env{'form.queue'};
1.33      albertel  908: 
1.32      albertel  909:     if (!defined($queue)) {
                    910: 	$env{'form.queue'}=$queue='gradingqueue';
                    911:     }
1.33      albertel  912: 
1.158     www       913:     my $gradingkey=&unescape($env{'form.gradingkey'});
1.33      albertel  914: 
1.49      albertel  915:     if ($env{'form.queue'} eq 'none') {
                    916: 	if (defined($env{'form.gradingkey'})) {
                    917: 	    if ($target eq 'webgrade') {
                    918: 		if ($env{'form.stop'}) {
                    919: 		    return (undef,'stop');
1.163     albertel  920: 		} elsif ($env{'form.cancel'}) {
                    921: 		    return (undef,'cancel');
1.49      albertel  922: 		} elsif ($env{'form.next'}) {
1.59      albertel  923: 		    return (undef,'select_user');
1.49      albertel  924: 		}
                    925: 	    }
                    926: 	    return ($gradingkey,'selected');
                    927: 	} else {
1.59      albertel  928: 	    return (undef,'select_user');
1.49      albertel  929: 	}
                    930:     }
1.32      albertel  931:     if (defined($env{'form.queue'}) && defined($env{'form.gradingkey'})
1.33      albertel  932: 	&& !defined($env{'form.gradingaction'}) 
                    933: 	&& $env{'form.queuemode'} eq 'selected') {
                    934: 	
                    935: 	my $who=&queue_key_locked($queue,$gradingkey);
                    936: 	if ($who eq $me) {
                    937: 	    &Apache::lonxml::debug("Found a key was given to me");
                    938: 	    return ($gradingkey,'selected');
                    939: 	} else {
                    940: 	    return (undef,'show_list');
                    941: 	}
                    942: 
                    943:     }
                    944: 
                    945:     if ($target eq 'webgrade' && $env{'form.queuemode'} eq 'selected') {
                    946: 	if ($env{'form.gradingaction'} eq 'resume') {
                    947: 	    delete($env{'form.gradingaction'});
                    948: 	    &Apache::lonxml::debug("Resuming a key");
1.32      albertel  949: 	    return ($gradingkey);
1.33      albertel  950: 	} elsif ($env{'form.gradingaction'} eq 'unlock') {
                    951: 	    &Apache::lonxml::debug("Unlocking a key ".
                    952: 				     &check_queue_unlock($queue,$gradingkey,1));
                    953: 	    return (undef,'unlock');
                    954: 	} elsif ($env{'form.gradingaction'} eq 'select') {
                    955: 	    &Apache::lonxml::debug("Locking a key");
                    956: 	    if (&lock_key($queue,$gradingkey)) {
                    957: 		&Apache::lonxml::debug("Success $queue");
                    958: 		return ($gradingkey);
                    959: 	    }
                    960: 	    &Apache::lonxml::debug("Failed $queue");
                    961: 	    return (undef,'lock_failed');
1.32      albertel  962: 	}
                    963:     }
1.33      albertel  964: 
                    965:     if ($env{'form.queuemode'} ne 'selected') {
                    966: 	# don't get something new from the queue if they hit the stop button
1.163     albertel  967:     	if (!(($env{'form.cancel'} || $env{'form.stop'}) 
                    968: 	      && $target eq 'webgrade') 
1.33      albertel  969: 	    && !$env{'form.gradingaction'}) {
                    970: 	    &Apache::lonxml::debug("Getting anew $queue");
                    971: 	    return (&get_from_queue($queue));
                    972: 	} else {
                    973: 	    return (undef,'stop');
                    974: 	}
1.32      albertel  975:     }
1.33      albertel  976:     return (undef,undef)
1.32      albertel  977: }
1.94      albertel  978: 
                    979: sub minimize_storage {
                    980:     foreach my $key (keys(%Apache::lonhomework::results)) {
                    981: 	if ($key =~ /regrader$/) { next; }
                    982: 	if ($Apache::lonhomework::results{$key} eq
                    983: 	    $Apache::lonhomework::history{$key}) {
                    984: 	    delete($Apache::lonhomework::results{$key});
                    985: 	}
                    986:     }
                    987: }
                    988: 
1.1       albertel  989: sub end_Task {
                    990:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                    991:     my $result='';
                    992:     my $status=$Apache::inputtags::status['-1'];
1.29      albertel  993:     my ($version,$previous)=&get_version();
1.1       albertel  994:     if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' ||
1.15      albertel  995: 	$target eq 'tex') {
1.69      albertel  996: 	if ($target eq 'web' || $target eq 'answer' || $target eq 'tex') {
1.1       albertel  997: 	    if ($target eq 'web') {
1.54      albertel  998: 		if (&show_task($status,$previous)) {
                    999: 		    $result.=&Apache::lonxml::endredirection();
                   1000: 		}
1.64      albertel 1001: 		if ($status eq 'CAN_ANSWER' && !$previous && 
                   1002: 		    !$env{'form.donescreen'}) {
1.15      albertel 1003: 		    $result.="\n".'<table border="1">'.
1.28      albertel 1004: 			&Apache::inputtags::file_selector("$version.0",
                   1005: 							  "bridgetask","*",
1.46      albertel 1006: 							  'portfolioonly',
                   1007: 							  '
                   1008: <h2>'.&mt('Submit Portfolio Files for Grading').'</h2>
                   1009: <p>'.&mt('Indicate the files from your portfolio to be evaluated in grading this task.').'</p>').
1.9       albertel 1010: 							  "</table>";
1.77      albertel 1011: 		}
1.78      albertel 1012: 		if (!$previous && $status ne 'SHOW_ANSWER' &&
                   1013: 		    &show_task($status,$previous)) {
1.9       albertel 1014: 		    $result.=&Apache::inputtags::gradestatus('0');
1.64      albertel 1015: 		    $result.='</form>';
1.116     albertel 1016: 		    my $action = &Apache::lonenc::check_encrypt($env{'request.uri'});
1.64      albertel 1017: 		    $result.=<<DONEBUTTON;
1.115     albertel 1018: <form name="done" method="post" action="$action">
1.64      albertel 1019:    <input type="hidden" name="donescreen" value="1" />
                   1020:    <input type="submit" value="Done" />
                   1021: </form>
                   1022: DONEBUTTON
1.77      albertel 1023:                 }
1.56      albertel 1024: 		if (&show_task($status,$previous) &&
1.89      albertel 1025: 		    $Apache::lonhomework::history{"resource.$version.0.status"} =~ /^(pass|fail)$/) {
                   1026: 		    my $bt_status=$Apache::lonhomework::history{"resource.$version.0.status"};
1.54      albertel 1027: 		    my $title=&Apache::lonnet::gettitle();
1.80      albertel 1028: 
1.149     albertel 1029: 		    my $start_time;
                   1030: 
1.80      albertel 1031: 		    my $slot_name=
1.89      albertel 1032: 			$Apache::lonhomework::history{"resource.$version.0.checkedin.slot"};
1.149     albertel 1033: 		    if ($slot_name) {
                   1034: 			my %slot=&Apache::lonnet::get_slot($slot_name);
                   1035: 
                   1036: 			$start_time=$slot{'starttime'}
                   1037: 		    } else {
                   1038: 			$start_time= 
                   1039: 			    &Apache::lonnet::EXT('resource.0.opendate');
                   1040: 		    }
                   1041: 		    $start_time=&Apache::lonlocal::locallocaltime($start_time);
1.54      albertel 1042: 
1.116     albertel 1043: 		    my $status = "\n<div class='LC_$bt_status LC_criteria'>\n";
1.54      albertel 1044: 		    
                   1045: 		    if ($bt_status eq 'pass')  {
                   1046: 			$status.='<h2>You passed the '.$title.' given on '.
1.80      albertel 1047: 			    $start_time.'</h2>';
1.54      albertel 1048: 		    }
                   1049: 		    if ($bt_status eq 'fail')  {
                   1050: 			$status.='<h2>You did not pass the '.$title.' given on '.
1.80      albertel 1051: 			    $start_time.'</h2>';
1.54      albertel 1052: 			if (!$previous) {
                   1053: 			    $status.=&add_request_another_attempt_button();
                   1054: 			}
                   1055: 		    }
                   1056: 		    my $man_count=0;
                   1057: 		    my $opt_count=0;
                   1058: 		    my $opt_passed=0;
1.168     albertel 1059: 		    foreach my $dim (keys(%Apache::bridgetask::top_dimensionlist)) {
                   1060: 			if ($Apache::bridgetask::top_dimensionlist{$dim}{'manadatory'}
1.54      albertel 1061: 			    eq 'N') {
                   1062: 			    $opt_count++;
1.168     albertel 1063: 			    if ($Apache::lonhomework::history{"resource.$version.0.$dim.status"} eq 'pass') {
1.54      albertel 1064: 				$opt_passed++;
                   1065: 			    }
                   1066: 			} else {
                   1067: 			    $man_count++;
                   1068: 			}
                   1069: 		    }
1.151     albertel 1070: 		    
1.54      albertel 1071: 		    my $opt_req=&Apache::lonxml::get_param('OptionalRequired',
                   1072: 							 $parstack,$safeeval);
                   1073: 		    if ($opt_req !~ /\S/) { $opt_req='0'; }
1.99      albertel 1074: 		    $status.="\n<p>".&mt('You needed to pass all of the [_1]  mandatory components and [_2] of the [_3] optional components, of which you passed [_4].',$man_count,$opt_req,$opt_count,$opt_passed)."</p></div>\n";
1.54      albertel 1075: 
                   1076: 		    my $internal_location=&internal_location();
                   1077: 		    $result=~s/\Q$internal_location\E/$status/;
                   1078: 		}
1.142     albertel 1079: 		$result.="\n</div>\n".
                   1080: 		    &Apache::loncommon::end_page({'discussion' => 1});
1.1       albertel 1081: 	    }
                   1082: 	}
1.181     albertel 1083: 
                   1084: 	my $useslots = &Apache::lonnet::EXT("resource.0.useslots");
                   1085: 	my %queue_data = ('type' => 'Task',
                   1086: 			  'time' => time,);
                   1087: 	if (defined($Apache::inputtags::slot_name)) {
                   1088: 	    $queue_data{'slot'} = $Apache::inputtags::slot_name;
                   1089: 	} elsif (defined($Apache::lonhomework::history{"resource.$version.0.checkedin.slot"})) {
                   1090: 	    $queue_data{'slot'} = $Apache::lonhomework::history{"resource.$version.0.checkedin.slot"};
                   1091: 	}
                   1092: 	
                   1093: 
1.29      albertel 1094: 	if ($target eq 'grade' && !$env{'form.webgrade'} && !$previous) {
1.12      albertel 1095: 	    my $award='SUBMITTED';
1.28      albertel 1096: 	    &Apache::essayresponse::file_submission("$version.0",'bridgetask',
1.20      albertel 1097: 						    'portfiles',\$award);
1.14      albertel 1098: 	    if ($award eq 'SUBMITTED' &&
1.28      albertel 1099: 		$Apache::lonhomework::results{"resource.$version.0.bridgetask.portfiles"}) {
                   1100: 		$Apache::lonhomework::results{"resource.0.tries"}=
                   1101: 		    $Apache::lonhomework::results{"resource.$version.0.tries"}=
                   1102: 		    1+$Apache::lonhomework::history{"resource.$version.0.tries"};
                   1103: 
                   1104: 		$Apache::lonhomework::results{"resource.0.award"}=
                   1105: 		    $Apache::lonhomework::results{"resource.$version.0.award"}=
                   1106: 		    $award;
1.51      albertel 1107: 		$Apache::lonhomework::results{"resource.0.submission"}=
                   1108: 		    $Apache::lonhomework::results{"resource.$version.0.submission"}='';
1.64      albertel 1109: 	    } else {
                   1110: 		delete($Apache::lonhomework::results{"resource.$version.0.bridgetask.portfiles"});
1.77      albertel 1111: 		$award = '';
1.10      albertel 1112: 	    }
1.4       albertel 1113: 	    &Apache::lonhomework::showhash(%Apache::lonhomework::results);
                   1114: 	    &Apache::structuretags::finalize_storage();
1.148     albertel 1115: 	    if ($award eq 'SUBMITTED') {
1.181     albertel 1116: 		&add_to_queue('gradingqueue',\%queue_data);
1.14      albertel 1117: 	    }
1.1       albertel 1118: 	}
1.163     albertel 1119: 	if ($target eq 'grade' && $env{'form.webgrade'} eq 'yes' 
                   1120: 	    && exists($env{'form.cancel'})) {
                   1121: 	    &check_queue_unlock($env{'form.queue'});
                   1122: 	    &Apache::lonxml::debug(" cancelled grading .".$env{'form.queue'});
                   1123: 	} elsif ($target eq 'grade' && $env{'form.webgrade'} eq 'yes' 
                   1124: 		 && !exists($env{'form.cancel'})) {
1.20      albertel 1125: 	    my $optional_required=
                   1126: 		&Apache::lonxml::get_param('OptionalRequired',$parstack,
                   1127: 					   $safeeval);
                   1128: 	    my $optional_passed=0;
                   1129: 	    my $mandatory_failed=0;
                   1130: 	    my $ungraded=0;
                   1131: 	    my $review=0;   
1.21      albertel 1132: 	    &Apache::lonhomework::showhash(%Apache::lonhomework::results);
1.168     albertel 1133: 	    foreach my $dim (keys(%Apache::bridgetask::top_dimensionlist)) {
1.20      albertel 1134: 		my $status=
1.168     albertel 1135: 		    $Apache::lonhomework::results{"resource.$version.0.$dim.status"};
1.20      albertel 1136: 		my $mandatory=
1.168     albertel 1137: 		    ($Apache::bridgetask::top_dimensionlist{$dim}{'manadatory'} ne 'N');
1.20      albertel 1138: 		if ($status eq 'pass') {
                   1139: 		    if (!$mandatory) { $optional_passed++; }
                   1140: 		} elsif ($status eq 'fail') {
                   1141: 		    if ($mandatory) { $mandatory_failed++; }
                   1142: 		} elsif ($status eq 'ungraded') {
                   1143: 		    $ungraded++;
                   1144: 		} elsif ($status eq 'review') {
                   1145: 		    $review++;
1.49      albertel 1146: 		} else {
                   1147: 		    $ungraded++;
                   1148: 		}
1.20      albertel 1149: 	    }
                   1150: 	    if ($optional_passed < $optional_required) {
                   1151: 		$mandatory_failed++;
                   1152: 	    }
1.168     albertel 1153: 	    &Apache::lonxml::debug("all dim ".join(':',keys(%Apache::bridgetask::top_dimensionlist))."results -> m_f $mandatory_failed o_p $optional_passed u $ungraded r $review");
1.89      albertel 1154: 	    $Apache::lonhomework::results{'resource.0.regrader'}=
1.138     albertel 1155: 		$env{'user.name'}.':'.$env{'user.domain'};
1.20      albertel 1156: 	    if ($review) {
1.89      albertel 1157: 		$Apache::lonhomework::results{"resource.$version.0.status"}='review';
1.20      albertel 1158: 	    } elsif ($ungraded) {
1.89      albertel 1159: 		$Apache::lonhomework::results{"resource.$version.0.status"}='ungraded';
1.20      albertel 1160: 	    } elsif ($mandatory_failed) {
1.89      albertel 1161: 		$Apache::lonhomework::results{"resource.$version.0.status"}='fail';
1.25      albertel 1162: 		$Apache::lonhomework::results{"resource.$version.0.solved"}='incorrect_by_override';
                   1163: 		$Apache::lonhomework::results{"resource.$version.0.award"}='INCORRECT';
                   1164: 		$Apache::lonhomework::results{"resource.$version.0.awarded"}='0';
1.185     albertel 1165: 		my ($symb,$courseid,$udom,$uname)=&Apache::lonnet::whichuser();
1.52      albertel 1166: 		
                   1167: 		if ($env{'form.regrade'} ne 'yes') {
                   1168: 		    $Apache::lonhomework::results{"resource.$version.0.bridgetask.portfiles"}=
                   1169: 			$Apache::lonhomework::history{"resource.$version.0.bridgetask.portfiles"};
                   1170: 		    &Apache::grades::version_portfiles(
                   1171: 						       \%Apache::lonhomework::results,
                   1172: 						       ["$version.0.bridgetask"],$courseid,
                   1173: 						       $symb,$udom,$uname,
                   1174: 						       ["$version.0.bridgetask"]);
                   1175: 		}
1.20      albertel 1176: 	    } else {
1.89      albertel 1177: 		$Apache::lonhomework::results{"resource.$version.0.status"}='pass';
1.25      albertel 1178: 		$Apache::lonhomework::results{"resource.$version.0.solved"}='correct_by_override';
                   1179: 		$Apache::lonhomework::results{"resource.$version.0.award"}='EXACT_ANS';
                   1180: 		$Apache::lonhomework::results{"resource.$version.0.awarded"}='1';
1.185     albertel 1181: 		my ($symb,$courseid,$udom,$uname)=&Apache::lonnet::whichuser();
1.52      albertel 1182: 		if ($env{'form.regrade'} ne 'yes') {
                   1183: 		    $Apache::lonhomework::results{"resource.$version.0.bridgetask.portfiles"}=
                   1184: 			$Apache::lonhomework::history{"resource.$version.0.bridgetask.portfiles"};
                   1185: 		    &Apache::grades::version_portfiles(
                   1186: 						       \%Apache::lonhomework::results,
                   1187: 						       ["$version.0.bridgetask"],$courseid,
                   1188: 						       $symb,$udom,$uname,
                   1189: 						       ["$version.0.bridgetask"]);
                   1190: 		}
1.20      albertel 1191: 	    }
1.89      albertel 1192: 	    $Apache::lonhomework::results{"resource.0.status"}=
                   1193: 		$Apache::lonhomework::results{"resource.$version.0.status"};
1.28      albertel 1194: 	    if (defined($Apache::lonhomework::results{"resource.$version.0.awarded"})) {
1.26      albertel 1195: 		$Apache::lonhomework::results{"resource.0.award"}=
1.50      albertel 1196: 		    $Apache::lonhomework::results{"resource.$version.0.award"};
1.26      albertel 1197: 		$Apache::lonhomework::results{"resource.0.awarded"}=
1.50      albertel 1198: 		    $Apache::lonhomework::results{"resource.$version.0.awarded"};
1.26      albertel 1199: 		$Apache::lonhomework::results{"resource.0.solved"}=
1.50      albertel 1200: 		    $Apache::lonhomework::results{"resource.$version.0.solved"};
1.25      albertel 1201: 	    }
1.94      albertel 1202: 	    &minimize_storage();
1.21      albertel 1203: 	    &Apache::structuretags::finalize_storage();
1.188     albertel 1204: 	    
                   1205: 	    # data stored, now handle queue
                   1206: 	    if ($review) {
                   1207: 		if ($env{'form.queue'} eq 'reviewqueue') {
                   1208: 		    &check_queue_unlock($env{'form.queue'});
                   1209: 		    &Apache::lonxml::debug(" still needs review not changing status.");
                   1210: 		} else {
                   1211: 		    if ($env{'form.queue'} ne 'none') {
                   1212: 			&move_between_queues($env{'form.queue'},'reviewqueue');
                   1213: 		    } else {
                   1214: 			&add_to_queue('reviewqueue',\%queue_data);
                   1215: 		    }
                   1216: 		}
                   1217: 	    } elsif ($ungraded) {
                   1218: 		if ($env{'form.queue'} eq 'reviewqueue') {
                   1219: 		    &Apache::lonxml::debug("moving back.");
                   1220: 		    &move_between_queues($env{'form.queue'},
                   1221: 					 'gradingqueue');
                   1222: 		} elsif ($env{'form.queue'} eq 'none' ) {
                   1223: 		    &add_to_queue('gradingqueue',\%queue_data);	
                   1224: 		} else {
                   1225: 		    &check_queue_unlock($env{'form.queue'});
                   1226: 		}
                   1227: 	    } elsif ($mandatory_failed) {
                   1228: 		&remove_from_queue($env{'form.queue'}); 
                   1229: 	    } else {
                   1230: 		&remove_from_queue($env{'form.queue'});
                   1231: 	    }
1.20      albertel 1232: 	}
1.184     albertel 1233: 	if (exists($Apache::lonhomework::results{'INTERNAL_store'})) {
                   1234: 	    # instance generation occured and hasn't yet been stored
                   1235: 	    &Apache::structuretags::finalize_storage();
                   1236: 	}
1.15      albertel 1237:     } elsif ($target eq 'webgrade') {
1.131     albertel 1238: 	$result.="</div>";
1.20      albertel 1239: 	#$result.='<input type="submit" name="next" value="'.
                   1240: 	#    &mt('Save &amp; Next').'" /> ';
                   1241: 	#$result.='<input type="submit" name="end" value="'.
                   1242: 	#    &mt('Save &amp; Stop Grading').'" /> ';
                   1243: 	#$result.='<input type="submit" name="throwaway" value="'.
                   1244: 	#    &mt('Throw Away &amp; Stop Grading').'" /> ';
                   1245: 	#$result.='<input type="submit" name="save" value="'.
                   1246: 	#    &mt('Save Partial Grade and Continue Grading').'" /> ';
1.124     albertel 1247: 	$result.='</form>'."\n</div>\n</div>\n".
1.140     albertel 1248: 	    &Apache::loncommon::end_page();
1.1       albertel 1249:     } elsif ($target eq 'meta') {
1.70      albertel 1250: 	$result.=&Apache::response::meta_package_write('Task');
1.77      albertel 1251:         $result.=&Apache::response::meta_stores_write('solved','string',
                   1252: 						      'Problem Status');
                   1253: 	$result.=&Apache::response::meta_stores_write('tries','int_zeropos',
                   1254: 						      'Number of Attempts');
                   1255: 	$result.=&Apache::response::meta_stores_write('awarded','float',
                   1256: 						      'Partial Credit Factor');
                   1257: 	$result.=&Apache::response::meta_stores_write('status','string',
                   1258: 						      'Bridge Task Status');
1.182     albertel 1259:     } elsif ($target eq 'edit') {
                   1260: 	&Apache::structuretags::reset_problem_globals('Task');
                   1261: 	undef($Apache::lonhomework::parsing_a_task);
                   1262: 	return ('','no');
1.1       albertel 1263:     }
1.179     albertel 1264:     &Apache::structuretags::reset_problem_globals('Task');
1.4       albertel 1265:     undef($Apache::lonhomework::parsing_a_task);
1.1       albertel 1266:     return $result;
                   1267: }
                   1268: 
1.31      albertel 1269: sub move_between_queues {
                   1270:     my ($src_queue,$dest_queue)=@_;
1.49      albertel 1271:     my $cur_data;
                   1272:     if ($src_queue ne 'none') {
                   1273: 	$cur_data=&get_queue_data($src_queue);
                   1274: 	if (!$cur_data) { return 'not_exist'; }
                   1275:     } else {
                   1276: 	$cur_data = ['none'];
                   1277:     }
1.148     albertel 1278:     my $result=&add_to_queue($dest_queue,$cur_data);
1.31      albertel 1279:     if ($result ne 'ok') {
                   1280: 	return $result;
                   1281:     }
                   1282:     &check_queue_unlock($src_queue);
                   1283:     return &remove_from_queue($src_queue);
1.21      albertel 1284: }
                   1285: 
                   1286: sub check_queue_unlock {
1.32      albertel 1287:     my ($queue,$key,$allow_not_me)=@_;
1.49      albertel 1288:     if ($queue eq 'none') { return 'ok'; }
1.185     albertel 1289:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.32      albertel 1290:     if (!defined($key)) {
1.138     albertel 1291: 	$key="$symb\0queue\0$uname:$udom";
1.32      albertel 1292:     }
1.30      albertel 1293:     my $cnum=$env{'course.'.$cid.'.num'};
                   1294:     my $cdom=$env{'course.'.$cid.'.domain'};
1.138     albertel 1295:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.30      albertel 1296:     my $who=&queue_key_locked($queue,$key,$cdom,$cnum);
                   1297:     if  ($who eq $me) {
1.163     albertel 1298: 	&Apache::lonxml::debug("unlocking my own $who");
1.32      albertel 1299: 	return &Apache::lonnet::del($queue,["$key\0locked"],$cdom,$cnum);
                   1300:     } elsif ($allow_not_me) {
1.33      albertel 1301: 	&Apache::lonxml::debug("unlocking $who by $me");
1.32      albertel 1302: 	return &Apache::lonnet::del($queue,["$key\0locked"],$cdom,$cnum);
1.30      albertel 1303:     }
1.32      albertel 1304:     return 'not_owner';
1.21      albertel 1305: }
                   1306: 
1.88      albertel 1307: sub in_queue {
                   1308:     my ($queue,$symb,$cdom,$cnum,$udom,$uname)=@_;
                   1309:     if ($queue eq 'none') { return 0; }
                   1310:     if (!defined($symb) || !defined($cdom) || !defined($cnum)
                   1311: 	|| !defined($udom) || !defined($uname)) {
1.185     albertel 1312: 	($symb,my $cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.88      albertel 1313: 	$cnum=$env{'course.'.$cid.'.num'};
                   1314: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1315:     }
                   1316: 
                   1317:     my $key=&encode_queue_key($symb,$udom,$uname);
                   1318:     my %results = &Apache::lonnet::get($queue,[$key],$cdom,$cnum);
                   1319: 
                   1320:     if (defined($results{$key})) {
                   1321: 	return 1;
                   1322:     }
                   1323:     return 0;
                   1324: }
                   1325: 
1.21      albertel 1326: sub remove_from_queue {
1.86      albertel 1327:     my ($queue,$symb,$cdom,$cnum,$udom,$uname)=@_;
1.49      albertel 1328:     if ($queue eq 'none') { return 'ok'; }
1.86      albertel 1329:     if (!defined($symb) || !defined($cdom) || !defined($cnum)
                   1330: 	|| !defined($udom) || !defined($uname)) {
1.185     albertel 1331: 	($symb,my $cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.86      albertel 1332: 	$cnum=$env{'course.'.$cid.'.num'};
                   1333: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1334:     }
1.88      albertel 1335:     if (!&in_queue($queue,$symb,$cdom,$cnum,$udom,$uname)) {
                   1336: 	return 'ok';
                   1337:     }
1.86      albertel 1338:     my $key=&encode_queue_key($symb,$udom,$uname);
1.27      albertel 1339:     my @keys=($key,"$key\0locked");
1.31      albertel 1340:     return &Apache::lonnet::del($queue,\@keys,$cdom,$cnum);
1.21      albertel 1341: }
                   1342: 
1.16      albertel 1343: sub setup_env_for_other_user {
                   1344:     my ($queue_key,$safeeval)=@_;
                   1345:     my ($symb,$uname,$udom)=&decode_queue_key($queue_key);
1.30      albertel 1346:     &Apache::lonxml::debug("setup_env for $queue_key");
1.16      albertel 1347:     $env{'form.grade_symb'}=$symb;
                   1348:     $env{'form.grade_domain'}=$udom;
                   1349:     $env{'form.grade_username'}=$uname;
                   1350:     $env{'form.grade_courseid'}=$env{'request.course.id'};
                   1351:     &Apache::lonxml::initialize_rndseed($safeeval);
                   1352: }
                   1353: 
1.31      albertel 1354: sub get_queue_data {
1.165     albertel 1355:     my ($queue,$udom,$uname)=@_;
1.185     albertel 1356:     my ($symb,$cid,$other_udom,$other_uname)=&Apache::lonnet::whichuser();
1.165     albertel 1357:     if (!$uname || !$udom) {
                   1358: 	$uname=$other_uname;
                   1359: 	$udom =$other_udom;
                   1360:     }
1.31      albertel 1361:     my $cnum=$env{'course.'.$cid.'.num'};
                   1362:     my $cdom=$env{'course.'.$cid.'.domain'};
1.138     albertel 1363:     my $todo="$symb\0queue\0$uname:$udom";
1.31      albertel 1364:     my ($key,$value)=&Apache::lonnet::get($queue,[$todo],$cdom,$cnum);
                   1365:     if ($key eq $todo && ref($value)) {
                   1366: 	return $value;
                   1367:     }
                   1368:     return undef;
                   1369: }
                   1370: 
1.84      albertel 1371: 
1.49      albertel 1372: sub check_queue_for_key {
1.84      albertel 1373:     my ($cdom,$cnum,$queue,$todo)=@_;
                   1374: 
1.49      albertel 1375:     my %results=
                   1376: 	&Apache::lonnet::get($queue,[$todo,"$todo\0locked"],$cdom,$cnum);
                   1377:     
                   1378:     if (exists($results{$todo}) && ref($results{$todo})) {
                   1379: 	if (defined($results{"$todo\0locked"})) {
                   1380: 	    return 'locked';
                   1381: 	}
1.148     albertel 1382: 	if (my $slot=&slotted_access($results{$todo})) {
1.86      albertel 1383: 	    my %slot_data=&Apache::lonnet::get_slot($slot);
                   1384: 	    if ($slot_data{'endtime'} > time) { 
                   1385: 		return 'in_progress';
                   1386: 	    }
1.148     albertel 1387: 	} else {
                   1388: 	    my ($symb) = &decode_queue_key($todo);
                   1389: 	    my $due_date = &Apache::lonhomework::due_date('0',$symb);
                   1390: 	    if ($due_date > time) {
                   1391: 		return 'in_progress';
                   1392: 	    }
1.58      albertel 1393: 	}
1.49      albertel 1394: 	return 'enqueued';
                   1395:     }
                   1396:     return undef;
                   1397: }
                   1398: 
1.14      albertel 1399: sub add_to_queue {
1.82      albertel 1400:     my ($queue,$user_data)=@_;
1.49      albertel 1401:     if ($queue eq 'none') { return 'ok'; }
1.185     albertel 1402:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.82      albertel 1403:     if (!$cid || $env{'request.state'} eq 'construct') {
                   1404: 	return 'no_queue';
                   1405:     }
1.14      albertel 1406:     my $cnum=$env{'course.'.$cid.'.num'};
                   1407:     my $cdom=$env{'course.'.$cid.'.domain'};
                   1408:     my %data;
1.138     albertel 1409:     $data{"$symb\0queue\0$uname:$udom"}=$user_data;
1.83      albertel 1410:     return &Apache::lonnet::cput($queue,\%data,$cdom,$cnum);
1.14      albertel 1411: }
                   1412: 
1.156     albertel 1413: sub get_limited_classlist {
                   1414:     my ($sections) = @_;
                   1415: 
                   1416:     my $classlist = &Apache::loncoursedata::get_classlist();
1.157     albertel 1417:     foreach my $student (keys(%$classlist)) {
                   1418: 	if ( $classlist->{$student}[&Apache::loncoursedata::CL_STATUS()]
                   1419: 	     ne 'Active') {
                   1420: 	    delete($classlist->{$student});
                   1421:        	}
                   1422:     }
1.156     albertel 1423: 
1.157     albertel 1424:     if (ref($sections) && !grep('all',@{ $sections })) {
1.156     albertel 1425: 	foreach my $student (keys(%$classlist)) {
                   1426: 	    my $section  = 
                   1427: 		$classlist->{$student}[&Apache::loncoursedata::CL_SECTION()];
                   1428: 	    if (! grep($section,@{ $sections })) {
                   1429: 		delete($classlist->{$student});
                   1430: 	    }
                   1431: 	}
                   1432:     }
                   1433:     return $classlist;
                   1434: }
                   1435: 
                   1436: 
1.14      albertel 1437: sub show_queue {
1.32      albertel 1438:     my ($queue,$with_selects)=@_;
1.14      albertel 1439:     my $result;
1.185     albertel 1440:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.14      albertel 1441:     my $cnum=$env{'course.'.$cid.'.num'};
                   1442:     my $cdom=$env{'course.'.$cid.'.domain'};
1.59      albertel 1443: 
                   1444:     my @chosen_sections=
                   1445: 	&Apache::loncommon::get_env_multiple('form.chosensections');
1.156     albertel 1446: 
                   1447:     my $classlist = &get_limited_classlist(\@chosen_sections);
                   1448: 
1.63      albertel 1449:     if (!(grep(/^all$/,@chosen_sections))) {
                   1450: 	$result.='<p> Showing only sections <tt>'.join(', ',@chosen_sections).
                   1451: 	    '</tt>.</p> '."\n";
                   1452:     }
1.59      albertel 1453: 
1.156     albertel 1454:     my ($view,$view_section);
                   1455:     my $scope = $env{'request.course.id'};
                   1456:     if (!($view=&Apache::lonnet::allowed('vgr',$scope))) {
                   1457: 	$scope .= '/'.$env{'request.course.sec'};
                   1458: 	if ( $view = &Apache::lonnet::allowed('vgr',$scope)) {
                   1459: 	    $view_section=$env{'request.course.sec'};
                   1460: 	} else {
                   1461: 	    undef($view);
                   1462: 	}
                   1463:     }
                   1464: 
1.16      albertel 1465:     my $regexp="^$symb\0";
1.30      albertel 1466:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.31      albertel 1467:     my ($tmp)=%queue;
                   1468:     if ($tmp=~/^error: 2 /) {
1.159     albertel 1469: 	return "\n<h3>Current Queue - $queue</h3>".
                   1470: 	    &Apache::loncommon::start_data_table().
                   1471: 	    &Apache::loncommon::start_data_table_row().
                   1472: 	    '<td>'.&mt('Empty').'</td>'.
                   1473: 	    &Apache::loncommon::end_data_table_row().
                   1474: 	    &Apache::loncommon::end_data_table();
1.31      albertel 1475:     }
1.103     albertel 1476:     my $title=&Apache::lonnet::gettitle($symb);
1.159     albertel 1477:     $result.="\n<h3>Current Queue - $title $queue </h3>".
                   1478: 	&Apache::loncommon::start_data_table().
                   1479: 	&Apache::loncommon::start_data_table_header_row();
1.103     albertel 1480:     if ($with_selects) { $result.="<th>Status</th><th></th>"; }
1.159     albertel 1481:     $result.="<th>user</th><th>data</th>".
                   1482: 	&Apache::loncommon::end_data_table_header_row();
1.14      albertel 1483:     foreach my $key (sort(keys(%queue))) {
1.59      albertel 1484: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
                   1485: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
1.156     albertel 1486: 	
                   1487: 	my $section = $classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_SECTION()];
                   1488: 
                   1489: 	my $can_view=1;
                   1490: 	if (!$view
                   1491: 	    || ($view_section && !$section)
                   1492: 	    || ($view_section && $section && ($view_section ne $section))) {
                   1493: 	    $can_view=0;
                   1494: 	}
                   1495: 
1.32      albertel 1496: 	if ($key=~/locked$/ && !$with_selects) {
1.159     albertel 1497: 	    $result.= &Apache::loncommon::start_data_table_row().
                   1498: 		"<td>$uname</td>";
1.103     albertel 1499: 	    $result.='<td>'.$queue{$key}.'</td></tr>';
1.32      albertel 1500: 	} elsif ($key=~/timestamp$/ && !$with_selects) {
1.159     albertel 1501: 	    $result.=&Apache::loncommon::start_data_table_row()."<td></td>";
1.103     albertel 1502: 	    $result.='<td>'.
1.16      albertel 1503: 		&Apache::lonlocal::locallocaltime($queue{$key})."</td></tr>";
1.32      albertel 1504: 	} elsif ($key!~/(timestamp|locked)$/) {
1.159     albertel 1505: 	    $result.= &Apache::loncommon::start_data_table_row();
1.148     albertel 1506: 	    my ($end_time,$slot_text);
                   1507: 	    if (my $slot=&slotted_access($queue{$key})) {
                   1508: 		my %slot_data=&Apache::lonnet::get_slot($slot);
                   1509: 		$end_time = $slot_data{'endtime'};
                   1510: 		$slot_text = &mt('Slot: [_1]',$slot);
                   1511: 	    } else {
                   1512: 		$end_time = &Apache::lonhomework::due_date('0',$symb);
                   1513: 		$slot_text = '';
                   1514: 	    }
1.32      albertel 1515: 	    if ($with_selects) {
1.158     www      1516: 		my $ekey=&escape($key);
1.103     albertel 1517: 		my ($action,$description,$status)=('select',&mt('Select'));
1.32      albertel 1518: 		if (exists($queue{"$key\0locked"})) {
1.138     albertel 1519: 		    my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.103     albertel 1520: 		    $status=&mt('Locked by <tt>[_1]</tt>',$queue{"$key\0locked"});
1.32      albertel 1521: 		    if ($me eq $queue{"$key\0locked"}) {
                   1522: 			($action,$description)=('resume',&mt('Resume'));
                   1523: 		    } else {
                   1524: 			($action,$description)=('unlock',&mt('Unlock'));
                   1525: 		    }
                   1526: 		}
1.62      albertel 1527: 		my $seclist;
                   1528: 		foreach my $sec (@chosen_sections) {
                   1529: 		    $seclist.='<input type="hidden" name="chosensections" 
                   1530:                                value="'.$sec.'" />';
                   1531: 		}
1.156     albertel 1532: 		if ($can_view && ($end_time ne '' && time > $end_time)) {
1.35      albertel 1533: 		    $result.=(<<FORM);
1.103     albertel 1534: <td>$status</td>
1.32      albertel 1535: <td>
1.115     albertel 1536: <form style="display: inline" method="post">
1.32      albertel 1537:  <input type="hidden" name="gradingkey" value="$ekey" />
                   1538:  <input type="hidden" name="queue" value="$queue" />
                   1539:  <input type="hidden" name="gradingaction" value="$action" />
                   1540:  <input type="hidden" name="webgrade" value="no" />
1.33      albertel 1541:  <input type="hidden" name="queuemode" value="selected" />
1.32      albertel 1542:  <input type="submit" name="submit" value="$description" />
1.62      albertel 1543:  $seclist
1.32      albertel 1544: </form>
                   1545: </td>
                   1546: FORM
1.156     albertel 1547:                 } elsif (!$can_view && ($end_time ne '' && time > $end_time)) {
                   1548: 		    $result.='<td>'.&mt("Not gradable").'</td><td>&nbsp;</td>'
1.35      albertel 1549:                 } else {
1.148     albertel 1550: 		    $result.='<td>'.&mt("In Progress").'</td><td>&nbsp;</td>'
1.35      albertel 1551: 		}
1.32      albertel 1552: 	    }
1.156     albertel 1553: 	    $result.= "<td>".$classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_FULLNAME()].
1.138     albertel 1554: 		" <tt>($uname:$udom)</tt> </td>";
1.148     albertel 1555: 	    $result.='<td>'.$slot_text.' End time: '.
                   1556: 		&Apache::lonlocal::locallocaltime($end_time).
1.159     albertel 1557: 		"</td>".&Apache::loncommon::end_data_table_row();
1.16      albertel 1558: 	}
1.14      albertel 1559:     }
1.159     albertel 1560:     $result.= &Apache::loncommon::end_data_table()."<hr />\n";
1.14      albertel 1561:     return $result;
                   1562: }
                   1563: 
1.34      albertel 1564: sub get_queue_counts {
                   1565:     my ($queue)=@_;
                   1566:     my $result;
1.185     albertel 1567:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.34      albertel 1568:     my $cnum=$env{'course.'.$cid.'.num'};
                   1569:     my $cdom=$env{'course.'.$cid.'.domain'};
1.156     albertel 1570: 
1.157     albertel 1571:     my $classlist=&get_limited_classlist();
1.156     albertel 1572: 
1.34      albertel 1573:     my $regexp="^$symb\0";
                   1574:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
                   1575:     my ($tmp)=%queue;
                   1576:     if ($tmp=~/^error: 2 /) {
                   1577: 	return (0,0,0);
                   1578:     }
                   1579:     my ($entries,$ready_to_grade,$locks)=(0,0,0);
1.96      albertel 1580:     my %slot_cache;
1.34      albertel 1581:     foreach my $key (sort(keys(%queue))) {
1.156     albertel 1582: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
                   1583: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
1.34      albertel 1584: 	if ($key=~/locked$/) {
                   1585: 	    $locks++;
                   1586: 	} elsif ($key=~/timestamp$/) {
                   1587: 	    #ignore
                   1588: 	} elsif ($key!~/(timestamp|locked)$/) {
                   1589: 	    $entries++;
1.148     albertel 1590: 	    if (my $slot=&slotted_access($queue{$key})) {
                   1591: 		if (!exists($slot_cache{$slot})) {
                   1592: 		    my %slot_data=&Apache::lonnet::get_slot($slot);
                   1593: 		    $slot_cache{$slot} = \%slot_data;
                   1594: 		}
                   1595: 		if (time > $slot_cache{$slot}{'endtime'}) {
                   1596: 		    $ready_to_grade++;
                   1597: 		}
                   1598: 	    } else {
                   1599: 		my $due_date = &Apache::lonhomework::due_date('0',$symb);
                   1600: 		if ($due_date ne '' && time > $due_date) {
                   1601: 		    $ready_to_grade++;
                   1602: 		}
1.34      albertel 1603: 	    }
                   1604: 	}
                   1605:     }
                   1606:     return ($entries,$ready_to_grade,$locks);
                   1607: }
                   1608: 
1.49      albertel 1609: sub encode_queue_key {
                   1610:     my ($symb,$udom,$uname)=@_;
1.138     albertel 1611:     return "$symb\0queue\0$uname:$udom";
1.49      albertel 1612: }
                   1613: 
1.14      albertel 1614: sub decode_queue_key {
                   1615:     my ($key)=@_;
                   1616:     my ($symb,undef,$user) = split("\0",$key);
1.138     albertel 1617:     my ($uname,$udom) = split(':',$user);
1.14      albertel 1618:     return ($symb,$uname,$udom);
                   1619: }
                   1620: 
                   1621: sub queue_key_locked {
1.30      albertel 1622:     my ($queue,$key,$cdom,$cnum)=@_;
1.33      albertel 1623:     if (!defined($cdom) || !defined($cnum)) {
1.185     albertel 1624: 	my (undef,$cid)=&Apache::lonnet::whichuser();
1.33      albertel 1625: 	$cnum=$env{'course.'.$cid.'.num'};
                   1626: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1627:     }
1.14      albertel 1628:     my ($key_locked,$value)=
1.30      albertel 1629: 	&Apache::lonnet::get($queue,["$key\0locked"],$cdom,$cnum);
1.14      albertel 1630:     if ($key_locked eq "$key\0locked") {
                   1631: 	return $value;
                   1632:     }
                   1633:     return undef;
                   1634: }
                   1635: 
1.148     albertel 1636: sub slotted_access {
                   1637:     my ($queue_entry) = @_;
                   1638:     if (ref($queue_entry) eq 'ARRAY') {
                   1639: 	if (defined($queue_entry->[0])) {
                   1640: 	    return $queue_entry->[0];
                   1641: 	}
                   1642: 	return undef;
                   1643:     } elsif (ref($queue_entry) eq 'HASH') {
                   1644: 	if (defined($queue_entry->{'slot'})) {
                   1645: 	    return $queue_entry->{'slot'};
                   1646: 	}
                   1647: 	return undef;
                   1648:     }
                   1649:     return undef;
                   1650: }
                   1651: 
1.14      albertel 1652: sub pick_from_queue_data {
1.156     albertel 1653:     my ($queue,$check_section,$queuedata,$cdom,$cnum,$classlist)=@_;
1.98      albertel 1654:     my @possible; # will hold queue entries that are valid to be selected
1.30      albertel 1655:     foreach my $key (keys(%$queuedata)) {
1.68      albertel 1656: 	if ($key =~ /\0locked$/) { next; }
                   1657: 	if ($key =~ /\0timestamp$/) { next; }
1.156     albertel 1658: 
1.14      albertel 1659: 	my ($symb,$uname,$udom)=&decode_queue_key($key);
1.156     albertel 1660: 	if (!defined($classlist->{$uname.':'.$udom})) { next; }
                   1661: 
1.14      albertel 1662: 	if ($check_section) {
1.156     albertel 1663: 	    my $section =
                   1664: 		$classlist->{$uname.':'.$udom}[&Apache::loncoursedata::CL_SECTION()];
1.17      albertel 1665: 	    if ($section eq $check_section) {
1.33      albertel 1666: 		&Apache::lonxml::debug("my sec");
1.15      albertel 1667: 		next;
                   1668: 	    }
1.14      albertel 1669: 	}
1.148     albertel 1670: 	my $end_time;
                   1671: 	if (my $slot=&slotted_access($queuedata->{$key})) {
1.154     albertel 1672: 	    &Apache::lonxml::debug("looking at slot $slot");
1.148     albertel 1673: 	    my %slot_data=&Apache::lonnet::get_slot($slot);
                   1674: 	    if ($slot_data{'endtime'} < time) { 
                   1675: 		$end_time = $slot_data{'endtime'};
1.154     albertel 1676: 	    } else {
                   1677: 		&Apache::lonxml::debug("not time ".$slot_data{'endtime'});
                   1678: 		next;
1.148     albertel 1679: 	    }
                   1680: 	} else {
                   1681: 	    my $due_date = &Apache::lonhomework::due_date('0',$symb);
1.154     albertel 1682: 	    if ($due_date < time) {
1.148     albertel 1683: 		$end_time = $due_date;
1.154     albertel 1684: 	    } else {
                   1685: 		&Apache::lonxml::debug("not time $due_date");
                   1686: 		next;
1.148     albertel 1687: 	    }
                   1688: 	}
                   1689: 	
1.98      albertel 1690: 	if (exists($queuedata->{"$key\0locked"})) {
1.33      albertel 1691: 	    &Apache::lonxml::debug("someone already has um.");
1.15      albertel 1692: 	    next;
                   1693: 	}
1.148     albertel 1694: 	push(@possible,[$key,$end_time]);
1.98      albertel 1695:     }
                   1696:     if (@possible) {
                   1697:         # sort entries in order by slot end time
                   1698: 	@possible = sort { $a->[1] <=> $b->[1] } @possible;
1.137     albertel 1699: 	# pick one of the entries in the top 10% in small queues and one
                   1700: 	# of the first ten entries in large queues
1.139     albertel 1701: 	#my $ten_percent = int($#possible * 0.1);
                   1702: 	#if ($ten_percent < 1 ) { $ten_percent = 1;  }
                   1703: 	#if ($ten_percent > 10) { $ten_percent = 10; }
                   1704: 	#my $max=($#possible < $ten_percent) ? $#possible : $ten_percent;
1.137     albertel 1705: 	
1.139     albertel 1706: 	#return $possible[int(rand($max))][0];
                   1707: 	return $possible[0][0];
1.14      albertel 1708:     }
                   1709:     return undef;
                   1710: }
                   1711: 
1.15      albertel 1712: sub find_mid_grade {
1.30      albertel 1713:     my ($queue,$symb,$cdom,$cnum)=@_;
1.158     www      1714:     my $todo=&unescape($env{'form.gradingkey'});
1.138     albertel 1715:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.15      albertel 1716:     if ($todo) {
1.30      albertel 1717: 	my $who=&queue_key_locked($queue,$todo,$cdom,$cnum);
1.15      albertel 1718: 	if ($who eq $me) { return $todo; }
                   1719:     }
                   1720:     my $regexp="^$symb\0.*\0locked\$";
1.30      albertel 1721:     my %locks=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.15      albertel 1722:     foreach my $key (keys(%locks)) {
                   1723: 	my $who=$locks{$key};
                   1724: 	if ($who eq $me) {
                   1725: 	    $todo=$key;
                   1726: 	    $todo=~s/\0locked$//;
                   1727: 	    return $todo;
                   1728: 	}
                   1729:     }
                   1730:     return undef;
                   1731: }
                   1732: 
1.32      albertel 1733: sub lock_key {
                   1734:     my ($queue,$todo)=@_;
1.138     albertel 1735:     my $me=$env{'user.name'}.':'.$env{'user.domain'};
1.185     albertel 1736:     my (undef,$cid)=&Apache::lonnet::whichuser();
1.32      albertel 1737:     my $cnum=$env{'course.'.$cid.'.num'};
                   1738:     my $cdom=$env{'course.'.$cid.'.domain'};
                   1739:     my $success=&Apache::lonnet::newput($queue,{"$todo\0locked"=> $me},
                   1740: 					$cdom,$cnum);
1.33      albertel 1741:     &Apache::lonxml::debug("success $success $todo");
1.32      albertel 1742:     if ($success eq 'ok') {
                   1743: 	return 1;
                   1744:     }
                   1745:     return 0;
                   1746: }
                   1747: 
1.86      albertel 1748: sub get_queue_symb_status {
1.85      albertel 1749:     my ($queue,$symb,$cdom,$cnum) = @_;
                   1750:     if (!defined($cdom) || !defined($cnum)) {
1.185     albertel 1751: 	my (undef,$cid)=&Apache::lonnet::whichuser();
1.85      albertel 1752: 	$cnum=$env{'course.'.$cid.'.num'};
                   1753: 	$cdom=$env{'course.'.$cid.'.domain'};
                   1754:     }
1.157     albertel 1755:     my $classlist=&get_limited_classlist();
1.156     albertel 1756: 
1.85      albertel 1757:     my $regexp="^$symb\0";
                   1758:     my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
                   1759:     my ($tmp)=%queue;
                   1760:     if ($tmp=~/^error: 2 /) { return; }
                   1761:     my @users;
                   1762:     foreach my $key (sort(keys(%queue))) {
                   1763: 	next if ($key=~/locked$/);
                   1764: 	next if ($key=~/timestamp$/);
                   1765: 	my ($symb,$uname,$udom) = &decode_queue_key($key);
1.156     albertel 1766: 	next if (!defined($classlist->{$uname.':'.$udom}));
1.85      albertel 1767: 	push(@users,"$uname:$udom");
                   1768:     }
                   1769:     return @users;
                   1770: }
                   1771: 
1.14      albertel 1772: sub get_from_queue {
1.30      albertel 1773:     my ($queue)=@_;
1.14      albertel 1774:     my $result;
1.185     albertel 1775:     my ($symb,$cid,$udom,$uname)=&Apache::lonnet::whichuser();
1.14      albertel 1776:     my $cnum=$env{'course.'.$cid.'.num'};
                   1777:     my $cdom=$env{'course.'.$cid.'.domain'};
1.32      albertel 1778:     my $todo=&find_mid_grade($queue,$symb,$cdom,$cnum);
1.33      albertel 1779:     &Apache::lonxml::debug("found ".join(':',&decode_queue_key($todo)));
1.16      albertel 1780:     if ($todo) { return $todo; }
1.95      albertel 1781:     my $attempts=0;
1.156     albertel 1782: 
1.157     albertel 1783:     my $classlist=&get_limited_classlist();
1.156     albertel 1784: 
1.14      albertel 1785:     while (1) {
1.95      albertel 1786: 	if ($attempts > 2) {
                   1787: 	    # tried twice to get a queue entry, giving up
                   1788: 	    return (undef,'unable');
                   1789: 	}
1.14      albertel 1790: 	my $starttime=time;
1.83      albertel 1791: 	&Apache::lonnet::cput($queue,{"$symb\0timestamp"=>$starttime},
                   1792: 			      $cdom,$cnum);
1.33      albertel 1793: 	&Apache::lonxml::debug("$starttime");
1.14      albertel 1794: 	my $regexp="^$symb\0queue\0";
1.156     albertel 1795: 	#my $range= ($attempts < 1 ) ? '0-100' : '0-400';
1.97      albertel 1796: 
1.98      albertel 1797: 	my %queue=&Apache::lonnet::dump($queue,$cdom,$cnum,$regexp);
1.33      albertel 1798: 	#make a pass looking for a user _not_ in my section
1.14      albertel 1799: 	if ($env{'request.course.sec'}) {
1.33      albertel 1800: 	    &Apache::lonxml::debug("sce");
1.30      albertel 1801: 	    $todo=&pick_from_queue_data($queue,$env{'request.course.sec'},
1.156     albertel 1802: 					\%queue,$cdom,$cnum,$classlist);
1.33      albertel 1803: 	    &Apache::lonxml::debug("sce $todo");
1.14      albertel 1804: 	}
1.33      albertel 1805: 	# no one _not_ in our section so look for any user that is
                   1806: 	# ready for grading
1.14      albertel 1807: 	if (!$todo) {
1.33      albertel 1808: 	    &Apache::lonxml::debug("no sce");
1.156     albertel 1809: 	    $todo=&pick_from_queue_data($queue,undef,\%queue,$cdom,$cnum,
                   1810: 					$classlist);
1.33      albertel 1811: 	    &Apache::lonxml::debug("no sce $todo");
1.14      albertel 1812: 	}
                   1813: 	# no user to grade 
                   1814: 	if (!$todo) { last; }
1.33      albertel 1815: 	&Apache::lonxml::debug("got $todo");
1.14      albertel 1816: 	# otherwise found someone so lets try to lock them
1.32      albertel 1817: 	# unless someone else already picked them
1.95      albertel 1818: 	if (!&lock_key($queue,$todo)) {
                   1819: 	    $attempts++;
                   1820: 	    next;
                   1821: 	}
1.14      albertel 1822: 	my (undef,$endtime)=
1.30      albertel 1823: 	    &Apache::lonnet::get($queue,["$symb\0timestamp"],
1.14      albertel 1824: 				 $cdom,$cnum);
1.33      albertel 1825: 	&Apache::lonxml::debug("emd  $endtime");
1.14      albertel 1826: 	# someone else already modified the queue, 
                   1827: 	# perhaps our picked user wass already fully graded between
                   1828: 	# when we picked him and when we locked his record? so lets
                   1829: 	# double check.
                   1830: 	if ($endtime != $starttime) {
                   1831: 	    my ($key,$value)=
1.30      albertel 1832: 		&Apache::lonnet::get($queue,["$todo"],
1.14      albertel 1833: 				     $cdom,$cnum);
1.33      albertel 1834: 	    &Apache::lonxml::debug("check  $key .. $value");
1.14      albertel 1835: 	    if ($key eq $todo && ref($value)) {
                   1836: 	    } else {
1.30      albertel 1837: 		&Apache::lonnet::del($queue,["$todo\0locked"],
1.14      albertel 1838: 				     $cdom,$cnum);
1.33      albertel 1839: 		&Apache::lonxml::debug("del");
1.95      albertel 1840: 		$attempts++;
1.14      albertel 1841: 		next;
                   1842: 	    }
                   1843: 	}
1.33      albertel 1844: 	&Apache::lonxml::debug("last $todo");
1.14      albertel 1845: 	last;
                   1846:     }
                   1847:     return $todo;
                   1848: }
                   1849: 
1.49      albertel 1850: sub select_user {
1.185     albertel 1851:     my ($symb,$cid)=&Apache::lonnet::whichuser();
1.49      albertel 1852: 
1.59      albertel 1853:     my @chosen_sections=
                   1854: 	&Apache::loncommon::get_env_multiple('form.chosensections');
1.156     albertel 1855: 
                   1856:     my $classlist = &get_limited_classlist(\@chosen_sections);
1.63      albertel 1857:     
                   1858:     my $result;
                   1859:     if (!(grep(/^all$/,@chosen_sections))) {
                   1860: 	$result.='<p> Showing only sections <tt>'.join(', ',@chosen_sections).
                   1861: 	    '</tt>.</p> '."\n";
                   1862:     }
1.159     albertel 1863:     $result.=&Apache::loncommon::start_data_table();
1.49      albertel 1864: 
1.156     albertel 1865:     foreach my $student (sort {lc($classlist->{$a}[&Apache::loncoursedata::CL_FULLNAME()]) cmp lc($classlist->{$b}[&Apache::loncoursedata::CL_FULLNAME()]) } (keys(%$classlist))) {
1.49      albertel 1866: 	my ($uname,$udom) = split(/:/,$student);
1.59      albertel 1867: 	
1.84      albertel 1868: 	my $cnum=$env{'course.'.$cid.'.num'};
                   1869: 	my $cdom=$env{'course.'.$cid.'.domain'};
1.88      albertel 1870: 	my %status = &get_student_status($symb,$cdom,$cnum,$udom,$uname,
                   1871: 					 'Task');
1.49      albertel 1872: 	my $queue = 'none';
1.58      albertel 1873: 	my $cannot_grade;
                   1874: 	if ($status{'reviewqueue'} =~ /^(in_progress|enqueue)$/) {
1.49      albertel 1875: 	    $queue = 'reviewqueue';
1.58      albertel 1876: 	    if ($status{'reviewqueue'} eq 'in_progress') {
                   1877: 		$cannot_grade=1;
                   1878: 	    }
                   1879: 	} elsif ($status{'gradingqueue'} =~ /^(in_progress|enqueue)$/) {
1.49      albertel 1880: 	    $queue = 'gradingqueue';
1.58      albertel 1881: 	    if ($status{'gradingqueue'} eq 'in_progress') {
                   1882: 		$cannot_grade=1;
                   1883: 	    }
1.49      albertel 1884: 	}
                   1885: 	my $todo = 
1.158     www      1886: 	    &escape(&encode_queue_key($symb,$udom,$uname));
1.58      albertel 1887: 	if ($cannot_grade) {
1.159     albertel 1888: 	    $result.=&Apache::loncommon::start_data_table_row().
                   1889: 		'<td>&nbsp;</td><td>'.$classlist->{$student}[&Apache::loncoursedata::CL_FULLNAME()].
1.58      albertel 1890: 		'</td><td>';
                   1891: 	} else {
1.62      albertel 1892: 	    my $seclist;
                   1893: 	    foreach my $sec (@chosen_sections) {
                   1894: 		$seclist.='<input type="hidden" name="chosensections" 
                   1895:                                value="'.$sec.'" />';
                   1896: 	    }
1.159     albertel 1897: 	    $result.=&Apache::loncommon::start_data_table_row();
1.58      albertel 1898: 	    $result.=<<RESULT;
1.49      albertel 1899:   <td>
1.115     albertel 1900:     <form style="display: inline" method="post">
1.49      albertel 1901:       <input type="hidden" name="gradingkey" value="$todo" />
                   1902:       <input type="hidden" name="queue" value="$queue" />
                   1903:       <input type="hidden" name="webgrade" value="no" />
1.52      albertel 1904:       <input type="hidden" name="regrade" value="yes" />
1.62      albertel 1905:       <input type="submit" name="submit" value="Regrade" />
                   1906:       $seclist
1.49      albertel 1907:     </form>
1.155     albertel 1908:   <td>$classlist->{$student}[&Apache::loncoursedata::CL_FULLNAME()] <tt>($student)</tt></td>
1.49      albertel 1909:   <td>
                   1910: RESULT
1.58      albertel 1911:         }
1.49      albertel 1912:         if ($status{'status'} eq 'pass') {
                   1913: 	    $result .= '<font color="green">'.&mt('Passed').'</font>';
                   1914: 	} elsif ($status{'status'} eq 'fail') {
                   1915: 	    $result .= '<font color="red">'.&mt('Failed').'</font>';
                   1916: 	} elsif ($status{'status'} eq 'review') {
                   1917: 	    $result .= '<font color="blue">'.&mt('Under Review').'</font>';
                   1918: 	} elsif ($status{'status'} eq 'ungraded') {
                   1919: 	    $result .= &mt('Ungraded');
                   1920: 	} elsif ($status{'status'} ne '') {
                   1921: 	    $result .= '<font color="orange">'.&mt('Unknown Status').'</font>';
                   1922: 	} else {
                   1923: 	    $result.="&nbsp;";
                   1924: 	}
                   1925: 	if ($status{'version'}) {
                   1926: 	    $result .= ' '.&mt('Version').' '.$status{'version'};
                   1927: 	}
1.101     albertel 1928: 	if ($status{'grader'}) {
                   1929: 	    $result .= ' '.&mt('(Graded by [_1])',$status{'grader'}).' ';
                   1930: 	}
1.49      albertel 1931: 	$result.= '</td><td>';
                   1932: 	if ($status{'reviewqueue'} eq 'enqueued') {
                   1933: 	    $result .= &mt('Awaiting Review');
                   1934: 	} elsif ($status{'reviewqueue'} eq 'locked') {
                   1935: 	    $result .= &mt('Under Review');
1.58      albertel 1936: 	} elsif ($status{'reviewqueue'} eq 'in_progress') {
                   1937: 	    $result .= &mt('Still being worked on.');
1.49      albertel 1938: 	} elsif ($status{'gradingqueue'} eq 'enqueued') {
                   1939: 	    $result .= &mt('Awaiting Grading');
                   1940: 	} elsif ($status{'gradingqueue'} eq 'locked') {
                   1941: 	    $result .= &mt('Being Graded');
1.58      albertel 1942: 	} elsif ($status{'gradingqueue'} eq 'in_progress') {
                   1943: 	    $result .= &mt('Still being worked on.');
1.49      albertel 1944: 	} else {
                   1945: 	    $result.="&nbsp;";
                   1946: 	}
1.159     albertel 1947: 	$result.= '</td>'.&Apache::loncommon::end_data_table_row();
1.49      albertel 1948:     }
1.159     albertel 1949:     $result.=&Apache::loncommon::end_data_table();
1.49      albertel 1950:     return $result;
                   1951: }
                   1952: 
                   1953: sub get_student_status {
1.86      albertel 1954:     my ($symb,$cdom,$cnum,$udom,$uname,$type)=@_;
                   1955: 
                   1956:     my %status;
                   1957: 
                   1958:     if ($type eq 'Task') {
                   1959: 	my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
1.49      albertel 1960: 					  $udom,$uname);
1.89      albertel 1961: 	$status{'status'}=$record{'resource.0.status'};
                   1962: 	$status{'version'}=$record{'resource.0.version'};
                   1963: 	$status{'grader'}=$record{'resource.0.regrader'};
1.86      albertel 1964:     }
                   1965:     $status{'reviewqueue'}=
                   1966: 	&check_queue_for_key($cdom,$cnum,'reviewqueue',
                   1967: 			     &encode_queue_key($symb,$udom,$uname));
                   1968:     $status{'gradingqueue'}=
                   1969: 	&check_queue_for_key($cdom,$cnum,'gradingqueue',
                   1970: 			     &encode_queue_key($symb,$udom,$uname));
1.49      albertel 1971:     return %status;
                   1972: }
                   1973: 
1.1       albertel 1974: sub start_ClosingParagraph {
                   1975:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   1976:     my $result;
                   1977:     if ($target eq 'web') {
1.13      albertel 1978:     } elsif ($target eq 'webgrade') {
                   1979: 	&Apache::lonxml::startredirection();
1.1       albertel 1980:     }
                   1981:     return $result;
                   1982: }
                   1983: 
                   1984: sub end_ClosingParagraph {
                   1985:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   1986:     my $result;
                   1987:     if ($target eq 'web') {
1.13      albertel 1988:     } elsif ($target eq 'webgrade') {
                   1989: 	&Apache::lonxml::endredirection();
1.1       albertel 1990:     }
                   1991:     return $result;
                   1992: }
                   1993: 
1.168     albertel 1994: sub get_dim_id {
                   1995:     return $Apache::bridgetask::dimension[-1];
                   1996: }
                   1997: 
1.19      albertel 1998: sub get_id {
                   1999:     my ($parstack,$safeeval)=@_;
                   2000:     my $id=&Apache::lonxml::get_param('id',$parstack,$safeeval);
                   2001:     if (!$id) { $id=$Apache::lonxml::curdepth; }
                   2002:     return $id;
                   2003: }
                   2004: 
1.162     albertel 2005: sub start_Setup {
                   2006:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.168     albertel 2007:     #undef(%dimension);
                   2008:     my $dim = &get_id($parstack,$safeeval);
                   2009:     push(@Apache::bridgetask::dimension,$dim);
1.162     albertel 2010:     &Apache::lonxml::startredirection();
1.168     albertel 2011:     return &internal_location($dim);
1.162     albertel 2012: }
1.173     albertel 2013: 
                   2014: {
                   2015:     my @allowed;
                   2016:     sub enable_dimension_parsing {
                   2017: 	my ($id) = @_;
                   2018: 	push(@allowed,$id);
                   2019:     }
                   2020:     sub disable_dimension_parsing {
                   2021: 	pop(@allowed);
                   2022:     }
                   2023:     sub skip_dimension_parsing {
                   2024: 	my ($check) = @_;
                   2025: 	if (!@allowed) { return 0;}
                   2026: 	# if unspecified allow any id
                   2027: 	if ($allowed[-1] eq undef) { return 0;}
                   2028: 
                   2029: 	return ($check ne $allowed[-1]);
                   2030:     }
                   2031: }
                   2032: 
1.151     albertel 2033: sub start_Question { return &start_Dimension(@_); }
1.1       albertel 2034: sub start_Dimension {
1.173     albertel 2035:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.168     albertel 2036:     my $dim = &get_id($parstack,$safeeval);
                   2037:     my $previous_dim;
                   2038:     if (@Apache::bridgetask::dimension) {
                   2039: 	$previous_dim = $Apache::bridgetask::dimension[-1];
                   2040: 	push(@{$Apache::bridgetask::dimension{$previous_dim}{'contains'}},
                   2041: 	     $dim);
1.173     albertel 2042: 	if(&skip_dimension_parsing($dim)) {
                   2043: 	    $dimension{$previous_dim}{'criteria.'.$dim} =
                   2044: 		$token->[4]
                   2045: 		.&Apache::lonxml::get_all_text('/'.$tagstack->[-1],$parser,
                   2046: 					      $style)
                   2047: 		.'</'.$tagstack->[-1].'>';
                   2048: 	}
1.169     albertel 2049: 	$dimension{$previous_dim}{'criteria.'.$dim.'.type'}='dimension';
                   2050: 	$dimension{$previous_dim}{'criteria.'.$dim.'.mandatory'}=
                   2051: 	    &Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
                   2052: 	push(@{$dimension{$previous_dim}{'criterias'}},$dim);
1.171     albertel 2053: 	$dimension{$dim}{'nested'}=$previous_dim;
1.172     albertel 2054: 	&Apache::lonxml::debug("adding $dim as criteria to $previous_dim");
1.168     albertel 2055:     } else {
                   2056: 	$Apache::bridgetask::top_dimensionlist{$dim}{'manadatory'}=
                   2057: 	    &Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
                   2058:     }
                   2059:     push(@Apache::bridgetask::dimension,$dim);
1.54      albertel 2060:     &Apache::lonxml::startredirection();
1.173     albertel 2061:     &enable_dimension_parsing($dim);
1.168     albertel 2062:     return &internal_location($dim);
1.1       albertel 2063: }
                   2064: 
1.160     albertel 2065: sub start_QuestionText {
                   2066:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.168     albertel 2067:     my $dim = &get_dim_id();
1.160     albertel 2068:     my $text=&Apache::lonxml::get_all_text('/questiontext',$parser,$style);
                   2069:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
1.169     albertel 2070: 	$dimension{$dim}{'questiontext'}=$text;
1.160     albertel 2071:     }
                   2072:     return '';
                   2073: }
                   2074: 
                   2075: sub end_QuestionText {
                   2076:     return '';
                   2077: }
                   2078: 
1.13      albertel 2079: sub get_instance {
1.75      albertel 2080:     my ($dim)=@_;
                   2081:     my $rand_alg=&Apache::lonnet::get_rand_alg();
                   2082:     if (!$rand_alg || $rand_alg eq '32bit' || $rand_alg eq '64bit' ||
                   2083: 	$rand_alg eq '64bit2' || $rand_alg eq '64bit3' ||
                   2084: 	$rand_alg eq '64bit4' ) {
                   2085: 	&Apache::response::pushrandomnumber();
1.169     albertel 2086: 	my @order=&Math::Random::random_permutation(@{$dimension{$dim}{'instances'}});
1.75      albertel 2087: 	my $num=@order;
                   2088: 	my $version=&get_version();
                   2089: 	my $which=($version-1)%$num;
                   2090: 	return $order[$which];
                   2091:     } else {
                   2092: 	my ($version,$previous) = &get_version();
                   2093: 	my $instance = 
                   2094: 	    $Apache::lonhomework::history{"resource.$version.0.$dim.instance"};
                   2095: 	if (defined($instance)) { return $instance; }
                   2096: 
                   2097: 	&Apache::response::pushrandomnumber();
1.173     albertel 2098: 	if (ref($dimension{$dim}{'instances'}) eq 'ARRAY') {
                   2099: 	    my @instances = @{$dimension{$dim}{'instances'}};
                   2100: 	    # remove disabled instances
                   2101: 	    for (my $i=0; $i < $#instances; $i++) {
                   2102: 		if ($dimension{$dim}{$instances[$i].'.disabled'}) {
                   2103: 		    splice(@instances,$i,1);
                   2104: 		    $i--;
                   2105: 		}
                   2106: 	    }
                   2107: 	    @instances = &Math::Random::random_permutation(@instances);
                   2108: 	    $instance  = $instances[($version-1)%scalar(@instances)];
                   2109: 	    if ($version =~ /^\d$/) {
                   2110: 		$Apache::lonhomework::results{"resource.$version.0.$dim.instance"} = 
                   2111: 		    $instance;
                   2112: 		$Apache::lonhomework::results{'INTERNAL_store'} = 1; 
1.75      albertel 2113: 	    }
                   2114: 	}
                   2115: 	&Apache::response::poprandomnumber();
                   2116: 	return $instance;
                   2117:     }
1.13      albertel 2118: }
                   2119: 
1.169     albertel 2120: sub get_criteria {
                   2121:     my ($what,$version,$dim,$id) = @_;
                   2122:     my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2123:     my $prefix = ($type eq 'criteria') ? "$dim.$id"
                   2124: 	                               : "$id";
                   2125:     my $entry = "resource.$version.0.$prefix.$what";
                   2126:     if (exists($Apache::lonhomework::results{$entry})) {
                   2127: 	return $Apache::lonhomework::results{$entry};
                   2128:     }
                   2129:     return $Apache::lonhomework::history{$entry};
                   2130: }
                   2131: 
1.18      albertel 2132: {
                   2133:     my $last_link;
1.122     albertel 2134:     sub link {
1.151     albertel 2135: 	my ($id) = @_;
                   2136: 	$id =~ s/\./_/g;
                   2137: 	return 'LC_GRADING_criteria_'.$id;
1.122     albertel 2138:     }
1.151     albertel 2139:     sub end_Question { return &end_Dimension(@_); }
1.18      albertel 2140:     sub end_Dimension {
                   2141: 	my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.54      albertel 2142: 	my $result=&Apache::lonxml::endredirection();
1.25      albertel 2143: 	my $dim=&get_id($parstack,$safeeval);
1.173     albertel 2144: 	if (&skip_dimension_parsing($dim)) {
                   2145: 	    &disable_dimension_parsing($dim);
                   2146: 	    pop(@Apache::bridgetask::dimension);
                   2147: 	    return;
                   2148: 	}
1.75      albertel 2149: 	my $instance=&get_instance($dim);
1.25      albertel 2150: 	my $version=&get_version();
1.18      albertel 2151: 	if ($target eq 'web') {
1.173     albertel 2152: 	    $result .= &nested_parse(\$dimension{$dim}{'intro'},[@_]);
1.76      albertel 2153: 	    my @instances = $instance;
                   2154: 	    if (&Apache::response::showallfoils()) {
1.169     albertel 2155: 		@instances = @{$dimension{$dim}{'instances'}};
1.76      albertel 2156: 	    }
1.160     albertel 2157: 	    my $shown_question_text;
1.76      albertel 2158: 	    foreach my $instance (@instances) {
1.173     albertel 2159: 		$result .= &nested_parse(\$dimension{$dim}{$instance.'.text'},
                   2160: 					 [@_]);
                   2161: 		$result .= &nested_parse(\$dimension{$dim}{'questiontext'},
                   2162: 					 [@_],{'set_dim_id' => undef});
1.169     albertel 2163: 		my $task_status = 
                   2164: 		    $Apache::lonhomework::history{"resource.$version.0.status"};
1.173     albertel 2165: 		if ($task_status ne 'pass' && $task_status ne 'fail') {
1.76      albertel 2166: 
1.173     albertel 2167: 		    foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2168: 				    @{$dimension{$dim}{'criterias'}}) {
                   2169: 			my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2170: 			&Apache::lonxml::debug("$id is $type");
                   2171: 			if ($type eq 'dimension') {
                   2172: 			    $result.=
                   2173: 				&nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2174: 					      [@_],{'set_dim_id' => $id});
                   2175: 			}
                   2176: 		    }
                   2177: 		} else {
1.89      albertel 2178: 		    my $dim_status=$Apache::lonhomework::history{"resource.$version.0.$dim.status"};
1.76      albertel 2179: 		    my $mandatory='Mandatory';
1.189     albertel 2180: 		    if (&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval) eq 'N') {
1.76      albertel 2181: 			$mandatory='Optional';
                   2182: 		    }
1.116     albertel 2183: 		    my $dim_info="<div class='LC_$dim_status LC_question_grade'>\n";
1.76      albertel 2184: 		    if ($dim_status eq 'pass') {
                   2185: 			$dim_info.='<h3>Question : you passed this '.$mandatory.' question</h3>';
1.54      albertel 2186: 		    }
1.76      albertel 2187: 		    if ($dim_status eq 'fail') {
                   2188: 			$dim_info.='<h3>Question : you did not pass this '.$mandatory.' question</h3>';
1.53      albertel 2189: 		    }
1.76      albertel 2190: 		    my $man_count=0;
                   2191: 		    my $man_passed=0;
                   2192: 		    my $opt_count=0;
                   2193: 		    my $opt_passed=0;
1.169     albertel 2194: 		    foreach my $id ( @{$dimension{$dim}{$instance.'.criterias'}},
                   2195: 				     @{$dimension{$dim}{'criterias'}} ) {
                   2196: 			my $status = &get_criteria('status',$version,$dim,$id);
                   2197: 			if ($dimension{$dim}{'criteria.'.$id.'.mandatory'} 
1.76      albertel 2198: 			    eq 'N') {
                   2199: 			    $opt_count++;
1.169     albertel 2200: 			    if ($status eq 'pass') { $opt_passed++; }
1.76      albertel 2201: 			} else {
                   2202: 			    $man_count++;
1.169     albertel 2203: 			    if ($status eq 'pass') { $man_passed++; }
1.76      albertel 2204: 			}
1.22      albertel 2205: 		    }
1.76      albertel 2206: 		    if ($man_passed eq $man_count) { $man_passed='all'; }
1.151     albertel 2207: 
1.169     albertel 2208: 		    my $opt_req=$dimension{$dim}{$instance.'.optionalrequired'};
1.151     albertel 2209: 		    if ($opt_req !~ /\S/) {
                   2210: 			$opt_req=
                   2211: 			    &Apache::lonxml::get_param('OptionalRequired',
                   2212: 						       $parstack,$safeeval);
                   2213: 			if ($opt_req !~ /\S/) { $opt_req = 0; }
                   2214: 		    }
1.76      albertel 2215: 		    $dim_info.="\n<p>".&mt('You passed [_1] of the [_2] mandatory components and [_3] of the [_4] optional components, of which you were required to pass [_5].',$man_passed,$man_count,$opt_passed,$opt_count,$opt_req)."</p>\n</div>";
                   2216: 
                   2217: 		    my $internal_location=&internal_location($dim);
                   2218: 		    $result=~s/\Q$internal_location\E/$dim_info/;
                   2219: 
1.169     albertel 2220: 		    foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2221: 				    @{$dimension{$dim}{'criterias'}}) {
                   2222: 			my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
1.171     albertel 2223: 			if ($type eq 'dimension') {
                   2224: 			    $result.=$dimension{$id}{'result'};
                   2225: 			    next;
                   2226: 			}
1.22      albertel 2227: 		    }
                   2228: 		}
                   2229: 	    }
1.18      albertel 2230: 	} elsif ($target eq 'webgrade') {
1.47      albertel 2231: 	    # in case of any side effects that we need
1.173     albertel 2232: 	    &nested_parse(\$dimension{$dim}{'intro'},[@_]);
                   2233: 	    &nested_parse(\$dimension{$dim}{$instance.'.text'},[@_]);
                   2234: 	    $result.=
                   2235: 		&nested_parse(\$dimension{$dim}{'questiontext'},[@_],
1.180     albertel 2236: 			      {'set_dim_id'          => undef,
                   2237: 			       'delayed_dim_results' => 1});
1.169     albertel 2238: 	    foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2239: 			    @{$dimension{$dim}{'criterias'}} ) {
                   2240: 		my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
1.171     albertel 2241: 		if ($type eq 'dimension') {
                   2242: 		    # dimensional 'criteria' don't get assigned grades
1.173     albertel 2243: 		    $result.=
                   2244: 			&nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2245: 				      [@_],{'set_dim_id' => $id});
1.171     albertel 2246: 		    next;
                   2247: 		}
1.169     albertel 2248: 
1.151     albertel 2249: 		my $link=&link($id);
1.169     albertel 2250: 		my $status= &get_criteria('status',$version,$dim,$id);
1.120     albertel 2251: 		$result.='<div class="LC_GRADING_criteria" id="'.$link.'">'."\n".
1.136     albertel 2252: 		    '<div class="LC_GRADING_criteriatext" id="next_'.$last_link.'">'."\n";
1.173     albertel 2253: 		$result.=
                   2254: 		    &nested_parse(\$dimension{$dim}{'criteria.'.$id},[@_]);
                   2255: 
1.111     albertel 2256: 		$result.='</div>'."\n".
1.120     albertel 2257: 		    '<div class="LC_GRADING_grade">'."\n".
                   2258: 		    '<label class="LC_GRADING_ungraded"><input type="radio" name="HWVAL_'.$link.'" value="ungraded" '.($status eq 'ungraded' || !$status ? 'checked="checked"':'').' />'.&mt('Ungraded').'</label>'."\n".
                   2259: 		    '<label class="LC_GRADING_fail"><input type="radio" name="HWVAL_'.$link.'" value="fail" '.($status eq 'fail' ? 'checked="checked"':'').' />'.&mt('Fail').'</label>'."\n".
                   2260: 		    '<label class="LC_GRADING_pass"><input type="radio" name="HWVAL_'.$link.'" value="pass" '.($status eq 'pass' ? 'checked="checked"':'').' />'.&mt('Pass').'</label>'."\n".
                   2261: 		    '<label class="LC_GRADING_review"><input type="radio" name="HWVAL_'.$link.'" value="review" '.($status eq 'review' ? 'checked="checked"':'').' />'.&mt('Review').'</label>'."\n".
1.111     albertel 2262: 		    '</div>'."\n".
1.120     albertel 2263: 		    '<label class="LC_GRADING_comment">'.&mt('Additional Comment for Student')."\n".
1.169     albertel 2264: 		    '<textarea class="LC_GRADING_comment_area" name="HWVAL_comment_'.$link.'">'.&HTML::Entities::encode(&get_criteria('comment',$version,$dim,$id),'<>"&').'</textarea>'."\n".
1.111     albertel 2265: 		    '</label>'."\n".
1.120     albertel 2266: 		    '<ul class="LC_GRADING_navbuttons">'."\n".
1.111     albertel 2267: 		    '<li><a href="#'.$last_link.'">Prev</a></li>'."\n".
                   2268: 		    '<li><a href="#next_'.$link.'">Next</a></li>'."\n".
                   2269: 		    '</ul>'."\n".
                   2270:                     '</div>'."\n";
1.151     albertel 2271: 		$result.=&grading_history($version,$dim,$id);
1.18      albertel 2272: 		$last_link=$link;
                   2273: 	    }
1.180     albertel 2274: 	    if (&nest()) {
1.173     albertel 2275: 		&Apache::lonxml::debug(" for $dim stashing results into ".$dimension{$dim}{'nested'});
                   2276: 		$dimension{$dimension{$dim}{'nested'}}{'result'}.=$result;
1.171     albertel 2277: 		undef($result);
                   2278: 	    }
1.22      albertel 2279: 	} elsif ($target eq 'grade' && $env{'form.webgrade'}) {
1.19      albertel 2280: 	    my $optional_passed=0;
1.20      albertel 2281: 	    my $mandatory_failed=0;
                   2282: 	    my $ungraded=0;
                   2283: 	    my $review=0;
1.153     albertel 2284: 
1.173     albertel 2285: 	    $result .= &nested_parse(\$dimension{$dim}{'intro'},[@_]);
                   2286: 	    $result .= &nested_parse(\$dimension{$dim}{$instance.'.text'},
                   2287: 				     [@_]);
                   2288: 	    $result .= &nested_parse(\$dimension{$dim}{'questiontext'},
                   2289: 				     [@_],{'set_dim_id' => undef});
1.160     albertel 2290: 
1.169     albertel 2291: 	    foreach my $id (@{$dimension{$dim}{$instance.'.criterias'}},
                   2292: 			    @{$dimension{$dim}{'criterias'}}) {
1.151     albertel 2293: 		my $link=&link($id);
1.169     albertel 2294: 
                   2295: 		my $type = $dimension{$dim}{'criteria.'.$id.'.type'};
                   2296: 		if ($type eq 'criteria') {
                   2297: 		    # dimensional 'criteria' don't get assigned grades
                   2298: 		    $Apache::lonhomework::results{"resource.$version.0.$dim.$id.status"}=$env{'form.HWVAL_'.$link};
                   2299: 		    $Apache::lonhomework::results{"resource.$version.0.$dim.$id.comment"}=$env{'form.HWVAL_comment_'.$link};
1.173     albertel 2300: 		} else {
                   2301: 		    $result .=
                   2302: 			&nested_parse(\$dimension{$dim}{'criteria.'.$id},
                   2303: 				      [@_],{'set_dim_id' => $id});
1.169     albertel 2304: 		}
                   2305: 		my $status= &get_criteria('status',$version,$dim,$id);
                   2306: 
                   2307: 		my $mandatory=($dimension{$dim}{'criteria.'.$id.'.mandatory'} ne 'N');
1.20      albertel 2308: 		if ($status eq 'pass') {
                   2309: 		    if (!$mandatory) { $optional_passed++; }
                   2310: 		} elsif ($status eq 'fail') {
                   2311: 		    if ($mandatory) { $mandatory_failed++; }
1.21      albertel 2312: 		} elsif ($status eq 'review') {
                   2313: 		    $review++;
1.20      albertel 2314: 		} elsif ($status eq 'ungraded') {
                   2315: 		    $ungraded++;
1.21      albertel 2316: 		} else {
1.47      albertel 2317: 		    $ungraded++;
1.19      albertel 2318: 		}
                   2319: 	    }
1.151     albertel 2320: 	    # FIXME optional required can apply to only <instance> right now...
1.169     albertel 2321: 	    my $opt_req=$dimension{$dim}{$instance.'.optionalrequired'};
1.151     albertel 2322: 	    if ($opt_req !~ /\S/) {
                   2323: 		$opt_req=
                   2324: 		    &Apache::lonxml::get_param('OptionalRequired',
                   2325: 					       $parstack,$safeeval);
                   2326: 		if ($opt_req !~ /\S/) { $opt_req = 0; }
                   2327: 	    }
                   2328: 	    if ($optional_passed < $opt_req) {
1.20      albertel 2329: 		$mandatory_failed++;
                   2330: 	    }
1.169     albertel 2331: 	    &Apache::lonxml::debug("all instance ".join(':',@{$dimension{$dim}{$instance.'.criterias'}})." results -> m_f $mandatory_failed o_p $optional_passed u $ungraded r $review");
1.20      albertel 2332: 	    if ($review) {
1.89      albertel 2333: 		$Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
1.22      albertel 2334: 		    'review';
1.20      albertel 2335: 	    } elsif ($ungraded) {
1.89      albertel 2336: 		$Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
1.22      albertel 2337: 		    'ungraded';
1.20      albertel 2338: 	    } elsif ($mandatory_failed) {
1.89      albertel 2339: 		$Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
1.22      albertel 2340: 		    'fail';
1.20      albertel 2341: 	    } else {
1.91      albertel 2342: 		$Apache::lonhomework::results{"resource.$version.0.$dim.status"}=
1.22      albertel 2343: 		    'pass';
1.20      albertel 2344: 	    }
1.69      albertel 2345: 	} else {
                   2346: 	    # any other targets no output
                   2347: 	    undef($result);
1.13      albertel 2348: 	}
1.173     albertel 2349: 	&disable_dimension_parsing();
1.169     albertel 2350: 	pop(@Apache::bridgetask::dimension);
1.18      albertel 2351: 	return $result;
1.1       albertel 2352:     }
1.162     albertel 2353: 
                   2354:     sub end_Setup {
                   2355: 	my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
                   2356: 	my $result=&Apache::lonxml::endredirection();
                   2357: 	my $dim=&get_id($parstack,$safeeval);
                   2358: 	my $instance=&get_instance($dim);
                   2359: 	my $version=&get_version();
                   2360: 	if ($target eq 'web') {
                   2361: 	    @Apache::scripttag::parser_env = @_;
1.169     albertel 2362: 	    $result.=&Apache::scripttag::xmlparse($dimension{$dim}{'intro'});
1.162     albertel 2363: 	    my @instances = $instance;
                   2364: 	    if (&Apache::response::showallfoils()) {
1.169     albertel 2365: 		@instances = @{$dimension{$dim}{'instances'}};
1.162     albertel 2366: 	    }
                   2367: 	    foreach my $instance (@instances) {
                   2368: 		@Apache::scripttag::parser_env = @_;
1.169     albertel 2369: 		$result.=&Apache::scripttag::xmlparse($dimension{$dim}{$instance.'.text'});
1.162     albertel 2370: 		@Apache::scripttag::parser_env = @_;
1.169     albertel 2371: 		$result.=&Apache::scripttag::xmlparse($dimension{$dim}{'questiontext'});
1.162     albertel 2372: 	    }
                   2373: 	} elsif ($target eq 'webgrade' 
                   2374: 		 || $target eq 'grade' && $env{'form.webgrade'}) {
                   2375: 	    # in case of any side effects that we need
                   2376: 	    @Apache::scripttag::parser_env = @_;
1.169     albertel 2377: 	    &Apache::scripttag::xmlparse($dimension{$dim}{'intro'});
1.162     albertel 2378: 	    @Apache::scripttag::parser_env = @_;
1.169     albertel 2379: 	    &Apache::scripttag::xmlparse($dimension{$dim}{$instance.'.text'});
1.162     albertel 2380: 	    @Apache::scripttag::parser_env = @_;
1.169     albertel 2381: 	    &Apache::scripttag::xmlparse($dimension{$dim}{'questiontext'});
1.162     albertel 2382: 	} else {
                   2383: 	    # any other targets no output
                   2384: 	    undef($result);
                   2385: 	}
1.169     albertel 2386: 	pop(@Apache::bridgetask::dimension);
1.162     albertel 2387: 	return $result;
                   2388:     }
1.1       albertel 2389: }
                   2390: 
1.113     albertel 2391: sub grading_history {
1.151     albertel 2392:     my ($version,$dim,$id) = @_;
1.113     albertel 2393:     if (!&Apache::lonnet::allowed('mgq',$env{'request.course.id'})) {
                   2394: 	return '';
                   2395:     }
                   2396:     my ($result,$grader);
1.151     albertel 2397:     my $scope="resource.$version.0.$dim.$id";
1.113     albertel 2398:     foreach my $t (1..$Apache::lonhomework::history{'version'}) {
                   2399: 	if (exists($Apache::lonhomework::history{$t.':resource.0.regrader'})) {
                   2400: 	    my ($gname,$gdom) = 
1.138     albertel 2401: 		split(':',$Apache::lonhomework::history{$t.':resource.0.regrader'});
1.113     albertel 2402: 	    my $fullname = &Apache::loncommon::plainname($gname,$gdom);
                   2403: 	    $grader = &Apache::loncommon::aboutmewrapper($fullname,
                   2404: 							 $gname,$gdom);
                   2405: 	}
                   2406: 	my $entry;
                   2407: 	if (exists($Apache::lonhomework::history{"$t:$scope.status"})) {
                   2408: 	    $entry.="<tt>".$Apache::lonhomework::history{"$t:$scope.status"}.'</tt>';
                   2409: 	}
                   2410: 	if (exists($Apache::lonhomework::history{"$t:$scope.comment"})) {
                   2411: 	    $entry.=' comment: "'.$Apache::lonhomework::history{"$t:$scope.comment"}.'"';
                   2412: 	}
                   2413: 	if ($entry) {
                   2414: 	    $result.= "<li>$grader : $entry </li>";
                   2415: 	}
                   2416:     }
                   2417:     if ($result) {
1.120     albertel 2418: 	return '<ul class="LC_GRADING_pastgrading">'.$result.'</ul>';
1.113     albertel 2419:     }
                   2420:     return '';
                   2421: }
                   2422: 
1.1       albertel 2423: sub start_IntroParagraph {
1.87      albertel 2424:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel 2425:     my $result;
1.168     albertel 2426:     my $dim = &get_dim_id();
1.153     albertel 2427:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
1.151     albertel 2428: 	if ($tagstack->[-2] eq 'Dimension' || $tagstack->[-2] eq 'Question' ) {
1.169     albertel 2429: 	    $dimension{$dim}{'intro'}=
1.151     albertel 2430: 		&Apache::lonxml::get_all_text('/introparagraph',
                   2431: 					      $parser,$style);
                   2432:        	} elsif ($tagstack->[-2] eq 'Task' && $target eq 'webgrade') {
1.127     albertel 2433: 	    &Apache::lonxml::startredirection();
1.1       albertel 2434: 	}
1.47      albertel 2435: 	
1.1       albertel 2436:     }
                   2437:     return $result;
                   2438: }
                   2439: 
                   2440: sub end_IntroParagraph {
1.127     albertel 2441:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.128     albertel 2442:     if ($tagstack->[-2] eq 'Task' && $target eq 'webgrade') {
1.127     albertel 2443: 	my $result = &Apache::lonxml::endredirection();
                   2444:     }
1.1       albertel 2445: }
                   2446: 
                   2447: sub start_Instance {
                   2448:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.168     albertel 2449:     my $dim = &get_dim_id();
                   2450:     my $id  = &get_id($parstack,$safeeval);
1.169     albertel 2451:     push(@{$dimension{$dim}{'instances'}},$id);
1.168     albertel 2452:     push(@{$Apache::bridgetask::instance{$dim}},$id);
1.19      albertel 2453:     push(@Apache::bridgetask::instancelist,$id);
1.169     albertel 2454:     $dimension{$dim}{$id.'.optionalrequired'}=
1.19      albertel 2455: 	&Apache::lonxml::get_param('OptionalRequired',$parstack,$safeeval);
1.75      albertel 2456:     my $disabled = &Apache::lonxml::get_param('Disabled',$parstack,$safeeval);
                   2457:     if (lc($disabled) eq 'yes') {
1.169     albertel 2458: 	$dimension{$dim}{$id.'.disabled'}='1';
1.75      albertel 2459:     }
1.1       albertel 2460:     return '';
                   2461: }
                   2462: 
                   2463: sub end_Instance {
                   2464: }
                   2465: 
                   2466: sub start_InstanceText {
1.87      albertel 2467:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.168     albertel 2468:     my $dim = &get_dim_id();
                   2469:     my $instance_id=$Apache::bridgetask::instance{$dim}[-1];
1.87      albertel 2470:     my $text=&Apache::lonxml::get_all_text('/instancetext',$parser,$style);
1.153     albertel 2471:     if ($target eq 'grade' || $target eq 'web' || $target eq 'webgrade') {
1.169     albertel 2472: 	$dimension{$dim}{$instance_id.'.text'}=$text;
1.1       albertel 2473:     }
                   2474:     return '';
                   2475: }
                   2476: 
                   2477: sub end_InstanceText {
                   2478:     return '';
                   2479: }
                   2480: 
                   2481: sub start_Criteria {
1.87      albertel 2482:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   2483:     my $criteria=&Apache::lonxml::get_all_text('/criteria',$parser,$style);
1.190     albertel 2484:     my $result = '';
1.21      albertel 2485:     if ($target eq 'web' || $target eq 'webgrade' || $target eq 'grade') {
1.168     albertel 2486: 	my $dim = &get_dim_id();
1.19      albertel 2487: 	my $id=&get_id($parstack,$safeeval);
1.169     albertel 2488: 	&Apache::lonxml::debug("Criteria $id with $dim");
1.151     albertel 2489: 	if (&Apache::londefdef::is_inside_of($tagstack,'Instance')) {
1.168     albertel 2490: 	    my $instance_id=$Apache::bridgetask::instance{$dim}[-1];
1.169     albertel 2491: 	    $dimension{$dim}{"criteria.$instance_id.$id"}=$criteria;
                   2492: 	    $dimension{$dim}{"criteria.$instance_id.$id.type"}='criteria';
                   2493: 	    $dimension{$dim}{"criteria.$instance_id.$id.mandatory"}=
1.151     albertel 2494: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
1.169     albertel 2495: 	    push(@{$dimension{$dim}{$instance_id.'.criterias'}},"$instance_id.$id");
1.151     albertel 2496: 	} else {
1.169     albertel 2497: 	    $dimension{$dim}{'criteria.'.$id}=$criteria;
                   2498: 	    $dimension{$dim}{'criteria.'.$id.'.type'}='criteria';
                   2499: 	    $dimension{$dim}{'criteria.'.$id.'.mandatory'}=
1.151     albertel 2500: 		&Apache::lonxml::get_param('Mandatory',$parstack,$safeeval);
1.169     albertel 2501: 	    push(@{$dimension{$dim}{'criterias'}},$id);
1.190     albertel 2502: 
                   2503: 	    my $version=&get_version();
                   2504: 	    my $task_status = 
                   2505: 		$Apache::lonhomework::history{"resource.$version.0.status"};
                   2506: 	    if ($target eq 'web' 
                   2507: 		&& ($task_status eq 'pass' || $task_status eq 'fail')) {
                   2508: 		my $status= &get_criteria('status', $version,$dim,$id);
                   2509: 		my $comment=&get_criteria('comment',$version,$dim,$id);
                   2510: 		my $mandatory=($dimension{$dim}{'criteria.'.$id.'.mandatory'} ne 'N');
                   2511: 		if ($mandatory) {
                   2512: 		    $mandatory='Mandatory';
                   2513: 		} else {
                   2514: 		    $mandatory='Optional';
                   2515: 		}
                   2516: 		my $status_display=$status;
                   2517: 		$status_display=~s/^([a-z])/uc($1)/e;
                   2518: 		$result.=
                   2519: 		    '<div class="LC_'.$status.' LC_criteria"><h4>'
                   2520: 		    .$mandatory.' Criteria</h4><p>';
                   2521: 		$result.=
                   2522: 		    &nested_parse(\$dimension{$dim}{'criteria.'.$id},[@_]);
                   2523: 		$result.='</p><p class="LC_grade">'.$status_display.'</p>';
1.191     albertel 2524: 		if ($comment =~ /\w/) {
1.190     albertel 2525: 		    $result.='<p class="LC_comment">'.
                   2526: 			&mt('Comment: [_1]',$comment).'</p>';
                   2527: 		}
                   2528: 		$result.='</div>';
                   2529: 	    }
1.151     albertel 2530: 	}
1.1       albertel 2531:     }
1.190     albertel 2532:     return $result;
1.1       albertel 2533: }
                   2534: 
1.47      albertel 2535: sub end_Criteria {
                   2536: }
                   2537: 
1.186     albertel 2538: sub start_GraderNote {
                   2539:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   2540:     
                   2541:     if ($target eq 'webgrade') {
1.187     albertel 2542: 	return '<div class="LC_GRADING_gradernote"><b>'.
                   2543: 	    &mt('Note to graders:').'</b>';
1.186     albertel 2544:     }
                   2545:     my $note=&Apache::lonxml::get_all_text('/gradernote',$parser,$style); 
                   2546:     return;
                   2547: }
                   2548: 
                   2549: sub end_GraderNote {
                   2550:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                   2551: 
                   2552:     if ($target eq 'webgrade') {
                   2553: 	return '</div>';
                   2554:     }
                   2555:     return;
                   2556: }
                   2557: 
                   2558: 
                   2559: 
1.4       albertel 2560: sub proctor_validation_screen {
                   2561:     my ($slot) = @_;
1.185     albertel 2562:     my (undef,undef,$domain,$user) = &Apache::lonnet::whichuser();
1.5       albertel 2563:     my $url=&Apache::lonnet::studentphoto($domain,$user,'jpg');
1.44      albertel 2564:     my $name=&Apache::loncommon::plainname($user,$domain);
                   2565:     
1.4       albertel 2566:     my $msg;
1.11      albertel 2567:     if ($env{'form.proctorpassword'}) {
1.4       albertel 2568: 	$msg='<p><font color="red">'.&mt("Failed to authenticate the proctor.")
                   2569: 	    .'</font></p>';
                   2570:     }
1.47      albertel 2571:     if (!$env{'form.proctordomain'}) { $env{'form.proctordomain'}=$domain; }
1.4       albertel 2572:     my $result= (<<ENDCHECKOUT);
                   2573: <h2>Proctor Validation</h2>
                   2574:     <p>Your room's proctor needs to validate your access to this resource.</p>
                   2575:     $msg
1.115     albertel 2576: <form name="checkout" method="post" action="$env{'request.uri'}">
1.4       albertel 2577: <input type="hidden" name="validate" value="yes" />
                   2578: <input type="hidden" name="submitted" value="yes" />
                   2579: <table>
1.44      albertel 2580:   <tr><td>Proctor's Username:</td><td><input type="string" name="proctorname" value="$env{'form.proctorname'}" /></td></tr>
1.4       albertel 2581:   <tr><td>Password:</td><td><input type="password" name="proctorpassword" value="" /></td></tr>
1.46      albertel 2582:   <tr><td>Proctor's Domain:</td><td><input type="string" name="proctordomain" value="$env{'form.proctordomain'}" /></td></tr>
1.4       albertel 2583: </table>
                   2584: <input type="submit" name="checkoutbutton" value="Validate"  /><br />
1.44      albertel 2585: <table border="1">
                   2586:   <tr><td>
                   2587:     <table>
                   2588:       <tr><td colspan="2">Student who should be logged in is:</td></tr>
                   2589:       <tr><td>Name:</td><td>$name</td></tr>
1.45      albertel 2590:       <tr><td>Student ID:</td><td>$env{'environment.id'}</td></tr>
1.138     albertel 2591:       <tr><td>Usename</td><td>$user:$domain</td></tr>
1.44      albertel 2592:       <tr><td colspan="2"><img src="$url" /></td></tr>
                   2593:     </table>
                   2594:   </tr></td>
                   2595: </table>
1.4       albertel 2596: </form>
                   2597: ENDCHECKOUT
                   2598:     return $result;
                   2599: }
                   2600: 
1.1       albertel 2601: 1;
                   2602: __END__

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