0.91-1mdk0.91

5 files changed, 204 insertions, 78 deletions

diff --git a/URPM.pm b/URPM.pm
index 0be03d9..b599c6d 100644
--- a/URPM.pm
+++ b/URPM.pm
@@ -4,7 +4,7 @@ use strict;
 use DynaLoader;
 
 our @ISA = qw(DynaLoader);
-our $VERSION = '0.90';
+our $VERSION = '0.91';
 
 URPM->bootstrap($VERSION);
 
diff --git a/URPM.xs b/URPM.xs
index 98a882e..404675c 100644
--- a/URPM.xs
+++ b/URPM.xs
@@ -72,24 +72,23 @@ typedef rpmdb URPM__DB;
 typedef struct s_Transaction* URPM__Transaction;
 typedef struct s_Package* URPM__Package;
 
-#define FLAG_ID             0x000fffffU
-#define FLAG_RATE           0x00700000U
-#define FLAG_SKIP           0x00800000U
-#define FLAG_BASE           0x01000000U
-#define FLAG_FORCE          0x02000000U
-#define FLAG_INSTALLED      0x04000000U
-#define FLAG_REQUESTED      0x08000000U
-#define FLAG_REQUIRED       0x10000000U
-#define FLAG_UPGRADE        0x20000000U
-#define FLAG_OBSOLETE       0x40000000U
-#define FLAG_NO_HEADER_FREE 0x80000000U
-
-#define FLAG_ID_MAX         0x000ffffe
-#define FLAG_ID_INVALID     0x000fffff
-
-#define FLAG_RATE_POS       20
-#define FLAG_RATE_MAX       5
-#define FLAG_RATE_INVALID   0
+#define FLAG_ID               0x001fffffU
+#define FLAG_RATE             0x00e00000U
+#define FLAG_BASE             0x01000000U
+#define FLAG_SKIP             0x02000000U
+#define FLAG_DISABLE_OBSOLETE 0x04000000U
+#define FLAG_INSTALLED        0x08000000U
+#define FLAG_REQUESTED        0x10000000U
+#define FLAG_REQUIRED         0x20000000U
+#define FLAG_UPGRADE          0x40000000U
+#define FLAG_NO_HEADER_FREE   0x80000000U
+
+#define FLAG_ID_MAX           0x001ffffe
+#define FLAG_ID_INVALID       0x001fffff
+
+#define FLAG_RATE_POS         21
+#define FLAG_RATE_MAX         5
+#define FLAG_RATE_INVALID     0
 
 
 #define FILENAME_TAG 1000000
@@ -1989,6 +1988,45 @@ Pkg_build_header(pkg, fileno)
   } else croak("no header available for package");
 
 int
+Pkg_flag(pkg, name)
+  URPM::Package pkg
+  char *name
+  PREINIT:
+  unsigned mask;
+  CODE:
+  if (!strcmp(name, "skip")) mask = FLAG_SKIP;
+  else if (!strcmp(name, "disable_obsolete")) mask = FLAG_DISABLE_OBSOLETE;
+  else if (!strcmp(name, "installed")) mask = FLAG_INSTALLED;
+  else if (!strcmp(name, "requested")) mask = FLAG_REQUESTED;
+  else if (!strcmp(name, "required")) mask = FLAG_REQUIRED;
+  else if (!strcmp(name, "upgrade")) mask = FLAG_UPGRADE;
+  else croak("unknown flag: %s", name);
+  RETVAL = pkg->flag & mask;
+  OUTPUT:
+  RETVAL
+
+int
+Pkg_set_flag(pkg, name, value=1)
+  URPM::Package pkg
+  char *name
+  int value
+  PREINIT:
+  unsigned mask;
+  CODE:
+  if (!strcmp(name, "skip")) mask = FLAG_SKIP;
+  else if (!strcmp(name, "disable_obsolete")) mask = FLAG_DISABLE_OBSOLETE;
+  else if (!strcmp(name, "installed")) mask = FLAG_INSTALLED;
+  else if (!strcmp(name, "requested")) mask = FLAG_REQUESTED;
+  else if (!strcmp(name, "required")) mask = FLAG_REQUIRED;
+  else if (!strcmp(name, "upgrade")) mask = FLAG_UPGRADE;
+  else croak("unknown flag: %s", name);
+  RETVAL = pkg->flag & mask;
+  if (value) pkg->flag |= mask;
+  else       pkg->flag &= ~mask;
+  OUTPUT:
+  RETVAL
+
+int
 Pkg_flag_skip(pkg)
   URPM::Package pkg
   CODE:
