RE: PAR + tmpwatch = mess

diff -u -r /home/eedmja/subversion/par/trunk/lib/PAR/Heavy.pm lib/PAR/Heavy.pm
--- /home/eedmja/subversion/par/trunk/lib/PAR/Heavy.pm	2015-06-26 18:00:44.134089289 +0200
+++ lib/PAR/Heavy.pm	2015-07-01 15:32:28.263406000 +0200
@@ -1,5 +1,5 @@
 package PAR::Heavy;
-$PAR::Heavy::VERSION = '0.12';
+$PAR::Heavy::VERSION = '0.12_001';
 
 =head1 NAME
 
@@ -159,6 +159,8 @@
         $member->extractToFileHandle($fh);
         close $fh;
         chmod 0750, $filename;
+	my $cur_time = time();
+	utime($cur_time, $cur_time, $filename);
     }
 
     return $filename;
diff -u -r /home/eedmja/subversion/par/trunk/lib/PAR.pm lib/PAR.pm
--- /home/eedmja/subversion/par/trunk/lib/PAR.pm	2015-06-26 18:00:44.154089460 +0200
+++ lib/PAR.pm	2015-07-01 17:43:37.103558000 +0200
@@ -1,5 +1,5 @@
 package PAR;
-$PAR::VERSION = '1.010';
+$PAR::VERSION = '1.009_001';
 
 use 5.006;
 use strict;
@@ -16,6 +16,7 @@
         prefork->import($_) for qw/
             Archive::Zip
             File::Glob
+            File::Find
             File::Spec
             File::Temp
             LWP::Simple
@@ -258,6 +259,23 @@
 that causes trouble, you can turn this off by setting the
 environment variable C<PAR_VERBATIM> to C<1>.
 
+Since version 1.010, PAR employs an internal canary file inside the file cache
+as a countermeasure against deterioration caused by tmpwatch or similar
+cleanup helpers.
+Long-term PAR based server processes may call PAR::refresh_file_cache()
+at least once a day to prevent tmpwatch based problems.
+The default canary file assumption is that tmpwatch runs on a daily basis,
+and cleans up files in the temporary space which are older than 7 days.
+In case the canary file is older than $PAR::MaxSecondsInTemp, a file cache
+refresh is performed, unless the value is set to 0.
+Adjustments to the canary file handling can be done with the following code
+(the values below are the default ones):
+
+  use PAR;
+  $PAR::MaxSecondsInTemp = 601200; # auto-refresh after 7 days minus 1 hour
+  $PAR::CanaryMtimeDiff  = 90000;  # canary file is 25 hours older
+  PAR::refresh_file_cache(1);      # run a check with the adjusted values
+
 =head2 import options
 
 When you "use PAR {...}" or call PAR->import({...}), the following
@@ -323,6 +341,18 @@
                                     # Layout:
                                     # $FileCache{$ZipObj}{$FileName} = $Member
 use vars qw(%ArchivesExtracted);    # Associates archive-zip-object => full extraction path
+use vars qw($ImportTime);           # Epoch when import() or refresh_file_cache() was called last time
+use vars qw($CanaryFileName);       # Canary File name
+use vars qw($CanaryMtimeDiff);      # Canary File creation mtime difference
+use vars qw($MaxSecondsInTemp);     # Canary File maximum age for auto refresh
+
+# The default canary file assumption is that tmpwatch cleans up files in /tmp which are older than 7 days,
+# and runs once a day.
+# In case the canary file is older than $MaxSecondsInTemp, a file cache refresh is performed,
+# unless the value is set to 0.
+my $default_canary_file_name    = '.canary_file';
+my $default_canary_mtime_diff   =  90000; # 25 hours, to handle even time shifts
+my $default_max_seconds_in_temp = 601200; # 7 days minus 1 hour, to prevent race conditions
 
 my $ver  = $Config{version};
 my $arch = $Config{archname};
