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

albertel lon-capa-cvs-allow@mail.lon-capa.org
Fri, 05 Oct 2007 17:56:32 -0000


This is a MIME encoded message

--albertel1191606992
Content-Type: text/plain

albertel		Fri Oct  5 13:56:32 2007 EDT

  Modified files:              (Branch: version_2_5_X)
    /loncom/interface	lonparmset.pm 
  Log:
  - backport 1.379 1.380
  
  
--albertel1191606992
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20071005135632.txt"

Index: loncom/interface/lonparmset.pm
diff -u loncom/interface/lonparmset.pm:1.376 loncom/interface/lonparmset.pm:1.376.2.1
--- loncom/interface/lonparmset.pm:1.376	Mon Aug 20 18:31:59 2007
+++ loncom/interface/lonparmset.pm	Fri Oct  5 13:56:29 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to set parameters for assessments
 #
-# $Id: lonparmset.pm,v 1.376 2007/08/20 22:31:59 albertel Exp $
+# $Id: lonparmset.pm,v 1.376.2.1 2007/10/05 17:56:29 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2101,13 +2101,13 @@
         #
         # Let the user know we made the changes
         if ($name && defined($value)) {
-            my $failed_cloners;
+            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);
+                %failed_cloners = &check_cloners(\$value,\@oldcloner);
             }
             my $put_result = &Apache::lonnet::put('environment',
                                                   {$name=>$value},$dom,$crs);
@@ -2124,17 +2124,34 @@
                 $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 />';
+            if (($name eq 'cloners') && (keys(%failed_cloners) > 0)) {
+                $setoutput.= &mt('Unable to include').': ';
+                my @fails;
+                my $num = 0;
+                if (defined($failed_cloners{'format'})) {
+                    $fails[$num] .= '<b>'.$failed_cloners{'format'}.
+                                  '</b>, '.&mt('reason').' - '.
+                                  &mt('Invalid format');
+                    $num ++;
+                }
+                if (defined($failed_cloners{'domain'})) {
+                    $fails[$num] .= '<b>'.$failed_cloners{'domain'}.
+                                  '</b>, '.&mt('reason').' - '.
+                                  &mt('Domain does not exist');
+                    $num ++;
+                }
+                if (defined($failed_cloners{'newuser'})) {
+                    $fails[$num] .= '<b>'.$failed_cloners{'newuser'}.                                   '</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="/adm/parmset?action=crsenv">'.
+                        &mt('Course Parameters page').'</a> '.
+                        &mt('to add the new user(s) to the list of possible cloners');
+                }
+                $setoutput .= join(';&nbsp;&nbsp;',@fails).'.<br />';
             }
         }
     }
@@ -2165,7 +2182,9 @@
              'courseid'       => '<b>'.&mt('Course ID or number').
                                  '</b><br />'.
                                  '('.&mt('internal').', '.&mt('optional').')',
-             'cloners'        => '<b>'.&mt('Users allowed to clone course').'</b><br /><tt>(user:domain,user:domain)</tt><br />'.&mt('Users with active Course Coordinator role in the course automatically have the right to clone it, and can be omitted from list.'),
+             'cloners'        => '<b>'.&mt('Users allowed to clone course').'</b><br /><tt>(user:domain,user:domain,*:domain)</tt><br />'.&mt('Users with active Course Coordinator role in course are permitted to clone and need not be included.<br />
+Use *:domain to allow course to be cloned by anyone in the specified domain.<br />
+Use * to allow unrestricted cloning in all domains.'),
              'grading'        => '<b>'.&mt('Grading').'</b><br />'.
                                  '<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'),
 	     'task_grading'   => '<b>'.&mt('Bridge Task Grading').'</b><br />'.
@@ -3055,48 +3074,63 @@
 user for whom cloning ability is to be changed in course. 
 
 =cut
-                                                                                            
+
 ##################################################
 ##################################################
 
 sub extract_cloners {
     my ($clonelist,$allowclone) = @_;
     if ($clonelist =~ /,/) {
-        @{$allowclone} = split/,/,$clonelist;
+        @{$allowclone} = split(/,/,$clonelist);
     } else {
         $$allowclone[0] = $clonelist;
     }
 }
 
