version 1.379, 2007/09/03 15:34:12
|
version 1.380, 2007/09/05 00:58:57
|
Line 3082 where $action is add or drop, and $clone
|
Line 3082 where $action is add or drop, and $clone
|
user for whom cloning ability is to be changed in course. |
user for whom cloning ability is to be changed in course. |
|
|
=cut |
=cut |
|
|
################################################## |
################################################## |
################################################## |
################################################## |
|
|
sub extract_cloners { |
sub extract_cloners { |
my ($clonelist,$allowclone) = @_; |
my ($clonelist,$allowclone) = @_; |
if ($clonelist =~ /,/) { |
if ($clonelist =~ /,/) { |
@{$allowclone} = split/,/,$clonelist; |
@{$allowclone} = split(/,/,$clonelist); |
} else { |
} else { |
$$allowclone[0] = $clonelist; |
$$allowclone[0] = $clonelist; |
} |
} |
Line 3101 sub check_cloners {
|
Line 3101 sub check_cloners {
|
my @allowclone = (); |
my @allowclone = (); |
&extract_cloners($$clonelist,\@allowclone); |
&extract_cloners($$clonelist,\@allowclone); |
foreach my $currclone (@allowclone) { |
foreach my $currclone (@allowclone) { |
if (!grep/^\Q$currclone\E$/,@$oldcloner) { |
if (!grep(/^\Q$currclone\E$/,@$oldcloner)) { |
if ($currclone eq '*') { |
if ($currclone eq '*') { |
$clean_clonelist .= $currclone.','; |
$clean_clonelist .= $currclone.','; |
} else { |
} else { |
my ($uname,$udom) = split(/:/,$currclone); |
my ($uname,$udom) = split(/:/,$currclone); |
if ($uname eq '*') { |
if ($uname eq '*') { |
if ($udom =~ /^$match_domain$/) { |
if ($udom =~ /^$match_domain$/) { |
my @alldoms = &Apache::lonnet::all_domains(); |
if (!&Apache::lonnet::domain($udom)) { |
if (!grep(/^\Q$udom\E$/,@alldoms)) { |
|
$disallowed{'domain'} .= $currclone.','; |
$disallowed{'domain'} .= $currclone.','; |
} else { |
} else { |
$clean_clonelist .= $currclone.','; |
$clean_clonelist .= $currclone.','; |
Line 3152 sub change_clone {
|
Line 3151 sub change_clone {
|
my @allowclone; |
my @allowclone; |
&extract_cloners($clonelist,\@allowclone); |
&extract_cloners($clonelist,\@allowclone); |
foreach my $currclone (@allowclone) { |
foreach my $currclone (@allowclone) { |
if (!grep/^$currclone$/,@$oldcloner) { |
if (!grep(/^$currclone$/,@$oldcloner)) { |
if ($currclone ne '*') { |
if ($currclone ne '*') { |
($uname,$udom) = split/:/,$currclone; |
($uname,$udom) = split(/:/,$currclone); |
if ($uname && $udom && $uname ne '*') { |
if ($uname && $udom && $uname ne '*') { |
if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') { |
if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') { |
my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable'); |
my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable'); |
Line 3172 sub change_clone {
|
Line 3171 sub change_clone {
|
} |
} |
} |
} |
foreach my $oldclone (@$oldcloner) { |
foreach my $oldclone (@$oldcloner) { |
if (!grep/^$oldclone$/,@allowclone) { |
if (!grep(/^\Q$oldclone\E$/,@allowclone)) { |
if ($oldclone ne '*') { |
if ($oldclone ne '*') { |
($uname,$udom) = split/:/,$oldclone; |
($uname,$udom) = split(/:/,$oldclone); |
if ($uname && $udom && $uname ne '*' ) { |
if ($uname && $udom && $uname ne '*' ) { |
if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') { |
if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') { |
my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable'); |
my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable'); |