#!/usr/bin/perl -w
#
# Copyright 2006 Ian Jackson <ijackson@chiark.greenend.org.uk>
#
# This script and its documentation (if any) are free software; you
# can redistribute it and/or modify them under the terms of the GNU
# General Public License as published by the Free Software Foundation;
# either version 3, or (at your option) any later version.
# 
# chiark-named-conf and its manpage are distributed in the hope that
# it will be useful, but WITHOUT ANY WARRANTY; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.  See the GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with this program; if not, consult the Free Software Foundation's
# website at www.fsf.org, or the GNU Project website at www.gnu.org.

use strict;

our $usage = <<'END';
usage:
  expire-iso8601 [<options>] <number>x<interval> [<number>x<interval> ...]
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)
example:
   /home/ian/junk/expire-iso8601 14x1 4x7
      uses units of 86400s (1 day) with a slop of 8640
      it keeps 14 daily items
       (that is 14 items, dated no less than 86400-8640 apart)
      and 4 weekly items
       (that is 4 items, dated no less than 7*86400-8640 apart)
      the 14 daily and 7 weekly items may be the same, or not
   There is no need to sort the list of <number>x<interval> pairs.
exit status:
   0                   ok
   4                   rm failed
   8                   bad usage
   16                  catastrophic failure
END

use Carp;
use DateTime::Format::RFC3339;

our @files;
our $rm = 1;
our $recurse = 1;
our $unit = 86400;
our $slop;
our @intervals;

sub badusage ($) {
  print STDERR "bad usage: $_[0]\n$usage" or die $!;
  exit 8;
}

sub scan () {
  my $parser = DateTime::Format::RFC3339->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";
    }
    $!=0; $?=0; my $t = `date -d '$&' +%s`;
    die "date(!) failed on $&: $? $!" if $! || $?;
    chomp $t or confess;
    push @files, { F => $f, T => $t, U => [] };
  }
}

sub precomp () {
  if (!@files) {
    print STDERR "none at all yet!\n";
    exit 0;
  }

  # newest first, which means biggest T
  @files = sort { $b->{T} <=> $a->{T} || $b->{F} cmp $a->{F} } @files;
  my $newest_t = $files[0]{T};
  $_->{A} = ($newest_t - $_->{T}) / $unit foreach @files;
  $slop /= $unit;
}

sub flag ($) {
  my ($int) = @_;
  my $n = $int->{Number};
  my $d = $int->{Interval};
  my $spec = $int->{Spec};
  my $start_age = ($n+1) * $d;
  my $i = 0;

  # find $i, the youngest which is at least $number x $interval
  for (;;) {
    last if $files[$i]{A} > $start_age;
    if ($i == $#files) {
      print STDERR "insufficient for $spec\n";
    }
    $i++;
  }

  for (;;) {
    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;
    }
    last if $j < 0;

    $i = $j;
  }
}

sub implement () {
  foreach (@files) {
    next unless @{$_->{U}};
    print "keep $_->{F} for @{$_->{U}}\n";
  }
  foreach (@files) {
    next if @{$_->{U}};
    print "remove $_->{F}\n";
    if ($rm) {
      my $r= system 'rm', ($recurse ? ('-r') : ()), "--", $_->{F};
      die "run rm: $!\n" unless defined($r) && $r >= 0;
      exit 12 if $r;
    }
  }
}

while (@ARGV && $ARGV[0] =~ m/^-/) {
  $_ = shift @ARGV;
  last if $_ eq '-' || $_ eq '--';
  if (m/^-[^-]/) {
    while (m/^-./) {
      if (s/^-n/-/) { $rm=0; }
      elsif (s/-r/-/) { $recurse=1; }
      elsif (s/-u(\d+)$//) { $unit=$1; }
      elsif (s/-s(\d+)$//) { $slop=$1; }
      else { badusage "unknown short option $_" }
    }
  } elsif (m/^--help$/) {
    print $usage or die $!;
    exit 0;
  } else {
    badusage "unknown long option $_"
  }
}

badusage "too few arguments" unless @ARGV;

$slop //= $unit * 0.1;

foreach (@ARGV) {
  m/^(\d+)x(\d+)$/ or badusage "bad <number>x<interval> $_";
  push @intervals, { Spec => $&, N => $1, I => $2 };
}

scan();
precomp();
foreach (@intervals) { flag $_ }
implement();