Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.753 and 1.755

version 1.753, 2006/06/22 13:16:09 version 1.755, 2006/06/22 14:30:14
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;
       }
       &logthis("accepting $result");
       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 2934  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 4711  sub parse_access_controls { Line 4725  sub parse_access_controls {
                 }                  }
             } elsif ($entry eq 'roles') {              } elsif ($entry eq 'roles') {
                 $role_id = $token->[2]{id};                  $role_id = $token->[2]{id};
  $content{$entry}{$role_id}} = {   $content{$entry}{$role_id} = {
                                  role => [],                                   role => [],
                                                  access => [],                                                   access => [],
                                                  section => [],                                                   section => [],
                                                  group => [],                                                   group => [],
                                                 };                                               };
             } elsif ($entry eq 'users') {              } elsif ($entry eq 'users') {
                 $content{'users'} = {};                  $content{'users'} = {};
                 $usercount = 0;                  $usercount = 0;

Removed from v.1.753  
changed lines
  Added in v.1.755


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