chiark / gitweb /
expire-8601: wip new version, err on other side
[chiark-utils.git] / scripts / expire-iso8601.new
index f001b3564ec03cbb3fabd935dd2f20b030ffc5d8..b8a857efe6cc5db1d4b55f7688b5329095000a7e 100755 (executable)
@@ -55,6 +55,7 @@ our $rm = 1;
 our $recurse = 1;
 our $unit = 86400;
 our $slop;
+our $debug;
 our @intervals;
 
 sub badusage ($) {
@@ -98,19 +99,19 @@ sub precomp () {
   $_->{A} = ($newest_t - $_->{T}) / $unit foreach @files;
   $slop /= $unit;
 
-#  print DEBUG Dumper(\@files, \@intervals);
+  print DEBUG Dumper(\@files, \@intervals) if $debug >= 2;
 }
 
 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;
   my $i = 0;
 
-  print DEBUG "FLAG $spec sa=$start_age dmin=$dmin\n";
+  print DEBUG "FLAG $spec sa=$start_age dmax=$dmax\n";
 
   # find $i, the youngest which is at least $number x $interval
   for (;;) {
@@ -125,15 +126,14 @@ 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 which is no more than $dmax younger
     my $j = $i;
     for (;;) {
       $j--;
-      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 >= $dmin;
+      last if $j <= 0;
+      my $ndt = $files[$i]{A} - $files[$j-1]{A};
+      print DEBUG "j #$j $files[$j]{A} ndt=$ndt\n";
+      last if $ndt > $dmax;
     }
     last if $j < 0;
 
@@ -166,7 +166,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 $!; DEBUG->autoflush(1) }
+      elsif (s/-D/-/) { $debug++; }
       elsif (s/-u(\d+)$//) { $unit=$1; }
       elsif (s/-s(\d+)$//) { $slop=$1; }
       else { badusage "unknown short option $_" }
@@ -181,6 +181,11 @@ 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) {