summaryrefslogtreecommitdiffstats
path: root/urpmq
diff options
context:
space:
mode:
Diffstat (limited to 'urpmq')
-rwxr-xr-xurpmq324
1 files changed, 324 insertions, 0 deletions
diff --git a/urpmq b/urpmq
new file mode 100755
index 00000000..5cd3d9f3
--- /dev/null
+++ b/urpmq
@@ -0,0 +1,324 @@
+#!/usr/bin/perl
+
+#- Copyright (C) 2000 MandrakeSoft (fpons@mandrakesoft.com)
+#-
+#- 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.
+
+#- this program is based upon urpmi.
+
+#use strict qw(subs vars refs);
+use rpmtools;
+
+#- 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;
+
+my %I18N;
+load_po();
+
+sub usage {
+ die(_("usage: urpmq [-h] [-d] [-u] [-g] [-v] [-r] package_name|rpm_file [package_names|rpm_files...]\n"));
+}
+
+#- parse arguments list.
+my @nextargv;
+for (@ARGV) {
+ /^--help$/ and do { usage; next };
+ /^-(.*)$/ and do { foreach (split //, $1) {
+ /[\?h]/ and do { usage; next };
+ /d/ and do { $query->{deps} = 1; next };
+ /u/ and do { $query->{upgrade} = 1; next };
+ /g/ and do { $query->{group} = 1; next };
+ /v/ and do { $query->{version} = 1; next };
+ /r/ and do { $query->{release} = 1; next };
+ die "urpmq: 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 "urpmq: cannot read rpm file \"$_\"\n", next;
+ push @files, $_; next };
+ push @names, $_;
+}
+
+#- 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;
+
+if ($query && $query->{group}) {
+ open F, $compss or die "$compss file not found, run urpmi.addmedia first\n";
+ $params->read_compss(\*F);
+ close F;
+}
+
+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;
+
+ #- compute depslist of files provided on command line.
+ $params->read_rpms($_) foreach @files;
+ $params->compute_depslist;
+
+ #- gets full names of packages, sanity check of pathname.
+ m|(.*/)?(.*)\.[^.]+\.rpm$| and push @names, $2 foreach @files;
+ m|^/| or $_ = "./$_" foreach @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;
+ }
+ }
+ }
+}
+
+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);
+ }
+
+ #- 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;
+ }
+ }
+}
+
+#- 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;
+
+#- print sub for query.
+my $query_sub = sub {
+ my ($id) = @_;
+ my $info = $params->{depslist}[$id];
+ my $str = '';
+ $query->{group} and $str .= $info->{group} . '/';
+ $str .= $info->{name};
+ $query->{version} and $str .= '-' . $info->{version};
+ $query->{release} and $str .= '-' . $info->{release};
+ $str;
+};
+
+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;
+ }
+ } 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, @_;
+ my ($T, @p) = @$t;
+ sprintf $T, @_[@p];
+}
+sub translate { $I18N{$_[0]} || $_[0]; }
+
+sub load_po {
+ my ($from, $to, $state, $fuzzy);
+
+ my $lang = $ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES} || $ENV{LANG};
+ my $f; -e ($f = "/usr/share/locale/$_/LC_MESSAGES/urpmi.po") and last foreach split ':', $lang;
+
+ local *F; open F, $f or return;
+ foreach (<F>) {
+ /^msgstr/ and $state = 1;
+ /^msgid/ && !$fuzzy and $state = 2;
+
+ if (/^(#|$)/ && $state != 3) {
+ $state = 3;
+ s/\\n/\n/g foreach $from, $to;
+
+ if (my @l = $to =~ /%(\d+)\$/g) {
+ $to =~ s/%(\d+)\$/%/g;
+ $to = [ $to, map { $_ - 1 } @l ];
+ }
+ $I18N{$from} = $to if $from;
+ $from = $to = '';
+ }
+ $to .= (/"(.*)"/)[0] if $state == 1;
+ $from .= (/"(.*)"/)[0] if $state == 2;
+
+ $fuzzy = /^#, fuzzy/;
+ }
+}