@@ -339,6 +369,10 @@
 # called on "use PAR"
 sub import {
     my $class = shift;
+    $ImportTime = time();
+    $CanaryFileName         = $default_canary_file_name if ( ! defined $CanaryFileName || $CanaryFileName eq '' );
+    $CanaryMtimeDiff = $default_canary_mtime_diff if ( ! defined $CanaryMtimeDiff );
+    $MaxSecondsInTemp       = $default_max_seconds_in_temp if ( ! defined $MaxSecondsInTemp );
 
     PAR::SetupProgname::set_progname();
     PAR::SetupTemp::set_par_temp_env();
@@ -604,6 +638,7 @@
         print $fh "#line 1 \"$file\"\n";
         $member->extractToFileHandle($fh);
         seek ($fh, 0, 0);
+        utime($ImportTime, $ImportTime, $filename);
     }
 
     $ENV{PAR_0} = $filename; # for Pod::Usage
@@ -628,6 +663,7 @@
         print $fh "#line 1 \"$file\"\n";
         $member->extractToFileHandle($fh);
         seek ($fh, 0, 0);
+        utime($ImportTime, $ImportTime, $filename);
     }
 
     unshift @INC, sub { shift @INC; return $fh };
@@ -678,10 +714,11 @@
     my $dlext = defined($Config{dlext}) ? $Config::Config{dlext} : '';
     my $inc_exists = -d $inc;
     my $is_handle = ref($file_or_azip_handle) && $file_or_azip_handle->isa('Archive::Zip::Archive');
+    my $canary_file_existed = refresh_file_cache(1); # best case: only check the canary file
 
     require File::Spec;
 
-    if (!$inc_exists or $force_extract) {
+    if (!$inc_exists or ! $canary_file_existed or $force_extract) {
         for (1 .. 10) { mkdir("$inc.lock", 0755) and last; sleep 1 }
         
         undef $@;
@@ -725,6 +762,7 @@
               my $outfile =  File::Spec->catfile($inc, $_);
               next if -e $outfile and not -w _;
               $zip->extractMember($_, $outfile);
+              utime($ImportTime, $ImportTime, $outfile);
           }
         }
         
@@ -893,6 +931,45 @@
     return;
 }
 
+sub refresh_file_cache {
+    my $only_check_canary_file = shift @_ || 0;
+    $ImportTime = time();
+    my $canary_file_existed = 1;
+    my $auto_refresh        = 0;
+
+    my $canary_file = File::Spec->catfile($PAR::SetupTemp::PARTemp, $CanaryFileName);
+    if ( -f $canary_file ) {
+        my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
+             $atime, $mtime, $ctime, $blksize, $blocks )
+                = stat(_);
+        $auto_refresh++ if ( $MaxSecondsInTemp > 0 && $mtime < $ImportTime - $MaxSecondsInTemp );
+    }
+    else {
+        $canary_file_existed = 0;
+        open my $fh, '>', $canary_file;
+        binmode($fh);
+        print $fh "$ImportTime\n";
+        close($fh);
+    }
+
+    if ( ! $only_check_canary_file || ! $canary_file_existed || $auto_refresh ) {
+        utime ($ImportTime - $CanaryMtimeDiff, $ImportTime - $CanaryMtimeDiff, $canary_file);
+
+        require File::Find;
+        File::Find::find(
+            {
+                wanted => sub {
+                    utime($ImportTime, $ImportTime, $File::Find::name)
+                        if ( $File::Find::name ne $canary_file );
+                },
+            },
+            $PAR::SetupTemp::PARTemp
+        );
+    }
+
+    return $canary_file_existed;
+}
+
 sub par_handle {
     my $par = pop;
     return $LibCache{$par};
@@ -901,7 +978,7 @@
 my %escapes;
 sub unpar {
     my ($par, $file, $member_only, $allow_other_ext) = @_;
-	return if not defined $par;
+    return if not defined $par;
     my $zip = $LibCache{$par};
     my @rv = $par;
 
@@ -1016,8 +1093,10 @@
                 my $dest_name =
                     File::Spec->catfile($ENV{PAR_TEMP}, $extract_name);
                 # but don't extract it if we've already got one
-                $member->extractToFileNamed($dest_name)
-                    unless(-e $dest_name);
+                unless(-e $dest_name) {
+                    $member->extractToFileNamed($dest_name);
+                    utime($ImportTime, $ImportTime, $dest_name);
+                }
             }
         }
 
@@ -1067,6 +1146,7 @@
     if ($is_new) {
         $member->extractToFileHandle($fh);
         seek ($fh, 0, 0);
+        utime($ImportTime, $ImportTime, $LastTempFile);
     }
 
     return $fh;