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

[raeburn]

raeburn		Mon Sep  7 17:44:11 2015 EDT

  Modified files:              
    /loncom/interface	slotrequest.pm 
  Log:
  - Bug 6796. Fields: "allowedsections" and "allowedusers" are advertised 
    as being available for assignment to columns in uploaded slot list (csv file)
    - Add code to include validated data assigned to either of those fields 
      into the stored slot definition(s).
  
  
Index: loncom/interface/slotrequest.pm
diff -u loncom/interface/slotrequest.pm:1.123 loncom/interface/slotrequest.pm:1.124
--- loncom/interface/slotrequest.pm:1.123	Tue Jun 23 16:09:43 2015
+++ loncom/interface/slotrequest.pm	Mon Sep  7 17:44:11 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler for requesting to have slots added to a students record
 #
-# $Id: slotrequest.pm,v 1.123 2015/06/23 16:09:43 raeburn Exp $
+# $Id: slotrequest.pm,v 1.124 2015/09/07 17:44:11 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -37,7 +37,7 @@
 use Apache::lonnavmaps();
 use Date::Manip;
 use lib '/home/httpd/lib/perl/';
-use LONCAPA;
+use LONCAPA qw(:DEFAULT :match);
 
 sub fail {
     my ($r,$code)=@_;
@@ -2779,7 +2779,37 @@
 		$slot{$key}=$entries{$fields{$key}};
 	    }
 	}
-
+        if ($entries{$fields{'allowedusers'}}) {
+            $entries{$fields{'allowedusers'}} =~ s/^\s+//;
+            $entries{$fields{'allowedusers'}} =~ s/\s+$//;
+            my @allowedusers;
+            foreach my $poss (split(/\s*,\s*/,$entries{$fields{'allowedusers'}})) {
+                my ($possuname,$possudom) = split(/:/,$poss);
+                if (($possuname =~ /^$match_username$/) && ($possudom =~ /^$match_domain$/)) {
+                    unless (grep(/^\Q$poss\E$/, at allowedusers)) {
+                        push(@allowedusers,$poss);
+                    }
+                }
+            }
+            if (@allowedusers > 0) {
+                $slot{'allowedusers'} = join(',', at allowedusers);
+            }
+        }
+        if ($entries{$fields{'allowedsections'}}) {
+            $entries{$fields{'allowedsections'}} =~ s/^\s+//;
+            $entries{$fields{'allowedsections'}} =~ s/\s+$//;
+            my @allowedsections;
+            foreach my $poss (split(/\s*,\s*/,$entries{$fields{'allowedsections'}})) {
+                if (($poss !~ /\W/) && ($poss ne 'none')) {
+                    unless (grep(/^\Q$poss\E$/, at allowedsections)) {
+                        push(@allowedsections,$poss);
+                    }
+                }
+            }
+            if (@allowedsections > 0) {
+                $slot{'allowedsections'} = join(',', at allowedsections);
+            }
+        }
 	if ($entries{$fields{'uniqueperiod'}}) {
 	    my ($start,$end)=split(',',$entries{$fields{'uniqueperiod'}});
 	    my @times=(&UnixDate($start,"%s"),