aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--URPM.pm2
-rw-r--r--URPM.xs33
-rw-r--r--URPM/Resolve.pm150
-rw-r--r--perl-URPM.spec15
4 files changed, 106 insertions, 94 deletions
diff --git a/URPM.pm b/URPM.pm
index e571a77..04f6b03 100644
--- a/URPM.pm
+++ b/URPM.pm
@@ -4,7 +4,7 @@ use strict;
use DynaLoader;
our @ISA = qw(DynaLoader);
-our $VERSION = '0.83';
+our $VERSION = '0.84';
URPM->bootstrap($VERSION);
diff --git a/URPM.xs b/URPM.xs
index 9a35dd0..ae6c475 100644
--- a/URPM.xs
+++ b/URPM.xs
@@ -693,7 +693,7 @@ pack_header(URPM__Package pkg) {
}
static void
-update_provide_entry(char *name, STRLEN len, int force, URPM__Package pkg, HV *provides) {
+update_provide_entry(char *name, STRLEN len, int force, IV use_sense, URPM__Package pkg, HV *provides) {
SV** isv;
if (!len) len = strlen(name);
@@ -712,7 +712,8 @@ update_provide_entry(char *name, STRLEN len, int force, URPM__Package pkg, HV *p
if (isv && *isv != &PL_sv_undef) {
char id[8];
STRLEN id_len = snprintf(id, sizeof(id), "%d", pkg->flag & FLAG_ID);
- hv_fetch((HV*)SvRV(*isv), id, id_len, 1);
+ SV **sense = hv_fetch((HV*)SvRV(*isv), id, id_len, 1);
+ if (sense && use_sense) sv_setiv(*sense, use_sense);
}
}
}
@@ -723,6 +724,7 @@ update_provides(URPM__Package pkg, HV *provides) {
int len;
int_32 type, count;
char **list = NULL;
+ int_32 *flags = NULL;
int i;
/* examine requires for files which need to be marked in provides */
@@ -737,10 +739,12 @@ update_provides(URPM__Package pkg, HV *provides) {
/* update all provides */
headerGetEntry(pkg->h, RPMTAG_PROVIDENAME, &type, (void **) &list, &count);
if (list) {
+ headerGetEntry(pkg->h, RPMTAG_PROVIDEFLAGS, &type, (void **) &flags, &count);
for (i = 0; i < count; ++i) {
len = strlen(list[i]);
if (!strncmp(list[i], "rpmlib(", 7)) continue;
- update_provide_entry(list[i], len, 1, pkg, provides);
+ update_provide_entry(list[i], len, 1, flags && flags[i] & (RPMSENSE_PREREQ|RPMSENSE_LESS|RPMSENSE_EQUAL|RPMSENSE_GREATER),
+ pkg, provides);
}
}
} else {
@@ -767,11 +771,11 @@ update_provides(URPM__Package pkg, HV *provides) {
ps = strchr(s, '@');
while(ps != NULL) {
*ps = 0; es = strchr(s, '['); if (!es) es = strchr(s, ' '); *ps = '@';
- update_provide_entry(s, es != NULL ? es-s : ps-s, 1, pkg, provides);
+ update_provide_entry(s, es != NULL ? es-s : ps-s, 1, es != NULL, pkg, provides);
s = ps + 1; ps = strchr(s, '@');
}
es = strchr(s, '['); if (!es) es = strchr(s, ' ');
- update_provide_entry(s, es != NULL ? es-s : 0, 1, pkg, provides);
+ update_provide_entry(s, es != NULL ? es-s : 0, 1, es != NULL, pkg, provides);
}
}
}
@@ -802,7 +806,7 @@ update_provides_files(URPM__Package pkg, HV *provides) {
if (p - buff + len >= sizeof(buff)) continue;
memcpy(p, baseNames[i], len + 1); p += len;
- update_provide_entry(buff, p-buff, 0, pkg, provides);
+ update_provide_entry(buff, p-buff, 0, 0, pkg, provides);
}
free(baseNames);
@@ -813,7 +817,7 @@ update_provides_files(URPM__Package pkg, HV *provides) {
for (i = 0; i < count; i++) {
len = strlen(list[i]);
- update_provide_entry(list[i], len, 0, pkg, provides);
+ update_provide_entry(list[i], len, 0, 0, pkg, provides);
}
free(list);
@@ -2403,7 +2407,21 @@ Trans_remove(trans, name)
Header h;
rpmdbMatchIterator mi;
int count = 0;
+ char *boa = NULL, *bor = NULL;
CODE:
+ /* hide arch in name if present */
+ if ((boa = strrchr(name, '.'))) {
+ *boa = 0;
+ if ((bor = strrchr(name, '-'))) {
+ *bor = 0;
+ if (!strrchr(name, '-')) {
+ *boa = '.'; boa = NULL;
+ }
+ *bor = '-'; bor = NULL;
+ } else {
+ *boa = '.'; boa = NULL;
+ }
+ }
#ifdef RPM_42
mi = rpmtsInitIterator(trans->ts, RPMDBI_LABEL, name, 0);
#else
@@ -2421,6 +2439,7 @@ Trans_remove(trans, name)
}
}
rpmdbFreeIterator(mi);
+ if (boa) *boa = '.';
RETVAL=count;
OUTPUT:
RETVAL
diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm
index 7624254..da26dda 100644
--- a/URPM/Resolve.pm
+++ b/URPM/Resolve.pm
@@ -35,50 +35,65 @@ sub find_candidate_packages {
#- return unresolved requires of a package (a new one or a existing one).
sub unsatisfied_requires {
- my ($_urpm, $db, $state, $pkg, %options) = @_;
+ my ($urpm, $db, $state, $pkg, %options) = @_;
my %properties;
#- all requires should be satisfied according to selected package, or installed packages.
- foreach ($pkg->requires) {
- if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
+ REQUIRES: foreach my $dep ($pkg->requires) {
+ if (my ($n, $s) = $dep =~ /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
#- allow filtering on a given name (to speed up some search).
- ! defined $options{name} || $n eq $options{name} or next;
+ ! defined $options{name} || $n eq $options{name} or next REQUIRES;
#- avoid recomputing the same all the time.
- exists $properties{$_} || $state->{installed}{$_} and next;
+ exists $properties{$dep} and next REQUIRES;
+
+ #- check for installed package in the cache (only without sense to speed up)
+ foreach (keys %{$state->{cached_installed}{$n} || {}}) {
+ exists $state->{obsoleted}{$_} and next;
+ exists $state->{ask_remove}{$_} and next;
+ next REQUIRES;
+ }
- #- keep track if satisfied.
- my $satisfied = 0;
#- check on selected package if a provide is satisfying the resolution (need to do the ops).
- foreach my $sense (keys %{$state->{provided}{$n} || {}}) {
- ranges_overlap($sense, $s) and ++$satisfied, last;
+ foreach (keys %{$urpm->{provides}{$n} || {}}) {
+ exists $state->{selected}{$_} or next;
+ my $p = $urpm->{depslist}[$_];
+ if ($urpm->{provides}{$n}{$_}) {
+ #- sense information are used, this means we have to examine carrefully the provides.
+ foreach ($p->provides) {
+ ranges_overlap($_, $dep) and next REQUIRES;
+ }
+ } else {
+ next REQUIRES;
+ }
}
+
#- check on installed system a package which is not obsoleted is satisfying the require.
- unless ($satisfied) {
- if ($n =~ /^\//) {
- $db->traverse_tag('path', [ $n ], sub {
- my ($p) = @_;
- exists $state->{obsoleted}{$p->fullname} and return;
- $state->{ask_remove}{join '-', ($p->fullname)[0..2]} and return;
- ++$satisfied;
- });
- } else {
- $db->traverse_tag('whatprovides', [ $n ], sub {
- my ($p) = @_;
- exists $state->{obsoleted}{$p->fullname} and return;
- $state->{ask_remove}{join '-', ($p->fullname)[0..2]} and return;
- foreach ($p->provides) {
- $options{keep_state} or $state->{installed}{$_}{$p->fullname} = undef;
- if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- $pn eq $n or next;
- ranges_overlap($ps, $s) and ++$satisfied;
- }
+ my $satisfied = 0;
+ if ($n =~ /^\//) {
+ $db->traverse_tag('path', [ $n ], sub {
+ my ($p) = @_;
+ exists $state->{obsoleted}{$p->fullname} and return;
+ exists $state->{ask_remove}{$p->fullname} and return;
+ $state->{cached_installed}{$n}{$p->fullname} = undef;
+ ++$satisfied;
+ });
+ } else {
+ $db->traverse_tag('whatprovides', [ $n ], sub {
+ my ($p) = @_;
+ exists $state->{obsoleted}{$p->fullname} and return;
+ exists $state->{ask_remove}{$p->fullname} and return;
+ foreach ($p->provides) {
+ if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
+ $ps or $state->{cached_installed}{$pn}{$p->fullname} = undef;
+ $pn eq $n or next;
+ ranges_overlap($ps, $s) and ++$satisfied;
}
- });
- }
+ }
+ });
}
#- if nothing can be done, the require should be resolved.
- $satisfied or $properties{$_} = undef;
+ $satisfied or $properties{$dep} = undef;
}
}
keys %properties;
@@ -87,30 +102,23 @@ sub unsatisfied_requires {
#- close ask_remove (as urpme previously) for package to be removable without error.
sub resolve_closure_ask_remove {
my ($urpm, $db, $state, $pkg, $from, $why, $avoided) = @_;
- my $name = join '-', ($pkg->fullname)[0..2]; #- specila name (without arch) to allow selection.
my @unsatisfied;
#- allow default value for 'from' to be taken.
- $from ||= $name;
+ $from ||= $pkg->fullname;
#- keep track to avoided removed package.
$avoided and $avoided->{$pkg->fullname} = undef;
#- check if the package has already been asked to be removed,
#- this means only add the new reason and return.
- unless ($state->{ask_remove}{$name}) {
- $state->{ask_remove}{$name} = { size => $pkg->size,
- closure => { $from => $why },
- };
+ unless ($state->{ask_remove}{$pkg->fullname}) {
+ $state->{ask_remove}{$pkg->fullname} = { size => $pkg->size,
+ closure => { $from => $why },
+ };
my @removes = $pkg;
while ($pkg = shift @removes) {
- #- clean state according to provided properties.
- foreach ($pkg->provides) {
- delete $state->{installed}{$_}{$pkg->fullname};
- %{$state->{installed}{$_} || {}} or delete $state->{installed}{$_};
- }
-
#- close what requires this property, but check with selected package requiring old properties.
foreach ($pkg->provides) {
if (my ($n) = /^([^\s\[]*)/) {
@@ -125,13 +133,13 @@ sub resolve_closure_ask_remove {
$db->traverse_tag('whatrequires', [ $n ], sub {
my ($p) = @_;
if (my @l = $urpm->unsatisfied_requires($db, $state, $p, name => $n, keep_state => 1)) {
- my $v = $state->{ask_remove}{join '-', ($p->fullname)[0..2]} ||= {};
+ my $v = $state->{ask_remove}{$p->fullname} ||= {};
#- keep track to avoided removed package.
$avoided and $avoided->{$p->fullname} = undef;
#- keep track of what cause closure.
- $v->{closure}{$name} = { unsatisfied => \@l };
+ $v->{closure}{$pkg->fullname} = { unsatisfied => \@l };
exists $v->{size} and return;
$v->{size} = $p->size;
@@ -143,7 +151,7 @@ sub resolve_closure_ask_remove {
}
}
} else {
- $state->{ask_remove}{$name}{closure}{$from} = $why;
+ $state->{ask_remove}{$pkg->fullname}{closure}{$from} = $why;
}
@unsatisfied;
@@ -158,16 +166,6 @@ sub resolve_closure_ask_remove {
#- the following options are recognized :
#- check : check requires of installed packages.
sub resolve_requested {
- #- internal method to simplify code.
- sub update_state_provides {
- my ($state, $pkg) = @_;
- foreach ($pkg->provides) {
- if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- $state->{provided}{$n}{$s}{$pkg->id} = undef;
- }
- }
- };
-
my ($urpm, $db, $state, $requested, %options) = @_;
my (@properties, @obsoleted, %requested, %avoided, $dep);
@@ -175,7 +173,9 @@ sub resolve_requested {
#- on choices instead of anything other one.
@properties = keys %$requested;
foreach my $dep (@properties) {
- @requested{split '\|', $dep} = ();
+ foreach (split '\|', $dep) {
+ $requested{$_} = $requested->{$dep};
+ }
}
#- for each dep property evaluated, examine which package will be obsoleted on $db,
@@ -294,7 +294,6 @@ sub resolve_requested {
$db->traverse_tag('name', [ $pkg->name ], sub {
my ($p) = @_;
if ($pkg->compare_pkg($p) < 0) {
- $allow or update_state_provides($state, $pkg);
$allow = ++$state->{oldpackage};
$options{keep_state} or
push @properties, $urpm->resolve_closure_ask_remove($db, $state, $p, $pkg->id,
@@ -318,10 +317,6 @@ sub resolve_requested {
#- check if package is not already installed before trying to use it, compute
#- obsoleted package too. this is valable only for non source package.
if ($pkg->arch ne 'src') {
- #- keep in mind the provides of this package, so that future requires can be satisfied
- #- with this package potentially.
- $allow or update_state_provides($state, $pkg);
-
foreach ($pkg->name." < ".$pkg->epoch.":".$pkg->version."-".$pkg->release, $pkg->obsoletes) {
if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?\s*\[?([^\s\]]*)\s*([^\s\]]*)/) {
#- populate avoided entries according to what is selected.
@@ -349,14 +344,17 @@ sub resolve_requested {
$state->{obsoleted}{$p->fullname}{$pkg->id} = undef;
foreach ($p->provides) {
- #- clean installed property.
- if (my ($ip) = $state->{installed}{$_}) {
- delete $ip->{$p->fullname};
- %$ip or delete $state->{installed}{$_};
- }
#- check differential provides between obsoleted package and newer one.
if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- ($state->{provided}{$pn} || {})->{$ps} or $diff_provides{$pn} = undef;
+ $diff_provides{$pn} = undef;
+ foreach (grep { exists $state->{selected}{$_} }
+ keys %{$urpm->{provides}{$pn} || {}}) {
+ my $pp = $urpm->{depslist}[$_];
+ foreach ($pp->provides) {
+ /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/ && $1 eq $pn or next;
+ $2 eq $ps and delete $diff_provides{$pn};
+ }
+ }
}
}
});
@@ -481,18 +479,6 @@ sub resolve_requested {
}
if ($options{keep_state}) {
- #- clear state provided according to selection done.
- foreach (keys %{$state->{selected} || {}}) {
- my $pkg = $urpm->{depslist}[$_];
-
- foreach ($pkg->provides) {
- if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- delete $state->{provided}{$n}{$s}{$pkg->id};
- %{$state->{provided}{$n}{$s}} or delete $state->{provided}{$n}{$s};
- }
- }
- }
-
#- clear state obsoleted according to saved obsoleted.
foreach (@obsoleted) {
if (ref $_) {
@@ -537,10 +523,6 @@ sub resolve_unrequested {
#- state should be cleaned by any reference to it.
foreach ($pkg->provides) {
$diff_provides{$_} = undef;
- if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- delete $state->{provided}{$n}{$s}{$pkg->id};
- %{$state->{provided}{$n}{$s}} or delete $state->{provided}{$n}{$s};
- }
}
foreach ($pkg->name, $pkg->obsoletes_nosense) {
$db->traverse_tag('name', [ $_ ], sub {
diff --git a/perl-URPM.spec b/perl-URPM.spec
index e91cba8..d7f3cb4 100644
--- a/perl-URPM.spec
+++ b/perl-URPM.spec
@@ -1,7 +1,7 @@
%define name perl-URPM
%define real_name URPM
-%define version 0.83
-%define release 4mdk
+%define version 0.84
+%define release 1mdk
%{expand:%%define rpm_version %(rpm -q --queryformat '%{VERSION}-%{RELEASE}' rpm)}
@@ -51,6 +51,17 @@ rm -rf $RPM_BUILD_ROOT
%changelog
+* Fri May 16 2003 François Pons <fpons@mandrakesoft.com> 0.84-1mdk
+- removed provided hash from state and added use_sense value to
+ provides hash values when using sense.
+- removed installed hash from state and added cached_installed
+ which is no more updated and cached installed provides without
+ sense associated.
+- allow removing of package by giving the fullname (with arch).
+- changed ask_remove hash keys to be fullname compliant.
+- light improvement of speed (10%% faster on dependencies
+ computation) and memory usage (provided hashes removed).
+
* Wed May 14 2003 François Pons <fpons@mandrakesoft.com> 0.83-4mdk
- completed URPM::Transaction::verify_rpm for signature checking
and added a lot of more options (including db to avoid openning