[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.954 and 1.955

version 1.954, 2008/04/04 16:56:11 version 1.955, 2008/04/16 22:59:36
Line 5803  sub revokecustomrole { Line 5803  sub revokecustomrole {
   
 # ------------------------------------------------------------ Disk usage  # ------------------------------------------------------------ Disk usage
 sub diskusage {  sub diskusage {
     my ($udom,$uname,$directoryRoot)=@_;      my ($udom,$uname,$directorypath,$getpropath)=@_;
     $directoryRoot =~ s/\/$//;      $directorypath =~ s/\/$//;
     my $listing=&reply('du:'.$directoryRoot,homeserver($uname,$udom));      my $listing=&reply('du2:'.&escape($directorypath).':'
                          .&escape($getpropath).':'.&escape($uname).':'
                          .&escape($udom),homeserver($uname,$udom));
       if ($listing eq 'unknown_cmd') {
           if ($getpropath) {
               $directorypath = &propath($udom,$uname).'/'.$directorypath; 
           }
           $listing = &reply('du:'.$directorypath,homeserver($uname,$udom));
       }
     return $listing;      return $listing;
 }  }
   
Line 6222  sub unmark_as_readonly { Line 6230  sub unmark_as_readonly {
 # ------------------------------------------------------------ Directory lister  # ------------------------------------------------------------ Directory lister
   
 sub dirlist {  sub dirlist {
     my ($uri,$userdomain,$username,$alternateDirectoryRoot)=@_;      my ($uri,$userdomain,$username,$getpropath,$getuserdir,$alternateRoot)=@_;
   
     $uri=~s/^\///;      $uri=~s/^\///;
     $uri=~s/\/$//;      $uri=~s/\/$//;
     my ($udom, $uname);      my ($udom, $uname);
     (undef,$udom,$uname)=split(/\//,$uri);      if ($getuserdir) {
     if(defined($userdomain)) {  
         $udom = $userdomain;          $udom = $userdomain;
     }  
     if(defined($username)) {  
         $uname = $username;          $uname = $username;
       } else {
           (undef,$udom,$uname)=split(/\//,$uri);
           if(defined($userdomain)) {
               $udom = $userdomain;
           }
           if(defined($username)) {
               $uname = $username;
           }
     }      }
       my ($dirRoot,$listing,@listing_results);
   
     my $dirRoot = $perlvar{'lonDocRoot'};      $dirRoot = $perlvar{'lonDocRoot'};
     if(defined($alternateDirectoryRoot)) {      if (defined($getpropath)) {
         $dirRoot = $alternateDirectoryRoot;          $dirRoot = &propath($udom,$uname);
         $dirRoot =~ s/\/$//;          $dirRoot =~ s/\/$//;
       } elsif (defined($getuserdir)) {
           my $subdir=$uname.'__';
           $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
           $dirRoot = $Apache::lonnet::perlvar{'lonUsersDir'}
                      ."/$udom/$subdir/$uname";
       } elsif (defined($alternateRoot)) {
           $dirRoot = $alternateRoot;
     }      }
   
     if($udom) {      if($udom) {
         if($uname) {          if($uname) {
             my $listing = &reply('ls2:'.$dirRoot.'/'.$uri,              $listing = &reply('ls3:'.&escape('/'.$uri).':'.$getpropath.':'
  &homeserver($uname,$udom));                                .$getuserdir.':'.&escape($alternateRoot)
             my @listing_results;                                .':'.&escape($uname).':'.&escape($udom),
                                 &homeserver($uname,$udom));
               if ($listing eq 'unknown_cmd') {
                   $listing = &reply('ls2:'.$dirRoot.'/'.$uri,
                                     &homeserver($uname,$udom));
               } else {
                   @listing_results = map { &unescape($_); } split(/:/,$listing);
               }
             if ($listing eq 'unknown_cmd') {              if ($listing eq 'unknown_cmd') {
                 $listing = &reply('ls:'.$dirRoot.'/'.$uri,                  $listing = &reply('ls:'.$dirRoot.'/'.$uri,
   &homeserver($uname,$udom));    &homeserver($uname,$udom));
Line 6254  sub dirlist { Line 6281  sub dirlist {
                 @listing_results = map { &unescape($_); } split(/:/,$listing);                  @listing_results = map { &unescape($_); } split(/:/,$listing);
             }              }
             return @listing_results;              return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {          } elsif(!$alternateRoot) {
             my %allusers;              my %allusers;
     my %servers = &get_servers($udom,'library');      my %servers = &get_servers($udom,'library');
     foreach my $tryserver (keys(%servers)) {       foreach my $tryserver (keys(%servers)) {
  my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.                  $listing = &reply('ls3:'.&escape("/res/$udom").':::::'.
      $udom, $tryserver);                                    &escape($udom),$tryserver);
  my @listing_results;                  if ($listing eq 'unknown_cmd') {
       $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
         $udom, $tryserver);
                   } else {
                       @listing_results = map { &unescape($_); } split(/:/,$listing);
                   }
  if ($listing eq 'unknown_cmd') {   if ($listing eq 'unknown_cmd') {
     $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.      $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
       $udom, $tryserver);        $udom, $tryserver);
Line 6287  sub dirlist { Line 6319  sub dirlist {
         } else {          } else {
             return ('missing user name');              return ('missing user name');
         }          }
     } elsif(!defined($alternateDirectoryRoot)) {      } elsif(!defined($getpropath)) {
         my @all_domains = sort(&all_domains());          my @all_domains = sort(&all_domains());
          foreach my $domain (@all_domains) {          foreach my $domain (@all_domains) {
              $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';              $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
          }          }
          return @all_domains;          return @all_domains;
      } else {      } else {
         return ('missing domain');          return ('missing domain');
     }      }
 }  }
Line 6303  sub dirlist { Line 6335  sub dirlist {
 # when it was last modified.  It will also return an error of -1  # when it was last modified.  It will also return an error of -1
 # if an error occurs  # if an error occurs
   
 ##  
 ## FIXME: This subroutine assumes its caller knows something about the  
 ## directory structure of the home server for the student ($root).  
 ## Not a good assumption to make.  Since this is for looking up files  
 ## in user directories, the full path should be constructed by lond, not  
 ## whatever machine we request data from.  
 ##  
 sub GetFileTimestamp {  sub GetFileTimestamp {
     my ($studentDomain,$studentName,$filename,$root)=@_;      my ($studentDomain,$studentName,$filename,$getuserdir)=@_;
     $studentDomain = &LONCAPA::clean_domain($studentDomain);      $studentDomain = &LONCAPA::clean_domain($studentDomain);
     $studentName   = &LONCAPA::clean_username($studentName);      $studentName   = &LONCAPA::clean_username($studentName);
     my $subdir=$studentName.'__';      my ($fileStat) = 
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;          &Apache::lonnet::dirlist($filename,$studentDomain,$studentName, 
     my $proname="$studentDomain/$subdir/$studentName";                                   undef,$getuserdir);
     $proname .= '/'.$filename;  
     my ($fileStat) = &Apache::lonnet::dirlist($proname, $studentDomain,   
                                               $studentName, $root);  
     my @stats = split('&', $fileStat);      my @stats = split('&', $fileStat);
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {      if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
         # @stats contains first the filename, then the stat output          # @stats contains first the filename, then the stat output
Line 6333  sub stat_file { Line 6355  sub stat_file {
     my ($uri) = @_;      my ($uri) = @_;
     $uri = &clutter_with_no_wrapper($uri);      $uri = &clutter_with_no_wrapper($uri);
   
     my ($udom,$uname,$file,$dir);      my ($udom,$uname,$file);
     if ($uri =~ m-^/(uploaded|editupload)/-) {      if ($uri =~ m-^/(uploaded|editupload)/-) {
  ($udom,$uname,$file) =   ($udom,$uname,$file) =
     ($uri =~ m-/(?:uploaded|editupload)/?($match_domain)/?($match_name)/?(.*)-);      ($uri =~ m-/(?:uploaded|editupload)/?($match_domain)/?($match_name)/?(.*)-);
  $file = 'userfiles/'.$file;   $file = 'userfiles/'.$file;
  $dir = &propath($udom,$uname);  
     }      }
     if ($uri =~ m-^/res/-) {      if ($uri =~ m-^/res/-) {
  ($udom,$uname) =    ($udom,$uname) = 
Line 6351  sub stat_file { Line 6372  sub stat_file {
  return ();   return ();
     }      }
   
     my ($result) = &dirlist($file,$udom,$uname,$dir);      my $getpropath = 1;
       my ($result) = &dirlist($file,$udom,$uname,$getpropath);
     my @stats = split('&', $result);      my @stats = split('&', $result);
           
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {      if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
Line 8104  sub filelocation { Line 8126  sub filelocation {
         my @ids=&current_machine_ids();          my @ids=&current_machine_ids();
         foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }          foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
         if ($is_me) {          if ($is_me) {
      $location=&propath($udom,$uname).       $location=&propath($udom,$uname).'/userfiles/'.$filename;
        '/userfiles/'.$filename;  
         } else {          } else {
    $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.     $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
        $udom.'/'.$uname.'/'.$filename;         $udom.'/'.$uname.'/'.$filename;
Removed from v.1.954  
changed lines
  Added in v.1.955

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>