[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Thu, 22 Jun 2006 14:30:16 -0000
albertel Thu Jun 22 10:30:16 2006 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
- adding an easy to use network error detector
- dump internally detect the error: 2 case and no longer returns it
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.754 loncom/lonnet/perl/lonnet.pm:1.755
--- loncom/lonnet/perl/lonnet.pm:1.754 Thu Jun 22 09:28:32 2006
+++ loncom/lonnet/perl/lonnet.pm Thu Jun 22 10:30:14 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.754 2006/06/22 13:28:32 albertel Exp $
+# $Id: lonnet.pm,v 1.755 2006/06/22 14:30:14 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -281,6 +281,18 @@
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
sub transfer_profile_to_env {
@@ -2922,23 +2934,25 @@
# -------------------------------------------------------------- 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