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

banghart lon-capa-cvs@mail.lon-capa.org
Wed, 19 Jan 2005 01:25:35 -0000


banghart		Tue Jan 18 20:25:35 2005 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  	lonnet::filelocation now returns location of portfolio files
  	minor formatting correction
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.589 loncom/lonnet/perl/lonnet.pm:1.590
--- loncom/lonnet/perl/lonnet.pm:1.589	Tue Jan 18 17:09:14 2005
+++ loncom/lonnet/perl/lonnet.pm	Tue Jan 18 20:25:35 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.589 2005/01/18 22:09:14 albertel Exp $
+# $Id: lonnet.pm,v 1.590 2005/01/19 01:25:35 banghart Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -5433,39 +5433,42 @@
 }
 
 sub filelocation {
-  my ($dir,$file) = @_;
-  my $location;
-  $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
-  if ($file=~m:^/~:) { # is a contruction space reference
-    $location = $file;
-    $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
-  } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
-      my ($udom,$uname,$filename)=
-	  ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|);
-      my $home=&homeserver($uname,$udom);
-      my $is_me=0;
-      my @ids=&current_machine_ids();
-      foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
-      if ($is_me) {
-	  $location=&Apache::loncommon::propath($udom,$uname).
-	      '/userfiles/'.$filename;
-      } else {
-	  $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
-	      $udom.'/'.$uname.'/'.$filename;
-      }
-  } else {
-    $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
-    $file=~s:^/res/:/:;
-    if ( !( $file =~ m:^/:) ) {
-      $location = $dir. '/'.$file;
-    } else {
-      $location = '/home/httpd/html/res'.$file;
+    my ($dir,$file) = @_;
+    my $location;
+    $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
+    if ($file=~m:^/~:) { # is a contruction space reference
+        $location = $file;
+        $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
+    } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
+        my ($udom,$uname,$filename)=
+  	    ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|);
+        my $home=&homeserver($uname,$udom);
+        my $is_me=0;
+        my @ids=&current_machine_ids();
+        foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
+        if ($is_me) {
+  	    $location=&Apache::loncommon::propath($udom,$uname).
+  	      '/userfiles/'.$filename;
+        } else {
+  	  $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
+  	      $udom.'/'.$uname.'/'.$filename;
+        }
+    } elsif ($file =~ /^\/adm\/portfolio\//) {
+        $file =~ s:^/adm/portfolio/::;
+        $location = $location=&Apache::loncommon::propath($ENV{'user.domain'},$ENV{'user.name'}).'/userfiles/portfolio/'.$file;
+    } else {
+        $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
+        $file=~s:^/res/:/:;
+        if ( !( $file =~ m:^/:) ) {
+            $location = $dir. '/'.$file;
+        } else {
+            $location = '/home/httpd/html/res'.$file;
+        }
     }
-  }
-  $location=~s://+:/:g; # remove duplicate /
-  while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
-  while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./
-  return $location;
+    $location=~s://+:/:g; # remove duplicate /
+    while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
+    while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./
+    return $location;
 }
 
 sub hreflocation {