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

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

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