4.4-1mdk

1 files changed, 105 insertions, 58 deletions

diff --git a/urpm.pm b/urpm.pm
index 3e404655..bddda161 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -3,7 +3,7 @@ package urpm;
 use strict;
 use vars qw($VERSION @ISA @EXPORT);
 
-$VERSION = '4.3';
+$VERSION = '4.4';
 @ISA = qw(Exporter URPM);
 @EXPORT = qw(*N);
 
@@ -784,10 +784,16 @@ sub configure {
     }
     #- determine package to withdraw (from skip.list file) only if something should be withdrawn.
     unless ($options{noskipping}) {
-	$urpm->compute_skip_flags($urpm->get_unwanted_packages($options{skip}), callback => sub {
-				      my ($urpm, $pkg) = @_;
-				      $urpm->{log}(N("skipping package %s", scalar($pkg->fullname)));
-				  });
+	$urpm->compute_flags($urpm->get_packages_list($urpm->{skiplist}, $options{skip}), skip => 1, callback => sub {
+				 my ($urpm, $pkg) = @_;
+				 $urpm->{log}(N("skipping package %s", scalar($pkg->fullname)));
+			     });
+    }
+    unless ($options{noinstalling}) {
+	$urpm->compute_flags($urpm->get_packages_list($urpm->{instlist}, $options{skip}), disable_obsolete => 1, callback => sub {
+				 my ($urpm, $pkg) = @_;
+				 $urpm->{log}(N("would install instead of upgrade package %s", scalar($pkg->fullname)));
+			     });
     }
     if ($options{bug}) {
 	#- and a dump of rpmdb itself as synthesis file.
@@ -2150,32 +2156,41 @@ sub resolve_dependencies {
 	$options{auto_select} and $urpm->request_packages_to_upgrade($db, $state, $requested, requested => undef);
 
 	$urpm->resolve_requested($db, $state, $requested, %options);
+
+	#- build transaction set now...
+	$urpm->build_transaction_set($db, $state, %options);
     }
 }
 
 #- get list of package that should not be upgraded.
