[LON-CAPA-cvs] cvs: loncom / Lond.pm /interface loncommon.pm loncoursequeueadmin.pm lonpickcourse.pm lonrequestcourse.pm /lonnet/perl lonnet.pm

raeburn raeburn at source.lon-capa.org
Thu May 21 19:40:26 EDT 2015


raeburn		Thu May 21 23:40:26 2015 EDT

  Modified files:              
    /loncom/interface	loncommon.pm loncoursequeueadmin.pm 
                     	lonpickcourse.pm lonrequestcourse.pm 
    /loncom	Lond.pm 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Support checking of course cloning rights based on (a) domain defaults
    (where no course-specific rights set), or (b) course specific rights
    for official courses, based on institutional code category/ies set in
    courseprefs, e.g., department=phy etc.   
  
  
-------------- next part --------------
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1220 loncom/interface/loncommon.pm:1.1221
--- loncom/interface/loncommon.pm:1.1220	Mon May 11 14:21:39 2015
+++ loncom/interface/loncommon.pm	Thu May 21 23:40:09 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1220 2015/05/11 14:21:39 raeburn Exp $
+# $Id: loncommon.pm,v 1.1221 2015/05/21 23:40:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -536,7 +536,7 @@
 
 sub coursebrowser_javascript {
     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
-        $credits_element) = @_;
+        $credits_element,$instcode) = @_;
     my $wintitle = 'Course_Browser';
     if ($crstype eq 'Community') {
         $wintitle = 'Community_Browser';
@@ -586,7 +586,10 @@
         if (formname == 'ccrs') {
             var ownername = document.forms[formid].ccuname.value;
             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
-            url += '&cloner='+ownername+':'+ownerdom;
+            url += '&cloner='+ownername+':'+ownerdom+'&crscode='+document.forms[formid].crscode.value;
+        }
+        if (formname == 'requestcrs') {
+            url += '&crsdom=$domainfilter&crscode=$instcode';
         }
         if (multflag !=null && multflag != '') {
             url += '&multiple='+multflag;
@@ -14411,34 +14414,90 @@
             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
 	    $can_clone = 1;
 	} else {
-	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
+	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
 						 $args->{'clonedomain'},$args->{'clonecourse'});
-	    my @cloners = split(/,/,$clonehash{'cloners'});
-            if (grep(/^\*$/, at cloners)) {
-                $can_clone = 1;
-            } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/, at cloners)) {
-                $can_clone = 1;
-            } else {
-                my $ccrole = 'cc';
-                if ($args->{'crstype'} eq 'Community') {
-                    $ccrole = 'co';
+            if ($clonehash{'cloners'} eq '') {
+                my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
+                if ($domdefs{'canclone'}) {
+                    unless ($domdefs{'canclone'} eq 'none') {
+                        if ($domdefs{'canclone'} eq 'domain') {
+                            if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
+                                $can_clone = 1;
+                            }
+                        } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
+                                 ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
+                            if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
+                                                                          $clonehash{'internal.coursecode'},$args->{'crscode'})) {
+                                $can_clone = 1;
+                            }
+                        }
+                    }
                 }
-	        my %roleshash =
-		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
-					 $args->{'ccdomain'},
-                                         'userroles',['active'],[$ccrole],
-					 [$args->{'clonedomain'}]);
-	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/, at cloners))) {
+            } else {
+	        my @cloners = split(/,/,$clonehash{'cloners'});
+                if (grep(/^\*$/, at cloners)) {
                     $can_clone = 1;
-                } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
+                } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/, at cloners)) {
                     $can_clone = 1;
-                } else {
-                    if ($args->{'crstype'} eq 'Community') {
-                        $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
-                    } else {
-                        $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+                }
+                unless ($can_clone) {
+                    if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
+                        my (%gotdomdefaults,%gotcodedefaults);
+                        foreach my $cloner (@cloners) {
+                            if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
+                                ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
+                                my (%codedefaults, at code_order);
+                                if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
+                                    if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
+                                        %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
+                                    }
+                                    if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
+                                        @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
+                                    }
+                                } else {
+                                    &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
+                                                                            \%codedefaults,
+                                                                            \@code_order);
+                                    $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
+                                    $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
+                                }
+                                if (@code_order > 0) {
+                                    if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
+                                                                                $cloner,$clonehash{'internal.coursecode'},
+                                                                                $args->{'crscode'})) {
+                                        $can_clone = 1;
+                                        last;
+                                    }
+                                }
+                            }
+                        }
                     }
