debian-installer/build/util/trim-daily-builds

#!/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";