0.84-1mdk

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