--- loncom/interface/lonparmset.pm 2007/08/30 00:01:56 1.378
+++ loncom/interface/lonparmset.pm 2007/09/11 01:59:30 1.381
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.378 2007/08/30 00:01:56 albertel Exp $
+# $Id: lonparmset.pm,v 1.381 2007/09/11 01:59:30 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2109,13 +2109,13 @@ sub crsenv {
#
# 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);
@@ -2132,17 +2132,34 @@ sub crsenv {
$setoutput.=&mt('Unable to set').' '.$name.' '.&mt('to').
' '.$value.' '.&mt('due to').' '.$put_result.'.
';
}
- if (($name eq 'cloners') && ($failed_cloners)) {
- $setoutput.= &mt('Unable to include').' - '.$failed_cloners.', '.
- &mt('reason').' - '.&mt('LON-CAPA user(s) do(es) not exist').
- '.
'.&mt('Please ').
- ' '.
- &mt('add the user(s)').', '.
- &mt('and then return to the ').
- ''.
- &mt('Course Parameters page').' '.
- &mt('to add the new user(s) to the list of possible cloners').
- '.
';
+ 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] .= ''.$failed_cloners{'format'}.
+ ', '.&mt('reason').' - '.
+ &mt('Invalid format');
+ $num ++;
+ }
+ if (defined($failed_cloners{'domain'})) {
+ $fails[$num] .= ''.$failed_cloners{'domain'}.
+ ', '.&mt('reason').' - '.
+ &mt('Domain does not exist');
+ $num ++;
+ }
+ if (defined($failed_cloners{'newuser'})) {
+ $fails[$num] .= ''.$failed_cloners{'newuser'}. ', '.&mt('reason').' - '.
+ &mt('LON-CAPA user(s) do(es) not exist.').
+ '.
'.&mt('Please ').
+ ' '.
+ &mt('add the user(s)').', '.
+ &mt('and then return to the ').
+ ''.
+ &mt('Course Parameters page').' '.
+ &mt('to add the new user(s) to the list of possible cloners');
+ }
+ $setoutput .= join('; ',@fails).'.
';
}
}
}
@@ -2173,7 +2190,9 @@ sub crsenv {
'courseid' => ''.&mt('Course ID or number').
'
'.
'('.&mt('internal').', '.&mt('optional').')',
- 'cloners' => ''.&mt('Users allowed to clone course').'
(user:domain,user:domain)
'.&mt('Users with active Course Coordinator role in the course automatically have the right to clone it, and can be omitted from list.'),
+ 'cloners' => ''.&mt('Users allowed to clone course').'
(user:domain,user:domain,*:domain)
'.&mt('Users with active Course Coordinator role in course are permitted to clone and need not be included.
+Use *:domain to allow course to be cloned by anyone in the specified domain.
+Use * to allow unrestricted cloning in all domains.'),
'grading' => ''.&mt('Grading').'
'.
'"standard", "external", or "spreadsheet" '.&Apache::loncommon::help_open_topic('GradingOptions'),
'task_grading' => ''.&mt('Bridge Task Grading').'
'.
@@ -2563,6 +2582,26 @@ sub extractuser {
return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
}
+sub parse_listdata_key {
+ my ($key,$listdata) = @_;
+ # split into student/section affected, and
+ # the realm (folder/resource part and parameter
+ my ($student,$realm) =
+ ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
+ # if course wide student would be undefined
+ if (!defined($student)) {
+ ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
+ }
+ # strip off the .type if it's not the Question type parameter
+ if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
+ $realm=~s/\.type//;
+ }
+ # split into resource+part and parameter name
+ my ($res, $parm) = ($realm=~/^(.*)\.(.*)$/);
+ my ($res, $part) = ($res =~/^(.*)\.(.*)$/);
+ return ($student,$res,$part,$parm);
+}
+
sub listdata {
my ($r,$resourcedata,$listdata,$sortorder)=@_;
# Start list output
@@ -2574,40 +2613,48 @@ sub listdata {
$tableopen=0;
my $foundkeys=0;
my %keyorder=&standardkeyorder();
+
foreach my $thiskey (sort {
+ my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
+ my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
+
+ # get the numerical order for the param
+ $aparm=$keyorder{'parameter_0_'.$aparm};
+ $bparm=$keyorder{'parameter_0_'.$bparm};
+
+ my $result=0;
+
if ($sortorder eq 'realmstudent') {
- my ($astudent,$arealm)=($a=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
- my ($bstudent,$brealm)=($b=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
- if (!defined($astudent)) {
- ($arealm)=($a=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
- }
- if (!defined($bstudent)) {
- ($brealm)=($b=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
- }
- $arealm=~s/\.type//;
- my ($ares, $aparm) = ($arealm=~/^(.*)\.(.*)$/);
- $aparm=$keyorder{'parameter_0_'.$aparm};
- $brealm=~s/\.type//;
- my ($bres, $bparm) = ($brealm=~/^(.*)\.(.*)$/);
- $bparm=$keyorder{'parameter_0_'.$bparm};
- if ($ares eq $bres) {
- if (defined($aparm) && defined($bparm)) {
- ($aparm <=> $bparm);
- } elsif (defined($aparm)) {
- -1;
- } elsif (defined($bparm)) {
- 1;
- } else {
- ($arealm cmp $brealm) || ($astudent cmp $bstudent);
- }
- } else {
- ($arealm cmp $brealm) || ($astudent cmp $bstudent);
+ if ($ares ne $bres ) {
+ $result = ($ares cmp $bres);
+ } elsif ($astudent ne $bstudent) {
+ $result = ($astudent cmp $bstudent);
+ } elsif ($apart ne $bpart ) {
+ $result = ($apart cmp $bpart);
}
} else {
- $a cmp $b;
+ if ($astudent ne $bstudent) {
+ $result = ($astudent cmp $bstudent);
+ } elsif ($ares ne $bres ) {
+ $result = ($ares cmp $bres);
+ } elsif ($apart ne $bpart ) {
+ $result = ($apart cmp $bpart);
+ }
+ }
+
+ if (!$result) {
+ if (defined($aparm) && defined($bparm)) {
+ $result = ($aparm <=> $bparm);
+ } elsif (defined($aparm)) {
+ $result = -1;
+ } elsif (defined($bparm)) {
+ $result = 1;
+ }
}
+
+ $result;
} keys %{$listdata}) {
-
+
if ($$listdata{$thiskey.'.type'}) {
my $thistype=$$listdata{$thiskey.'.type'};
if ($$resourcedata{$thiskey.'.type'}) {
@@ -3063,48 +3110,63 @@ where $action is add or drop, and $clone
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) = @_;
@@ -3117,43 +3179,47 @@ sub change_clone {
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);
}
}
}