--- loncom/lonnet/perl/lonnet.pm 2009/07/25 15:25:18 1.1007
+++ loncom/lonnet/perl/lonnet.pm 2009/08/08 19:55:24 1.1011
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1007 2009/07/25 15:25:18 raeburn Exp $
+# $Id: lonnet.pm,v 1.1011 2009/08/08 19:55:24 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1665,12 +1665,14 @@ sub userenvironment {
}
$items=~s/\&$//;
my %returnhash=();
- my @answer=split(/\&/,
- &reply('get:'.$udom.':'.$unam.':environment:'.$items,
- &homeserver($unam,$udom)));
- my $i;
- for ($i=0;$i<=$#what;$i++) {
- $returnhash{$what[$i]}=&unescape($answer[$i]);
+ my $uhome = &homeserver($unam,$udom);
+ unless ($uhome eq 'no_host') {
+ my @answer=split(/\&/,
+ &reply('get:'.$udom.':'.$unam.':environment:'.$items,$uhome));
+ my $i;
+ for ($i=0;$i<=$#what;$i++) {
+ $returnhash{$what[$i]}=&unescape($answer[$i]);
+ }
}
return %returnhash;
}
@@ -2968,7 +2970,7 @@ sub courseidput {
sub courseiddump {
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
- $selfenrollonly,$catfilter,$showhidden,$caller)=@_;
+ $selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,$cloneonly)=@_;
my $as_hash = 1;
my %returnhash;
if (!$domfilter) { $domfilter=''; }
@@ -2987,7 +2989,8 @@ sub courseiddump {
':'.&escape($coursefilter).':'.&escape($typefilter).
':'.&escape($regexp_ok).':'.$as_hash.':'.
&escape($selfenrollonly).':'.&escape($catfilter).':'.
- $showhidden.':'.$caller,$tryserver);
+ $showhidden.':'.$caller.':'.&escape($cloner).':'.
+ &escape($cc_clone).':'.$cloneonly,$tryserver);
my @pairs=split(/\&/,$rep);
foreach my $item (@pairs) {
my ($key,$value)=split(/\=/,$item,2);
@@ -3002,7 +3005,7 @@ sub courseiddump {
for (my $i=0; $i<@responses; $i++) {
$returnhash{$key}{$items[$i]} = &unescape($responses[$i]);
}
- }
+ }
}
}
}
@@ -5768,6 +5771,12 @@ sub auto_possible_instcodes {
return $response;
}
+sub auto_courserequest_checks {
+ my ($dom) = @_;
+ my %validations;
+ return %validations;
+}
+
sub auto_validate_class_sec {
my ($cdom,$cnum,$owners,$inst_class) = @_;
my $homeserver = &homeserver($cnum,$cdom);
@@ -5934,8 +5943,8 @@ sub plaintext {
}
}
my %rolenames = (
- Course => 'std',
- Group => 'alt1',
+ Course => 'std',
+ Community => 'alt1',
);
if (defined($type) &&
defined($rolenames{$type}) &&
@@ -6311,28 +6320,26 @@ sub writecoursepref {
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;
@@ -6341,7 +6348,7 @@ sub createcourse {
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';
}
@@ -6382,6 +6389,30 @@ ENDINITMAP
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,
@@ -9694,7 +9725,7 @@ and course level
plaintext($short,$type,$cid,$forcedefault) : return value in %prp hash
(rolesplain.tab); plain text explanation of a user role term.
-$type is Course (default) or Group.
+$type is Course (default) or Community.
If $forcedefault evaluates to true, text returned will be default
text for $type. Otherwise, if this is a course, the text returned
will be a custom name for the role (if defined in the course's
@@ -9904,7 +9935,11 @@ database) for a course
=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