[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[albertel]

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