expire-8601: wip new version, sort of works, need adj

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

diff --git a/scripts/expire-iso8601.new b/scripts/expire-iso8601.new
index 25a4cd79d8e4da6ac68388aeefd8a0117a7e2efc..169961a75d6a3cc1137ffd4caa030499d7db0274 100755 (executable)
--- a/scripts/expire-iso8601.new
+++ b/scripts/expire-iso8601.new
@@ -44,28 +44,46 @@ exit status:
    16                  catastrophic failure
 END
 
+use POSIX;
 use Carp;
-use DateTime::Format::ISO8601;
+use Data::Dumper;
+use Date::Parse;
+use DateTime::Format::Strptime;
 
 our @files;
 our $rm = 1;
 our $recurse = 1;
 our $unit = 86400;
 our $slop;
+our $debug;
 our @intervals;
 
-sub scan () {
-  my $parser = DateTime::Format::ISO8601->new;
+sub badusage ($) {
+  print STDERR "bad usage: $_[0]\n$usage" or die $!;
+  exit 8;
+}
 
+sub scan () {
+#  my $strp = DateTime::Format::Strptime->new();
   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) {
       print STDERR "ignoring $f\n";
     }
-    my $t = $parser->parse_time($f) // confess;
-    my $t = $t->epoch() // confess;
-    push @files, { F => $f, T => $t, U => [] ];
+    my @t = Date::Parse::strptime($f);
+    @t = map { $_ // 0 } @t;
+    my $t = mktime @t;
+#    m
+#    my $t = $strp->parse_datetime($f);
+#    $t = $t->epoch();
+#    my @t = Date::Parse::strptime($f);
+#print STDERR Dumper(\@t);
+#    my $t = mktime(@t);
+#    $!=0; $?=0; my $t = `date -d '$&' +%s`;
+#    die "date(!) failed on $&: $? $!" if $! || $?;
+#    chomp $t or confess;
+    push @files, { F => $f, T => $t, U => [] };
   }
 }
 
@@ -80,19 +98,25 @@ sub precomp () {
   my $newest_t = $files[0]{T};
   $_->{A} = ($newest_t - $_->{T}) / $unit foreach @files;
   $slop /= $unit;
+
+  print DEBUG Dumper(\@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 $dmin = $d - $slop;
   my $spec = $int->{Spec};
-  my $start_age = $int->{Number+1) * $interval;
+  my $start_age = ($n+1) * $d;
   my $i = 0;
 
+  print DEBUG "FLAG $spec sa=$start_age dmin=$dmin\n";
+
   # find $i, the youngest which is at least $number x $interval
   for (;;) {
-    last if $files[$i]{A} > $start_age;
+    print DEBUG "i #$i $files[$i]{A}\n";
+    last if $files[$i]{A} >= $start_age;
     if ($i == $#files) {
       print STDERR "insufficient for $spec\n";
     }
@@ -100,16 +124,16 @@ sub flag ($) {
   }
 
   for (;;) {
-    push $files[$i]{U}, $spec;
+    push @{ $files[$i]{U} }, $spec;
 
     # find $j, the closest to $i which is at least $d-slop younger
     my $j = $i;
     for (;;) {
       $j--;
       last if $j < 0;
-      last if $files[$j];
       my $dt = $files[$i]{A} - $files[$j]{A};
-      last if $dt >= $d - $slop;
+      print DEBUG "j #$j $files[$j]{A} dt=$dt\n";
+      last if $dt >= $dmin;
     }
     last if $j < 0;
 
@@ -124,15 +148,17 @@ sub implement () {
   }
   foreach (@files) {
     next if @{$_->{U}};
-    print "remove $_>{F}\n";
+    print "remove $_->{F}\n";
     if ($rm) {
       my $r= system 'rm', ($recurse ? ('-r') : ()), "--", $_->{F};
       die "run rm: $!\n" unless defined($r) && $r >= 0;
-      exit 16 if $r;
+      exit 12 if $r;
     }
   }
 }
 
+open DEBUG, ">/dev/null" or die $!;
+
 while (@ARGV && $ARGV[0] =~ m/^-/) {
   $_ = shift @ARGV;
   last if $_ eq '-' || $_ eq '--';
@@ -140,6 +166,7 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
     while (m/^-./) {
       if (s/^-n/-/) { $rm=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 $_" }
@@ -154,14 +181,19 @@ 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();
 precomp();
-foreach $int (@intervals) { flag $int }
+foreach (@intervals) { flag $_ }
 implement();