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