diff options
Diffstat (limited to 'urpm')
| -rw-r--r-- | urpm/args.pm | 13 | ||||
| -rw-r--r-- | urpm/bug_report.pm | 3 | ||||
| -rw-r--r-- | urpm/cfg.pm | 157 | ||||
| -rw-r--r-- | urpm/download.pm | 20 | ||||
| -rw-r--r-- | urpm/install.pm | 11 | ||||
| -rw-r--r-- | urpm/lock.pm | 3 | ||||
| -rw-r--r-- | urpm/md5sum.pm | 2 | ||||
| -rw-r--r-- | urpm/media.pm | 23 | ||||
| -rw-r--r-- | urpm/msg.pm | 80 | ||||
| -rw-r--r-- | urpm/select.pm | 69 | ||||
| -rw-r--r-- | urpm/util.pm | 31 |
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; |