summaryrefslogtreecommitdiffstats
path: root/urpm
diff options
context:
space:
mode:
Diffstat (limited to 'urpm')
-rw-r--r--urpm/args.pm13
-rw-r--r--urpm/bug_report.pm3
-rw-r--r--urpm/cfg.pm157
-rw-r--r--urpm/download.pm20
-rw-r--r--urpm/install.pm11
-rw-r--r--urpm/lock.pm3
-rw-r--r--urpm/md5sum.pm2
-rw-r--r--urpm/media.pm23
-rw-r--r--urpm/msg.pm80
-rw-r--r--urpm/select.pm69
-rw-r--r--urpm/util.pm31
11 files changed, 235 insertions, 177 deletions
diff --git a/urpm/args.pm b/urpm/args.pm
index 6f11dd7c..3ce53e60 100644
--- a/urpm/args.pm
+++ b/urpm/args.pm
@@ -252,9 +252,11 @@ my %options_spec = (
'm|M' => sub { $options{deps} = $options{upgrade} = 1 },
c => \$options{complete},
g => \$options{group},
- p => \$options{use_provides},
+ 'whatprovides|p' => \$options{use_provides},
P => sub { $options{use_provides} = 0 },
- R => sub { ++$options{what_requires} },
+ 'whatrequires|R' => sub { $options{what_requires} and $options{what_requires_recursive} = 1;
+ $options{what_requires} = 1 },
+ 'whatrequires-recursive' => sub { $options{what_requires_recursive} = $options{what_requires} = 1 },
y => sub { $urpm->{options}{fuzzy} = 1; $options{all} = 1 },
Y => sub { $urpm->{options}{fuzzy} = 1; $options{all} = $options{caseinsensitive} = 1 },
'verbose|v' => \$options{verbose},
@@ -297,6 +299,7 @@ my %options_spec = (
'q|quiet' => sub { --$options{verbose} },
'v|verbose' => sub { ++$options{verbose} },
'norebuild!' => sub { $urpm->{options}{'build-hdlist-on-error'} = !$_[1]; $options{force} = 0 },
+ 'probe-rpms' => sub { $options{probe_with} = 'rpms' },
'<>' => sub {
my ($p) = @_;
if ($p =~ /^--?(.+)/) { # unrecognized option
@@ -311,7 +314,6 @@ my %options_spec = (
distrib => sub { $options{distrib} = 1 },
interactive => sub { $options{interactive} = 1 },
'all-media' => sub { $options{allmedia} = 1 },
- 'probe-rpms' => sub { $options{probe_with} = 'rpms' },
'from=s' => \$options{mirrors_url},
virtual => \$options{virtual},
nopubkey => \$options{nopubkey},
@@ -386,7 +388,7 @@ foreach my $k ("help|h", "version", "wget", "curl", "prozilla", "proxy=s", "prox
}
foreach my $k ("help|h", "wget", "curl", "prozilla", "proxy=s", "proxy-user=s", "c", "f", "z",
- "limit-rate=s", "no-md5sum", "update", "norebuild!",
+ "limit-rate=s", "no-md5sum", "update", "norebuild!", "probe-rpms",
"wget-options=s", "curl-options=s", "rsync-options=s", "prozilla-options=s", '<>')
{
$options_spec{'urpmi.addmedia'}{$k} = $options_spec{'urpmi.update'}{$k};
@@ -419,7 +421,8 @@ sub parse_cmdline {
}
my $ret = GetOptions(%{$options_spec{$tool}}, %options_spec_all);
- if ($tool ne 'urpmi.addmedia' && $options{probe_with} && !$options{usedistrib}) {
+ if ($tool ne 'urpmi.addmedia' && $tool ne 'urpmi.update' &&
+ $options{probe_with} && !$options{usedistrib}) {
die N("Can't use %s without %s", "--probe-$options{probe_with}", "--use-distrib");
}
if ($options{probe_with} && $options{probe_with} eq 'rpms' && $options{virtual}) {
diff --git a/urpm/bug_report.pm b/urpm/bug_report.pm
index eb1258a4..f4265870 100644
--- a/urpm/bug_report.pm
+++ b/urpm/bug_report.pm
@@ -30,10 +30,9 @@ sub write_urpmdb {
require URPM::Build;
foreach (@{$urpm->{media}}) {
#- take care of virtual medium this way.
- $_->{hdlist} ||= "hdlist.$_->{name}.cz";
#- now build directly synthesis file, this is by far the simplest method.
if (urpm::media::is_valid_medium($_)) {
- $urpm->build_synthesis(start => $_->{start}, end => $_->{end}, synthesis => "$bug_report_dir/synthesis.$_->{hdlist}");
+ $urpm->build_synthesis(start => $_->{start}, end => $_->{end}, synthesis => "$bug_report_dir/synthesis." . urpm::media::_hdlist($_));
$urpm->{log}(N("built hdlist synthesis file for medium \"%s\"", $_->{name}));
}
}
diff --git a/urpm/cfg.pm b/urpm/cfg.pm
index 06f3c7ef..47761fec 100644
--- a/urpm/cfg.pm
+++ b/urpm/cfg.pm
@@ -24,12 +24,14 @@ urpm::cfg - routines to handle the urpmi configuration files
Reads an urpmi configuration file and returns its contents in a hash ref :
{
- 'medium name 1' => {
+ media => [
+ 'medium name 1' => {
url => 'http://...',
option => 'value',
...
- }
- '' => {
+ },
+ ],
+ global => {
# global options go here
},
}
@@ -51,9 +53,7 @@ Returns 1 on success, 0 on failure.
my ($arch, $release);
sub _init_arch_release () {
if (!$arch && !$release) {
- open my $f, '/etc/release' or return undef;
- my $l = <$f>;
- close $f;
+ my $l = cat_('/etc/release') or return undef;
($release, $arch) = $l =~ /release (\d+\.\d+).*for (\w+)/;
$release = 'cooker' if $l =~ /cooker/i;
}
@@ -103,49 +103,46 @@ sub expand_line {
return $line;
}
-sub load_config ($;$) {
+sub load_config_raw {
my ($file, $b_norewrite) = @_;
- my %config;
- my $priority = 1;
- my $medium;
+ my @blocks;
+ my $block;
$err = '';
- my @conf_lines = cat_($file) or do { $err = N("unable to read config file [%s]", $file); return };
- foreach (@conf_lines) {
+ -r $file or do {
+ $err = N("unable to read config file [%s]", $file);
+ return;
+ };
+ foreach (cat_($file)) {
chomp;
next if /^\s*#/; #- comments
s/^\s+//; s/\s+$//;
$_ = expand_line($_) unless $b_norewrite;
if ($_ eq '}') { #-{
- if (!defined $medium) {
+ if (!defined $block) {
_syntax_error();
return;
}
- $config{$medium}{priority} = $priority++ if $medium ne ''; #- to preserve order
- undef $medium;
- next;
- }
- if (defined $medium && /{$/) { #-}
+ push @blocks, $block;
+ undef $block;
+ } elsif (defined $block && /{$/) { #-}
_syntax_error();
return;
- }
- if ($_ eq '{') { #-} Entering a global block
- $medium = '';
- next;
- }
- if (/^(.*?[^\\])\s+(?:(.*?[^\\])\s+)?{$/) { #- medium definition
- $medium = unquotespace $1;
- if ($config{$medium}) {
+ } elsif ($_ eq '{') {
+ #-} Entering a global block
+ $block = { name => '' };
+ } elsif (/^(.*?[^\\])\s+(?:(.*?[^\\])\s+)?{$/) {
+ #- medium definition
+ my ($name, $url) = (unquotespace($1), unquotespace($2));
+ if (grep { $_->{name} eq $name } @blocks) {
#- hmm, somebody fudged urpmi.cfg by hand.
- $err = N("medium `%s' is defined twice, aborting", $medium);
+ $err = N("medium `%s' is defined twice, aborting", $name);
return;
}
- $config{$medium}{url} = unquotespace $2;
- next;
- }
- #- config values
- /^(hdlist
+ $block = { name => $name, url => $url };
+ } elsif (/^(hdlist
|list
|with_hdlist
+ |media_info_dir
|removable
|md5sum
|limit-rate
@@ -157,16 +154,16 @@ sub load_config ($;$) {
|retry
|default-media
|(?:curl|rsync|wget|prozilla)-options
- )\s*:\s*['"]?(.*?)['"]?$/x
- and $config{$medium}{$1} = $2, next;
- /^key[-_]ids\s*:\s*['"]?(.*?)['"]?$/
- and $config{$medium}{'key-ids'} = $1, next;
- #- positive flags
- /^(update|ignore|synthesis|noreconfigure|static|virtual)$/
- and $config{$medium}{$1} = 1, next;
- my ($no, $k, $v);
- #- boolean options
- if (($no, $k, $v) = /^(no-)?(
+ )\s*:\s*['"]?(.*?)['"]?$/x) {
+ #- config values
+ $block->{$1} = $2;
+ } elsif (/^key[-_]ids\s*:\s*['"]?(.*?)['"]?$/) {
+ $block->{'key-ids'} = $1;
+ } elsif (/^(update|ignore|hdlist|synthesis|noreconfigure|static|virtual)$/) {
+ #- positive flags
+ $block->{$1} = 1;
+ } elsif (my ($no, $k, $v) =
+ /^(no-)?(
verify-rpm
|norebuild
|fuzzy
@@ -182,49 +179,71 @@ sub load_config ($;$) {
|nopubkey
|resume)(?:\s*:\s*(.*))?$/x
) {
+ #- boolean options
my $yes = $no ? 0 : 1;
$no = $yes ? 0 : 1;
$v = '' unless defined $v;
- $config{$medium}{$k} = $v =~ /^(yes|on|1|)$/i ? $yes : $no;
- next;
+ $block->{$k} = $v =~ /^(yes|on|1|)$/i ? $yes : $no;
+ } elsif ($_ eq 'modified') {
+ #- obsolete
+ } else {
+ warn "unknown line '$_'\n" if $_;
}
- #- obsolete
- $_ eq 'modified' and next;
}
- return \%config;
+ \@blocks;
+}
+
+sub load_config {
+ my ($file) = @_;
+
+ my $blocks = load_config_raw($file);
+ my ($media, $global) = partition { $_->{name} } @$blocks;
+ ($global) = @$global;
+ delete $global->{name};
+
+ { global => $global || {}, media => $media };
}
-sub dump_config ($$) {
+sub dump_config {
my ($file, $config) = @_;
- my $config_old = load_config($file, 1);
- my @media = sort {
- return 0 if $a eq $b;
- return -1 if $a eq ''; #- global options come first
- return 1 if $b eq '';
- return $config->{$a}{priority} <=> $config->{$b}{priority} || $a cmp $b;
- } keys %$config;
+
+ my %global = (name => '', %{$config->{global}});
+
+ dump_config_raw($file, [ %global ? \%global : (), @{$config->{media}} ]);
+}
+
+sub dump_config_raw {
+ my ($file, $blocks) = @_;
+
+ my $old_blocks = load_config_raw($file, 1);
+ my $substitute_back = sub {
+ my ($m, $field) = @_;
+ my ($prev_block) = grep { $_->{name} eq $m->{name} } @$old_blocks;
+ substitute_back($m->{$field}, $prev_block && $prev_block->{$field});
+ };
+
open my $f, '>', $file or do {
$err = N("unable to write config file [%s]", $file);
return 0;
};
- foreach my $m (@media) {
- if ($m) {
- print $f quotespace($m), ' ', quotespace(substitute_back($config->{$m}{url}, $config_old->{$m}{url})), " {\n";
- } else {
- next if !keys %{$config->{''}};
- print $f "{\n";
- }
- foreach (sort grep { $_ && $_ ne 'url' } keys %{$config->{$m}}) {
+
+ foreach my $m (@$blocks) {
+ my @l = map {
if (/^(update|ignore|synthesis|noreconfigure|static|virtual)$/) {
- print $f " $_\n";
+ $_;
+ } elsif ($_ eq 'hdlist' && $m->{$_} eq '1') {
+ $_;
} elsif ($_ ne 'priority') {
- print $f " $_: " . substitute_back($config->{$m}{$_}, $config_old->{$m}{$_}) . "\n";
+ "$_: " . $substitute_back->($m, $_);
}
- }
- print $f "}\n\n";
+ } sort grep { $_ && $_ ne 'url' && $_ ne 'name' } keys %$m;
+
+ my $name_url = $m->{name} ?
+ join(' ', map { quotespace($_) } $m->{name}, $substitute_back->($m, 'url')) . ' ' : '';
+
+ print $f $name_url . "{\n", (map { " $_\n" } @l), "}\n\n";
}
- close $f;
- return 1;
+ 1;
}
#- routines to handle mirror list location
diff --git a/urpm/download.pm b/urpm/download.pm
index ceb6ffff..e4fed74c 100644
--- a/urpm/download.pm
+++ b/urpm/download.pm
@@ -617,6 +617,21 @@ sub requested_ftp_http_downloader {
} || $urpm->{global_config}{downloader};
}
+sub parse_url_with_login {
+ my ($url) = @_;
+ $url =~ m!([^:]*)://([^/:\@]*)(:([^/:\@]*))?\@([^/]*)(.*)! &&
+ { proto => $1, login => $2, password => $4, machine => $5, dir => $6 };
+}
+sub url_obscuring_password {
+ my ($url) = @_;
+ my $u = parse_url_with_login($url);
+ if ($u && $u->{password}) {
+ sprintf('%s://xxx:xxx@%s%s', $u->{proto}, $u->{machine}, $u->{dir});
+ } else {
+ $url;
+ }
+}
+
#- $medium can be undef
#- known options: quiet, resume, callback
sub sync {
@@ -632,11 +647,12 @@ sub sync {
$all_options{$cpt} = $urpm->{options}{$cpt} if defined $urpm->{options}{$cpt};
}
- $urpm->{debug}(N("retrieving %s", join(' ', @$files)));
+ my $files_text = join(' ', map { url_obscuring_password($_) } @$files);
+ $urpm->{debug} and $urpm->{debug}(N("retrieving %s", $files_text));
eval {
_sync_webfetch_raw($urpm, $files, \%all_options);
- $urpm->{log}(N("retrieved %s", join(' ', @$files)));
+ $urpm->{log}(N("retrieved %s", $files_text));
1;
};
}
diff --git a/urpm/install.pm b/urpm/install.pm
index e78f80a9..82f01b0c 100644
--- a/urpm/install.pm
+++ b/urpm/install.pm
@@ -163,7 +163,7 @@ sub install {
return unless defined $pkgid;
my $pkg = $urpm->{depslist}[$pkgid];
my $fullname = $pkg->fullname;
- my $trtype = (grep { /\Q$fullname\E/ } values %$install) ? 'install' : '(upgrade|update)';
+ my $trtype = $pkg->flag_installed ? '(upgrade|update)' : 'install';
foreach ($pkg->files) { /\bREADME(\.$trtype)?\.urpmi$/ and $readmes{$_} = $fullname }
close $fh if defined $fh;
};
@@ -176,16 +176,15 @@ sub install {
#- don't clear cache if transaction failed. We might want to retry.
if (@l == 0 && !$options{test} && $options{post_clean_cache}) {
#- examine the local cache to delete packages which were part of this transaction
- foreach (keys %$install, keys %$upgrade) {
- my $pkg = $urpm->{depslist}[$_];
- unlink "$urpm->{cachedir}/rpms/" . $pkg->filename;
- }
+ my @pkgs = map { $urpm->{depslist}[$_]->filename } keys %$install, keys %$upgrade;
+ $urpm->{log}(N("removing installed rpms (%s) from %s", join(' ', @pkgs), "$urpm->{cachedir}/rpms"));
+ unlink "$urpm->{cachedir}/rpms/$_" foreach @pkgs;
}
if ($::verbose >= 0) {
foreach (keys %readmes) {
print "-" x 70, "\n", N("More information on package %s", $readmes{$_}), "\n";
- print cat_($_);
+ print cat_(($urpm->{root} || '') . $_);
print "-" x 70, "\n";
}
}
diff --git a/urpm/lock.pm b/urpm/lock.pm
index 6c1560ca..0b9cf7f7 100644
--- a/urpm/lock.pm
+++ b/urpm/lock.pm
@@ -17,7 +17,8 @@ my ($LOCK_SH, $LOCK_EX, $LOCK_NB, $LOCK_UN) = (1, 2, 4, 8);
# - lock urpmi db in /
sub rpm_db {
my ($urpm, $b_exclusive) = @_;
- urpm::lock->new($urpm, "$urpm->{root}/$urpm->{statedir}/.RPMLOCK", 'rpm', $b_exclusive);
+ my $f = ($urpm->{root} && !$urpm->{urpmi_root} ? "$urpm->{root}/" : '') . "$urpm->{statedir}/.RPMLOCK";
+ urpm::lock->new($urpm, $f, 'rpm', $b_exclusive);
}
sub urpmi_db {
my ($urpm, $b_exclusive, $b_nofatal) = @_;
diff --git a/urpm/md5sum.pm b/urpm/md5sum.pm
index f5295190..71ccc5b5 100644
--- a/urpm/md5sum.pm
+++ b/urpm/md5sum.pm
@@ -41,7 +41,7 @@ sub compute_on_local_medium {
my ($urpm, $medium) = @_;
require urpm::media; #- help perl_checker
- my $f = urpm::media::statedir_hdlist_or_synthesis($urpm, $medium);
+ my $f = urpm::media::statedir_hdlist_or_synthesis($urpm, $medium, 's');
$urpm->{log}(N("computing md5sum of existing source hdlist (or synthesis) [%s]", $f));
-e $f && compute($f);
}
diff --git a/urpm/media.pm b/urpm/media.pm
index 4beb4268..2c27aa32 100644
--- a/urpm/media.pm
+++ b/urpm/media.pm
@@ -7,6 +7,7 @@ use urpm::msg;
use urpm::util;
use urpm::removable;
use urpm::lock;
+use MDV::Distribconf;
our @PER_MEDIA_OPT = qw(
@@ -56,18 +57,12 @@ sub read_private_netrc {
@l;
}
-sub parse_url_with_login {
- my ($url) = @_;
- $url =~ m!([^:]*)://([^/:\@]*)(:([^/:\@]*))?\@([^/]*)(.*)! &&
- { proto => $1, login => $2, password => $4, machine => $5, dir => $6 };
-}
-
sub read_config_add_passwords {
my ($urpm, $config) = @_;
my @netrc = read_private_netrc($urpm) or return;
foreach (@{$config->{media}}) {
- my $u = parse_url_with_login($_->{url}) or next;
+ my $u = urpm::download::parse_url_with_login($_->{url}) or next;
if (my ($e) = grep { ($_->{default} || $_->{machine} eq $u->{machine}) && $_->{login} eq $u->{login} } @netrc) {
$_->{url} = sprintf('%s://%s:%s@%s%s', $u->{proto}, $u->{login}, $e->{password}, $u->{machine}, $u->{dir});
} else {
@@ -81,7 +76,7 @@ sub remove_passwords_and_write_private_netrc {
my @l;
foreach (@{$config->{media}}) {
- my $u = parse_url_with_login($_->{url}) or next;
+ my $u = urpm::download::parse_url_with_login($_->{url}) or next;
#- check whether a password is visible
$u->{password} or next;
@@ -541,14 +536,14 @@ sub configure {
if ($options{media}) {
delete $_->{modified} foreach @{$urpm->{media} || []};
select_media($urpm, split /,/, $options{media});
- foreach (grep { !$_->{modified} } @{$urpm->{media} || []}) {
- _tempignore($_, 1);
+ foreach (@{$urpm->{media} || []}) {
+ _tempignore($_, !$_->{modified});
}
}
if ($options{searchmedia}) {
select_media($urpm, $options{searchmedia}); #- Ensure this media has been selected
if (my $medium = name2medium($urpm, $options{searchmedia})) {
- $medium->{ignore} and $urpm->{fatal}("searchmedia is ignored");
+ _tempignore($medium, 0);
$medium->{searchmedia} = 1;
}
}
@@ -589,7 +584,7 @@ sub _parse_media {
$need_second_pass = 1 if !$is_second_pass && !$options->{no_second_pass};
} else {
$options->{need_hdlist}
- and $urpm->{error}(N("Note: no hdlist for medium \"%s\", urpmf is unable to return any result for it", $_->{name}));
+ and $urpm->{error}(N("Note: no hdlist for medium \"%s\", unable to return any result for it", $_->{name}));
_parse_synthesis($urpm, $_, any_synthesis($urpm, $_), $options->{callback});
}
@@ -877,7 +872,7 @@ sub _probe_with_try_list {
my $url = reduce_pathname("$base/$media_info_dir") . '/' . ($synthesis ? 'synthesis.hdlist.cz' : 'hdlist.cz');
$f->($url) or return;
- $urpm->{debug}("found hdlist/synthesis: $url");
+ $urpm->{debug} and $urpm->{debug}("found hdlist/synthesis: $url");
$medium->{media_info_dir} = $media_info_dir;
if ($probe_with) {
@@ -1684,7 +1679,7 @@ sub _update_medium_first_pass {
my @unresolved_after = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}};
if (@unresolved_before != @unresolved_after) {
$medium->{need_second_pass} = 1;
- $urpm->{debug}(sprintf qq(medium "%s" has unresolved dependencies: %s),
+ $urpm->{debug} and $urpm->{debug}(sprintf qq(medium "%s" has unresolved dependencies: %s),
$medium->{name},
join(' ', difference2(\@unresolved_after, \@unresolved_before)));
}
diff --git a/urpm/msg.pm b/urpm/msg.pm
index 2944f85c..e8a1a503 100644
--- a/urpm/msg.pm
+++ b/urpm/msg.pm
@@ -5,44 +5,58 @@ package urpm::msg;
use strict;
no warnings;
use Exporter;
+use URPM;
+
+BEGIN {
+ eval { require encoding };
+ eval "use open ':locale'" if eval { encoding::_get_locale_encoding() ne 'ANSI_X3.4-1968' };
+}
(our $VERSION) = q($Revision$) =~ /(\d+)/;
our @ISA = 'Exporter';
-our @EXPORT = qw(N bug_log to_utf8 message_input toMb from_utf8 sys_log);
+our @EXPORT = qw(N P translate bug_log message_input toMb sys_log);
#- I18N.
use Locale::gettext;
-use POSIX qw(LC_ALL);
-POSIX::setlocale(LC_ALL, "");
-Locale::gettext::textdomain("urpmi");
-
-my $codeset; #- encoding of the current locale
-eval {
- require I18N::Langinfo;
- I18N::Langinfo->import(qw(langinfo CODESET));
- $codeset = langinfo(CODESET()); # note the ()
-};
-defined $codeset or eval {
- (undef, $codeset) = `/usr/bin/locale -c charmap`;
- chomp $codeset;
-};
-
-sub from_utf8_full { Locale::gettext::iconv($_[0], "UTF-8", $codeset) }
-sub from_utf8_dummy { $_[0] }
-
-our $use_utf8_full = defined $codeset && $codeset eq 'UTF-8';
+use POSIX();
+POSIX::setlocale(POSIX::LC_ALL(), "");
+my @textdomains = qw(urpmi rpm-summary-main rpm-summary-contrib rpm-summary-devel);
+foreach my $domain (@textdomains) {
+ Locale::gettext::bind_textdomain_codeset($domain, 'UTF-8');
+}
+URPM::bind_rpm_textdomain_codeset();
+
+our $no_translation;
+
+sub translate {
+ my ($s, $o_plural, $o_nb) = @_;
+ my $res;
+ if ($no_translation) {
+ $s;
+ } elsif ($o_nb) {
+ foreach my $domain (@textdomains) {
+ eval { $res = Locale::gettext::dngettext($domain, $s || '', $o_plural, $o_nb) || $s };
+ return $res if $s ne $res;
+ }
+ return $s;
+ } else {
+ foreach my $domain (@textdomains) {
+ eval { $res = Locale::gettext::dgettext($domain, $s || '') || $s };
+ return $res if $s ne $res;
+ }
+ return $s;
+ }
+}
-sub from_utf8 { $use_utf8_full ? &from_utf8_full : &from_utf8_dummy }
+sub P {
+ my ($s_singular, $s_plural, $nb, @para) = @_;
+ sprintf(translate($s_singular, $s_plural, $nb), @para);
+}
sub N {
my ($format, @params) = @_;
- my $s = sprintf(
- eval { Locale::gettext::gettext($format || '') } || $format,
- @params,
- );
- utf8::decode($s) unless $use_utf8_full;
- $s;
+ sprintf(translate($format), @params);
}
my $noexpr = N("Nn");
@@ -50,13 +64,19 @@ my $yesexpr = N("Yy");
eval {
require Sys::Syslog;
- Sys::Syslog->import();
+ Sys::Syslog->import;
(my $tool = $0) =~ s!.*/!!;
+
+ #- what we really want is "unix" (?)
+ #- we really don't want "console" which forks/exit and thus
+ # run callbacks registered through atexit() : x11, gtk+, rpm, ...
+ Sys::Syslog::setlogsock([ 'tcp', 'unix', 'stream' ]);
+
openlog($tool, '', 'user');
END { defined &closelog and closelog() }
};
-sub sys_log { defined &syslog and syslog("info", @_) }
+sub sys_log { defined &syslog and eval { syslog("info", @_) } }
#- writes only to logfile, not to screen
sub bug_log {
@@ -68,8 +88,6 @@ sub bug_log {
}
}
-sub to_utf8 { Locale::gettext::iconv($_[0], undef, "UTF-8") }
-
sub message_input {
my ($msg, $o_default_input, %o_opts) = @_;
my $input;
diff --git a/urpm/select.pm b/urpm/select.pm
index aa8a9726..4b6f90a8 100644
--- a/urpm/select.pm
+++ b/urpm/select.pm
@@ -16,10 +16,10 @@ sub _findindeps {
/$qv/ || !$caseinsensitive && /$qv/i or next;
my @list = grep { defined $_ } map {
- my $pkg = $urpm->{depslist}[$_];
+ my $pkg = $_;
$pkg && ($src ? $pkg->arch eq 'src' : $pkg->arch ne 'src')
? $pkg->id : undef;
- } keys %{$urpm->{provides}{$_} || {}};
+ } $urpm->packages_providing($_);
@list > 0 and push @{$found->{$v}}, join '|', @list;
}
}
@@ -49,9 +49,7 @@ sub search_packages {
$urpm->{searchmedia}{start} <= $_->id
&& $urpm->{searchmedia}{end} >= $_->id)
? $_ : @{[]};
- } map {
- $urpm->{depslist}[$_];
- } keys %{$urpm->{provides}{$v} || {}})
+ } $urpm->packages_providing($v))
{
#- we assume that if there is at least one package providing
#- the resource exactly, this should be the best one; but we
@@ -194,33 +192,44 @@ sub resolve_dependencies {
start => $urpm->{searchmedia}{start}, end => $urpm->{searchmedia}{end});
}
- #- resolve dependencies which will be examined for packages that need to
- #- have urpmi restarted when they're updated.
- $urpm->resolve_requested($db, $state, $requested, %options);
+ my @priority_upgrade;
+ my $resolve_priority_upgrades = sub {
+ my ($selected, $priority_requested) = @_;
+
+ my %priority_state;
+
+ $urpm->resolve_requested($db, \%priority_state, $priority_requested, %options);
+ if (grep { ! exists $priority_state{selected}{$_} } keys %$priority_requested) {
+ #- some packages which were selected previously have not been selected, strange!
+ } elsif (grep { ! exists $priority_state{selected}{$_} } keys %$selected) {
+ #- there are other packages to install after this priority transaction.
+ %$state = %priority_state;
+ $need_restart = 1;
+ }
+ };
if ($options{priority_upgrade} && !$options{rpmdb}) {
- my (%priority_upgrade, %priority_requested);
- @priority_upgrade{split /,/, $options{priority_upgrade}} = ();
-
- #- check if a priority upgrade should be tried
- foreach (keys %{$state->{selected}}) {
- my $pkg = $urpm->{depslist}[$_] or next;
- exists $priority_upgrade{$pkg->name} or next;
- $priority_requested{$pkg->id} = undef;
+ @priority_upgrade = map {
+ $urpm->packages_by_name($_);
+ } split(/,/, $options{priority_upgrade});
+
+ #- first check if a priority_upgrade package is requested
+ #- (it should catch all occurences in --auto-select mode)
+ #- (nb: a package "foo" may appear twice, and only one will be set flag_upgrade)
+ if (my @l = grep { $_->flag_upgrade } @priority_upgrade) {
+ my %priority_requested = map { $_->id => undef } @l;
+ $resolve_priority_upgrades->($requested, \%priority_requested);
}
+ }
- if (%priority_requested) {
- my %priority_state;
-
- $urpm->resolve_requested($db, \%priority_state, \%priority_requested, %options);
- if (grep { ! exists $priority_state{selected}{$_} } keys %priority_requested) {
- #- some packages which were selected previously have not been selected, strange!
- $need_restart = 0;
- } elsif (grep { ! exists $priority_state{selected}{$_} } keys %{$state->{selected}}) {
- #- there are other packages to install after this priority transaction.
- %$state = %priority_state;
- $need_restart = 1;
- }
+ if (!$need_restart) {
+ $urpm->resolve_requested($db, $state, $requested, %options);
+
+ #- now check if a priority_upgrade package has been required
+ #- by a requested package
+ if (my @l = grep { $state->{selected}{$_->id} } @priority_upgrade) {
+ my %priority_requested = map { $_->id => undef } @l;
+ $resolve_priority_upgrades->($state->{selected}, \%priority_requested);
}
}
}
@@ -409,7 +418,9 @@ sub translate_why_removed {
sub translate_why_removed_one {
my ($urpm, $state, $fullname) = @_;
- my $closure = $state->{rejected}{$fullname}{closure};
+ my $closure = $state->{rejected} && $state->{rejected}{$fullname} && $state->{rejected}{$fullname}{closure}
+ or return $fullname;
+
my ($from) = keys %$closure;
my ($whyk) = keys %{$closure->{$from}};
my $whyv = $closure->{$from}{$whyk};
diff --git a/urpm/util.pm b/urpm/util.pm
index b12c49a0..e6e91dca 100644
--- a/urpm/util.pm
+++ b/urpm/util.pm
@@ -8,10 +8,11 @@ our @ISA = 'Exporter';
our @EXPORT = qw(quotespace unquotespace
remove_internal_name
reduce_pathname offset_pathname
- md5sum untaint
+ untaint
copy_and_own
same_size_and_mtime
- difference2 member file_size cat_ dirname basename
+ partition uniq
+ difference2 member file_size cat_ cat_utf8 dirname basename
);
(our $VERSION) = q($Revision$) =~ /(\d+)/;
@@ -87,21 +88,6 @@ sub untaint {
@r == 1 ? $r[0] : @r;
}
-sub md5sum {
- my ($file) = @_;
- eval { require Digest::MD5 };
- if ($@) {
- #- Use an external command to avoid depending on perl
- return (split ' ', `/usr/bin/md5sum '$file'`)[0];
- } else {
- my $ctx = Digest::MD5->new;
- open my $fh, $file or return '';
- $ctx->addfile($fh);
- close $fh;
- return $ctx->hexdigest;
- }
-}
-
sub copy {
my ($file, $dest) = @_;
!system("/bin/cp", "-p", "-L", "-R", $file, $dest);
@@ -130,9 +116,20 @@ sub same_size_and_mtime {
$sstat[7] == $lstat[7] && $sstat[9] == $lstat[9];
}
+sub partition(&@) {
+ my $f = shift;
+ my (@a, @b);
+ foreach (@_) {
+ $f->($_) ? push(@a, $_) : push(@b, $_);
+ }
+ \@a, \@b;
+}
+
+sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
sub cat_ { my @l = map { my $F; open($F, '<', $_) ? <$F> : () } @_; wantarray() ? @l : join '', @l }
+sub cat_utf8 { my @l = map { my $F; open($F, '<:utf8', $_) ? <$F> : () } @_; wantarray() ? @l : join '', @l }
1;