#!/usr/bin/perl

# Copyright (C) 1999,2002 MandrakeSoft <pixel@linux-mandrake.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

#We only make good software ;-)
use strict;

#use strict qw(subs vars refs);
use rpmtools;
use urpm;

#- get I18N translation method.
import urpm _;

my ($auto, $matches, $maymatch, @l, @m, @toremove);
my $askok = _("Is it OK?");
my $askrm = _("Remove them all?");
# Translator: Add here the keys which might be pressed in the "No"-case.
my $noexpr = _("Nn");
# Translator: Add here the keys which might be pressed in the "Yes"-case.
my $yesexpr = _("Yy");

local $_ = ' ' . join(' ', @ARGV) . ' ';

if ( / --?h/ || @ARGV == 0 ) {
    print STDERR _("usage: urpme [-a] [--auto] <packages...>\n");
    exit(0);
}

$matches = / -a /;
$auto = / --?auto /;

@l = grep { !/^-/ } @ARGV;
if (!$matches) {
    @m = map { chop; $_ } `rpm -q @l 2>&1`;
    if ($?) {
	$maymatch = _("unknown package(s) ") . join(", ", map { /package (\S+) is not installed/ ? $1 : () } @m) . "\n";
	$auto || @l > 1 and die $maymatch;
    }
}
if ($matches || $maymatch) {
    my $match = join "|", map { quotemeta } @l;
    @m = grep { /$match/ } map { chop; $_ } `rpm -qa`;

    if ($maymatch) {
	@m or die $maymatch;
        my $msg = _("Using \"%s\" as a substring, I found", $match);
        print STDOUT "$msg:\n@m\n$askrm" . _(" (y/N) ");
        <STDIN> =~ /[$yesexpr]/ or exit 1;
    }
}

my %toremove; @toremove{@m} = ();
my $changed = 1;
while ($changed) {
    $changed = 0;
    local *F;
    open F, "LANGUAGE=C rpm -e --test " . join(" ", keys %toremove) . " 2>&1 |";
    foreach (<F>) {
    	if (/package (\S+) is not installed/) {
    	    delete $toremove{$1};
    	} elsif (/is needed by (\S+)/ && ! exists $toremove{$1}) {
    	    $toremove{$1} = 1;
    	    $changed = 1;
    	}
    }
}
if ( ! (@toremove = keys %toremove) ) {
    print _("Nothing to remove.\n");
    exit(0);
}

#- check if a package to be removed is a part of basesystem requires.
my %base;
my @base = qw(basesystem);
my %basepackages;
my $db = rpmtools::db_open('');
while (defined($_ = shift @base)) {
    exists $basepackages{$_} and next;
    rpmtools::db_traverse_tag($db, /^\// ? 'path' : 'whatprovides', [ $_ ], [ qw(name version release requires) ], sub {
				  my ($p) = @_;
				  push @{$basepackages{$_} ||= []}, "$p->{name}-$p->{version}-$p->{release}";
				  push @base, @{$p->{requires} || []};
			      });
}
rpmtools::db_close($db);
foreach (values %basepackages) {
    my $n = @$_;
    foreach (@$_) {
	$base{$_} = \$n;
    }
}
my $base_str = '';
foreach (@toremove) {
    my $rn = $base{$_};
    if ($rn) {
	$$rn == 1 and $base_str .= _("removing package %s will break your system\n", $_);
	--$$rn;
    }
}
$base_str and die $base_str;

if (@toremove > @l && !$auto) {
    my $sum = 0;
    map { $sum += $_ } `rpm -q --queryformat "%{SIZE}\n" @toremove`;
    my $msg = _("To satisfy dependencies, the following packages are going to be removed (%d MB)", toMb($sum));
    print STDOUT "$msg:\n@toremove\n$askok" . _(" (Y/n) ");
    <STDIN> =~ /[$noexpr]/ and exit 0;
}
system("rpm", "-e", @toremove);


sub toMb {
    my $nb = $_[0] / 1024 / 1024;
    int $nb + 0.5;
}