--- loncom/lonnet/perl/lonnet.pm	2015/05/13 20:38:31	1.1285
+++ loncom/lonnet/perl/lonnet.pm	2015/06/12 21:11:20	1.1288
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1285 2015/05/13 20:38:31 raeburn Exp $
+# $Id: lonnet.pm,v 1.1288 2015/06/12 21:11:20 damieng Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -101,11 +101,12 @@ use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;
 use LONCAPA::lonmetadata;
 use LONCAPA::Lond;
+use Time::HiRes qw(sleep);
 
 use File::Copy;
 
 my $readit;
-my $max_connection_retries = 10;     # Or some such value.
+my $max_connection_retries = 20;     # Or some such value.
 
 require Exporter;
 
@@ -375,7 +376,7 @@ sub subreply {
 
     my $lockfile=$peerfile.".lock";
     while (-e $lockfile) {	# Need to wait for the lockfile to disappear.
-	sleep(1);
+	Time::HiRes::sleep(0.1);
     }
     # At this point, either a loncnew parent is listening or an old lonc
     # or loncnew child is listening so we can connect or everything's dead.
@@ -393,7 +394,7 @@ sub subreply {
 	} else {
 	    &create_connection(&hostname($server),$server);
 	}
-        sleep(1);		# Try again later if failed connection.
+        Time::HiRes::sleep(0.1);	# Try again later if failed connection.
     }
     my $answer;
     if ($client) {
@@ -486,7 +487,7 @@ sub critical {
 		    close($dfh);
 		}
             }
-            sleep 2;
+            sleep 1;
             my $wcmd='';
             {
 		my $dfh;
@@ -2101,6 +2102,16 @@ sub get_domain_defaults {
                 }
             }
         }
+        if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') {
+            if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') {
+                my @clonecodes = @{$domconfig{'coursedefaults'}{'canclone'}{'instcode'}};
+                if (@clonecodes) {
+                    $domdefaults{'canclone'} = join('+',@clonecodes);
+                }
+            }
+        } elsif ($domconfig{'coursedefaults'}{'canclone'}) {
+            $domdefaults{'canclone'}=$domconfig{'coursedefaults'}{'canclone'};
+        }
     }
     if (ref($domconfig{'usersessions'}) eq 'HASH') {
         if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
@@ -4270,7 +4281,7 @@ sub courseiddump {
         $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
         $selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,
         $cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner,
-        $hasuniquecode)=@_;
+        $hasuniquecode,$reqcrsdom,$reqinstcode)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -4293,7 +4304,8 @@ sub courseiddump {
                                 &escape($catfilter), $showhidden, $caller, 
                                 &escape($cloner), &escape($cc_clone), $cloneonly, 
                                 &escape($createdbefore), &escape($createdafter), 
-                                &escape($creationcontext), $domcloner, $hasuniquecode)));
+                                &escape($creationcontext),$domcloner,$hasuniquecode,
+                                $reqcrsdom,&escape($reqinstcode))));
                 } else {
                     $rep = &reply('courseiddump:'.&host_domain($tryserver).':'.
                              $sincefilter.':'.&escape($descfilter).':'.
@@ -4304,8 +4316,8 @@ sub courseiddump {
                              $showhidden.':'.$caller.':'.&escape($cloner).':'.
                              &escape($cc_clone).':'.$cloneonly.':'.
                              &escape($createdbefore).':'.&escape($createdafter).':'.
-                             &escape($creationcontext).':'.$domcloner.':'.$hasuniquecode,
-                             $tryserver);
+                             &escape($creationcontext).':'.$domcloner.':'.$hasuniquecode.
+                             ':'.$reqcrsdom.':'.&escape($reqinstcode),$tryserver);
                 }
                      
                 my @pairs=split(/\&/,$rep);
