*** empty log message ***

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/;
+    }
+}