summaryrefslogtreecommitdiffstats
path: root/urpm.pm
diff options
context:
space:
mode:
Diffstat (limited to 'urpm.pm')
-rw-r--r--urpm.pm1135
1 files changed, 464 insertions, 671 deletions
diff --git a/urpm.pm b/urpm.pm
index 08c9cbc2..241dabbc 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -3,7 +3,8 @@ package urpm;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '3.3';
+$VERSION = '3.4';
+@ISA = qw(URPM);
=head1 NAME
@@ -31,7 +32,7 @@ urpm - Mandrake perl tools to handle urpmi database
$urpm->parse_synthesis($_);
}
if (@files) {
- push @names, $urpm->register_local_packages(@files);
+ push @names, $urpm->register_rpms(@files);
}
$urpm->relocate_depslist_provides();
@@ -69,8 +70,8 @@ on a Linux-Mandrake distribution.
=head1 SEE ALSO
-rpmtools package is used to manipulate at a lower level hdlist and rpm
-files.
+perl-URPM (obsolete rpmtools) package is used to manipulate at a lower
+level hdlist and rpm files.
=head1 COPYRIGHT
@@ -92,7 +93,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
=cut
-use rpmtools;
+use URPM;
use POSIX;
use Locale::GetText;
@@ -115,7 +116,9 @@ sub new {
statedir => "/var/lib/urpmi",
cachedir => "/var/cache/urpmi",
media => undef,
- params => new rpmtools('sense', 'conflicts', 'obsoletes'),
+
+ provides => {},
+ depslist => [],
sync => \&sync_webfetch, #- first argument is directory, others are url to fetch.
@@ -425,6 +428,33 @@ sub write_config {
delete $urpm->{modified};
}
+#- read urpmi.cfg file as well as synthesis file needed.
+sub configure {
+ my ($urpm, %options) = @_;
+
+ $urpm->clean;
+ $urpm->read_config(%options);
+ if ($options{media}) {
+ $urpm->select_media(split ',', $options{media});
+ foreach (grep { !$_->{modified} } @{$urpm->{media} || []}) {
+ #- this is only a local ignore that will not be saved.
+ $_->{ignore} = 1;
+ }
+ }
+ foreach (grep { !$_->{ignore} && (!$options{update} || $_->{update}) } @{$urpm->{media} || []}) {
+ $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$_->{hdlist}"));
+ ($_->{start}, $_->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$_->{hdlist}");
+ }
+
+ if ($options{files}) {
+ #- build closure with local package and return list of names.
+ $urpm->register_rpms(@{$options{files}});
+ }
+
+ #- relocate depslist.
+ $urpm->relocate_depslist_provides();
+}
+
#- add a new medium, sync the config file accordingly.
sub add_medium {
my ($urpm, $name, $url, $with_hdlist, %options) = @_;
@@ -597,38 +627,6 @@ sub remove_selected_media {
$urpm->{media} = \@result;
}
-sub build_synthesis_hdlist {
- my ($urpm, $medium, $use_parsehdlist) = @_;
-
- unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
- unless ($use_parsehdlist) {
- #- building synthesis file using internal params.
- local *F;
- open F, "| gzip >'$urpm->{statedir}/synthesis.$medium->{hdlist}'";
- foreach my $p (@{$medium->{depslist}}) {
- foreach (qw(provides requires conflicts obsoletes)) {
- @{$p->{$_} || []} and print F join('@', $p->{name}, $_, @{$p->{$_} || []}) . "\n";
- }
- print F join('@',
- $p->{name}, 'info', "$p->{name}-$p->{version}-$p->{release}.$p->{arch}",
- $p->{serial} || 0, $p->{size} || 0, $p->{group}, $p->{file} ? ($p->{file}) : ()). "\n";
- }
- close F or unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
- }
- if (-s "$urpm->{statedir}/synthesis.$medium->{hdlist}" <= 32) {
- #- building synthesis file using parsehdlist output, need 4.0-1mdk or above.
- $use_parsehdlist or $urpm->{error}(_("unable to build hdlist synthesis, using parsehdlist method"));
- if (system "parsehdlist --synthesis '$urpm->{statedir}/$medium->{hdlist}' | gzip >'$urpm->{statedir}/synthesis.$medium->{hdlist}'") {
- unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
- $urpm->{error}(_("unable to build synthesis file for medium \"%s\"", $medium->{name}));
- return;
- }
- }
- $urpm->{log}(_("built hdlist synthesis file for medium \"%s\"", $medium->{name}));
- delete $medium->{modified_synthesis};
- 1;
-}
-
#- update urpmi database regarding the current configuration.
#- take care of modification and try some trick to bypass
#- computational of base files.
@@ -640,13 +638,20 @@ sub build_synthesis_hdlist {
#- noclean -> keep header directory cleaned.
sub update_media {
my ($urpm, %options) = @_; #- do not trust existing hdlist and try to recompute them.
+ my ($cleaned_cache);
- #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
- my ($LOCK_EX, $LOCK_NB, $LOCK_UN) = (2, 4, 8);
+ #- take care of some options.
+ $cleaned_cache = !$options{noclean};
#- avoid trashing existing configuration in this case.
$urpm->{media} or return;
+ #- now we need additional methods not defined by default in URPM.
+ require URPM::Build;
+
+ #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
+ my ($LOCK_EX, $LOCK_NB, $LOCK_UN) = (2, 4, 8);
+
#- lock urpmi database.
local (*LOCK_FILE);
open LOCK_FILE, $urpm->{statedir};
@@ -655,6 +660,7 @@ sub update_media {
#- examine each medium to see if one of them need to be updated.
#- if this is the case and if not forced, try to use a pre-calculated
#- hdlist file else build it from rpms files.
+ $urpm->clean;
foreach my $medium (@{$urpm->{media}}) {
#- take care of modified medium only or all if all have to be recomputed.
$medium->{ignore} and next;
@@ -663,7 +669,21 @@ sub update_media {
-s "$urpm->{statedir}/synthesis.$medium->{hdlist}" > 32 or $medium->{modified_synthesis} = 1;
#- but do not take care of removable media for all.
- $medium->{modified} ||= $options{all} && $medium->{url} !~ /removable/ or next;
+ $medium->{modified} ||= $options{all} && $medium->{url} !~ /removable/;
+ unless ($medium->{modified}) {
+ #- the medium is not modified, but for computing dependencies,
+ #- we still need to read it and all synthesis will be written if
+ #- a unresolved provides is found.
+ #- to speed up the process, we only read the synthesis at the begining.
+ $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
+ my ($test_id, undef) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
+ unless (defined $test_id) {
+ #- this is almost a fatal error, ignore it by default?
+ $urpm->{error}(_("problem reading synthesis file of medium \"%s\"", $medium->{name}));
+ $medium->{ignore} = 1;
+ }
+ next;
+ }
#- list of rpm files for this medium, only available for local medium where
#- the source hdlist is not used (use force).
@@ -735,6 +755,13 @@ sub update_media {
#- the two files are considered equal here, the medium is so not modified.
$medium->{modified} = 0;
unlink "$urpm->{cachedir}/partial/$medium->{hdlist}";
+ #- as previously done, just read synthesis file here, this is enough.
+ $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
+ my ($test_id, undef) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
+ unless (defined $test_id) {
+ $urpm->{error}(_("problem reading synthesis file of medium \"%s\"", $medium->{name}));
+ $medium->{ignore} = 1;
+ }
next;
}
}
@@ -762,11 +789,15 @@ sub update_media {
if (@files > 0) {
#- we need to rebuild from rpm files the hdlist.
eval {
- $urpm->{log}(_("building hdlist [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}"));
- $urpm->{params}->build_hdlist($options{noclean}, $options{ratio} || 4, "$urpm->{cachedir}/headers",
- "$urpm->{cachedir}/partial/$medium->{hdlist}", @files);
+ $urpm->{log}(_("reading rpms files from [%s]", $dir));
+ $medium->{headers} = [ $urpm->parse_rpms_build_headers(dir => "$urpm->{cachedir}/headers",
+ rpms => \@files,
+ clean => $cleaned_cache,
+ ) ];
+ $cleaned_cache = 0; #- make sure the headers will not be removed for another media.
};
- $@ and $error = 1, $urpm->{error}(_("unable to build hdlist: %s", $@));
+ $@ and $error = 1, $urpm->{error}(_("unable to read rpms files from [%s]: %s", $dir, $@));
+ $error and delete $medium->{headers}; #- do not propagate these.
$error or delete $medium->{synthesis}; #- when building hdlist by ourself, drop synthesis property.
} else {
$error = 1;
@@ -847,6 +878,13 @@ sub update_media {
#- the two files are considered equal here, the medium is so not modified.
$medium->{modified} = 0;
unlink "$urpm->{cachedir}/partial/$basename";
+ #- as previously done, just read synthesis file here, this is enough.
+ $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
+ my ($test_id, undef) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
+ unless (defined $test_id) {
+ $urpm->{error}(_("problem reading synthesis file of medium \"%s\"", $medium->{name}));
+ $medium->{ignore} = 1;
+ }
next;
}
}
@@ -874,7 +912,7 @@ sub update_media {
}
#- build list file according to hdlist used.
- unless (-s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 32) {
+ unless ($medium->{headers} || -s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 32) {
$error = 1;
$urpm->{error}(_("no hdlist file found for medium \"%s\"", $medium->{name}));
}
@@ -883,44 +921,54 @@ sub update_media {
unless ($error) {
#- sort list file contents according to id.
my %list;
- if (@files) {
+ if ($medium->{headers}) {
+ #- rpm files have already been read (first pass), there is just a need to
+ #- build list hash.
foreach (@files) {
- /\/([^\/]*)-[^-\/]*-[^-\/]*\.[^\/]*\.rpm/;
- $list{"$prefix:/$_\n"} = ($urpm->{params}{names}{$1} || { id => 1000000000 })->{id};
+ /\/([^\/]*\.rpm)$/ or next;
+ $list{$1} and $urpm->{error}(_("file [%s] already used in the same medium \"%s\"", $1, $medium->{name})), next;
+ $list{$1} = "$prefix:/$_\n";
}
} else {
- local (*F, $_);
- my %filename2pathname;
- if ($medium->{hdlist} ne 'list' && -s "$urpm->{cachedir}/partial/list") {
- open F, "$urpm->{cachedir}/partial/list";
- while (<F>) {
- /\/([^\/]*)\.rpm$/ and $filename2pathname{$1} = "$medium->{url}/$_";
+ #- read first pass hdlist or synthesis, try to open as synthesis, if file
+ #- is larger than 1MB, this is problably an hdlist else a synthesis.
+ #- anyway, if one tries fails, try another mode.
+ my ($start, $end);
+ if (-s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 1048576) {
+ ($start, $end) = $urpm->parse_hdlist("$urpm->{cachedir}/partial/$medium->{hdlist}", 1);
+ if (defined $start && defined $end) {
+ delete $medium->{synthesis};
+ } else {
+ ($start, $end) = $urpm->parse_synthesis("$urpm->{cachedir}/partial/$medium->{hdlist}");
+ defined $start && defined $end and $medium->{synthesis} = 1;
}
- close F;
- }
- unless ($medium->{synthesis}) {
- open F, "parsehdlist --silent --name '$urpm->{cachedir}/partial/$medium->{hdlist}' |";
- while (<F>) {
- /^([^\/]*):name:([^\/\s:]*)(?::(.*)\.rpm)?$/ or next;
- $list{$filename2pathname{$3 || $2} ||
- "$medium->{url}/". ($3 || $2) .".rpm\n"} = ($urpm->{params}{names}{$1} ||
- { id => 1000000000 })->{id};
+ } else {
+ ($start, $end) = $urpm->parse_synthesis("$urpm->{cachedir}/partial/$medium->{hdlist}");
+ if (defined $start && defined $end) {
+ $medium->{synthesis} = 1;
+ } else {
+ ($start, $end) = $urpm->parse_hdlist("$urpm->{cachedir}/partial/$medium->{hdlist}", 1);
+ defined $start && defined $end and delete $medium->{synthesis};
}
- close F or $medium->{synthesis} = 1; #- try hdlist as a synthesis (for probe)
}
- if ($medium->{synthesis}) {
- if (my @founds = $urpm->parse_synthesis($medium, filename => "$urpm->{cachedir}/partial/$medium->{hdlist}")) {
- #- it appears hdlist file is a synthesis one in fact.
- #- parse_synthesis returns all full name of package read from it.
- foreach (@founds) {
- my $fullname = "$_->{name}-$_->{version}-$_->{release}.$_->{arch}";
- $list{$filename2pathname{$_->{file} || $fullname} ||
- "$medium->{url}/". ($_->{file} || $fullname) .".rpm\n"} = ($urpm->{params}{names}{$_->{name}} ||
- { id => 1000000000 })->{id};
+ defined $start && defined $end or
+ $error = 1, $urpm->{error}(_("unable to parse hdlist file of \"%s\"", $medium->{name}));
+
+ unless ($error) {
+ if ($medium->{hdlist} ne 'list' && -s "$urpm->{cachedir}/partial/list") {
+ local (*F, $_);
+ open F, "$urpm->{cachedir}/partial/list";
+ while (<F>) {
+ /\/([^\/]*\.rpm)$/ or next;
+ $list{$1} and $urpm->{error}(_("file [%s] already used in the same medium \"%s\"", $1, $medium->{name})), next;
+ $list{$1} = "$medium->{url}/$_";
}
+ close F;
} else {
- $error = 1, $urpm->{error}(_("unable to parse hdlist file of \"%s\"", $medium->{name}));
- delete $medium->{synthesis}; #- make sure synthesis property is no more set.
+ foreach ($start .. $end) {
+ my $filename = $urpm->{depslist}[$_]->filename;
+ $list{$filename} = "$medium->{url}/$_";
+ }
}
}
}
@@ -928,18 +976,20 @@ sub update_media {
#- check there is something found.
%list or $error = 1, $urpm->{error}(_("nothing to write in list file for \"%s\"", $medium->{name}));
- #- write list file.
- local *LIST;
- my $mask = umask 077;
- open LIST, ">$urpm->{cachedir}/partial/$medium->{list}"
- or $error = 1, $urpm->{error}(_("unable to write list file of \"%s\"", $medium->{name}));
- umask $mask;
- print LIST sort { $list{$a} <=> $list{$b} } keys %list;
- close LIST;
-
- #- check if at least something has been written into list file.
- -s "$urpm->{cachedir}/partial/$medium->{list}" > 32 or
- $error = 1, $urpm->{error}(_("nothing written in list file for \"%s\"", $medium->{name}));
+ unless ($error) {
+ #- write list file.
+ local *LIST;
+ my $mask = umask 077;
+ open LIST, ">$urpm->{cachedir}/partial/$medium->{list}"
+ or $error = 1, $urpm->{error}(_("unable to write list file of \"%s\"", $medium->{name}));
+ umask $mask;
+ print LIST values %list;
+ close LIST;
+
+ #- check if at least something has been written into list file.
+ -s "$urpm->{cachedir}/partial/$medium->{list}" > 32 or
+ $error = 1, $urpm->{error}(_("nothing written in list file for \"%s\"", $medium->{name}));
+ }
}
if ($error) {
@@ -955,73 +1005,69 @@ sub update_media {
unlink "$urpm->{statedir}/$medium->{hdlist}";
$medium->{synthesis} and unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
unlink "$urpm->{statedir}/$medium->{list}";
- rename("$urpm->{cachedir}/partial/$medium->{hdlist}", $medium->{synthesis} ?
- "$urpm->{statedir}/synthesis.$medium->{hdlist}" : "$urpm->{statedir}/$medium->{hdlist}") or
- system("mv", "$urpm->{cachedir}/partial/$medium->{hdlist}", $medium->{synthesis} ?
- "$urpm->{statedir}/synthesis.$medium->{hdlist}" :
- "$urpm->{statedir}/$medium->{hdlist}");
+ unless ($medium->{headers}) {
+ rename("$urpm->{cachedir}/partial/$medium->{hdlist}", $medium->{synthesis} ?
+ "$urpm->{statedir}/synthesis.$medium->{hdlist}" : "$urpm->{statedir}/$medium->{hdlist}") or
+ system("mv", "$urpm->{cachedir}/partial/$medium->{hdlist}", $medium->{synthesis} ?
+ "$urpm->{statedir}/synthesis.$medium->{hdlist}" :
+ "$urpm->{statedir}/$medium->{hdlist}");
+ }
rename("$urpm->{cachedir}/partial/$medium->{list}", "$urpm->{statedir}/$medium->{list}") or
system("mv", "$urpm->{cachedir}/partial/$medium->{list}", "$urpm->{statedir}/$medium->{list}");
#- and create synthesis file associated.
$medium->{modified_synthesis} = !$medium->{synthesis};
- #$medium->{synthesis} or $medium->{modified_synthesis} = 1;
}
}
- #- build synthesis files once requires/files have been matched by rpmtools::read_hdlists.
- if (my @rebuild_synthesis = grep { $_->{modified_synthesis} && !$_->{modified} } @{$urpm->{media}}) {
- #- cleaning whole data structures (params and per media).
- $urpm->{log}(_("examining whole urpmi database"));
- $urpm->clean;
-
- foreach my $medium (@{$urpm->{media} || []}) {
- $medium->{ignore} || $medium->{modified} and next;
- if ($medium->{synthesis}) {
- #- reading the synthesis allow to propagate requires to files, so that if an hdlist can have them...
- $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
- $urpm->parse_synthesis($medium, examine_requires => 1);
- } else {
- $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
- $urpm->{params}->read_hdlists("$urpm->{statedir}/$medium->{hdlist}");
- }
- }
+ #- check if some unresolved provides may force to rebuild all synthesis,
+ #- in any cases, two pass will be done.
+ my $force_rebuild_all_synthesis = $urpm->unresolved_provides_clean > 0;
- $urpm->{log}(_("keeping only files referenced in provides"));
- $urpm->{params}->keep_only_cleaned_provides_files();
- foreach my $medium (@{$urpm->{media} || []}) {
- $medium->{ignore} || $medium->{modified} and next;
- unless ($medium->{synthesis}) {
- $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
- my @fullnames = $urpm->{params}->read_hdlists("$urpm->{statedir}/$medium->{hdlist}");
- while (!@fullnames) {
- $urpm->{error}(_("problem reading hdlist file, trying again"));
- @fullnames = $urpm->{params}->read_hdlists("$urpm->{statedir}/$medium->{hdlist}");
- }
- $medium->{depslist} = [];
- push @{$medium->{depslist}}, $urpm->{params}{info}{$_} foreach @fullnames;
- }
- }
+ #- second pass consist of reading again synthesis or hdlist.
+ foreach my $medium (@{$urpm->{media}}) {
+ #- take care of modified medium only or all if all have to be recomputed.
+ $medium->{ignore} and next;
- #- restore provided file in each packages.
- #- this is the only operation not done by reading hdlist.
- foreach my $file (keys %{$urpm->{params}{provides}}) {
- $file =~ /^\// or next;
- foreach (keys %{$urpm->{params}{provides}{$file} || {}}) {
- eval { push @{$urpm->{params}{info}{$_}{provides}}, $file }; #- HACK
+ #- a modified medium is an invalid medium, we have to read back the previous hdlist
+ #- or synthesis which has not been modified by first pass above.
+ if ($medium->{headers} && !$medium->{modified}) {
+ $urpm->{log}(_("reading headers from medium \"%s\"", $medium->{name}));
+ ($medium->{start}, $medium->{end}) = $urpm->parse_headers(dir => "$urpm->{cachedir}/headers",
+ headers => $medium->{headers},
+ );
+ $urpm->{log}(_("building hdlist [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
+ #- finish building operation of hdlist.
+ $urpm->build_hdlist(start => $medium->{start},
+ end => $medium->{end},
+ dir => "$urpm->{cachedir}/headers",
+ hdlist => "$urpm->{statedir}/$medium->{hdlist}",
+ );
+ #- synthesis need to be created for sure, since the medium has been built from rpm files.
+ $urpm->build_synthesis(start => $medium->{start},
+ end => $medium->{end},
+ synthesis => "$urpm->{statedir}/synthesis.$medium->{hdlist}",
+ );
+ $urpm->{log}(_("built hdlist synthesis file for medium \"%s\"", $medium->{name}));
+ #- keep in mind we have modified database, sure at this point.
+ $urpm->{modified} = 1;
+ } elsif ($medium->{synthesis}) {
+ $urpm->{log}(_("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
+ ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
+ } else {
+ $urpm->{log}(_("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
+ ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$medium->{hdlist}", 1);
+ #- check if synthesis file can be built.
+ if (($force_rebuild_all_synthesis || $medium->{modified_synthesis}) && !$medium->{modified}) {
+ $urpm->build_synthesis(start => $medium->{start},
+ end => $medium->{end},
+ synthesis => "$urpm->{statedir}/synthesis.$medium->{hdlist}",
+ );
+ $urpm->{log}(_("built hdlist synthesis file for medium \"%s\"", $medium->{name}));
+ #- keep in mind we have modified database, sure at this point.
+ $urpm->{modified} = 1;
}
}
-
- #- this is necessary to give id at least.
- $urpm->{params}->compute_id;
-
- #- rebuild all synthesis hdlist which need to be updated.
- foreach (@rebuild_synthesis) {
- $urpm->build_synthesis_hdlist($_);
- }
-
- #- keep in mind we have modified database, sure at this point.
- $urpm->{modified} = 1;
}
#- clean headers cache directory to remove everything that is no more
@@ -1029,19 +1075,19 @@ sub update_media {
if ($urpm->{modified}) {
if ($options{noclean}) {
local (*D, $_);
- my %arch;
+ my %headers;
opendir D, "$urpm->{cachedir}/headers";
while (defined($_ = readdir D)) {
- /^([^\/]*)-([^-]*)-([^-]*)\.([^\.]*)$/ and $arch{"$1-$2-$3"} = $4;
+ /^([^\/]*-[^-]*-[^-]*\.[^\.]*)(?::\S*)?$/ and $headers{$1} = $_;
}
closedir D;
- $urpm->{log}(_("found %d headers in cache", scalar(keys %arch)));
- foreach (@{$urpm->{params}{depslist}}) {
- delete $arch{"$_->{name}-$_->{version}-$_->{release}"};
+ $urpm->{log}(_("found %d headers in cache", scalar(keys %headers)));
+ foreach (@{$urpm->{depslist}}) {
+ delete $headers{$_->fullname};
}
- $urpm->{log}(_("removing %d obsolete headers in cache", scalar(keys %arch)));
- foreach (keys %arch) {
- unlink "$urpm->{cachedir}/headers/$_.$arch{$_}";
+ $urpm->{log}(_("removing %d obsolete headers in cache", scalar(keys %headers)));
+ foreach (values %headers) {
+ unlink "$urpm->{cachedir}/headers/$_";
}
}
@@ -1061,9 +1107,13 @@ sub update_media {
sub clean {
my ($urpm) = @_;
- $urpm->{params}->clean();
+ $urpm->{depslist} = [];
+ $urpm->{provides} = {};
+ $urpm->{names} = {};
+
foreach (@{$urpm->{media} || []}) {
- $_->{depslist} = [];
+ delete $_->{start};
+ delete $_->{end};
}
}
@@ -1195,55 +1245,7 @@ sub try_umounting {
#- reorder info hashes to give only access to best packages.
sub relocate_depslist_provides {
my ($urpm, %options) = @_;
- my $relocated_entries = 0;
-
- #- reset names hash now, will be filled after.
- $urpm->{params}{names} = {};
-
- foreach (@{$urpm->{params}{depslist} || []}) {
- my $fullname = "$_->{name}-$_->{version}-$_->{release}.$_->{arch}";
-
- #- remove access to info if arch is incompatible and only
- #- take into account compatible arch to examine.
- #- set names hash by prefering first better version,
- #- then better release, then better arch.
- if (rpmtools::compat_arch($_->{arch})) {
- my $p = $urpm->{params}{names}{$_->{name}};
- if ($p) {
- my $cmp_version = $_->{serial} == $p->{serial} && rpmtools::version_compare($_->{version}, $p->{version});
- my $cmp_release = $cmp_version == 0 && rpmtools::version_compare($_->{release}, $p->{release});
- if ($_->{serial} > $p->{serial} || $cmp_version > 0 || $cmp_release > 0 ||
- ($_->{serial} == $p->{serial} && $cmp_version == 0 && $cmp_release == 0 &&
- rpmtools::better_arch($_->{arch}, $p->{arch}))) {
- $urpm->{params}{names}{$_->{name}} = $_;
- ++$relocated_entries;
- }
- } else {
- $urpm->{params}{names}{$_->{name}} = $_;
- }
- } elsif ($_->{arch} ne 'src') {
- #- the package is removed, make it invisible (remove id).
- delete $_->{id};
-
- #- the architecture is not compatible, this means the package is dropped.
- #- we have to remove its reference in provides.
- foreach (@{$_->{provides} || []}) {
- delete $urpm->{provides}{$_}{$fullname};
- }
- }
- }
-
- #- relocate id used in depslist array, delete id if the package
- #- should NOT be used.
- #- if no entries have been relocated, we can safely avoid this computation.
- if ($relocated_entries) {
- foreach (@{$urpm->{params}{depslist}}) {
- unless ($_->{source}) { #- hack to avoid losing local package.
- my $p = $urpm->{params}{names}{$_->{name}} or next;
- $_->{id} = $p->{id};
- }
- }
- }
+ my $relocated_entries = $urpm->relocate_depslist;
$urpm->{log}($relocated_entries ?
_("relocated %s entries in depslist", $relocated_entries) :
@@ -1252,29 +1254,25 @@ sub relocate_depslist_provides {
}
#- register local packages for being installed, keep track of source.
-sub register_local_packages {
+sub register_rpms {
my ($urpm, @files) = @_;
- my ($error, @names);
+ my ($start, $id, $error);
#- examine each rpm and build the depslist for them using current
#- depslist and provides environment.
+ $start = @{$urpm->{depslist}};
foreach (@files) {
/(.*\/)?[^\/]*\.rpm$/ or $error = 1, $urpm->{error}(_("invalid rpm file name [%s]", $_)), next;
-r $_ or $error = 1, $urpm->{error}(_("unable to access rpm file [%s]", $_)), next;
- my ($fullname) = $urpm->{params}->read_rpms($_);
- my $pkg = $urpm->{params}{info}{$fullname};
+ ($id, undef) = $urpm->parse_rpm($_);
+ my $pkg = $urpm->{depslist}[$id];
$pkg or $urpm->{error}(_("unable to register rpm file")), next;
- $pkg->{source} = $1 ? $_ : "./$_";
- push @names, $fullname;
+ #TODO $pkg->{source} = $1 ? $_ : "./$_";
}
$error and $urpm->{fatal}(1, _("error registering local packages"));
- #- allocate id to each package read.
- $urpm->{params}->compute_id;
-
- #- return package names...
- @names;
+ $start <= $id ? ($start, $id) : ();
}
#- search packages registered by their name by storing their id into packages hash.
@@ -1286,12 +1284,10 @@ sub search_packages {
#- 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.
- my $pkg = $urpm->{params}{info}{$v};
- defined $pkg->{id} and $exact{$v} = $pkg->{id}, next;
unless ($options{fuzzy}) {
- my $pkg = $urpm->{params}{names}{$v};
- if (defined $pkg->{id} && ($options{src} ? $pkg->{arch} eq 'src' : $pkg->{arch} ne 'src')) {
- $exact{$v} = $pkg->{id};
+ my $pkg = $urpm->{names}{$v};
+ if ($pkg && defined $pkg->id && ($options{src} ? $pkg->arch eq 'src' : $pkg->arch ne 'src')) {
+ $exact{$v} = $pkg->id;
next;
}
}
@@ -1301,9 +1297,9 @@ sub search_packages {
if ($options{use_provides}) {
unless ($options{fuzzy}) {
#- try to search through provides.
- if (my @l = grep { defined $_ } map { $_ && ($options{src} ? $_->{arch} eq 'src' : $_->{arch} ne 'src') &&
- $_->{id} || undef } map { $urpm->{params}{info}{$_} }
- keys %{$urpm->{params}{provides}{$v} || {}}) {
+ if (my @l = grep { defined $_ } map { $_ && ($options{src} ? $_->arch eq 'src' : $_->arch ne 'src') &&
+ $_->id || undef } map { $urpm->{depslist}[$_] }
+ keys %{$urpm->{provides}{$v} || {}}) {
#- we assume that if the there is at least one package providing the resource exactly,
#- this should be the best ones that is described.
$exact{$v} = join '|', @l;
@@ -1311,35 +1307,35 @@ sub search_packages {
}
}
- foreach (keys %{$urpm->{params}{provides}}) {
+ foreach (keys %{$urpm->{provides}}) {
#- search through provides to find if a provide match this one.
#- but manages choices correctly (as a provides may be virtual or
#- multiply defined.
if (/$qv/) {
my @list = grep { defined $_ }
- map { my $pkg = $urpm->{params}{info}{$_};
- $pkg && ($options{src} ? $pkg->{arch} eq 'src' : $pkg->{arch} ne 'src') && $pkg->{id} || undef }
- keys %{$urpm->{params}{provides}{$_}};
+ map { my $pkg = $urpm->{depslist}[$_];
+ $pkg && ($options{src} ? $pkg->arch eq 'src' : $pkg->arch ne 'src') ? $pkg->id : undef }
+ keys %{$urpm->{provides}{$_} || {}};
@list > 0 and push @{$found{$v}}, join '|', @list;
}
if (/$qv/i) {
my @list = grep { defined $_ }
- map { my $pkg = $urpm->{params}{info}{$_};
- $pkg && ($options{src} ? $pkg->{arch} eq 'src' : $pkg->{arch} ne 'src') && $pkg->{id} || undef }
- keys %{$urpm->{params}{provides}{$_}};
+ map { my $pkg = $urpm->{depslist}[$_];
+ $pkg && ($options{src} ? $pkg->arch eq 'src' : $pkg->arch ne 'src') ? $pkg->id : undef }
+ keys %{$urpm->{provides}{$_} || {}};
@list > 0 and push @{$found{$v}}, join '|', @list;
}
}
}
- foreach my $id (0 .. $#{$urpm->{params}{depslist}}) {
- my $info = $urpm->{params}{depslist}[$id];
+ foreach my $id (0 .. $#{$urpm->{depslist}}) {
+ my $pkg = $urpm->{depslist}[$id];
- ($options{src} ? $info->{arch} eq 'src' : rpmtools::compat_arch($info->{arch})) or next;
+ ($options{src} ? $pkg->arch eq 'src' : $pkg->is_arch_compat) or next;
- my $pack_ra = "$info->{name}-$info->{version}";
- my $pack_a = "$pack_ra-$info->{release}";
- my $pack = "$pack_a.$info->{arch}";
+ my $pack_ra = $pkg->name . '-' . $pkg->version;
+ my $pack_a = "$pack_ra-" . $pkg->release;
+ my $pack = "$pack_a." . $pkg->arch;
unless ($options{fuzzy}) {
if ($pack eq $v) {
@@ -1368,8 +1364,8 @@ sub search_packages {
#- always prefer already found package.
my %l;
foreach (@{$exact_a{$_} || $exact_ra{$_} || $found{$_} || $foundi{$_} || []}) {
- my $info = $urpm->{params}{depslist}[$_];
- push @{$l{$info->{name}}}, { id => $_, info => $info };
+ my $pkg = $urpm->{depslist}[$_];
+ push @{$l{$pkg->name}}, { id => $_, pkg => $pkg };
}
if (values(%l) == 0) {
$urpm->{error}(_("no package named %s", $_));
@@ -1382,24 +1378,12 @@ sub search_packages {
my $best;
foreach (@$_) {
if ($best) {
- my $cmp_version = ($_->{info}{serial} == $best->{info}{serial} &&
- rpmtools::version_compare($_->{info}{version},
- $best->{info}{version}));
- my $cmp_release = ($cmp_version == 0 &&
- rpmtools::version_compare($_->{info}{release},
- $best->{info}{release}));
- if ($_->{info}{serial} > $best->{info}{serial} ||
- $cmp_version > 0 || $cmp_release > 0 ||
- ($_->{info}{serial} == $best->{info}{serial} &&
- $cmp_version == 0 && $cmp_release == 0 &&
- rpmtools::better_arch($_->{info}{arch}, $best->{info}{arch}))) {
- $best = $_;
- }
+ $_->compare_pkg($best) > 0 and $best = $_;
} else {
$best = $_;
}
}
- $packages->{$best->{id}} = undef;
+ $packages->{$best->id} = undef;
}
}
}
@@ -1409,90 +1393,6 @@ sub search_packages {
$result;
}
-#- parse synthesis file to retrieve information stored inside.
-sub parse_synthesis {
- my ($urpm, $medium, %options) = @_;
- local (*F, $_);
- my ($error, @founds, %info);
-
- #- check with provides that version and release are matching else ignore safely.
- #- simply ignore src rpm, which does not have any provides.
- my $update_info = sub {
- my ($found, $fullname, $serial, $size, $group, $file);
-
- #- search important information.
- $info{info} and ($fullname, $serial, $size, $group, $file) = @{$info{info}};
- $fullname or $info{name} and ($fullname, $file) = @{$info{name}};
-
- #- no fullname means no information have been found, this is really problematic here!
- $fullname or return;
-
- #- search an existing entry or create it.
- unless ($found = $urpm->{params}{info}{$fullname}) {
- #- the entry does not exists *AND* should be created (in info, names and provides hashes)
- if ($fullname =~ /^(.*?)-([^-]*)-([^-]*)\.([^\-\.]*)$/) {
- $found = $urpm->{params}{info}{$fullname} = $urpm->{params}{names}{$1} =
- { name => $1, version => $2, release => $3, arch => $4,
- id => scalar @{$urpm->{params}{depslist}},
- };
-
- #- update global depslist, medium depslist and provides.
- push @{$urpm->{params}{depslist}}, $found;
- push @{$medium->{depslist}}, $found;
-
- if ($options{examine_requires}) {
- foreach (@{$info{requires} || []}) {
- /([^\s\[]*)/ and $urpm->{params}{provides}{$1} ||= undef; #- do not delete, but keep in mind.
- }
- }
- $urpm->{params}{provides}{$found->{name}}{$fullname} = undef;
- foreach (@{$info{provides} || []}) {
- defined $serial or
- /([^\s\[]*)(?:\s+|\[)?==\s*(?:(\d+):)?[^\-]*-/ && $found->{name} eq $1 && $2 > 0 and $serial = $2;
- /([^\s\[]*)/ and $urpm->{params}{provides}{$1}{$fullname} = undef;
- }
- }
- }
- if ($found) {
- #- an already existing entries has been found, so
- #- add additional information (except name or info).
- foreach my $tag (keys %info) {
- eval { $tag ne 'name' && $tag ne 'info' and $found->{$tag} ||= $info{$tag}; }; #- HACK
- }
- $serial and $found->{serial} ||= $serial;
- $size and $found->{size} ||= $size;
- $group and $found->{group} ||= $group;
- $file and $found->{file} ||= $file;
-
- #- keep track of package found.
- push @founds, $found;
- } else {
- #- fullname is incoherent or not found (and not created).
- $urpm->{log}(_("unknown data associated with %s", $fullname));
- }
- $found;
- };
-
- #- keep track of filename used for the medium.
- my $filename = $options{filename} || "$urpm->{statedir}/synthesis.$medium->{hdlist}";
-
- open F, "gzip -dc '$filename' |";
- while (<F>) {
- chomp;
- my ($name, $tag, @data) = split '@';
-
- $info{$tag} = \@data;
- if ($tag eq 'info' || $tag eq 'name') {
- $update_info->() or $urpm->{log}(_("unable to analyse synthesis data of %s",
- $name =~ /^[[:print:]]*$/ ? $name : _("<non printable chars>")));
- %info = ();
- }
- }
- $urpm->{log}(_("read synthesis file [%s]", $filename));
-
- @founds;
-}
-
#- filter minimal list, upgrade packages only according to rpm requires
#- satisfied, remove upgrade for package already installed or with a better
#- version, try to upgrade to minimize upgrade errors.
@@ -1500,24 +1400,20 @@ sub parse_synthesis {
sub filter_packages_to_upgrade {
my ($urpm, $packages, $select_choices, %options) = @_;
my ($id, %track, %track_requires, %installed, %selected, %conflicts);
- my ($db, @packages) = (rpmtools::db_open($options{root}), keys %$packages);
- my $sig_handler = sub { rpmtools::db_close($db); exit 3 };
+ my ($db, @packages) = (URPM::DB::open($options{root}), keys %$packages);
+ my $sig_handler = sub { undef $db; exit 3 };
local $SIG{INT} = $sig_handler;
local $SIG{QUIT} = $sig_handler;
#- common routines that are called at different points.
my $check_installed = sub {
my ($pkg) = @_;
- $pkg->{src} eq 'src' and return;
- $options{keep_alldeps} || exists $installed{$pkg->{id}} and return 0;
- rpmtools::db_traverse_tag($db, 'name', [ $pkg->{name} ],
- [ qw(name version release serial) ], sub {
- my ($p) = @_;
- my $vc = rpmtools::version_compare($pkg->{version}, $p->{version});
- $installed{$pkg->{id}} ||=
- !($pkg->{serial} > $p->{serial} || $pkg->{serial} == $p->{serial} &&
- ($vc > 0 || $vc == 0 && rpmtools::version_compare($pkg->{release}, $p->{release}) > 0));
- });
+ $pkg->arch eq 'src' and return;
+ $options{keep_alldeps} || exists $installed{$pkg->id} and return 0;
+ $db->traverse_tag('name', [ $pkg->name ], sub {
+ my ($p) = @_;
+ $installed{$pkg->id} ||= $pkg->compare_pkg($p) <= 0;
+ });
};
#- at this level, compute global closure of what is requested, regardless of
@@ -1535,9 +1431,9 @@ sub filter_packages_to_upgrade {
#- a provide with a lot of choices, we have to filter according to those who
#- are installed).
foreach (@$id) {
- my $pkg = $urpm->{params}{depslist}[$_];
+ my $pkg = $urpm->{depslist}[$_];
if (exists $packages->{$_} || $check_installed->($pkg) > 0) {
- $installed{$pkg->{id}} or push @forced_selection, $_;
+ $installed{$pkg->id} or push @forced_selection, $_;
} else {
push @selection, $_;
}
@@ -1555,8 +1451,8 @@ sub filter_packages_to_upgrade {
}
next;
}
- my $pkg = $urpm->{params}{depslist}[$id];
- defined $pkg->{id} or next; #- id has been removed for package that only exists on some arch.
+ my $pkg = $urpm->{depslist}[$id];
+ defined $pkg->id or next; #- id has been removed for package that only exists on some arch.
#- search for package that will be upgraded, and check the difference
#- of provides to see if something will be altered and need to be upgraded.
@@ -1566,51 +1462,43 @@ sub filter_packages_to_upgrade {
#- installed.
my (%diff_provides, %provides);
- if ($pkg->{arch} ne 'src') {
+ if ($pkg->arch ne 'src') {
my @upgraded;
- foreach ($pkg->{name}, @{$pkg->{obsoletes} || []}) {
- if (my ($n, $o, $v, $r) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\-\]]*)-?([^\s\]]*)/) {
- rpmtools::db_traverse_tag($db, 'name', [ $n ],
- [ qw(name version release sense provides),
- $options{track} ? qw(arch requires serial) : () ],
- sub {
- my ($p) = @_;
- (!$v || eval(rpmtools::version_compare($p->{version}, $v) . $o . 0)) &&
- (!$r || rpmtools::version_compare($p->{version}, $v) != 0 ||
- eval(rpmtools::version_compare($p->{release}, $r) . $o . 0)) or return;
- $options{track} and push @upgraded, $p;
- foreach (@{$p->{provides}}) {
- s/\[\*\]//;
- s/\[([^\]]*)\]/ $1/;
- $diff_provides{$_} = "$p->{name}-$p->{version}-$p->{release}";
- }
- });
+ foreach ($pkg->name, $pkg->obsoletes) {
+ if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
+ $db->traverse_tag('name', [ $n ], sub {
+ my ($p) = @_;
+ eval($p->compare($v) . $o . 0) or return;
+ $options{track} and $p->pack_header, push @upgraded, $p;
+ foreach ($p->provides) {
+ s/\[\*\]//;
+ s/\[([^\]]*)\]/ $1/;
+ $diff_provides{$_} = $p->fullname;
+ }
+ });
}
}
- $options{track} and $track{$pkg->{id}}{upgraded} = \@upgraded;
+ $options{track} and $track{$pkg->id}{upgraded} = \@upgraded;
- foreach (@{$pkg->{provides} || []}) {
+ foreach ($pkg->provides) {
s/\[\*\]//;
s/\[([^\]]*)\]/ $1/;
delete $diff_provides{$_};
}
foreach (keys %diff_provides) {
- #- analyse the difference in provide and select other package.
- if (my ($n, $o, $e, $v, $r) = /^(\S*)\s*(\S*)\s*(\d+:)?([^\s-]*)-?(\S*)/) {
+ #- analyse the difference in provides and select other package.
+ if (my ($n, $o, $v) = /^(\S*)\s*(\S*)\s*(\S*)/) {
my $check = sub {
my ($p) = @_;
my ($needed, $satisfied) = (0, 0);
- foreach (@{$p->{requires}}) {
- if (my ($pn, $po, $pv, $pr) =
- /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\-\]]*)-?([^\s\]]*)/) {
+ foreach ($p->requires) {
+ if (my ($pn, $po, $pv) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
if ($po || $o) {
- $pn eq $n && $pn eq $pkg->{name} or next;
+ $pn eq $n && $pn eq $pkg->name or next;
++$needed;
- (!$pv || eval(rpmtools::version_compare($pkg->{version}, $pv) . $po . 0)) &&
- (!$pr || rpmtools::version_compare($pkg->{version}, $pv) != 0 ||
- eval(rpmtools::version_compare($pkg->{release}, $pr) . $po . 0)) or next;
+ eval($pkg->compare($pv) . $po . 0) or next;
#- an existing provides (propably the one examined) is satisfying the underlying.
++$satisfied;
} else {
@@ -1623,22 +1511,23 @@ sub filter_packages_to_upgrade {
#- check if the package need to be updated because it
#- losts some of its requires regarding the current diff_provides.
if ($needed > $satisfied) {
- $selected{$p->{name}} ||= undef;
- $options{track} and push @{$track{$pkg->{id}}{diff_provides} ||= []}, $p;
+ $selected{$p->name} ||= undef;
+ if ($options{track}) {
+ $p->pack_header;
+ push @{$track{$pkg->id}{diff_provides} ||= []}, $p;
+ }
}
};
- rpmtools::db_traverse_tag($db, 'whatrequires', [ $n ],
- [ qw(name version release sense requires),
- $options{track} ? qw(arch provides serial) : () ], $check);
+ $db->traverse_tag('whatrequires', [ $n ], $check);
}
}
- $selected{$pkg->{name}} ||= undef;
+ $selected{$pkg->name} ||= undef;
}
#- iterate over requires of the packages, register them.
- foreach (@{$pkg->{requires} || []}) {
- if (my ($n, $o, $v, $r) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\-\]]*)-?([^\s\]]*)/) {
+ foreach ($pkg->requires) {
+ if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
exists $provides{$_} and next;
#- if the provides is not found, it will be resolved at next step, else
#- it will be resolved by searching the rpm database.
@@ -1646,47 +1535,40 @@ sub filter_packages_to_upgrade {
unless ($options{keep_alldeps}) {
my $check_pkg = sub {
my ($p) = @_;
- exists $selected{$p->{name}} and return;
- $o and $n eq $p->{name} || return;
- (!$v || eval(rpmtools::version_compare($p->{version}, $v) . $o . 0)) &&
- (!$r || rpmtools::version_compare($p->{version}, $v) != 0 ||
- eval(rpmtools::version_compare($p->{release}, $r) . $o . 0)) or return;
- $provides{$_} = "$p->{name}-$p->{version}-$p->{release}";
+ exists $selected{$p->name} and return;
+ $o and $n eq $p->name || return;
+ eval($p->compare($v) . $o . 0) or return;
+ $provides{$_} = $p->fullname;
};
- rpmtools::db_traverse_tag($db, $n =~ m|^/| ? 'path' : 'whatprovides', [ $n ],
- [ qw (name version release),
- $options{track} ? qw(arch sense requires provides serial) : () ], $check_pkg);
+ $db->traverse_tag($n =~ m|^/| ? 'path' : 'whatprovides', [ $n ], $check_pkg);
}
- $options{track} and $track_requires{$_}{$pkg->{id}} = $_;
+ $options{track} and $track_requires{$_}{$pkg->id} = $_;
}
}
#- examine conflicts and try to resolve them.
#- if there is a conflicts with a too old version, it need to be upgraded.
#- if there is a provides (by using a obsoletes on it too), examine obsolete (provides) too.
- foreach (@{$pkg->{conflicts} || []}) {
- if (my ($n, $o, $v, $r) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\-\]]*)-?([^\s\]]*)/) {
+ foreach ($pkg->conflicts) {
+ if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
my $check_pkg = sub {
my ($p) = @_;
- $o and $n eq $p->{name} || return;
- (!$v || eval(rpmtools::version_compare($p->{version}, $v) . $o . 0)) &&
- (!$r || rpmtools::version_compare($p->{version}, $v) != 0 ||
- eval(rpmtools::version_compare($p->{release}, $r) . $o . 0)) or return;
- $conflicts{"$p->{name}-$p->{version}-$p->{release}.$p->{arch}"} = 1;
- $selected{$p->{name}} ||= undef;
- $options{track} and push @{$track{$pkg->{id}}{conflicts} ||= []}, $p;
+ $o and $n eq $p->name || return;
+ eval($p->compare($v) . $o . 0) or return;
+ $conflicts{$p->fullname} = 1;
+ $selected{$p->name} ||= undef;
+ if ($options{track}) {
+ $p->pack_header;
+ push @{$track{$pkg->id}{conflicts} ||= []}, $p;
+ }
};
- rpmtools::db_traverse_tag($db, $n =~ m|^/| ? 'path' : 'whatprovides', [ $n ],
- [ qw (name version release arch),
- $options{track} ? qw(sense requires provides serial) : () ], $check_pkg);
- foreach my $fullname (keys %{$urpm->{params}{provides}{$n} || {}}) {
- my $p = $urpm->{params}{info}{$fullname};
- $p->{arch} eq 'src' and next;
- $o and $n eq $p->{name} || next;
- (!$v || eval(rpmtools::version_compare($p->{version}, $v) . $o . 0)) &&
- (!$r || rpmtools::version_compare($p->{version}, $v) != 0 ||
- eval(rpmtools::version_compare($p->{release}, $r) . $o . 0)) or next;
- $conflicts{"$p->{name}-$p->{version}-$p->{release}.$p->{arch}"} ||= 0;
+ $db->traverse_tag($n =~ m|^/| ? 'path' : 'whatprovides', [ $n ], $check_pkg);
+ foreach my $id (keys %{$urpm->{provides}{$n} || {}}) {
+ my $p = $urpm->{depslist}[$id];
+ $p->arch eq 'src' and next;
+ $o and $n eq $p->name || next;
+ eval($p->compare($v) . $o . 0) or next;
+ $conflicts{$p->fullname} ||= 0;
}
}
}
@@ -1695,39 +1577,36 @@ sub filter_packages_to_upgrade {
#- provides files, try to minimize choice at this level.
foreach (keys %provides, grep { !$selected{$_} } keys %selected) {
my (%pre_choices, @pre_choices, @choices, @upgradable_choices, %choices_id);
- if (my ($n, $o, $v, $r) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\-\]]*)-?([^\s\]]*)/) {
+ if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
$provides{$_} and next;
- foreach my $fullname (keys %{$urpm->{params}{provides}{$n} || {}}) {
- exists $conflicts{$fullname} and next;
- my $pkg = $urpm->{params}{info}{$fullname};
- $pkg->{arch} eq 'src' and next;
- $selected{$n} || $selected{$pkg->{name}} and %pre_choices=(), last;
+ foreach my $id (keys %{$urpm->{provides}{$n} || {}}) {
+#TODO exists $conflicts{$fullname} and next;
+ my $pkg = $urpm->{depslist}[$id];
+ $pkg->arch eq 'src' and next;
+ $selected{$n} || $selected{$pkg->name} and %pre_choices=(), last;
#- check if a unsatisfied selection on a package is needed,
#- which need a obsolete on a package with different name or
#- a package with the given name.
#- if an obsolete is given, it will be satisfied elsewhere. CHECK TODO
- if ($n ne $pkg->{name}) {
+ if ($n ne $pkg->name) {
unless (exists $selected{$n}) {
#- a virtual provides exists with a specific version and maybe release.
#- try to resolve.
- foreach (@{$pkg->{provides}}) {
- if (my ($pn, $po, $pv, $pr) =
- /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\-\]]*)-?([^\s\]]*)/) {
+ foreach ($pkg->provides) {
+ if (my ($pn, $po, $pv) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
$pn eq $n or next;
my $no = $po eq '==' ? $o : $po; #- CHECK TODO ?
- (!$pv || !$v || eval(rpmtools::version_compare($pv, $v) . $no . 0)) &&
- (!$pr || !$r || rpmtools::version_compare($pv, $v) != 0 ||
- eval(rpmtools::version_compare($pr, $r) . $no . 0)) or next;
- push @{$pre_choices{$pkg->{name}}}, $pkg;
+#TODO (!$pv || !$v || eval(rpmtools::version_compare($pv, $v) . $no . 0)) &&
+#TODO (!$pr || !$r || rpmtools::version_compare($pv, $v) != 0 ||
+#TODO eval(rpmtools::version_compare($pr, $r) . $no . 0)) or next;
+ push @{$pre_choices{$pkg->name}}, $pkg;
}
}
}
} else {
- (!$v || eval(rpmtools::version_compare($pkg->{version}, $v) . $o . 0)) &&
- (!$r || rpmtools::version_compare($pkg->{version}, $v) != 0 ||
- eval(rpmtools::version_compare($pkg->{release}, $r) . $o . 0)) or next;
- push @{$pre_choices{$pkg->{name}}}, $pkg;
+ eval($pkg->compare($v) . $o . 0) or next;
+ push @{$pre_choices{$pkg->name}}, $pkg;
}
}
}
@@ -1739,13 +1618,13 @@ sub filter_packages_to_upgrade {
#- take the best one, according to id used.
my $chosen_pkg;
foreach my $id (%$packages) {
- my $candidate_pkg = $urpm->{params}{depslist}[$id];
- $candidate_pkg->{name} eq $pkg->{name} or next;
+ my $candidate_pkg = $urpm->{depslist}[$id];
+ $candidate_pkg->name eq $pkg->name or next;
foreach my $pkg (@$_) {
$pkg == $candidate_pkg and $chosen_pkg = $pkg, last;
}
}
- $chosen_pkg ||= $urpm->{params}{names}{$_->[0]{name}}; #- at least take the best normally used.
+ $chosen_pkg ||= $urpm->{names}{$_->[0]->name}; #- at least take the best normally used.
push @pre_choices, $chosen_pkg;
}
}
@@ -1753,21 +1632,21 @@ sub filter_packages_to_upgrade {
push @choices, $pkg;
$check_installed->($pkg);
- $installed{$pkg->{id}} and delete $packages->{$pkg->{id}};
- exists $installed{$pkg->{id}} and push @upgradable_choices, $pkg;
+ $installed{$pkg->id} and delete $packages->{$pkg->id};
+ exists $installed{$pkg->id} and push @upgradable_choices, $pkg;
}
foreach my $pkg (@pre_choices) {
- if (exists $packages->{$pkg->{id}} || $installed{$pkg->{id}}) {
+ if (exists $packages->{$pkg->id} || $installed{$pkg->id}) {
#- the package is already selected, or installed with a better version and release.
@choices = @upgradable_choices = ();
last;
}
}
@upgradable_choices > 0 and @choices = @upgradable_choices;
- $choices_id{$_->{id}} = $_ foreach @choices;
+ $choices_id{$_->id} = $_ foreach @choices;
if (keys(%choices_id) == 1) {
my ($id) = keys(%choices_id);
- $selected{$choices_id{$id}{name}} = 1;
+ $selected{$choices_id{$id}->name} = 1;
unless ($packages->{$id}) {
$packages->{$id} = 1;
if ($options{track} && $track_requires{$_}) {
@@ -1788,8 +1667,7 @@ sub filter_packages_to_upgrade {
}
}
- rpmtools::db_close($db);
-
+ #- rpm db will be closed automatically on destruction of $db.
\%track;
}
@@ -1801,11 +1679,11 @@ sub deselect_unwanted_packages {
open F, $urpm->{skiplist};
while (<F>) {
chomp; s/#.*$//; s/^\s*//; s/\s*$//;
- foreach (keys %{$urpm->{params}{provides}{$_} || {}}) {
- my $pkg = $urpm->{params}{info}{$_} or next;
- $pkg->{arch} eq 'src' and next; #- never ignore source package.
- $options{force} || (exists $packages->{$pkg->{id}} && defined $packages->{$pkg->{id}})
- and delete $packages->{$pkg->{id}};
+ foreach (keys %{$urpm->{provides}{$_} || {}}) {
+ my $pkg = $urpm->{depslist}[$_] or next;
+ $pkg->arch eq 'src' and next; #- never ignore source package.
+ $options{force} || (exists $packages->{$pkg->id} && defined $packages->{$pkg->id})
+ and delete $packages->{$pkg->id};
}
}
close F;
@@ -1823,20 +1701,20 @@ sub get_source_packages {
#- build association hash to retrieve id and examine all list files.
foreach (keys %$packages) {
- my $p = $urpm->{params}{depslist}[$_];
- if ($p->{source}) {
- $local_sources{$_} = $p->{source};
- } else {
- $fullname2id{"$p->{name}-$p->{version}-$p->{release}.$p->{arch}"} = $_;
- }
+ my $p = $urpm->{depslist}[$_];
+#TODO if ($p->{source}) {
+#TODO $local_sources{$_} = $p->{source};
+#TODO } else {
+ $fullname2id{$p->fullname} = $_;
+#TODO }
}
#- examine each medium to search for packages.
#- now get rpm file name in hdlist to match list file.
foreach my $medium (@{$urpm->{media} || []}) {
- foreach (@{$medium->{depslist} || []}) {
- my $fullname = "$_->{name}-$_->{version}-$_->{release}.$_->{arch}";
- $file2fullnames{($_->{file} =~ /(.*)\.rpm$/ && $1) || $fullname}{$fullname} = undef;
+ foreach ($medium->{start} .. $medium->{end}) {
+ my $pkg = $urpm->{depslist}[$_];
+ $file2fullnames{($pkg->filename =~ /(.*)\.rpm$/ && $1) || $pkg->fullname}{$pkg->fullname} = undef;
}
}
@@ -2049,15 +1927,15 @@ sub extract_packages_to_install {
open F, $urpm->{instlist};
while (<F>) {
chomp; s/#.*$//; s/^\s*//; s/\s*$//;
- foreach (keys %{$urpm->{params}{provides}{$_} || {}}) {
- my $pkg = $urpm->{params}{info}{$_} or next;
+ foreach (keys %{$urpm->{provides}{$_} || {}}) {
+ my $pkg = $urpm->{depslist}[$_] or next;
#- some package with specific naming convention to avoid upgrade problem
#- should not be taken into account here.
#- these package have version=1 and release=1mdk, and name contains version and release.
- $pkg->{version} eq '1' && $pkg->{release} eq '1mdk' && $pkg->{name} =~ /^.*-[^\-]*mdk$/ and next;
+ $pkg->version eq '1' && $pkg->release eq '1mdk' && $pkg->name =~ /^.*-[^\-]*mdk$/ and next;
- exists $sources->{$pkg->{id}} and $inst{$pkg->{id}} = delete $sources->{$pkg->{id}};
+ exists $sources->{$pkg->id} and $inst{$pkg->id} = delete $sources->{$pkg->id};
}
}
close F;
@@ -2067,8 +1945,8 @@ sub extract_packages_to_install {
sub select_packages_to_upgrade {
my ($urpm, $prefix, $packages, $remove_packages, $keep_files, %options) = @_;
- my $db = rpmtools::db_open($prefix);
- my $sig_handler = sub { rpmtools::db_close($db); exit 3 };
+ my $db = URPM::DB::open($prefix);
+ my $sig_handler = sub { undef $db; exit 3 };
local $SIG{INT} = $sig_handler;
local $SIG{QUIT} = $sig_handler;
@@ -2080,6 +1958,9 @@ sub select_packages_to_upgrade {
#'compat-libs' => 1,
);
+ #- TODO installed flag on id.
+ my %installed;
+
#- help removing package which may have different release numbering
my %toRemove;
@@ -2089,222 +1970,137 @@ sub select_packages_to_upgrade {
#- help keeping memory by this set of package that have been obsoleted.
my %obsoletedPackages;
- #- make a subprocess here for reading filelist, this is important
- #- not to waste a lot of memory for the main program which will fork
- #- latter for each transaction.
- local (*INPUT, *OUTPUT_CHILD); pipe INPUT, OUTPUT_CHILD;
- local (*INPUT_CHILD, *OUTPUT); pipe INPUT_CHILD, OUTPUT;
- if (my $pid = $options{use_parsehdlist} ? fork() : 1) {
- close INPUT_CHILD;
- close OUTPUT_CHILD;
- #- check if there is a parsehdlist running in the background.
- if ($pid == 1) {
- close INPUT;
- close OUTPUT;
- } else {
- select((select(OUTPUT), $| = 1)[0]);
- }
-
- #- internal reading from interactive mode of parsehdlist.
- #- takes a code to call with the line read, this avoid allocating
- #- memory for that.
- my $ask_child = sub {
- my ($pkg, $tag, $code) = @_;
- $code or die "no callback code for parsehdlist output";
- #- check if what is requested is not already available locally (because
- #- the hdlist does not exists and the medium is marked as using a
- #- synthesis file).
- if ($pid == 1 || $pkg && @{$pkg->{$tag} || []}) {
- foreach (@{$pkg->{$tag} || []}) {
- $code->($_);
- }
- } else {
- print OUTPUT "$pkg->{name}-$pkg->{version}-$pkg->{release}.$pkg->{arch}:$tag\n";
-
- local $_;
- while (<INPUT>) {
- chomp;
- /^\s*$/ and last;
- $code->($_);
+ #- select packages which obseletes other package, obselete package are not removed,
+ #- should we remove them ? this could be dangerous !
+ foreach my $pkg (@{$urpm->{depslist}}) {
+ defined $pkg->id && $pkg->arch ne 'src' or next;
+ foreach ($pkg->obsoletes) {
+ #- take care of flags and version and release if present
+ if (my ($n,$o,$v) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\]]*)/) {
+ my $obsoleted = 0;
+ my $check_obsoletes = sub {
+ my ($p) = @_;
+ eval($p->compare($v) . $o . 0) or return;
+ ++$obsoleted;
+ };
+ $db->traverse_tag("name", [ $n ], $check_obsoletes);
+ if ($obsoleted > 0) {
+ $urpm->{log}(_("selecting %s using obsoletes", $pkg->fullname));
+ $obsoletedPackages{$n} = undef;
+ $packages->{$pkg->id} = undef;
}
}
- };
-
- #- select packages which obseletes other package, obselete package are not removed,
- #- should we remove them ? this could be dangerous !
- foreach my $pkg (values %{$urpm->{params}{info}}) {
- defined $pkg->{id} && $pkg->{arch} ne 'src' or next;
- $ask_child->($pkg, "obsoletes", sub {
- #- take care of flags and version and release if present
- local ($_) = @_;
- if (my ($n,$o,$v,$r) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\-\]]*)-?([^\s\]]*)/) {
- my $obsoleted = 0;
- my $check_obsoletes = sub {
- my ($p) = @_;
- (!$v || eval(rpmtools::version_compare($p->{version}, $v) . $o . 0)) &&
- (!$r || rpmtools::version_compare($p->{version}, $v) != 0 ||
- eval(rpmtools::version_compare($p->{release}, $r) . $o . 0)) or return;
- ++$obsoleted;
- };
- rpmtools::db_traverse_tag($db, "name", [ $n ], [ qw(name version release) ], $check_obsoletes);
- if ($obsoleted > 0) {
- $urpm->{log}(_("selecting %s using obsoletes",
- "$pkg->{name}-$pkg->{version}-$pkg->{release}"));
- $obsoletedPackages{$n} = undef;
- $pkg->{selected} = 1;
- }
- }
- });
}
+ }
- #- mark all files which are not in /dev or /etc/rc.d/ for packages which are already installed
- #- but which are not in the packages list to upgrade.
- #- the 'installed' property will make a package unable to be selected, look at select.
- rpmtools::db_traverse($db, [ qw(name version release serial files) ], sub {
+ #- mark all files which are not in /dev or /etc/rc.d/ for packages which are already installed
+ #- but which are not in the packages list to upgrade.
+ #- the 'installed' property will make a package unable to be selected, look at select.
+ $db->traverse(sub {
+ my ($p) = @_;
+ my $otherPackage = $p->release !~ /mdk\w*$/ && ($p->name.'-'.$p->version.'-'.$p->release);
+ my $pkg = $urpm->{names}{$p->name};
+
+ if ($pkg) {
+ if ($p->compare_pkg($pkg) >= 0) {
+ if ($otherPackage && $p->compare($pkg->version) <= 0) {
+ $toRemove{$otherPackage} = 0;
+ $packages->{$pkg->id} = undef;
+ $urpm->{log}(_("removing %s to upgrade to %s ...
+ since it will not be updated otherwise", $otherPackage, $pkg->name.'-'.$pkg->version.'-'.$pkg->release));
+ } else {
+ $installed{$pkg->id} = undef;
+ }
+ } elsif ($upgradeNeedRemove{$pkg->name}) {
+ my $otherPackage = $p->name.'-'.$p->version.'-'.$p->release;
+ $toRemove{$otherPackage} = 0;
+ $packages->{$pkg->id} = undef;
+ $urpm->{log}(_("removing %s to upgrade to %s ...
+ since it will not upgrade correctly!", $otherPackage, $pkg->name.'-'.$pkg->version.'-'.$pkg->release));
+ }
+ } else {
+ if (exists $obsoletedPackages{$p->name}) {
+ @installedFilesForUpgrade{$p->upgrade_files} = ();
+ }
+ }
+ });
+
+ #- find new packages to upgrade.
+ foreach my $pkg (@{$urpm->{depslist}}) {
+ defined $pkg->id && $pkg->arch ne 'src' or next;
+
+ my $skipThis = 0;
+ my $count = $db->traverse_tag("name", [ $pkg->name ], sub {
+ $skipThis ||= exists $installed{$pkg->id};
+ });
+
+ #- skip if not installed (package not found in current install).
+ $skipThis ||= ($count == 0);
+
+ #- select the package if it is already installed with a lower version or simply not installed.
+ unless ($skipThis) {
+ my $cumulSize;
+
+ $packages->{$pkg->id} = undef;
+
+ #- keep in mind installed files which are not being updated. doing this costs in
+ #- execution time but use less memory, else hash all installed files and unhash
+ #- all file for package marked for upgrade.
+ $db->traverse_tag("name", [ $pkg->name ], sub {
my ($p) = @_;
- my $otherPackage = $p->{release} !~ /mdk\w*$/ && "$p->{name}-$p->{version}-$p->{release}";
- my $pkg = $urpm->{params}{names}{$p->{name}};
-
- if ($pkg) {
- my $version_cmp = rpmtools::version_compare($p->{version}, $pkg->{version});
- if ($p->{serial} > $pkg->{serial} || $p->{serial} == $pkg->{serial} &&
- ($version_cmp > 0 ||
- $version_cmp == 0 &&
- rpmtools::version_compare($p->{release}, $pkg->{release}) >= 0)) {
- if ($otherPackage && $version_cmp <= 0) {
- $toRemove{$otherPackage} = 0;
- $pkg->{selected} = 1;
- $urpm->{log}(_("removing %s to upgrade to %s ...
- since it will not be updated otherwise", $otherPackage, "$pkg->{name}-$pkg->{version}-$pkg->{release}"));
- } else {
- $pkg->{installed} = 1;
- }
- } elsif ($upgradeNeedRemove{$pkg->{name}}) {
- my $otherPackage = "$p->{name}-$p->{version}-$p->{release}";
- $toRemove{$otherPackage} = 0;
- $pkg->{selected} = 1;
- $urpm->{log}(_("removing %s to upgrade to %s ...
- since it will not upgrade correctly!", $otherPackage, "$pkg->{name}-$pkg->{version}-$pkg->{release}"));
- }
- } else {
- if (exists $obsoletedPackages{$p->{name}}) {
- @installedFilesForUpgrade{grep { ($_ !~ m|^/dev/| && $_ !~ m|^/etc/rc.d/| &&
- $_ !~ m|\.la$| &&
- ! -d "$prefix/$_" && ! -l "$prefix/$_") }
- @{$p->{files}}} = ();
- }
- }
+ @installedFilesForUpgrade{$p->upgrade_files} = ();
});
- #- find new packages to upgrade.
- foreach my $pkg (values %{$urpm->{params}{info}}) {
- defined $pkg->{id} && $pkg->{arch} ne 'src' or next;
-
- my $skipThis = 0;
- my $count = rpmtools::db_traverse_tag($db, "name", [ $pkg->{name} ], [ 'name' ], sub {
- $skipThis ||= $pkg->{installed};
- });
-
- #- skip if not installed (package not found in current install).
- $skipThis ||= ($count == 0);
-
- #- select the package if it is already installed with a lower version or simply not installed.
- unless ($skipThis) {
- my $cumulSize;
-
- $pkg->{selected} = 1;
-
- #- keep in mind installed files which are not being updated. doing this costs in
- #- execution time but use less memory, else hash all installed files and unhash
- #- all file for package marked for upgrade.
- rpmtools::db_traverse_tag($db, "name", [ $pkg->{name} ], [ qw(name files) ], sub {
- my ($p) = @_;
- @installedFilesForUpgrade{grep { ($_ !~ m|^/dev/| && $_ !~ m|^/etc/rc.d/| &&
- $_ !~ m|\.la$| &&
- ! -d "$prefix/$_" && ! -l "$prefix/$_") }
- @{$p->{files}}} = ();
- });
-
- $ask_child->($pkg, "files", sub {
- delete $installedFilesForUpgrade{$_[0]};
- });
+ foreach ($pkg->files) {
+ delete $installedFilesForUpgrade{$_};
}
}
+ }
- #- unmark all files for all packages marked for upgrade. it may not have been done above
- #- since some packages may have been selected by depsList.
- foreach my $pkg (values %{$urpm->{params}{info}}) {
- defined $pkg->{id} && $pkg->{arch} ne 'src' or next;
- if ($pkg->{selected}) {
- $ask_child->($pkg, "files", sub {
- delete $installedFilesForUpgrade{$_[0]};
- });
+ #- unmark all files for all packages marked for upgrade. it may not have been done above
+ #- since some packages may have been selected by depsList.
+ foreach my $pkg (@{$urpm->{depslist}}) {
+ defined $pkg->id && $pkg->arch ne 'src' or next;
+ if (exists $packages->{$pkg->id}) {
+ foreach ($pkg->files) {
+ delete $installedFilesForUpgrade{$_};
}
}
+ }
- #- select packages which contains marked files, then unmark on selection.
- #- a special case can be made here, the selection is done only for packages
- #- requiring locales if the locales are selected.
- #- another special case are for devel packages where fixes over the time has
- #- made some files moving between the normal package and its devel couterpart.
- #- if only one file is affected, no devel package is selected.
- foreach my $pkg (values %{$urpm->{params}{info}}) {
- defined $pkg->{id} && $pkg->{arch} ne 'src' or next;
- unless ($pkg->{selected}) {
- my $toSelect = 0;
- $ask_child->($pkg, "files", sub {
- if ($_[0] !~ m|^/dev/| && $_[0] !~ m|^/etc/rc.d/| &&
- $_ !~ m|\.la$| && exists $installedFilesForUpgrade{$_[0]}) {
- ++$toSelect if ! -d "$prefix/$_[0]" && ! -l "$prefix/$_[0]";
- }
- delete $installedFilesForUpgrade{$_[0]};
- });
- if ($toSelect) {
- if ($toSelect <= 1 && $pkg->{name} =~ /-devel/) {
- $urpm->{log}(_("avoid selecting %s as not enough files will be updated",
- "$pkg->{name}-$pkg->{version}-$pkg->{release}"));
+ #- select packages which contains marked files, then unmark on selection.
+ #- a special case can be made here, the selection is done only for packages
+ #- requiring locales if the locales are selected.
+ #- another special case are for devel packages where fixes over the time has
+ #- made some files moving between the normal package and its devel couterpart.
+ #- if only one file is affected, no devel package is selected.
+ foreach my $pkg (@{$urpm->{depslist}}) {
+ defined $pkg->id && $pkg->arch ne 'src' or next;
+ unless (exists $packages->{$pkg->id}) {
+ my $toSelect = 0;
+ foreach ($pkg->upgrade_files) {
+ delete $installedFilesForUpgrade{$_} and ++$toSelect;
+ }
+ if ($toSelect) {
+ if ($toSelect <= 1 && $pkg->name =~ /-devel/) {
+ $urpm->{log}(_("avoid selecting %s as not enough files will be updated", $pkg->fullname));
+ } else {
+ #- default case is assumed to allow upgrade.
+ my @deps = grep { $_ } map { $urpm->{names}{$_} } grep { /locales-/ } $pkg->requires_nosense;
+ if (@deps == 0 || @deps > 0 && (grep { ! exists $packages->{$pkg->id} &&
+ ! exists $installed{$_->{id}} } @deps) == 0) {
+ $urpm->{log}(_("selecting %s by selection on files", $pkg->name));
+ $packages->{$pkg->id} = undef;
} else {
- #- default case is assumed to allow upgrade.
- my @deps = map { /\|/ and next; #- do not inspect choice
- my $p = $urpm->{params}{depslist}[$_];
- $p && $p->{name} =~ /locales-/ ? ($p) : () } split ' ', $pkg->{deps};
- if (@deps == 0 ||
- @deps > 0 && (grep { !$_->{selected} && !$_->{installed} } @deps) == 0) {
- $urpm->{log}(_("selecting %s by selection on files", $pkg->{name}));
- $pkg->{selected} = 1;
- } else {
- $urpm->{log}(_("avoid selecting %s as its locales language is not already selected",
- "$pkg->{name}-$pkg->{version}-$pkg->{release}"));
- }
+ $urpm->{log}(_("avoid selecting %s as its locales language is not already selected", $pkg->fullname));
}
}
}
}
-
- #- clean memory...
- %installedFilesForUpgrade = ();
-
- #- no need to still use the child as this point, we can let him to terminate.
- #- but only if a child has really been used.
- if ($pid != 1) {
- close OUTPUT;
- close INPUT;
- waitpid $pid, 0;
- }
- } else {
- close INPUT;
- close OUTPUT;
- open STDIN, "<&INPUT_CHILD";
- open STDOUT, ">&OUTPUT_CHILD";
- exec "parsehdlist", "--interactive", (map { "$urpm->{statedir}/$_->{hdlist}" }
- grep { ! $_->{synthesis} && ! $_->{ignore} } @{$urpm->{media} || []})
- or rpmtools::_exit(1);
}
- #- let the caller known about what we found here!
- foreach my $pkg (values %{$urpm->{params}{info}}) {
- $packages->{$pkg->{id}} = 0 if $pkg->{selected};
- }
+ #- clean memory...
+ %installedFilesForUpgrade = ();
#- clean false value on toRemove.
delete $toRemove{''};
@@ -2314,17 +2110,14 @@ sub select_packages_to_upgrade {
#- are very old when compabilty has been broken.
#- but new version may saved to .rpmnew so it not so hard !
if ($keep_files && keys %toRemove) {
- rpmtools::db_traverse($db, [ qw(name version release conffiles) ], sub {
- my ($p) = @_;
- my $otherPackage = "$p->{name}-$p->{version}-$p->{release}";
- if (exists $toRemove{$otherPackage}) {
- @{$keep_files}{@{$p->{conffiles} || []}} = ();
- }
- });
+ $db->traverse(sub {
+ my ($p) = @_;
+ my $otherPackage = $p->name.'-'.$p->version.'-'.$p->release;
+ if (exists $toRemove{$otherPackage}) {
+ @{$keep_files}{$p->conf_files} = ();
+ }
+ });
}
-
- #- close db, job finished !
- rpmtools::db_close($db);
}
1;