#!/usr/bin/perl -w

=head1 NAME
    
    cleanup-repos

=head1 SYNOPSIS

    cleanup-repos --subminor-cnt=3 /opt/repos/debian/debs/

=head1 DESCRIPTION

    Самодельная очистка самодельных репозиториев от старых версий
    Один обязательный параметр - директория с репозиторием.

    опции:
      prefix - префикс рассматриваемых пакетов
      max-age - максимальный возраст в днях, всё что старше удаляем
      major-cnt - количество оставляемых мажорных версий
      minor-cnt - количество оставляемых минорных версий
      subminor-cnt - количество оставляемых "субминорных" версий
      dry-run - не удалять файлы, просто выводить на печать их имена
      help - вывод справки

    Примечание: мажорная/минорная/субминорная версия - это первые три числа из версии.
    1.26.125~dirty-IPREG-new-1 -> (1, 26, 125)

=cut

use strict;

use Getopt::Long;

my $MAJOR_CNT = 0;
my $MINOR_CNT = 0;
my $SUBMINOR_CNT = 0;
my $PREFIX = '';
my $DRY_RUN = 0;
my $MAX_AGE = 0;

GetOptions(
    "major-cnt=i" => \$MAJOR_CNT,
    "minor-cnt=i" => \$MINOR_CNT,
    "subminor-cnt=i" => \$SUBMINOR_CNT,
    "max-age=i" => \$MAX_AGE,
    "prefix=s" => \$PREFIX,
    "dry-run" => \$DRY_RUN,
    "help" => \&usage,
) || die "Invalid arguments: $!";

my ($dir) = @ARGV;

if (@ARGV != 1 || !-d $ARGV[0]) {
   usage(1);
   exit 1;
}

opendir(my $dh, $dir) || die "Can't opendir $dir: $!";
my %PACKAGES;
while(my $file = readdir($dh)) {
    my $fullname = "$dir/$file";
    next if !-f $fullname;
    next if $PREFIX && $file !~ /^\Q$PREFIX\E/;
    if ($file !~ /^([a-z0-9\-]+)_([^_]+)_.*\.deb$/) {
        print "strange file $file\n" if $DRY_RUN;
        next;
    }
    my ($package_name, $version) = ($1, $2);
    if ($MAX_AGE && time - (stat $fullname)[9] > $MAX_AGE*24*60*60) {
        my_rm($fullname);
        next;
    }
    my ($major, $minor, $subminor) = split /\D+/, $version;
    $PACKAGES{$package_name}{$major||0}{$minor||0}{$subminor||0} = $fullname;
}
closedir($dh) || die "Can't closedir: $!";

# для каждого типа версии отсчитываем соответствующее число пакетов, которые оставляем,
# всё что старше - удаляем
while(my ($package_name, $majors) = each %PACKAGES) {
    my $major_cnt = 0;
    for my $major_version (sort {$b <=> $a} keys %$majors) {
        $major_cnt++;
        my $minor_cnt = 0;
        my $minors = $majors->{$major_version};
        for my $minor_version (sort {$b <=> $a} keys %$minors) {
            $minor_cnt++;
            my $subminor_cnt = 0;
            my $subminors = $minors->{$minor_version};
            for my $subminor_version (sort {$b <=> $a} keys %$subminors) {
                $subminor_cnt++;
                if ($MAJOR_CNT && $major_cnt > $MAJOR_CNT
                    || $MINOR_CNT && $minor_cnt > $MINOR_CNT
                    || $SUBMINOR_CNT && $subminor_cnt > $SUBMINOR_CNT
                ) {
                    my_rm($subminors->{$subminor_version});
                } elsif ($DRY_RUN) {
                    print "keep $subminors->{$subminor_version}\n";
                }
            }
        }
    }
}

sub my_rm {
    my $fullname = shift;
    if ($DRY_RUN) {
        print "rm $fullname\n";
    } else {
        unlink($fullname) || die "Can't unlink $fullname: $!";
    }
}

sub usage {
    my $exit_code = shift;
    system("podselect -section NAME -section SYNOPSIS -section DESCRIPTION $0 | pod2text-utf8 >&2");
    exit($exit_code);
}

