#!/usr/bin/perl # Copyright (C) 1999,2002 MandrakeSoft # # # 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 URPM; use URPM::Resolve; use urpm; my (@nextargv, $root, $test, $parallel, $auto, $matches, $verbose, $maymatch, @l); my $askok = N("Is this OK?"); # Translator: Add here the keys which might be pressed in the "No"-case. my $noexpr = N("Nn"); # Translator: Add here the keys which might be pressed in the "Yes"-case. my $yesexpr = N("Yy"); sub usage { print STDERR N("urpme version %s Copyright (C) 1999, 2000, 2001, 2002 MandrakeSoft. This is free software and may be redistributed under the terms of the GNU GPL. usage: ", $urpm::VERSION) . N(" --help - print this help message. ") . N(" --auto - automatically select a package in choices. ") . N(" --test - verify if the installation can be achieved correctly. ") . N(" --parallel - distributed urpmi accross machines of alias. ") . N(" -v - verbose mode. ") . N(" -a - select all packages matching expression. "); exit(0); } @ARGV or usage; while (defined($_ = shift @ARGV)) { /^--help$/ and do { usage; next }; /^--no-locales$/ and do { undef *N; undef *urpm::N; *N = *urpm::N = sub { sprintf(shift @_, @_) }; next }; /^--?auto$/ and do { $auto = 1; next }; /^--(no-)?test$/ and do { $test = !$1; next }; /^--root$/ and do { push @nextargv, \$root; next }; /^--parallel$/ and do { push @nextargv, \$parallel; next }; /^-(.*)$/ and do { foreach (split //, $1) { /[\?h]/ and do { usage; next }; /a/ and do { $matches = 1; next }; /v/ and do { $verbose = 1; next }; die N("urpme: unknown option \"-%s\", check usage with --help\n", $1); } next }; @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next }; push @l, $_; } my $urpm = new urpm; my $state = {}; #- remove verbose if not asked. $verbose or $urpm->{log} = sub {}; #- just configure parallel mode if available. $parallel and $urpm->configure(synthesis => 'none', root => $root, parallel => $parallel, ); #- examine packages... my @toremove = $urpm->find_packages_to_remove($state, \@l, test => $test, matches => $matches, auto => $auto, callback_notfound => sub { my $urpm = shift @_; $urpm->{fatal}(1, (@_ > 1 ? N("unknown packages") : N("unknown package")) . ': ' . join(', ', @_)); 0 }, callback_fuzzy => sub { my $urpm = shift @_; my $match = shift @_; $urpm->{fatal}(1, N("The following packages contain %s: %s", $match, join(' ', @_))); 0 }, callback_base => sub { my $urpm = shift @_; foreach (@_) { $urpm->{error}(N("removing package %s will break your system", $_)); } 0 }, ) or $urpm->{fatal}(0, N("Nothing to remove")); if ($test && $auto) { my $msg = N("Checking to remove the following packages"); print STDOUT "$msg:\n" . join("\n", sort { $a cmp $b } @toremove) . "\n"; } elsif (@toremove > @l && !$auto) { my $sum = 0; foreach (@toremove) { $sum += $state->{rejected}{$_}{size}; } my $msg = N("To satisfy dependencies, the following packages are going to be removed (%d MB)", toMb($sum)); print STDOUT "$msg:\n" . join("\n", sort { $a cmp $b } @toremove) . "\n$askok" . N(" (Y/n) "); =~ /[$noexpr]/ and exit 0; } print STDOUT "\n".N("removing %s", join(' ', @toremove))."\n"; @l = $parallel ? $urpm->parallel_remove(\@toremove, test => $test, translate_message => 1) : $urpm->install(\@toremove, {}, {}, test => $test, translate_message => 1); @l and $urpm->{fatal}(2, N("Removing failed") . ":\n" . join("\n", map { "\t$_" } @l)); sub toMb { my $nb = $_[0] / 1024 / 1024; int $nb + 0.5; }