@@ -2027,21 +2065,21 @@ Pkg_set_flag_base(pkg, value=1)
   RETVAL
 
 int
-Pkg_flag_force(pkg)
+Pkg_flag_disable_obsolete(pkg)
   URPM::Package pkg
   CODE:
-  RETVAL = pkg->flag & FLAG_FORCE;
+  RETVAL = pkg->flag & FLAG_DISABLE_OBSOLETE;
   OUTPUT:
   RETVAL
 
 int
-Pkg_set_flag_force(pkg, value=1)
+Pkg_set_flag_disable_obsolete(pkg, value=1)
   URPM::Package pkg
   int value
   CODE:
-  RETVAL = pkg->flag & FLAG_FORCE;
-  if (value) pkg->flag |= FLAG_FORCE;
-  else       pkg->flag &= ~FLAG_FORCE;
+  RETVAL = pkg->flag & FLAG_DISABLE_OBSOLETE;
+  if (value) pkg->flag |= FLAG_DISABLE_OBSOLETE;
+  else       pkg->flag &= ~FLAG_DISABLE_OBSOLETE;
   OUTPUT:
   RETVAL
 
@@ -2122,25 +2160,6 @@ Pkg_set_flag_upgrade(pkg, value=1)
   RETVAL
 
 int
-Pkg_flag_obsolete(pkg)
-  URPM::Package pkg
-  CODE:
-  RETVAL = pkg->flag & FLAG_OBSOLETE;
-  OUTPUT:
-  RETVAL
-
-int
-Pkg_set_flag_obsolete(pkg, value=1)
-  URPM::Package pkg
-  int value
-  CODE:
-  RETVAL = pkg->flag & FLAG_OBSOLETE;
-  if (value) pkg->flag |= FLAG_OBSOLETE;
-  else       pkg->flag &= ~FLAG_OBSOLETE;
-  OUTPUT:
-  RETVAL
-
-int
 Pkg_flag_selected(pkg)
   URPM::Package pkg
   CODE:
diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm
index c7e8451..7f1d74e 100644
--- a/URPM/Resolve.pm
+++ b/URPM/Resolve.pm
@@ -159,7 +159,7 @@ sub unsatisfied_requires {
 	    #- check on selected package if a provide is satisfying the resolution (need to do the ops).
 	    foreach (keys %{$urpm->{provides}{$n} || {}}) {
 		my $p = $urpm->{depslist}[$_];
-		$p->flag_selected || exists $state->{selected}{$_} or next;
+		exists $state->{selected}{$_} or next;
 		if ($urpm->{provides}{$n}{$_}) {
 		    #- sense information are used, this means we have to examine carrefully the provides.
 		    foreach ($p->provides) {
@@ -202,7 +202,7 @@ sub unsatisfied_requires {
 sub backtrack_selected {
     my ($urpm, $db, $state, $dep, %options) = @_;
 
-    if (defined $dep->{required} && $options{callback_backtrack}) {
+    if (defined $dep->{required}) {
 	#- search for all possible packages, first is to try the selection, then if it is
 	#- impossible, backtrack the origin.
 	my $packages = $urpm->find_candidate_packages($dep->{required});
@@ -213,8 +213,11 @@ sub backtrack_selected {
 		exists $state->{backtrack}{selected}{$_->id} and next;
 		#- a package if found is problably rejected or there is a problem.
 		if ($state->{rejected}{$_->fullname}) {
-		    if ($options{callback_backtrack}->($urpm, $db, $state, $_,
+		    if (!$options{callback_backtrack} ||
+			$options{callback_backtrack}->($urpm, $db, $state, $_,
 						       dep => $dep, alternatives => $packages, %options) <= 0) {
+			#- keep in mind a backtrack has happening here...
+			$state->{rejected}{$_->fullname}{backtrack} ||= {};
 			#- backtrack callback should return a strictly positive value if the selection of the new
 			#- package is prefered over the currently selected package.
 			next;
@@ -341,11 +344,13 @@ sub resolve_requested {
 
     #- populate properties with backtrack informations.
     while (my ($r, $v) = each %$requested) {
-	#- keep track of requested packages by propating the flag.
-	my $packages = $urpm->find_candidate_packages($r);
-	foreach (values %$packages) {
-	    foreach (@$_) {
-		$_->set_flag_requested;
+	unless ($options{keep_requested_flag}) {
+	    #- keep track of requested packages by propating the flag.
+	    my $packages = $urpm->find_candidate_packages($r);
+	    foreach (values %$packages) {
+		foreach (@$_) {
+		    $_->set_flag_requested;
+		}
 	    }
 	}
 	#- keep value to be available from selected hash.
@@ -362,7 +367,7 @@ sub resolve_requested {
 	#- in case of keep_unrequested_dependencies option is not set, we need to avoid
 	#- selecting packages if the source has been disabled.
 	if (exists $dep->{from} && !$options{keep_unrequested_dependencies}) {
-	    $dep->{from}->flag_selected || exists $state->{selected}{$dep->{from}->id} or next;
+	    exists $state->{selected}{$dep->{from}->id} or next;
 	}
 
 	#- take the best choice possible.
@@ -389,7 +394,7 @@ sub resolve_requested {
 
 	#- now do the real work, select the package.
 	my ($pkg) = @chosen;
-	!$pkg || $pkg->flag_selected || exists $state->{selected}{$pkg->id} and next;
+	!$pkg || exists $state->{selected}{$pkg->id} and next;
 
 	if ($pkg->arch eq 'src') {
 	    $pkg->set_flag_upgrade;
@@ -430,13 +435,14 @@ sub resolve_requested {
 	push @selected, $pkg;
 	$state->{selected}{$pkg->id} = { exists $dep->{requested} ? (requested => $dep->{requested}) : @{[]},
 					 exists $dep->{from} ? (from => $dep->{from}) : @{[]},
+					 $pkg->flag_disable_obsolete ? (install => 1) : @{[]},
 				       };
 
 	$pkg->set_flag_required;
 
 	#- 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') {
+	if ($pkg->arch ne 'src' && !$pkg->flag_disable_obsolete) {
 	    my (%diff_provides);
 
 	    foreach ($pkg->name." < ".$pkg->epoch.":".$pkg->version."-".$pkg->release, $pkg->obsoletes) {
@@ -498,7 +504,7 @@ sub resolve_requested {
 					      @{$packages->{$p->name}};
 
 					  if (length $best) {
-					      push @properties, { required => $best, promote => $n };
+					      push @properties, { required => $best, from => $pkg, promote => $n };
 					  } else {
 					      #- no package have been found, we may need to remove the package examined unless
 					      #- there exists a package that provided the unsatisfied requires.
@@ -510,7 +516,7 @@ sub resolve_requested {
 					      }
 
 					      if (@best == @l) {
-						  push @properties, map { +{ required => $_, promote => $n } } @best;
+						  push @properties, map { +{ required => $_, from => $pkg, promote => $n } } @best;
 					      } else {
 						  $urpm->resolve_rejected($db, $state, $p,
 									  removed => 1, unsatisfied => \@properties,
@@ -563,7 +569,7 @@ sub resolve_requested {
 					      @{$packages->{$p->name}};
 
 					  if (length $best) {
-					      push @properties, { required => $best, promote_conflicts => $name };
+					      push @properties, { required => $best, from => $pkg, promote_conflicts => $name };
 					  } else {
 					      #- no package have been found, we need to remove the package examined.
 					      $urpm->resolve_rejected($db, $state, $p,
@@ -604,7 +610,7 @@ sub disable_selected {
 
     #- iterate over package needing unrequested one.
     while (my $pkg = shift @closure) {
-	$pkg->flag_selected || exists $state->{selected}{$pkg->id} or next;
+	exists $state->{selected}{$pkg->id} or next;
 
 	#- keep a trace of what is deselected.
 	push @unselected, $pkg;
@@ -633,7 +639,7 @@ sub disable_selected {
 	foreach my $n ($pkg->provides_nosense) {
 	    foreach (keys %{$state->{whatrequires}{$n} || {}}) {
 		my $p = $urpm->{depslist}[$_];
-		$p->flag_selected || exists $state->{selected}{$p->id} or next;
+		exists $state->{selected}{$p->id} or next;
 		if ($urpm->unsatisfied_requires($db, $state, $p, name => $n)) {
 		    #- this package has broken dependencies and is selected.
 		    push @closure, $p;
@@ -670,7 +676,7 @@ sub disable_selected_unrequested_dependencies {
 	    foreach ($_->requires_nosense) {
 		foreach (keys %{$urpm->{provides}{$_} || {}}) {
 		    my $pkg = $urpm->{depslist}[$_] or next;
-		    $pkg->flag_selected || exists $state->{selected}{$pkg->id} or next;
+		    exists $state->{selected}{$pkg->id} or next;
 		    $pkg->flag_requested and next;
 		    $required{$pkg->id} = undef;
 		}
@@ -684,7 +690,7 @@ sub disable_selected_unrequested_dependencies {
 		foreach (keys %{$state->{whatrequires}{$_}}) {
 		    my $p = $urpm->{depslist}[$_] or next;
 		    exists $required{$p->id} and next;
-		    $p->flag_selected and $required{$pkg->id} = 1;
+		    exists $state->{selected}{$p->id} and $required{$pkg->id} = 1;
 		}
 	    }
 	}
@@ -725,35 +731,41 @@ sub compute_installed_flags {
     \%sizes;
 }
 
-#- compute skip flag according to hash describing package to remove
+#- compute flags according to hash describing package to remove
 #- $skip is a hash reference described as follow :
 #-   key is package name or regular expression on fullname if /.../
 #-   value is reference to hash indicating sense information ({ '' => undef } if none).
 #- options hash :
 #-   callback : sub to be called for each package with skip flag activated,
-sub compute_skip_flags {
-    my ($urpm, $skip, %options) = @_;
+sub compute_flags {
+    my ($urpm, $val, %options) = @_;
 
     #- avoid losing our time.
-    %$skip or return;
+    %$val or return;
 
     foreach my $pkg (@{$urpm->{depslist}}) {
 	#- check if fullname is matching a regexp.
-	if (grep { exists($skip->{$_}{''}) && /^\/(.*)\/$/ && $pkg->fullname =~ /$1/ } keys %$skip) {
+	if (grep { exists($val->{$_}{''}) && /^\/(.*)\/$/ && $pkg->fullname =~ /$1/ } keys %$val) {
 	    #- a single selection on fullname using a regular expression.
-	    unless ($pkg->flag_skip) {
-		$pkg->set_flag_skip(1);
-		$options{callback} and $options{callback}->($urpm, $pkg, %options);
+	    foreach (qw(skip disable_obsolete)) {
+		if ($options{$_} && !$pkg->flag($_)) {
+		    $pkg->set_flag($_, 1);
+		    $options{callback} and $options{callback}->($urpm, $pkg, %options);
+		}
 	    }
 	} else {
 	    #- check if a provides match at least one package.
 	    foreach ($pkg->provides) {
 		if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
-		    foreach my $sn ($n, grep { /^\/(.*)\/$/ && $n =~ /$1/ } keys %$skip) {
-			foreach (keys %{$skip->{$sn} || {}}) {
-			    if (URPM::ranges_overlap($_, $s) && !$pkg->flag_skip) {
-				$pkg->set_flag_skip(1);
-				$options{callback} and $options{callback}->($urpm, $pkg, %options);
+		    foreach my $sn ($n, grep { /^\/(.*)\/$/ && $n =~ /$1/ } keys %$val) {
+			foreach (keys %{$val->{$sn} || {}}) {
+			    if (URPM::ranges_overlap($_, $s)) {
+				foreach (qw(skip disable_obsolete)) {
+				    if ($options{$_} && !$pkg->flag($_)) {
+					$pkg->set_flag($_, 1);
+					$options{callback} and $options{callback}->($urpm, $pkg, %options);
+				    }
+				}
 			    }
 			}
 		    }
@@ -905,6 +917,87 @@ sub request_packages_to_upgrade {
     $requested;
 }
 
+#- detect a dependency relation.
+sub has_dependence {
+    my ($urpm, $state, $a, $b) = @_;
+    my %examined; $examined{$a} = undef;
+    my @closure = $urpm->{depslist}[$a];
+
+    while (my $pkg = shift @closure) {
+	$pkg->id eq $b and return 1;
+	if (my $from = $state->{selected}{$pkg->id}{from}) {
+	    unless (exists $examined{$from->id}) {
+		$examined{$from->id} = undef;
+		push @closure, $from;
+	    }
+	}
+	foreach ($pkg->provides_nosense) {
+	    foreach (keys %{$state->{whatrequires}{$_} || {}}) {
+		my $p = $urpm->{depslist}[$_] or next;
+		$state->{selected}{$p->id} or next;
+		exists $examined{$p->id} and next;
+		$examined{$p->id} = undef;
+		push @closure, $p;
+	    }
+	}
+    }
+
+    return 0;
+}
+
+#- build transaction set for given selection already done.
+sub build_transaction_set {
+    my ($urpm, $db, $state, %options) = @_;
+
+    if ($options{split_level}) {
+	#- first step consists of sorting packages according to dependencies.
+	my @sorted = sort { ($a <=> $b, -1, +1, 0)[($urpm->has_dependence($state, $a, $b) && 1) +
+						   ($urpm->has_dependence($state, $b, $a) && 2)] }
+	  grep { (! defined $options{start} || $_ >= $options{start}) &&
+		   (! defined $options{end} || $_ <= $options{end})} keys %{$state->{selected}};
+
+	#- second step consists of re-applying resolve_requested in the same
+	#- order computed in first step and to update a list of package to
+	#- install, to upgrade and to remove.
+	my (%requested, %examined);
+	foreach (@sorted) {
+	    $requested{$_} = undef;
+	    if (keys(%requested) >= $options{split_level}) {
+		my %set;
+
+		$urpm->resolve_requested($db, $state->{transaction_state} ||= {}, \%requested,
+					 keep_requested_flag => 1,
+					 defined $options{start} ? (start => $options{start}) : @{[]},
+					 defined $options{end}   ? (end   => $options{end}) : @{[]});
+		%requested = ();
+
+		foreach (keys %{$state->{transaction_state}{selected}}) {
+		    exists $examined{$_} and next;
+		    $examined{$_} = undef;
+		    push @{$set{upgrade}}, $_;
+		}
+		foreach (keys %{$state->{transaction_state}{rejected}}) {
+		    exists $examined{$_} and next;
+		    $examined{$_} = undef;
+		    $state->{transaction_state}{rejected}{$_}{removed} &&
+		      !$state->{transaction_state}{rejected}{$_}{obsoleted} or next;
+		    push @{$set{remove}}, $_;
+		}
+		%set and push @{$state->{transaction}}, \%set;
+	    }
+	}
+    } else {
+	#- no split is necessary, simply extract from current selection.
+	$state->{transaction} = [ {
+				   upgrade => [ keys %{$state->{selected}} ],
+				   remove  => [ grep { $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted} }
+						keys %{$state->{rejected}} ],
+				  } ];
+    }
+
+    $state->{transaction};
+}
+
 #- compatiblity method which are going to be removed.
 sub resolve_closure_ask_remove {
     my ($urpm, $db, $state, $pkg, $from, $why, $avoided) = @_;
@@ -943,5 +1036,12 @@ sub resolve_unrequested {
     #- use return value of old method.
     %$unrequested && $unrequested;
 }
+sub compute_skip_flags {
+    my ($urpm, $skip, %options) = @_;
+
+    print STDERR "calling obsoleted method URPM::compute_skip_flags\n";
+
+    $urpm->compute_flags($skip, %options, skpip => 1);
+}
 
 1;
diff --git a/perl-URPM.spec b/perl-URPM.spec
index 1a0d3e8..3ee5b7e 100644
--- a/perl-URPM.spec
+++ b/perl-URPM.spec
@@ -1,7 +1,7 @@
 %define name perl-URPM
 %define real_name URPM
-%define version 0.90
-%define release 10mdk
+%define version 0.91
+%define release 1mdk
 
 %{expand:%%define rpm_version %(rpm -q --queryformat '%{VERSION}-%{RELEASE}' rpm)}
 
@@ -51,6 +51,13 @@ rm -rf $RPM_BUILD_ROOT
 
 
 %changelog
+* Mon Jun 16 2003 François Pons <fpons@mandrakesoft.com> 0.91-1mdk
+- added transaction set methods.
+- added disable_obsolete flags to improve installation mode of
+  packages, now handled by resolve_requested.
+- obsoleted URPM::compute_skip_flags (now URPM::compute_flags).
+- fixed rpmdb.t test when gpg pubkey has been imported in rpmdb.
+
 * Thu Jun 12 2003 François Pons <fpons@mandrakesoft.com> 0.90-10mdk
 - changed return value of verify_rpm to allow looking at key id.
 
diff --git a/t/rpmdb.t b/t/rpmdb.t
index 898588d..8d93fd2 100644
--- a/t/rpmdb.t
+++ b/t/rpmdb.t
@@ -25,7 +25,7 @@ my ($count, @all_pkgs_extern, @all_pkgs);
     $count = $db->traverse(sub {
 			       my ($pkg) = @_;
 			       my ($name, $version, $release, $arch) = $pkg->fullname;
-			       $arch or return;
+			       #- arch is void for -pubkey- package.
 			       push @all_pkgs, "$name-$version-$release";
 			   });
 }