major changes, added --auto-select flag and better online (small) help.

4 files changed, 328 insertions, 25 deletions

diff --git a/urpm.pm b/urpm.pm
index dfa782d0..24732b39 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -3,7 +3,7 @@ package urpm;
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = '1.40';
+$VERSION = '1.5';
 
 =head1 NAME
 
@@ -1125,5 +1125,219 @@ sub upload_source_packages {
     @$local_sources, @sources;
 }
 
+sub select_packages_to_upgrade {
+    my ($urpm, $prefix, $packages, $remove_packages, $keep_files) = @_;
+    my $db = rpmtools::db_open($prefix);
+
+    #- used for package that are not correctly updated.
+    #- should only be used when nothing else can be done correctly.
+    my %upgradeNeedRemove = (
+			     'libstdc++' => 1,
+			     'compat-glibc' => 1,
+			     'compat-libs' => 1,
+			    );
+
+    #- help removing package which may have different release numbering
+    my %toRemove;
+
+    #- help searching package to upgrade in regard to already installed files.
+    my %installedFilesForUpgrade;
+
+    #- help keeping memory by this set of package that have been obsoleted.
+    my %obsoletedPackages;
+
+    #- make a subprocess here for reading filelist, this is important
+    #- not to waste a lot of memory for the main program which will fork
+    #- latter for each transaction.
+    local (*INPUT, *OUTPUT_CHILD); pipe INPUT, OUTPUT_CHILD;
+    local (*INPUT_CHILD, *OUTPUT); pipe INPUT_CHILD, OUTPUT;
+    if (my $pid = fork()) {
+	close INPUT_CHILD;
+	close OUTPUT_CHILD;
+	select((select(OUTPUT), $| = 1)[0]);
+
+	#- internal reading from interactive mode of parsehdlist.
+	#- takes a code to call with the line read, this avoid allocating
+	#- memory for that.
+	my $ask_child = sub {
+	    my ($name, $tag, $code) = @_;
+	    $code or die "no callback code for parsehdlist output";
+	    print OUTPUT "$name:$tag\n";
+
+	    local $_;
+	    while (<INPUT>) {
+		chomp;
+		/^\s*$/ and last;
+		$code->($_);
+	    }
+	};
+
+	#- select packages which obseletes other package, obselete package are not removed,
+	#- should we remove them ? this could be dangerous !
+	foreach my $pkg (values %{$urpm->{params}{info}}) {
+	    $ask_child->($pkg->{name}, "obsoletes", sub {
+			     #- take care of flags and version and release if present
+			     if ($_[0] =~ /^(\S*)\s*(\S*)\s*([^\s-]*)-?(\S*)/ &&
+				 rpmtools::db_traverse_names($db, [], [$1], undef) > 0) {
+				 $3 and eval(rpmtools::version_compare($pkg->{version}, $3) . $2 . 0) or next;
+				 $4 and eval(rpmtools::version_compare($pkg->{release}, $4) . $2 . 0) or next;
+				 $urpm->{log}("selecting $pkg->{name}-$pkg->{version}-$pkg->{release} using obsoletes");
+				 $obsoletedPackages{$1} = undef;
+				 $pkg->{selected} = 1;
+			     }
+			 });
+	}
+
+	#- mark all files which are not in /etc/rc.d/ for packages which are already installed but which
+	#- are not in the packages list to upgrade.
+	#- the 'installed' property will make a package unable to be selected, look at select.
+	rpmtools::db_traverse($db, [ qw(name version release files) ], sub {
+				  my ($p) = @_;
+				  my $otherPackage = $p->{release} !~ /mdk\w*$/ && "$p->{name}-$p->{version}-$p->{release}";
+				  my $pkg = $urpm->{params}{info}{$p->{name}};
+
+				  if ($pkg) {
+				      my $version_cmp = rpmtools::version_compare($p->{version}, $pkg->{version});
+				      if ($version_cmp > 0 || $version_cmp == 0 &&
+					  rpmtools::version_compare($p->{release}, $pkg->{release}) >= 0) {
+					  if ($otherPackage && $version_cmp <= 0) {
+					      $toRemove{$otherPackage} = 0;
+					      $pkg->{selected} = 1;
+					      $urpm->{log}("removing $otherPackage to upgrade ...\n  to $pkg->{name}-$pkg->{version}-$pkg->{release} since it will not be updated otherwise");
+					  } else {
+					      $pkg->{installed} = 1;
+					  }
+				      } elsif ($upgradeNeedRemove{$pkg->{name}}) {
+					  my $otherPackage = "$p->{name}-$p->{version}-$p->{release}";
+					  $toRemove{$otherPackage} = 0;
+					  $pkg->{selected} = 1;
+					  $urpm->{log}("removing $otherPackage to upgrade ...\n  to $pkg->{name}-$pkg->{version}-$pkg->{release} since it will not upgrade correctly!");
+				      }
+				  } else {
+				      if (! exists $obsoletedPackages{$p->{name}}) {
+					  @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| &&
+									    ! -d "$prefix/$_" && ! -l "$prefix/$_") }
+								      @{$p->{files}}} = ();
+				      }
+				  }
+			      });
+
+	#- find new packages to upgrade.
+	foreach my $pkg (values %{$urpm->{params}{info}}) {
+	    my $skipThis = 0;
+	    my $count = rpmtools::db_traverse_names($db, [ 'name' ], [ $pkg->{name} ], sub {
+							$skipThis ||= $pkg->{installed};
+						    });
+
+	    #- skip if not installed (package not found in current install).
+	    $skipThis ||= ($count == 0);
+
+	    #- select the package if it is already installed with a lower version or simply not installed.
+	    unless ($skipThis) {
+		my $cumulSize;
+
+		$pkg->{selected} = 1;
+
+		#- keep in mind installed files which are not being updated. doing this costs in
+		#- execution time but use less memory, else hash all installed files and unhash
+		#- all file for package marked for upgrade.
+		rpmtools::db_traverse_names($db, [ qw(name files) ], [ $pkg->{name} ], sub {
+						my ($p) = @_;
+						@installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| &&
+										  ! -d "$prefix/$_" && ! -l "$prefix/$_") }
+									    @{$p->{files}}} = ();
+					    });
+
+		$ask_child->($pkg->{name}, "files", sub {
+				 delete $installedFilesForUpgrade{$_[0]};
+			     });
+	    }
+	}
+
+	#- unmark all files for all packages marked for upgrade. it may not have been done above
+	#- since some packages may have been selected by depsList.
+	foreach my $pkg (values %{$urpm->{params}{info}}) {
+	    if ($pkg->{selected}) {
+		$ask_child->($pkg->{name}, "files", sub {
+				 delete $installedFilesForUpgrade{$_[0]};
+			     });
+	    }
+	}
+
+	#- select packages which contains marked files, then unmark on selection.
+	#- a special case can be made here, the selection is done only for packages
+	#- requiring locales if the locales are selected.
+	#- another special case are for devel packages where fixes over the time has
+	#- made some files moving between the normal package and its devel couterpart.
+	#- if only one file is affected, no devel package is selected.
+	foreach my $pkg (values %{$urpm->{params}{info}}) {
+	    unless ($pkg->{selected}) {
+		my $toSelect = 0;
+		$ask_child->($pkg->{name}, "files", sub {
+				 if ($_[0] !~  m|^/etc/rc.d/| &&  $_ !~ m|\.la$| && exists $installedFilesForUpgrade{$_[0]}) {
+				     ++$toSelect if ! -d "$prefix/$_[0]" && ! -l "$prefix/$_[0]";
+				 }
+				 delete $installedFilesForUpgrade{$_[0]};
+			     });
+		if ($toSelect) {
+		    if ($toSelect <= 1 && $pkg->{name} =~ /-devel/) {
+			$urpm->{log}("avoid selecting $pkg->{name}-$pkg->{version}-$pkg->{release} as not enough files will be updated");
+		    } else {
+			#- default case is assumed to allow upgrade.
+			my @deps = map { /\|/ and next; #- do not inspect choice
+					 my $p = $urpm->{params}{depslist}[$_];
+					 $p && $p->{name} =~ /locales-/ ? ($p) : () } split ' ', $pkg->{deps};
+			if (@deps == 0 || @deps > 0 && (grep { !$_->{selected} && !$_->{installed} } @deps) == 0) {
+			    $urpm->{log}("selecting $pkg->{name} by selection on files");
+			    $pkg->{selected} = 1;
+			} else {
+			    $urpm->{log}("avoid selecting $pkg->{name}-$pkg->{version}-$pkg->{release} as its locales language is not already selected");
+			}
+		    }
+		}
+	    }
+	}
+
+	#- clean memory...
+	%installedFilesForUpgrade = ();
+
+	#- no need to still use the child as this point, we can let him to terminate.
+	close OUTPUT;
+	close INPUT;
+	waitpid $pid, 0;
+    } else {
+	close INPUT;
+	close OUTPUT;
+	open STDIN, "<&INPUT_CHILD";
+	open STDOUT, ">&OUTPUT_CHILD";
+	exec "parsehdlist", "--interactive", map { "$urpm->{statedir}/$_->{hdlist}" } grep { ! $_->{ignore} } @{$urpm->{media}}
+	  or rpmtools::_exit(1);
+    }
+
+    #- let the caller known about what we found here!
+    foreach my $pkg (values %{$urpm->{params}{info}}) {
+	$packages->{$pkg->{id}} = 0 if $pkg->{selected};
+    }
+
+    #- clean false value on toRemove.
+    delete $toRemove{''};
+
+    #- get filenames that should be saved for packages to remove.
+    #- typically config files, but it may broke for packages that
+    #- are very old when compabilty has been broken.
+    #- but new version may saved to .rpmnew so it not so hard !
+    if ($keep_files && keys %toRemove) {
+	rpmtools::db_traverse($db, [ qw(name version release conffiles) ], sub {
+				  my ($p) = @_;
+				  my $otherPackage = "$p->{name}-$p->{version}-$p->{release}";
+				  if (exists $toRemove{$otherPackage}) {
+				      @{$keep_files}{@{$p->{conffiles} || []}} = ();
+				  }
+			      });
+    }
+
+    #- close db, job finished !
+    rpmtools::db_close($db);
+}
 
 1;
