[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.750 and 1.757

version 1.750, 2006/06/19 21:01:01 version 1.757, 2006/06/22 15:34:16
Line 281  sub critical { Line 281  sub critical {
     return $answer;      return $answer;
 }  }
   
   # ------------------------------------------- check if return value is an error
   
   sub error {
       my ($result) = @_;
       if ($result =~ /^(con_lost|no_such_host|error: (\d+) (.*))/) {
    if ($2 == 2) { return undef; }
    return $1;
       }
       return undef;
   }
   
 # ------------------------------------------- Transfer profile into environment  # ------------------------------------------- Transfer profile into environment
   
 sub transfer_profile_to_env {  sub transfer_profile_to_env {
Line 2922  sub del { Line 2933  sub del {
 # -------------------------------------------------------------- dump interface  # -------------------------------------------------------------- dump interface
   
 sub dump {  sub dump {
    my ($namespace,$udomain,$uname,$regexp,$range)=@_;      my ($namespace,$udomain,$uname,$regexp,$range)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }      if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }      if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);      my $uhome=&homeserver($uname,$udomain);
    if ($regexp) {      if ($regexp) {
        $regexp=&escape($regexp);   $regexp=&escape($regexp);
    } else {      } else {
        $regexp='.';   $regexp='.';
    }      }
    my $rep=reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);      my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
    my @pairs=split(/\&/,$rep);      my @pairs=split(/\&/,$rep);
    my %returnhash=();      my %returnhash=();
    foreach (@pairs) {      foreach my $item (@pairs) {
       my ($key,$value)=split(/=/,$_,2);   my ($key,$value)=split(/=/,$item,2);
       $returnhash{unescape($key)}=&thaw_unescape($value);   $key = &unescape($key);
    }   next if ($key =~ /^error: 2 /);
    return %returnhash;   $returnhash{$key}=&thaw_unescape($value);
       }
       return %returnhash;
 }  }
   
 # --------------------------------------------------------- dumpstore interface  # --------------------------------------------------------- dumpstore interface
Line 4693  sub get_access_controls { Line 4706  sub get_access_controls {
     return %access;      return %access;
 }  }
   
 sub parse_access_controls {  
     my ($access_item) = @_;  
     my %content;  
     my $token;  
     my $parser=HTML::TokeParser->new(\$access_item);  
     while ($token=$parser->get_token) {  
         if ($token->[0] eq 'S')  {  
             my $entry=$token->[1];  
             if ($entry eq 'scope') {  
                 my $type = $token->[2]{'type'};  
             } else {  
                 my $value=$parser->get_text('/'.$entry);  
                 $content{$entry}=$value;  
             }  
         }  
     }  
     return %content;  
 }  
   
 sub modify_access_controls {  sub modify_access_controls {
     my ($file_name,$changes,$domain,$user)=@_;      my ($file_name,$changes,$domain,$user)=@_;
     my ($outcome,$deloutcome);      my ($outcome,$deloutcome);
Line 4923  sub dirlist { Line 4917  sub dirlist {
     if(defined($alternateDirectoryRoot)) {      if(defined($alternateDirectoryRoot)) {
         $dirRoot = $alternateDirectoryRoot;          $dirRoot = $alternateDirectoryRoot;
         $dirRoot =~ s/\/$//;          $dirRoot =~ s/\/$//;
     }Clay Greene      }
   
     if($udom) {      if($udom) {
         if($uname) {          if($uname) {
Removed from v.1.750  
changed lines
  Added in v.1.757

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