--- loncom/lonnet/perl/lonnet.pm 2006/06/22 13:16:09 1.753 +++ loncom/lonnet/perl/lonnet.pm 2006/06/22 15:34:16 1.757 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.753 2006/06/22 13:16:09 albertel Exp $ +# $Id: lonnet.pm,v 1.757 2006/06/22 15:34:16 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -281,6 +281,17 @@ sub critical { 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 sub transfer_profile_to_env { @@ -2922,23 +2933,25 @@ sub del { # -------------------------------------------------------------- dump interface sub dump { - my ($namespace,$udomain,$uname,$regexp,$range)=@_; - if (!$udomain) { $udomain=$env{'user.domain'}; } - if (!$uname) { $uname=$env{'user.name'}; } - my $uhome=&homeserver($uname,$udomain); - if ($regexp) { - $regexp=&escape($regexp); - } else { - $regexp='.'; - } - my $rep=reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); - my @pairs=split(/\&/,$rep); - my %returnhash=(); - foreach (@pairs) { - my ($key,$value)=split(/=/,$_,2); - $returnhash{unescape($key)}=&thaw_unescape($value); - } - return %returnhash; + my ($namespace,$udomain,$uname,$regexp,$range)=@_; + if (!$udomain) { $udomain=$env{'user.domain'}; } + if (!$uname) { $uname=$env{'user.name'}; } + my $uhome=&homeserver($uname,$udomain); + if ($regexp) { + $regexp=&escape($regexp); + } else { + $regexp='.'; + } + my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); + my @pairs=split(/\&/,$rep); + my %returnhash=(); + foreach my $item (@pairs) { + my ($key,$value)=split(/=/,$item,2); + $key = &unescape($key); + next if ($key =~ /^error: 2 /); + $returnhash{$key}=&thaw_unescape($value); + } + return %returnhash; } # --------------------------------------------------------- dumpstore interface @@ -4693,67 +4706,6 @@ sub get_access_controls { return %access; } -sub parse_access_controls { - my ($access_item) = @_; - my %content; - my $role_id; - my $user; - my $usercount; - 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'}; - 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 { - my $value=$parser->get_text('/'.$entry); - 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 = ''; - } - } - } - return %content; -} - sub modify_access_controls { my ($file_name,$changes,$domain,$user)=@_; my ($outcome,$deloutcome);