[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