--- loncom/lonnet/perl/lonnet.pm 2006/06/19 21:01:01 1.750 +++ 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.750 2006/06/19 21:01:01 banghart 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,25 +4706,6 @@ sub get_access_controls { 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 { my ($file_name,$changes,$domain,$user)=@_; my ($outcome,$deloutcome); @@ -4923,7 +4917,7 @@ sub dirlist { if(defined($alternateDirectoryRoot)) { $dirRoot = $alternateDirectoryRoot; $dirRoot =~ s/\/$//; - }Clay Greene + } if($udom) { if($uname) {