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

[raeburn]

raeburn		Sun Aug 27 17:49:50 2017 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - If resource is outdated, trigger a connection from resource's homeserver
    to flush the delayed queue.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1353 loncom/lonnet/perl/lonnet.pm:1.1354
--- loncom/lonnet/perl/lonnet.pm:1.1353	Sun Aug 27 13:48:52 2017
+++ loncom/lonnet/perl/lonnet.pm	Sun Aug 27 17:49:49 2017
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1353 2017/08/27 13:48:52 raeburn Exp $
+# $Id: lonnet.pm,v 1.1354 2017/08/27 17:49:49 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3171,9 +3171,15 @@
     }
 }
 
+
+# If the local copy of a replicated resource is outdated, trigger a  
+# connection from the homeserver to flush the delayed queue. If no update 
+# happens, remove local copies of outdated resource (and corresponding
+# metadata file).
+
 sub remove_stale_resfile {
     my ($url) = @_;
-    my $stale;
+    my $removed;
     if ($url=~m{^/res/($match_domain)/($match_username)/}) {
         my $audom = $1;
         my $auname = $2;
@@ -3194,12 +3200,32 @@
                             my $remmodtime = &HTTP::Date::str2time( $response->header('Last-modified') );
                             my $locmodtime = (stat($fname))[9];
                             if ($locmodtime < $remmodtime) {
-                                unlink($fname);
-                                if ($uri!~/\.meta$/) {
-                                    unlink($fname.'.meta');
+                                my $stale;
+                                my $answer = &reply('pong',$homeserver);
+                                if ($answer eq $homeserver.':'.$perlvar{'lonHostID'}) {
+                                    sleep(0.2);
+                                    $locmodtime = (stat($fname))[9];
+                                    if ($locmodtime < $remmodtime) {
+                                        my $posstransfer = $fname.'.in.transfer';
+                                        if ((-e $posstransfer) && ($remmodtime < (stat($posstransfer))[9])) {
+                                            $removed = 1;
+                                        } else {
+                                            $stale = 1;
+                                        }
+                                    } else {
+                                        $removed = 1;
+                                    }
+                                } else {
+                                    $stale = 1;
+                                }
+                                if ($stale) {
+                                    unlink($fname);
+                                    if ($uri!~/\.meta$/) {
+                                        unlink($fname.'.meta');
+                                    }
+                                    &reply("unsub:$fname",$homeserver);
+                                    $removed = 1;
                                 }
-                                &reply("unsub:$fname",$homeserver);
-                                $stale = 1;
                             }
                         }
                     }
@@ -3207,7 +3233,7 @@
             }
         }
     }
-    return $stale;
+    return $removed;
 }
 
 # -------------------------------- Allow a /uploaded/ URI to be vouched for