@@ -7667,7 +7679,7 @@ sub get_query_reply {
     my $replyfile=LONCAPA::tempdir().$queryid;
     my $reply='';
     for (1..100) {
-	sleep 2;
+	Time::HiRes::sleep(0.2);
         if (-e $replyfile.'.end') {
 	    if (open(my $fh,$replyfile)) {
 		$reply = join('',<$fh>);
@@ -8090,6 +8102,80 @@ sub auto_crsreq_update {
     return \%crsreqresponse;
 }
 
+sub check_instcode_cloning {
+    my ($codedefaults,$code_order,$cloner,$clonefromcode,$clonetocode) = @_;
+    unless ((ref($codedefaults) eq 'HASH') && (ref($code_order) eq 'ARRAY')) {
+        return;
+    }
+    my $canclone;
+    if (@{$code_order} > 0) {
+        my $instcoderegexp ='^';
+        my @clonecodes = split(/\&/,$cloner);
+        foreach my $item (@{$code_order}) {
+            if (grep(/^\Q$item\E=/,@clonecodes)) {
+                foreach my $pair (@clonecodes) {
+                    my ($key,$val) = split(/\=/,$pair,2);
+                    $val = &unescape($val);
+                    if ($key eq $item) {
+                        $instcoderegexp .= '('.$val.')';
+                        last;
+                    }
+                }
+            } else {
+                $instcoderegexp .= $codedefaults->{$item};
+            }
+        }
+        $instcoderegexp .= '$';
+        my (@from,@to);
+        eval {
+               (@from) = ($clonefromcode =~ /$instcoderegexp/);
+               (@to) = ($clonetocode =~ /$instcoderegexp/);
+        };
+        if ((@from > 0) && (@to > 0)) {
+            my @diffs = &Apache::loncommon::compare_arrays(\@from,\@to);
+            if (!@diffs) {
+                $canclone = 1;
+            }
+        }
+    }
+    return $canclone;
+}
+
+sub default_instcode_cloning {
+    my ($clonedom,$domdefclone,$clonefromcode,$clonetocode,$codedefaultsref,$codeorderref) = @_;
+    my (%codedefaults,@code_order,$canclone);
+    if ((ref($codedefaultsref) eq 'HASH') && (ref($codeorderref) eq 'ARRAY')) {
+        %codedefaults = %{$codedefaultsref};
+        @code_order = @{$codeorderref};
+    } elsif ($clonedom) {
+        &auto_instcode_defaults($clonedom,\%codedefaults,\@code_order);
+    }
+    if (($domdefclone) && (@code_order)) {
+        my @clonecodes = split(/\+/,$domdefclone);
+        my $instcoderegexp ='^';
+        foreach my $item (@code_order) {
+            if (grep(/^\Q$item\E$/,@clonecodes)) {
+                $instcoderegexp .= '('.$codedefaults{$item}.')';
+            } else {
+                $instcoderegexp .= $codedefaults{$item};
+            }
+        }
+        $instcoderegexp .= '$';
+        my (@from,@to);
+        eval {
+            (@from) = ($clonefromcode =~ /$instcoderegexp/);
+            (@to) = ($clonetocode =~ /$instcoderegexp/);
+        };
+        if ((@from > 0) && (@to > 0)) {
+            my @diffs = &Apache::loncommon::compare_arrays(\@from,\@to);
+            if (!@diffs) {
+                $canclone = 1;
+            }
+        }
+    }
+    return $canclone;
+}
+
 # ------------------------------------------------------- Course Group routines
 
 sub get_coursegroups {
@@ -9436,9 +9522,9 @@ sub modify_access_controls {
     my $tries = 0;
     my $gotlock = &newput('file_permissions',$lockhash,$domain,$user);
    
-    while (($gotlock ne 'ok') && $tries <3) {
+    while (($gotlock ne 'ok') && $tries < 10) {
         $tries ++;
-        sleep 1;
+        Time::HiRes::sleep(0.1);
         $gotlock = &newput('file_permissions',$lockhash,$domain,$user);
     }
     if ($gotlock eq 'ok') {