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

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

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