[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--