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

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

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