[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.749 and 1.755

version 1.749, 2006/06/16 22:37:35 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 4696  sub get_access_controls { Line 4710  sub get_access_controls {
 sub parse_access_controls {  sub parse_access_controls {
     my ($access_item) = @_;      my ($access_item) = @_;
     my %content;      my %content;
       my $role_id;
       my $user;
       my $usercount;
     my $token;      my $token;
     my $parser=HTML::TokeParser->new(\$access_item);      my $parser=HTML::TokeParser->new(\$access_item);
     while ($token=$parser->get_token) {      while ($token=$parser->get_token) {
Line 4703  sub parse_access_controls { Line 4720  sub parse_access_controls {
             my $entry=$token->[1];              my $entry=$token->[1];
             if ($entry eq 'scope') {              if ($entry eq 'scope') {
                 my $type = $token->[2]{'type'};                  my $type = $token->[2]{'type'};
                   if (($type eq 'course') || ($type eq 'group')) {
                       $content{'roles'} = {};
                   }
               } elsif ($entry eq 'roles') {
                   $role_id = $token->[2]{id};
    $content{$entry}{$role_id} = {
                                    role => [],
                                                    access => [],
                                                    section => [],
                                                    group => [],
                                                };
               } elsif ($entry eq 'users') {
                   $content{'users'} = {};
                   $usercount = 0;
               } elsif ($entry eq 'user') {
                   $user = '';
             } else {              } else {
                 my $value=$parser->get_text('/'.$entry);                  my $value=$parser->get_text('/'.$entry);
                 $content{$entry}=$value;                  if ($entry eq 'uname') {
                       $user = $value;
                   } elsif ($entry eq 'udom') {
                       $user .= ':'.$value;
                       $content{'users'}{$user} = $usercount;
                   } elsif ($entry eq 'role' ||
                       $entry eq 'access' ||
                       $entry eq 'section' ||
                       $entry eq 'group') {
                       if ($role_id ne '') {
                           push(@{$content{'roles'}{$role_id}{$entry}},$value);
                       }
                   } elsif ($entry eq 'dom') {
                       push(@{$content{$entry}},$value);
                   } else {
                       $content{$entry}=$value;
                   }
               }
           } elsif ($token->[0] eq 'E') {
               if ($token->[1] eq 'user') {
                   $user = '';
                   $usercount ++;
               } elsif ($token->[1] eq 'roles') {
                   $role_id = '';
             }              }
         }          }
     }      }
Line 4846  sub get_marked_as_readonly_hash { Line 4902  sub get_marked_as_readonly_hash {
         if (ref($value) eq "ARRAY"){          if (ref($value) eq "ARRAY"){
             foreach my $stored_what (@{$value}) {              foreach my $stored_what (@{$value}) {
                 if (ref($stored_what) eq 'ARRAY') {                  if (ref($stored_what) eq 'ARRAY') {
                     if ($stored_what eq $what) {                      foreach my $lock_descriptor(@{$stored_what}) {
                         $readonly_files{$file_name} = 'locked';                          if ($lock_descriptor eq 'graded') {
                     } elsif (!defined($what)) {                              $readonly_files{$file_name} = 'graded';
                         $readonly_files{$file_name} = 'locked';                          } elsif ($lock_descriptor eq 'handback') {
                               $readonly_files{$file_name} = 'handback';
                           } else {
                               if (!exists($readonly_files{$file_name})) {
                                   $readonly_files{$file_name} = 'locked';
                               }
                           }
                     }                      }
                 }                  } 
             }              }
         }           } 
     }      }
Removed from v.1.749  
changed lines
  Added in v.1.755

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