use of urpm library, moved code.

2 files changed, 61 insertions, 400 deletions

diff --git a/urpmi b/urpmi
index d542649f..90c60c3b 100755
--- a/urpmi
+++ b/urpmi
@@ -1,3 +1,4 @@
+#!/usr/bin/perl
 #!/usr/bin/perl -T
 
 #- Copyright (C) 1999 MandrakeSoft (pixel@linux-mandrake.com)
@@ -17,7 +18,7 @@
 #- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 #use strict qw(subs vars refs);
-use rpmtools;
+use urpm;
 
 #- default options.
 my $auto = 0;
@@ -26,11 +27,6 @@ my $X = 0;
 my $all = 0;
 my $rpm_opt = "-U";
 my $datadir = "/var/lib/urpmi";
-my $confdir = "/etc/urpmi";
-
-my $depslist = "$datadir/depslist.ordered";
-my $provides = "$datadir/provides";
-my $compss   = "$datadir/compss";
 
 my $uid;
 my @files;
@@ -78,24 +74,20 @@ select STDERR; $| = 1;     # make unbuffered
 select STDOUT; $| = 1;     # make unbuffered
 
 #- params contains informations to parse installed system.
-my $params = new rpmtools;
+my $urpm = new urpm;
 
-open F, $depslist or die "$depslist file not found, run urpmi.addmedia first\n";
-$params->read_depslist(\*F);
-close F;
+$urpm->read_depslist;
 
 if (@files) {
     $uid == 0 or die _("Only superuser is allowed to install local packages");
 
     #- read provides file which is needed only to compute incremental
     #- dependancies, of files provided.
-    open F, $provides or die "$provides file not found, run urpmi.addmedia first\n";
-    $params->read_provides(\*F);
-    close F;
+    $urpm->read_provides;
 
     #- compute depslist of files provided on command line.
-    $params->read_rpms($_) foreach @files;
-    $params->compute_depslist;
+    $urpm->{params}->read_rpms($_) foreach @files;
+    $urpm->{params}->compute_depslist;
 
     #- gets full names of packages, sanity check of pathname.
     m|(.*/)?(.*)\.[^.]+\.rpm$| and push @names, $2 foreach @files;
@@ -103,182 +95,41 @@ if (@files) {
 }
 
 #- reparse whole internal depslist to match against newer packages only.
-$params->relocate_depslist();
-
-my %exact;
-my %found;
-my %foundi;
-my @packages;
-
-foreach my $v (@names) {
-    #- it is a way of speedup, providing the name of a package directly help
-    #- to find the package.
-    #- this is necessary if providing a name list of package to upgrade.
-    if ($params->{info}{$v}) {
-	$exact{$v} = $params->{info}{$v}; next;
-    }
+# TO MOVE TO urpm management of ignored medium
+$urpm->{params}->relocate_depslist();
 
-    my $qv = quotemeta $v;
-    foreach (keys %{$params->{info}}) {
-	my $info = $params->{info}{$_};
-	my $pack = $info->{name} .'-'. $info->{version} .'-'. $info->{release};
 
-	$pack =~ /^$qv-[^-]+-[^-]+$/ and $exact{$v} = $info;
-	$pack =~ /^$qv-[^-]+$/ and $exact{$v} = $info;
-	$pack =~ /$qv/ and push @{$found{$v}}, $info;
-	$pack =~ /$qv/i and push @{$foundi{$v}}, $info; 
-    }
-}
+#- search the packages according the selection given by the user,
+#- 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, [ 'basesystem', @names], all => $all) or $force or exit 1;
 
-my $ok = 1;
-foreach (@names) {
-    my $info = $exact{$_};
-    if ($info) {
-	push @packages, $info->{id};
-    } else {
-	my $l = $found{$_} || $foundi{$_};
-	if (@{$l || []} == 0) {
-	    warn(_("no package named %s\n", $_)); $ok = $force; 
-	} elsif (@$l > 1 && !$all) {
-	    warn(_("The following packages contain %s: %s\n", $_, join(' ', map { $_->{name} } @$l))); $ok = $force; 
-	} else {
-	    push @packages, map { $_->{id} } @$l;
-	}
-    }
-}
-$ok or exit 1;
-
-#- keep in mind the packages asked by the user, just for interactive activity.
-my %packages; @packages{@packages} = ();
-
-#- compute closure of package to install/upgrade before examining installed
-#- packages, this help speed up the process to retrieve installed packages in
-#- the given list.
-my %packages_to_install;
-my @packages_installed;
-if (rpmtools::get_packages_installed('', \@packages_installed, [ 'basesystem' ])) {
-    #- if basesystem is installed and need to be updated.
-    #- we have to add it in the list explicitely.
-    #- in order to take care of all basesystem packages.
-    my $pkg = $params->{info}{basesystem};
-    foreach (@packages_installed) {
-	my $cmp = rpmtools::version_compare($pkg->{version}, $_->{version});
-	if ($cmp > 0 || $cmp == 0 && rpmtools::version_compare($pkg->{release}, $_->{release}) > 0) {
-	    push @packages, $pkg->{id}; last;
-	}
-    }
-}
+#- filter to add in packages selected required packages.
+$urpm->filter_packages_to_upgrade(\%packages, sub {
+    my ($urpm, @choices_id) = @_;
+    my $n = 1; #- default value.
+    my @l = map { my $info = $urpm->{params}{depslist}[$_]; "$info->{name}-$info->{version}-$info->{release}" } @choices_id;
 
-my $id;
-while (defined($id = shift @packages)) {
-    if (ref $id) {
-	#- in such case, this is a dependancy on a choices, check
-	#- if one of the package is already selected, in such case, the choice
-	#- can safely be dropped. in other cases, the choices has to be registered.
-	foreach (@$id) {
-	    exists $packages_to_install{$_} && !$packages_to_install{$_} and $id = undef, last;
-	}
-	#- registering the choice is done by adding the class in any referenced id.
-	if ($id) {
-	    foreach (@$id) {
-		push @{$packages_to_install{$_} ||= []}, $id;
-	    }
-	}
-    } else {
-	if ($packages_to_install{$id}) {
-	    drop_in_choices(\%packages_to_install, $id);
-	}
-	exists $packages_to_install{$id} and next;
-	#- force selection as mandatory package.
-	$packages_to_install{$id} = undef;
-	#- rebuild requires_id array according to deps as requires_id is no more available (because of speed :-)
-	#- and because id have been relocated.
-	my @rebuild_requires_id;
-	foreach (split /\s+/, $params->{depslist}[$id]{deps}) {
-	    if (/\|/) {
-		push @rebuild_requires_id, [ map { $params->{depslist}[$_]{id} } split /\|/, $_ ];
-	    } else {
-		push @rebuild_requires_id, $params->{depslist}[$_]{id};
-	    }
-	}
-	#- get all dependancies to add them.
-	#- this is a partial closure, it assumes it has already be done before.
-	foreach (@rebuild_requires_id) {
-	    if (ref $_) {
-		push @packages, $_;
-	    } else {
-		$packages_to_install{$_} = undef;
+    if (@l > 1 && !$auto) {
+	my $msg = _("One of the following packages is needed:");
+	if ($X) {
+	    `gchooser "$msg" @l`;
+	    $n = $? >> 8 || die;
+	} else {
+	    print SAVEOUT "$msg\n";
+	    my $i = 0; foreach (@l) { print SAVEOUT " ", ++$i, "- $_\n"; }
+	    while (1) {
+		print SAVEOUT _("What is your choice? (1-%d) ", $i);
+		$n = <STDIN>;
+		1 <= $n && $n <= $i and last;
+		print SAVEOUT _("Sorry, bad choice, try again\n");
 	    }
 	}
     }
-}
-
-#- now the packages_to_install contains as keys all packages that may be selected,
-#- this is used to determine a restricted list of packages installed, as it can
-#- improve performance on some cases.
-my @packages_to_install = map { $params->{depslist}[$_]{name} } keys %packages_to_install;
-my @packages_installed;
-if (@packages_to_install > 100) {
-    rpmtools::get_all_packages_installed('', \@packages_installed);
-} else {
-    rpmtools::get_packages_installed('', \@packages_installed, \@packages_to_install);
-}
-
-#- examine installed packages, determine if a package need upgrade or not.
-#- this list may be bigger than packages than really need to be upgraded because they
-#- are selected.
-foreach (@packages_installed) {
-    my $pkg = $params->{info}{$_->{name}};
-    #- if package has not event been selected by upgrade, continue.
-    #- but if the package is part of a choice, if it need upgrade, the choice will
-    #- be dropped, if it does not need upgrade, the choice has to been dropped.
-    #- in any case, a choice has to be dropped.
-    exists $packages_to_install{$pkg->{id}} or next;
-    if ($packages_to_install{$pkg->{id}}) {
-	drop_in_choices(\%packages_to_install, $pkg->{id});
-    }
-    #- at this point, $_ is the package installed and $pkg is the package candidate to install.
-    my $cmp = rpmtools::version_compare($pkg->{version}, $_->{version});
-    if ($cmp < 0 || $cmp == 0 && rpmtools::version_compare($pkg->{release}, $_->{release}) <= 0) {
-	#- the package $pkg is older or the same as the installed package,
-	#- this means it has to be removed from the list, and considered to be
-	#- already installed.
-	delete $packages_to_install{$pkg->{id}};
-    } else {
-	$packages_to_install{$pkg->{id}} = undef;
-    }
-}
 
-#- resolution of choices by the user, or automatically by the first listed.
-foreach my $id (keys %packages_to_install) {
-    my $class = $packages_to_install{$id};
-    foreach my $choices_id (@{$class || []}) {
-	my $n = 1; #- default value.
-	my @l = map { my $info = $params->{depslist}[$_]; "$info->{name}-$info->{version}-$info->{release}" } @$choices_id;
-
-	if (@l > 1 && !$auto) {
-	    my $msg = _("One of the following packages is needed:");
-	    if ($X) {
-		`gchooser "$msg" @l`;
-		$n = $? >> 8 || die;
-	    } else {
-		print SAVEOUT "$msg\n";
-		my $i = 0; foreach (@l) { print SAVEOUT " ", ++$i, "- $_\n"; }
-		while (1) {
-		    print SAVEOUT _("What is your choice? (1-%d) ", $i);
-		    $n = <STDIN>;
-		    1 <= $n && $n <= $i and last;
-		    print SAVEOUT _("Sorry, bad choice, try again\n");
-		}
-	    }
-	}
-
-	#- at this point, the choice is selected by $n and is
-	#- selected, choices are dropped.
-	drop_in_choices(\%packages_to_install, $choices_id->[$n - 1]);
-	$packages_to_install{$choices_id->[$n - 1]} = undef;
-    }
-}
+    $choices_id[$n - 1];
+});
 
 #- package to install as a array of strings.
 my @to_install;
@@ -287,9 +138,9 @@ my @to_install;
 #- has not been given by the user.
 my $ask_user;
 my $sum = 0;
-foreach (keys %packages_to_install) {
-    exists $packages{$_} or $ask_user = 1;
-    my $info  = $params->{depslist}[$_];
+foreach (keys %packages) {
+    defined $packages{$_} and $ask_user = 1;
+    my $info  = $urpm->{params}{depslist}[$_];
     $sum += $info->{size};
     push @to_install, "$info->{name}-$info->{version}-$info->{release}";
 }
@@ -375,26 +226,6 @@ install(@to_install_long) if $removables{0} || $removables{1};
 $something_was_installed or message_auto(_("everything already installed"));
 
 
-#- remove any reference to package in choices,
-#- it is NECESSARY the package to be in a choice, or it will die.
-sub drop_in_choices {
-    my ($packages_to_install, $id) = @_;
-
-    #- the package here is listed in a choices, drop any reference to the choices
-    #- as this package will have to be selected.
-    my %class_to_drop; @class_to_drop{@{$packages_to_install->{$id}}} = ();
-    foreach (keys %$packages_to_install) {
-	if ($packages_to_install->{$_}) {
-	    my @keeped_choices = grep { ! exists $class_to_drop{$_} } @{$packages_to_install->{$_}};
-	    if (@keeped_choices) {
-		$packages_to_install->{$_} = \@keeped_choices;
-	    } else {
-		delete $packages_to_install->{$_};
-	    }
-	}
-    }
-}
-
 sub install {
     @_ or return;
 	
diff --git a/urpmq b/urpmq
index 5cd3d9f3..862ff1af 100755
--- a/urpmq
+++ b/urpmq
@@ -19,16 +19,10 @@
 #- this program is based upon urpmi.
 
 #use strict qw(subs vars refs);
-use rpmtools;
+use urpm;
 
 #- default options.
 my $query = {};
-my $datadir = "/var/lib/urpmi";
-my $confdir = "/etc/urpmi";
-
-my $depslist = "$datadir/depslist.ordered";
-my $provides = "$datadir/provides";
-my $compss   = "$datadir/compss";
 
 my @files;
 my @names;
@@ -59,28 +53,19 @@ for (@ARGV) {
 }
 
 #- params contains informations to parse installed system.
-my $params = new rpmtools;
-
-open F, $depslist or die "$depslist file not found, run urpmi.addmedia first\n";
-$params->read_depslist(\*F);
-close F;
+my $urpm = new urpm;
 
-if ($query && $query->{group}) {
-    open F, $compss or die "$compss file not found, run urpmi.addmedia first\n";
-    $params->read_compss(\*F);
-    close F;
-}
+$urpm->read_depslist;
+$query && $query->{group} and $urpm->read_compss;
 
 if (@files) {
     #- read provides file which is needed only to compute incremental
     #- dependancies, of files provided.
-    open F, $provides or die "$provides file not found, run urpmi.addmedia first\n";
-    $params->read_provides(\*F);
-    close F;
+    $urpm->read_provides;
 
     #- compute depslist of files provided on command line.
-    $params->read_rpms($_) foreach @files;
-    $params->compute_depslist;
+    $urpm->{params}->read_rpms($_) foreach @files;
+    $urpm->{params}->compute_depslist;
 
     #- gets full names of packages, sanity check of pathname.
     m|(.*/)?(.*)\.[^.]+\.rpm$| and push @names, $2 foreach @files;
@@ -88,161 +73,27 @@ if (@files) {
 }
 
 #- reparse whole internal depslist to match against newer packages only.
-$params->relocate_depslist();
-
-my %exact;
-my %found;
-my %foundi;
-my @packages;
-
-foreach my $v (@names) {
-    #- it is a way of speedup, providing the name of a package directly help
-    #- to find the package.
-    #- this is necessary if providing a name list of package to upgrade.
-    if ($params->{info}{$v}) {
-	$exact{$v} = $params->{info}{$v}; next;
-    }
-
-    my $qv = quotemeta $v;
-    foreach (keys %{$params->{info}}) {
-	my $info = $params->{info}{$_};
-	my $pack = $info->{name} .'-'. $info->{version} .'-'. $info->{release};
-
-	$pack =~ /^$qv-[^-]+-[^-]+$/ and $exact{$v} = $info;
-	$pack =~ /^$qv-[^-]+$/ and $exact{$v} = $info;
-	$pack =~ /$qv/ and push @{$found{$v}}, $info;
-	$pack =~ /$qv/i and push @{$foundi{$v}}, $info; 
-    }
-}
-
-foreach (@names) {
-    my $info = $exact{$_};
-    if ($info) {
-	push @packages, $info->{id};
-    } else {
-	my $l = $found{$_} || $foundi{$_};
-	if (@{$l || []} == 0) {
-	    warn(_("no package named %s\n", $_));
-	} elsif (@$l > 1 && !$all) {
-	    warn(_("The following packages contain %s: %s\n", $_, join(' ', map { $_->{name} } @$l)));
-	} else {
-	    push @packages, map { $_->{id} } @$l;
-	}
-    }
-}
-
-#- keep in mind the packages asked by the user, just for interactive activity.
-my %packages; @packages{@packages} = ();
-
-#- compute closure of package to install/upgrade before examining installed
-#- packages, this help speed up the process to retrieve installed packages in
-#- the given list.
-my %packages_to_install;
-my @packages_installed;
-if (rpmtools::get_packages_installed('', \@packages_installed, [ 'basesystem' ])) {
-    #- if basesystem is installed and need to be updated.
-    #- we have to add it in the list explicitely.
-    #- in order to take care of all basesystem packages.
-    my $pkg = $params->{info}{basesystem};
-    foreach (@packages_installed) {
-	my $cmp = rpmtools::version_compare($pkg->{version}, $_->{version});
-	if ($cmp > 0 || $cmp == 0 && rpmtools::version_compare($pkg->{release}, $_->{release}) > 0) {
-	    push @packages, $pkg->{id}; last;
-	}
-    }
-}
-
-my $id;
-while (defined($id = shift @packages)) {
-    if (ref $id) {
-	#- in such case, this is a dependancy on a choices, check
-	#- if one of the package is already selected, in such case, the choice
-	#- can safely be dropped. in other cases, the choices has to be registered.
-	foreach (@$id) {
-	    exists $packages_to_install{$_} && !$packages_to_install{$_} and $id = undef, last;
-	}
-	#- registering the choice is done by adding the class in any referenced id.
-	if ($id) {
-	    foreach (@$id) {
-		push @{$packages_to_install{$_} ||= []}, $id;
-	    }
-	}
-    } else {
-	if ($packages_to_install{$id}) {
-	    drop_in_choices(\%packages_to_install, $id);
-	}
-	exists $packages_to_install{$id} and next;
-	#- force selection as mandatory package.
-	$packages_to_install{$id} = undef;
-	#- rebuild requires_id array according to deps as requires_id is no more available (because of speed :-)
-	#- and because id have been relocated.
-	my @rebuild_requires_id;
-	foreach (split /\s+/, $params->{depslist}[$id]{deps}) {
-	    if (/\|/) {
-		push @rebuild_requires_id, [ map { $params->{depslist}[$_]{id} } split /\|/, $_ ];
-	    } else {
-		push @rebuild_requires_id, $params->{depslist}[$_]{id};
-	    }
-	}
-	#- get all dependancies to add them.
-	#- this is a partial closure, it assumes it has already be done before.
-	foreach (@rebuild_requires_id) {
-	    if (ref $_) {
-		push @packages, $_;
-	    } else {
-		$packages_to_install{$_} = undef;
-	    }
-	}
-    }
-}
+$urpm->{params}->relocate_depslist();
 
-if ($query->{upgrade}) {
-    #- now the packages_to_install contains as keys all packages that may be selected,
-    #- this is used to determine a restricted list of packages installed, as it can
-    #- improve performance on some cases.
-    my @packages_to_install = map { $params->{depslist}[$_]{name} } keys %packages_to_install;
-    my @packages_installed;
-    if (@packages_to_install > 100) {
-	rpmtools::get_all_packages_installed('', \@packages_installed);
-    } else {
-	rpmtools::get_packages_installed('', \@packages_installed, \@packages_to_install);
-    }
+#- search the packages according the selection given by the user,
+#- 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;
 
-    #- examine installed packages, determine if a package need upgrade or not.
-    #- this list may be bigger than packages than really need to be upgraded because they
-    #- are selected.
-    foreach (@packages_installed) {
-	my $pkg = $params->{info}{$_->{name}};
-	#- if package has not event been selected by upgrade, continue.
-	#- but if the package is part of a choice, if it need upgrade, the choice will
-	#- be dropped, if it does not need upgrade, the choice has to been dropped.
-	#- in any case, a choice has to be dropped.
-	exists $packages_to_install{$pkg->{id}} or next;
-	if ($packages_to_install{$pkg->{id}}) {
-	    drop_in_choices(\%packages_to_install, $pkg->{id});
-	}
-	#- at this point, $_ is the package installed and $pkg is the package candidate to install.
-	my $cmp = rpmtools::version_compare($pkg->{version}, $_->{version});
-	if ($cmp < 0 || $cmp == 0 && rpmtools::version_compare($pkg->{release}, $_->{release}) <= 0) {
-	    #- the package $pkg is older or the same as the installed package,
-	    #- this means it has to be removed from the list, and considered to be
-	    #- already installed.
-	    delete $packages_to_install{$pkg->{id}};
-	} else {
-	    $packages_to_install{$pkg->{id}} = undef;
-	}
-    }
-}
+#- 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);
 
 #- query of dependancies will make use of packages_to_install, else just
 #- need to use @names where all informations are given, with eventual
 #- limitation on packages already installed.
-my $l = $query->{deps} ? \%packages_to_install : \%packages;
+my $l = $query->{deps} ? \%packages : \%packages;
 
 #- print sub for query.
 my $query_sub = sub {
 	my ($id) = @_;
-	my $info = $params->{depslist}[$id];
+	my $info = $urpm->{params}{depslist}[$id];
 	my $str = '';
 	$query->{group} and $str .= $info->{group} . '/';
 	$str .= $info->{name};
@@ -251,41 +102,20 @@ my $query_sub = sub {
 	$str;
 };
 
+my %hack_only_one;
 foreach my $id (keys %$l) {
     my $class = $l->{$id};
-    if ($class) {
-	my %hack_only_one;
-	foreach my $choices_id (@{$class || []}) {
-	    exists $hack_only_one{$choices_id} and next;
-	    print join('|', map { $query_sub->($_) } @$choices_id), "\n";
-	    drop_in_choices($l, $choices_id->[0]);
-	    $hack_only_one{$choices_id} = undef;
+    if (ref $class) {
+	foreach my $choices (@{$class || []}) {
+	    exists $hack_only_one{$choices} and next;
+	    print join('|', map { $query_sub->($_) } @$choices), "\n";
+	    $hack_only_one{$choices} = undef;
 	}
     } else {
 	exists $l->{$id} and print $query_sub->($id), "\n";
     }
 }
 
-#- remove any reference to package in choices,
-#- it is NECESSARY the package to be in a choice, or it will die.
-sub drop_in_choices {
-    my ($packages_to_install, $id) = @_;
-
-    #- the package here is listed in a choices, drop any reference to the choices
-    #- as this package will have to be selected.
-    my %class_to_drop; @class_to_drop{@{$packages_to_install->{$id}}} = ();
-    foreach (keys %$packages_to_install) {
-	if ($packages_to_install->{$_}) {
-	    my @keeped_choices = grep { ! exists $class_to_drop{$_} } @{$packages_to_install->{$_}};
-	    if (@keeped_choices) {
-		$packages_to_install->{$_} = \@keeped_choices;
-	    } else {
-		delete $packages_to_install->{$_};
-	    }
-	}
-    }
-}
-
 sub _ {
     my $s = shift @_; my $t = translate($s);
     $t && ref $t or return sprintf $t, @_;