[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[raeburn]

raeburn		Mon May 10 20:09:25 2021 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Speed-up &allowed() when checking for course.*.lock.sections in %env,
    by ignoring privs except bre,pch,plc,pac,sma and for bre only checking in 
    current course for course-specific URLs (including /res/lib/templates/*). 
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1453 loncom/lonnet/perl/lonnet.pm:1.1454
--- loncom/lonnet/perl/lonnet.pm:1.1453	Mon May 10 18:13:50 2021
+++ loncom/lonnet/perl/lonnet.pm	Mon May 10 20:09:25 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1453 2021/05/10 18:13:50 raeburn Exp $
+# $Id: lonnet.pm,v 1.1454 2021/05/10 20:09:25 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -8530,11 +8530,39 @@
 #
 
 # Possibly locked functionality, check all courses
+# In roles.tab, L (unless locked) available for bre, pch, plc, pac and sma.
 # Locks might take effect only after 10 minutes cache expiration for other
-# courses, and 2 minutes for current course
+# courses, and 2 minutes for current course, in which user has st or ta role
+# which is neither expired nor a future role (unless current course).
 
+    my ($needlockcheck,$now,$crsonly);
     if ($thisallowed=~/L/) {
-        my $now = time;
+        $now = time;
+        if ($priv eq 'bre') {
+            if ($uri ne '') {
+                if ($orguri =~ m{^/+res/}) {
+                    if ($uri =~ m{^lib/templates/}) {
+                        if ($env{'request.course.id'}) {
+                            $crsonly = 1;
+                            $needlockcheck = 1;
+                        }
+                    } else {
+                        $needlockcheck = 1;
+                    }
+                } elsif ($env{'request.course.id'}) {
+                    my ($crsdom,$crsnum) = split('_',$env{'request.course.id'});
+                    if (($uri =~ m{^(adm|uploaded|public)/$crsdom/$crsnum/}) ||
+                        ($uri =~ m{^adm/$match_domain/$match_username/\d+/(smppg|bulletinboard)$})) {
+                        $crsonly = 1;
+                    }
+                    $needlockcheck = 1;
+                }
+            }
+        } elsif (($priv eq 'pch') || ($priv eq 'plc') || ($priv eq 'pac') || ($priv eq 'sma')) {
+            $needlockcheck = 1;
+        }
+    }
+    if ($needlockcheck) {
         foreach my $envkey (keys(%env)) {
            if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                my $courseid=$2;
@@ -8544,6 +8572,7 @@
                    my ($start,$end) = split(/\./,$env{$envkey});
                    next unless (($now >= $start) && (!$end || $end > $now));
                }
+               
                my $expiretime=600;
                if ($env{'request.role'} eq $roleid) {
 		  $expiretime=120;