[LON-CAPA-cvs] cvs: loncom /interface lonparmset.pm

[raeburn]

raeburn		Sun Mar  1 03:33:29 2009 EDT

  Modified files:              
    /loncom/interface	lonparmset.pm 
  Log:
  Bug 5822.
    - availablestudent parameter (for student-selectable slot reservations).
     - only provide selectable links for this parameter in table mode
       for user-specific settings for course, folder or resource.
       - update slotreservations.db if parameter is changed for a user from the
         parameter table by a CC/IN.
       - log transactions to nohist_slotreservationslog.db
  
  
Index: loncom/interface/lonparmset.pm
diff -u loncom/interface/lonparmset.pm:1.436 loncom/interface/lonparmset.pm:1.437
--- loncom/interface/lonparmset.pm:1.436	Sun Mar  1 01:12:20 2009
+++ loncom/interface/lonparmset.pm	Sun Mar  1 03:33:29 2009
@@ -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 @@
     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
     $r->print('<td style="background-color:'.(($result==$which)?'#AAFFAA':$defbg).
               ';" align="center">');
-    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('</td>'."\n");
 }
@@ -1797,6 +1805,39 @@
         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 @@
     $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);