diff --git a/urpmi b/urpmi
index de854b4b..07962a33 100755
--- a/urpmi
+++ b/urpmi
@@ -22,11 +22,13 @@ use urpm;
 
 #- default options.
 my $auto = 0;
+my $auto_select = 0;
 my $force = 0;
 my $X = 0;
 my $all = 0;
+my $complete = 0;
 my $rpm_opt = "-Uvh";
-my $datadir = "/var/lib/urpmi";
+my $verbose = 0;
 
 my $uid;
 my @files;
@@ -40,7 +42,26 @@ delete @ENV{qw(ENV BASH_ENV IFS CDPATH)};
 ($<, $uid) = ($>, $<);
     
 sub usage {
-    die(_("usage: urpmi [-h] [--auto] [--force] [-a] [-v] package_name|rpm_file [package_names|rpm_files...]\n"));
+    #die(_("usage: urpmi [-h] [--auto] [--force] [-a] [-v] package_name|rpm_file [package_names|rpm_files...]\n"));
+    die(_("urpmi version %s
+Copyright (C) 1999, 2000 MandrakeSoft.
+This is free software and may be redistributed under the terms of the GNU GPL.
+
+usage:
+  --help           - print this help message.
+  --auto           - automatically select a good package in choices.
+  --auto-select    - automatically select packages for upgrading the system.
+  --force          - force invocation even if some package does not exists.
+  --X              - use X interface.
+  --best-output    - chose best interface according to the environment:
+                     X or text mode.
+  -a               - select all matches on command line.
+  -c               - choose complete method for resolving requires closure.
+  -q               - quiet mode.
+  -v               - verbose mode.
+
+  names or rpm files (only for root) given on command line are installed.
+", $urpm::VERSION));
 }
 
 #- parse arguments list.
@@ -48,6 +69,7 @@ my @nextargv;
 for (@ARGV) {
     /^--help$/ and do { usage; next };
     /^--auto$/ and do { $auto = 1; next };
+    /^--auto-select$/ and do { $auto_select = 1; next };
     /^--force$/ and do { $force = 1; next };
     /^--X$/ and do { $X = 1; next };
     /^--best-output$/ and do { $X ||= $ENV{DISPLAY} && system('/usr/X11R6/bin/xtest', '') == 0; next };
@@ -55,8 +77,9 @@ for (@ARGV) {
     /^-(.*)$/ and do { foreach (split //, $1) {
 	/[\?h]/ and do { usage; next };
 	/a/ and do { $all = 1; next };
-	/v/ and do { $rpm_opt = "-Uvh"; next };
+	/c/ and do { $complete = 1; next };
 	/q/ and do { $rpm_opt = "-U"; next };
+	/v/ and do { $verbose = 1; next };
 	die "urpmi: unknown option \"-$1\", check usage with --help\n"; } next };
     @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next };
     /\.rpm$/ and do { -r $_ or print STDERR "urpmi: cannot read rpm file \"$_\"\n", next;
@@ -77,6 +100,9 @@ select STDOUT; $| = 1;     # make unbuffered
 #- params contains informations to parse installed system.
 my $urpm = new urpm;
 
+#- remove verbose if not asked.
+$verbose or $urpm->{log} = sub {};
+
 $urpm->read_depslist;
 
 if (@files) {
@@ -104,6 +130,17 @@ $urpm->relocate_depslist;
 my %packages;
 $urpm->search_packages(\%packages, [ 'basesystem', @names], all => $all) or $force or exit 1;
 
+#- auto select package for upgrading the distribution.
+if ($auto_select) {
+    my (%to_remove, %keep_files);
+
+    $urpm->select_packages_to_upgrade('', \%packages, \%to_remove, \%keep_files);
+
+    if (keys(%to_remove) > 0) {
+	print STDERR "some package have to be removed for being upgraded, this is not supported yet\n";
+    }
+}
+
 #- filter to add in packages selected required packages.
 $urpm->filter_packages_to_upgrade(\%packages, sub {
     my ($urpm, @choices_id) = @_;
@@ -128,7 +165,7 @@ $urpm->filter_packages_to_upgrade(\%packages, sub {
     }
 
     $choices_id[$n - 1];
-});
+}, complete => $complete);
 
 #- package to install as a array of strings.
 my @to_install;
@@ -182,10 +219,8 @@ my @sources = $urpm->upload_source_packages($local_sources, $list, 'force_local'
 						}
 					    });
 
-my $something_was_installed;
-
 install(@sources);
-$something_was_installed or message_auto(_("everything already installed"));
+@sources or message_auto(_("everything already installed"));
 
 #- this help flushing correctly by closing this file before (piped on tee).
 close STDERR;
@@ -194,7 +229,6 @@ close STDOUT;
 sub install {
     @_ or return;
 	
-    $something_was_installed = 1;
     print SAVEOUT _("installing %s\n", join(' ', @_));
     log_it(scalar localtime, " @_\n");
     system($X ? "grpmi" : ("rpm", $rpm_opt), @_);
@@ -278,12 +312,3 @@ sub load_po {
     }
 }
 
-sub rpmlistfiles {
-    my ($d) = @_;
-    local *F;
-    opendir F, $d or die "all: can't open dir $d: $!\n";
-    my @l = grep { /^list\.*/ } readdir F;
-    closedir F;
-
-    @l;
-}
diff --git a/urpmi.spec b/urpmi.spec
index a0e5033d..fa3bb4f5 100644
--- a/urpmi.spec
+++ b/urpmi.spec
@@ -1,13 +1,13 @@
 %define group System/Configuration/Packaging
 
 Name: urpmi
-Version: 1.4
-Release: 7mdk
+Version: 1.5
+Release: 1mdk
 License: GPL
 Source0: %{name}.tar.bz2
 Summary: User mode rpm install
 Requires: /usr/bin/suidperl, eject, wget
-PreReq: rpmtools >= 2.1-9mdk
+PreReq: rpmtools >= 2.2
 BuildRoot: %{_tmppath}/%{name}-buildroot
 
 Group: %{group}
@@ -18,7 +18,7 @@ well-known rpms to be installed.
 You can compare rpm vs. urpmi  with  insmod vs. modprobe
 
 %package -n gurpmi
-Version: 0.8
+Version: 0.9
 Summary: User mode rpm GUI install
 Requires: urpmi grpmi gchooser gmessage
 Group: %{group}
@@ -29,7 +29,7 @@ well-known rpms to be installed.
 You can compare rpm vs. urpmi  with  insmod vs. modprobe
 
 %package -n autoirpm
-Version: 0.6
+Version: 0.7
 Summary: Auto install of rpm on demand
 Requires: sh-utils urpmi gurpmi xtest gmessage gurpmi
 Group: %{group}
@@ -113,6 +113,11 @@ autoirpm.uninstall
 
 
 %changelog
+* Wed Feb 14 2001 François Pons <fpons@ackbar.mandrakesoft.com> 1.5-1mdk
+- added --auto-select flag for urpmi and urpmq.
+- added --headers flag to urpmq.
+- changed help screen for both urpmi and urpmq.
+
 * Mon Feb 05 2001 François Pons <fpons@mandrakesoft.com> 1.4-7mdk
 - fixed wrong probing of medium list file.
 
diff --git a/urpmq b/urpmq
index a821cdd4..2680e992 100755
--- a/urpmq
+++ b/urpmq
@@ -31,13 +31,34 @@ my %I18N;
 load_po();
 
 sub usage {
-    die(_("usage: urpmq [-h] [-d] [-u] [-c] [-g] [-v] [-r] package_name|rpm_file [package_names|rpm_files...]\n"));
+    #die(_("usage: urpmq [-h] [-d] [-u] [-c] [-g] [-v] [-r] package_name|rpm_file [package_names|rpm_files...]\n"));
+    die(_("urpmq version %s
+Copyright (C) 2000 MandrakeSoft.
+This is free software and may be redistributed under the terms of the GNU GPL.
+
+usage:
+  -h             - print this help message.
+  -d             - extend query to package dependancies.
+  -u             - remove package if a better version is already installed.
+  -c             - choose complete method for resolving requires closure.
+  -g             - print groups too with name.
+  -v             - print version too with name.
+  -r             - print release too with name.
+
+  --auto-select  - automatically select packages for upgrading the system.
+  --headers      - extract headers for package listed from urpmi db to
+                   stdout (root only).
+
+  names or rpm files given on command line are queried.
+", $urpm::VERSION));
 }
 
 #- parse arguments list.
 my @nextargv;
 for (@ARGV) {
     /^--help$/ and do { usage; next };
+    /^--auto-select$/ and do { $query->{auto_select} = 1; next };
+    /^--headers$/ and do { $query->{headers} = 1; next };
     /^-(.*)$/ and do { foreach (split //, $1) {
 	/[\?h]/ and do { usage; next };
 	/d/ and do { $query->{deps} = 1; next };
@@ -80,12 +101,50 @@ $urpm->{params}->relocate_depslist();
 #- basesystem is added to the list so if it need to be upgraded, all its dependancy
 #- will be updated too.
 my %packages;
-$urpm->search_packages(\%packages, [ @names ], all => $all) or $force or exit 1;
+$urpm->search_packages(\%packages, [ @names ]) or exit 1;
+
+#- auto select package for upgrading the distribution.
+if ($query->{auto_select}) {
+    my (%to_remove, %keep_files);
+
+    $urpm->select_packages_to_upgrade('', \%packages, \%to_remove, \%keep_files);
+
+    if (keys(%to_remove) > 0) {
+	print STDERR "some package have to be removed for being upgraded, this is not supported yet\n";
+    }
+}
 
 #- filter to add in packages selected required packages.
 $query->{deps} && !$query->{upgrade} and $urpm->compute_closure(\%packages);
 $query->{upgrade} and $urpm->filter_packages_to_upgrade(\%packages, complete => $query->{complete});
 
+if ($query->{headers}) {
+    $urpm->read_config();
+
+    my ($local_sources, $list) = $urpm->get_source_packages(\%packages);
+    unless ($local_sources || $list) {
+	die("unable to get source packages, aborting");
+	exit 1;
+    }
+
+    #- now examine source package to build headers list to extract.
+    foreach (@$local_sources) {
+	system 'rpm2header', @$local_sources;
+    }
+    foreach (0..$#{$urpm->{media} || []}) {
+	my @headers = (grep { my $file = "$urpm->{cachedir}/headers/$_";
+			      -s $file and system 'cat', $file;
+			      ! -s $file }
+		       map { /(.*)\/([^\/]*)-([^-]*)-([^-]*)\.([^\.]*)\.rpm/ and "$2-$3-$4.$5" } @{$list->[$_]});
+	@headers > 0 or next;
+
+	require packdrake;
+	my $packer = new packdrake("$urpm->{statedir}/$urpm->{media}[$_]{hdlist}");
+	$packer->extract_archive(undef, @headers);
+    }
+    exit 0;
+}
+
 #- print sub for query.
 my $query_sub = sub {
 	my ($id) = @_;