4.2-1mdk

1 files changed, 54 insertions, 141 deletions

diff --git a/urpme b/urpme
index d8244f49..7c593a33 100644
--- a/urpme
+++ b/urpme
@@ -28,17 +28,14 @@ use urpm;
 #- get I18N translation method.
 import urpm _;
 
-my ($auto, $matches, $maymatch, @l, @m, %base);
+my (@nextargv, $root, $test, $parallel, $auto, $matches, $maymatch, @l);
 my $askok = _("Is this 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 ) {
+sub usage {
     print STDERR _("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.
@@ -46,144 +43,61 @@ This is free software and may be redistributed under the terms of the GNU GPL.
 usage:
 ", $urpm::VERSION) . _("  --help         - print this help message.
 ") . _("  --auto         - automatically select a package in choices.
+") . _("  --test         - verify if the installation can be achieved correctly.
+") . _("  --parallel     - distributed urpmi accross machines of alias.
 ") . _("  -a             - select all packages matching expression.
 ");
     exit(0);
 }
 
-$matches = / -a /;
-$auto = / --?auto /;
-
-$urpm = new urpm;
-$state = {};
-
-#- open database to examine packages...
-{
-    my $db = URPM::DB::open;
-
-    @l = grep { !/^-/ } @ARGV;
-    if (!$matches) {
-	foreach (@l) {
-	    my ($n, $found);
-
-	    #- check if name-version-release may have been given.
-	    if (($n) = /^(.*)-[^\-]*-[^\-]*\.[^\.\-]*$/) {
-		$db->traverse_tag('name', [ $n ], sub {
-				      my ($p) = @_;
-				      $p->fullname eq $_ or return;
-				      $urpm->resolve_closure_ask_remove($db, $state, $p);
-				      push @m, join('-', ($p->fullname)[0..2]);
-				      $found = 1;
-				  });
-		$found and next;
-	    }
-
-	    #- check if name-version-release may have been given.
-	    if (($n) = /^(.*)-[^\-]*-[^\-]*$/) {
-		$db->traverse_tag('name', [ $n ], sub {
-				      my ($p) = @_;
-				      join('-', ($p->fullname)[0..2]) eq $_ or return;
-				      $urpm->resolve_closure_ask_remove($db, $state, $p);
-				      push @m, join('-', ($p->fullname)[0..2]);
-				      $found = 1;
-				  });
-		$found and next;
-	    }
-
-	    #- check if name-version may have been given.
-	    if (($n) = /^(.*)-[^\-]*$/) {
-		$db->traverse_tag('name', [ $n ], sub {
-				      my ($p) = @_;
-				      join('-', ($p->fullname)[0..1]) eq $_ or return;
-				      $urpm->resolve_closure_ask_remove($db, $state, $p);
-				      push @m, join('-', ($p->fullname)[0..2]);
-				      $found = 1;
-				  });
-		$found and next;
-	    }
-
-	    #- check if only name may have been given.
-	    $db->traverse_tag('name', [ $_ ], sub {
-				  my ($p) = @_;
-				  $p->name eq $_ or return;
-				  $urpm->resolve_closure_ask_remove($db, $state, $p);
-				  push @m, join('-', ($p->fullname)[0..2]);
-				  $found = 1;
-			      });
-	    $found and next;
-
-	    #- nothing has been found for the given name.
-	    $maymatch .= ($maymatch && ", ") . $_;
-	}
-	if ($maymatch) {
-	    my $msg = $maymatch =~ /, / ? _("unknown packages ") : _("unknown package ");
-	    $msg =~ /\s$/ or $msg .= ' '; #- add trailing space to avoid fixing bad translator (too late now for 9.0).
-	    $maymatch = "$msg$maymatch\n";
-	}
-	$maymatch && ($auto || @l > 1) and die $maymatch;
-    }
-    if ($matches || $maymatch) {
-	my $match = join "|", map { quotemeta } @l;
-
-	#- reset what has been already found.
-	$state = {};
-	@m = ();
-
-	#- search for package that matches, and perform closure again.
-	$db->traverse(sub {
-			  my ($p) = @_;
-			  $p->fullname =~ /$match/ or return;
-			  $urpm->resolve_closure_ask_remove($db, $state, $p);
-			  push @m, join('-', ($p->fullname)[0..2]);
-		      });
-
-	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;
-	}
-    }
-
-    #- if nothing need to be removed.
-    unless (%{$state->{ask_remove} || {}}) {
-	print _("Nothing to remove.\n");
-	exit(0);
-    }
-
-    my @base = qw(basesystem);
-    my %basepackages;
-
-    #- check if a package to be removed is a part of basesystem requires.
-    while (defined($_ = shift @base)) {
-	exists $basepackages{$_} and next;
-	$db->traverse_tag(/^\// ? 'path' : 'whatprovides', [ $_ ], sub {
-			      my ($p) = @_;
-			      push @{$basepackages{$_} ||= []}, join '-', ($p->fullname)[0..2];
-			      push @base, $p->requires_nosense;
-			  });
-    }
-
-    foreach (values %basepackages) {
-	my $n = @$_;
-	foreach (@$_) {
-	    $base{$_} = \$n;
-	}
-    }
-}
-
-my $base_str = '';
-my @toremove = keys %{$state->{ask_remove}};
-foreach (@toremove) {
-    my $rn = $base{$_};
-    if ($rn) {
-	$$rn == 1 and $base_str .= _("removing package %s will break your system\n", $_);
-	--$$rn;
-    }
+@ARGV or usage;
+while (defined($_ = shift @ARGV)) {
+    /^--help$/ and do { usage; next };
+    /^--no-locales$/ and do { undef *_; undef *urpm::_; *_ = *urpm::_ = 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 };
+	die _("urpme: unknown option \"-%s\", check usage with --help\n", $1); } next };
+    @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next };
+    push @l, $_;
 }
-$base_str and die $base_str;
 
-if (@toremove > @l && !$auto) {
+my $urpm = new urpm;
+my $state = {};
+
+#- 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 ? _("unknown packages") : _("unknown package")) .
+								 ': ' . join(', ', @_)); 0 },
+					      callback_fuzzy => sub {
+						  my $urpm = shift @_;
+						  my $match = shift @_;
+						  $urpm->{fatal}(1, _("The following packages contain %s: %s",
+								      $match, join(' ', @_))); 0 },
+					      callback_base => sub {
+						  my $urpm = shift @_;
+						  foreach (@_) {
+						      $urpm->{error}(_("removing package %s will break your system", $_));
+						  } 0 },
+					     ) or $urpm->{fatal}(0, _("Nothing to remove"));
+
+if ($test && $auto) {
+    my $msg = _("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->{ask_remove}{$_}{size};
@@ -193,11 +107,10 @@ if (@toremove > @l && !$auto) {
     <STDIN> =~ /[$noexpr]/ and exit 0;
 }
 
-@l = $urpm->install(\@toremove, {}, {});
-if (@l) {
-    print STDERR _("Removing failed") . ":\n" . join("\n",  map { "\t$_" } @l);
-    exit 1;
-}
+@l = $parallel ?
+  $urpm->parallel_remove(\@toremove, test => $test, translate_message => 1) :
+  $urpm->remove(\@toremove, test => $test, translate_message => 1);
+@l and $urpm->{fatal}(1, _("Removing failed") . ":\n" . join("\n",  map { "\t$_" } @l));
 
 sub toMb {
     my $nb = $_[0] / 1024 / 1024;