[LON-CAPA-cvs] cvs: loncom /automation Autocreate.pl batchcreatecourse.pm /interface loncommon.pm lonparmset.pm
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Mon, 03 Sep 2007 15:34:17 -0000
This is a MIME encoded message
--raeburn1188833657
Content-Type: text/plain
raeburn Mon Sep 3 11:34:17 2007 EDT
Modified files:
/loncom/interface lonparmset.pm loncommon.pm
/loncom/automation Autocreate.pl batchcreatecourse.pm
Log:
bug 5378.
lonparmset.pm
- Users allowed to clone course:
- can use wildcards (*:domain and *) for unrestricted cloning within a domain, and unrestricted cloning in all domains respectively.
- warning messages about invalid data separated into (a) invlaid format, invalid domain, non-existent user.
loncommon.pm
- cloning rights check accommodates wildcards.
- let the user know the course was not created, when the specified course to clone was non-existent, or cloning rights were missing.
Autocreate.pl
- improve format of logged messages.
batchcreatecourse.pm
- Since loncommon::construct_course() now terminates course creation when cloning rights check is not passed, early out to stop user creation and attempted enrollment in an uncreated course.
--raeburn1188833657
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20070903113417.txt"
Index: loncom/interface/lonparmset.pm
diff -u loncom/interface/lonparmset.pm:1.378 loncom/interface/lonparmset.pm:1.379
--- loncom/interface/lonparmset.pm:1.378 Wed Aug 29 20:01:56 2007
+++ loncom/interface/lonparmset.pm Mon Sep 3 11:34:12 2007
@@ -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.379 2007/09/03 15:34:12 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2109,13 +2109,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);
@@ -2132,17 +2132,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('; ',@fails).'.<br />';
}
}
}
@@ -2173,7 +2190,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 />'.
@@ -3076,35 +3095,51 @@
}
}
-
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$/) {
+ my @alldoms = &Apache::lonnet::all_domains();
+ if (!grep(/^\Q$udom\E$/,@alldoms)) {
+ $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) = @_;
@@ -3118,17 +3153,19 @@
&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 ($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);
}
}
}
@@ -3136,24 +3173,26 @@
}
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 ($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);
}
}
}
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.577 loncom/interface/loncommon.pm:1.578
--- loncom/interface/loncommon.pm:1.577 Fri Aug 31 13:58:47 2007
+++ loncom/interface/loncommon.pm Mon Sep 3 11:34:12 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.577 2007/08/31 17:58:47 raeburn Exp $
+# $Id: loncommon.pm,v 1.578 2007/09/03 15:34:12 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -6983,7 +6983,7 @@
############################################################
sub check_clone {
- my ($args) = @_;
+ my ($args,$linefeed) = @_;
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
@@ -6991,8 +6991,7 @@
my $can_clone = 0;
if ($clonehome eq 'no_host') {
- $clonemsg = &mt('Attempting to clone non-existing [_1]',
- $args->{'crstype'});
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
} else {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
@@ -7001,18 +7000,24 @@
my %clonehash = &Apache::lonnet::get('environment',['cloners'],
$args->{'clonedomain'},$args->{'clonecourse'});
my @cloners = split(/,/,$clonehash{'cloners'});
- my %roleshash =
- &Apache::lonnet::get_my_roles($args->{'ccuname'},
- $args->{'ccdomain'},'userroles',['active'],['cc'],
- [$args->{'clonedomain'}]);
- if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
- $can_clone = 1;
- } else {
- $clonemsg = &mt('The new course was not cloned from an existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ if (grep(/^\*$/,@cloners)) {
+ $can_clone = 1;
+ } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
+ $can_clone = 1;
+ } else {
+ my %roleshash =
+ &Apache::lonnet::get_my_roles($args->{'ccuname'},
+ $args->{'ccdomain'},
+ 'userroles',['active'],['cc'],
+ [$args->{'clonedomain'}]);
+ if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
+ $can_clone = 1;
+ } else {
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ }
}
- }
+ }
}
-
return ($can_clone, $clonemsg, $cloneid, $clonehome);
}
@@ -7029,9 +7034,11 @@
#
my ($can_clone, $clonemsg, $cloneid, $clonehome);
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
- ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args);
+ ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
if ($context ne 'auto') {
- $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
+ if ($clonemsg ne '') {
+ $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
+ }
}
$outcome .= $clonemsg.$linefeed;
Index: loncom/automation/Autocreate.pl
diff -u loncom/automation/Autocreate.pl:1.6 loncom/automation/Autocreate.pl:1.7
--- loncom/automation/Autocreate.pl:1.6 Sun Jul 1 23:36:47 2007
+++ loncom/automation/Autocreate.pl Mon Sep 3 11:34:16 2007
@@ -101,7 +101,13 @@
print $fh "Sending to batch - auto,$defdom,$dcname,$dcdom ".join(":",@requests)."\n";
my ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(\@requests,\%courseids,'auto',$defdom,$dcname,$dcdom);
- print $fh "$result && $logmsg\n";
+ my $output;
+ if ($result ne '') {
+ $output = $result."\n";
+ }
+ if ($logmsg ne '') {
+ $output .= $logmsg."\n";
+ }
# Copy requests from pending directory to processed directory and unlink.
foreach my $request (@requests) {
@@ -121,7 +127,6 @@
}
}
- my $output;
foreach my $key (sort keys %courseids) {
print $fh "created course: $key - $courseids{$key}\n";
my $newcourse = &Apache::lonnet::escape($key.':'.$courseids{$key});
Index: loncom/automation/batchcreatecourse.pm
diff -u loncom/automation/batchcreatecourse.pm:1.23 loncom/automation/batchcreatecourse.pm:1.24
--- loncom/automation/batchcreatecourse.pm:1.23 Thu Aug 23 17:54:37 2007
+++ loncom/automation/batchcreatecourse.pm Mon Sep 3 11:34:16 2007
@@ -1,5 +1,5 @@
#
-# $Id: batchcreatecourse.pm,v 1.23 2007/08/23 21:54:37 albertel Exp $
+# $Id: batchcreatecourse.pm,v 1.24 2007/09/03 15:34:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -499,6 +499,9 @@
}
my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context);
$$logmsg .= $msg;
+ if (!$success) {
+ return;
+ }
} else {
return;
}
--raeburn1188833657--