[LON-CAPA-cvs] cvs: loncom /automation batchcreatecourse.pm /interface loncommon.pm /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Sat, 08 Aug 2009 19:55:25 -0000
This is a MIME encoded message
--raeburn1249761325
Content-Type: text/plain
raeburn Sat Aug 8 19:55:25 2009 EDT
Modified files:
/loncom/interface loncommon.pm
/loncom/automation batchcreatecourse.pm
/loncom/lonnet/perl lonnet.pm
Log:
Course Requests
- lonnet.pm
- generation of unique coursenum move to own routine: &generate_coursenum()
- prefacing of coursenum with number then letter added to second attempt
to generate an ID (to duplicate change in first attempt in rev 1.674).
- additional optional argument to &createcourse() - can use a previously
generated, but unused, coursenum (will be hashkey in a queued course request).
- loncommon.pm
- additional optional argument to &construct_course() - $cnum, previously
generated, but unused, coursenum.
- check_clone() - unrestricted cloning in course's in role's domain now
requires creator has ccc privilege in role's domain.
- batchcreatecourse.pm
- &build_course() - update documentation, and new optional arg
previously generated, but unused, coursenum
--raeburn1249761325
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20090808195525.txt"
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.881 loncom/interface/loncommon.pm:1.882
--- loncom/interface/loncommon.pm:1.881 Thu Aug 6 20:40:59 2009
+++ loncom/interface/loncommon.pm Sat Aug 8 19:55:04 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.881 2009/08/06 20:40:59 raeburn Exp $
+# $Id: loncommon.pm,v 1.882 2009/08/08 19:55:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -9860,7 +9860,8 @@
$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'}) {
+ if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
+ (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
$can_clone = 1;
} else {
my %clonehash = &Apache::lonnet::get('environment',['cloners'],
@@ -9888,7 +9889,7 @@
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum) = @_;
my $outcome;
my $linefeed = '<br />'."\n";
if ($context eq 'auto') {
@@ -9926,7 +9927,8 @@
$args->{'crscode'},
$args->{'ccuname'}.':'.
$args->{'ccdomain'},
- $args->{'crstype'});
+ $args->{'crstype'},
+ $cnum);
# Note: The testing routines depend on this being output; see
# Utils::Course. This needs to at least be output as a comment
Index: loncom/automation/batchcreatecourse.pm
diff -u loncom/automation/batchcreatecourse.pm:1.27 loncom/automation/batchcreatecourse.pm:1.28
--- loncom/automation/batchcreatecourse.pm:1.27 Wed Jul 2 18:44:16 2008
+++ loncom/automation/batchcreatecourse.pm Sat Aug 8 19:55:15 2009
@@ -1,5 +1,5 @@
#
-# $Id: batchcreatecourse.pm,v 1.27 2008/07/02 18:44:16 raeburn Exp $
+# $Id: batchcreatecourse.pm,v 1.28 2009/08/08 19:55:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -370,7 +370,7 @@
# build_course()
#
# inputs
-# domain
+# course domain
# course request number
# context - auto if called from command line, web if called from DC web interface
# ref to hash of course creation information
@@ -379,8 +379,13 @@
# ref to scalar used to accumulate messages sent to new users
# ref to scalar used to accumulate results of new user additions
# ref to hash of enrollment counts for different roles
-# ref to scalar used to accumulate iformation about added roles
-# ref to scalar used to accumulate
+# ref to scalar used to accumulate information about added roles
+# ref to scalar used to accumulate
+# ref to scalar used to accumulate information about access keys
+# domain of DC creating course
+# username of DC creating course
+# optional course number, if unique course number already obtained (e.g., for
+# course requests submitted via course request form.
#
# outputs
# LON-CAPA courseID for new (created) course
@@ -388,7 +393,7 @@
#########################################################
sub build_course {
- my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname) = @_;
+ my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname,$cnum) = @_;
my $owner_uname = $$details{$num}{'owner'};
my $owner_domain = $$details{$num}{'domain'};
my $owner = $owner_uname.':'.$owner_domain;
@@ -504,7 +509,7 @@
$$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'};
return;
}
- my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context);
+ my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context,$cnum);
$$logmsg .= $msg;
if (!$success) {
return;
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1010 loncom/lonnet/perl/lonnet.pm:1.1011
--- loncom/lonnet/perl/lonnet.pm:1.1010 Sat Aug 8 00:36:10 2009
+++ loncom/lonnet/perl/lonnet.pm Sat Aug 8 19:55:24 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1010 2009/08/08 00:36:10 raeburn Exp $
+# $Id: lonnet.pm,v 1.1011 2009/08/08 19:55:24 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -6320,28 +6320,26 @@
sub createcourse {
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
- $course_owner,$crstype)=@_;
+ $course_owner,$crstype,$cnum)=@_;
$url=&declutter($url);
my $cid='';
unless (&allowed('ccc',$udom)) {
return 'refused';
}
-# ------------------------------------------------------------------- Create ID
- my $uname=int(1+rand(9)).
- ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
- substr($$.time,0,5).unpack("H8",pack("I32",time)).
- unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
-# ----------------------------------------------- Make sure that does not exist
- my $uhome=&homeserver($uname,$udom,'true');
- unless (($uhome eq '') || ($uhome eq 'no_host')) {
- $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
- unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
- $uhome=&homeserver($uname,$udom,'true');
- unless (($uhome eq '') || ($uhome eq 'no_host')) {
- return 'error: unable to generate unique course-ID';
- }
- }
-# ------------------------------------------------ Check supplied server name
+# --------------------------------------------------------------- Get Unique ID
+ my $uname;
+ if ($cnum =~ /^$match_courseid$/) {
+ my $chome=&homeserver($cnum,$udom,'true');
+ if (($chome eq '') || ($chome eq 'no_host')) {
+ $uname = $cnum;
+ } else {
+ $uname = &generate_coursenum($udom);
+ }
+ } else {
+ $uname = &generate_coursenum($udom);
+ }
+ return $uname if ($uname =~ /^error/);
+# -------------------------------------------------- Check supplied server name
$course_server = $env{'user.homeserver'} if (! defined($course_server));
if (! &is_library($course_server)) {
return 'error:bad server name '.$course_server;
@@ -6350,7 +6348,7 @@
my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
$course_server);
unless ($reply eq 'ok') { return 'error: '.$reply; }
- $uhome=&homeserver($uname,$udom,'true');
+ my $uhome=&homeserver($uname,$udom,'true');
if (($uhome eq '') || ($uhome eq 'no_host')) {
return 'error: no such course';
}
@@ -6391,6 +6389,30 @@
return '/'.$udom.'/'.$uname;
}
+# ------------------------------------------------------------------- Create ID
+sub generate_coursenum {
+ my ($udom) = @_;
+ my $domdesc = &domain($udom);
+ return 'error: invalid domain' if ($domdesc eq '');
+ my $uname=int(1+rand(9)).
+ ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
+ substr($$.time,0,5).unpack("H8",pack("I32",time)).
+ unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
+# ----------------------------------------------- Make sure that does not exist
+ my $uhome=&homeserver($uname,$udom,'true');
+ unless (($uhome eq '') || ($uhome eq 'no_host')) {
+ $uname=int(1+rand(9)).
+ ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
+ substr($$.time,0,5).unpack("H8",pack("I32",time)).
+ unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
+ $uhome=&homeserver($uname,$udom,'true');
+ unless (($uhome eq '') || ($uhome eq 'no_host')) {
+ return 'error: unable to generate unique course-ID';
+ }
+ }
+ return $uname;
+}
+
sub is_course {
my ($cdom,$cnum) = @_;
my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
@@ -9913,7 +9935,11 @@
=item *
-createcourse($udom,$description,$url) : make/modify course
+createcourse($udom,$description,$url,$course_server,$nonstandard,$inst_code,$course_owner,$crstype,$cnum) : make course
+
+=item *
+
+generate_coursenum($udom) : get a unique (unused) course number in domain $udom
=back
--raeburn1249761325--