expire-8601: new version fixes

[chiark-utils.git] / scripts / expire-iso8601.new

diff --git a/scripts/expire-iso8601.new b/scripts/expire-iso8601.new
index 6c8ffd947e5379523cd6bddb9d5b6977c1173ff4..552b25839cb5e90c591e7e1a10e4ec752be73ea0 100755 (executable)
--- a/scripts/expire-iso8601.new
+++ b/scripts/expire-iso8601.new
@@ -55,6 +55,7 @@ our $rm = 1;
 our $recurse = 1;
 our $unit = 86400;
 our $slop;
+our $debug = 0;
 our @intervals;
 
 sub badusage ($) {
@@ -98,25 +99,29 @@ sub precomp () {
   $_->{A} = ($newest_t - $_->{T}) / $unit foreach @files;
   $slop /= $unit;
 
-#  print DEBUG Dumper(\@files, \@intervals);
+  push @{$files[0]{U}}, "newest";
+
+  print DEBUG Dumper(scalar(@files), \@files, \@intervals) if $debug >= 2;
 }
 
 sub flag ($) {
   my ($int) = @_;
-  my $n = $int->{Number};
-  my $d = $int->{Interval};
+  my $n = $int->{N};
+  my $d = $int->{D};
+  my $dmax = $d + $slop;
   my $spec = $int->{Spec};
-  my $start_age = ($n+1) * $d;
+  my $start_age = ($n-1) * $d - $slop;
   my $i = 0;
 
-  print DEBUG "FLAG $spec\n";
+  print DEBUG "FLAG $spec sa=$start_age dmax=$dmax\n";
 
-  # find $i, the youngest which is at least $number x $interval
+  # find $i, the youngest which is at least $start_age
   for (;;) {
     print DEBUG "i #$i $files[$i]{A}\n";
-    last if $files[$i]{A} > $start_age;
+    last if $files[$i]{A} >= $start_age;
     if ($i == $#files) {
-      print STDERR "insufficient for $spec\n";
+      print STDERR "insufficiently old for $spec\n";
+      last;
     }
     $i++;
   }
@@ -124,17 +129,23 @@ sub flag ($) {
   for (;;) {
     push @{ $files[$i]{U} }, $spec;
 
-    # find $j, the closest to $i which is at least $d-slop younger
+    # find $j, the closest to $i, preferably no more than $dmax younger
     my $j = $i;
     for (;;) {
       $j--;
+      # at each point in this loop $j is the next candidate
       last if $j < 0;
-      last if $files[$j];
       my $dt = $files[$i]{A} - $files[$j]{A};
       print DEBUG "j #$j $files[$j]{A} dt=$dt\n";
-      last if $dt >= $d - $slop;
+      last if $dt > $dmax;
     }
     last if $j < 0;
+    $j++;
+    if ($j == $i) {
+      $j--;
+      print STDERR "insufficiently dense for $spec after $files[$j]{F}\n";
+    }
+    print DEBUG "i #$j\n";
 
     $i = $j;
   }
@@ -143,11 +154,13 @@ sub flag ($) {
 sub implement () {
   foreach (@files) {
     next unless @{$_->{U}};
-    print "keep $_->{F} for @{$_->{U}}\n";
+    printf "keep %s for %s - age %.1f\n",
+      $_->{F}, "@{$_->{U}}", $_->{A};
   }
   foreach (@files) {
     next if @{$_->{U}};
-    print "remove $_->{F}\n";
+    printf "remove %s - age %.1f\n",
+      $_->{F}, $_->{A};
     if ($rm) {
       my $r= system 'rm', ($recurse ? ('-r') : ()), "--", $_->{F};
       die "run rm: $!\n" unless defined($r) && $r >= 0;
@@ -165,7 +178,7 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
     while (m/^-./) {
       if (s/^-n/-/) { $rm=0; }
       elsif (s/-r/-/) { $recurse=1; }
-      elsif (s/-D/-/) { open DEBUG, ">&STDERR" or die $!; }
+      elsif (s/-D/-/) { $debug++; }
       elsif (s/-u(\d+)$//) { $unit=$1; }
       elsif (s/-s(\d+)$//) { $slop=$1; }
       else { badusage "unknown short option $_" }
@@ -180,11 +193,16 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
 
 badusage "too few arguments" unless @ARGV;
 
+if ($debug) {
+  open DEBUG, ">&STDERR" or die $!;
+  DEBUG->autoflush(1);
+}
+
 $slop //= $unit * 0.1;
 
 foreach (@ARGV) {
   m/^(\d+)x(\d+)$/ or badusage "bad <number>x<interval> $_";
-  push @intervals, { Spec => $&, N => $1, I => $2 };
+  push @intervals, { Spec => $&, N => $1, D => $2 };
 }
 
 scan();