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

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

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