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

[raeburn]

raeburn		Thu Aug  9 14:04:35 2018 EDT

  Modified files:              
    /loncom	Lond.pm 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Fewer calls to courseiddump() to check if something is a course. 
  
  
Index: loncom/Lond.pm
diff -u loncom/Lond.pm:1.10 loncom/Lond.pm:1.11
--- loncom/Lond.pm:1.10	Thu May 18 22:13:52 2017
+++ loncom/Lond.pm	Thu Aug  9 14:04:30 2018
@@ -1,6 +1,6 @@
 # The LearningOnline Network
 #
-# $Id: Lond.pm,v 1.10 2017/05/18 22:13:52 raeburn Exp $
+# $Id: Lond.pm,v 1.11 2018/08/09 14:04:30 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -783,6 +783,35 @@
     return $qresult;
 }
 
+sub is_course {
+    my ($cdom,$cnum) = @_;
+
+    return unless (($cdom =~ /^$LONCAPA::match_domain$/) &&
+                   ($cnum =~ /^$LONCAPA::match_courseid$/));
+    my $hashid = $cdom.':'.$cnum;
+    my ($iscourse,$cached) =
+        &Apache::lonnet::is_cached_new('iscourse',$hashid);
+    unless (defined($cached)) {
+        my $hashref =
+            &tie_domain_hash($cdom, "nohist_courseids", &GDBM_WRCREAT());
+        if (ref($hashref) eq 'HASH') {
+            my $esc_key = &escape($cdom.'_'.$cnum);
+            if (exists($hashref->{$esc_key})) {
+                $iscourse = 1;
+            } else {
+                $iscourse = 0;
+            }
+            &Apache::lonnet::do_cache_new('iscourse',$hashid,$iscourse,3600);
+            unless (&untie_domain_hash($hashref)) {
+                &logthis("Failed to untie tied hash for nohist_courseids.db for $cdom");
+            }
+        } else {
+            &logthis("Failed to tie hash for nohist_courseids.db for $cdom");
+        }
+    }
+    return $iscourse;
+}
+
 sub server_certs {
     my ($perlvar) = @_;
     my %pemfiles = (
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1380 loncom/lonnet/perl/lonnet.pm:1.1381
--- loncom/lonnet/perl/lonnet.pm:1.1380	Tue Aug  7 17:12:25 2018
+++ loncom/lonnet/perl/lonnet.pm	Thu Aug  9 14:04:35 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1380 2018/08/07 17:12:25 raeburn Exp $
+# $Id: lonnet.pm,v 1.1381 2018/08/09 14:04:35 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -10041,12 +10041,25 @@
     my ($cdom, $cnum) = scalar(@_) == 1 ? 
          ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;
 
-    return unless $cdom and $cnum;
-
-    my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef,
-        '.');
-
-    return unless(exists($courses{$cdom.'_'.$cnum}));
+    return unless (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/));
+    my $uhome=&homeserver($cnum,$cdom);
+    my $iscourse;
+    if (grep { $_ eq $uhome } current_machine_ids()) {
+        $iscourse = &Lond::is_course($cdom,$cnum);
+    } else {
+        my $hashid = $cdom.':'.$cnum;
+        ($iscourse,my $cached) = &is_cached_new('iscourse',$hashid);
+        unless (defined($cached)) {
+            my %courses = &courseiddump($cdom, '.', 1, '.', '.',
+                                        $cnum,undef,undef,'.');
+            $iscourse = 0;
+            if (exists($courses{$cdom.'_'.$cnum})) {
+                $iscourse = 1;
+            }
+            &do_cache_new('iscourse',$hashid,$iscourse,3600);
+        }
+    }
+    return unless ($iscourse);
     return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;
 }