diff options
| -rw-r--r-- | URPM.pm | 2 | ||||
| -rw-r--r-- | URPM.xs | 33 | ||||
| -rw-r--r-- | URPM/Resolve.pm | 150 | ||||
| -rw-r--r-- | perl-URPM.spec | 15 |
4 files changed, 106 insertions, 94 deletions
@@ -4,7 +4,7 @@ use strict; use DynaLoader; our @ISA = qw(DynaLoader); -our $VERSION = '0.83'; +our $VERSION = '0.84'; URPM->bootstrap($VERSION); @@ -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 |