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

[stredwic]

stredwic		Wed Jul 17 15:18:48 2002 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Added the ability for dirlist to take alternate roots for the directory.  
  Three parameters were added, $userdomain, $username, and $alternateDirectoryRoot.
  The domain and name are necessary because of a call to homeserver.  Previously,
  the uri(parameter) was parsed to get that info.  It defaults to that, but the
  other parameters will override it if they are defined.  This was necessary, or
  different parsings of the uri would have been needed based on the type of uri passed
  in.
  
  If alternateDirectoryRoot is not defined, then the function defaults to $perlvar{'lonDocRoot'}
  for the directory root.  Also, if username and userdomain are not supplied for
  alternate directory roots, it gives up.  The default search of all students and/or domains
  when missing that data for the default directory root still exists.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.252 loncom/lonnet/perl/lonnet.pm:1.253
--- loncom/lonnet/perl/lonnet.pm:1.252	Wed Jul 17 14:01:33 2002
+++ loncom/lonnet/perl/lonnet.pm	Wed Jul 17 15:18:47 2002
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.252 2002/07/17 18:01:33 albertel Exp $
+# $Id: lonnet.pm,v 1.253 2002/07/17 19:18:47 stredwic Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2166,51 +2166,74 @@
 # ------------------------------------------------------------ Directory lister
 
 sub dirlist {
-    my $uri=shift;
+    my ($uri,$userdomain,$username,$alternateDirectoryRoot)=@_;
+
     $uri=~s/^\///;
     $uri=~s/\/$//;
-    my ($res,$udom,$uname,@rest)=split(/\//,$uri);
-    if ($udom) {
-     if ($uname) {
-       my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/'.$uri,
-                      homeserver($uname,$udom));
-       return split(/:/,$listing);
-     } else {
-       my $tryserver;
-       my %allusers=();
-       foreach $tryserver (keys %libserv) {
-	  if ($hostdom{$tryserver} eq $udom) {
-             my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.$udom,
-			       $tryserver);
-             if (($listing ne 'no_such_dir') && ($listing ne 'empty')
-              && ($listing ne 'con_lost')) {
-                foreach (split(/:/,$listing)) {
-                  my ($entry,@stat)=split(/&/,$_);
-                  $allusers{$entry}=1;
+    my ($udom, $uname);
+    (undef,$udom,$uname)=split(/\//,$uri);
+    if(defined($userdomain)) {
+        $udom = $userdomain;
+    }
+    if(defined($username)) {
+        $uname = $username;
+    }
+
+    my $dirRoot = $perlvar{'lonDocRoot'};
+    if(defined($alternateDirectoryRoot)) {
+        $dirRoot = $alternateDirectoryRoot;
+        $dirRoot =~ s/\/$//;
+    }
+
+    if($udom) {
+        if($uname) {
+            my $listing=reply('ls:'.$dirRoot.'/'.$uri,
+                              homeserver($uname,$udom));
+            return split(/:/,$listing);
+        } elsif(!defined($alternateDirectoryRoot)) {
+            my $tryserver;
+            my %allusers=();
+            foreach $tryserver (keys %libserv) {
+                if($hostdom{$tryserver} eq $udom) {
+                    my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+                                      $udom, $tryserver);
+                    if (($listing ne 'no_such_dir') && ($listing ne 'empty')
+                        && ($listing ne 'con_lost')) {
+                        foreach (split(/:/,$listing)) {
+                            my ($entry,@stat)=split(/&/,$_);
+                            $allusers{$entry}=1;
+                        }
+                    }
                 }
-             }
-	  }
-       }
-       my $alluserstr='';
-       foreach (sort keys %allusers) {
-           $alluserstr.=$_.'&user:';
-       }
-       $alluserstr=~s/:$//;
-       return split(/:/,$alluserstr);
-     } 
-   } else {
-       my $tryserver;
-       my %alldom=();
-       foreach $tryserver (keys %libserv) {
-	   $alldom{$hostdom{$tryserver}}=1;
-       }
-       my $alldomstr='';
-       foreach (sort keys %alldom) {
-          $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
-       }
-       $alldomstr=~s/:$//;
-       return split(/:/,$alldomstr);       
-   }
+            }
+            my $alluserstr='';
+            foreach (sort keys %allusers) {
+                $alluserstr.=$_.'&user:';
+            }
+            $alluserstr=~s/:$//;
+            return split(/:/,$alluserstr);
+        } else {
+            my @emptyResults = ();
+            push(@emptyResults, 'missing user name');
+            return split(':',@emptyResults);
+        }
+    } elsif(!defined($alternateDirectoryRoot)) {
+        my $tryserver;
+        my %alldom=();
+        foreach $tryserver (keys %libserv) {
+            $alldom{$hostdom{$tryserver}}=1;
+        }
+        my $alldomstr='';
+        foreach (sort keys %alldom) {
+            $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
+        }
+        $alldomstr=~s/:$//;
+        return split(/:/,$alldomstr);       
+    } else {
+        my @emptyResults = ();
+        push(@emptyResults, 'missing domain');
+        return split(':',@emptyResults);
+    }
 }
 
 # -------------------------------------------------------- Value of a Condition