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

[www]

www		Mon Nov 18 10:16:35 2002 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Bug #975 - &allowed recognizes that a "public" resource is used within the
  framework of a course, and does not return "F".
  
  Bug #793 - has new subroutine "gettitle", which ideally takes symb as
  parameter and should return the table-of-contents title of a resource if
  possible.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.300 loncom/lonnet/perl/lonnet.pm:1.301
--- loncom/lonnet/perl/lonnet.pm:1.300	Tue Nov 12 17:23:37 2002
+++ loncom/lonnet/perl/lonnet.pm	Mon Nov 18 10:16:35 2002
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.300 2002/11/12 22:23:37 albertel Exp $
+# $Id: lonnet.pm,v 1.301 2002/11/18 15:16:35 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -78,7 +78,7 @@
 use HTTP::Headers;
 use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
-   %libserv %pr %prp %metacache %packagetab 
+   %libserv %pr %prp %metacache %packagetab %titlecache 
    %courselogs %accesshash $processmarker $dumpcount 
    %coursedombuf %coursehombuf %courseresdatacache %domaindescription);
 use IO::Socket;
@@ -1802,7 +1802,9 @@
 
     if ($priv eq 'bre') {
         my $copyright=&metadata($uri,'copyright');
-	if ($copyright eq 'public') { return 'F'; }
+	if (($copyright eq 'public') && (!$ENV{'request.course.id'})) { 
+           return 'F'; 
+        }
         if ($copyright eq 'priv') {
             $uri=~/([^\/]+)\/([^\/]+)\//;
 	    unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) {
@@ -3096,6 +3098,33 @@
     }
 }
 
+# ------------------------------------------------- Get the title of a resource
+
+sub gettitle {
+    my $urlsymb=shift;
+    my $symb=&symbread($urlsymb);
+    unless ($symb) {
+	unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
+        return &metadata($urlsymb,'title'); 
+    }
+    if ($titlecache{$symb}) { return $titlecache{$symb}; }
+    my ($map,$resid,$url)=split(/\_\_\_/,$symb);
+    my $title='';
+    my %bighash;
+    if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
+                            &GDBM_READER(),0640)) {
+        my $mapid=$bighash{'map_pc_'.&clutter($map)};
+        $title=$bighash{'title_'.$mapid.'.'.$resid};
+        untie %bighash;
+    }
+    if ($title) {
+        $titlecache{$symb}=$title;
+        return $title;
+    } else {
+	return &metadata($urlsymb,'title');
+    }
+}
+    
 # ------------------------------------------------- Update symbolic store links
 
 sub symblist {