chiark / gitweb /
Bump version to 7.0.1~iwj0
[chiark-utils.git] / scripts / expire-iso8601
index 8d4838f98ff063bd83c9a2e5e5ba9110e96da755..62ba62d9cda969b3d45cefb0b2a3810192860d37 100755 (executable)
@@ -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;
@@ -52,8 +54,9 @@ use DateTime::Format::Strptime;
 
 $|=1;
 
+our @oldfiles;
 our @files;
-our $rm = 1;
+our $enable = 2;
 our $recurse = 1;
 our $unit = 86400;
 our $slop;
@@ -70,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;
@@ -156,8 +166,8 @@ sub flag ($) {
     $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";
 
@@ -183,7 +193,20 @@ sub flag ($) {
   }
 }
 
+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 (reverse sort @oldfiles) {
+    printf "remove %s - old\n", $_;
+    do_rm($_);
+  }
   foreach (reverse @files) {
     next unless @{$_->{U}};
     printf "keep %s for %s - age %.1f\n",
@@ -193,10 +216,10 @@ sub implement () {
     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);
     }
   }
 }
@@ -208,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;