[LON-CAPA-cvs] cvs: loncom /interface loncreatecourse.pm lonmodifycourse.pm lonrequestcourse.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Thu Jul 25 16:23:59 EDT 2019
raeburn Thu Jul 25 20:23:59 2019 EDT
Modified files:
/loncom/interface loncreatecourse.pm lonmodifycourse.pm
lonrequestcourse.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Devalidate cache for self-cataloging of courses based on institutional
code for institution's nodes, if creating/modifying an "official" course.
-------------- next part --------------
Index: loncom/interface/loncreatecourse.pm
diff -u loncom/interface/loncreatecourse.pm:1.170 loncom/interface/loncreatecourse.pm:1.171
--- loncom/interface/loncreatecourse.pm:1.170 Thu Jul 25 20:13:56 2019
+++ loncom/interface/loncreatecourse.pm Thu Jul 25 20:23:52 2019
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Create a course
#
-# $Id: loncreatecourse.pm,v 1.170 2019/07/25 20:13:56 raeburn Exp $
+# $Id: loncreatecourse.pm,v 1.171 2019/07/25 20:23:52 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -84,6 +84,10 @@
use LONCAPA::batchcreatecourse;
use LONCAPA qw(:DEFAULT :match);
+my $registered_flush;
+my $registered_instcats;
+my $modified_dom;
+
# ===================================================== Phase one: fill-in form
sub print_course_creation_page {
@@ -764,8 +768,10 @@
'<p>'.&mt('Course identifier to share with students: [_1]',$code).'</p>'
);
}
- # Flush the course logs so reverse user roles immediately updated
- $r->register_cleanup(\&Apache::lonnet::flushcourselogs);
+ if ($env{'form.crscode'} ne '') {
+ &Apache::lonnet::devalidate_cache_new('instcats',$crsudom);
+ }
+ ®ister_cleanups($r,$crsudom,$env{'form.crscode'});
$r->print('<p>'.&mt('Roles will be active at next login').'.</p>');
}
$r->print('<p><a href="/adm/createcourse?phase='.lc($crstype).'one">'.
@@ -893,7 +899,7 @@
my $uname = $env{'user.name'};
my $udom = $env{'user.domain'};
my $dir = &LONCAPA::tempdir().'addcourse';
- my ($result,$logmsg);
+ my ($result,$logmsg,$keysmsg,$codesref,$instcodesref);
if (($defdom =~ /^$match_domain$/) && ($uname =~ /^$match_username$/) && ($udom =~/^$match_domain$/)) {
my $batchfilepath=&Apache::lonnet::userfileupload('coursecreatorxml',undef,
'batchupload',undef,undef,
@@ -907,9 +913,10 @@
if ((defined($filename)) && (defined($batchdir))) {
my @requests = ($filename);
my %courseids = ();
- ($result,$logmsg) = &LONCAPA::batchcreatecourse::create_courses(
- \@requests,\%courseids,'web',$defdom,
- $uname,$udom);
+ ($result,$logmsg,$keysmsg,$codesref,$instcodesref) =
+ &LONCAPA::batchcreatecourse::create_courses(
+ \@requests,\%courseids,'web',$defdom,
+ $uname,$udom);
if (keys(%courseids) > 0) {
if (!-e "$batchdir/processed") {
mkdir("$batchdir/processed", 0755);
@@ -923,6 +930,11 @@
if (-e "$batchdir/processed/$filename") {
unlink("$batchdir/pending/$filename");
}
+ my $updatecats;
+ if ((ref($instcodesref) eq 'HASH') && (keys(%{$instcodesref}) > 0)) {
+ $updatecats = 1;
+ }
+ ®ister_cleanups($r,$defdom,$updatecats);
}
}
} else {
@@ -1335,6 +1347,44 @@
return ($allowed,\%permission);
}
+sub register_cleanups {
+ my ($r,$cdom,$updatecats) = @_;
+ # Flush the course logs so reverse user roles immediately updated
+ unless ($registered_flush) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\&Apache::lonnet::flushcourselogs,@{$handlers}]);
+ $registered_flush=1;
+ }
+ # Update cache of self-cataloging courses on institution's server(s).
+ if ($updatecats) {
+ if (&Apache::lonnet::shared_institution($cdom)) {
+ unless ($registered_instcats) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\&devalidate_remote_instcats,@{$handlers}]);
+ $registered_instcats=1;
+ $modified_dom = $cdom;
+ }
+ }
+ }
+ return;
+}
+
+sub devalidate_remote_instcats {
+ if ($modified_dom ne '') {
+ my %servers = &Apache::lonnet::internet_dom_servers($modified_dom);
+ my %thismachine;
+ map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();
+ if (keys(%servers)) {
+ foreach my $server (keys(%servers)) {
+ next if ($thismachine{$server});
+ &Apache::lonnet::remote_devalidate_cache($server,['instcats:'.$modified_dom]);
+ }
+ }
+ $modified_dom = '';
+ }
+ return;
+}
+
# ===================================================================== Handler
sub handler {
my $r = shift;
@@ -1345,6 +1395,10 @@
return OK;
}
+ $registered_flush = 0;
+ $registered_instcats = 0;
+ $modified_dom = '';
+
my ($allowed,$permission) = &get_permission($env{'request.role.domain'});
if ($allowed) {
my $show_all_choices = 0;
Index: loncom/interface/lonmodifycourse.pm
diff -u loncom/interface/lonmodifycourse.pm:1.94 loncom/interface/lonmodifycourse.pm:1.95
--- loncom/interface/lonmodifycourse.pm:1.94 Mon Apr 29 22:19:24 2019
+++ loncom/interface/lonmodifycourse.pm Thu Jul 25 20:23:52 2019
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# handler for DC-only modifiable course settings
#
-# $Id: lonmodifycourse.pm,v 1.94 2019/04/29 22:19:24 raeburn Exp $
+# $Id: lonmodifycourse.pm,v 1.95 2019/07/25 20:23:52 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,6 +39,9 @@
use lib '/home/httpd/lib/perl';
use LONCAPA qw(:DEFAULT :match);
+my $registered_cleanup;
+my $modified_dom;
+
sub get_dc_settable {
my ($type,$cdom) = @_;
if ($type eq 'Community') {
@@ -1484,6 +1487,18 @@
my $putres = &Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');
if (($putres eq 'ok') && (($changed{'owner'} || $changed{'code'}))) {
&update_coowners($cdom,$cnum,$chome,\%settings,\%newattr);
+ if ($changed{'code'}) {
+ &Apache::lonnet::devalidate_cache_new('instcats',$cdom);
+ # Update cache of self-cataloging courses on institution's server(s).
+ if (&Apache::lonnet::shared_institution($cdom)) {
+ unless ($registered_cleanup) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\&devalidate_remote_instcats,@{$handlers}]);
+ $registered_cleanup=1;
+ $modified_dom = $cdom;
+ }
+ }
+ }
}
}
}
@@ -2539,6 +2554,22 @@
return ($allowed,\%permission);
}
+sub devalidate_remote_instcats {
+ if ($modified_dom ne '') {
+ my %servers = &Apache::lonnet::internet_dom_servers($modified_dom);
+ my %thismachine;
+ map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();
+ if (keys(%servers)) {
+ foreach my $server (keys(%servers)) {
+ next if ($thismachine{$server});
+ &Apache::lonnet::remote_devalidate_cache($server,['instcats:'.$modified_dom]);
+ }
+ }
+ $modified_dom = '';
+ }
+ return;
+}
+
sub handler {
my $r = shift;
if ($r->header_only) {
@@ -2547,6 +2578,9 @@
return OK;
}
+ $registered_cleanup=0;
+ $modified_dom = '';
+
my $dom = $env{'request.role.domain'};
my $domdesc = &Apache::lonnet::domain($dom,'description');
my ($allowed,$permission) = &get_permission($dom);
Index: loncom/interface/lonrequestcourse.pm
diff -u loncom/interface/lonrequestcourse.pm:1.106 loncom/interface/lonrequestcourse.pm:1.107
--- loncom/interface/lonrequestcourse.pm:1.106 Sun Jan 27 15:46:26 2019
+++ loncom/interface/lonrequestcourse.pm Thu Jul 25 20:23:52 2019
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Request a course
#
-# $Id: lonrequestcourse.pm,v 1.106 2019/01/27 15:46:26 raeburn Exp $
+# $Id: lonrequestcourse.pm,v 1.107 2019/07/25 20:23:52 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -119,6 +119,10 @@
use Apache::lonuserutils;
use LONCAPA qw(:DEFAULT :match);
+my $registered_flush;
+my $registered_instcats;
+my $modified_dom;
+
sub handler {
my ($r) = @_;
&Apache::loncommon::content_type($r,'text/html');
@@ -127,6 +131,10 @@
return OK;
}
+ $registered_flush = 0;
+ $registered_instcats = 0;
+ $modified_dom = '';
+
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['action','showdom','cnum','state','crstype','queue','tabs']);
&Apache::lonhtmlcommon::clear_breadcrumbs();
@@ -3887,6 +3895,24 @@
}
$output .= '</p>';
$creationresult = 'created';
+ # Flush the course logs so reverse user roles immediately updated
+ unless ($registered_flush) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\&Apache::lonnet::flushcourselogs,@{$handlers}]);
+ $registered_flush=1;
+ }
+ if ($instcode ne '') {
+ &Apache::lonnet::devalidate_cache_new('instcats',$dom);
+ # Update cache of self-cataloging courses on institution's server(s).
+ if (&Apache::lonnet::shared_institution($dom)) {
+ unless ($registered_instcats) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\&devalidate_remote_instcats,@{$handlers}]);
+ $registered_instcats=1;
+ $modified_dom = $dom;
+ }
+ }
+ }
} else {
$output = '<span class="LC_error">';
if ($crstype eq 'community') {
@@ -4022,6 +4048,22 @@
}
}
+sub devalidate_remote_instcats {
+ if ($modified_dom ne '') {
+ my %servers = &Apache::lonnet::internet_dom_servers($modified_dom);
+ my %thismachine;
+ map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();
+ if (keys(%servers)) {
+ foreach my $server (keys(%servers)) {
+ next if ($thismachine{$server});
+ &Apache::lonnet::remote_devalidate_cache($server,['instcats:'.$modified_dom]);
+ }
+ }
+ $modified_dom = '';
+ }
+ return;
+}
+
sub custom_formitems {
my ($preprocess,$customhash) = @_;
return unless ((ref($preprocess) eq 'HASH') && (ref($customhash) eq 'HASH'));
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1413 loncom/lonnet/perl/lonnet.pm:1.1414
--- loncom/lonnet/perl/lonnet.pm:1.1413 Tue Jul 23 13:59:01 2019
+++ loncom/lonnet/perl/lonnet.pm Thu Jul 25 20:23:59 2019
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1413 2019/07/23 13:59:01 raeburn Exp $
+# $Id: lonnet.pm,v 1.1414 2019/07/25 20:23:59 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -14067,6 +14067,27 @@
return $domain;
}
+sub shared_institution {
+ my ($dom) = @_;
+ my $same_intdom;
+ my $hostintdom = &internet_dom($perlvar{'lonHostID'});
+ if ($hostintdom ne '') {
+ my %iphost = &get_iphost();
+ my $primary_id = &domain($dom,'primary');
+ my $primary_ip = &get_host_ip($primary_id);
+ if (ref($iphost{$primary_ip}) eq 'ARRAY') {
+ foreach my $id (@{$iphost{$primary_ip}}) {
+ my $intdom = &internet_dom($id);
+ if ($intdom eq $hostintdom) {
+ $same_intdom = 1;
+ last;
+ }
+ }
+ }
+ }
+ return $same_intdom;
+}
+
sub uses_sts {
my ($ignore_cache) = @_;
my $lonhost = $perlvar{'lonHostID'};
More information about the LON-CAPA-cvs
mailing list