-	        }
+                    unless ($can_clone) {
+                        my $ccrole = 'cc';
+                        if ($args->{'crstype'} eq 'Community') {
+                            $ccrole = 'co';
+                        }
+	                my %roleshash =
+		            &Apache::lonnet::get_my_roles($args->{'ccuname'},
+					                  $args->{'ccdomain'},
+                                                          'userroles',['active'],[$ccrole],
+					                  [$args->{'clonedomain'}]);
+	                if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || 
+                            (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/, at cloners))) {
+                            $can_clone = 1;
+                        } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
+                                                                  $args->{'ccuname'},$args->{'ccdomain'})) {
+                            $can_clone = 1;
+                        }
+                    }
+                }
+            }
+            unless ($can_clone) {
+                if ($args->{'crstype'} eq 'Community') {
+                    $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+                } else {
+                    $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+                }
 	    }
         }
     }
@@ -15651,11 +15710,18 @@
 
 clonerudom - optional domain of new course owner
 
-domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
+domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
             (used when DC is using course creation form)
 
 codetitles - reference to array of titles of components in institutional codes (official courses).
 
+cc_clone - escaped comma separated list of courses for which course cloner has active CC role
+           (and so can clone automatically)
+
+reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
+
+reqinstcode - institutional code of new course, where search_courses is used to identify potential 
+              courses to clone 
 
 Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
 
