summaryrefslogtreecommitdiffstats
path: root/urpm.pm
diff options
context:
space:
mode:
Diffstat (limited to 'urpm.pm')
-rw-r--r--urpm.pm163
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} || {}};
}