[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.250 and 1.254

version 1.250, 2002/07/04 15:47:18 version 1.254, 2002/07/27 19:06:41
Line 708  sub ssi { Line 708  sub ssi {
     return $response->content;      return $response->content;
 }  }
   
   # ------- Add a token to a remote URI's query string to vouch for access rights
   
   sub tokenwrapper {
       my $uri=shift;
       my $token=&reply('tmpput:'.&escape($uri),$perlvar{'lonHostID'});
       return $uri.(($uri=~/\?/)?'&':'?').
    'token='.$token.'&server='.$perlvar{'lonHostID'};
   }
       
   
 # ------------------------------------------------------------------------- Log  # ------------------------------------------------------------------------- Log
   
 sub log {  sub log {
Line 2166  sub revokecustomrole { Line 2176  sub revokecustomrole {
 # ------------------------------------------------------------ Directory lister  # ------------------------------------------------------------ Directory lister
   
 sub dirlist {  sub dirlist {
     my $uri=shift;      my ($uri,$userdomain,$username,$alternateDirectoryRoot)=@_;
   
     $uri=~s/^\///;      $uri=~s/^\///;
     $uri=~s/\/$//;      $uri=~s/\/$//;
     my ($res,$udom,$uname,@rest)=split(/\//,$uri);      my ($udom, $uname);
     if ($udom) {      (undef,$udom,$uname)=split(/\//,$uri);
      if ($uname) {      if(defined($userdomain)) {
        my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/'.$uri,          $udom = $userdomain;
                       homeserver($uname,$udom));      }
        return split(/:/,$listing);      if(defined($username)) {
      } else {          $uname = $username;
        my $tryserver;      }
        my %allusers=();  
        foreach $tryserver (keys %libserv) {      my $dirRoot = $perlvar{'lonDocRoot'};
   if ($hostdom{$tryserver} eq $udom) {      if(defined($alternateDirectoryRoot)) {
              my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.$udom,          $dirRoot = $alternateDirectoryRoot;
        $tryserver);          $dirRoot =~ s/\/$//;
              if (($listing ne 'no_such_dir') && ($listing ne 'empty')      }
               && ($listing ne 'con_lost')) {  
                 foreach (split(/:/,$listing)) {      if($udom) {
                   my ($entry,@stat)=split(/&/,$_);          if($uname) {
                   $allusers{$entry}=1;              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) {
        my $alluserstr='';                  $alluserstr.=$_.'&user:';
        foreach (sort keys %allusers) {              }
            $alluserstr.=$_.'&user:';              $alluserstr=~s/:$//;
        }              return split(/:/,$alluserstr);
        $alluserstr=~s/:$//;          } else {
        return split(/:/,$alluserstr);              my @emptyResults = ();
      }               push(@emptyResults, 'missing user name');
    } else {              return split(':',@emptyResults);
        my $tryserver;          }
        my %alldom=();      } elsif(!defined($alternateDirectoryRoot)) {
        foreach $tryserver (keys %libserv) {          my $tryserver;
    $alldom{$hostdom{$tryserver}}=1;          my %alldom=();
        }          foreach $tryserver (keys %libserv) {
        my $alldomstr='';              $alldom{$hostdom{$tryserver}}=1;
        foreach (sort keys %alldom) {          }
           $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';          my $alldomstr='';
        }          foreach (sort keys %alldom) {
        $alldomstr=~s/:$//;              $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
        return split(/:/,$alldomstr);                 }
    }          $alldomstr=~s/:$//;
           return split(/:/,$alldomstr);       
       } else {
           my @emptyResults = ();
           push(@emptyResults, 'missing domain');
           return split(':',@emptyResults);
       }
 }  }
   
 # -------------------------------------------------------- Value of a Condition  # -------------------------------------------------------- Value of a Condition
Line 2278  sub courseresdata { Line 2311  sub courseresdata {
  if (time-$courseresdatacache{$hashid.'.time'}>300) { $dodump=1; }   if (time-$courseresdatacache{$hashid.'.time'}>300) { $dodump=1; }
     }      }
     if ($dodump) {      if ($dodump) {
  my $coursehom=&homeserver($coursenum,$coursedomain);   my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
  if ($coursehom) {   my ($tmp) = keys(%dumpreply);
     my $dumpreply=&reply('dump:'.$coursedomain.':'.$coursenum.   if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
  ':resourcedata:.',$coursehom);      $courseresdatacache{$hashid.'.time'}=time;
     if ($dumpreply!~/^error\:/) {      $courseresdatacache{$hashid}=\%dumpreply;
  $courseresdatacache{$hashid.'.time'}=time;  
  $courseresdatacache{$hashid}=$dumpreply;  
     }  
  }   }
     }      }
     my @pairs=split(/\&/,$courseresdatacache{$hashid});      foreach my $item (@which) {
     my %returnhash=();   if ($courseresdatacache{$hashid}->{$item}) {
     foreach (@pairs) {      return $courseresdatacache{$hashid}->{$item};
  my ($key,$value)=split(/=/,$_);   }
  $returnhash{unescape($key)}=unescape($value);  
     }  
     my $item;  
     foreach $item (@which) {  
  if ($returnhash{$item}) { return $returnhash{$item}; }  
     }      }
     return '';      return '';
 }  }
Line 2956  BEGIN { Line 2981  BEGIN {
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);         chomp($configline);
        my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);         my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
        $hostname{$id}=$name;         if ($id && $domain && $role && $name && $ip) {
        $hostdom{$id}=$domain;   $hostname{$id}=$name;
        $hostip{$id}=$ip;   $hostdom{$id}=$domain;
        if ($domdescr) {   $hostip{$id}=$ip;
    $domaindescription{$domain}=$domdescr;   if ($domdescr) { $domaindescription{$domain}=$domdescr; }
    if ($role eq 'library') { $libserv{$id}=$name; }
          } else {
    if ($configline) {
      &logthis("Skipping hosts.tab line -$configline-");
    }
        }         }
        if ($role eq 'library') { $libserv{$id}=$name; }  
     }      }
 }  }
   
Removed from v.1.250  
changed lines
  Added in v.1.254

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