@@ -15666,7 +15732,8 @@
 
 
 sub search_courses {
-    my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
+    my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
+        $cc_clone,$reqcrsdom,$reqinstcode) = @_;
     my (%courses,%showcourses,$cloner);
     if (($filter->{'ownerfilter'} ne '') ||
         ($filter->{'ownerdomfilter'} ne '')) {
@@ -15714,10 +15781,10 @@
                                              $filter->{'combownerfilter'},
                                              $filter->{'coursefilter'},
                                              undef,undef,$type,$regexpok,undef,undef,
-                                             undef,undef,$cloner,$env{'form.cc_clone'},
+                                             undef,undef,$cloner,$cc_clone,
                                              $filter->{'cloneableonly'},
                                              $createdbefore,$createdafter,undef,
-                                             $domcloner);
+                                             $domcloner,undef,$reqcrsdom,$reqinstcode);
     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
         my $ccrole;
         if ($type eq 'Community') {
Index: loncom/interface/loncoursequeueadmin.pm
diff -u loncom/interface/loncoursequeueadmin.pm:1.50 loncom/interface/loncoursequeueadmin.pm:1.51
--- loncom/interface/loncoursequeueadmin.pm:1.50	Thu Mar 26 14:16:11 2015
+++ loncom/interface/loncoursequeueadmin.pm	Thu May 21 23:40:09 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Utilities to administer domain course requests and course self-enroll requests
 #
-# $Id: loncoursequeueadmin.pm,v 1.50 2015/03/26 14:16:11 raeburn Exp $
+# $Id: loncoursequeueadmin.pm,v 1.51 2015/05/21 23:40:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1724,7 +1724,7 @@
 }
 
 sub can_clone_course {
-    my ($uname,$udom,$clonecrs,$clonedom,$crstype) = @_;
+    my ($uname,$udom,$clonecrs,$clonedom,$crstype,$dom,$instcode) = @_;
     my $canclone;
     my $ccrole = 'cc';
     if ($crstype eq 'community') {
@@ -1735,19 +1735,71 @@
     if (exists($roleshash{$clonecrs.':'.$clonedom.':'.$ccrole})) {
         $canclone = 1;
     } else {
-        my %courseenv = &Apache::lonnet::userenvironment($clonedom,$clonecrs,('cloners'));
+        my %courseenv = &Apache::lonnet::userenvironment($clonedom,$clonecrs,
+                                                         ('cloners','internal.coursecode'));
         my $cloners = $courseenv{'cloners'};
+        my $clonefromcode = $courseenv{'internal.coursecode'};
         if ($cloners ne '') {
             my @cloneable = split(',',$cloners);
             if (grep(/^\*$/, at cloneable)) {
                 $canclone = 1;
-            }
-            if (grep(/^\*:\Q$udom\E$/, at cloneable)) {
+            } elsif (grep(/^\*:\Q$udom\E$/, at cloneable)) {
                 $canclone = 1;
-            }
-            if (grep(/^\Q$uname\E:\Q$udom\E$/, at cloneable)) {
+            } elsif (grep(/^\Q$uname\E:\Q$udom\E$/, at cloneable)) {
                 $canclone = 1;
             }
+            unless ($canclone) {
+                if (($clonefromcode) && ($instcode) && ($clonedom eq $dom)) {
+                    my (%gotdomdefaults,%gotcodedefaults);
+                    foreach my $cloner (@cloneable) {
+                        if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
+                            ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
+                            if ($cloner =~ /\=/) {
+                                my (%codedefaults, at code_order);
+                                if (ref($gotcodedefaults{$clonedom}) eq 'HASH') {
+                                    if (ref($gotcodedefaults{$clonedom}{'defaults'}) eq 'HASH') {
+                                        %codedefaults = %{$gotcodedefaults{$clonedom}{'defaults'}};
+                                    }
+                                    if (ref($gotcodedefaults{$clonedom}{'order'}) eq 'ARRAY') {
+                                        @code_order = @{$gotcodedefaults{$dom}{'order'}};
+                                    }
+                                } else {
+                                    &Apache::lonnet::auto_instcode_defaults($clonedom,
+                                                                            \%codedefaults,
+                                                                            \@code_order);
+                                    $gotcodedefaults{$clonedom}{'defaults'} = \%codedefaults;
+                                    $gotcodedefaults{$clonedom}{'order'} = \@code_order;
+                                }
+                                if (@code_order > 0) {
+                                    if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
+                                                                                $cloner,$clonefromcode,$instcode)) {
+print STDERR "Z got check from $cloner,$clonefromcode,$instcode and ||".join('**', at code_order)."||\n";
+                                        $canclone = 1;
+                                        last; 
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        } else {
+            my %domdefs = &Apache::lonnet::get_domain_defaults($clonedom);
+            if ($domdefs{'canclone'}) {
+                unless ($domdefs{'canclone'} eq 'none') {
+                    if ($domdefs{'canclone'} eq 'domain') {
+                        if ($udom eq $clonedom) {
+                            $canclone = 1;
+                        }
+                    } elsif (($clonefromcode) && ($instcode) &&
+                             ($clonedom eq $dom)) {
+                        if (&Apache::lonnet::default_instcode_cloning($clonedom,$domdefs{'canclone'},
+                                                                      $clonefromcode,$instcode)) {
+                            $canclone = 1;
+                        }
+                    }
+                }
+            }
         }
         unless ($canclone) {
             if (&Apache::lonnet::is_course_owner($clonedom,$clonecrs,$uname,$udom)) {
Index: loncom/interface/lonpickcourse.pm
diff -u loncom/interface/lonpickcourse.pm:1.115 loncom/interface/lonpickcourse.pm:1.116
--- loncom/interface/lonpickcourse.pm:1.115	Fri May 30 01:50:05 2014
+++ loncom/interface/lonpickcourse.pm	Thu May 21 23:40:09 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Pick a course
 #
-# $Id: lonpickcourse.pm,v 1.115 2014/05/30 01:50:05 raeburn Exp $
+# $Id: lonpickcourse.pm,v 1.116 2015/05/21 23:40:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -50,9 +50,10 @@
     &Apache::loncommon::get_unprocessed_cgi
         ($ENV{'QUERY_STRING'},['domainfilter','form','cnumelement',
 			       'cdomelement','cnameelement','roleelement',
-                               'multiple','type','setroles','fixeddom','cloner']);
+                               'multiple','type','setroles','fixeddom','cloner',
+                               'crscode','crsdom']);
     my ($type,$title,$jscript,$multelement,$multiple,$roleelement,$typeelement,
-        $lastaction,$autosubmit,$submitopener,$cloneruname,$clonerudom);
+        $lastaction,$autosubmit,$submitopener,$cloneruname,$clonerudom,$crscode,$crsdom);
 
     # Get course type - Course or Community.
     $type = $env{'form.type'};
@@ -82,12 +83,16 @@
     # if called when a DC is creating a course for another user.
     if ($env{'form.form'} eq 'ccrs') {
         ($cloneruname,$clonerudom) = ($env{'form.cloner'} =~ /^($match_username):($match_domain)$/);
+        $crscode = $env{'form.crscode'};
+        $crsdom = $env{'request.role.domain'};
     }
 
     # if called when requesting a course
     if ($env{'form.form'} eq 'requestcrs') {
         $cloneruname = $env{'user.name'};
         $clonerudom =  $env{'user.domain'};
+        $crscode = $env{'form.crscode'};
+        $crsdom = $env{'form.crsdom'};
     }
 
     my $onlyown = 0;
@@ -220,6 +225,12 @@
             if ($coord_cloneable) {
                 $clonetext .= '<input type="hidden" name="cc_clone" value="'.$coord_cloneable.'" />';
             }
+            if ($crscode ne '') {
+                $clonetext .= '<input type="hidden" name="crscode" value="'.$crscode.'" />';
+            }
+            if ($crsdom ne '') {
+                $clonetext .= '<input type="hidden" name="crsdom" value="'.$crsdom.'" />';
+            }
         }
         $r->print(&Apache::loncommon::build_filters($filterlist,$type,$roleelement,$multelement,
                                                     $filter,$action,\$numtitles,undef,$cloneruname,
@@ -247,7 +258,8 @@
             my $srchdom = $filter->{'domainfilter'};
             %courses = &Apache::loncommon::search_courses($srchdom,$type,$filter,$numtitles,
                                                           $cloneruname,$clonerudom,$domcloner,
-                                                          \@codetitles,$env{'form.cc_clone'});
+                                                          \@codetitles,$env{'form.cc_clone'},
+                                                          $crsdom,$crscode);
         } else {
             $r->print('<br />');
             my %coursehash = &Apache::loncommon::findallcourses();
@@ -262,7 +274,7 @@
                            '<b>'.$filter->{'persondomfilter'}.'</b>').'</span>');
         } else {
             &display_matched_courses($r,$type,$multiple,$action,$showroles,$cloneruname,
-                                     $clonerudom,%courses);
+                                     $clonerudom,$crsdom,$crscode,%courses);
         }
     }
     $r->print(&Apache::loncommon::end_page());
@@ -371,7 +383,7 @@
 }
 
 sub display_matched_courses {
-    my ($r,$type,$multiple,$action,$showroles,$cloneruname,$clonerudom,%courses) = @_;
+    my ($r,$type,$multiple,$action,$showroles,$cloneruname,$clonerudom,$crsdom,$crscode,%courses) = @_;
     if ($env{'form.form'} eq 'portform') {
         $action = '/adm/portfolio';
     }
@@ -464,6 +476,7 @@
             map {$cc_cloneable{$_} = 1;} split('&',$coord_cloneable);
         }
     }
