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

[raeburn]

raeburn		Tue Jul 19 12:42:09 2005 EDT

  Modified files:              
    /loncom/interface	lonparmset.pm 
  Log:
  Checks if username:domain exists when adding new cloners. 
  
  
Index: loncom/interface/lonparmset.pm
diff -u loncom/interface/lonparmset.pm:1.238 loncom/interface/lonparmset.pm:1.239
--- loncom/interface/lonparmset.pm:1.238	Wed Jun 29 07:57:17 2005
+++ loncom/interface/lonparmset.pm	Tue Jul 19 12:42:02 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to set parameters for assessments
 #
-# $Id: lonparmset.pm,v 1.238 2005/06/29 11:57:17 www Exp $
+# $Id: lonparmset.pm,v 1.239 2005/07/19 16:42:02 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1769,9 +1769,13 @@
         #
         # Let the user know we made the changes
         if ($name && defined($value)) {
+            my $failed_cloners;
             if ($name eq 'cloners') {
+                $value =~ s/\s//g;
                 $value =~ s/^,//;
                 $value =~ s/,$//;
+                # check requested clones are valid users.
+                $failed_cloners = &check_cloners(\$value,\@oldcloner);
             }
             my $put_result = &Apache::lonnet::put('environment',
                                                   {$name=>$value},$dom,$crs);
@@ -1788,6 +1792,18 @@
                 $setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to').
 		    ' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />';
             }
+            if (($name eq 'cloners') && ($failed_cloners)) {
+                $setoutput.= &mt('Unable to include').' - <b>'.$failed_cloners.'</b>, '.
+                 &mt('reason').' - '.&mt('LON-CAPA user(s) do(es) not exist').
+                 '.<br />'.&mt('Please ').
+                 ' <a href="/adm/createuser">'.
+                 &mt('add the user(s)').'</a>, '.
+                 &mt('and then return to the ').
+                 '<a href="/admparmset?action=crsenv">'.
+                 &mt('Course Parameters page').'</a> '.
+                 &mt('to add the new user(s) to the list of possible cloners').
+                 '.<br />';
+            }
         }
     }
 # ------------------------- Re-init course environment entries for this session
@@ -2490,25 +2506,76 @@
 ##################################################
                                                                                             
 =pod
-                                                                                            
-=item change clone
-                                                                                            
+
+=item check_cloners
+
+Checks if new users included in list of allowed cloners
+are valid users.  Replaces supplied list with 
+cleaned list containing only users with valid usernames
+and domains.
+
+Inputs: $clonelist, $oldcloner 
+where $clonelist is ref to array of requested cloners,
+and $oldcloner is ref to array of currently allowed
+cloners.
+
+Returns: string - comma separated list of requested
+cloners (username:domain) who do not exist in system.
+
+=item change_clone
+
 Modifies the list of courses a user can clone (stored
-in the user's environemnt.db file), called when a
+in the user's environment.db file), called when a
 change is made to the list of users allowed to clone
 a course.
-                                                                                            
+
 Inputs: $action,$cloner
 where $action is add or drop, and $cloner is identity of 
 user for whom cloning ability is to be changed in course. 
-                                                                                            
-Returns: 
 
 =cut
                                                                                             
 ##################################################
 ##################################################
 
+sub extract_cloners {
+    my ($clonelist,$allowclone) = @_;
+    if ($clonelist =~ /,/) {
+        @{$allowclone} = split/,/,$clonelist;
+    } else {
+        $$allowclone[0] = $clonelist;
+    }
+}
+
+
+sub check_cloners {
+    my ($clonelist,$oldcloner) = @_;
+    my ($clean_clonelist,$disallowed);
+    my @allowclone = ();
+    &extract_cloners($$clonelist,\@allowclone);
+    foreach my $currclone (@allowclone) {
+        if (!grep/^$currclone$/,@$oldcloner) {
+            my ($uname,$udom) = split/:/,$currclone;
+            if ($uname && $udom) {
+                if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
+                    $disallowed .= $currclone.',';   
+                } else {
+                    $clean_clonelist .= $currclone.',';
+                }
+            }
+        } else {
+            $clean_clonelist .= $currclone.',';
+        }
+    }
+    if ($disallowed) {
+        $disallowed =~ s/,$//;
+    }
+    if ($clean_clonelist) {
+        $clean_clonelist =~ s/,$//;
+    }
+    $$clonelist = $clean_clonelist;
+    return $disallowed;
+}  
 
 sub change_clone {
     my ($clonelist,$oldcloner) = @_;
@@ -2518,12 +2585,8 @@
     my $clone_crs = $cnum.':'.$cdom;
     
     if ($cnum && $cdom) {
-        my @allowclone = ();
-        if ($clonelist =~ /,/) {
-            @allowclone = split/,/,$clonelist;
-        } else {
-            $allowclone[0] = $clonelist;
-        }
+        my @allowclone;
+        &extract_cloners($clonelist,\@allowclone);
         foreach my $currclone (@allowclone) {
             if (!grep/^$currclone$/,@$oldcloner) {
                 ($uname,$udom) = split/:/,$currclone;