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)
+ --help
example:
/home/ian/junk/expire-iso8601 14x1 4x7
uses units of 86400s (1 day) with a slop of 8640
0 ok
4 rm failed
8 bad usage
- 16 catastrophic failure
+ -1 catastrophic failure
END
use POSIX;
use Date::Parse;
use DateTime::Format::Strptime;
+$|=1;
+
+our @oldfiles;
our @files;
our $rm = 1;
our $recurse = 1;
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";
}
-# my @t = Date::Parse::strptime($f);
-# @t = map { $_ // 0 } @t;
-# my $t = mktime @t;
+
+ if ($1) {
+ push @oldfiles, $f;
+ next;
+ }
+
+ 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;
+# $!=0; $?=0; my $t = `date -d '$&' +%s`;
+# die "date(!) failed on $&: $? $!" if $! || $?;
+# chomp $t or confess;
push @files, { F => $f, T => $t, U => [] };
}
}
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;
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 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 ($rm) {
+ 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;
+ my $tmp = "$_->{F}.rm";
+ rename $_->{F}, $tmp or die "rename $_->{F} to $tmp: $!\n";
+ do_rm($tmp);
}
}
}