Bump version to 7.0.1~iwj0

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

diff --git a/scripts/expire-iso8601 b/scripts/expire-iso8601
index 552b25839cb5e90c591e7e1a10e4ec752be73ea0..62ba62d9cda969b3d45cefb0b2a3810192860d37 100755 (executable)
--- a/scripts/expire-iso8601
+++ b/scripts/expire-iso8601
@@ -24,10 +24,12 @@ usage:
 options:
    -u<unitlen>  <interval> is measured in units of <unitlen> seconds
                    (default is 86400, so <interval> is in days)
-   -s<slop>     allow kept items to be <slop> seconds shorter apart than
-                   specified; default is 10% of <unitlen>
-   -n           do not really delete
-   -r           recursive removal (rm -r)
+   -s<slop>       allow kept items to be <slop> seconds shorter or
+                   longer apart than specified; default is 0.1 unit
+   -n             do not really delete
+   -r             recursive removal (rm -r)
+   --rename-only  rename to *.rm, but do not delete
+   --help
 example:
    /home/ian/junk/expire-iso8601 14x1 4x7
       uses units of 86400s (1 day) with a slop of 8640
@@ -41,7 +43,7 @@ exit status:
    0                   ok
    4                   rm failed
    8                   bad usage
-   16                  catastrophic failure
+  -1                   catastrophic failure
 END
 
 use POSIX;
@@ -50,8 +52,11 @@ use Data::Dumper;
 use Date::Parse;
 use DateTime::Format::Strptime;
 
+$|=1;
+
+our @oldfiles;
 our @files;
-our $rm = 1;
+our $enable = 2;
 our $recurse = 1;
 our $unit = 86400;
 our $slop;
@@ -68,9 +73,16 @@ sub scan () {
   foreach my $f (<[0-9]*>) {
     if ($f  !~ m/^ \d\d\d\d - \d\d - \d\d 
                 (?: T \d\d \: \d\d (?: \: \d\d )?
-                  (?: [-+] \d{1,2} \:? \d\d )? )? /x) {
+                  (?: [-+] \d{1,2} \:? \d\d )? )? 
+                ( \.rm )? $/x) {
       print STDERR "ignoring $f\n";
     }
+
+    if ($1) {
+      push @oldfiles, $f;
+      next;
+    }
+
     my @t = Date::Parse::strptime($f);
     @t = map { $_ // 0 } @t;
     my $t = mktime @t;
@@ -108,26 +120,38 @@ sub flag ($) {
   my ($int) = @_;
   my $n = $int->{N};
   my $d = $int->{D};
+  my $dmin = $d - $slop;
   my $dmax = $d + $slop;
   my $spec = $int->{Spec};
   my $start_age = ($n-1) * $d - $slop;
   my $i = 0;
+  my $insufficiently_old = 0;
 
-  print DEBUG "FLAG $spec sa=$start_age dmax=$dmax\n";
+  print DEBUG "FLAG $spec sa=$start_age dmin=$dmin dmax=$dmax\n";
 
   # 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;
     if ($i == $#files) {
+      $insufficiently_old = 1;
       print STDERR "insufficiently old for $spec\n";
       last;
     }
     $i++;
   }
 
-  for (;;) {
+  my $oldest = $i;
+  my $count = 0;
+
+  my $use = sub {
+    my ($i, $spec) = @_;
     push @{ $files[$i]{U} }, $spec;
+    $count++;
+  };
+
+  for (;;) {
+    $use->($i, $spec);
 
     # find $j, the closest to $i, preferably no more than $dmax younger
     my $j = $i;
@@ -139,32 +163,63 @@ sub flag ($) {
       print DEBUG "j #$j $files[$j]{A} dt=$dt\n";
       last if $dt > $dmax;
     }
-    last if $j < 0;
     $j++;
     if ($j == $i) {
       $j--;
-      print STDERR "insufficiently dense for $spec after $files[$j]{F}\n";
+      last if $j < 0;
+      print STDERR "insufficiently dense for $spec before $files[$j]{F}\n";
     }
     print DEBUG "i #$j\n";
 
     $i = $j;
   }
+
+  $i = $oldest;
+  while ($count < $n) {
+    for (;;) {
+      $i++;
+      if ($i > $#files) {
+       if (!$insufficiently_old) {
+         print STDERR
+           "insufficiently old for $spec (density compensation)\n";
+       }
+       return;
+      }
+      my $dt = $files[$i]{A} - $files[$oldest]{A};
+      print DEBUG "o #$i $files[$i]{A} dt=$dt\n";
+      last if $dt >= $dmin;
+    }
+    $use->($i, "$spec+");
+  }
+}
+
+sub do_rm ($) {
+  my ($fn) = @_;
+  if ($enable >= 2) {
+    my $r= system 'rm', ($recurse ? ('-r') : ()), "--", $fn;
+    die "run rm: $!\n" unless defined($r) && $r >= 0;
+    exit 4 if $r;
+  }
 }
 
 sub implement () {
-  foreach (@files) {
+  foreach (reverse sort @oldfiles) {
+    printf "remove %s - old\n", $_;
+    do_rm($_);
+  }
+  foreach (reverse @files) {
     next unless @{$_->{U}};
     printf "keep %s for %s - age %.1f\n",
       $_->{F}, "@{$_->{U}}", $_->{A};
   }
-  foreach (@files) {
+  foreach (reverse @files) {
     next if @{$_->{U}};
     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;
-      exit 12 if $r;
+    if ($enable >= 1) {
+      my $tmp = "$_->{F}.rm";
+      rename $_->{F}, $tmp or die "rename $_->{F} to $tmp: $!\n";
+      do_rm($tmp);
     }
   }
 }
@@ -176,13 +231,15 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
   last if $_ eq '-' || $_ eq '--';
   if (m/^-[^-]/) {
     while (m/^-./) {
-      if (s/^-n/-/) { $rm=0; }
+      if (s/^-n/-/) { $enable=0; }
       elsif (s/-r/-/) { $recurse=1; }
       elsif (s/-D/-/) { $debug++; }
       elsif (s/-u(\d+)$//) { $unit=$1; }
       elsif (s/-s(\d+)$//) { $slop=$1; }
       else { badusage "unknown short option $_" }
     }
+  } elsif (m/^--rename-only$/) {
+    $enable=1;
   } elsif (m/^--help$/) {
     print $usage or die $!;
     exit 0;