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

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

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