-sub get_unwanted_packages {
-    my ($urpm, $skip) = @_;
-    my %skip;
+sub get_packages_list {
+    my ($urpm, $file, $extra) = @_;
+    my %val;
 
     local ($_, *F);
-    open F, $urpm->{skiplist};
+    open F, $file;
     while (<F>) {
 	chomp; s/#.*$//; s/^\s*//; s/\s*$//;
 	if (my ($n, $s) = /^([^\s\[]+)(?:\[\*\])?\[?\s*([^\s\]]*\s*[^\s\]]*)/) {
- 	    $skip{$n}{$s} = undef;
+ 	    $val{$n}{$s} = undef;
 	}
     }
     close F;
 
     #- additional skipping from given parameter.
-    foreach (split ',', $skip) {
+    foreach (split ',', $extra) {
 	if (my ($n, $s) = /^([^\s\[]+)(?:\[\*\])?\[?\s*([^\s\]]*\s*[^\s\]]*)/) {
- 	    $skip{$n}{$s} = undef;
+ 	    $val{$n}{$s} = undef;
 	}
     }
 
-    \%skip;
+    \%val;
+}
+#- for compability...
+sub get_unwanted_packages {
+    my ($urpm, $skip) = @_;
+    print STDERR "calling obsoleted method urpm::get_unwanted_packages\n";
+    get_packages_list($urpm->{skiplist}, $skip);
 }
 
 #- select source for package selected.
@@ -2307,7 +2322,48 @@ sub get_source_packages {
 #- return a list of package ready for rpm.
 sub download_source_packages {
     my ($urpm, $local_sources, $list, %options) = @_;
-    my (%sources, %error_sources, %removables);
+    my %sources = %$local_sources;
+    my %error_sources;
+
+    print STDERR "calling obsoleted method urpm::download_source_packages\n";
+
+    $urpm->exlock_urpmi_db;
+    $urpm->copy_packages_of_removable_media($list, \%sources, %options) or return;
+    $urpm->download_packages_of_distant_media($list, \%sources, \%error_sources, %options);
+    $urpm->unlock_urpmi_db;
+
+    %sources, %error_sources;
+}
+
+sub exlock_urpmi_db {
+    my ($urpm) = @_;
+
+    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
+    my $LOCK_EX = 2;
+
+    #- lock urpmi database, but keep lock to wait for an urpmi.update to finish.
+    open LOCK_FILE, $urpm->{statedir};
+    flock LOCK_FILE, $LOCK_EX or $urpm->{fatal}(7, N("urpmi database locked"));
+}
+
+sub unlock_urpmi_db {
+    my ($_urpm) = @_;
+
+    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
+    my $LOCK_UN = 8;
+
+    #- now everything is finished.
+    system("sync");
+
+    #- release lock on database.
+    flock LOCK_FILE, $LOCK_UN;
+    close LOCK_FILE;
+
+}
+
+sub copy_packages_of_removable_media {
+    my ($urpm, $list, $sources, %options) = @_;
+    my %removables;
 
     #- make sure everything is correct on input...
     @{$urpm->{media} || []} == @$list or return;
@@ -2361,13 +2417,13 @@ sub download_source_packages {
 				#- now we can consider the file to be fine.
 				unlink "$urpm->{cachedir}/rpms/$filename";
 				rename "$urpm->{cachedir}/partial/$filename", "$urpm->{cachedir}/rpms/$filename";
-				-r "$urpm->{cachedir}/rpms/$filename" and $sources{$i} = "$urpm->{cachedir}/rpms/$filename";
+				-r "$urpm->{cachedir}/rpms/$filename" and $sources->{$i} = "$urpm->{cachedir}/rpms/$filename";
 			    }
 			} else {
-			    $sources{$i} = $filepath;
+			    $sources->{$i} = $filepath;
 			}
 		    }
-		    unless ($sources{$i}) {
+		    unless ($sources->{$i}) {
 			#- fallback to use other method for retrieving the file later.
 			$urpm->{error}(N("unable to read rpm file [%s] from medium \"%s\"", $filepath, $medium->{name}));
 		    }
@@ -2381,14 +2437,6 @@ sub download_source_packages {
 	}
     };
 
-    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
-    my ($LOCK_EX, $LOCK_UN) = (2, 8);
-
-    #- lock urpmi database, but keep lock to wait for an urpmi.update to finish.
-    local (*LOCK_FILE);
-    open LOCK_FILE, $urpm->{statedir};
-    flock LOCK_FILE, $LOCK_EX or $urpm->{fatal}(7, N("urpmi database locked"));
-
     foreach (0..$#$list) {
 	values %{$list->[$_]} or next;
 	my $medium = $urpm->{media}[$_];
@@ -2428,6 +2476,12 @@ sub download_source_packages {
 	$examine_removable_medium->($removables{$device}[0], $device, $urpm->is_using_supermount($device) && 'copy');
     }
 
+    1;
+}
+
+sub download_packages_of_distant_media {
+    my ($urpm, $list, $sources, $error_sources, %options) = @_;
+
     #- get back all ftp and http accessible rpms file into the local cache
     #- if necessary (as used by checksig or any other reasons).
     foreach (0..$#$list) {
@@ -2439,18 +2493,18 @@ sub download_source_packages {
 	#- examine all files to know what can be indexed on multiple media.
 	while (my ($i, $url) = each %{$list->[$_]}) {
 	    #- it is trusted that the url given is acceptable, so the file can safely be ignored.
-	    defined $sources{$i} and next;
+	    defined $sources->{$i} and next;
 	    if ($url =~ /^(removable[^:]*|file):\/(.*\.rpm)$/) {
 		if (-r $2) {
-		    $sources{$i} = $2;
+		    $sources->{$i} = $2;
 		} else {
-		    $error_sources{$i} = $2;
+		    $error_sources->{$i} = $2;
 		}
 	    } elsif ($url =~ /^([^:]*):\/(.*\/([^\/]*\.rpm))$/) {
 		if ($options{force_local} || $1 ne 'ftp' && $1 ne 'http') { #- only ftp and http protocol supported by grpmi.
 		    $distant_sources{$i} = "$1:/$2";
 		} else {
-		    $sources{$i} = "$1:/$2";
+		    $sources->{$i} = "$1:/$2";
 		}
 	    } else {
 		$urpm->{error}(N("malformed input: [%s]", $url));
@@ -2484,51 +2538,44 @@ sub download_source_packages {
 		    #- it seems the the file has been downloaded correctly and has been checked to be valid.
 		    unlink "$urpm->{cachedir}/rpms/$filename";
 		    rename "$urpm->{cachedir}/partial/$filename", "$urpm->{cachedir}/rpms/$filename";
-		    -r "$urpm->{cachedir}/rpms/$filename" and $sources{$i} = "$urpm->{cachedir}/rpms/$filename";
+		    -r "$urpm->{cachedir}/rpms/$filename" and $sources->{$i} = "$urpm->{cachedir}/rpms/$filename";
 		}
-		unless ($sources{$i}) {
-		    $error_sources{$i} = $distant_sources{$i};
+		unless ($sources->{$i}) {
+		    $error_sources->{$i} = $distant_sources{$i};
 		}
 	    }
 	}
     }
 
     #- clean failed download which have succeeded.
-    delete @error_sources{keys %sources};
+    delete @{$error_sources}{keys %$sources};
 
-    #- now everything is finished.
-    system("sync");
+    1;
+}
 
-    #- release lock on database.
-    flock LOCK_FILE, $LOCK_UN;
-    close LOCK_FILE;
+#- prepare transaction.
+sub prepare_transaction {
+    my ($urpm, $set, $list, $sources, $transaction_list, $transaction_sources) = @_;
 
-    #- return the hash of rpm file that have to be installed, they are all local now.
-    %$local_sources, %sources, %error_sources;
+    foreach my $id (@{$set->{upgrade}}) {
+	my $pkg = $urpm->{depslist}[$id];
+	foreach (0..$#$list) {
+	    exists $list->[$_]{$id} and $transaction_list->[$_]{$id} = $list->[$_]{$id};
+	}
+	exists $sources->{$id} and $transaction_sources->{$id} = $sources->{$id};
+    }
 }
 
 #- extract package that should be installed instead of upgraded,
 #- sources is a hash of id -> source rpm filename.
 sub extract_packages_to_install {
     my ($urpm, $sources) = @_;
-
     my %inst;
-    local ($_, *F);
-    open F, $urpm->{instlist};
-    while (<F>) {
-	chomp; s/#.*$//; s/^\s*//; s/\s*$//;
-	foreach (keys %{$urpm->{provides}{$_} || {}}) {
-	    my $pkg = $urpm->{depslist}[$_] or next;
 
-	    #- some package with specific naming convention to avoid upgrade problem
-	    #- should not be taken into account here.
-	    #- these package have version=1 and release=1mdk, and name contains version and release.
-	    $pkg->version eq '1' && $pkg->release eq '1mdk' && $pkg->name =~ /^.*-[^\-]*mdk$/ and next;
-
-	    exists($sources->{$pkg->id}) and $inst{$pkg->id} = delete $sources->{$pkg->id};
-	}
+    foreach (keys %$sources) {
+	my $pkg = $urpm->{depslist}[$_] or next;
+	$pkg->flag_disable_obsolete and $inst{$pkg->id} = delete $sources->{$pkg->id};
     }
-    close F;
 
     \%inst;
 }
@@ -2572,7 +2619,7 @@ sub install {
     my $trans = $db->create_transaction($urpm->{root});
     if ($trans) {
 	$urpm->{log}(N("created transaction for installing on %s (remove=%d, install=%d, upgrade=%d)", $urpm->{root} || '/',
-		       scalar(@$remove), scalar(values %$install), scalar(values %$upgrade)));
+		       scalar(@{$remove || []}), scalar(values %$install), scalar(values %$upgrade)));
     } else {
 	return (N("unable to create transaction"));
     }
@@ -2792,7 +2839,7 @@ sub parallel_remove {
 
 #- misc functions to help finding ask_unselect and ask_remove elements with their reasons translated.
 sub unselected_packages {
-    my ($urpm, $state, %options) = @_;
+    my ($urpm, $state) = @_;
 
     grep { $state->{rejected}{$_}{backtrack} } keys %{$state->{rejected} || {}};
 }
@@ -2808,7 +2855,7 @@ sub translate_why_unselected {
 }
 
 sub removed_packages {
-    my ($urpm, $state, %options) = @_;
+    my ($urpm, $state) = @_;
 
     grep { $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted} } keys %{$state->{rejected} || {}};
 }