--- loncom/interface/lonparmset.pm 2009/03/01 01:12:20 1.436
+++ loncom/interface/lonparmset.pm 2009/03/01 03:33:29 1.437
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.436 2009/03/01 01:12:20 raeburn Exp $
+# $Id: lonparmset.pm,v 1.437 2009/03/01 03:33:29 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1076,12 +1076,20 @@ sub print_td {
my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
$r->print('
');
- if ($which<11 || $which > 12) {
- $r->print(&plink($$typeoutpar[$which],
- $$display{$value},$$outpar[$which],
- $mprefix."$which",'parmform.pres','psub'));
+ my $nolink = 0;
+ if ($which == 11 || $which == 12) {
+ $nolink = 1;
+ } elsif ($mprefix =~ /availablestudent\&$/) {
+ if ($which > 3) {
+ $nolink = 1;
+ }
+ }
+ if ($nolink) {
+ $r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
} else {
- $r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
+ $r->print(&plink($$typeoutpar[$which],
+ $$display{$value},$$outpar[$which],
+ $mprefix."$which",'parmform.pres','psub'));
}
$r->print(' | '."\n");
}
@@ -1797,6 +1805,39 @@ sub assessparms {
my @values=split(/\&\&\&/,$env{'form.pres_value'});
my @types=split(/\&\&\&/,$env{'form.pres_type'});
for (my $i=0;$i<=$#markers;$i++) {
+ if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3)$/) {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my (@ok_slots,@fail_slots,@del_slots);
+ my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
+ my ($level,@all) =
+ &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
+ $csec,$cgroup,$courseopt);
+ foreach my $slot_name (split(/:/,$values[$i])) {
+ next if ($slot_name eq '');
+ if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
+ push(@ok_slots,$slot_name);
+
+ } else {
+ push(@fail_slots,$slot_name);
+ }
+ }
+ if (@ok_slots) {
+ $values[$i] = join(':',@ok_slots);
+ } else {
+ $values[$i] = '';
+ }
+ if ($all[$level] ne '') {
+ my @existing = split(/:/,$all[$level]);
+ foreach my $slot_name (@existing) {
+ if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
+ if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
+ push(@del_slots,$slot_name);
+ }
+ }
+ }
+ }
+ }
$message.=&storeparm(split(/\&/,$markers[$i]),
$values[$i],
$types[$i],
@@ -4642,6 +4683,79 @@ sub parm_change_log {
$r->print(&Apache::loncommon::end_page());
}
+sub update_slots {
+ my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
+ my %slot=&Apache::lonnet::get_slot($slot_name);
+ if (!keys(%slot)) {
+ return 'error: slot does not exist';
+ }
+ my $max=$slot{'maxspace'};
+ if (!defined($max)) { $max=99999; }
+
+ my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
+ "^$slot_name\0");
+ my ($tmp)=%consumed;
+ if ($tmp=~/^error: 2 / ) {
+ return 'error: unable to determine current slot status';
+ }
+ my $last=0;
+ foreach my $key (keys(%consumed)) {
+ my $num=(split('\0',$key))[1];
+ if ($num > $last) { $last=$num; }
+ if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
+ return 'ok';
+ }
+ }
+
+ if (scalar(keys(%consumed)) >= $max) {
+ return 'error: no space left in slot';
+ }
+ my $wanted=$last+1;
+
+ my %reservation=('name' => $uname.':'.$udom,
+ 'timestamp' => time,
+ 'symb' => $symb);
+
+ my $success=&Apache::lonnet::newput('slot_reservations',
+ {"$slot_name\0$wanted" =>
+ \%reservation},
+ $cdom, $cnum);
+ return $success;
+}
+
+sub delete_slots {
+ my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
+ my $delresult;
+ my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
+ $cnum, "^$slot_name\0");
+ if (&Apache::lonnet::error(%consumed)) {
+ return 'error: unable to determine current slot status';
+ }
+ my ($tmp)=%consumed;
+ if ($tmp=~/^error: 2 /) {
+ return 'error: unable to determine current slot status';
+ }
+ foreach my $key (keys(%consumed)) {
+ if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
+ my $num=(split('\0',$key))[1];
+ my $entry = $slot_name.'\0'.$num;
+ $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
+ $cdom,$cnum);
+ if ($delresult eq 'ok') {
+ my %storehash = (
+ symb => $symb,
+ slot => $slot_name,
+ action => 'release',
+ context => 'parameter',
+ );
+ &Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
+ 1,$uname,$udom,$cnum,$cdom);
+ }
+ }
+ }
+ return $delresult;
+}
+
sub check_for_course_info {
my $navmap = Apache::lonnavmaps::navmap->new();
return 1 if ($navmap);