-
 sub check_cloners {
     my ($clonelist,$oldcloner) = @_;
-    my ($clean_clonelist,$disallowed);
+    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.',';   
+        if (!grep(/^\Q$currclone\E$/,@$oldcloner)) {
+            if ($currclone eq '*') {
+                $clean_clonelist .= $currclone.',';
+            } else {
+                my ($uname,$udom) = split(/:/,$currclone);
+                if ($uname eq '*') {
+                    if ($udom =~ /^$match_domain$/) {
+                        if (!&Apache::lonnet::domain($udom)) {
+                            $disallowed{'domain'} .= $currclone.',';
+                        } else {
+                            $clean_clonelist .= $currclone.',';
+                        }
+                    } else {
+                        $disallowed{'format'} .= $currclone.',';
+                    }
+                } elsif ($currclone !~/^($match_username)\:($match_domain)$/) {
+                    $disallowed{'format'} .= $currclone.','; 
                 } else {
-                    $clean_clonelist .= $currclone.',';
+                    if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
+                        $disallowed{'newuser'} .= $currclone.',';
+                    } else {
+                        $clean_clonelist .= $currclone.',';
+                    }
                 }
             }
         } else {
             $clean_clonelist .= $currclone.',';
         }
     }
-    if ($disallowed) {
-        $disallowed =~ s/,$//;
+    foreach my $key (keys(%disallowed)) {
+        $disallowed{$key} =~ s/,$//;
     }
     if ($clean_clonelist) {
         $clean_clonelist =~ s/,$//;
     }
     $$clonelist = $clean_clonelist;
-    return $disallowed;
-}  
+    return %disallowed;
+}
 
 sub change_clone {
     my ($clonelist,$oldcloner) = @_;
@@ -3109,43 +3143,47 @@
         my @allowclone;
         &extract_cloners($clonelist,\@allowclone);
         foreach my $currclone (@allowclone) {
-            if (!grep/^$currclone$/,@$oldcloner) {
-                ($uname,$udom) = split/:/,$currclone;
-                if ($uname && $udom) {
-                    unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
-                        my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
-                        if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
-                            if ($currclonecrs{'cloneable'} eq '') {
-                                $currclonecrs{'cloneable'} = $clone_crs;
-                            } else {
-                                $currclonecrs{'cloneable'} .= ','.$clone_crs;
+            if (!grep(/^$currclone$/,@$oldcloner)) {
+                if ($currclone ne '*') {
+                    ($uname,$udom) = split(/:/,$currclone);
+                    if ($uname && $udom && $uname ne '*') {
+                        if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') {
+                            my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
+                            if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
+                                if ($currclonecrs{'cloneable'} eq '') {
+                                    $currclonecrs{'cloneable'} = $clone_crs;
+                                } else {
+                                    $currclonecrs{'cloneable'} .= ','.$clone_crs;
+                                }
+                                &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
                             }
-                            &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
                         }
                     }
                 }
             }
         }
         foreach my $oldclone (@$oldcloner) {
-            if (!grep/^$oldclone$/,@allowclone) {
-                ($uname,$udom) = split/:/,$oldclone;
-                if ($uname && $udom) {
-                    unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
-                        my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
-                        my %newclonecrs = ();
-                        if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
-                            if ($currclonecrs{'cloneable'} =~ /,/) {
-                                my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
-                                foreach (@currclonecrs) {
-                                    unless ($_ eq $clone_crs) {
-                                        $newclonecrs{'cloneable'} .= $_.',';
+            if (!grep(/^\Q$oldclone\E$/,@allowclone)) {
+                if ($oldclone ne '*') {
+                    ($uname,$udom) = split(/:/,$oldclone);
+                    if ($uname && $udom && $uname ne '*' ) {
+                        if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') {
+                            my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
+                            my %newclonecrs = ();
+                            if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
+                                if ($currclonecrs{'cloneable'} =~ /,/) {
+                                    my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
+                                    foreach my $crs (@currclonecrs) {
+                                        if ($crs ne $clone_crs) {
+                                            $newclonecrs{'cloneable'} .= $crs.',';
+                                        }
                                     }
+                                    $newclonecrs{'cloneable'} =~ s/,$//;
+                                } else {
+                                    $newclonecrs{'cloneable'} = '';
                                 }
-                                $newclonecrs{'cloneable'} =~ s/,$//;
-                            } else {
-                                $newclonecrs{'cloneable'} = '';
+                                &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
                             }
-                            &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
                         }
                     }
                 }

--albertel1191606992--