summaryrefslogtreecommitdiffstats
path: root/urpm.pm
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2001-12-06 17:43:07 +0000
committerFrancois Pons <fpons@mandriva.com>2001-12-06 17:43:07 +0000
commitbf14431431b0d3996cbed13b27e483f4fd777d89 (patch)
tree3b2effe311050a4e39d30bbd721a7491b9aa1e07 /urpm.pm
parent86f61ad423dbf3b0e45ed770628fea640b673dc8 (diff)
downloadurpmi-bf14431431b0d3996cbed13b27e483f4fd777d89.tar
urpmi-bf14431431b0d3996cbed13b27e483f4fd777d89.tar.gz
urpmi-bf14431431b0d3996cbed13b27e483f4fd777d89.tar.bz2
urpmi-bf14431431b0d3996cbed13b27e483f4fd777d89.tar.xz
urpmi-bf14431431b0d3996cbed13b27e483f4fd777d89.zip
3.0 of urpmi.
Diffstat (limited to 'urpm.pm')
-rw-r--r--urpm.pm740
1 files changed, 281 insertions, 459 deletions
diff --git a/urpm.pm b/urpm.pm
index 2581f1b5..939872cb 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -3,7 +3,7 @@ package urpm;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.6';
+$VERSION = '3.0';
=head1 NAME
@@ -15,9 +15,6 @@ urpm - Mandrake perl tools to handle urpmi database
my $urpm = new urpm;
- $urpm->read_depslist();
- $urpm->read_provides();
- $urpm->read_compss();
$urpm->read_config();
=head1 DESCRIPTION
@@ -70,13 +67,10 @@ sub new {
config => "/etc/urpmi/urpmi.cfg",
skiplist => "/etc/urpmi/skip.list",
instlist => "/etc/urpmi/inst.list",
- depslist => "/var/lib/urpmi/depslist.ordered",
- provides => "/var/lib/urpmi/provides",
- compss => "/var/lib/urpmi/compss",
statedir => "/var/lib/urpmi",
cachedir => "/var/cache/urpmi",
media => undef,
- params => new rpmtools,
+ params => new rpmtools('sense'),
sync => \&sync_webfetch, #- first argument is directory, others are url to fetch.
@@ -354,8 +348,6 @@ sub add_medium {
$urpm->try_mounting($dir) or $urpm->{log}(_("unable to access medium \"%s\"", $name)), return;
#- check if directory is somewhat normalized so that we can get back hdlist,
- #- check it that case if depslist, compss and provides file are also
- #- provided.
if (!($with_hdlist && -e "$dir/$with_hdlist") && $dir =~ /RPMS([^\/]*)\/*$/) {
foreach my $rdir (qw(Mandrake/base ../Mandrake/base ..)) {
-e "$dir/$_/hdlist$1.cz" and $with_hdlist = "$_/hdlist$1.cz", last;
@@ -388,10 +380,9 @@ sub remove_media {
$media{$_->{name}} = 1; #- keep it mind this one has been removed
#- remove file associated with this medium.
- #- this is the hdlist and the list files.
- unlink "$urpm->{statedir}/synthesis.$_->{hdlist}";
- unlink "$urpm->{statedir}/$_->{hdlist}";
- unlink "$urpm->{statedir}/$_->{list}";
+ foreach ($_->{hdlist}, $_->{list}, "synthesis.$_->{hdlist}", "descriptions.$_->{name}", "$_->{name}.cache") {
+ unlink "$urpm->{statedir}/$_";
+ }
} else {
push @result, $_; #- not removed so keep it
}
@@ -399,23 +390,11 @@ sub remove_media {
#- check if some arguments does not correspond to medium name.
foreach (keys %media) {
- if ($media{$_}) {
- #- when a medium is removed, depslist and others need to be recomputed.
- $urpm->{modified} = 1;
- } else {
+ unless ($media{$_}) {
$urpm->{error}(_("trying to remove inexistent medium \"%s\"", $_));
}
}
- #- special case if there is no more media registered.
- #- there is no need to recompute the hdlist and the files
- #- can be safely removed.
- if ($urpm->{modified} && @result == 0) {
- unlink $urpm->{depslist};
- unlink $urpm->{provides};
- unlink $urpm->{compss};
- }
-
#- restore newer media list.
$urpm->{media} = \@result;
}
@@ -442,17 +421,36 @@ sub select_media {
}
sub build_synthesis_hdlist {
- my ($urpm, $medium) = @_;
+ my ($urpm, $medium, $use_parsehdlist) = @_;
- #- building synthesis file using parsehdlist output, need 3.2-1mdk or above.
unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
- if (system "parsehdlist --compact --info --provides --requires '$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;
+ if ($use_parsehdlist) {
+ #- building synthesis file using parsehdlist output, need 4.0-1mdk or above.
+ if (system "parsehdlist --compact --info --provides --requires '$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;
+ }
} else {
- $urpm->{log}(_("built hdlist synthesis file for medium \"%s\"", $medium->{name}));
+ #- building synthesis file using internal params.
+ local *F;
+ open F, "| gzip >'$urpm->{statedir}/synthesis.$medium->{hdlist}'";
+ foreach my $p (@{$urpm->{params}{depslist}}) {
+ $p->{medium} eq $medium or next;
+ foreach (qw(provides requires)) {
+ @{$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";
+ }
+ unless (close F) {
+ 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}));
1;
}
@@ -469,13 +467,20 @@ sub update_media {
#- avoid trashing existing configuration in this case.
$urpm->{media} or return;
+ #- list of medium to update their synthesis once a pass with provides/requires will be made.
+ my @rebuild_synthesis_of_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.
foreach my $medium (@{$urpm->{media}}) {
#- take care of modified medium only or all if all have to be recomputed.
- #- but do not take care of removable media for all.
$medium->{ignore} and next;
+
+ #- and create synthesis file associated if it does not already exists...
+ -s "$urpm->{statedir}/synthesis.$medium->{hdlist}" or push @rebuild_synthesis_of_media, $medium;
+
+ #- but do not take care of removable media for all.
$medium->{modified} ||= $options{all} && $medium->{url} !~ /removable/ or next;
#- list of rpm files for this medium, only available for local medium where
@@ -495,7 +500,7 @@ sub update_media {
system("cp", "-a", "$dir/../descriptions", "$urpm->{statedir}/descriptions.$medium->{name}");
#- if the source hdlist is present and we are not forcing using rpms file
- if ($options{force} < 2 && $medium->{with_hdlist} && -e "$dir/$medium->{with_hdlist}") {
+ if (!$options{force} && $medium->{with_hdlist} && -e "$dir/$medium->{with_hdlist}") {
unlink "$urpm->{cachedir}/partial/$medium->{hdlist}";
system("cp", "-a", "$dir/$medium->{with_hdlist}", "$urpm->{cachedir}/partial/$medium->{hdlist}");
@@ -565,10 +570,10 @@ sub update_media {
#- try to sync (copy if needed) local copy after restored the previous one.
unlink "$urpm->{cachedir}/partial/$basename";
if ($medium->{synthesis}) {
- $options{force} >= 2 || ! -e "$urpm->{statedir}/synthesis.$medium->{hdlist}" or
+ $options{force} || ! -e "$urpm->{statedir}/synthesis.$medium->{hdlist}" or
system("cp", "-a", "$urpm->{statedir}/synthesis.$medium->{hdlist}", "$urpm->{cachedir}/partial/$basename");
} else {
- $options{force} >= 2 || ! -e "$urpm->{statedir}/$medium->{hdlist}" or
+ $options{force} || ! -e "$urpm->{statedir}/$medium->{hdlist}" or
system("cp", "-a", "$urpm->{statedir}/$medium->{hdlist}", "$urpm->{cachedir}/partial/$basename");
}
eval {
@@ -606,7 +611,7 @@ sub update_media {
#- make sure group and other does not have any access to this file.
unless ($error) {
- #- sort list file contents according to depslist.ordered file.
+ #- sort list file contents according to id.
my %list;
if (@files) {
foreach (@files) {
@@ -625,7 +630,7 @@ sub update_media {
close F or $medium->{synthesis} = 1; #- try hdlist as a synthesis (for probe)
}
if ($medium->{synthesis}) {
- if (my @founds = $urpm->parse_synthesis("$urpm->{cachedir}/partial/$medium->{hdlist}")) {
+ if (my @founds = $urpm->parse_synthesis($medium)) {
#- it appears hdlist file is a synthesis one in fact.
#- parse_synthesis returns all full name of package read from it.
foreach (@founds) {
@@ -665,7 +670,6 @@ sub update_media {
} else {
#- make sure to rebuild base files and clean medium modified state.
$medium->{modified} = 0;
- $urpm->{modified} = 1;
#- but use newly created file.
unlink "$urpm->{statedir}/$medium->{hdlist}";
@@ -680,62 +684,53 @@ sub update_media {
system("mv", "$urpm->{cachedir}/partial/$medium->{list}", "$urpm->{statedir}/$medium->{list}");
#- and create synthesis file associated.
- $medium->{synthesis} or $urpm->build_synthesis_hdlist($medium);
+ $medium->{synthesis} or push @rebuild_synthesis_of_media, $medium;
}
}
- #- build base files (depslist.ordered, provides, compss) according to modified global status.
- if ($urpm->{modified}) {
- #- special case if there is no more media registered.
- #- there is no need to recompute the hdlist and the files
- #- can be safely removed.
- if (@{$urpm->{media}} == 0) {
- unlink $urpm->{depslist};
- unlink $urpm->{provides};
- unlink $urpm->{compss};
-
- $urpm->{modified} = 0;
- }
-
- if ($urpm->{modified}) {
- #- cleaning.
- $urpm->{params}->clean();
+ #- build synthesis files once requires/files have been matched by rpmtools::read_hdlists.
+ if (@rebuild_synthesis_of_media) {
+ #- cleaning.
+ $urpm->{params}->clean();
- foreach my $medium (@{$urpm->{media} || []}) {
- $medium->{ignore} and next;
- if ($medium->{synthesis}) {
- $urpm->{log}(_("reading synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
- $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
- } else {
- $urpm->{log}(_("reading hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
- $urpm->{params}->read_hdlists("$urpm->{statedir}/$medium->{hdlist}") or next;
- }
+ foreach my $medium (@{$urpm->{media} || []}) {
+ $medium->{ignore} and next;
+ if ($medium->{synthesis}) {
+ #- reading the synthesis allow to propagate requires to files, so that if an hdlist can have them...
+ $urpm->{log}(_("reading synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
+ $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
+ } else {
+ $urpm->{log}(_("reading hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
+ $urpm->{params}->read_hdlists("$urpm->{statedir}/$medium->{hdlist}");
}
+ }
- $urpm->{log}(_("keeping only files referenced in provides"));
- $urpm->{params}->keep_only_cleaned_provides_files();
- foreach my $medium (@{$urpm->{media} || []}) {
- $medium->{ignore} and next;
- if ($medium->{synthesis}) {
- $urpm->{log}(_("reading synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
- $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
- } else {
- $urpm->{log}(_("reading hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
- $urpm->{params}->read_hdlists("$urpm->{statedir}/$medium->{hdlist}") or next;
- }
+ $urpm->{log}(_("keeping only files referenced in provides"));
+ $urpm->{params}->keep_only_cleaned_provides_files();
+ foreach my $medium (@{$urpm->{media} || []}) {
+ $medium->{ignore} and next;
+ unless ($medium->{synthesis}) {
+ $urpm->{log}(_("reading hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
+ my @fullnames = $urpm->{params}->read_hdlists("$urpm->{statedir}/$medium->{hdlist}");
+ $urpm->{params}{info}{$_}{medium} = $medium foreach @fullnames;
}
- if ($options{depslist}) {
- $urpm->{log}(_("computing dependencies"));
- $urpm->{params}->compute_depslist;
- } else {
- #- this is necessary to give id at least.
- $urpm->{params}->compute_id;
+ }
+
+ #- 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} || {}}) {
+ push @{$urpm->{params}{info}{$_}{provides}}, $file;
}
+ }
- #- once everything has been computed, write back the files to
- #- sync the urpmi database.
- $urpm->write_base_files();
- $urpm->{modified} = 0;
+ #- this is necessary to give id at least.
+ $urpm->{params}->compute_id;
+
+ #- rebuild all synthesis hdlist which need to be updated.
+ foreach (@rebuild_synthesis_of_media) {
+ $urpm->build_synthesis_hdlist($_);
}
#- clean headers cache directory to remove everything that is no more
@@ -844,112 +839,6 @@ sub try_umounting {
! -e $dir;
}
-#- read depslist file using rpmtools, this file is not managed directly by urpm.
-sub read_depslist {
- my ($urpm) = @_;
-
- local *F;
- open F, $urpm->{depslist} or $urpm->{error}(_("unable to read depslist file [%s]", $urpm->{depslist})), return;
- $urpm->{params}->read_depslist(\*F);
- close F;
- $urpm->{log}(_("read depslist file [%s]", $urpm->{depslist}));
- 1;
-}
-
-#- read providest file using rpmtools, this file is not managed directly by urpm.
-sub read_provides {
- my ($urpm) = @_;
-
- local *F;
- open F, $urpm->{provides} or $urpm->{error}(_("unable to read provides file [%s]", $urpm->{provides})), return;
- $urpm->{params}->read_provides(\*F);
- close F;
- $urpm->{log}(_("read provides file [%s]", $urpm->{provides}));
- 1;
-}
-
-#- read providest file using rpmtools, this file is not managed directly by urpm.
-sub read_compss {
- my ($urpm) = @_;
-
- local *F;
- open F, $urpm->{compss} or $urpm->{error}(_("unable to read compss file [%s]", $urpm->{compss})), return;
- $urpm->{params}->read_compss(\*F);
- close F;
- $urpm->{log}(_("read compss file [%s]", $urpm->{compss}));
- 1;
-}
-
-#- write base files using rpmtools, these files are not managed directly by urpm.
-sub write_base_files {
- my ($urpm) = @_;
- local *F;
-
- open F, ">$urpm->{depslist}" or $urpm->{fatal}(6, _("unable to write depslist file [%s]", $urpm->{depslist}));
- $urpm->{params}->write_depslist(\*F);
- close F;
- $urpm->{log}(_("write depslist file [%s]", $urpm->{depslist}));
-
- open F, ">$urpm->{provides}" or $urpm->{fatal}(6, _("unable to write provides file [%s]", $urpm->{provides}));
- $urpm->{params}->write_provides(\*F);
- close F;
- $urpm->{log}(_("write provides file [%s]", $urpm->{provides}));
-
- open F, ">$urpm->{compss}" or $urpm->{fatal}(6, _("unable to write compss file [%s]", $urpm->{compss}));
- $urpm->{params}->write_compss(\*F);
- close F;
- $urpm->{log}(_("write compss file [%s]", $urpm->{compss}));
-}
-
-#- try to determine which package are belonging to which medium.
-#- a flag active is used for that, transfered from medium to each
-#- package.
-#- relocation can use this flag after.
-sub filter_active_media {
- my ($urpm, %options) = @_;
- my (%fullname2id);
-
- #- build association hash to retrieve id and examine all list files.
- foreach (0 .. $#{$urpm->{params}{depslist}}) {
- my $p = $urpm->{params}{depslist}[$_];
- $fullname2id{"$p->{name}-$p->{version}-$p->{release}.$p->{arch}"} = $_;
- }
-
- #- examine each medium to search for packages.
- #- now get rpm file name in hdlist to match list file.
- require packdrake;
- foreach my $medium (@{$urpm->{media} || []}) {
- if (($medium->{active} || $options{use_update} && $medium->{update}) && !$medium->{ignore}) {
- if ($medium->{synthesis} && -r "$urpm->{statedir}/synthesis.$medium->{hdlist}") {
- local (*F, $_);
- open F, "gzip -dc '$urpm->{statedir}/synthesis.$medium->{hdlist}' |";
- while (<F>) {
- chomp;
- my ($name, $tag, @data) = split '@';
- $tag eq 'name' or next;
- my $id = delete $fullname2id{$data[0]};
- defined $id and $urpm->{params}{depslist}[$id]{active} = 1;
- }
- } elsif (-r "$urpm->{statedir}/$medium->{hdlist}") {
- my $packer = eval { new packdrake("$urpm->{statedir}/$medium->{hdlist}"); };
- $packer or $urpm->{error}(_("unable to parse correctly [%s]", "$urpm->{statedir}/$medium->{hdlist}")), next;
- foreach (@{$packer->{files}}) {
- $packer->{data}{$_}[0] eq 'f' or next;
- if (my ($fullname) = /^([^:\s]*-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*)(?::\S+)?/) {
- my $id = delete $fullname2id{$fullname};
- defined $id and $urpm->{params}{depslist}[$id]{active} = 1;
- } else {
- $urpm->{log}(_("unable to parse correctly [%s] on value \"%s\"",
- "$urpm->{statedir}/$medium->{hdlist}", $_));
- }
- }
- } else {
- $urpm->{error}(_("no hdlist file found for medium \"%s\"", $medium->{name}));
- }
- }
- }
-}
-
#- relocate depslist array id to use only the most recent packages,
#- reorder info hashes to give only access to best packages.
sub relocate_depslist_provides {
@@ -961,30 +850,26 @@ sub relocate_depslist_provides {
foreach (@{$urpm->{params}{depslist} || []}) {
my $fullname = "$_->{name}-$_->{version}-$_->{release}.$_->{arch}";
- if ($options{use_active} && !$_->{active}) {
- #- disable non active package if active flag should be checked.
- delete $urpm->{params}{info}{$fullname};
- } else {
- #- 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.
- $relocated_entries ||= 0;
- 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 {
+
+ #- 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.
+ $relocated_entries ||= 0;
+ 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}} = $_;
+ ++$relocated_entries;
}
}
}
@@ -1020,7 +905,7 @@ sub relocate_depslist_provides {
#- register local packages for being installed, keep track of source.
sub register_local_packages {
- my ($urpm, $minimal, @files) = @_;
+ my ($urpm, @files) = @_;
my ($error, @names);
#- examine each rpm and build the depslist for them using current
@@ -1037,13 +922,8 @@ sub register_local_packages {
}
$error and $urpm->{fatal}(1, _("error registering local packages"));
- #- compute id or depslist associated.
- #- minimal mode says dependencies will be resolved in a cleaner way.
- if ($minimal) {
- $urpm->{params}->compute_id;
- } else {
- $urpm->{params}->compute_depslist;
- }
+ #- allocate id to each package read.
+ $urpm->{params}->compute_id;
#- return package names...
@names;
@@ -1165,7 +1045,7 @@ sub search_packages {
#- parse synthesis file to retrieve information stored inside.
sub parse_synthesis {
- my ($urpm, $synthesis) = @_;
+ my ($urpm, $medium) = @_;
local (*F, $_);
my ($error, $last_name, @founds, %info);
@@ -1194,28 +1074,29 @@ sub parse_synthesis {
push @{$urpm->{params}{depslist}}, $found;
$urpm->{params}{provides}{$found->{name}}{$fullname} = undef;
- #- get back epoch from provides list unless it is already known, if it is defined and create entry too.
- if (defined $serial) {
- $serial and $found->{serial} = $serial;
- } else {
- foreach (@{$info{provides} || []}) {
- /(\S*)\s*==\s*(\d+:)?[^-]*-[^-]*/ && $found->{name} eq $1 && $2 > 0 and $found->{serial} = $2;
- /(\S*)/ and $urpm->{params}{provides}{$1}{$fullname} = undef;
- }
+ foreach (@{$info{requires} || []}) {
+ /([^\s\[]*)/ and $urpm->{params}{provides}{$_} ||= undef; #- do not delete, but keep in mind.
+ }
+ foreach (@{$info{provides} || []}) {
+ /([^\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)
+ #- add additional information (except name or info).
foreach my $tag (keys %info) {
$tag ne 'name' && $tag ne 'info' and $found->{$tag} ||= $info{$tag};
}
- #- help remind rpm filename.
+ $serial and $found->{serial} = $serial;
$size and $found->{size} ||= $size;
$group and $found->{group} ||= $group;
$file and $found->{file} ||= $file;
+ #- keep track of medium used.
+ $found->{medium} ||= $medium;
+
#- keep track of package found.
push @founds, $found;
} else {
@@ -1225,7 +1106,7 @@ sub parse_synthesis {
$found;
};
- open F, "gzip -dc '$synthesis' |";
+ open F, "gzip -dc '" . "$urpm->{statedir}/synthesis.$medium->{hdlist}" . "' |";
while (<F>) {
chomp;
my ($name, $tag, @data) = split '@';
@@ -1237,8 +1118,8 @@ sub parse_synthesis {
$info{$tag} = \@data;
}
!%info || $update_info->() or $urpm->{log}(_("unable to analyse synthesis data of %s", $last_name));
- close F or $urpm->{error}(_("unable to parse correctly [%s]", $synthesis)), return;
- $urpm->{log}(_("read synthesis file [%s]", $synthesis));
+ close F or $urpm->{error}(_("unable to parse correctly [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}")), return;
+ $urpm->{log}(_("read synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
@founds;
}
@@ -1247,247 +1128,187 @@ sub parse_synthesis {
#- satisfied, remove upgrade for package already installed or with a better
#- version, try to upgrade to minimize upgrade errors.
#- all additional package selected have a true value.
-sub filter_minimal_packages_to_upgrade {
+sub filter_packages_to_upgrade {
my ($urpm, $packages, $select_choices, %options) = @_;
-
- #- 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);
- local (*INPUT_CHILD, *OUTPUT);
- my $pid = 1;
-
- #- try to figure out if parsehdlist need to be called,
- #- or we have to use synthesis file.
- my @synthesis = map { "$urpm->{statedir}/synthesis.$_->{hdlist}" } grep { ! $_->{ignore} } @{$urpm->{media} || []};
- if (grep { ! -r $_ || ! -s $_ } @synthesis) {
- $urpm->{error}(_("unable to find all synthesis file, using parsehdlist server"));
- pipe INPUT, OUTPUT_CHILD;
- pipe INPUT_CHILD, OUTPUT;
- $pid = fork();
- } else {
- foreach (@synthesis) {
- $urpm->parse_synthesis($_);
- }
- }
-
- if ($pid) {
- close INPUT_CHILD;
- close OUTPUT_CHILD;
- 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 ($name, $tag, $code) = @_;
- $code or die "no callback code for parsehdlist output";
- if ($pid == 1) {
- my $p = $urpm->{params}{info}{$name} || $urpm->{params}{names}{$name};
- foreach (@{$p->{$tag} || []}) {
- $code->($_);
- }
- } else {
- print OUTPUT "$name:$tag\n";
-
- local $_;
- while (<INPUT>) {
- chomp;
- /^\s*$/ and last;
- $code->($_);
- }
- }
- };
-
- my ($db, @packages) = (rpmtools::db_open(''), keys %$packages);
- my ($id, %installed, %selected);
-
- #- at this level, compute global closure of what is requested, regardless of
- #- choices for which all package in the choices are taken and their dependencies.
- #- allow iteration over a modifying list.
- while (defined($id = shift @packages)) {
- $id =~ /\|/ and delete $packages->{$id}, $id = [ split '\|', $id ]; #- get back choices...
- if (ref $id) {
- my (@forced_selection, @selection);
-
- #- at this point we have almost only choices to resolves.
+ my ($db, @packages) = (rpmtools::db_open(''), keys %$packages);
+ my ($id, %installed, %selected);
+
+ #- at this level, compute global closure of what is requested, regardless of
+ #- choices for which all package in the choices are taken and their dependencies.
+ #- allow iteration over a modifying list.
+ while (defined($id = shift @packages)) {
+ $id =~ /\|/ and delete $packages->{$id}, $id = [ split '\|', $id ]; #- get back choices...
+ if (ref $id) {
+ my (@forced_selection, @selection);
+
+ #- at this point we have almost only choices to resolves.
#- but we have to check if one package here is already selected
#- previously, if this is the case, use it instead.
- #- if a choice is proposed with package already installed (this is the case for
- #- a provide with a lot of choices, we have to filter according to those who
+ #- if a choice is proposed with package already installed (this is the case for
+ #- a provide with a lot of choices, we have to filter according to those who
#- are installed).
- foreach (@$id) {
- if (exists $packages->{$_} ||
- rpmtools::db_traverse_tag($db, "name",
- [ $urpm->{params}{depslist}[$_]{name} ], [], undef) > 0) {
- push @forced_selection, $_;
- } else {
- push @selection, $_;
- }
+ foreach (@$id) {
+ if (exists $packages->{$_} ||
+ rpmtools::db_traverse_tag($db, "name",
+ [ $urpm->{params}{depslist}[$_]{name} ], [], undef) > 0) {
+ push @forced_selection, $_;
+ } else {
+ push @selection, $_;
}
+ }
- #- propose the choice to the user now, or select the best one (as it is supposed to be).
- @selection = @forced_selection ? @forced_selection :
- $select_choices && @selection > 1 ?
- ($select_choices->($urpm, undef, @selection)) : ($selection[0]);
- foreach (@selection) {
- unless (exists $packages->{$_}) {
- unshift @packages, $_;
- $packages->{$_} = 1;
- }
+ #- propose the choice to the user now, or select the best one (as it is supposed to be).
+ @selection = @forced_selection ? @forced_selection :
+ $select_choices && @selection > 1 ?
+ ($select_choices->($urpm, undef, @selection)) : ($selection[0]);
+ foreach (@selection) {
+ unless (exists $packages->{$_}) {
+ unshift @packages, $_;
+ $packages->{$_} = 1;
}
- next;
}
- my $pkg = $urpm->{params}{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.
- #- this is bogus as it only take care of == operator if any.
- #- defining %provides here could slow the algorithm but it solves multi-pass
- #- where a provides is A and after A == version-release, when A is already
- #- installed.
- my (%diffprovides, %provides);
-
- rpmtools::db_traverse_tag($db,
- 'name', [ $pkg->{name} ],
- [ qw(name version release sense provides) ], sub {
- my ($p) = @_;
- foreach (@{$p->{provides}}) {
- s/\[\*\]//;
- s/\[([^\]]*)\]/ $1/;
- /^(\S*\s*\S*\s*)(\d+:)?([^\s-]*)(-?\S*)/;
- foreach ($_, "$1$3", "$1$2$3", "$1$3$4") {
- $diffprovides{$_} = "$p->{name}-$p->{version}-$p->{release}";
- }
+ next;
+ }
+ my $pkg = $urpm->{params}{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.
+ #- this is bogus as it only take care of == operator if any.
+ #- defining %provides here could slow the algorithm but it solves multi-pass
+ #- where a provides is A and after A == version-release, when A is already
+ #- installed.
+ my (%diffprovides, %provides);
+
+ rpmtools::db_traverse_tag($db,
+ 'name', [ $pkg->{name} ],
+ [ qw(name version release sense provides) ], sub {
+ my ($p) = @_;
+ foreach (@{$p->{provides}}) {
+ s/\[\*\]//;
+ s/\[([^\]]*)\]/ $1/;
+ /^(\S*\s*\S*\s*)(\d+:)?([^\s-]*)(-?\S*)/ or next;
+ foreach ($_, "$1$3", "$1$2$3", "$1$3$4") {
+ $diffprovides{$_} = "$p->{name}-$p->{version}-$p->{release}";
}
- });
- $ask_child->("$pkg->{name}-$pkg->{version}-$pkg->{release}.$pkg->{arch}", "provides", sub {
- $_[0] =~ /^(\S*\s*\S*\s*)(\d+:)?([^\s-]*)(-?\S*)/;
- foreach ($_[0], "$1$3", "$1$2$3", "$1$3$4") {
- delete $diffprovides{$_};
- }
- });
- foreach ($pkg->{name}, "$pkg->{name} == $pkg->{version}", "$pkg->{name} == $pkg->{version}-$pkg->{release}") {
+ }
+ });
+ foreach (@{$pkg->{provides} || []}) {
+ s/\[\*\]//;
+ s/\[([^\]]*)\]/ $1/;
+ /^(\S*\s*\S*\s*)(\d+:)?([^\s-]*)(-?\S*)/ or next;
+ foreach ($_, "$1$3", "$1$2$3", "$1$3$4") {
delete $diffprovides{$_};
}
- delete $diffprovides{""};
-
- foreach (keys %diffprovides) {
- #- check for exact match on it.
- if (/^(\S*)\s*(\S*)\s*(\d+:)?([^\s-]*)-?(\S*)/) {
- rpmtools::db_traverse_tag($db,
- 'whatrequires', [ $1 ],
- [ qw(name version release sense requires) ], sub{
- my ($p) = @_;
- foreach (@{$p->{requires}}) {
- s/\[\*\]//;
- s/\[([^\]]*)\]/ $1/;
- exists $diffprovides{$_} and $provides{$p->{name}} = undef;
- }
- });
- }
+ }
+ foreach ($pkg->{name}, "$pkg->{name} == $pkg->{version}", "$pkg->{name} == $pkg->{version}-$pkg->{release}") {
+ delete $diffprovides{$_};
+ }
+ delete $diffprovides{""};
+
+ foreach (keys %diffprovides) {
+ #- check for exact match on it.
+ if (/^(\S*)\s*(\S*)\s*(\d+:)?([^\s-]*)-?(\S*)/) {
+ rpmtools::db_traverse_tag($db,
+ 'whatrequires', [ $1 ],
+ [ qw(name version release sense requires) ], sub{
+ my ($p) = @_;
+ foreach (@{$p->{requires}}) {
+ s/\[\*\]//;
+ s/\[([^\]]*)\]/ $1/;
+ exists $diffprovides{$_} and $provides{$p->{name}} = undef;
+ }
+ });
}
+ }
- #- iterate over requires of the packages, register them.
- $provides{$pkg->{name}} = undef; #"$pkg->{name}-$pkg->{version}-$pkg->{release}";
- $ask_child->("$pkg->{name}-$pkg->{version}-$pkg->{release}.$pkg->{arch}", "requires", sub {
- if (my ($n, $o, $v, $r) = $_[0] =~ /^(\S*)\s*(\S*)\s*([^\s\-]*)-?(\S*)/) {
- exists $provides{$n} || exists $selected{$n} and return;
- #- if the provides is not found, it will be resolved at next step, else
- #- it will be resolved by searching the rpm database.
- $provides{$n} ||= undef;
- my $check_pkg = sub {
- $options{keep_alldeps} and return;
- $v and eval(rpmtools::version_compare($_[0]{version}, $v) . $o . 0) || return;
- $r and eval(rpmtools::version_compare($_[0]{release}, $r) . $o . 0) || return;
- $provides{$n} = "$_[0]{name}-$_[0]{version}-$_[0]{release}";
- };
- rpmtools::db_traverse_tag($db, $n =~ m|^/| ? 'path' : 'whatprovides', [ $n ],
- [ qw (name version release) ], $check_pkg);
- }
- });
+ #- iterate over requires of the packages, register them.
+ $provides{$pkg->{name}} = undef; #"$pkg->{name}-$pkg->{version}-$pkg->{release}";
+ foreach (@{$pkg->{requires} || []}) {
+ if (my ($n, $o, $v, $r) = /^([^\s\[]*)(?:\[\*\])?(?:\s+|\[)?([^\s\]]*)\s*([^\s\-\]]*)-?([^\s\]]*)/) {
+ exists $provides{$n} || exists $selected{$n} 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.
+ $provides{$n} ||= undef;
+ my $check_pkg = sub {
+ $options{keep_alldeps} and return;
+ $v and eval(rpmtools::version_compare($_[0]{version}, $v) . $o . 0) || return;
+ $r and eval(rpmtools::version_compare($_[0]{release}, $r) . $o . 0) || return;
+ $provides{$n} = "$_[0]{name}-$_[0]{version}-$_[0]{release}";
+ };
+ rpmtools::db_traverse_tag($db, $n =~ m|^/| ? 'path' : 'whatprovides', [ $n ],
+ [ qw (name version release) ], $check_pkg);
+ }
+ }
- #- at this point, all unresolved provides (requires) should be fixed by
- #- provides files, try to minimize choice at this level.
- foreach (keys %provides) {
- $provides{$_} || exists $selected{$_} and next;
- $selected{$_} = undef;
+ #- at this point, all unresolved provides (requires) should be fixed by
+ #- provides files, try to minimize choice at this level.
+ foreach (keys %provides) {
+ $provides{$_} || exists $selected{$_} and next;
+ $selected{$_} = undef;
- my (%pre_choices, @pre_choices, @choices, @upgradable_choices, %choices_id);
- foreach my $fullname (keys %{$urpm->{params}{provides}{$_} || {}}) {
- my $pkg = $urpm->{params}{info}{$fullname};
- push @{$pre_choices{$pkg->{name}}}, $pkg;
- }
- foreach (values %pre_choices) {
- #- there is at least one element in each list of values.
- if (@$_ == 1) {
- push @pre_choices, $_->[0];
- } else {
- #- 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;
- foreach my $pkg (@$_) {
- $pkg == $candidate_pkg and $chosen_pkg = $pkg, last;
- }
+ my (%pre_choices, @pre_choices, @choices, @upgradable_choices, %choices_id);
+ foreach my $fullname (keys %{$urpm->{params}{provides}{$_} || {}}) {
+ my $pkg = $urpm->{params}{info}{$fullname};
+ push @{$pre_choices{$pkg->{name}}}, $pkg;
+ }
+ foreach (values %pre_choices) {
+ #- there is at least one element in each list of values.
+ if (@$_ == 1) {
+ push @pre_choices, $_->[0];
+ } else {
+ #- 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;
+ 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.
- push @pre_choices, $chosen_pkg;
}
+ $chosen_pkg ||= $urpm->{params}{names}{$_->[0]{name}}; #- at least take the best normally used.
+ push @pre_choices, $chosen_pkg;
}
- foreach my $pkg (@pre_choices) {
- push @choices, $pkg;
-
- unless ($options{keep_alldeps}) {
- rpmtools::db_traverse_tag($db,
- 'name', [ $pkg->{name} ],
- [ qw(name version release serial) ], sub {
- my ($p) = @_;
- my $cmp = rpmtools::version_compare($pkg->{version},
- $p->{version});
- $installed{$pkg->{id}} ||= !($pkg->{serial} > $p->{serial} || $pkg->{serial} == $p->{serial} && ($cmp > 0 || $cmp == 0 && rpmtools::version_compare($pkg->{release}, $p->{release}) > 0));
- });
- }
- $installed{$pkg->{id}} and delete $packages->{$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;
- }
- exists $installed{$pkg->{id}} and push @upgradable_choices, $pkg;
+ }
+ foreach my $pkg (@pre_choices) {
+ push @choices, $pkg;
+
+ unless ($options{keep_alldeps}) {
+ rpmtools::db_traverse_tag($db,
+ 'name', [ $pkg->{name} ],
+ [ qw(name version release serial) ], sub {
+ my ($p) = @_;
+ my $cmp = rpmtools::version_compare($pkg->{version}, $p->{version});
+ $installed{$pkg->{id}} ||= !($pkg->{serial} > $p->{serial} ||
+ $pkg->{serial} == $p->{serial} &&
+ ($cmp > 0 || $cmp == 0 &&
+ rpmtools::version_compare($pkg->{release},
+ $p->{release}) > 0));
+ });
}
- @upgradable_choices > 0 and @choices = @upgradable_choices;
- @choices_id{map { $_->{id} } @choices} = ();
- if (keys(%choices_id) > 0) {
- if (keys(%choices_id) == 1) {
- my ($id) = keys(%choices_id);
- exists $packages->{$id} or $packages->{$id} = 1;
- unshift @packages, $id;
- } else {
- push @packages, [ sort { $a <=> $b } keys %choices_id ];
- }
+ $installed{$pkg->{id}} and delete $packages->{$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;
+ }
+ exists $installed{$pkg->{id}} and push @upgradable_choices, $pkg;
+ }
+ @upgradable_choices > 0 and @choices = @upgradable_choices;
+ @choices_id{map { $_->{id} } @choices} = ();
+ if (keys(%choices_id) > 0) {
+ if (keys(%choices_id) == 1) {
+ my ($id) = keys(%choices_id);
+ exists $packages->{$id} or $packages->{$id} = 1;
+ unshift @packages, $id;
+ } else {
+ push @packages, [ sort { $a <=> $b } keys %choices_id ];
}
}
}
-
- rpmtools::db_close($db);
-
- #- no need to still use the child as this point, we can let him to terminate.
- 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 { ! $_->{ignore} } @{$urpm->{media} || []}
- or rpmtools::_exit(1);
}
+
+ rpmtools::db_close($db);
}
#- get out of package that should not be upgraded.
@@ -1534,7 +1355,7 @@ sub get_source_packages {
if (-r "$urpm->{statedir}/$medium->{list}" && !$medium->{ignore}) {
if ($medium->{synthesis} && -r "$urpm->{statedir}/synthesis.$medium->{hdlist}") {
#- rpm filename is stored in synthesis file now.
- my @list = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
+ # TODO my @list = $urpm->parse_synthesis($medium);
@list > 0 or $urpm->{log}(_("unable to parse correctly [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
foreach (@list) {
my $fullname = "$_->{name}-$_->{version}-$_->{release}.$_->{arch}";
@@ -1800,9 +1621,10 @@ sub select_packages_to_upgrade {
select((select(OUTPUT), $| = 1)[0]);
#- for medium not having hdlist (because of only synthesis file used)
- #- let parse synthesis file.
- foreach (grep { -r $_ && -s $_ }
- map { "$urpm->{statedir}/synthesis.$_->{hdlist}" }
+ #- synthesis has already been parsed, any property in synthesis have already
+ #- been parsed too, only specific need like obsoletes or files may
+ #- need parsehdlist interactivity with hdlist.
+ foreach (grep { -r "$urpm->{statedir}/synthesis.$_->{hdlist}" && -s "$urpm->{statedir}/synthesis.$_->{hdlist}" }
grep { $_->{synthesis} && ! $_->{ignore} } @{$urpm->{media} || []}) {
$urpm->parse_synthesis($_);
}