--- loncom/lond	2009/07/29 22:32:39	1.418
+++ loncom/lond	2009/07/31 02:20:12	1.419
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.418 2009/07/29 22:32:39 raeburn Exp $
+# $Id: lond,v 1.419 2009/07/31 02:20:12 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -59,7 +59,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.418 $'; #' stupid emacs
+my $VERSION='$Revision: 1.419 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -3693,6 +3693,12 @@ sub put_course_id_hash_handler {
 #                 caller -  if set to 'coursecatalog', courses set to be hidden
 #                           from course catalog will be excluded from results (unless
 #                           overridden by "showhidden".
+#                 cloner - escaped username:domain of course cloner (if picking course to# 
+#                          clone).
+#                 cc_clone_list - escaped comma separated list of courses for which 
+#                                 course cloner has active CC role (and so can clone
+#                                 automatically).
+#                 cloneonly - filter by courses for which cloner has rights to clone. 
 #
 #     $client  - The socket open on the client.
 # Returns:
@@ -3705,8 +3711,9 @@ sub dump_course_id_handler {
 
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
-        $caller) =split(/:/,$tail);
+        $caller,$cloner,$cc_clone_list,$cloneonly) =split(/:/,$tail);
     my $now = time;
+    my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {
 	$description=&unescape($description);
     } else {
@@ -3749,6 +3756,20 @@ sub dump_course_id_handler {
     if (defined($catfilter)) {
         $catfilter=&unescape($catfilter);
     }
+    if (defined($cloner)) {
+        $cloner = &unescape($cloner);
+        ($cloneruname,$clonerudom) = ($cloner =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/); 
+    }
+    if (defined($cc_clone_list)) {
+        $cc_clone_list = &unescape($cc_clone_list);
+        my @cc_cloners = split('&',$cc_clone_list);
+        foreach my $cid (@cc_cloners) {
+            my ($clonedom,$clonenum) = split(':',$cid);
+            next if ($clonedom ne $udom); 
+            $cc_clone{$clonedom.'_'.$clonenum} = 1;
+        } 
+    }
+    
     my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
         $typefilter eq '.') {
@@ -3771,14 +3792,46 @@ sub dump_course_id_handler {
                 $lasttime = $hashref->{$lasttime_key};
                 next if ($lasttime<$since);
             }
+            my ($canclone,$valchange);
             my $items = &Apache::lonnet::thaw_unescape($value);
             if (ref($items) eq 'HASH') {
                 $is_hash =  1;
+                if (defined($clonerudom)) {
+                    if ($items->{'cloners'}) {
+                        my @cloneable = split(',',$items->{'cloners'});
+                        if (@cloneable) {
+                            if (grep(/^\*$/,@cloneable))  {
+                                $canclone = 1;
+                            } elsif (grep(/^\*:\Q$clonerudom\E$/,@cloneable)) {
+                                $canclone = 1;
+                            } elsif (grep(/^\Q$cloneruname\E:\Q$clonerudom\E$/,@cloneable)) {
+                                $canclone = 1;
+                            }
+                        }
+                        unless ($canclone) {
+                            if ($cloneruname ne '' && $clonerudom ne '') {
+                                if ($cc_clone{$unesc_key}) {
+                                    $canclone = 1;
+                                    $items->{'cloners'} .= ','.$cloneruname.':'.
+                                                           $clonerudom;
+                                    $valchange = 1;
+                                }
+                            }
+                        }
+                    } elsif (defined($cloneruname)) {
+                        if ($cc_clone{$unesc_key}) {
+                            $canclone = 1;
+                            $items->{'cloners'} = $cloneruname.':'.$clonerudom;
+                            $valchange = 1;
+                        }
+                    }
+                }
                 if ($unpack || !$rtn_as_hash) {
                     $unesc_val{'descr'} = $items->{'description'};
                     $unesc_val{'inst_code'} = $items->{'inst_code'};
                     $unesc_val{'owner'} = $items->{'owner'};
                     $unesc_val{'type'} = $items->{'type'};
+                    $unesc_val{'cloners'} = $items->{'cloners'};
                 }
                 $selfenroll_types = $items->{'selfenroll_types'};
                 $selfenroll_end = $items->{'selfenroll_end_date'};
@@ -3809,7 +3862,13 @@ sub dump_course_id_handler {
                 }
             } else {
                 next if ($catfilter ne '');
-                next if ($selfenrollonly); 
+                next if ($selfenrollonly);
+                if ((defined($clonerudom)) && (defined($cloneruname)))  {
+                    if ($cc_clone{$unesc_key}) {
+                        $canclone = 1;
+                        $val{'cloners'} = &escape($cloneruname.':'.$clonerudom);
+                    }
+                }
                 $is_hash =  0;
                 my @courseitems = split(/:/,$value);
                 $lasttime = pop(@courseitems);
@@ -3818,6 +3877,9 @@ sub dump_course_id_handler {
                 }
 	        ($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
             }
+            if ($cloneonly) {
+               next unless ($canclone);
+            }
             my $match = 1;
 	    if ($description ne '.') {
                 if (!$is_hash) {
@@ -3904,12 +3966,18 @@ sub dump_course_id_handler {
             if ($match == 1) {
                 if ($rtn_as_hash) {
                     if ($is_hash) {
-                        $qresult.=$key.'='.$value.'&';
+                        if ($valchange) {
+                            my $newvalue = &Apache::lonnet::freeze_escape($items);
+                            $qresult.=$key.'='.$newvalue.'&';
+                        } else {
+                            $qresult.=$key.'='.$value.'&';
+                        }
                     } else {
                         my %rtnhash = ( 'description' => &unescape($val{'descr'}),
                                         'inst_code' => &unescape($val{'inst_code'}),
                                         'owner'     => &unescape($val{'owner'}),
                                         'type'      => &unescape($val{'type'}),
+                                        'cloners'   => &unescape($val{'cloners'}),
                                       );
                         my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
                         $qresult.=$key.'='.$items.'&';