You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
107 lines
2.4 KiB
107 lines
2.4 KiB
#!/usr/bin/perl
|
|
# Given a list of daily builds on stdin, output a list of builds to remove,
|
|
# so that the total number of builds is no more than the number passed to
|
|
# the program.
|
|
#
|
|
# Attempts to remove builds that are least likely to be interesting and
|
|
# retain both a useful set of current builds as well as a useful sampling
|
|
# of past builds.
|
|
|
|
use POSIX q(mktime);
|
|
|
|
my $num_wanted=shift;
|
|
|
|
# Number of recent builds we'd perfer to keep. A week's worth seems
|
|
# reasonable unless num_wanted is very small.
|
|
my $end_span = ($num_wanted < 14) ? ($num_wanted / 2) : 7;
|
|
|
|
# We used to use form YYYY-MM-DD, now we use YYYYMMDD-HH:MM
|
|
my $br=qr#(?:.*/)?([0-9]+)-?([0-9]+)-?([0-9]+-?([0-9]*):?([0-9]*))$#;
|
|
|
|
# Make sure a build directory parses.
|
|
sub parse_build {
|
|
my $build=shift;
|
|
$build=~/$br/;
|
|
}
|
|
|
|
# Given the name of a build directory, return the date it was built as a
|
|
# unix time value.
|
|
sub build_date {
|
|
my $build=shift;
|
|
|
|
my ($y, $m, $d, $h, $m)=$build=~/$br/;
|
|
|
|
$h=0 unless defined $h;
|
|
$m=0 unless defined $m;
|
|
|
|
return mktime(0, $m, $h, $d, $m - 1, $y - 1900);
|
|
}
|
|
|
|
# Given two builds, calculate the distance between them in days.
|
|
sub distance {
|
|
my $a=shift;
|
|
my $b=shift;
|
|
|
|
if ($a eq undef || $b eq undef) {
|
|
return 0; # end
|
|
}
|
|
|
|
return abs(build_date($a) - build_date($b)) / (60 * 60 * 24);
|
|
}
|
|
|
|
# Takes a list of builds and returns a list of numbers indicating the
|
|
# relative interest of each of the builds.
|
|
sub calc_interest {
|
|
my @list=@_;
|
|
|
|
my @i;
|
|
my $most_interesting=0;
|
|
for (my $x=0; $x < @list; $x++) {
|
|
# Larger distances between a build and the builds on each
|
|
# side are more interesting.
|
|
$i[$x]=distance($list[$x], $list[$x-1]) +
|
|
distance($list[$x+1], $list[$x]);
|
|
|
|
# Newer builds are more interesting than older.
|
|
$i[$x]+=$x;
|
|
|
|
if ($i[$x] > $most_interesting) {
|
|
$most_interesting=$i[$x];
|
|
}
|
|
}
|
|
|
|
# Beginning and several at the end are always most interesting.
|
|
for (1..$end_span) {
|
|
$i[-1 * $_] = $most_interesting + 1;
|
|
}
|
|
$i[0]=$i[-1]=$most_interesting + 2;
|
|
|
|
return @i;
|
|
}
|
|
|
|
# Main program.
|
|
my @b;
|
|
while (<>) {
|
|
chomp;
|
|
if (! parse_build($_)) {
|
|
print STDERR "ignoring unparsable item: $_\n";
|
|
}
|
|
else {
|
|
push @b, $_;
|
|
}
|
|
}
|
|
|
|
while (@b > $num_wanted) {
|
|
my @int=calc_interest(@b);
|
|
my $least_int=0;
|
|
for (my $x=0; $x < @b; $x++) {
|
|
if ($int[$least_int] > $int[$x]) {
|
|
$least_int=$x;
|
|
}
|
|
}
|
|
|
|
print "$b[$least_int]\n";
|
|
splice @b, $least_int, 1;
|
|
}
|
|
|
|
print STDERR "kept: @b\n";
|
|
|