--- loncom/lonnet/perl/lonnet.pm	2003/12/08 13:50:57	1.457
+++ loncom/lonnet/perl/lonnet.pm	2004/01/15 19:41:00	1.463
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.457 2003/12/08 13:50:57 raeburn Exp $
+# $Id: lonnet.pm,v 1.463 2004/01/15 19:41:00 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1319,8 +1319,15 @@ sub flushcourselogs {
 # Writes to the dynamic metadata of resources to get hit counts, etc.
 #
     foreach my $entry (keys(%accesshash)) {
-        my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
-        if ($type eq 'count'){
+        if ($entry =~ /___count$/) {
+            my ($dom,$name);
+            ($dom,$name,undef)=($entry=~m:___(\w+)/(\w+)/(.*)___count$:);
+            if (! defined($dom) || $dom eq '' || 
+                ! defined($name) || $name eq '') {
+                my $cid = $ENV{'request.course.id'};
+                $dom  = $ENV{'request.'.$cid.'.domain'};
+                $name = $ENV{'request.'.$cid.'.num'};
+            }
             my $value = $accesshash{$entry};
             my (undef,$url,undef) = ($entry =~ /^(.*)___(.*)___count$/);
             my %temphash=($url => $value);
@@ -1335,6 +1342,7 @@ sub flushcourselogs {
                 }
             }
         } else {
+            my ($dom,$name) = ($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
             my %temphash=($entry => $accesshash{$entry});
             if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                 delete $accesshash{$entry};
@@ -1375,8 +1383,7 @@ sub courselog {
     } else {
 	$courselogs{$ENV{'request.course.id'}}.=$what;
     }
-#    if (length($courselogs{$ENV{'request.course.id'}})>4048) {
-    if (length($courselogs{$ENV{'request.course.id'}})>48) {
+    if (length($courselogs{$ENV{'request.course.id'}})>4048) {
 	&flushcourselogs();
     }
 }
@@ -1398,6 +1405,7 @@ sub courseacclog {
 
 sub countacc {
     my $url=&declutter(shift);
+    return if (! defined($url) || $url eq '');
     unless ($ENV{'request.course.id'}) { return ''; }
     $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
     my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
@@ -2119,6 +2127,36 @@ sub coursedescription {
     return %returnhash;
 }
 
+# -------------------------------------------------See if a user is privileged
+
+sub privileged {
+    my ($username,$domain)=@_;
+    my $rolesdump=&reply("dump:$domain:$username:roles",
+			&homeserver($username,$domain));
+    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }
+    my $now=time;
+    if ($rolesdump ne '') {
+        foreach (split(/&/,$rolesdump)) {
+	    if ($_!~/^rolesdef\&/) {
+		my ($area,$role)=split(/=/,$_);
+		$area=~s/\_\w\w$//;
+		my ($trole,$tend,$tstart)=split(/_/,$role);
+		if (($trole eq 'dc') || ($trole eq 'su')) {
+		    my $active=1;
+		    if ($tend) {
+			if ($tend<$now) { $active=0; }
+		    }
+		    if ($tstart) {
+			if ($tstart>$now) { $active=0; }
+		    }
+		    if ($active) { return 1; }
+		}
+	    }
+	}
+    }
+    return 0;
+}
+
 # -------------------------------------------------------- Get user privileges
 
 sub rolesinit {
@@ -3695,12 +3733,13 @@ sub EXT {
 		    if ($$result{$courselevel}) {
 			return $$result{$courselevel}; }
 		} else {
-		    if ($tmp!~/No such file/) {
+		    #error 2 occurs when the .db doesn't exist
+		    if ($tmp!~/error: 2 /) {
 			&logthis("<font color=blue>WARNING:".
 				 " Trying to get resource data for ".
 				 $uname." at ".$udom.": ".
 				 $tmp."</font>");
-		    } elsif ($tmp=~/error:No such file/) {
+		    } elsif ($tmp=~/error: 2 /) {
                         &EXT_cache_set($udom,$uname);
 		    } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
 			return $tmp;
@@ -3783,7 +3822,9 @@ sub packages_tab_default {
     foreach my $package (split(/,/,$packages)) {
 	my ($pack_type,$pack_part)=split(/_/,$package,2);
 	if ($pack_part eq $part) {
-	    return $packagetab{"$pack_type&$name&default"};
+	    if (defined($packagetab{"$pack_type&$name&default"})) {
+		return $packagetab{"$pack_type&$name&default"};
+	    }
 	}
     }
     return undef;
@@ -4432,14 +4473,17 @@ sub filelocation {
 
 sub hreflocation {
     my ($dir,$file)=@_;
-    unless (($file=~/^http:\/\//i) || ($file=~/^\//)) {
-       my $finalpath=filelocation($dir,$file);
-       $finalpath=~s/^\/home\/httpd\/html//;
-       $finalpath=~s-/home/(\w+)/public_html/-/~$1/-;
-       return $finalpath;
-    } else {
-       return $file;
+    unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
+	my $finalpath=filelocation($dir,$file);
+	$finalpath=~s-^/home/httpd/html--;
+	$finalpath=~s-^/home/(\w+)/public_html/-/~$1/-;
+	return $finalpath;
+    } elsif ($file=~m-^/home-) {
+	$file=~s-^/home/httpd/html--;
+	$file=~s-^/home/(\w+)/public_html/-/~$1/-;
+	return $file;
     }
+    return $file;
 }
 
 # ------------------------------------------------------------- Declutters URLs