Strip Old Linux packages from debian-like systems

sol.pl

#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;

my ($kill_all, $one_line, $execute, $force);

Getopt::Long::Configure("bundling"); # make switches case sensitive (and turn on bundling)
GetOptions(
    "--kill-all|k" => \$kill_all,
    "--one-line|o" => \$one_line,
    "--execute|x"  => \$execute,
    "--force|f"    => \$force,
    "help|H"       => sub { pod2usage(-verbose=>1) },
    "h"            => sub { pod2usage() },
    "--all|a"      => sub { $kill_all = $one_line = $execute = $force = 1; }
) or pod2usage();

$ENV{COLUMNS} = $ENV{TERMCAP} = "";

my @pkg = slurp( qr{^(?:rc|ii).*linux-.*(?:image|modules|headers).*2\.[46]\.\d+.*2\.[46]\.\d+} => qw(dpkg -l linux-*) );
my $ver = slurp( qr(.) => qw(uname -r) );
my $avr = qr(2\.[46]\.\d+);
my $nqv = $ver;
   $nqv =~ s/-[a-z]*$//;

my $ver_ = qr($ver);
my $avr_ = qr($avr);

my (@agp, @dp);

for (@pkg) {
    my ($status, $package, $version) = split m/\s+/;

    next unless $package =~ $avr_ and $version =~ $avr_;
    next if $package =~ $ver_;
    next if $package =~ $avr_ and $package =~ m/headers/;

    if( $status eq "ii" ) {
        push @agp, $package if $package =~ m/(?:image|headers)/ or $kill_all;

    } else {
        push @dp, $package;
    }
}

my @cmds;
if( $one_line ) {
    push @cmds, [ qw(apt-get purge), @agp ];
    push @cmds, [ qw(dpkg --purge),  @dp ];

} else {
    push @cmds, map([qw(apt-get purge), $_], @agp);
    push @cmds, map([qw(dpkg --purge),  $_], @dp);
}

exit unless @cmds;

if( $execute ) {
    for(@cmds) {
        my $res = system(@$_);
        exit 1 if $res and not $force;
    }

} else {
    print "# current version $ver / $nqv\n";
    print "@$_\n" for @cmds;
}

sub slurp {
    my $r = shift;
    open my $in, "-|", @_ or die "problem grabbing output from @_: $!";
    my @a = grep { $_ =~ $r } <$in>;
    chomp @a;
    return @a if wantarray;
    return $a[0];
}

__END__

=head1 NAME

sol.pl - Strip Old Linux packages from debian-like systems

=head1 SYNOPSIS

    sol.pl
       --kill-all -k
       --one-line -o
       --exeucte  -x
       --force    -f
       --all      -a
       --help     -H
       -h

=head1 OPTIONS

=over 

=item B<--kill-all> B<-k>

By default sol tries to skip apt-get purges of module packages because apt-get
will automatically remove those anyway -- the modules depend on the kernel
image.

=item B<--one-line> B<-o>

By default sol issues one command per package instead of combining them all up.

=item B<--execute> B<-x>

By default sol doesn't actually issue the commands, it prints them for pumping through a shell.  This makes it execute them.

=item B<--force> B<-f>

By default, sol will quit when it encounters an error with B<-x>.  This makes it continue on.

=item B<--all> B<-a>

Same as B<-k> B<-o> B<-x> B<-f> all at once.

=back