diff options
| -rwxr-xr-x | urpmi | 243 | ||||
| -rwxr-xr-x | urpmq | 218 |
2 files changed, 61 insertions, 400 deletions
@@ -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; @@ -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, @_; |