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

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

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