+    my (%gotdomdefaults,%gotcodedefaults);
     foreach my $description (sort { lc($a) cmp lc($b) } (keys(%by_descrip))) {
         foreach my $course (@{$by_descrip{$description}}) {
             $r->print(&Apache::loncommon::start_data_table_row());
@@ -489,7 +502,7 @@
                     }
                     unless ($canclone) {
                         my $cloners = $courses{$course}{'cloners'};
-                        if ($cloners ne '') { 
+                        if ($cloners ne '') {
                             my @cloneable = split(',',$cloners);
                             if (grep(/^\*$/, at cloneable)) {
                                 $canclone = 1;
@@ -500,6 +513,80 @@
                             if (grep(/^\Q$cloneruname\E:\Q$clonerudom\E$/, at cloneable)) {
                                 $canclone = 1;
                             }
+                            unless ($canclone) {
+                                if (($instcode) && ($crscode) && ($cdom eq $crsdom)) {
+                                    foreach my $cloner (@cloneable) {
+                                        if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
+                                            ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
+                                            if ($cloner =~ /\=/) {
+                                                my (%codedefaults, at code_order);
+                                                if (ref($gotcodedefaults{$cdom}) eq 'HASH') {
+                                                    if (ref($gotcodedefaults{$cdom}{'defaults'}) eq 'HASH') {
+                                                        %codedefaults = %{$gotcodedefaults{$cdom}{'defaults'}};
+                                                    }
+                                                    if (ref($gotcodedefaults{$cdom}{'order'}) eq 'ARRAY') {
+                                                        @code_order = @{$gotcodedefaults{$cdom}{'order'}};
+                                                    }
+                                                } else {
+                                                    &Apache::lonnet::auto_instcode_defaults($cdom,
+                                                                                            \%codedefaults,
+                                                                                            \@code_order);
+                                                    $gotcodedefaults{$cdom}{'defaults'} = \%codedefaults;
+                                                    $gotcodedefaults{$cdom}{'order'} = \@code_order;
+                                                }
+                                                if (@code_order > 0) {
+                                                    if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
+                                                                                                $cloner,$instcode,$crscode)) {
+                                                        $canclone = 1;
+                                                        last;
+                                                    }
+                                                }
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                        } else {
+                            my %domdefs;
+                            if (ref($gotdomdefaults{$cdom}) eq 'HASH') {
+                                %domdefs = %{$gotdomdefaults{$cdom}};
+                            } else {
+                                %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+                                $gotdomdefaults{$cdom} = \%domdefs;
+                            }
+                            if ($domdefs{'canclone'}) {
+                                unless ($domdefs{'canclone'} eq 'none') {
+                                    if ($domdefs{'canclone'} eq 'domain') {
+                                        if ($clonerudom eq $cdom) {
+                                            $canclone = 1;
+                                        }
+                                    } elsif (($instcode) && ($crscode) &&
+                                             ($cdom eq $crsdom)) {
+                                        my (%codedefaults, at code_order); 
+                                        if (ref($gotcodedefaults{$cdom}) eq 'HASH') {
+                                            if (ref($gotcodedefaults{$cdom}{'defaults'}) eq 'HASH') {
+                                                %codedefaults = %{$gotcodedefaults{$cdom}{'defaults'}};
+                                            }
+                                            if (ref($gotcodedefaults{$cdom}{'order'}) eq 'ARRAY') {
+                                                @code_order = @{$gotcodedefaults{$cdom}{'order'}};
+                                            }
+                                        } else {
+                                            &Apache::lonnet::auto_instcode_defaults($cdom,
+                                                                                    \%codedefaults,
+                                                                                    \@code_order);
+                                            $gotcodedefaults{$cdom}{'defaults'} = \%codedefaults;
+                                            $gotcodedefaults{$cdom}{'order'} = \@code_order;
+                                        }
+                                        if (@code_order > 0) {
+                                            if (&Apache::lonnet::default_instcode_cloning($cdom,$domdefs{'canclone'},
+                                                                                          $instcode,$crscode,\%codedefaults,
+                                                                                          \@code_order)) {
+                                                $canclone = 1;
+                                            }
+                                        }
+                                    }
+                                }
+                            }
                         }
                     }
                 }
@@ -849,9 +936,9 @@
 
 =item *
 X<display_matched_courses()>
-B<display_matched_courses($r,$type,$multiple,$action,$showroles,$cloneruname,$clonerudom,%courses)>:
+B<display_matched_courses($r,$type,$multiple,$action,$showroles,$cloneruname,$clonerudom,$crsdom,$crscode,%courses)>:
 
-Input: 7 - request object, course type, multiple (0 or 1), form action, whether to show roles (for course personnel filter), username of new course owner, domain of new course owner, hash of courses.
+Input: 8 - request object, course type, multiple (0 or 1), form action, whether to show roles (for course personnel filter), username of new course owner, domain of new course owner, domain of new course, institutional code of new course, hash of courses.
 
 Output: 0
 
Index: loncom/interface/lonrequestcourse.pm
diff -u loncom/interface/lonrequestcourse.pm:1.86 loncom/interface/lonrequestcourse.pm:1.87
--- loncom/interface/lonrequestcourse.pm:1.86	Thu Mar 26 14:16:11 2015
+++ loncom/interface/lonrequestcourse.pm	Thu May 21 23:40:09 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Request a course
 #
-# $Id: lonrequestcourse.pm,v 1.86 2015/03/26 14:16:11 raeburn Exp $
+# $Id: lonrequestcourse.pm,v 1.87 2015/05/21 23:40:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -939,7 +939,8 @@
     if ($action eq 'new') {
         my $jsextra;
         if (($state eq 'courseinfo') || ($state eq 'codepick')) {
-            $jsextra = "\n".&Apache::loncommon::coursebrowser_javascript($dom);
+            $jsextra = "\n".&Apache::loncommon::coursebrowser_javascript($dom,'','','','','',
+                                                                         $newinstcode);
         } elsif ($state eq 'enrollment') {
             if (($env{'form.crstype'} eq 'official') && 
                 (&Apache::lonnet::auto_run('',$dom))) {
@@ -2788,6 +2789,7 @@
 
     my $enrollrow_title = &mt('Default Access Dates').'<br />'.
                           '('.&Apache::lonnet::plaintext('st',$category).')';
+    my $instcode;
     if ($env{'form.crstype'} eq 'official') {
         if ((ref($codetitles) eq 'ARRAY') && (ref($cat_titles) eq 'HASH')) {
             foreach my $title (@{$codetitles}) {
@@ -2803,6 +2805,11 @@
                 }
             }
         }
+        if (ref($code_order) eq 'ARRAY') {
+            foreach my $item (@{$code_order}) {
+                $instcode .= $env{'form.instcode_'.$item};
+            }
+        }
         $inst_headers .= '<th>'.&mt('Credits').'</th>';
         if ($instcredits) {
             $inst_values .= '<td>'.$instcredits.'</td>';
@@ -2890,7 +2897,7 @@
         ($env{'form.clonedom'} =~ /^$match_domain$/)) {
         my $canclone = &Apache::loncoursequeueadmin::can_clone_course($uname,
                            $udom,$env{'form.clonecrs'},$env{'form.clonedom'},
-                           $env{'form.crstype'});
+                           $env{'form.crstype'},$dom,$instcode);
         if ($canclone) {
             my %courseenv = &Apache::lonnet::userenvironment($env{'form.clonedom'},
                               $env{'form.clonecrs'},('description','internal.coursecode'));
@@ -3588,7 +3595,7 @@
             my $canclone =  
                 &Apache::loncoursequeueadmin::can_clone_course($env{'user.name'},
                         $env{'user.domain'},$env{'form.clonecrs'},$env{'form.clonedom'},
-                        $crstype);
+                        $crstype,$dom,$instcode);
             if ($canclone) {
                 $clonecrs = $env{'form.clonecrs'};
                 $clonedom = $env{'form.clonedom'};
@@ -4462,7 +4469,7 @@
                     my ($clonedom,$clonecrs) = split(/_/,$item);
                     if (ref($prefab{$type}{$item}) eq 'HASH') {
                         if (&Apache::loncoursequeueadmin::can_clone_course($env{'user.name'},
-                                          $env{'user.domain'},$clonecrs,$clonedom,$crstype)) {
+                                          $env{'user.domain'},$clonecrs,$clonedom,$crstype,$dom)) {
 
                             my $num = $prefab{$type}{$item}{'order'};
                             $ordered{$type}{$num} = $item;
@@ -4804,7 +4811,7 @@
         if (&Apache::lonnet::homeserver($clonecrs,$clonedom) ne 'no_host') {
             my $canclone =
                 &Apache::loncoursequeueadmin::can_clone_course($env{'user.name'},
-                            $env{'user.domain'},$clonecrs,$clonedom,$crstype);
+                            $env{'user.domain'},$clonecrs,$clonedom,$crstype,$dom);
             unless ($canclone) {
                 undef($clonecrs);
                 undef($clonedom);
Index: loncom/Lond.pm
diff -u loncom/Lond.pm:1.6 loncom/Lond.pm:1.7
--- loncom/Lond.pm:1.6	Wed Jan  1 17:41:37 2014
+++ loncom/Lond.pm	Thu May 21 23:40:17 2015
@@ -1,6 +1,6 @@
 # The LearningOnline Network
 #
-# $Id: Lond.pm,v 1.6 2014/01/01 17:41:37 raeburn Exp $
+# $Id: Lond.pm,v 1.7 2015/05/21 23:40:17 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -333,7 +333,7 @@
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
-        $creationcontext,$domcloner,$hasuniquecode) = split(/:/,$tail);
+        $creationcontext,$domcloner,$hasuniquecode,$reqcrsdom,$reqinstcode) = split(/:/,$tail);
     my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {
@@ -415,6 +415,7 @@
         $unpack = 0;
     }
     if (!defined($since)) { $since=0; }
+    my (%gotcodedefaults,%otcodedefaults);
     my $qresult='';
 
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT())
@@ -434,12 +435,15 @@
                 $lasttime = $hashref->{$lasttime_key};
                 next if ($lasttime<$since);
             }
-            my ($canclone,$valchange);
+            my ($canclone,$valchange,$clonefromcode);
             my $items = &Apache::lonnet::thaw_unescape($value);
             if (ref($items) eq 'HASH') {
                 if ($hashref->{$lasttime_key} eq '') {
                     next if ($since > 1);
                 }
+                if ($items->{'inst_code'}) {
+                    $clonefromcode = $items->{'inst_code'};
+                }
                 $is_hash =  1;
                 if ($domcloner) {
                     $canclone = 1;
@@ -465,6 +469,41 @@
                                 }
                             }
                         }
+                        unless ($canclone) {
+                            if (($reqcrsdom eq $udom) && ($reqinstcode) && ($clonefromcode)) {
+                                if (grep(/\=/, at cloneable))  {
+                                    foreach my $cloner (@cloneable) {
+                                        if (($cloner ne '*') && ($cloner !~ /^\*\:$LONCAPA::match_domain$/) &&
+                                            ($cloner !~ /^$LONCAPA::match_username\:$LONCAPA::match_domain$/) && ($cloner ne '')) {
+                                            if ($cloner =~ /=/) {
+                                                my (%codedefaults, at code_order);
+                                                if (ref($gotcodedefaults{$udom}) eq 'HASH') {
+                                                    if (ref($gotcodedefaults{$udom}{'defaults'}) eq 'HASH') {
+                                                        %codedefaults = %{$gotcodedefaults{$udom}{'defaults'}};
+                                                    }
+                                                    if (ref($gotcodedefaults{$udom}{'order'}) eq 'ARRAY') {
+                                                        @code_order = @{$gotcodedefaults{$udom}{'order'}};
+                                                    }
+                                                } else {
+                                                    &Apache::lonnet::auto_instcode_defaults($udom,
+                                                                                            \%codedefaults,
+                                                                                            \@code_order);
+                                                    $gotcodedefaults{$udom}{'defaults'} = \%codedefaults;
+                                                    $gotcodedefaults{$udom}{'order'} = \@code_order;
+                                                }
+                                                if (@code_order > 0) {
+                                                    if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
+                                                                                                $cloner,$clonefromcode,$reqinstcode)) {
+                                                        $canclone = 1;
+                                                        last;
+                                                    }
+                                                }
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                        }
                     } elsif (defined($cloneruname)) {
                         if ($cc_clone{$unesc_key}) {
                             $canclone = 1;
@@ -485,6 +524,24 @@
                             }
                         }
                     }
+                    unless (($canclone) || ($items->{'cloners'})) {
+                        my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
+                        if ($domdefs{'canclone'}) {
+                            unless ($domdefs{'canclone'} eq 'none') {
+                                if ($domdefs{'canclone'} eq 'domain') {
+                                    if ($clonerudom eq $udom) {
+                                        $canclone = 1;
+                                    }
+                                } elsif (($clonefromcode) && ($reqinstcode) &&
+                                         ($udom eq $reqcrsdom)) {
+                                    if (&Apache::lonnet::default_instcode_cloning($udom,$domdefs{'canclone'},
+                                                                                  $clonefromcode,$reqinstcode)) {
+                                        $canclone = 1;
+                                    }
+                                }
+                            }
+                        }
+                    }
                 }
                 if ($unpack || !$rtn_as_hash) {
                     $unesc_val{'descr'} = $items->{'description'};
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1286 loncom/lonnet/perl/lonnet.pm:1.1287
--- loncom/lonnet/perl/lonnet.pm:1.1286	Thu May 21 23:10:57 2015
+++ loncom/lonnet/perl/lonnet.pm	Thu May 21 23:40:25 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1286 2015/05/21 23:10:57 raeburn Exp $
+# $Id: lonnet.pm,v 1.1287 2015/05/21 23:40:25 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4280,7 +4280,7 @@
         $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=''; }
@@ -4303,7 +4303,8 @@
                                 &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).':'.
@@ -4314,8 +4315,8 @@
                              $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);
@@ -8100,6 +8101,80 @@
     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=/, at 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, at 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, at 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$/, at clonecodes)) {
+                $instcoderegexp .= '('.$codedefaults{$item}.')';
+            } else {
+                $instcoderegexp .= $codedefaults{$item};
+            }
+        }
+        $instcoderegexp .= '$';
+        my (@from, at 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 {


More information about the LON-CAPA-cvs mailing list