--- loncom/interface/loncommon.pm	2013/12/24 19:15:10	1.1165
+++ loncom/interface/loncommon.pm	2013/12/25 09:52:42	1.1166
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1165 2013/12/24 19:15:10 raeburn Exp $
+# $Id: loncommon.pm,v 1.1166 2013/12/25 09:52:42 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -13884,7 +13884,7 @@ sub check_clone {
 }
 
 sub construct_course {
-    my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
+    my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
     my $outcome;
     my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {
@@ -13981,7 +13981,8 @@ sub construct_course {
                    'plc.users.denied',
                    'hidefromcat',
                    'checkforpriv',
-                   'categories'],
+                   'categories',
+                   'internal.uniquecode'],
                    $$crsudom,$$crsunum);
     }
 
@@ -14166,6 +14167,19 @@ sub construct_course {
 	}
     }
 
+#
+# course should have uniquecode (available to course requester).
+#
+    if ($args->{'uniquecode'}) {
+        my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
+        if ($code) {
+            $cenv{'internal.uniquecode'} = $code;
+            if (ref($coderef)) {
+                $$coderef = $code;
+            }
+        }
+    }
+
     if ($args->{'disresdis'}) {
         $cenv{'pch.roles.denied'}='st';
     }
@@ -14234,6 +14248,60 @@ sub construct_course {
     return (1,$outcome);
 }
 
+sub make_unique_code {
+    my ($cdom,$cnum) = @_;
+    # get lock on uniquecodes db
+    my $lockhash = {
+                      $cnum."\0".'uniquecodes' => $env{'user.name'}.
+                                                  ':'.$env{'user.domain'},
+                   };
+    my $tries = 0;
+    my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+    my ($code,$error);
+  
+    while (($gotlock ne 'ok') && ($tries<3)) {
+        $tries ++;
+        sleep 1;
+        $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+    }
+    if ($gotlock eq 'ok') {
+        my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
+        my $gotcode;
+        my $attempts = 0;
+        while ((!$gotcode) && ($attempts < 100)) {
+            $code = &generate_code();
+            if (!exists($currcodes{$code})) {
+                $gotcode = 1;
+                unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
+                    $error = 'nostore';
+                }
+            }
+            $attempts ++;
+        }
+        my @del_lock = ($cnum."\0".'uniquecodes');
+        my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
+    } else {
+        $error = 'nolock';
+    }
+    return ($code,$error);
+}
+
+sub generate_code {
+    my $code;
+    my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
+    for (my $i=0; $i<6; $i++) {
+        my $lettnum = int (rand 2);
+        my $item = '';
+        if ($lettnum) {
+            $item = $letts[int( rand(18) )];
+        } else {
+            $item = 1+int( rand(8) );
+        }
+        $code .= $item;
+    }
+    return $code;
+}
+
 ############################################################
 ############################################################