--- loncom/metadata_database/searchcat.pl	2001/04/14 18:24:54	1.1
+++ loncom/metadata_database/searchcat.pl	2001/04/16 12:26:36	1.7
@@ -8,10 +8,9 @@
 # directory and gathers metadata.
 # The metadata is entered into a SQL database.
 
-use strict;
-
 use IO::File;
 use HTML::TokeParser;
+use DBI;
 
 my @metalist;
 # ----------------- Code to enable 'find' subroutine listing of the .meta files
@@ -35,9 +34,9 @@ while ($configline=<CONFIG>) {
 }
 close(CONFIG);
 
+my $dbh;
 # ------------------------------------- Make sure that database can be accessed
 {
-    my $dbh;
     unless (
 	    $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
 	    ) { 
@@ -47,14 +46,20 @@ close(CONFIG);
 }
 
 # ------------------------------------------------------------- get .meta files
-# need to actually loop over existing users here.. will fix soon
-&find("$perlvar{'lonDocRoot'}/res");
+opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");
+my @homeusers=grep
+          {&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")}
+          grep {!/^\.\.?$/} readdir(RESOURCES);
+closedir RESOURCES;
+foreach my $user (@homeusers) {
+    &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");
+}
 
 # -- process each file to get metadata and put into search catalog SQL database
 foreach my $m (@metalist) {
     my $ref=&metadata($m);
     my $sth=$dbh->prepare('insert into metadata values ('.
-			  delete($ref->{'title'}),
+			  delete($ref->{'title'}).','.
 			  delete($ref->{'author'}).','.
 			  delete($ref->{'subject'}).','.
 			  delete($ref->{'url'}).','.
@@ -67,8 +72,7 @@ foreach my $m (@metalist) {
 			  delete($ref->{'creationdate'}).','.
 			  delete($ref->{'lastrevisiondate'}).','.
 			  delete($ref->{'owner'}).','.
-			  delete($ref->{'copyright'}).
-			  ')';
+			  delete($ref->{'copyright'}));
     $sth->execute();
 }
 
@@ -141,3 +145,29 @@ sub declutter {
     $thisfn=~s/^res\///;
     return $thisfn;
 }
+
+# --------------------------------------- Is this the home server of an author?
+# (copied from lond, modification of the return value)
+sub ishome {
+    my $author=shift;
+    $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+    my ($udom,$uname)=split(/\//,$author);
+    my $proname=propath($udom,$uname);
+    if (-e $proname) {
+	return 1;
+    } else {
+        return 0;
+    }
+}
+
+# -------------------------------------------- Return path to profile directory
+# (copied from lond)
+sub propath {
+    my ($udom,$uname)=@_;
+    $udom=~s/\W//g;
+    $uname=~s/\W//g;
+    my $subdir=$uname.'__';
+    $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+    my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
+    return $proname;
+}